From: Adam Sampson Date: Fri, 20 Apr 2018 13:22:32 +0000 (+0100) Subject: Add MIDAS 323 source. X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;ds=sidebyside;h=1896858948199f2ba18094e68295a41387e8abf3;p=pdp10-muddle.git Add MIDAS 323 source. This is the last version we've found that doesn't cause STINK to produce "Multiply Defined Global" errors. --- diff --git a//midas.323 b//midas.323 new file mode 100644 index 0000000..ce24ab3 --- /dev/null +++ b//midas.323 @@ -0,0 +1,13497 @@ + +.SYMTAB 4003.,2000. ;THIS MANY FOR DEC VERSION ON DEC SYSTEM. +IFN .OSMIDAS-SIXBIT/DEC/, .SYMTAB 5003. ;ON ITS ASSEMBLE FASTER. + +TITLE MIDAS +.MLLIT==1 ;MULTI-LINE MODE. + +;AC DEFS + +FF=0 ;FLAGS +P=1 +I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +AA=3 +A=4 +B=5 +C=6 +D=7 +T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T +TT=11 +SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=13 +F=14 +CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=16 ;" " " +TM=17 ;SUPER TEMPORARY + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NONZERO FOR ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF JSYS,[1] .ELSE 0 ;NONZERO FOR TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NONZERO TO RUN ON DEC MONITOR. + ; TNXSW SINCE TENEX MIDAS HAS DEC UUO'S + ; DEFINED TOO +IFNDEF DECDBG,DECDBG==0 ;NONZERO FOR DEC VERSION TO RUN WITH DEC DDT. +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NONZERO FOR SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NONZERO FOR VERSION TO RUN AT CMU. +IFN TNXSW,DECSW==1 ;***TEMP*** USE PA1050 FOR NOW +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF TSSYMS, TSSYMS==ITSSW ;.UAI, ETC. (AND ..RJCL, ETC) - EVER USE THEM? +IFNDEF BRCFLG, BRCFLG==0 ;1 => BRACES { AND } ARE SPECIAL IN MACRO ARGS, ETC. + ;JUST LIKE BRACKETS. BRACES ARE SPECIAL IN CONDITIONALS + ;REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;SET TO ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS +IFNDEF FASLP, FASLP==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE +IFNDEF .I.FSW, .I.FSW==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;ASSEMBLE CODING TO TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFE DECSW,IFNDEF MACL,MACL==6000 ;(MUST BE BIG ENOUGH TO COVER INIT CODE) + ;IN DEC VERSION, MACL IS DEFINED = SIZE OF INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN DECSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==500 ;LENGTH OF PDL +IFN DECSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==10000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFN DECSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +IF1 [ + +IFNDEF MIDVRS,MIDVRS=.FNAM2 +IFE MIDVRS-SIXBIT/MID/,[ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS +MIDVRS=SIXBIT/VRS/ +TERMIN +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. +IFNDEF OSMIDAS,OSMIDAS==IFE TS,[SIXBIT/BARE/] .ELSE IFN ITSSW,[SIXBIT/ITS/] .ELSE IFN CMUSW,[SIXBIT/CMU/] .ELSE IFN SAILSW,[SIXBIT/SAIL/] .ELSE IFN TNXSW,[SIXBIT/TENEX/] .ELSE SIXBIT/DEC/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT==40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC==20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY==10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +FLOUT==4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF==2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD==1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) + + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. + +] ;END IF1 + +IF1 [ + + ;INDICATOR REGISTER + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + + +CALL=PUSHJ P, +RET=POPJ P, +SAVE=PUSH P, +REST=POP P, + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE=="{ +IFNDEF RBRACE,RBRACE=="} + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +;CONTROL FLAGS +;LEFT HALF +TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE) +;RIGHT HALF +ARIM==2 ;IF ONE OUT FOR IS RIM +SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS +ARIM10==20 ;PDP-10 RIM +DECREL==40 ;DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL==100 ;LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC A!B!C!D!E!F +] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +IF1 [ + + ;RANDOM MACRO DEFINITIONS + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +IFN DECSW\TNXSW,[ +IF1 [ +IFE .OSMIDAS-SIXBIT/ITS/,[ + IFE CMUSW\SAILSW,.INSRT SYS:DECDFS + IFN SAILSW, .INSRT SYS:SAIDFS + IFN CMUSW, .INSRT SYS:CMUDFS + IFN TNXSW, .INSRT SYS:TNXDFS +] ;IF ASSEMBLED ON ITS +IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS: + IFE CMUSW\SAILSW,.INSRT DECDFS + IFN SAILSW, .INSRT SAIDFS + IFN CMUSW, .INSRT CMUDFS + IFN TNXSW, .INSRT TNXDFS +] ;IF ASSEMBLED ON A NON-ITS PLACE +.DECDF + +IFN TNXSW,[EXPUNGE RESET ; THE ONLY CONFLICTING JSYS/CALLI +.TNXDF +] ;IFN TNXSW + +EXPUNGE .SUSET +DEFINE .SUSET A +TERMIN + +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT +DEFINE .LOSE A + JRST 4,.-1 +TERMIN +] ;IF1 +IFN PURESW,.DECTWO +IFE PURESW,.DECREL +RL0==. +] ;IFN DECSW\TNXSW + +IFN ITSSW,[IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF +] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 +RL0==0 +IFDEF .SBLK,.SBLK +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==140 ;BLOCK NUMBER BEGINNING OF PURE CODING +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ;SWITCH TO CODING ABOVE THE GAP + +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + +PUR.LC==MINPUR*2000+IFN DECSW,[RL0] ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW + + ;SWITCH TO CODING BELOW THE GAP + +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[IFE SAILSW,LOC .JBAPR +.ELSE LOC JOBAPR + TSINT1] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + + ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS + ;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED) +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + + ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO2 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,INCHR3 ;RREOF + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + + ;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE MAYBE GET HERE FROM RCH2+2 +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES (SOMETIMES RETURN HERE FROM RREOF) +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RR1-1 +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + + + + ;JSP CH2,RR2 => DIGIT (FROM GDTAB) + ;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + + ;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + + ;DECIPHER A VALUE FROM NUMTABS + ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B + ;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + + ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + SAVE GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: SAVE PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: SAVE GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS + SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JRST MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAME D,GLSP1 + ETR [ASCIZ /Externals multiplied/] +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,GETFLB(P) + CAME D,GLSP1 + ETR [ASCIZ /Division involving externals/] + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS + MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ETR [ASCIZ /External in arg to \, & or #/] + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ SAVE B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + + ;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS + ;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS + ;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE + ;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + MOVEI CH1,CRDF + MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + SKIPN PARBIT ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + PUSHJ P,P70 ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + + ;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + CLEARM PARBIT ;SET FLAG SAYING COLON, FOR DEFINITION PUNCHING + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + SAVE A + SAVE A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: SAVE SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + SAVE ASMOUT + SAVE ASMDSP + SAVE ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + + ;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + + ;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + + ;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + + ;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + + ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + + ;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + + ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + SAVE [ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[-1-FLVOT-FLPTPF-FLTTY,,-1] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + ;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ SETZM CLOC + AOS CRLOC ;CRLOC GETS 1 +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNN A,DECREL + POPJ P, +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT, + MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. .INIT BLOCK). + CAIN C,2 + MOVEI C,1 ;IF ONLY .INIT AND .MAIN, FILE WILL HAVE ONLY GLOBAL. + MOVSI A,(C) + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + MOVEM A,SCKSUM ;SAVE THIS. + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE) + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL + JRST SSYMD6 ;NO BLOCKS IN DEC FMT. (OR FASL EITHER) + SKIPGE BKTAB1+1 + JRST SSYMG1 ;ONLY 1 BLOCK, PUT ALL IN GLOBAL. + MOVE A,BKTAB(C) + PUSHJ P,PPBCK + HLRZ A,BKTAB+1(C) + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,1] +SSYMG2: PUSHJ P,PPBCK ;FOLLOWED BY LEVEL. + JRST SSYMD6 + +SSYMG1: MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK + HRLZ A,BKTAB+BKWPB+2 + ADD A,[-2,,] + JRST SSYMG2 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD3 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. + JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK. + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR, + JRST SSYMG4 + MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK ;PUT A GLOBAL BLOCK WITH NO SYMS AT END. + MOVSI A,-2 + PUSHJ P,PPBCK +SSYMG4: MOVE A,B ;ABS ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). +BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) + JUMPE C,CPOPJ ;DON'T PUT .INIT BLOCK IN BKTAB1. + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + + ;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + + ;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: SAVE SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + + ;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + + ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + + ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD + ;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + + ;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ;DEC FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + SAVE SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + SAVE [EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + ;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILFLO ;FOR .VECTOR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + SAVE VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILFLO + JRST A.GLO2 + SAVE LINK ;.VECTOR - READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + SKIPE A + MOVEM A,VECSIZ ;IF NONZERO SIZE SPEC'D, USE IT AND SET DEFAULT. + MOVE A,VECSIZ ;ELSE USE THE DEFAULT. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT + SKIPGE A,CONTRL + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + +AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART + TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST + PUSHJ P,PPB + JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW,[ + SAVE TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD: CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: SAVE A + SAVE WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS A,-1(P) + SUB P,[2,,2] + JRST VALRET ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + SAVE ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + SAVE A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + SAVE A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + SAVE A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + SAVE A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + SAVE [AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + SAVE SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + SAVE ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + SAVE A + SAVE B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + SAVE C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + + ;UUO HANDLING ROUTINE + ;41 HAS JSR ERROR + +VBLK +IFE ITSSW,ERRTTL: 0 ; NUMBER OF ERRORS HIT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN TS, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + SAVE C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPR_-33 ;TYPR? + JRST TYPR1 ;YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT +IFE ITSSW,[ + AOS ERRTTL ; BUMP ERROR TOTAL +IFE SAILSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT +.ELSE AOS JOBERR +] ; IFE ITSSW + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO2 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. +IFN ITSSW,.RESET TYIC, + JRST GO2 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + ;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + SAVE B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + SAVE CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2 + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? + JRST [IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2 + JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR + .ALSO RET + ] ; AND RETURN IF PASS2 DEC CCL +IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2 + PUSHJ P,TYO ;NEITHER OF THESE, PRINT CHAR +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: SAVE CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL: SAVE [GO2] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + ;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + SAVE [0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + SAVE ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + SAVE SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HRLES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: SAVE SYM + SAVE SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + ;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + + ;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD + JRST -3(A) + JRST -4(A) + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + + ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + + ;PDL STRUCTURE FOR REPEAT + ;TWO TWO WORD ENTRIES + ;BBASE,,CPTR + ;LIMBO1 STATUS,,# TIMES LEFT + ;OLD .RPCNT,,BEG OF BODY + ;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + + ;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + + ;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + SAVE SYM + HRRI B,SCONDF + SAVE B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + + ;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + + ;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: SAVE [0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + SAVE [0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + SAVE [0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFEVL==5 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + SAVE CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + SAVE SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + SAVE SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + SAVE SYM + SAVE ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: SAVE A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 + +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: SAVE I + AOS PRCALP + AOS MDEPTH + SAVE RDWRDP + SAVE A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + JUMPE B,[TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS + TLZ I,ILPRN ;SUCH MACROS + SKIPE B,ASMOUT ;IF WITHIN A GROUPING, + CAIN B,4 + JRST MACNX0 + JSP LINK,SAVAS2 ;RESTORE ASMDSP TO NORMAL IN CASE + JRST MACNX0] ;THE CHAR BEING REREAD IS A CLOSE. + TLZ I,ILPRN + MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIN B,MCFSTR + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVE T,A ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZA FF,FLUNRD +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAME A,T + JRST MACST2 ;STORE IT AND READ ANOTHER. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY + TRZN LINK,MCFKWD + JRST MACDF1 +MACDF0: CALL REDINC + CAIE B,377 + JRST MACDF0 +MACDF1: CALL REDINC ;AS THE ARGUMENT STRING. + CAIN B,377 + JRST MACDF2 ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +MACDF2: MOVEM A,@PRCALP + JRST STPWR + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + SAVE CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + SAVE C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + SAVE CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: SAVE RDWRDP + SAVE @PRCALP + SAVE LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: REST LINK + REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOUDL START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE + SAVE @PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ. + SAVE LINK + CAIE A,"= + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE + REST LINK + REST @PRCALP +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + SAVE I + SAVE RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + SAVE A + CALL AGETFD + SAVE A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + SAVE A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: SAVE LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + + ;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + + ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) + ;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY + ;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + + ;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + + ;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +GC: MOVEM 17,GCSV+15 + MOVE 17,[2,,GCSV] + BLT 17,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + + ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 + MOVS 17,[2,,GCSV] + BLT 17,17 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE GET + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 +TERMIN + +DEFINE GETT + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +ACSAV: BLOCK 7 +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER + MOVE TM,[P,,ACSAV] + BLT TM,ACSAV+6 + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: GET ;CONTINUE STATEMENT RC + GET ;LF + GET ;. + CAIE A,". ;DOT + JRST BDCONT + GET ;F OR I + GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: GET + CAIE A,12 ;LF + JRST GETLF + MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + SAVE LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +IFN TS,[ ;;TS ;TIME-SHARING ROUTINES + +IFNDEF TYPDLC,TYPDLC==7 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY) +IFNDEF MX.INS,MX.INS==5 ;MAXIMUM DEPTH .INSRT FILES ONLY +IFNDEF MAXIND,MAXIND==6 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT +IFN DECSW,[ + UTOBFL==203 + CRFBSZ==203 + UTIBFL==410 + LSTBSZ==203 + ERRBSZ==203 +] +IFNDEF UTIBFL,UTIBFL==400 ;INPUT BUFFER SPACE. +IFNDEF UTOBFL,UTOBFL==200 +IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH. +IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER. +IFNDEF LSTBSZ,LSTBSZ==200 +IFNDEF ERRSW,ERRSW==1 ;1 FOR ERROR FILE OUTPUT CAPABILITY. +IFNDEF ERRBSZ,ERRBSZ==1 ;ERROR FILE BUFFER SIZE. + +ERRC==0 ;ERR DEVICE CHANNEL. +TYIC==1 ;TTY INPUT CHANNEL +TYOC==2 ;TTY OUTPUT CHANNEL +CREFC==3 ;CREF OUTPUT. +UTYOC==4 ;OUTPUT FILE +LPTC==5 ;LISTING (LPT) +ERRFC==6 ;ASSEMBLY ERROR OUTPUT FILE. +UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+N USED FOR NTH .INSRT LEVEL IN DEC VERSION. + +VBLK +INTJPC: 0 ;SAVES .JPC AT INTERRUPT. +INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING + +;NOTE THAT ONLY PDL OV IS NOW ENABLED. + +IFN ITSSW,[ +.JBCNI: +TSINT: 0 ;1ST WD INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS +.JBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ;SECOND-WORD INTS. + JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT +] +.ELSE CCLFLG:0 ; FLAG TO INDICATE CCL ENTRY FROM COMPIL + +PBLK +TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING + .SUSET [.SPICL,,[-1]] +IFE SAILSW,MOVE A,.JBCNI ;GET INTERRUPT REQUEST WORD +.ELSE MOVE A,JOBCNI + TRNE A,200000 ;PDL OVERFLOW? + JRST CONFLP + MOVE B,[TYPR [ASCIZ/Unknown interrupt - Fatal/]] + MOVEM B,40 +IFE SAILSW,MOVE A,.JBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY +.ELSE MOVE A,JOBTPC + JSA A,ERROR + +;MIDAS STARTS HERE. +BEG: +IFN DECSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; REMEMBER TYPE OF START-UP + RESET + MOVEI A,600000 + APRENB A, +] +IFN ITSSW,[ + .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME + .SUSET [.SMASK,,[%PIPDL]] ;PDL OVERFLOW ONLY. + .SUSET [.SMSK2,,[1_TYIC]] + SYSCAL TTYSET,[1000,,TYIC + [232020,,202020] + [232020,,220220]] + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT) +] + MOVEI FF,0 ;INITIALIZE FLAGS + MOVE P,[-LPDL,,PDL] ;INITIALIZE P + AOSN NVRRUN + JRST BEG9 + TYPR [ASCIZ /Can't restart MIDAS/] + JRST TSRETN + +BEG9: MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE +IFN ITSSW,[ + .SUSET [.RXJNAM,,A] + CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS + CAMN A,[SIXBIT/MM/] + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ;THE FIRST TIME THROUGH, + MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE. + CALL JCLINI ;NOW TRY TO FETCH JCL. +IFN ITSSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD + CALL TSYMGT ;GET TS SYMS FROM SYSTEM +] + SKIPGE CMPTR ;IF NO CMD FROM DDT, + JRST GO2A ;ANNOUNCE MIDAS'S NAME AND VERSION. +IFG PURESW-DECSW,[ + SKIPGE PURIFG + TYPR [ASCIZ /NOTPUR /] +] + MOVE B,[SIXBIT /MIDAS./] + PUSHJ P,SIXTYO + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO +; JRST GO2A + +GO2A: SETOM FATAL + SETZM TTYFLG +IFE ITSSW,SETZM ERRTTL ; INITIALIZE ERROR COUNTER + MOVEI FF,0 ;INITIALIZE FLAGS + SKIPLE CMPTR + SETZM CMPTR +IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME. + MOVEM A,IRUNTM'] + SETZM LSTTTY + PUSHJ P,CMD ;GET TYPED IN COMMAND + SKIPGE SMSRTF + JRST GO21 + TYPR [ASCIZ/SYMTAB clobbered +/] + JRST GO2A + +GO21: PUSHJ P,GINIT ;INITIALIZE STUFF + PUSHJ P,OPNRD ;OPEN INPUT FILE + PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE. +IFN DECSW,[ + SKIPGE CCLFLG + OUTSTR [ASCIZ /MIDAS: /] +] +GO3: MOVEMM TTYFLG,WSWCNT ;TURN OFF TYPEOUT IF THERE WERE (W) SWITCHS. + SETOM LSTTTY + JSP A,$INIT ;INITIALIZE FOR ASSEMBLY + JSP A,PS1 ;DO PASS 1 + TRNE FF,FRNPSS ;IF 2 PASS ASSEMBLY, + PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE + JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT + JSP A,PS2 ;DO PASS 2 + JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE +IFN A1PSW,[ + TLZ FF,FLOUT + AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED + SETOM OUTC ;" " " + TRNN FF,FRNPSS ;IF 1 PASS ASSEMBLY, + SKIPGE CONTRL + CAIA + JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO4 + MOVE A,[SIXBIT /*FASL*/] ;"FINISH" FASL FILE + MOVEI B,17 + PUSHJ P,FASO ;IGNORE END FROB, BUT OUTPUT FASL END CODE + MOVE A,[.BYTE 7 ?3 ? 3 ? 3? 3? 3] + PUSHJ P,FASO1 ;RANDOMNESS + PUSHJ P,FASBE ;WRITE OUT LAST BLOCK +] +GO4: SETZM FATAL ;THERE WAS NO FATAL ERROR: OUTPUT FILES GET RENAMED. +GO2: +RETN2: PUSHJ P,.FILE + SETZM LSTTTY +IFN RUNTSW,[ + PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2A +];IFN RUNTSW + CALL ERRCLS ;FILE AWAY ERROR FILE. + JRST TSRETN + + ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY + +GINIT: IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +] +IFN DECSW,[ IFE SAILSW,[ + SETZM V.SITE ;; CODE TO SET UP .SITE'S VALUE, ON DEC SYSTEM. + MOVE A,[V.SITE,,V.SITE+1] + BLT A,V.SITE+4 + MOVE B,[440600,,V.SITE] + MOVSI C,-5 ;PROCESS 5 WORDS F .GTCNF +GINIT1: HRLZ A,C + HRRI A,11 ;11 = .GTCNF + GETTAB A, ;GET 1 WORD + SETZ A, +GINIT2: SETZ AA, ;EXTRACT THE ASCII CHARS AND STORE THEM. + ROTC AA,7 + TRCE AA,140 ;SWAP BIT 40 WITH BIT 100, THUS TURNING + TRCE AA,140 ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' . + TRCE AA,140 + IDPB AA,B ;STORE THE SIXBIT INTO .SITE'S VALUE STRING. + JUMPN A,GINIT2 ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT. + AOBJN C,GINIT1 +]];END DECSW + MOVE A,[MAXIND,,FDSOFS] + MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE +IFDINI: MOVE A,[DNAM,,IFDS] + BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC. + POPJ P, + +IFN RUNTSW,[ ;TYPE OUT RUN TIME USED + +RNTTYO: +IFE ITSSW,[ ; NOBODY WANTS THIS ON ITS, BUT OTHER PEOPLE DO...SIGH... + SKIPE A,ERRTTL ; ANY ASSEMBLY ERRORS? + JRST [ TYPR [ASCIZ/? /] ; YES, ERROR MESSAGE FOR BATCH CONTROLLERS + CALL DPNT + TYPR [ASCIZ/ error(s) detected +/] + JRST .+1] +IFN DECSW,[ + SKIPE CCLFLG ; CALLED VIA CCL? + RET +] ; IFN DECSW +] ; IFE ITSSW + TYPR [ASCIZ /Run time = /] + CALL A.MRUNT ;GET RUNTIME IN MILLISEC. IN A. + IDIVI A,10. + IDIVI A,100. ;GET SECS AND HUNDREDTHS. + HRLM B,(P) ;SAVE REMAINDER + PUSHJ P,HMSTYO ;TYPE OUT SECS + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL RNTYO3 ;TYPE OUT HUNDREDTHS + CALL CRR + CALL A.SYMC + CALL DPNT + TYPR [ASCIZ/ Symbols including initial ones +/] + RET + + ;TYPE OUT H:MM:SS TIME IN A + ;DOESN'T WORK FOR TIMES .GE. 60. HOURS + +HMSTYO: IDIVI A,60. + JUMPE A,HMSTY2 + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": +RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR + HLRZ A,(P) +RNTYO3: IDIVI A,10. + PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A + MOVEI A,"0(B) + JRST TYO + +HMSTY2: MOVE A,B + JRST DPNT + +RNTTMA: .SUSET [.RRUNT,,A] +IFN DECSW,[SETZ A, + RUNTIM A,] + POPJ P, + +A.MRUNT: PUSHJ P,RNTTMA ;GET CURRENT RUN TIME + SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2 +IFN ITSSW,[MULI A,4069. ;CONVERT TO NANOSECONDS + DIV A,[1.^6] ;THEN TO MILLISECONDS. +] + JRST CLBPOP +] + + ;TS OUTPUT ROUTINES + +PPB: JUMPGE FF,CPOPJ +PPBA: +TPPB: SOSGE UTYOCT + JRST TPPB1 + IDPB A,UTYOP + RET + +TPPB1: CALL TPPBF ;OUTPUT THE BUFFER, + JRST TPPB + +TPPBF: SAVE C + MOVE C,[0 UTYOC,UTOHDR] + CALL OBUFO ;OUTPUT & RE-INIT BUFFER. + REST C + RET + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ;IF WANT ERROR OUTPUT FILE, + JRST WINIT2 + CALL OINIT ;OPEN IT. + 0 ERRFC,ERRDEV + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ;ERROR FILE NOW OPEN. +WINIT2: ] + PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT. + 13^9 UTYOC,ONAM ; CHNL,NAME-BLOCK. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH + .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL + ANDI A,77 ;MASK TO DEVICE CODE + CAIN A,7 ;IF PAPER TAPE PUNCH, + TLO FF,FLPTPF ;THEN SET FLPTPF +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT + 0 LPTC,LSTDEV ;OPEN LISTING FILE IF DESIRED. + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ;IF CREF REQUESTED, + RET + PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT + 13^9 CREFC,CRFDEV + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT. + PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK. +] + RET + +IFN ITSSW,RELEAS==.CLOSE + +;CLOSE INPUT, BIN, CREF AND LIST FILES. +.FILE: RELEAS UTYIC, + MOVNI A,1 + SKIPL B,CONTRL ;IF RELOCATABLE, + PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF + SETZ A, ;IN DEC FMT, OUTPUT A 0 AT END. + TRNE B,DECREL + CALL TPPB + SKIPE ONAM+2 + JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED + SKIPL B,CONTRL + SKIPA A,[IFN DECSW,['STK,,] .ELSE ['REL,,]] + MOVSI A,(SIXBIT /BIN/) + TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE. + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL + MOVE A,[IFN ITSSW,[SIXBIT /FASL/] .ELSE ['FAS,,]] +] + MOVEM A,ONAM+2 +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ;WRITE OUT BUFFER, RENAME AND CLOSE OUTPUT FILE. + ONAM +IFN LISTSW,[ + SKIPN LISTP ;LISTING FILE OPEN => + JRST .FILE3 + CALL PNTCR ;END WITH CR AND FF. + MOVEI A,^L + CALL PILPT + JSP A,OCLOSE + 0 LPTC,LSTHDR ;OUTPUT BUFFER, RENAME & CLOSE IT. + LSTDEV +.FILE3: +] ;END IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ;IF CREF FILE OPEN, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK, + JSP A,OCLOSE ;WRITE BUFFER, CLOSE. + 0 CREFC,CRFHDR ; 0 CHNL,HEADER + CRFDEV +] + RET + +;FILE OUT ERROR OUTPUT FILE. +ERRCLS: SETZM FATAL ;ERR FILE RENAMED EVEN AFTER FATAL ERROR. +IFN ERRSW,[ + SKIPN ERRFOP + RET ;THERE IS NONE. + MOVEI A,^M + CALL ERRCHR ;PUT CRLF AT ENND. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ;RENAME AND CLOSE. + 0 ERRFC,ERRHDR + ERRDEV + SETZM ERRFOP +] + RET + ; PUSHJ P,OINIT ;OPEN OUTPUT FILE +; MODE CHNL,NAME-BLOCK-ADDR +; SIXBIT/DESIRED-TEMPORARY-FN2/ +; HEADER,,BUFFER SPACE ;USED ONLY IN DEC VERSION. +;THE MODE SHOULD BE 13^9 FOR BINARY, 0 FOR ASCII. +IFN ITSSW,[ +OINIT: MOVE A,(P) + HLRZ B,2(A) ;GET ADDR OF HEADER, + SETOM 2(B) ;SET BUFFER BYTE COUNT TO -1 => NOT INITTED. + MOVE AA,1(A) ;GET 2ND ARG, + MOVS A,@(P) ;COPY OUTPUT FILE'S EVENTUAL NAMES INTO DNAM, ETC. + CALL A.IMP1 + .CALL OINITR ;TRANSLATE THEM AS IF OPENING THAT FILE, + JRST OINITL ;(TOO MANY TRANSLATIONS) + .CALL OINITB ;DELETE OLD TEMP NAME FILE. + JFCL ;THERE WAS NONE. + LDB A,[270400,,@(P)] ;GET CHANNEL NUM. + HRLI A,7 ;OPEN MODE. + LDB B,[331100,,@(P)] + CAIN B,0 ;BUT MAYBE WANT ASCII MODE. + HRLI A,3 + .CALL OINITO + JRST OINITL + HRRZ A,@(P) + MOVEI B,3(A) ;SUCCESSFUL OPEN, COPY TRANSLATED NAMES INTO NAME-BLOCK FOR FILE + HRLI A,DNAM + BLT A,(B) ;FOR EVENTUAL RENAME. +POPJ3: AOS (P) ;SKIP OVER 3 ARGS. +POPJ2: AOS (P) + JRST POPJ1 + +; JSP A,OCLOSE +; 0 CHNL,HEADER +; NAMEBLOCKADDR +;WRITE OUT LAST BUFFER, RENAME TO NAMES IN NAMEBLOCK AND CLOSE. +OCLOSE: MOVE C,(A) ;1ST WD OF ARGS IS WHAT OBUFO WANTS. + LDB B,[360600,,1(C)] ;JUST IN CASE THIS IS ASCII FILE, + DPB B,[300600,,OCLOSP] ;GET BP TO UNUSED PART OF LAST WD OF BUFFER, + MOVE B,[ASCIC//] + DPB B,OCLOSP ;AND PAD WITH ^C'S. + SOS 2(C) ;OBUFO ASSUMES BYTE COUNT WAS SOS'D. + CALL OBUFO ;WRITE OUT LAST PARTIAL BUFFER + MOVE B,1(A) + LDB C,[270400,,(A)] ;GET CHNL NUM. + SKIPE FATAL + JRST OCLOS1 ;AFTER FATAL ERROR, DON'T RENAME OUTPUTFILES. + .CALL ORENMB ;RENAME (B HAS NAMEBLOCK ADDR) + HALT +OCLOS1: .CALL OCLOSB ;CLOSE + HALT + JRST 2(A) + +ORENMB: SETZ ? SIXBIT/RENMWO/ + C ? 1(B) ? SETZ 2(B) ;[CHNL] ? [FN1] ? [FN2] ((SETZ)) + +OCLOSB: SETZ ? SIXBIT/CLOSE/ + SETZ C + +OINITB: SETZ ? SIXBIT/DELETE/ + DNAM ? ['_MIDAS] ? AA ? SETZ SNAM + +OINITR: SETZ ? SIXBIT/TRANS/ + REPEAT 4,DNAM+.RPCNT + REPEAT 4,[? 2000,,DNAM+.RPCNT ] ((SETZ)) + +OINITO: SETZ ? SIXBIT/OPEN/ ? A + DNAM ? ['_MIDAS] ? AA ? SETZ SNAM + +;WRITE OUT AND REINITIALIZE BUFFER FOR FILE. +;ASSUMES BYTE COUNT (HEADER 3RD WD) WAS SOS'D. +;C HAS <0 CHNL,HEADER> +;IN ITS VERSION, HEADER 1ST WD HAS ,,-1 +OBUFO: SAVE A + SAVE AA + AOSGE 2(C) ;WAS COUNT SOS'D FROM -1? + JRST OBUFO1 ;YES, BUFFER HADN'T BEEN INITTED, DON'T WRITE IT. + MOVN A,1(C) + ADD A,(C) ;RH(A) HAS -<# WDS USED IN BUFFER>. + MOVSI A,(A) + HRR A,(C) + AOS A ;A HAS AOBJN -> USED PART OF BUFFER. + HLLZ AA,C + IOR AA,[.IOT A] + SKIPGE A + XCT AA ;WRITE IT IN FILE. +OBUFO1: MOVE A,1(C) + HRR A,(C) ;POSITION THE B.P. BEFORE START OF BUFFER, + TLZ A,770000 ;AFTER LAST BYTE IN WD (IDPB WILL USE 1ST BUFFER WD) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ;SET UP BYTE COUNT. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ;IF OUTPUT DEVICE NOT PTP, + POPJ P, ;THEN DO NOTHING + PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER, +TFEED1: .FEED UTYOC, ;FEED A LINE, + TLZA FF,FLPTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL + SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES, + POPJ P, ;AND RETURN + +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ;IF NOT YET PURIFIED, ASSUME BEING DEBUGGED. + .VALUE +] + .LOGOUT ;COME HERE TO COMMIT SUICIDE. + .BREAK 16,160000 + +A.SITE: CALL AGETFD ;.SITE N, RETURNS NTH WORD OF SIXBIT MACHINE NAME. + CAIE A,0 ;ON ITS, ONLY WORD 0 IS NONZERO. IT'S THE "MACHINE NAME". + JRST CABPOP + SYSCAL SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A] + .LOSE 1000 + JRST CLBPOP +] ;END IFN ITSSW + +OINITL: IFN ITSSW,[ + HLLZ A,@(P) ;GET CHNL NUM, + TLZ A,777037 ;MASK TO JUST AC FIELD (CHNL NUM) + IOR A,[.STATUS A] + XCT A ;READ ITS STATUS, +] + PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE, + TYPR OINITS + PUSHJ P,GTYIP ;GET TYPEIN + HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES. + PUSHJ P,A.IMP1 + PUSHJ P,RFD ;GET NEW FILE DESCRIPTION + HRRZ A,@(P) ;GET NAME BLOCK ADDR, + MOVEI B,3(A) + HRLI A,DNAM ;COPY NAMES JUST READ INTO IT. + BLT A,(B) + JRST OINIT + +OINITS: ASCIZ/Use what filename instead? / + +IFN DECSW,[ +OINIT: MOVE AA,(P) + MOVS A,(AA) ;GET NAME-BLOCK ADDR IN LH, + HRLZ TT,A ;GET CHNL NUM IN LH. + TLZ TT,#(0 17,) ;MASK TO AC FIELD (CHANNEL NUM) + HRRI A,DNAM + BLT A,SNAM ;COPY NAMES INTO DNAM THRU SNAM. + HRRZ D,2(AA) ;GET BUFFER SPACE ADDR. + HLLZ C,2(AA) ;GET HEADER ADDR. + HLRZ A,C + SETZM (A) ;CLEAR OUT ITS-VERSION CONTENTS OF 1ST HEADER WD. + LDB A,[331100,,(AA)] ;GET MODE TO OPEN IN (WILL BE ASCII OR IMAGE BINARY) + CALL OPNRD2 ;DO OPEN. + JRST OINITL +IFE SAILSW,[SAVE .JBFF + MOVEM D,.JBFF] +.ELSE [SAVE JOBFF + MOVEM D,JOBFF] + XOR TT,[#] + XCT TT +IFE SAILSW,REST .JBFF +.ELSE REST JOBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ;GET JOB NUMBER, TO MAKE SIXBIT /MD/ + JFCL ;CAN IT SKIP? + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ;PUT THE DIGITS OF THE JOB NUMBER INTO THE SIXBIT WORD. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ;GET 1ST CHAR OF 'OUTPUT, 'LSTOUT, 'CRFOUT, 'ERROUT. + IOR A,B ;USE IT AS LAST CHAR OF TEMP FILE NAME. + MOVSI B,'TMP + SETZ C, + MOVE D,SNAM + XOR TT,[#] + XCT TT ;DO ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. +OCLOSE: MOVE AA,1(A) ;NAME BLOCK ADDR. + SKIPGE FATAL + JRST OCLOS2 + MOVE C,(AA) ;DELETE ANY FILE WITH NAMES + SETZB B,D ;WE WANT TO RENAME TO. + OPEN ERRC,B + JRST OCLOS1 + MOVE B,1(AA) + HLLZ C,2(AA) + SETZ D, + MOVE T,3(AA) + LOOKUP ERRC,B + JRST OCLOS1 ;THERE IS NONE, JUST RENAME. + SETZ B, + MOVE T,3(AA) + RENAME ERRC,B + JFCL + RELEAS ERRC, +OCLOS1: MOVE B,1(AA) ;DESIRED FN1. + HLLZ C,2(AA) ;DESIRED FN2. + SETZ D, + MOVE T,3(AA) ;SNAME (THAT IS, PPN) + HLLZ AA,(A) ;GET JUST CHNL NUM. + IOR AA,[CLOSE] + XCT AA + XOR AA,[CLOSE#] + XCT AA + JFCL +OCLOS2: HLLZ B,(A) ;GET CHNL IN AC FIELD. + IOR B,[RELEAS] + XCT B + JRST 2(A) + +;WRITE OUT BUFFER OF OUTPUT FILE, C HAS <0 CHNL,HEADER> +OBUFO: AND C,[0 17,] ;GET JUST CHNL NUM. + TLO C,(OUT) + XCT C + RET + SAVE A ;ERROR RETURN FROM OUT UUO. + XOR C,[OUT#] + XCT C ;READ FILE STATUS. + TRZ A,74^4 ;CLEAR ERROR BITS. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + +TFEED: RET + +TSRETN: MOVE C,[SIXBIT /MIDAS/] + SKIPE MORJCL + JRST RFDRUN + EXIT + +A.SITE: +IFE SAILSW,[ + CALL AGETFD ;.SITE ON DEC SYSTEM; VALUE HAS BEEN PRECOMPUTED NTO V.SITE. + CAIL A, + CAIL A,5 + JRST CABPOP + MOVE A,V.SITE(A) + JRST CLBPOP +];END IFE SAILSW +.ELSE JRST CABPOP ;SAIL DOESN'T HAVE GETTAB USED IN SETTING UP V.SITE. + +;DEVICE NAME IN B, MODE IN A, +;HEADER ADDR IN C, BUFFER SPACE ADDR IN D, +;CREAT DEC-STYLE BUFFER RING LEAVING 1 WD BETWEEN BUFFERS. +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[204] ;DEFAULT BUFFER SIZE IS THAT FOR DSK. + AOJLE AA,.-1 ;GET SIZE INCLUDING EXTRA WD. + MOVEI T,1(D) ;ADDR OF WD 2 OF 1ST BUFFER. + HRLI AA,T ;@AA IS ADDR OF 2ND WD OF NEXT BUFFER. + SUBI D,(AA) ;FACILITATE TEST FOR END OF BUFFER SPACE. + HRLI T,400000 + MOVEM T,(C) ;HEADER -> A BUFFER, SIGN SET. + HRRM T,1(C) ;MAKE RH OF BP -> BUFFER 1ST WD. + MOVSI T,440000 ;SET UP P-FIELD OF B.P. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ;DATA-AREA-SIZE +1,,ADDR-OF-2ND-WD +BUFIN1: CAIGE D,-410(T) ;ROOM FOR ANOTHER AFTER THIS BUFFER? + JRST BUFIN2 ;NO, ASSUMING 410 WDS BUFFERRrSPACE. + MOVEM T,@AA ;YES, MAKE NEXT BUFFER -> THIS ONE, + HRRI T,@AA ;POINT TO NEXT ONE. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ;-> 2ND WD OF 1ST BUFFER. + MOVEM T,(D) ;1ST BUFFER -> LAST, MAKING RING. + RET + +;CLOSE ALL INPUT CHANNELS - EQUIVALENT TO ITS .IOPDL. +$IOPDL: MOVEI A,UTYIC + EXCH A,UTICHN ;SET INPUT CHNL NUM. TO LOWEST. + LSH A,27 + IOR A,[RELEAS] ;SET UP TO RELEAS THE HIGHEST IN USE FIRST. +IOPDL1: XCT A ;RELEAS ONE INPUT CHANNEL, + CAMN A,[RELEAS UTYIC,] + RET ;ALL DONE. + SUB A,[0 1,] + JRST IOPDL1 ;RELEAS THE NEXT ONE DOWN. + +.IOPDL==CALL $IOPDL +] ;END IFNN DECSW, + + ;TS INPUT ROUTINES + + ;OPEN MAIN INPUT FILE FOR READING + +OPNRD: .IOPDL ;RE-INITIALIZE IO PDL + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ;INITIALIZE "TTY PDL" + PUSHJ P,MACIN1 ;CLOBBER MACRO EXPANSION STATUS + MOVS A,IFDS ;GET DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST OPNRDT ;YES, TREAT SPECIAL + MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE + PUSHJ P,A.IMP1 ;SET UP DNAM, ETC. + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST OPNRDL ;LOSE + MOVEM A,INFERR ;ERR MSG IN MAIN FILE SHOULDN'T TYPE NAMES. + MOVEI A,0 ;=> INPUT FROM FILE +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2 + SETOM NEDCRL + JRST RCHSET ;SET UP TO READ FROM FILE OR TTY. (ARG IN A) + +OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL + BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED + TYPR [ASCIZ /Reading from TTY: +/] + MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR + JRST OPNRT2 + +OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE + JRST GO2A ;READ NEW COMMAND + + +;COMMON STUFF FOR OPNRD1 IN DEC AND ITS VERSIONS. +OPNRD3: HRRZM A,UTIBED ;SAY BUFFER EMPTY, + MOVSI A,^C_13 + MOVEM A,@UTIBED ;CAUSE IMMEDIATE RELOAD. + MOVE A,[INFDEV+1,,IFNM1] + BLT A,IFNM2 ;SET UP .IFNM1, .IFNM2. + AOS A,INFCNT ;ASSIGN THIS FILE A NUMBER. + MOVEM A,INFCUR ;OPNRD EXPECTS THIS LEFT IN A. + JRST POPJ1 + + ;EOF WHILE TRYING TO READ CHARACTER + +RPAEOF: PUSH P,B ;SAVE B +RPAEO1: MOVE B,ITTYP ;GET PDL POINTER + PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT) + JRST RCHTRB ;RETURN TO GET CHARACTER + + ;EOF FROM MAIN FILE + +NEDCHK: TRNE FF,FRCMND ;^C READ IN COMMANND, :KILL SELF. + JRST TSRETN + SKIPE RCHMOD + JRST NEDCH1 + AOSN NEDCRL ;INVENT ONE CRLF AFTER END OF MAIN FILE. + JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? ^C]] + MOVEM B,UREDP + RET] +NEDCH1: +IFN A1PSW,[ PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT + AOBJN A,.-1 + JUMPGE A,GO4 +] + ETF [ASCIZ /No END statement/] + +IFN A1PSW,[ ;HOLLER "NED" IF ANY OF THE FOLLOWING: +NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED + SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT + SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE + TRNN FF,FRPSS2 ;CURRENTLY IN PASS 2 +LNEDT==.-NEDT ;LENGTH OF TABLE +] + +IFN ITSSW,[ + ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL + +OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL. + .CALL OPENB + JRST OPNRD2 ;CAN'T OPEN INPUT FILE. + MOVE AA,[UTYIC,,A] + .RCHST AA, + SKIPN B ;GET SYSTEM FILE NAME 1 + MOVE B,FNAM1 ;SYSTEM DOESN'T KNOW, USE SPEC'D. + SKIPN C ;NOW SAME FOR FN2. + MOVE C,FNAM2 + MOVE AA,[A,,INFDEV] + BLT AA,INFDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE. + HRLZS INFDEV ;MAKE THE DEV NAME BE LEFT-JUST. + MOVE A,IUREDP ;SET UP READING PTR, + MOVEM A,UREDP + JRST OPNRD3 ;SET UP ^C AFTER BUFFER, INFCUR, ETC. + +OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP + POPJ P, + +OPENB: SETZ ? SIXBIT/OPEN/ + A ;SHOULD HOLD MODE,,CHANNEL. + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + +IUREDP: 440700,,UTIBUF + + ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR + +INCHR3: HRRZ A,UREDP ;GET BYTE POINTER + CAME A,UTIBED ;END OF COMPLETELY READ BLOCK? + JRST RPAEOF ;NO => REALLY EOF + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ;READ IN BLOCK + TLZ A,377777 ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS + MOVEM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ;STORE EOF WORD + JRST RCHTRA ;NOW TRY NEXT CHAR +] ;END IFN ITSSW + +IFN DECSW,[ +OPNRD1: MOVEI C,UTIHDR ;OPEN THE INPUT FILE W/ NAMES IN DNAM ... SNAM. + SETZ A, ;MODE ASCII. + MOVEI D,UTIBUF + MOVE TT,UTICHN ;GET CHANNEL NUM. TO USE. + LSH TT,27 ;PUT IN AC FIELD. + CALL OPNRD2 ;DO OPEN. + RET ;FAILED. + CALL BUFINI ;INITIALIZE THE INPUT BUFFERS AND HEADER. + MOVE D,SNAM + MOVE A,FNAM1 + HLLZ B,FNAM2 + TLC TT,(OPEN#LOOKUP) + XCT TT ;LOOKUP CHANNEL,A + RET ;FAILED. +IFE SAILSW,[ + MOVE A,DNAM + DEVNAM A, ;GET REAL NAME OF DEVICE. + CAIA + MOVEM A,DNAM +] + MOVE A,[DNAM,,INFDEV] + BLT A,INFDEV+3 + MOVE A,UREDP + JRST OPNRD3 + +;TAKE C -> HEADER, D -> BUFFER SPACE, A HAS MODE, TT HAS CHNL IN AC FLD. +;OPEN FILE IN DNAM ... SNAM, INIT BUFFERS, +;THEN SET UP FOR LOOKUP OR ENTER. +;SKIP IF SUCCEED. +OPNRD2: IOR TT,[OPEN A] + MOVE B,DNAM + XCT TT ;OPEN CHANNEL,A + RET + JRST POPJ1 + +;RELOAD BUFFER, DEC STYLE. +INCHR3: HRRZ A,UREDP ;EOF AT END OF BUFFER? + CAME A,UTIBED + JRST RPAEOF ;NO, EOF, ^C IN FILE. + SAVE B + MOVE A,UTICHN + LSH A,27 ;CHANNEL NUM. N AC FLD. + TLO A,(IN) + XCT A ;GET NEXT BUFFERFULL. + CAIA ;SUCCEED. + JRST INCHR4 ;ERROR. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ;-> 1ST WD NOT READ INTO. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ;SCAN THE FILE AND REPLACE ALL LINE NUMBERS WITH NULLS. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,^C_13 + MOVEM B,(A) ;PUT EOF CHAR AFTER BUFFER. + JRST RCHTRB ;RETRY RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ;CLEAR ERROR BITS IN STATUS. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ;EOF. +] ;END IFN DECSW, + + ;IO PDL ROUTINES FOR INPUT FILE + ;PUSH THE INPUT FILE + +IPUSH: AOSN CMEOF ;WANT TO POP OUT OF TTY? (^C TYPED IN) + CALL POPTT ;YES, DO NOW BEFORE FORGET. + MOVE D,UREDP ;GET INPUT BYTE POINTER +IFN ITSSW,[ + .IOPUS UTYIC, + TLNN D,760000 ;AT END OF WORD? + ADD D,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ;GET # WDS WE'LL NEED IN MACTAB. + HLR D,UTIBED ;REMEMBER WHETHER EOF ON LAST .IOT. + HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING +] +IFN DECSW,[ + AOS A,UTICHN ;DO ".IOPUSH" - USE NEXT CHANNEL. + LSH A,27 + ADD A,[WAIT-<0 1,>] + XCT A ;DON'T MOVE BUFFERS WHILE IO GOING ON! + MOVEI A,UTIBFL+2 ;ASSUME MUST SAVE ALL BUFFER SPACE. +] + SAVE A + ADD A,FREPTB + ANDI A,-1 + CAML A,MACTND ;NO ROOM IN MACTAB => GC IT. + CALL GCA1 + MOVEI A,370 + CALL PUTREL ;INDICATE START OF SAVED BUFFER. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ;GET ADDR OF TTY PDL WD THAT'LL POINT TO SAVED BUFFER. + ADDI C,1 + HRRZM C,(B) ;STORE IN RH OF 1ST WD, + MOVEI C,(B) ;REMEMBER ADDR OF SAVED BUFFER TO PUSH ON TTYPDL. + HRLM A,(B) ;PUT LENGTH IN LH. + AOS B +IFN ITSSW,HRL B,UREDP ;ILH _ ADDR OF 1ST WD TO SAVE. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ;ADDR OF LAST WD TO BLT INTO. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ;MAKE FREE BP -> LAST BYTE JUST USED. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ;GET CHAR ADDR OF NEXT FREE BYTE. + MOVEM A,FREEPT + MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL +IPSHP: PUSH B,C ;PUSH -> SAVED BUFFER (GC WILL RELOCATE) +IFN DECSW,PUSH B,UTIBED +IFN DECSW,PUSH B,UTIHDR +REPEAT 4,PUSH B,INFDEV+.RPCNT ;SAVE NAMES OF INPUT FILE. + PUSH B,INFCUR ;SAVE NUMBER OF INPUT FILE. + PUSH B,D ;LH=LH(OLD UREDP), RH=LH(OLD UTIBED) + ;FOLLOWING TWO MUST BE LAST PUSHED + INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL +INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL + MOVE A,FREEPT ;W MUST USE SAME GC CONVENTION AS PUTREL; + CAML A,MACHI ;NAMELY, GC AFTER USING UP THE LAST BYTE. + CALL GCA1 + MOVEI A,0 ;=> INPUT FROM FILE + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN + ;POP INTO THE INPUT FILE +IPOP: +IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED. + SAVE C + MOVE B,ITTYP ;GET POINTER + INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF + POP B,INFCUR +REPEAT 4,POP B,INFDEV+3-.RPCNT +IFN DECSW,[ + POP B,C + SAVE C ;OLD UTIHDR + POP B,UTIBED +] + POP B,C + MOVEM B,ITTYP ;SAVED UPDATED PDL POINTERR. + HLRZ B,(C) ;GET LENGTH OF SAVED BUFFER, +IFN ITSSW,[ + SAVE A + CALL SETWH2 + REST A + .IOPOP UTYIC, + MOVEI AA,UTIBUF-1(B) ;GET ADDR OF 1ST WD WON'T BLT INTO IN UTIBUF, + HRLI AA,(A) ;GET SAVED LH OF UTIBED, + MOVEM AA,UTIBED + HRRI A,UTIBUF ;MAKE A -> 1ST WD IN BUFFER, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ;THIS CODE EQUIVALENT TO .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,^C_13 + MOVEM A,@UTIBED ;PUT EOF CHAR AFTER BUFFER. + MOVSI A,1(C) ;GET ADDR OF 1ST DATA WD OF SAVED BUFFER, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ;TELL GC TO RECLAIM SAVED BUFFER. +POPCJ: REST C + RET + + ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ;IF SUPPOSED TO POP OUT OF TTY SOON, + CALL POPTT ;DO IT NOW BEFORE CMEOF CLOBBERED. + MOVE F,ITTYP ;GET RELEVANT PDL POINTER + MOVEI A,0 + EXCH A,CLNN ;SET UP NEW LINE NUMBER + HRL A,CPGN ;SAVE CURRENT PAGE NUMBER + SETZM CPGN ;NOW RE-INITIALIZE + SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG. + TLO A,400000 + PUSH F,A ;SAVE CPGN,,CLNN + MOVE A,-1(P) ;RETRIEVE NEW MODE + PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET PDL POINTER + PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE + POP F,A ;GET CPGN,,CLNN + SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFFN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + + ;TTY ROUTINES + + ;CAUSE INPUT FROM TTY (MAIN ROUTINES) + +GTYIPA: ;PUSH TO TTY, DON'T STO@ AT CR. + SETZM A.TTYF +IFN ITSSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^C +/] ] +.ELSE [ IFE SAILSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^Z +/] ] + .ELSE [ TYPR [ASCIZ /TTY: .INSRTed, end input with CTL-META-LF +/] ]] +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ;INPUT FROM TTY, STOP AFTER 1 LINE. + SETZM CMPTR ;FORCE RELOAD ON 1ST READ. + JSP B,PUSHTT ;SET UP VARIABLES AND RETURN +GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR + JRST POPTT + +;CALL HERE FROM ASSEM1 LOOP WHEN A ^H INTERRUPT IS DETECTED. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ;TYPE FILENAME, PAGE AND LINE #. + SKIPE ASMOUT + TYPR [ASCIZ/within a <>, () or [] +/] + JRST GTYIPA + + ;RCHSET ROUTINES FOR READING FROM TTY + ;RCHMOD=3 => DON'T QUIT ON CR + ;2 => QUIT ON CR. + +RCHTRC: +RCHARC: TLO FF,FLTTY ;SET FLAG + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ;RCH2, RR1 + ILDB A,CMPTR ;GET CHAR + CAIN A,0 ;END OF STRING MARKED WITH 0 + PUSHJ P,TYRLDR ;RELOAD, JUMP BACK FOR NEXT CHAR +] + HALT ;RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ;SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ;RETURN AFTER THE CALL, NOT BEFORE. + ADDM A,(P) + + ;READ IN STRING + +;RELOAD BUFFER IF RAN OUT IN CALL TO RCH. +TYRLDR: AOSN CMEOF ;EOF DETECTED AFTER LAST RELOAD => + JRST RPAEOF ;POP OUT OF TTY. + SAVE A + SAVE B + MOVE B,RCHMOD + PUSH P,F + SAVE A.TTYF ;IF CHARS RUBBED OUT THEY SHOULD BE PRINTED. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER + MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ +TYRLD2: PUSHJ P,TYI ;GET CHARACTER + CAIN A,177 ;RUBOUT? + JRST TYRLD3 ;YES + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ;^C, ^Z => EOF. + CAIN A,^U + JRST TYRLD5 ;RUB OUT ALL + CAIE B,2 ;FOR .TTYMAC HANDLING, CONVERT LOWER CASE TO UPPER. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: IDPB A,F ;STORE CHARACTER IN BUFFER + CAIE A,^M ;CR? + JRST TYRLD2 ;NO, GO BACK FOR NEXT + CAIN B,2 ;.TTYMAC (MODE 2) => CR ENDS INPUT, SO FAKE EOF. + SETOM CMEOF + MOVEI A,^J ;FOLLOW THE CR WITH A LF. + IDPB A,F + SAVE F ;OUTPUT THE ENTIRE LINE TO THE ERROR FILE + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ;IF LINE WAS ENDED BY A ^C OR ^Z, PUT THAT IN ERROR + SKIPL CMEOF ;FILE, WHICH NEEDS HAIR SINCE THAT CHAR IS NOT + JRST TYRLD0 ;IN THE STRING WE STORED. + MOVEI A,"^ + CALL ERRCHR + MOVEI A,IFN DECSW,["Z] .ELSE "C + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ;MARK END OF STRING + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ;^C, ^Z FORCE EOF, + CALL TYRLCR ;AFTER TURNING INTO ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER? + JRST TYRLD4 ;YES + LDB A,F ;GET LAST CHARACTER IN BUFFER + CALL TYOX ;TYPE IT OUT, DON'T WRITE IN ERROR FILE. + ADD F,[70000,,] ;DECREMENT POINTER + JUMPGE F,TYRLD2 ;JUMP IF VALID + SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ;^U, BACK TO BEGINNING OF LINE +TYRLD4: PUSHJ P,TYRLCR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR + JRST TYRLD2 + +IFN ITSSW,[ ;GET (JUST TYPED IN) CHAR IN A +OUTCHR==.IOT TYOC, + +TYI: SKIPN TTYOP + CALL TTYINI ;OPEN THE TTY IF NOT ALREADY DONE. + .IOT TYIC,A + JUMPE A,TYI + CAIN A,^L + JRST TYI + POPJ P, + + ;INITIALIZE TTY + +TTYINI: SAVE A + .OPEN TYIC,[SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER + .LOSE + .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ;TTY: IS TRANSLATED TO SOMETHING ELSE => ASSUME INFINITE LINEL + MOVEM A,LINEL ;ELSE LINEL GETS WIDTH OF TTY. + SETOM TTYOP ;SAY THE TTY IS NOW OPEN. + JRST POPAJ + +JCLINI: .SUSET [.ROPTIO,,A] + TLNN A,40000 ;HAS OUR SUPERIUOR SAID IT HAS A CMD? + RET ;NO. + MOVE A,[CMBUF,,CMBUF+1] + BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD, + MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD. + .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ;IF READ A CMD-STRING, + MOVEM A,CMPTR ;TELL TYRLD, GO2 IT'S THERE. + POPJ P, + +;JRST HERE FROM TSINT FOR 2ND WD INTERRUPTS. +TTYINT: SAVE A + MOVEI A,TYIC ;THE TTY CHNL IS THE ONLY ONE ENABLED. + .ITYIC A, + JRST TTYINX ;NO INT. CHAR. + CAIN A,^W + AOS A,TTYFLG ;^W SILENCES, + CAIN A,^V + SOS A,TTYFLG ;^V UNSILENCES, + CAIN A,^H + SETOM TTYBRF ;^H SAYS BREAK NEXT TIME THRU ASSEM1 LOOP. +TTYINX: REST A + .DISMIS .JBTPC +] ;END IFN ITSSW + +IFN DECSW,[ +TYI: SKIPN TTYOP ;OPEN THE TTY, IF NOT ALREADY DONE. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ;SAIL => EOF IS 612. SO TURN INTO NORMAL EOF. + MOVEI A,^Z +] + CAIE A,^M ;THROW AWAY THE LF AFTER A CR + RET + INCHWL A + MOVEI A,^M ;NOTE THAT TYRLDR WILL PUT IT BACK IN. + RET + +TTYINI: OPEN TTYINB + JRST TTYINI + INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ;.TOWID + MOVE B,[2,,AA] + TRMOP. B, ;READ WIDTH OF TTY LINE INTO B. +] +TTYIN1: MOVEI B,80. ;TRMOP. FAILED OR NOT TRIED => ASSUME WIDTH IS 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOP + RET + +TTYINB: 1 + 'TTY,, + 0 + +TTYREN: IFE SAILSW,LOC .JBREN +.ELSE LOC JOBREN +TTYREN +LOC TTYREN + SETOM TTYBRF ;"REENTER" COMMAND COMES HERE +R: G: IFE SAILSW,JRST @.JBOPC ;TO REQUEST A ^H-BREAK. +.ELSE JRST @JOBOPC +] + +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX +ERRCHR: IFN ERRSW,[ + SKIPN ERRFOP ;OUTPUT CHAR IN A TO ERROR FILE IF ONE IS OPEN. + RET + SOSGE ERRCNT + JRST ERRCH1 ;OUTPUT BUFFER. + IDPB A,ERRPNT + RET + +ERRCH1: SAVE C + MOVE C,[0 ERRFC,ERRHDR] + CALL OBUFO + REST C + JRST ERRCHR +]IFE ERRSW,RET + +TYOX: SKIPN TTYOP + CALL TTYINI + OUTCHR A + RET + +IFN DECSW,[ + +JCLINI: SKIPN CCLFLG ; WAS MIDAS CALLED FROM CCL LEVEL? + RET ; NO, DO NOT SNARF TEMPCORE + SETZM CCLFLG ; IF TMPCOR LOSES WANT THIS 0 (WILL RE-SETOM BELOW) + SETZM CMBUF ; ZERO FIRST COMMAND WORD + MOVE A,[CMBUF,,CMBUF+1] ; LOAD BLT POINTER + BLT A,CMBUF+CMBFL-2 ; ZERO ALL BUT LAST WORD + MOVEM A,CMBUF+CMBFL-1 ; NON-ZERO LAST WORD + MOVE A,[2,,['MID,, ? -CMBFL,,CMBUF-1]] + TMPCOR A, ; READ COMPIL-GENERATED COMMAND + RET ; NO COMMAND, PUNT + MOVE A,[440700,,CMBUF] ; LOAD A BYTE POINTER TO THE COMMAND + SKIPN CMBUF ; ONE LAST CHECK FOR IT TO BE THERE + RET ; ALAS, THERE IS NONE + SETOM CCLFLG + MOVEM A,CMPTR ; THERE IS, SET COMMAND POINTER + SAVE B +JCLIN1: ILDB B,A + CAIE B,^J ;SEE IF OUR COMMAND FILE HAS ANYTHING AFTER 1ST LINE. + JRST JCLIN1 + ILDB B,A + JUMPE B,POPBJ + SETOM MORJCL ;IT DOES; SET FLAG SO AFTER HANDLING 1ST LINE WE'LL + SAVE C + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ;GET # WORDS WRITTEN IN UTIBUF. OPERAND IS RELOCATABLE! + HRLOI C,-1(C) ;THESE 2 INSNS TURN SIZE INTO -SIZE,,UTIBUF+1 + EQVI C,UTIBUF+1 + MOVEM C,(C) + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL + REST C + REST B + RET +];END IFN DECSW + + ;TS DATA STORAGE + +VBLK + +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE + ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED) + +ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY) +TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE + BLOCK TYPDLS ;PDL PROPER + + ;INPUT BUFFER AND VARIABLES + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ;INPUT BUFFER HEADER (DEC VERSION) +UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER +UTICNT: 0 ;INPUT BYTE COUNT (DEC VERSION) +UTIBED: UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT +IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES +IFN DECSW,UTICHN: UTYIC + + ;FILE DESCRIPTION STORAGE + +INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE +FDSBEG==. ;BEGINNING OF TABLE AREA +DNAM: 0 ;DEVICE NAME +FNAM1: 0 ;FILE NAME 1 +FNAM2: 0 ;" " 2 +SNAM: 0 ;SYSTEM NAME +LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY +IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE + 0 ;FOR .FDELE AT .FILE TIME +ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED +OFNM1==ONAM+1 +OFNM2==ONAM+2 +OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME +IFN CREFSW,[ 0 +CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2. +CRFSNM: 0 ;CREF SNAME. +] +IFN ERRSW,ERRDEV: BLOCK 4 ;ERROR OUTPUT FILE NAMES. +IFN LISTSW,[ +LSTDEV: BLOCK 3 ;LISTING FILE NAMES. +LSTSNM: 0 +] +FNMEND:: +INFDEV: 0 +INFFN1: BLOCK 3 ;FILENAMES OF INPUT FILE BEING READ NOW. +INFCNT: 0 ;# INPUT FILE OPENED. +INFCUR: 0 ;WHAT INFCNT WAS WHEN CURRENT FILE OPENED. +INFERR: 0 ;WHAT INFCUR HELD AT LAST ERROR MSG. +FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA + BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S) +SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES + BLOCK LFDSE*MAXIND ;STORAGE FOR " + +RFNAM1: 0 ;.FNAM1 +RFNAM2: 0 +IFNM1: 0 ;.IFNM1 +IFNM2: 0 +RSYSNM: 0 ;INITIAL SYSTEM NAME + +IFN CMUSW, PPNBUF: BLOCK 4 ;FOR CONVERTING CMU PPNs + +IFN DECSW,IFE SAILSW, V.SITE: BLOCK 5 ;SYSTEM NAME IN SIXBIT, FOR .SITE. + + ;TTY VARIABLES + +CMBUF: BLOCK CMBFL ;TYPEIN BUFFER +CMPTR: 0 ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0. +CMEOF: 0 ;-1 => POPTT INSTEAD RELOAD AFTER THIS BUFFERFULL. +IFN DECSW,MORJCL: 0 ;-1 => THERE ARE MORE LINES OF CCL COMMANDS + ;SO DO A RUN SYS:MIDAS WHEN FINISHED. +TTYOP: 0 ;-1 => THE TTY IS ALREADY OPEN. +LINEL: 0 ;WIDTH OF TTY (MAY BE 1,, MEANING ASSUME INFINITE). +A.TTYFLG: ;VALUE OF .TTYFLG: +TTYFLG: 0 ;TTY TYPEOUT PERMITTED IFF >= 0. +WSWCNT: 0 ;THE NUMBER OF W-SWITCHES IN THE LAST CMD STRING. +TTYBRF: 0 ;-1 => ^H BREAK HAS BEEN REQUESTED BUT NOT DONE. +FATAL: 0 ;AT END OF ASSEMBLY, NOT 0 IFF FATAL ERROR OCCURRED. +NEDCRL: 0 ;-1 => HAVEN'T YET SUPPLIED A CRLF AT EOF OF MAIN FILE. +NVRRUN: -1 ;0 => MIDAS WAS RUN; ERROR TO START OR PURIFY. + + ;OPNER VARIABLES + +ERRDNM: (SIXBIT /ERR/) + 3 +ERRNM2: 0 ;.STATUS WORD + +IFN ITSSW,OCLOSP: @1(C) ;TURNED INTO BP TO UNUSED PART OF LAST BFFER WD USED. + + ;OUTPUT VARIABLES + +UTOBUF: BLOCK UTOBFL ;OUTPUT BUFFER +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ;OUTPUT (36. BIT) BYTE POINTER +UTYOCT: 0 ;# WORDS LEFT IN UTOBUF + +IFN CREFSW,[ ;CREF OUTPUT VARS. +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ;HEADER, ASSEMBLED VALUE USED ONLY IFN ITSSW +CRFPTR: 444400,, ;BP FOR FILLING BUFFER +CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER +] + +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPNT: 440700,, +ERRCNT: 0 +ERRFP: 0 ;NON-0 IF WANT ERROR OUTPUT FILE. +ERRFOP: 0 ;NON-0 IF ERROR FILE OPEN (IE TRY OUTPUTTING TO IT) +] +PBLK + + ;.INSRT FILEDESCRIPTION + ;INSERT FILE HERE + ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE + ;PUSHES MACRO EXPANSION, OTHER .INSRT'S + ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER + +A.INSR: NOVAL + MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES + PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES + MOVSI A,(SIXBIT /DSK/) + MOVS B,DNAM + CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY, + MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD +IFN ITSSW,MOVSI A,(SIXBIT/>/) +IFN DECSW,MOVSI A,'MID + MOVEM A,FNAM2 ;USE > AS THE DEFAULT FN2. + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + PUSHJ P,A.ITRY ;NO, TRY OPENING FILE + MOVE A,DNAM(F) + AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY + SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE +A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH + CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE + JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE + MOVE A,F ;-> SFSFDS + MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT + MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY + CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED + AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY + JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE + ;FILE IS IN TABLE + PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY + PUSHJ P,A.ITRY ;TRY OPENING FILE + MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER), + PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES + PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES + TYPR [ASCIZ / -> /] ;TYPE OUT POINTER + PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE + SETOM DNAM(F) ;"HALF-KILL" ENTRY +A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF +A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY + JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN + + ;FILE NOT IN TABLE + +A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE? + ETF [ASCIZ /Too many @: files/] + MOVEI A,SFSFDS(F) + HRLI A,DNAM + BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY + SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION + MOVNI A,-LFDSE + ADDM A,INDDP ;UPDATE POINTER INTO TABLE + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY + MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME + MOVEM A,DNAM + JRST A.INT2 + + ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST A.ITRT ;YES, TREAT SPECIAL + TLO FF,FLUNRD + PUSHJ P,IPUSH ;SAVE CURRENT STATUS + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST IPOPL ;LOSE, POP AND RETURN +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK. + PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT IPOP) +] +A.ITR2: + MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED + AOJN A,ASSEM1 + PUSHJ P,A.OMAP ;YES, DO IT + JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL) + + ;.INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF + JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2) + + ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY) + +A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL +A.INEO: TLNE FF,FLMAC ;INPUTTING FROM MACRO? + JRST A.IEF2 ;YES, POP IT OFF + PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR + MOVE B,ITTYP ;GET PDL POINTER + POPJ B, ;RETURN TO POP ROUTINE + + ;MISC .INSRT + +A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F +A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP + BLT A,DNAM+LFDSE-1 ;DO IT + POPJ P, + +A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC. + HRLI A,DNAM + BLT A,DNAM+LFDSE-1(F) + POPJ P, + +;CALL FROM ERRH; TYPE INPUT FILE'S NAMES IF CHANGED SINCE LAST ERR MSG. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ;SAY LAST ERROR MSG IN THIS FILE. + CAMN C,INFERR ;IF PREV. MSG WAS IN OTHER FILE, + POPJ P, + MOVE C,[-4+DECSW,,INFDEV-DNAM] + PUSHJ P,TYPF1 ;TYPE THIS FILE'S NAMES. + JRST CRRERR + + ;MISC TS + +IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT + TYPR OINITS + RET + + ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION + +TYPFIL: MOVSI C,-4+DECSW +TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME + PUSHJ P,SIXTYO ;TYPE OUT NAME + HLRZ A,C + MOVE A,FILSPC+4-DECSW(A) ;NOW GET DELIMITING CHARACTER + PUSHJ P,TYOERR ;TYPE OUT + AOBJN C,TYPF1 ;LOOP FOR ALL NAMES +IFN ITSSW, POPJ P, +.ELSE,[ SKIPN B,DNAM(C) ;ON DEC SYSTEM PPN IS A SPECIAL CASE + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + MOVEI B,PPNBUF + PUSHJ P,TYPR3 + JRST PPNRB +];IFN CMUSW +IFE SAILSW,[ +OCTPPN: HLRZ B,DNAM(C) ;LH IS PROJ, + CALL OCTPNT +] +.ELSE [ HLLZ B,DNAM(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,DNAM(C) + CALL OCTPNT ;RH IS PROG. +] +.ELSE [ HRLZ B,DNAM(C) + CALL SIXTYO +] +PPNRB: ;[ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + + ;OPENLOSS DOCUMENTATION ROUTINE +IOPNER: MOVE A,IFSTS ;INPUT +OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD + PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION + PUSHJ P,CRRERR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING +IFN DECSW,[ + TYPR [ASCIZ/OPEN failed/] + JRST CRRERR +] +IFN ITSSW,[ + .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG + .VALUE ;CAN'T OPEN ERR DEVICE? +IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM + CAIN A,14 ;ENDS WITH FORM FEED + POPJ P, + PUSHJ P,TYOERR ;TYPE OUT CHARACTER + JRST IOPNR2 ;LOOP BACK FOR NEXT +] ;END IFN ITSSW + +;READ SINGLE FILE DESCRIPTION INTO DNAM ... SNAM . +;FRNNUL 1 IFF SPEC WAS NONNULL. +;FRMRGO 1 IFF "." WAS SEEN IN DEC VERSION - FORCE NULL FN2. +;FRCMND 1 IFF SHOULD RECOGNIZE -, COMMA, / AND ( AS SPECIAL CHARACTERS. +RFD: TRZ FF,FRNNUL+FRMRGO +RFD8: SETZ D, ;D COUNTS FILENAMES. 0 BEFORE 1ST. +RFD1: MOVEI C,0 ;INITIALIZE SIXBIT NAME. + MOVE B,[440600,,C] ;SET UP BP FOR INPUT +RFD2: PUSHJ P,RCH ;GET CHARACTER IN A + CAIN A,": ;IF COLON... + JRST RFDCOL ;THEN PROCESS AS SUCH + CAIN A,"; ;SIMILARLY FOR SEMICOLON + JRST RFDSEM +IFN DECSW,[ + CAIN A,"! ; FOO! MEANS RUN SYS:FOO WITH OFFSET 1 + JRST RFDRUN +] + CAIN A,^Q ;IF CONTROL Q... + JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL + TRNN FF,FRCMND ;IF READING COMMAND, _, COMMA, / AND ( ARE SPECIAL. + JRST RFD3 + CAIN A,"( + JRST CMDSW ;READ SWITCHES. + CAIN A,"/ + JRST CMDSL ;READ 1 SWITCH +IFN DECSW,CAIN A,"= +.ALSO JRST RFD6 ;ON DEC SYS, "=" = "_" + CAIE A,", + CAIN A,"_ + JRST RFD6 ;COMMA AND _ END SPEC. +RFD3: +IFN DECSW,[ + CAIE A,"[ ;] + CAIN A,". ;. LIK SPACE ON DEC SYS. + JRST RFD6] + CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR) + JRST RFDC ;NO +RFD6: TRZN FF,FRMRGO ;EXCEPT AFTER ".", + JUMPE C,RFD5 ;IGNORE NULL FILENAMES + XCT RFDTAB(D) ;STORE THE NAME (MAY SKIP) + ADDI D,1 ;NEXT NAME PUT ELSEWHERE +IFN DECSW,[ + CAIN A,". + IORI FF,FRMRGO +] + TRO FF,FRNNUL ;SPEC NOT NULL. +RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS. + JRST RFD7] + CAIN A,^R ;CONTROL R, + JRST RFD8 ;RESETS FILENAME COUNT +IFN DECSW,[ + CAIN A,"= ;ON DEC SYS, "=" = "_". + MOVEI A,"_ +] + CAIN A,", + RET + CAIE A,"_ ;RETURN IF SPEC TERMINATOR, + CAIN A,^M + RET + JRST RFD1 ;ELSE NEXT NAME. + +RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER + CAIN A,15 + JRST RFD6 ;BUT NOT IF CR +RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER. + SUBI A,40 + SUBI A,40 ;CONVERT CHARACTER TO SIXBIT + TLNE B,770000 ;TOO MANY CHARACTERS? + IDPB A,B ;NO + JRST RFD2 ;LOOP + +RFDTAB: MOVEM C,FNAM1 ;1ST NAME. + MOVEM C,FNAM2 ;2ND NAME. + MOVEM C,DNAM ;3RD NAME IS DEV. + MOVEM C,SNAM ;4TH IS SNAME. + CAIA ;5TH AND ON IGNORED, DON'T INCR. D. + +RFDCOL: TRO FF,FRNNUL + JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN + MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,[ +RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME". +] +RFDSEM: TRO FF,FRNNUL + JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE + MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,[ +RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM, +IFN CMUSW, JUMPE C,RCMUPP ;AT CMU WATCH FOR OUR FUNNY PPNs + HRLM C,(P) + PUSHJ P,RFDOCT ;READ PROGRAMMER NUM. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ;READ OCTAL NUMBERS. +.ELSE RFDOCL==40 ? RFDOCH==140 ;READ SIXBIT (RIGHT-JUSTIFIED). + +RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ;EVEN IF READING SIXBIT NAMES (FOR SAIL), + CAIE A,", ;COMMA AND CLOSEBRACKET ARE STILL SPECIAL. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ;NOT OCTAL OR NOT 6BIT, RETURN. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ;[ +RCMUPP: CAIN A,"] ;WATCH OUT FOR [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ;Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ;[ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, +];IFN CMUSW +];IFN DECSW + +IFN DECSW,[ + +;PROCESS "FOO!", WHICH MEANS "RUN SYS:FOO WITH AN OFFSET OF 1". + +RFDRUN: MOVSI A,'SYS ;DEV NAME + MOVE B,C ;FN1 + SETZB C,D ;DEFAULT THE FN2. 4TH WORD NOT USED. + SETZB T,TT ;DEFAULT THE PPN (UNUSED ANYWAY). DON'T SPECIFY CORE SIZE. + MOVE AA,[1,,A] ;,,
+ JRST RFDRU1 +VBLK +RFDRU1: MOVE F,[1,,RFDRUE] + CORE F, ;FLUSH AS MUCH CORE AS POSSIBLE, SINCE RUN UUO CAN LOSE + HALT ;BECAUSE OF HOW MUCH WE HAVE. + RUN AA, + HALT +RFDRUE: + +PBLK +];END IFN DECSW, + +;COMMAND SWITCH PROCESSING. + +CMDSL: CALL RCH ;COME HERE AFTER A SLASH. READ ONE SWITCH. + CAIN A,^M + JRST RFD6 + CALL CMDSW1 + JRST RFD2 + +CMDSW: PUSHJ P,RCH + CAIN A,") + JRST RFD2 + CAIN A,^M + JRST RFD6 ;DON'T CRASH IF USER PUTS CR IN SWITCH LIST. + CALL CMDSW1 + JRST CMDSW + +CMDSW1: CAIL A,140 ;LOWER CASE TO UPPER. + SUBI A,40 + CAIN A,"T + SOS TTYINS ;COUNT # T-SWITCHES. +IFN LISTSW,[ + CAIN A,"L + JRST CMDLST +] + CAIN A,"W ;W - PREVENT TTY MESSAGES, AND RQ ERROR OUTPUT FILE IF POSSIBLE. +IFE ERRSW,AOS WSWCNT +.ELSE [ + AOSA WSWCNT + CAIN A,"E ;E - RQ ERROR LOG FILE. + SETOM ERRFP +] +IFN CREFSW,[ + CAIN A,"C ;C - RQ CREF OUTPUT. + SETOM CREFP +] + RET + +;READ COMMAND, DEFAULT FILENAMES. +CMD: SKIPN CMPTR + CALL CRR + SKIPN CMPTR ;UNLESS HAVE DDT COMMAND STRING, PROMPT. +CMDB: TYPR [ASCIZ/*/] + MOVEI A,3 ;READ FROM TTY (OR STRING <- CMPTR) + CALL RCHSET + TRO FF,FRCMND+FRARRO ;TELL RFD ABOUT COMMA, _ AND (. + CALL RFD ;NOW SEE IF COMMAND NULL, AND WHETHER HAS _. + TRNN FF,FRNNUL + CAIE A,^M + CAIA + JRST CMDB ;JUST A CR WITH NOTHING SIGNIFICANT BEFORE IT. +CMD0: CAIN A,"_ + TRZ FF,FRARRO ;FRARRO WILL BE ON IFF NO _ IN STRING. + CAIN A,^M + JRST CMD1 ;READ THRU THE WHOLE COMMAND. + CALL RFD + JRST CMD0 + +;NOW RE-READ THE STRING, FOR REAL THIS TIME. +CMD1: MOVE F,[440700,,CMBUF] + MOVEM F,CMPTR ;START FROM BEGINNING OF STRING. +IFN CREFSW,SETZM CREFP ;CLEAR ALL SWITCHES BEFORE DECODING THEM. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ;WILL BE AOSED BY EACH (L) SWITCH. +] + SETZM DNAM ;CLEAR OUT ALL FILENAMES. + MOVE T,[DNAM,,DNAM+1] + BLT T,FNMEND-1 + MOVSI T,'DSK ;DEFAULT DEV IS DSK + MOVEM T,DNAM ;EXCEPT PERHAPS IF OUTPUT SPEC NULL. + MOVE T,RSYSNM + MOVEM T,SNAM ;DEFAULT SNAME IS INITIAL SNAME. + TRZ FF,FRNNUL + TRNN FF,FRARRO ;DON'T GOBBLE INPUT SPEC AS OUTPUT! + CALL RFD ;READ BIN FILE SPEC. + MOVE F,FF ;REMEMBER WHETHER NULL + MOVE T,[DNAM,,ONAM] + BLT T,OSYSNM + MOVS T,DNAM + CAIN T,'NUL ;IF BIN WENT TO NUL:, + MOVEI T,'DSK ;CREF GOES TO DSK. + MOVSM T,DNAM ;ELSE DEFAULT DEV FOR CREF IS BIN'S DEV. +IFN DECSW,MOVSI T,'CRF +IFN ITSSW,MOVE T,[SIXBIT/CREF/] + MOVEM T,FNAM2 ;DEFAULT THE CREF FILE'S NAMES. + TRNE FF,FRARRO + MOVEI A,"_ + CAIN A,"_ + JRST CMD2 ;RAN OUT OF OUTPUT SPECS => JUST USE DEFAULTS. + CALL RFD ;READ CREF FILE SPEC. +IFN CREFSW,[ + TRNN FF,FRNNUL ;IF SPEC NOT NULL OR ENDED BY _, + CAIN A,"_ + SETOM CREFP ;WE MUST WANT TO CREF. +CMD2: MOVE T,[DNAM,,CRFDEV] + BLT T,CRFSNM +]IFE CREFSW,CMD2: + MOVSI T,'ERR ;DEFAULT THE ERROR OUTPUT FILE'S NNAMES. + MOVEM T,FNAM2 + CAIN A,"_ + JRST CMD6 ;NO MORE OUTPUT SPECS. + CALL RFD ;READ ERROR FILE SPPEC. +IFN ERRSW,[ + TRNN FF,FRNNUL ;NONNULL SPEC OR LAST SPEC => + CAIN A,"_ + SETOM ERRFP ;MUST WAANT ANN ERROR FILE. +CMD6: MOVE T,[DNAM,,ERRDEV] + BLT T,ERRDEV+3 +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFN DECSW,MOVSI T,'LST +IFN ITSSW,MOVE T,[SIXBIT/LIST/] + MOVEM T,FNAM2 ;DEFAULT LST FILE FN2. + CAIN A,"_ ;ANY OUTPUT SPEC REMAINING? + JRST CMD3 + CALL RFD ;YES, READ ONE. + SETOM LISTP ;LIST SPEC GIVEN IMPLIES WANT LISTING. +CMD3: MOVE T,[DNAM,,LSTDEV] + BLT T,LSTSNM +] ;END IFN LISTSW, +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ;IGNORE ANY OUTPUT SPECS NOT NEEDED. + JRST CMD5 + +CMD4: MOVSI T,'DSK ;DEFAULT THE INPUT NAMES. + MOVS A,DNAM + CAIE A,'PTP ;DON'T LEAVE DEV NAME SET TO COMMON OUTPUT-ONLY DEVS. + CAIN A,'NUL + MOVEM T,DNAM +IFN DECSW,MOVSI T,'MID +IFN ITSSW,MOVSI T,'>_14 + MOVEM T,FNAM2 + MOVE T,[SIXBIT/PROG/] + SKIPN FNAM1 ;THE FN1 ALONE IS STICKY ACROSS THE _. + MOVEM T,FNAM1 + TRO FF,FRARRO ;IF ONLY 1 NAME IT SHOULD BE FNAM1. + CALL RFD ;READ INPUT SPEC. + MOVE T,[DNAM,,IFDS] + BLT T,IFDS+3 + MOVE T,FNAM1 ;DEFAULT OUTPUT FN1'S TO INPUT. + SKIPN ONAM+1 + MOVEM T,ONAM+1 +IFN CREFSW,[ + SKIPN CRFDEV+1 + MOVEM T,CRFDEV+1 +] +IFN LISTSW,[ + SKIPN LSTDEV+1 + MOVEM T,LSTDEV+1 +] +IFN ERRSW,[SKIPN ERRDEV+1 + MOVEM T,ERRDEV+1 +] + MOVSI A,'NUL ;THE OUTPUT DEV DEFAULTS TO NUL: + MOVS T,DNAM ;IF THE INPUT IS FROM TTY: + CAIN T,'TTY + TRNE F,FRNNUL ;AND THE BIN SPEC WAS NULL. + CAIA + MOVEM A,ONAM + TRZ FF,FRARRO ;DON'T LOUSE UP .INSRT'S READING. + RET + +IFN CREFSW,[ + +CRFOUT: SOSGE CRFCNT + JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER. + IDPB A,CRFPTR + POPJ P, + +CRFOU1: SAVE C + MOVE C,[0 CREFC,CRFHDR] + CALL OBUFO + REST C + JRST CRFOUT + +CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK. +CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK. +REPEAT 4,[ CALL CRFOUT + MOVE A,INFDEV+.RPCNT +] + JRST CRFOUT +] + +IFN LISTSW,[ + ;PRINTING ROUTINES + +;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING +CMDLST: SETOM LISTP ;SAY WANT LISTING. + AOS LISTP1 ;(STARTS AS -1, WILL BE POS. AFTER 2ND (L)) + RET + +;PRINT CHARACTER IN A +PILPT: SOSGE LSTCNT + JRST PILPT1 + IDPB A,LSTPTR + RET + +PILPT1: SAVE C + MOVE C,[0 LPTC,LSTHDR] + CALL OBUFO + REST C + JRST PILPT + +LPTCLS==CPOPJ +] ;END IFN LISTSW, + ;GET ANOTHER K OF MACTAB SPACE. + +CORRQB: IFN ITSSW,.VALUE ;LOOP POINT FOR DON'T PROCEED +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ;RESTORE A FROM PDL + JRST CORRQ1 + +GCCORQ: MOVE A,MACHI + LSH A,-2 ;CONVERT TO WORD # + CAIL A,MXMACL ;WANT MORE THAN ALLOWED? + POPJ P, + MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET. + PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN +CORRQ1:IFN ITSSW,[ + HRLI A,10001 ;(CODE FOR FRESH PAGE, _1) + LSH A,-1 + .CBLK A, ;TRY GETTING BLOCK +] +IFN DECSW,[ + IORI A,1777 + CORE A, +] + JRST CORRQL ;LOSE + REST A + ADDI A,2000 + JRST MACIN2 ;UPDATE POINTERS TO END OF MACTAB. + +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPR [ASCIZ / +No core for macro table./] +CORQL1: TYPR [ASCIZ / +Try again? /] +CORQL2: PUSHJ P,TYI ;GET CHAR + TRZ A," + CAIN A,"Y ;Y, + JRST CORRQA ;=> TRY AGAIN + CAIN A,"N ;N, + JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN + CAIN A,"? ;?, + ERJ CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB + TYPR [ASCIZ /? /] ;SOMETHING ELSE + JRST CORQL2 + +] ;END TS CONDITIONAL + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==./2000 ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>/2000 ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + SAVE AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW,[ ;YES, GET CORE FOR INCREASE. + SAVE AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. + .CALL INITSB(CH1) + .VALUE + REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +EISYMP: ;MAY BE MUNGED +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 + AOS AA + AOJA AA,SP1(CH1) + +IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + 1000,,600000 ;BOTH READ AND WRITE. + 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI 400001 ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,PURIFD ;NOT PURIFIED => FLUSH PAGES + MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + MXIMAC*1001 +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, + +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN + .VALUE [ASCIZ /:Already run +/] +PURIF1: MOVEI P,17 ;START PDL AT 20 + JSP F,PURIFD ;CALL .CBLK ROUTINE + MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB) + MINBNK*1001 + MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED. + MXICLR*1001 + MAXPUR-MINPUR ;PURIFY PURE PAGES. + 400000+MINPUR*1001 + SETZM PURIFG ;SET "PURIFIED" FLAG + MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF + MOVEI 1,0 + BLT 40 + .VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] + +GAPFLS: JSP F,PURIFD ;FLUSH GAP PAGES CREATED ON INITIAL LOAD. + MINPUR-MXIMAC + MXIMAC*1001 + .BREAK 16,300000 + + ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS + ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS + ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO + ;SECOND INITIAL .CBLK AC CONTENTS + +PURIFD: MOVE C,(F) ;GET COUNT + TLNE C,777000 ;CHECK INSTRUCTION PART + JRST (F) ;INSTRUCTION => RETURN TO IT + JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT + MOVE A,1(F) ;GET INITIAL .CBLK ARG +PURID1: .CBLK A, + .VALUE + ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE + SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES +PURID2: ADDI F,2 + JRST PURIFD + +] ;END PURESW CONDITIONAL +] ;END ITSSW, CONDITIONAL + +IFN DECDBG,[ +DECDBM: 0 +IFE SAILSW,HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, +.ELSE HRLZ A,JOBSYM + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. +IFE SAILSW,[HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM] +.ELSE [HRRM A,JOBSYM + HLRE B,JOBSYM] + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +ADJSP=105_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: ADJSP ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +SQUOZE 10,ADJSP + 0 + 0 +SQUOZE 10,DFAD +SQUOZE 10,DFSB +SQUOZE 10,DFMP +SQUOZE 10,DFDV +SQUOZE 10,DADD +SQUOZE 10,DSUB +SQUOZE 10,DMUL +SQUOZE 10,DDIV +SQUOZE 10,DMOVE +SQUOZE 10,DMOVN +SQUOZE 10,FIX +SQUOZE 10,EXTEND +SQUOZE 10,DMOVEM +SQUOZE 10,DMOVNM +SQUOZE 10,FIXR +SQUOZE 10,FLTR +SQUOZE 10,UFA +SQUOZE 10,DFN +SQUOZE 10,FSC +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB +SQUOZE 10,FAD +SQUOZE 10,FADL +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRL +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRL +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR + SQUOZE 10,FMPRL +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRL +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +0 + SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG + +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE + SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI + SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB + +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR + SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS + +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE + +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN + +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +SQUOZE 10,APR +0 +SQUOZE 10,PI +4 +SQUOZE 10,PTP +100 +SQUOZE 10,PTR +104 +SQUOZE 10,TTY +120 +SQUOZE 10,LPT +124 +SQUOZE 10,DIS +130 +SQUOZE 10,DC +200 +SQUOZE 10,UTC +210 +SQUOZE 10,UTS +214 + + +SQUOZE 10,LDBI ;REALLY ILDB, +LDBI +SQUOZE 10,DPBI ;AND IDPB +DPBI +SQUOZE 10,CLEAR +CLEAR +SQUOZE 10,CLEARI +CLEARI +SQUOZE 10,CLEARM +CLEARM +SQUOZE 10,CLEARB +CLEARB +SQUOZE 10,ADJBP +IBP +IRPS INST,,FAD FSB FMP FDV +SQUOZE 10,INST!RI +INST!RL +TERMIN + +IFN DECSW\TNXSW,[ +IFE TNXSW,[ +DEFINE DECDF1 FOO/ +IRPS X,,FOO +SQUOZE 10,X +X +.ISTOP TERMIN TERMIN +] +IFN TNXSW,[;; RESET IS BOTH A JSYS AND A CALLI!! +DEFINE DECDF1 FOO/ +IRPS X,,FOO +IFSN X,RESET,[SQUOZE 10,X +X] +.ISTOP TERMIN TERMIN +] +.DECUU DECDF1 +.DECTT DECDF1 +IFE SAILSW,.DECMT DECDF1 +.DECCL DECDF1 +IFN SAILSW,.DECMS DECDF1 +IFE SAILSW,.DEC.J DECDF1 +IFN SAILSW,.DECJB DECDF1 +.DECJH DECDF1 + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +DEFINE TNXDF1 FOO/ +IRPS X,,FOO +SQUOZE 10,X +X +.ISTOP TERMIN TERMIN +.TNXJS TNXDF1 +]] +SQUOZE 10,.OSMID +OSMIDAS +SQUOZEE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2 +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + + ;CONDITIONALS (SEE ALSO IFSE, IFSN) +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O +IRPS Y,,1 2 +SQUOZE 4,.!X!FNM!Y +X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN TSSYMS,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. +IFN DECSW,[ +IFNDEF MACL,MACL=.+5-MACTBA +IFGE .-MACTBA-MACL,.ERR MACL TOO SMALL +] + +IFN ITSSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL TOO SMALL + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR PURE TOO LOW. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT, + ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE. + ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER + ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION + +END 100