; -*-MIDAS-*- IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4003.,2000. ;THIS MANY ON DEC SYSTEM .ELSE .SYMTAB 8003. ;ELSEWHERE ASSEMBLE FASTER. TITLE MIDAS SUBTTL INITIAL DEFINITIONS ; AC DEFINITIONS. FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE ; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC. ; ALSO, .SEE R1 FF=:0 ; FLAGS. MUST BE AC 0. AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. A=:AA+1 ; 2 B=:A+1 ; 3 C=:B+1 ; 4 D=:C+1 ; 5 T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T TT=:T+1 ; 7 I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR LINK=:SYM+1 F=:13 CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH CH2=:CH1+1 ;" " " TM=:16 ; SUPER TEMPORARY P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL ; ASSUMES P=17. IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T ;OPERATING SYSTEM CONDITIONAL FLAGS: ; ITSSW IS 1 IF TO RUN ON ITS. ; DECSW IS 1 IF TO RUN ON ANY SORT OF BOTTOMS-10 (INCL. SAIL AND CMU). ; TNXSW IS 1 IF TO RUN ON TENEX OR TWENEX. ; SAILSW IS 1 IF TO RUN ON SAIL, AS OPPOSED TO OTHER BOTS-10. ; CMUSW IS 1 IF TO RUN AT CMU, AS OPPOSED TO OTHER BOTS-10. ; DECDBG IS 1 (ONLY WHEN DECSW IS 1) TO LEAVE SPACE FOR SYMBOL TABLE ; TO BE MOVED TO AFTEREXECUTION IS STARTED. ; DECBSW IS 1 TO PUT DECBTS IN THE PREDEFINED SYMBOL TABLE (ONLY IF DECSW IS 1). ; SMALSW IS 1 TO OCCUPY AS LITTLE CORE AS POSSIBLE. ; TS IS 1 EXCEPT FOR NON-TIMESHARED VERSION (WHICH IS OBSOLETE). ; CVTSW IS TO MAKE A MIDAS USING A DECDFS OR TNXDFS FILE GENERATED BY CVT. ; CVT READS A MONSYM FILE AND MAKES A TNXDFS.MID FILE, ALTHOUGH IT COULD ; BE HACKED TO READ UUOSYM AND MAKE DECDFS TOO. THERE IS NO SEPARATE ; DECBTS OR TWXBTS FILE WHEN USING CVT. 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 ;NON-ZERO => ITS VERSION IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION ; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC ; UUO'S DEFINED TOO ONCE UPON A TIME IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. IFN DECSW,[ IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. ] IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS (NORMALLY ; FOR RANDOM DEC SITES ONLY) IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW> ;NON-ZERO => INCLUDE DECBTS IFNDEF CVTSW,CVTSW==0 ;NON-ZERO => BITS DEFINITIONS COME FROM FILES ; MADE USING CVT IFN ITSSW\DECSW\TNXSW,TS==1 IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION IFE TS,1PASS IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL ; IN CONDITIONALS REGARDLESS OF BRCFLG. IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. IFNDEF FASLP, FASLP==1-SMALSW ;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==1-SMALSW;NON-ZERO => INCLUDE .I, .F IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => 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,[ IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR IFN TNXSW,IFNDEF MACL,MACL==12*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE 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 SMALSW,IFNDEF LPDL,LPDL==200. IFNDEF LPDL,LPDL==500. ;LENGTH OF PDL IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. IFN TNXSW, IFNDEF SYMDSZ,SYMDSZ==4003. ; MUST INCLUDE TONS OF SYSTEM DEFS 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. ; VERSION, FLAGS, ETC. 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. NOTE THAT TNX VERSION ACTUALLY SETS IT ;AT RUNTIME STARTUP TO "TENEX" OR "TWENEX" AS APPROPRIATE. 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) FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. ;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. FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> ] ;END IF1 ;INDICATOR REGISTER IF1 [ ;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, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX REST==POP P, PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. 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 TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. ] ;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==173 IFNDEF RBRACE,RBRACE==175 ;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. ; FLAGS IN "CONTROL" VARIABLE .SEE CONTRL ;LEFT HALF TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) ;RIGHT HALF ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. ] ;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 TYPE &STR TYPR [ASCIZ STR] TERMIN DEFINE TYPECR &STR TYPCR [ASCIZ STR] TERMIN 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 ;RANDOM MACRO DEFINITIONS IF1 [ ;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 SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT ; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS ; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, ; AND DEC). IF1 [ DEFINE DEFSYM X/ IRPS Z,,[X] EXPUNGE Z .ISTOP TERMIN X TERMIN ]; IF1 IFN DECSW\TNXSW,[ IF1 [ ; INSERT UUO DEFINITIONS FILES AS APPROPRIATE. IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS IFN SAILSW, .INSRT SAIDFS IFN CMUSW, .INSRT CMUDFS IFN TNXSW, .INSRT TNXDFS ;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES. IFE CVTSW,[ IFN DECSW,.DECDF DEFSYM IFN TNXSW,.TNXDF DEFSYM ;INSERT THE BITS DEFINITION FILES AS APPROPRIATE. ;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE ;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY ;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN. IFN TNXSW,[ EQUALS TEM,.SYMTAB .INSRT TWXBTS EQUALS .SYMTAB,TEM ] IFN DECBSW,.INSRT DECBTS ];IFE CVTSW IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... R2==:2 R3==:3 R4==:4 R5==:5 ] EXPUNGE HALT DEFINE HALT JRST 4,. TERMIN EXPUNGE .VALUE EQUALS .VALUE HALT DEFINE .LOSE A JRST 4,.-1 TERMIN ] ;IF1 IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION IFN PURESW,.DECTWO IFE PURESW,.DECREL RL0==. ] IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL, DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF. IFDEF .DECSAV,DECSVF==1 ] IFN DECSVF,.DECSAV .ELSE [ IFN PURESW,.DECTWO .ELSE .DECREL ] RL0==0 ] ] ;IFN DECSW\TNXSW IFN ITSSW,[ IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS .ITSDF DEFSYM ] ;IFNDEF .IOT IFNDEF %PIPDL,.INSRT SYS:ITSBTS HALT==.VALUE EXPUNG .JBTPC,.JBCNI DEFINE SYSCAL A,B .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] TERMIN ] ;IF1 IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION RL0==0 ] ;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==160 ;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 ; PBLK - SWITCH TO CODING ABOVE THE GAP DEFINE PBLK IFN CKPUR,.ERR PBLK IFE CKPUR,[VAR.LC==. LOC PUR.LC ]CKPUR==1 TERMIN ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. IFN ITSSW, PUR.LC==MINPUR*2000 IFN DECSW, PUR.LC==MINPUR*2000+RL0 IFN TNXSW,[ IFN DECSVF,PUR.LC==MINPUR*2000 .ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA. ] ; VBLK - SWITCH TO CODING BELOW THE GAP DEFINE VBLK IFE CKPUR,.ERR VBLK IFN CKPUR,[PUR.LC==. LOC VAR.LC ]CKPUR==0 TERMIN IFN TNXSW,IFE DECSVF,LOC 200 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,[ LOC .JBAPR 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 BEFORE SYMTAB IS COMPACTED AND SORTED. ;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING. 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, DECSAV DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) 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 ;GO9 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,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN 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 ;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. ;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. 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 SKIPL TEXT4 ;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO. CAIA 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\TNXSW,[ 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 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 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 RRU .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. 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\TNXSW,[ 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 CAIL A,140 SUBI A,40 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 PUSH P,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: PUSH P,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: PUSH P,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 [ PUSH P,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: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. JFCL 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) APOPJ: CPOPJ: POPJ P, ;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. ;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. 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:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT. 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,LABELF 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 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 POP P,LABELF 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 TRNN I,IREQL ;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 SETZ A, TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. MOVEI A,CRDF CALL P7X ;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 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 PUSH P,A PUSH P,A ABLKF2: CALL FASPW MOVEMM GLSP2,GLSP1 SOSE (P) JRST ABLKF2 JRST POPBAJ ] ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]] 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: PUSH P,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 PUSH P,ASMOUT PUSH P,ASMDSP PUSH P,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 PUSH P,[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,[FFINIT] ;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 [ SETZ A, ; SET LOC COUNTERS APPROPRIATELY SKIPGE B,CONTRL TRNE B,DECREL+FASL JRST [SETZM CLOC ; ASSUME RELOCATABLE AOS CRLOC ; CRLOC GETS 1 JRST P2INI5] TRNE B,DECSAV ; ASSUME ABSOLUTE MOVEI A,140 TRNE B,SBLKS MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. MOVEM A,CLOC P2INI5: ] 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 ] IFN ITSSW,[ TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK. ] TRNE T,DECREL JRST SYMDMD JUMPL T,SSYMD ;JUMP IF NOT STINK 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 IFN ITSSW,[ ; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY) SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK MOVE B,A ;UPDATING THE CHECKSUM IN B. PUSHJ P,PPB MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK. PUSHJ P,PPBCK .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, PUSHJ P,PPBCK SYSCAL RQDATE,[%CLOUT,,A] .LOSE %LSSYS PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). REPEAT 4,[ MOVE A,INFB+$F6DEV+.RPCNT PUSHJ P,PPBCK ] MOVE A,B PJRST PPB ; PUNCH OUT CHECKSUM & RETURN ] ;IFN ITSSW, ;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 AOS SMSRTF 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 CAIL A,DEFGVR_-16 TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. HRRI CH2,0 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 TOP BIT, MOVEI A,ST ;SORT FROM BOTTOM OF 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) ;-<# SYMTAB ENTRIES>,, MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS MOVE A,[SQUOZE 0,GLOBAL] MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. MOVE C,BKTABP IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. SETZM PRGNM+1 CAIN C,2 MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE, TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV, CAIA ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME). ;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME ;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK. MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,, SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT MOVE C,A MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM CALL PPB MOVE A,C CALL PPB HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, JRST .+1] MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) 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 A,BKTAB CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) 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+DECSAV JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT MOVE A,BKTAB(C) PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. HLRZ A,BKTAB+1(C) SKIPE A ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). HRL A,BKTAB+2(C) ;PUT IN -2* ADD A,[-2,,] SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. JRST SSYMD6 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 SSYMD8 ;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) TRNE LINK,DECSAV CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) 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. SSYMD8: TRNN LINK,DECSAV JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM, JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME. MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH) CALL PPB HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS) CALL PPB JRST SSYMD3 ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. ; (WHICH ASQOZR RTN DOESN'T) ; CLOBBERS B. RSQZA: PUSH P,A ; SAVE FLAGS TLZA A,740000 ; ZAP RSQZA2: DPB A,[004000,,(P)] ; UPDATE IDIVI A,50 JUMPE B,RSQZA2 POP P,A POPJ P, ;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 TRNE LINK,DECSAV ; IN DECSAV FORMAT, JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB CALL RSQZA CALL PPB ; WITH FUNNY VALUE OF SETZ A, ; -<# SYMTAB WDS USED BY PGM>,, CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO... JRST SSYMG3] MOVE A,B ; SBLK OR RIM 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) ;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. ; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS ; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). MOVE LINK,CONTRL ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. BKSR1: TRNE LINK,DECSAV JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] SETZ C, 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) ; RESTORE A (C IS PRESERVED OVER CALL) BKSR3: ADDI C,BKWPB CAMGE C,BKTABP JRST BKSR2 MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH TRNE LINK,DECSAV POPJ P, 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 ;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF ;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). 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: PUSH P,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 TRNE T,DECSAV JRST EDSBLK 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 REL 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 TRNE LINK,DECSAV JRST DSBLK1 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 ; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) DSBLK1: MOVE A,WRD 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, RETURN DSBLK2: SUBI A,BKBUF+1 JUMPE A,CPOPJ MOVNS A SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 HRLM A,BKBUF PUSHJ P,FEED MOVEI T,BKBUF DSBLK3: CAML T,OPT1 JRST DSBLK4 MOVE A,(T) PUSHJ P,PPB AOJA T,DSBLK3 DSBLK4: TRO FF,FRFIRWD MOVEI A,BKBUF+1 MOVEM A,OPT1 POPJ P, ; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. EDSBLK: MOVE A,OPT1 CAIN A,BKBUF+1 JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. PUSHJ P,DSBLK2 JRST EBLK4 ;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 PUSH P,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. PUSH P,[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 CAIL A,"A+40 CAILE A,"Z+40 JRST AFRTKL ;THAT CHAR WINS, SALT IT SUBI A,40 JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING 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. ; Note that use of ILFLO flag is a crock here. 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,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. PUSH P,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,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE JRST A.GLO2 PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN MOVE SYM,[SQUOZE 0,.SCALAR] TLNE LINK,ILFLO ; USE RIGHT SYM 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 JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D TLNN LINK,ILFLO ; ZERO, USE DEFAULT JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. 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 JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT JRST AEND6] TRNE A,DECSAV ; IF DECSAV FMT, JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. MOVEM A,DECSYA JRST AEND6] 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 ] TRNE B,DECSAV JRST AEND4 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 ; HERE FOR DECSAV FORMAT. AEND4: TLNE A,-1 JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. MOVE B,A MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. MOVE A,B PUSHJ P,PPB TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. JRST AEND1B AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST TLNN A,777000 ; CHECK INSTRUCTION PART TLO A,(JRST) ; WANTS JRST PUSHJ P,PPB AEND1B: 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\TNXSW,[ PUSH P,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: PUSH P,A PUSH P,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 T,-1(P) SUB P,[2,,2] JRST TEXT5 ;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. PUSH P,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 PUSH P,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. PUSH P,A CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T PUSH P,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 PUSH P,A CALL YGETFD MOVE T,A REST A LDB A,A JRST VALRET ;.IBP BP RETURNS AN INCREMENTED BP. A.IBP: CALL YGETFD TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. HRLZS A IBP 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 PUSH P,[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 PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. PUSH P,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 PUSH P,A PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. PUSH P,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 ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. ERRJPC: 0 ;JPC READ WHEN UUO. ERROR: 0 IFN ITSSW, .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 PUSH P,C LDB T,[331100,,40] ;PICK UP OP CODE CAIN T,TYPCR_-33 ; TYPCR? JRST TYPCR1 CAIN T,TYPR_-33 ; OR 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 AOS ERRCNT ; BUMP ERROR TOTAL IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT 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 CAIE A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, RET SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. SETOM TEXT4 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 GO9 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. MOVEI B,[ASCIZ /Error is fatal. /] CALL TYPR3 IFN ITSSW,[ .SUSET [.RTTY,,A] SKIPL A .RESET TYIC, ] JRST GO9 ;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 ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF TYPCR1: PUSH P,[ERRET1] PUSHJ P,TYPR4 ; When done, fall thru. 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) PUSH P,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 ; USE 100 ASSUMING ITS SBLK TRNE B,DECSAV MOVEI A,140 ; BUT USE 140 FOR DEC ABS. MOVEM A,CLOC SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. TRNE B,ARIM\ARIM10 TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. 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 ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT A.DECSAV: NOVAL MOVSI B,DECSAV ; SET FLAG JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK 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 PUSH P,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? IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR .ELSE [ JRST [ SKIPE CCLFLG TRNN FF,FRPSS2 JRST CRR RET] SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. ] PUSHJ P,TYO A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE JRST ATIT1 ;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. A.FATAL:PUSH P,[GO9] ;.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 PUSH P,[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,TEXT4 PUSH P,D PUSH P,SYM PUSH P,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,TEXT4 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 SETOM TEXT4 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: -1 ;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO. 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 SETOM TEXT4 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 . PUSH P,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: HLRES 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: PUSH P,SYM PUSH P,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 ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. JRST -3(A) ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU CAIN A,RREOF+1 JRST RRU PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. 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 PUSH P,SYM HRRI B,SCONDF PUSH P,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: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). WRQLEN==,-2 PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. WRQLVL==,-1 PUSH P,[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". MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. MCFEVL==6 ;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. PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. PUSH P,SYM CALL GETSLD CALL NONAME TLZ FF,FLUNRD SUB P,[2,,2] PUSH P,SYM PUSH P,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 KEEP-STRUNGNESS ON OR OFF. JRST DEFKST 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: PUSH P,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 DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS 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: PUSH P,I AOS PRCALP AOS MDEPTH PUSH P,RDWRDP PUSH P,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 TLZ I,ILPRN JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. MOVE A,LIMBO1 CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. JRST MACCLE CAIN A,RBRKT JRST MACCLE CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => 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. MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS ;AND IF THAT CHAR WAS A CLOSE-BRACKET, SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. CAIN B,4 CAIA JSP LINK,SAVAS2 SETZ LINK, JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. ;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. CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. 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. MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. MACST2: CALL PUTREL CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, CAIE A,(T) JRST MACST2 ;STORE IT AND READ ANOTHER. CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. 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 PUSH P,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 PUSH P,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 PUSH P,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: PUSH P,RDWRDP PUSH P,@PRCALP PUSH P,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 SHOULD 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 PUSH P,@PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ. PUSH P,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. PUSH P,I PUSH P,RDWRDP HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. CAIE LINK,NIRPN JRST AIRP0 CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. PUSH P,A CALL AGETFD PUSH P,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? PUSH P,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: PUSH P,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 IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. MOVE 16,[1,,GCSV] BLT 16,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 CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. JRST GCEND 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 IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. BLT 16,16 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,ACSVI PUSHJ P,RCH EXCH I,ACSVI TERMIN DEFINE GETT EXCH I,ACSVI PUSHJ P,RCH EXCH I,ACSVI 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 TEMP: 440600,,(D) ;INDIRECT VIA D BYTPNT: 0 ; Save 7 acs here, done by move(m)s for robustness IRP AC,,[AA,A,B,C,D,I,P] ACSV!AC: 0 TERMIN PBLK ; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR A.I: SETOM INTEGR SKIPA A.F: SETZM INTEGR PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER IRP AC,,[AA,A,B,C,D,I,P] MOVEM AC,ACSV!AC TERMIN 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: IRP AC,,[AA,A,B,C,D,I,P] MOVE AC,ACSV!AC TERMIN 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 IRP AC,,[AA,A,B,C,D,I,P] MOVE AC,ACSV!AC TERMIN 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 MOVE P,PNTSA+P ; P = 17 so must restore. IFN P-17, .ERR P=17 assumption at PNTR! 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 PUSH P,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, SUBTTL TS Routines for I/O & overall control IFN TS,.INSRT TSRTNS 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==._-10. ;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>_-10. ;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\TNXSW,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 CODE 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,[ PUSH P,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\TNXSW,[ ;YES, GET CORE FOR INCREASE. PUSH P,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,INITS3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. IFN TNXSW, PUSHJ P,TCORGT IFN ITSSW, .CALL INITSB(CH1) ? .VALUE INITS3: 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 CAIA .VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? 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) ;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, ;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. SP1: CAIL AA,EISYMT(CH1) POPJ P, MOVE SYM,(AA) LDB T,[400400,,SYM](CH1) ROT T,-4 TLZ SYM,740000 PUSHJ P,ES CAIA JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). 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 SP5: AOS AA AOJA AA,SP1(CH1) IFN ITSSW,[ INITSB: SETZ ? 'CORBLK MOVEI %CBNDR+%CBNDW ;BOTH READ AND WRITE. MOVEI %JSELF ? AA ;INTO SELF, AA IS AOBJN -> PAGES. SETZI %JSNEW ;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,FLSPGS ;NOT PURIFIED => FLUSH PAGES ,,MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. 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 ITSSW SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM IFN ITSSW\TNXSW,[ IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE PURIFY: SKIPL NVRRUN IFN ITSSW,[ .VALUE [ASCIZ /:Already run /]] IFN TNXSW,[ JRST [ HRROI 1,[ASCIZ /? Already run /] PSOUT HALTF JRST .+1] ; If continued, go ahead anyway. ] ;IFN TNXSW PURIF1: MOVEI P,17 ; Start PDL at 20 JSP F,FLSPGS ; First flush blank-code pages, ,,MINBNK ; incl. symbol table. JSP F,FLSPGS ,,MXICLR ; Flush MACTAB pages created by load but not needed. JSP F,PURIFD ,,MINPUR ; Purify pure pages. SETZM PURIFG ; Set "purified" flag MOVE [1,,2] ; Now clear out remains of data of self MOVEI 1,0 BLT 40 IFN ITSSW,.VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] IFN TNXSW,[ HRROI 1,[ASCIZ / Purified, now SAVE /] PSOUT HALTF ] ; IFN TNXSW GAPFLS: JSP F,FLSPGS ; Flush gap pages created on initial load. ,,MXIMAC IFN ITSSW, .BREAK 16,300000 IFN TNXSW, HALTF ; JSP F,FLSPGS ; -<# pgs>,, ; Flush pages specified by page AOBJN FLSPGS: MOVE A,(F) ; Get the page AOBJN IFN ITSSW,[ SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] .LOSE 1000 ] IFN TNXSW,[ ASH A,1 ; Multiply # pages, page # by 2. HLRE B,A HRLI A,.FHSLF MOVNS B TLO B,(PM%CNT) ; Say hacking repeat count FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. TLNN FF,FL20X ; If on 20X, that's all. JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. TRNE B,400000 ; See if became "negative". JRST .+1 ; Yep, done with manual iteration. AOJA A,FLSPG2] ; Nope, bump page #. ] JRST 1(F) ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. PURIFD: MOVE A,(F) ; Get page AOBJN IFN ITSSW,[ SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. MOVEI %JSELF ? A] .LOSE 1000 ] IFN TNXSW,[ ASH A,1 ; Double everything. HLRE B,A MOVNS B HRLI A,.FHSLF PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] ADDI A,1 SOJG B,PURID1 ] JRST 1(F) IFN TNXSW,[ ; PURSAV - More useful hack for 10X/20X since it preserves page access PURSV0: PUSHJ P,RDJERR PURSAV: MOVEI P,20 HRROI R1,[ASCIZ /Pure-Save to file: /] PSOUT MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) MOVE R2,[.PRIIN,,.PRIOU] GTJFN ; Get JFN from TTY JRST PURSV0 SETZM PURIFG ; Claim purified... SETOM MEMDBG ; and keeping watch on memory. HRLI R1,.FHSLF MOVEI R2,[ 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. 0 ] ; End of SSAVE table SETZ R3, SSAVE ; Do it! HRROI R1,[ASCIZ /Saved./] PSOUT HALTF ] ; IFN TNXSW ] ; IFN PURESW ] ; IFN ITSSW\TNXSW IFN DECDBG,[ DECDBM: 0 HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED HLRE B,.JBSYM MOVMS B BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. JRST @DECDBM ] CONSTANTS ;;ISYMS ;INITIAL SYMBOL TABLE IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB ISYMTB: ; 104-177 (JSYS - FDVRB) SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION SQUOZE 10,ADJSP ;KL10 INSTRUCTION 0 0 SQUOZE 10,DFAD ;KI10 INSTRUCTION SQUOZE 10,DFSB ;KI10 INSTRUCTION SQUOZE 10,DFMP ;KI10 INSTRUCTION SQUOZE 10,DFDV ;KI10 INSTRUCTION SQUOZE 10,DADD ;KL10 INSTRUCTION SQUOZE 10,DSUB ;KL10 INSTRUCTION SQUOZE 10,DMUL ;KL10 INSTRUCTION SQUOZE 10,DDIV ;KL10 INSTRUCTION SQUOZE 10,DMOVE ;KI10 INSTRUCTION SQUOZE 10,DMOVN ;KI10 INSTRUCTION SQUOZE 10,FIX ;KI10 INSTRUCTION SQUOZE 10,EXTEND ;KL10 INSTRUCTION SQUOZE 10,DMOVEM ;KI10 INSTRUCTION SQUOZE 10,DMOVNM ;KI10 INSTRUCTION SQUOZE 10,FIXR ;KI10 INSTRUCTION SQUOZE 10,FLTR ;KI10 INSTRUCTION SQUOZE 10,UFA ;KA/KI10 INSTRUCTION SQUOZE 10,DFN ;KA/KI10 INSTRUCTION SQUOZE 10,FSC SQUOZE 10,IBP SQUOZE 10,ILDB SQUOZE 10,LDB SQUOZE 10,IDPB SQUOZE 10,DPB SQUOZE 10,FAD SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION SQUOZE 10,FADM SQUOZE 10,FADB SQUOZE 10,FADR SQUOZE 10,FADRI ;PDP10 INSTRUCTION SQUOZE 10,FADRM SQUOZE 10,FADRB SQUOZE 10,FSB SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION SQUOZE 10,FSBM SQUOZE 10,FSBB SQUOZE 10,FSBR SQUOZE 10,FSBRI ;PDP10 INSTRUCTION SQUOZE 10,FSBRM SQUOZE 10,FSBRB SQUOZE 10,FMP SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION SQUOZE 10,FMPM SQUOZE 10,FMPB SQUOZE 10,FMPR SQUOZE 10,FMPRI ;PDP10 INSTRUCTION SQUOZE 10,FMPRM SQUOZE 10,FMPRB SQUOZE 10,FDV SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION SQUOZE 10,FDVM SQUOZE 10,FDVB SQUOZE 10,FDVR SQUOZE 10,FDVRI ;PDP10 INSTRUCTION SQUOZE 10,FDVRM SQUOZE 10,FDVRB ; 200-277 (MOVE - SUBB) 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 ;AI PDP10 INST. 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 SQUOZE 10,MAP ;KI10 INSTRUCTION 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 ; 300-377 (CAI - SOSG) 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 ; 400-477 (SETZ - SETOB) 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 ; 500-577 (HLL - HLRES) 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 ; 600-677 (TRN - TSON) 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: ; I/O INSTRUCTIONS 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 ;EXTEND MNEMONICS SQUOZE 10,CMPSL 001000,, SQUOZE 10,CMPSE 002000,, SQUOZE 10,CMPSLE 003000,, SQUOZE 10,EDIT 004000,, SQUOZE 10,CMPSGE 005000,, SQUOZE 10,CMPSN 006000,, SQUOZE 10,CMPSG 007000,, SQUOZE 10,CVTDBO 010000,, SQUOZE 10,CVTDBT 011000,, SQUOZE 10,CVTBDO 012000,, SQUOZE 10,CBTBDT 013000,, SQUOZE 10,MOVSO 014000,, SQUOZE 10,MOVST 015000,, SQUOZE 10,MOVSLJ 016000,, SQUOZE 10,MOVSRJ 017000,, SQUOZE 10,XBLT 020000,, ;OLD PROGRAMS USE THESE NAMES SQUOZE 10,CLEAR SETZ SQUOZE 10,CLEARI SETZI SQUOZE 10,CLEARM SETZM SQUOZE 10,CLEARB SETZB ;RANDOM ALIAS NAMES SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT IBP SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) JFCL 1, SQUOZE 10,JCRY1 JFCL 2, SQUOZE 10,JCRY0 JFCL 4, SQUOZE 10,JCRY JFCL 6, SQUOZE 10,JOV JFCL 10, SQUOZE 10,PORTAL ;KI10 INSTRUCTION JRST 1, SQUOZE 10,JRSTF JRST 2, SQUOZE 10,HALT JRST 4, SQUOZE 10,XJRSTF ;KL10 INSTRUCTION JRST 5, SQUOZE 10,XJEN ;KL10 INSTRUCTION JRST 6, SQUOZE 10,XPCW ;KL10 INSTRUCTION JRST 7, SQUOZE 10,JEN JRST 12, SQUOZE 10,SFM ;KL10 INSTRUCTION JRST 14, SQUOZE 10,XMOVEI ;KL10 INSTRUCTION SETMI SQUOZE 10,XHLLI ;KL10 INSTRUCTION HLLI ;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES IRPS INST,,FAD FSB FMP FDV SQUOZE 10,INST!RL INST!RI TERMIN DEFINE DEFSYM X/ IRPS Z,,[X] SQUOZE 10,Z Z .ISTOP TERMIN TERMIN IFN DECSW,[ IFE CVTSW,[ .DECDF DEFSYM IFN DECBSW,.INSRT DECBTS ];IFE CVTSW IFN CVTSW,[ .INSRT DECDFS ];IFN CVTSW ] ;IFN DECSW IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION IFE CVTSW,[ .TNXJS DEFSYM .INSRT TWXBTS ];IFE CVTSW IFN CVTSW,[ .INSRT TNXDFS ];IFN CVTSW ] ;IFN TNXSW SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at OSMID: OSMIDAS ; runtime before syms spread. SQUOZE 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,.DECSA A.DECSA 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,.IBP A.IBP 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,.ERRCNT=ERRCNT .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,.FVERS RFVERS,,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,.IFVRS IFVRS,,INTSYM SQUOZE 4,.TTYFLG A.TTYFLG,,INTSYM ] IFN .I.FSW,[ SQUOZE 4,.F A.F SQUOZE 4,.I A.I ] IFN ITSSW,[ 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 XJNAME LJB+ SQUOZE 10,..R!X .IRPCN+1 IFSN Y,+,[ SQUOZE 10,..S!X 400000+.IRPCN+1 ] TERMIN ] EISYMT: PRINTA \.-MACTBA-1, words initialization coding. VARIAB IFN .-EISYMT,.ERR Non-empty variables area IFN DECSW,[ IFGE .-MACTBA-MACL,[ IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA MACL==.-MACTBA ]] IFN ITSSW\TNXSW,[ 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 END