From d731f6ae88aa0bd6fb2c7d949d2f3dc5b6ed720a Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Fri, 3 Aug 2018 12:26:37 +0200 Subject: [PATCH] MIDAS version 108. From SYSENG; MIDAS 108 backed up 1973-03-09; timestamp March 6th. There apparently is a bug; it's fixed with a binary patch rather than a source change since ... --- build/misc.tcl | 28 + src/midas/midas.108 | 10031 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 10059 insertions(+) create mode 100644 src/midas/midas.108 diff --git a/build/misc.tcl b/build/misc.tcl index 9fc5370a..953cf45e 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -493,6 +493,34 @@ respond "*" ":midas sys1;ts who%_sysen3;who%\r" expect ":KILL" respond "*" ":link sys1;ts %,sys1;ts who%\r" +# midas 108 +respond "*" ":midas sysbin;midas 108bin_midas; midas 108\r" +respond "end input with ^C" "EXPUNGE FIX\r" +respond "\n" "PTR==100\r" +respond "\n" "LDBI==ILDB\r" +respond "\n" "DPBI==IPDB\r" +respond "\n" "\003" +expect ":KILL" +respond "*" ":job midas\r" +respond "*" ":load sysbin; midas 108bin\r" +respond "*" "cmdl+7/" +respond "40" "cain a,40\r" +respond "\n" "purify\033g" +respond "PURIFIED" ":pdump midas; ts 108\r" +respond "*" ":kill\r" +# Now, assemble itself! +respond "*" ":midas;108\r" +respond "MIDAS.108" "sysbin;midas 108bin_midas;midas 108\r" +respond "SWITCHES?" ".INEOF\r" +expect ":KILL" +respond "*" ":job midas\r" +#respond "*" ":load sysbin; midas 108bin\r" +#respond "*" "cmdl+7/" +#respond "40" "cain a,40\r" +#respond "\n" "purify\033g" +#respond "PURIFIED" ":pdump midas; ts 108\r" +respond "*" ":kill\r" + # palx respond "*" ":midas sys;ts palx_sysen1;palx\r" expect ":KILL" diff --git a/src/midas/midas.108 b/src/midas/midas.108 new file mode 100644 index 00000000..fddd009c --- /dev/null +++ b/src/midas/midas.108 @@ -0,0 +1,10031 @@ + +TITLE MIDAS 6 + +IFN <17-.TYPE .SYMTAB >, .SYMTAB 4000. ;APPROX TWICE # SYMS. +;CONDITIONALS IN FOLLOWING FOR COMPATIBILITY WITH OLD AND NTS VERSIONS OF MIDAS +IFE <17-.TYPE IFNDEF >,[DEFINE IFNDEF NAME +IFE <17-.TYPE NAME >*<3-.TYPE NAME >,TERMIN ;ASSEMBLE IF NAME NOT DEFINED +] +IFNDEF IFDEF,[DEFINE IFDEF NAME +IFN <17-.TYPE NAME >*<3*.TYPE NAME >,TERMIN ;ASSEMBLE IF NAME DEFINED +] +IF1,[IFN <17-.TYPE .INSRT >,[ +EQUALS NO,.INEOF ;LET "NO" BE VALID ANSWER TO TYPED OUT QUESTION +PRINTC /SWITCHES? +/ + ;NOW GET ANSWER, USER CAN TYPE IN STUFF IF HE WANTS TO, DEFINING SWITCHES, ETC. +.INSRT TTY: +EXPUNGE NO +PRINTC /OK. +/ ;A SIGN OF LIFE IS OFTEN WELCOMED IF TYPEIN HAS BEEN HAIRY +]] + +IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING +IFNDEF MOBY,MOBY==1 ;NON-ZERO TO ASSEMBLE MOBY SYMBOL TABLE, ETC. +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF TSSYMS, TSSYMS==1 ;.UAI, .UAO, .BAI, .BAO, .UII, .UIO, .BII, .BIO - EVER USE THEM? +IFNDEF LISTSW, LISTSW==0 ;LISTING FEATURE FOR MAINT PROGS +IFNDEF CREFSW, CREFSW==TS ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF RCHASW, RCHASW==TS ;INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS +IFNDEF .I.FSW, .I.FSW==1 ;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFN TS,IFNDEF RUNTSW, RUNTSW==1 ;ASSEMBLE CODING TO TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,[IFNDEF MACL,[ +IFE MOBY,MACL==2*2000 ;LENGTH OF MACTAB (MACRO DEFINITION TABLE) +IFN MOBY,MACL==6*2000 +]]IFN TS,[IFNDEF MACL,MACL==4000 +IFNDEF MXMACL,MXMACL==16.*2000 ;MAXIMUM LENGTH MACTAB (USED ONLY IF PURESW .NE. 0) +]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==20 ;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 BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFNDEF LPDL,LPDL"==500 ;LENGTH OF PDL +IFNDEF LCONTB,IFN MOBY,LCONTB==500*5 ;LENGTH OF CONSTANTS TABLE +IFNDEF LCONTB,IFE MOBY,LCONTB==500 +IFNDEF LCNGLO,LCNGLO==200*3 ;LENGTH OF CONST GLO TAB +IFNDEF NCONS,NCONS==25. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFNDEF SYMDSZ,SYMDSZ==2177*2 ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF DECSW,DECSW==0 ;NOT TEN50 VERSION. + +IFNDEF MIDVRS,MIDVRS"=.FNAM2 +.GLOBAL MIDVRS ;IN CASE USER HAS TYPED IT IN + +;AC DEFS + +FF"=0 ;FLAGS +P=1 +I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +AA=3 +A=4 +B=5 +C=6 +D=7 +T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T +TT=11 +SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=13 +F=14 +CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=16 ;" " " +TM=17 ;SUPER TEMPORARY + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +;FF FLAGS NOT PUSHED +;LEFT HALF +PPSS"==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +INDEFF==200000 ;SET IF LOC OR OFFSET IS INDEF +SKILF==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +VOT"==40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +MACRCH"==20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +TTYRCH"==10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +PTPF==2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP + +OUTF==4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) + +;FF RIGHT HALF FLAGS + +FIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +IPSYMS==200000 ;ONE IF SYM PUNCH DESIRED +LOCF==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +NPSS"==40000 ;ONE IF TWO PASS ASSEMBLY +PSS"==20000 ;ONE ON PASS 2 + +INVTF==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +NLIKF==2000 ;TEMPORARILY SUPPRESS ADR LINKING +GLOLOC==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +BITF==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +MRSW==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + + ;INDICATOR REGISTER + +;LEFT HALF +GLI==1 ;SET ON " CLEARED EACH SYL +VAR==2 ;SET ON ' " " " +FLO==4 ;SET ON . " " " +DECP==10 ;DECIMAL PREFER +UARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +LSRET==40 ;RETURN FROM < +MNSFLG==100 ;SET IF LAST OP WAS MINUS +WRDF==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +NPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +UNRCHF==2000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +MWRD==4000 ;SET ON MULTIPLE WORD +MWRD1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +NOOPTF==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 + +FLD==1 ;SET IF FLD NOT NULL +SYL==2 ;SET IF L-N SEEN IN CURRENT SYL +LET==4 ;SET IF LET SEEN IN CURRENT SYL +DEF==10 ;SET IF CURRENT EXPR DEFINED + +COM==40 ;SET IF CURRENT QUAN IS COMMON +PERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +EQLF==200 ;ONE DURING READING WORD TO RIGHT OF = +AIOWD==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +CONT==1000 ;SET IF NOT OK TO END BLOCK +IFN TS,FFFLG==2000 ;USED BY RFD TO COUNT FILE NAMES +PSEUDF==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +GMINF==20000 ;SET IF UARI OR BAKARI HAS GOBBLED MINUS +OPFLD==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + ;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. + +ERSM=1000,, ;ERROR, TYPE SYM. +ERR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ERI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ERA=5000,, ;ERROR, RET. TO ASSEM1. +ER1=6000,, ;ERROR ON PASS 1 ONLY, TYPE SYM. +ERF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLR==200000 ;R(RH) +3RLL==400000 ;R(LH) +3RLNK==100000 ;R(LINK) +3INI==40000 ;INITIAL SYM +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VP==20000 ;VALUE PUNCHED +3VCNT==1000 ;USED IN CONSTANT +3SKILL==10000 ;SEMI KILL IN DDT +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3MAS==400 ;MULTIPLE SYMS SAME NAME AT DIFFERENT LEVELS (I.E. KEEP LOOKING + ;AT SYMBOL LOOKUP) +3NCRF==200 ;DON'T CREF THIS SYMBOL. + +3DFCLR==777000 ;BITS IN LH TO CLEAR ON REDEFINITION. + +;CONTROL FLAGS +;LEFT HALF +TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE) +;RIGHT HALF +ARIM==2 ;IF ONE OUT FOR IS RIM +SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS +ARIM10==20 ;PDP-10 RIM +DECREL==40 ;DEC RELOCATABLE FORMAT. + +;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. +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. +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC Á!B!C!D!E!F +Ý +TERMIN + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +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 + +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,MINPUR==200 +IFE DECSW,MINPUR==120 ;BLOCK NUMBER BEGINNING OF PURE CODING +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ;SWITCH TO CODING ABOVE THE GAP + +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + +PUR.LC==MINPUR*2000 ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW + + ;SWITCH TO CODING BELOW THE GAP + +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + + ;RANDOM MACRO DEFINITIONS + + ;ASSEMBLE BYTE INSTRUCTION POINTING TO CERTAIN BIT + +DEFINE BYB A,B,C +ZZZ=C +ZZ=43 +REPEAT 35.,[IFGE ZZZ,[ ZZZ=ZZZ_1 + ZZ=ZZ-1 +]] +A,[ZZ*10000+100,,B] +TERMIN + + ;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 MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN + +IFNDEF HALT,[ +IFN TS-DECSW, HALT==.VALUE +IFE TS-DECSW,[DEFINE HALT + JRST 4,. + TERMIN +]] + +IF1 [IFN DECSW,[.INSRT COM:DEC DEFS + .DECDF +IFN PURESW,.DECTWO +IFE PURESW,.DECREL +]] + +FOO==. +LOC 41 + JSR ERROR +IFN TS-DECSW,JSR TSINT +IFN DECSW,[LOC JOBAPR + TSINT1] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL,,RRL2 ;EXCLAIM + DSYL,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + 0 ;(USED TO BE DOLLAR SIGN) + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + 0 ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + 0 ;UNUSED (FORMERLY PERIOD) + DFLD,,DIVID ;/ + DSYL,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL,,EQUAL ;= + 0 ;> + 0 ;? + DSYL,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL,,UPARR ;^ + DSYL,,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": REPEAT 3,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,[PRINTC /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 + REPEAT 4,POPJ P,76 ; BRACES, VERT BAR, TILDE + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,[PRINTX /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. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +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 +GETCNR: 105 ;PRIORITY OF UNARY OPS (AOS'D TO CAUSE RIGHT TO LEFT EVALUATION) +ISYMF": -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF": -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED) +GLOBT: 0 ;GLSP1 PUSHED DOWN ONE LEVEL AT GETFLD +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) +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +ISAV: 0 ;I FROM FLD AT AGETFLD +CPGN": 0 ; 1 LESS THAN CURRENT PAGE # IN INPUT FILE +CLNN": 0 ; 1 LESS THAN CURRENT LINE # IN INPUT FILE +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: IFN MOBY,SYMMSZ ;# SYMS FIT IN SYM TAB + IFE MOBY,SYMDSZ ;(ASSEMBLED IN VALUE USED 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. + +PBLK + + ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO2 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;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 I,UNRCHF ;RE-INPUT CHARACTER ON RETURN? +IFE LISTSW,TLO B,400000 ;YES +IFN LISTSW,[JRST LSTUN1 ;YES, LISTING STYLE +LSTUN2:] + 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,[ +LSTUN1: AOSN PNTSW + JRST LSTUN5 ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +LSTUN5: SETOM LISTBC + TLO B,400000 + JRST LSTUN2 +] + + ;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 I,UNRCHF ;YES, SET FLAG TO RE-INPUT LAST CHAR +IFE LISTSW,TLZ I,UNRCHF ;NO, CLEAR FLAG +IFN LISTSW,[TLZA I,UNRCHF ;SAME, LISTING STYLE... + IDPB A,PNTBP ;SET SWITCH, DEPOSIT CHAR INTO LISTING BUFFER +] + 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,MACRCH\TTYRCH ;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,GETCHR ;FIRST 3 WORDS GETCHR + TLNE FF,VOT + 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, + + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET": TLO FF,VOT ;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,[PRINTC /LOSSAGE AT MDSSTB. +/] + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR": TLZ FF,VOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP" ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,INCHR3" ;RREOF + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,[PRINTC /RCHFIL LOSES. +/] + ILDB A,UREDP ;SEMIC, GET CHARACTER + CAIG A,15 ;SKIP IF TOO BIG TO BE SPECIAL (CR ALSO SPECIAL HERE) + XCT RPATAB(A) ;MAYBE SPECIAL, DO THE APPROPRIATE THING + JRST SEMIC ;NOT CR, LOOP BACK FOR NEXT CHAR + + ;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING + +RPATAB": JFCL ;0 + JFCL + JFCL +IFN .-RPATAB-EOFCH,[PRINTC /EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. +/] + PUSHJ P,INCHR3" ;3, EOFCH + REPEAT 6,JFCL + AOS CLNN ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: AOS CPGN ;FORM FEED + SETZM CLNN + POPJ P, +] + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD": 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. + + ;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) + +RCH": TLZE I,UNRCHF + JRST RCH1 ;RE-INPUT LAST ONE MAYBE GET HERE FROM GETCHR+2 +GETCHR: 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 +IFN LISTSW,[ + AOSN PNTSW + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +] +TYPCTL": POPJ P, ;OR JRST SOMEWHERE +PBLK + +IFN LISTSW,[ +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL +] + +RCH1: MOVE A,LIMBO1 +IFN LISTSW,CAILE A,15 + POPJ P, +IFN LISTSW,[CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +] + +;;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,SYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO I,UNRCHF ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +GETSYL: TLZ I,UARI+NPRC +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,[DECP+FLO+VAR+GLI+LSRET,,PERI+LET+SYL] +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: TRNN I,SYL ;NOT SET => SYLLABLE TERMINATOR: SYL? + JRST CABPOP ;NO SYL + TRNE I,LET + POPJ P, ;SYL HAS LETTERS + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,NPRC + PUSHJ P,NUMSL + TLNN I,FLO + 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 + ERR 'EPO ;EXPONENT OVERFLOW +RR9: TLZ I,GLI+VAR ;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 UNRCHF 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,VOT\MACRCH\TTYRCH ;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 I,UNRCHF ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES (SOMETIMES RETURN HERE FROM RREOF) +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF": PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RR1-1 +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,LET\SYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,SYL ;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,LET\SYL + TRO I,SYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN UNRCHF SET +SEMIC": PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + CAIE A,15 ;CAIG A,15 ;SEE IF SPECIAL + JRST SEMIC ;XCT RPATAB(A) ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;JRST SEMIC ;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 + + ;JSP CH2,RR2 => DIGIT (FROM GDTAB) + ;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: TRNE I,LET + JRST RR2A ;NAME + TRZE I,PERI + TLO I,FLO ;FLOATING POINT + PUSHJ P,MAKNUM ;UPDATE NUMTABS +RR2A: XCT NSQTB-"0(A) ;UPDATE SYM + JRST 1(CH2) ;SKIP-RETURN + +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,FLO + 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 + POPJ P, + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,FLO + 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,DECP ;PREFER DECIMAL + TROE I,PERI ;SET PERIOD FLAG + TRO I,LET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RRL2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP + SKIPN CONDEP ;IF A CONSTANT TO TERMINATE, + JRST RBRAK1 + AOS CONEND ;SET FLAG TO END CONSTANT AT ASSEM1, + SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK1: SKIPE CONSML ;STRAY BRACKET ERROR UNLESS OLD MODE. + ERR (SIXBIT/NO[/) ;] + JRST RRL2 + +FORMF: TLNE FF,VOT\MACRCH\TTYRCH ;FORM FEED SYLLABLE OPERATOR ROUTINE + JRST RR10 ;CHARACTER CAME FROM RCH, THIS PROBLEM ALREADY TAKEN CARE OF + SETZM CLNN ;CLEAR OUT LINE NUMBER + AOS CPGN ;INCREMENT CURRENT PAGE NUMBER + JRST RR10 + +LINEF: TLNE FF,VOT\MACRCH\TTYRCH ;LINE FEED SYLLABLE OPERATOR ROUTINE + JRST RR10 + AOS CLNN ;INCREMENT CURRENT LINE NUMBER + JRST RR10 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,FLD ;SET FLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FLD 9/6/70 + JRST RRL2 ;FALL BACK IN + + ;DECIPHER A VALUE FROM NUMTABS + ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B + +NUMSL: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,DECP+VAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,GLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,VAR ;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,FLO + JRST FIX ;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 + MUL 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,FLO + 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,LET + 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,FLO +FIX: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ERR 'XSG ;SIG CHECK + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIVI AA,(D) ;DIVIDE HIGH PART BY APPROPRIATE RADIX + ADD B,A + MOVEI A,0 ;NOW TURN A/B INTO DOUBLE PRECISION POSITIVE VERSION OF C(B) + TLZE B,400000 + MOVEI A,1 + DIVI A,(D) + AOJL T,NUMSL6 + JRST NUMSL2 + +UPARR: TRON I,SYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,LET + ERR 'ILF ;LETTERS IN LEFT OPERAND TO UPARROW + PUSHJ P,NUMSL ;DECIPHER NUMTABS + TLO I,UARI ;SET INDICATOR (USED BY BACKARROW) + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + TLZ I,UARI + 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 + TLO I,NPRC + JRST RR8 + +UPCTRC: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH A,6 ;SHIFT ACCUMULATED VALUE OVER 6 (NOT ENTIRELY CLEAR IT SHOULD BE 6, BUT...) + ANDI T,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD A,T ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +BAKAR: TLNE I,UARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,SYL + TRNE I,LET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,NPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,FLO + POPJ P, + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + PUSHJ P,RCH + CAIN A,"- + TROA I,GMINF + TLO I,UNRCHF + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO I,UNRCHF +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,LET + JRST UA3S ;NAME + TLNE I,FLO + ERR 'ILF ;RIGHT OPERAND IS FLOATING POINT +UAR2: TRZN I,GMINF + SKIPA T,A + MOVN T,A + MOVEI TT,SGTSY1 + JSP LINK,POPLIS + 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,LSRET + PUSHJ P,LSSTH + PUSH P,A + PUSHJ P,RCH + CAIN A,"! + JRST .-2 + HLRZ T,GDTAB(A) + CAIE T,(POPJ P,) + ERR 'NOS ;> NOT FOLLOWED BY BREAK CHAR + HRRZ A,GDTAB(A) + MOVE A,DTB-40(A) + MOVEM A,CDISP + POP P,A +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +DQUOTE: TRON I,SYL + JRST DQUOT8 + TRNN I,LET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO I,UNRCHF ;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. + 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? + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;HAS THE RIGHT SUPPRO, TOO, MUST BE THE ONE. + SKIPN BKTAB+2(T) ;ELSE THIS IS ALTERNATE CHOICE + JUMPGE D,DQUOT1 ;(BUT PREFER DEFINED TO UNDEF) + HRROI D,(T) ;LEAVE SIGN OF D SET + SKIPE BKTAB+2(T) + ANDI D,-1 ;UNLESS THE ALTERNATE IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;HAVEN'T FOUND BEST POSSIBLE BLOCK. + SKIPGE ESBK ;IF SUPPRO WASN'T SPEC'D + CAIN T,-1 ;USE THE ALTERNATE CHOICE IF ANY. + CAIA + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ERF 'TMB ;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: SETZB SYM,ESBK ;BLOCK .M SPEC'D - SET TO OUTERMOST BLOCK. + JRST DQUOT3 + +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. + +SQUOT1: TLOA I,VAR +DQUOT7: TLO I,GLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: JSP F,QOTCOM ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH A,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD A,T ;ADD IN ASCII CHARACTER IN T + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,SYL + JRST SQUOT1 + JSP F,QOTCOM ;SIXBIT SYL + CAIGE T,40 + ERR 'N6B ;NOT SIXBIT + CAIL T,140 + SUBI T,40 ;CONVERT TO UPPER CASE + LSH A,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI A,-40(T) ;ADD IN SIXBIT FOR CHARACTER IN T + 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 + +QOTCOM: PUSHJ P,RCH ;GET FIRST CHARACTER + PUSH P,A ;SAVE IT, WILL USE IT NO MATTER WHAT IT IS + PUSHJ P,GSYL ;NOW GET NAME + MOVE B,STRCNT ;GET STRING COUNT, ONE MORE THAN # NON-BREAK CHARS READ BY GSYL + TLO I,UNRCHF ;SET FLAG TO RE-INPUT DELIMITING CHARACTER + POP P,T ;NOW GET BACK THAT FIRST CHARACTER + MOVE D,[440700,,STRSTO] ;SET UP BYTE POINTER TO STRING STORAGE + TDZA A,A ;CLEAR OUT ACCUMULATED VALUE AND FALL IN +QOTCM2: ILDB T,D ;GET CHAR FROM STRING + PUSHJ P,(F) ;PROCESS CHAR + SOJG B,QOTCM2 ;DO IT THE APPROPRIATE NUMBER OF TIMES + MOVE T,A + JRST TEXT5 + +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 +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,SYL + ERR 'NOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,SYL + 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 + PUSHJ P,(LINK) +SGTSY1==. + +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 + PUSHJ P,(LINK) +SAVL1==. + + ;(ALMOST) GENERALIZED POP ROUTINE + +POPLIS: POP P,F ;FIRST ENTRY ON PDL PC STORED BY PUSHJ AT END OF PUSH ROUTINE + CAIE TT,(F) ;TT SHOULD BE INDEPENDENTLY SET UP BY CALLING ROUTINE W/ SAME VALUE + HALT ;ROUTINE VERIFIES THIS AND KILLS ASSEMBLY IF DISAGREE + +POPLS1: HLRZ F,-2(TT) ;NOW FOR THE ACTUAL POPPING: GET NEXT PREV. INSTRUCTION IN PUSH ROUTINE + CAIE F,(PUSH P,) ;IF NOT PUSH + JRST (LINK) ;THEN DONE, RETURN + POP P,@-2(TT) ;PUSH, POP OFF WORD PUSHED + SOJA TT,POPLS1 + + ;POP OFF WHAT PUSHED BY SAVWLD (FOR WHICH POPLIS DOESN'T WORK) + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(WRDF)] + 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 + ;FOLLOW PUSHJ WITH INSTR EXECUTED IF SYM NOT FOUND + +AGETFD: MOVE CH1,@(P) ;GET ERROR INSTRUCTION + MOVEM CH1,GTVER ;STORE APPROPRIATELY + PUSH P,I ;SAVE I + TRO I,PSEUDF ;SET FLAG TO GETVAL TO EXTCUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,WRD + SETZM WRD +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA I,UNRCHF ;DELIMITER IS WORD TERMINATOR + TRNE I,FLD + AOSA -2(P) ;CAUSE RETURN TO SKIP OVER ERROR UUO + JRST AGTFD3 ;NO FIELD, TRY AGAIN + TLNE I,MWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + MOVEM I,ISAV ;SAVE FLAGS FOR FLD GOTTEN + POP P,I + 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 +RGTFD3: PUSHJ P,GETFLD ;READ UNTIL FIELD TERMINATOR + MOVE CH1,CDISP + TLNN CH1,DWRD ;WAS FIELD TERMINATOR WORD TERMINATOR? + TLOA I,UNRCHF ;YES + TRNE I,FLD ;NO, SKIP IF NO FIELD, GO BACK AND TRY AGAIN + JRST .+2 + JRST RGTFD3 + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,MWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +GETFLD: PUSH P,GLSP2 + PUSH P,GLSP2 + PUSH P,PPRIME + PUSH P,GLOBT + MOVE A,GLSP1 + MOVEM A,GLOBT + MOVEM P,PPRIME + TRZ I,FLD+OPFLD +GETFD1: TLNE I,MWRD + JRST .+3 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,LET + 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 + MOVEI TT,0 ;NO DISP MEANS FD TERMINATOR + TRNE I,SYL + TRO I,FLD + JSP LINK,GETFD2 ;EVALUATE WHATEVER HASN'T BEEN + SUB P,[4,,4] ;NOW POP OFF CRUFT FROM PDL + POP P,GLOBT + POP P,PPRIME + SUB P,[2,,2] + POPJ P, + + ;JSP LINK,GETFDA ;STORE SPECIFICATIONS OF OPERATOR, OPERAND; + ;MAYBE EVALUATE CRUFT ON LEFT + ;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, + ;C ADR OF ROUTINE TO PERFORM OPERATION, TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD1 ;ENTRY FOR NORMAL ROUTINE (RETURNS TO GETFD1) SO CAN DO JSP C,GETFDL +GETFDA: TRO I,FLD+OPFLD + TRNN I,SYL + AOS TT,GETCNR ;UNARY +GETFD2: CAMN P,PPRIME + JRST GETFD3 ;TOP OF LIST + HLRZ T,(P) ;GET PREC + CAMLE TT,T ;COMPARE TO CURRENT + JRST GETFD3 ;WAIT UNTIL LATER + HRRZ T,(P) + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + ;PDL AS SEEN BY OPERATOR ROUTINES: +GETFD3: PUSH P,GLSP1 ;-3(P) POINTS TO HIGHEST GLOTB ENTRY OF LEFT OPERAND (ALSO JUST BEFORE RIGHT) + PUSH P,B ;-2(P) HAS RELOCATION BITS OF LEFT OPERAND + PUSH P,A ;-1(P) HAS VALUE OF LEFT OPERAND + HRL C,TT + PUSH P,C ;(P) HAS OF OPERATOR + JRST (LINK) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVEI 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 + MOVE T,-3(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,-1(P) ;ADD VALUES + ADD B,-2(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: MOVEI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE -2(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,-1(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST .+3 +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,-2(P) ;RELOCATION BITS OF LEFT OPERAND + MOVE D,-3(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,-7(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,-1(P) ;MULTIPLY VALUES + IMUL D,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + JRST GETFD4 +MULTP4: ERSM 'IRL ;ILLEGAL RELOCATION * / + JRST GETFD4 + +GMUL1: TLNE FF,PPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ERSM 'IMY ;ILLEGAL MPY (BOTH OPERANDS GLOBAL DURING PUNCHING PASS) + SKIPA D,-7(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,-1(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 -2(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,-1(P) + IDIV A,-1(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,-7(P) + CAME D,GLSP1 + ERSM 'IDV ;AT LEAST ONE OF DIVISION OPERANDS GLOBAL DURING PUNCHING PASS + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVEI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,-1(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVEI TT,34 ;# + TRNN I,SYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,-1(P) + +IORF: MOVEI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,-1(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE -2(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,-7(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ERSM 'IBL ;GLOBALS IN BOOLEAN + JRST GETFD4 + +CBAKAR: MOVEI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL + JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + MOVE T,A + MOVE A,-1(P) + LSH A,(T) + JRST GETFD4 + +OPEN: PUSH P,D ;CLOSE DELIMITER, SET UP BY CALLING ROUTINE + PUSHJ P,GETWRD ;GET WORD + POP P,D ;RESTORE DELIMITER + CAME D,LIMBO1 ;IF AGREES WITH LAST CHAR READ, + TLNE I,MWRD ;OR IF READING MULTIPLE WORD + POPJ P, ;THEN OK + MOVE D,LIMBO1 ;NEITHER, GET LAST CHAR + CAIE D,15 + CAIN D,12 + SKIPE CONSML ;CR OR LF => OK IN OLD MODE. + ERR 'ILC ;ILLEGAL CLOSE + POPJ P, + +LSSTH: MOVEI D,"> + JSP LINK,SAVWD1 + PUSHJ P,OPEN + TLNE I,MWRD + PUSHJ P,IGTXT ;NOT INTERESTED IN MULTI-WORD CRUD +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + TLZE I,LSRET + JRST LSSTHR ;RETURN TO ^ OR _ + +;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,SYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ERR 'NOS +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 I,UNRCHF ;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. + CAIE A,12 + CAIN A,14 + JRST LSSTH7 ;THESE CHARS ARE SYLL. OPS. + CAIE A,"_ ;BUT DON'T CONSTITUTE A FOLLOWING SYLL, SO OK. + CAIN A,"] + JRST LSSTH7 + CAIN A,"; + JRST LSSTH7 + TLNE CH1,DSYL + JRST LSSTH4 ;SYLLABLE OPERATOR +LSSTH7: PUSHJ P,GETSYL +LSSTH6: TRO I,SYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + JRST GETFD6 + +LSSTH1: ADDM A,WRD + ADDM B,WRDRLC + TRNE I,SYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ERR 'NOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: SUB P,[2,,2] + JRST GETFD1 + +LSSTHR: +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,") + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,OPFLD + TRNE I,SYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,OPEN + 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 + TLNE I,MWRD + PUSHJ P,IGTXT + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + + ;VERSION OF GETWRD FOR PSEUDO + ;FOLLOW WITH UNDEFINED SYM ERROR MESSAGE + +AGETWD: MOVE CH1,@(P) ;GET ERROR UUO + MOVEM CH1,GTVER ;STORE APPROPRIATELY + TRO I,PSEUDF\DEF + PUSHJ P,GETWRD + TLNE I,MWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + JRST POPJ1 + +;;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,[WRDF,,AIOWD] + 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 + MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + MOVE C,CDISP + 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,FLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,WRDF ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ERR 'UFM ;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,AIOWD + 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,AIOWD + POPJ P, + +SPACE2: POP P,A +COMMA: TRNN I,FLD ;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 +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 + 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 FLD, 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: PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,", ;FIRST NON-SPACE CHAR COMMA? + JRST SPACE2 ;YES + POP P,A ;NO, RESTORE A + TLO I,UNRCHF ;CAUSE CHAR TO BE RE-READ NEXT TIME + TRNN I,FLD + 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 + ERR 'IRL ;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 + ERR 'IGS ;GLOB SYM APPEARS 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,AIOWD ;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: TLNE I,MWRD + JRST ASSEM2 ;ASSEMBLING MULTIPLE WORD + SKIPG CONSML ;UNLESS IN MULTI-LINE MODE, + JSP LINK,CONFLA ;FLUSH CONSTANTS, ERROR IF ANY AND CONSML < 0. + SKIPE CONEND ;IF DIDN'T FLUSH AND SAW RBRKT, END CONST. + JRST CONND +ASSEM3: PUSHJ P,RCH + CAIG A,40 + JRST .-2 ;FLUSH LEADING GARBAGE + TLO I,UNRCHF ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +ASSEM2: TRZ I,FLD+SYL+LET+PSEUDF+COM+CONT+GMINF+OPFLD + TLZ I,GLI+VAR+FLO+DECP+UARI+MNSFLG+WRDF+NPRC + TRO I,DEF + TLZ FF,SKILF + MOVE P,ASSEMP + HRRZM P,GETCNR ;MAKE SURE PREC OF UNARY OPS FITS IN A HALFWORD DURING LONG ASSEMBLIES + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 + PUSHJ P,GETWRD + TLZN I,WRDF + JRST ASSEM0 ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + SKIPE CONDEP + JRST ASSEM4 + SKIPE STGSW ;NOT INSIDE CONSTANT + ERR 'SWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST ASSEM1 + +ASSEM0: SKIPN CONDEP ;IF IN CONSTANT, MAYBE SHOULD END IT. + JRST ASSEM1 + CAIA +ASSEM4: JSP T,PCONST ;OUTPUT WORD TO CONSTANT. + SKIPE CONEND ;SAW BRACKET => END IT. + JRST CONND + SKIPG CONSML ;NEW MODE => OTHERWISE DON'T END. + TLNE I,MWRD ;SAME IF INSIDE MULTIPLE WORD PSEUDO. + JRST ASSEM1 + SKIPE CONSML ;CLOSING CONST. WITH CR OR LF, [ + ERR (SIXBIT/NO]/) + JRST CONND + +;;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 ;ERROR UUO (OR WHATEVER) TO EXECUTE ON UNDEFINED SYMBOL IN PSEUDO + JRST CABPOP +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,GLI + 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,PSS ;IF PASS 2 + TLNN I,VAR ;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,GLI ;UNDEF LOC 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: TLNE C,3LLV ;UNDEF LOCAL + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,GLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,VAR ;IF ', MAKE VAR (WILL CHECK GLI) + JRST GVUL1 + TLZN I,GLI ;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,GLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,VAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: 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,VAR+GLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + HRRI C,0 ;FORCE OUTERMOST BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,COM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLZE I,VAR+GLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + ERSM 'ILV + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLZE I,VAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ERSM 'MDV + TLZN I,GLI + 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. + + GVDG: TLZE I,VAR ;GLOBAL ENTRY + ERSM 'MDV ;MDGV + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + +;COME HERE FOR DEF GLOBAL THAT HASN'T HAD VALUE PUNCHED. +GVDG1: SKIPGE CONTRL + JRST GVDG2 ;DON'T PUNCH VALUE IF ABSOLUTE. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,PSEUDF+EQLF + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,EQLF + TRNN I,PSEUDF + TLNN C,3REL +GVDLV2: TLNE C,3LLV + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + BYB LDB B,C,\3RLR_18. + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUGV: +GVUNDF: TRZ I,DEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,PSEUDF + JRST GTVER ;PSEUDO + TRNN FF,PSS + JRST GVGLTB ;PASS 1 + SKIPN CONDEP + ERSM 'USW + SKIPE CONDEP + ERSM 'USC + JRST CABPOP + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +;SHOULD BE CALLED ONLY IN RELOCATABLE ASSEMBLY. +PLOGLO: 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 + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;RETURNS CRUD AS DOCUMENTED IN COMMENTS, SKIPS IF FOUND +;DOESN'T CLOBBER F (FOR WRQOTE) +;ESBK SHOULD HAVE -1 OR SPEC'D BLOCK (AS SET BY GETSYL FOR INSTANCE) +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, EVEN IF NOT BEST. +;ESL1 HAS LEVEL OF BEST, -1 IF NONE. +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF PLACE TO DEFINE SYM. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ES: MOVN TT,SYMLEN ;-<# STE'S IN SYMTAB> + SETOM ESLAST + SETOM ESL1 + MOVE C,SYM ;HASH AWAY + TSC C,C + MOVMS C + IDIV C,SYMLEN + IMULI D,WPS + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. + SETOB C,ESXPUN ;NO EXPUNGED OR FREE ENTRY FOUND. +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. + JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + 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. +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: ADDI D,WPS + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +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. + TRNE FF,NPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + SKIPA C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: MOVEM D,SADR ;FOUND IN CURRENT BLOCK. + LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +CPOPJ: POPJ P, + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3INI ; OR INSN, OK; ELSE GET NEW STE TO DEF. + JRST ES1POK +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. + ERF 'SCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADDI D,WPS + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ERF 'SCE + +;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, + + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TRNN I,OPFLD+PSEUDF + TRNN I,LET + ERA 'IPA ;ILLEG ARG EQ + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVE A,[ERSM 'USP] + MOVEM A,GTVER + TRO I,PSEUDF+DEF+EQLF + PUSHJ P,RCH + CAIE A,"= + TLOA I,UNRCHF + TLO FF,SKILF + PUSHJ P,GETWRD + MOVEI CH1,CRDF + MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION + TRNN I,DEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +] + TDZ I,[-1-(MWRD)] + IOR I,(P) + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT OR GLOBAL LOC CTR. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + JUMPGE FF,EQG2 ;(UNDEF SYMS GIVE GLOBAL REFS, 1ST PASS) + SKIPGE CONTRL + ERA 'IPA ;UNDEF GLOBALS & NOT RELOCATABLE? +EQG2: PUSHJ P,ESDEF ;GLOBALS TO RIGHT + JRST EQL2 ;NOT FOUND + JRST .+1(A) + ERA 'IPA ;COMMON + ERA 'IPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ERA 'IPA ;DEF LOC VAR + ERA 'IPA ;UNDEF LOC VAR + ERA 'IPA ;DEF GLO VAR + ERA 'IPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY +EQL8: JUMPE B,EQL7 ;GLO EXIT REACHED BY DISP + PUSHJ P,GLKPNR +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE FF,SKILF + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + SKIPN PARBIT ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. +EQL2: TLNE I,GLI + 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,CONT + POPJ P, ;DON'T PUNCH REQUEST + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,CONT ;OK TO END BLOCK NOW + JRST OUTPUT ;PUNCH OUT A AND RETURN + +;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,PPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + TRO I,CONT + PUSHJ P,P70 ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,CONT + JRST OUTWD ;OUTPUT VALUE + + ;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDEF + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + JRST .+1(A) + ERA 'IPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ERA 'IPA ;DEF LOC VAR + ERA 'IPA ;UNDEF LOC VAR + ERA 'IPA ;DEF GLO VAR + ERA 'IPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY +EQL1E: PUSHJ P,GLKPNR ;GLO EXIT REACHED BY DISP DUMP LINKING POINTER +EQL1D: PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,SKILF + 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,MWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +EQL1C: TLNE I,GLI + 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,SKILF + 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. + ERSM 'QPA ;ELSE TURN INTO NORMAL SYM. +EQL1B: PUSHJ P,RCHKT + TLNE I,GLI + 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: +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,GLI + JRST EQL1A1 + JRST EQL1D + +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 + ;GLOLOC (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: TLNE FF,INDEFF + JRST GTVLP1 ;LOCATION INDEFINITE + TRNE FF,GLOLOC + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM ;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,FLO+DECP+PERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + +GTVLP1: TLNE FF,PPSS ;LOCATION INDEFINITE + ERSM 'PNI + JRST CABPOP + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM ;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: TLNN I,WRDF + TRNN I,SYL + ERA 'ILF ;COLON WITHIN STORAGE WORD OR NOT PRECEDED BY SYL + TRNN I,OPFLD+PSEUDF + TRNN I,LET + ERA 'ILT ;COLON WITHIN FIELD OR PSEUDO, OR SYL NOT NAME + TLNE FF,INDEFF + ERA 'CLI ;COLON WHEN LOCATION INDEFINITE + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,SKILF ;THEN SET FLAG TO HALF-KILL + TLO I,UNRCHF ;NOT COLON, CAUSE IT TO BE RE-INPUT + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + CLEARM PARBIT ;SET FLAG SAYING COLON + SKIPN LDCCC + TRNE FF,GLOLOC + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDEF ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: JRST .+1(A) + ERA 'MDT ;COMMON + ERA 'RES ;MACRO OR PSEUDO + JRST COLON4 ;SYM + JRST EQL1C ;LOCAL UNDEF + ERA 'MDT + ERA 'MDT + ERA 'MDT + ERA 'MDT + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +COLON4: CAME B,WRD + JRST COL4E + PUSHJ P,GVSYM0 ;GET PREV. RELOC IN B. + CAME B,WRDRLC +COL4E: ERA 'MDT ;MDGS +CASSM1: JRST ASSEM1 + + ;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + PUSHJ P,ESDEF ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + JRST .+1(A) + + ERA 'MDT ;COMMON + ERA 'RES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + ERA 'MDT ;VAR + ERA 'MDT + ERA 'MDT + ERA 'MDT + 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 + ERSM 'USL ;IF UNDEFINED SYM IN LOC +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + SKIPGE B,CONTRL + TRNN B,DECREL ;(IN DEC FMT DON'T CLOBBER BKBUF) + HRRZM A,BKBUF ;ALSO STORE IN BKBUF IN CASE WANT TO OUTPUT NULL BLOCK + 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 +ABLK2: TRO FF,LOCF ;INDICATE ABS LOC ASSGT, FORCE EBLK TO OUTPUT LOCATION TO STINK +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ERR 'LAI ;ILLEGAL RELOCATION ATTEMPTED IN LOCATION ASSIGNMENT + 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 GLOLOC SHOULD BE SET + TRZA FF,GLOLOC ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,GLOLOC ;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: PUSHJ P,ALOCRG ;.=, GET ARG + ERSM 'USP ;HE'LL FIGURE IT OUT + 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 ;BLOCK, GET ARG + ERSM 'USB ;UNDEFINED SYM IN BLOCK + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JUMPN B,ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL + 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 + JRST ABLK2 ;FALL INTO ALOC ROUTINE, MAKING SURE LOCF GETS SET + +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 + + ;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: TLZ FF,INDEFF ;THIS SHOULD BE IMPROVED SOMETIME +ABLKRG: SKIPN CRLOC ;IF ADDR. BEFORE LOC WAS RELOC, + JRST ABLKR1 + MOVE A,CLOC + CAML A,DECBRK ;USE IT TO UPDATE THE MAX. RELOC. ADDR. SEEN. + MOVEM A,DECBRK +ABLKR1: PUSHJ P,CONBAD ;ERROR IF IN LITERAL. + MOVEI A,", ;CALLED WITH PUSHJ, FOLLOWED BY INSTR EXECUTED IF UNDEFINED + MOVEM A,LIMBO1 ;START OFF WITH COMMA TO TRUNCATE TO HALFWORD (BLETCH!) + TLO I,UNRCHF ;CAUSE IT TO BE (RE)INPUT +AOFFS2: MOVE A,@(P) ;ENTRY FROM AOFFSET, GET ERROR ARG + MOVEM A,GTVER + TRO I,PSEUDF\DEF + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,GETWRD ;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 + TRNE I,DEF ;ALL DEFINED? + JRST POPJ1 ;YES, RETURN SKIPPING OVER ARG + TLO FF,INDEFF ;LOCATION := INDEFINITE + MOVE A,[SQUOZE 0,INDEFF] + MOVEM A,SYSYM + MOVE A,CLOC + MOVEM A,SYLOC + JRST ASSEM1 + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + ERSM 'USO ;UNDEFINED SYMBOL IN OFFSET + 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 + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK +BLCODE [CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND NOOPTF BIT(SEE CPTMK) +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE + ;EACH ENTRY TWO WORDS + ;FIRST WORD GLOTB ENTRY + ;SECOND ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +PLIM: 0 ;POINTER TO TOP OF CONTAB, HAS ADR OF FIRST UNUSED WORD +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONGLO + + ;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 CONTAB 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. +CONEND: 0 ;SET BY RBRAK TO FORCE END OF CONSTANT. + + ;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 + +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: TRO I,FLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + AOS CONDEP ;ONE DEEPER IN CONSTANTS + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + SETZM SCNDEP + 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,[ERF 'PDL] + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,PPRIME + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + 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 + 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,NOOPTF ;REMEMBER NOOPTF 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,[ERF 'PDL] + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +PCONST: SKIPE CONEND ;OUTPUT TO CONST. FROM ASSEM1; 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,MWRD+MWRD1 ;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 RBRKTF STILL SET) +CONNDW: PUSH P,CONSTP ;CONSTP WILL POINT TO NEXT WD OF CONST. + TLZ I,MWRD1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,MWRD+NOOPTF + SETZM WRDRLC + MOVE F,CONSTP ;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,NOOPTF ;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,CONSTP + CAME F,ASSEMP ;IF MORE WORDS SET MWRD + TLO I,MWRD + 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,MWRD+MWRD1+NOOPTF + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVEI A,CONTAB +SCON1: CAML A,PLIM ;SEARCH CONTAB 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 CONBIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVEI B,CONGLO ;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 + CAILE A,CONTAB+LCONTB + ERF 'TMC + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,NOOPTF + 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 + CAIL AA,CONGLO+LCNGLO + ERF 'TMC ;TOO MANY CONSTANT GLOBAL REFERENCES + POPJ P, + + ;SET UP BYTE POINTER TO CONBIT TABLE + ;A SHOULD HAVE ADR OF CONTAB ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONBIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 NOOPTF BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUBI A,CONTAB + PUSH P,B + IDIVI A,12. + MOVEI C,CONBIT(A) ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD + POP P,B + JRST POPAJ + NOCON4: TLON I,MWRD1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,MWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,(P) ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONTAB 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 CONTAB + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUBI A,CONTAB + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +CONNDP: INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,PPRIME,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: POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + SETZM CONEND + JRST (T) + +CONFLA: SKIPGE CONSML ;FLUSH CONSTANTS, IN ERROR MODE ERROR IF ANY. + SKIPN CONDEP + CAIA ;[ +CONFLM: ERR (SIXBIT/NO]/) +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + SKIPN CONDEP ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN CONDEP ;IF IN CONSTANT, ERROR. + POPJ P, + ERSM 'IPC + JRST ASSEM1 + + ;CONSTA + +CNSTNT: SKIPE CONDEP ;IF ANY CONSTANTS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSH P,CASSM1 ;CAUSE RETURN TO ASSEM1 +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ERF 'TCA ;TOO MANY CONSTANTS AREAS + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,PSS + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,GLOLOC + TLC A,CGBAL + SKIPN A + ERR 'CVD + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ERR 'CLD + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ERR 'CRD + ;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,GLOLOC + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVEI A,CONTAB +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 + MOVEI C,CONGLO +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONGLO + 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 CONTAB + 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? + ERR 'ICS ;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 + TRO FF,LOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + + ;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,GLOLOC + 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 + SUBI T,CONTAB + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,GLOLOC + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,NPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,CONT ;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,OUTPUT + HRRZ A,1(T) + PUSHJ P,OUTPUT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,CONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,PSS + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVEI A,CONTAB + MOVEM A,PLIM + MOVEI A,CONGLO + 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 CONGLO TABLE + +CONBUG: MOVEI A,CONGLO ;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 CONGLO 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 CONGLO 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 CONTAB + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ERA 'CRI ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONGLO 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 CONGLO 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: MOVEI A,CONGLO + PUSH P,B + MOVEI B,CONGLO +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) + ERA 'CRI + ANDCB B,CH1 + JRST CONB8A + + ;VARIAB + +AVARIAB: PUSH P,CASSM1 ;RETURN TO ASSEM1 +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ERF 'TVA ;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,PSS + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2 + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ERR 'VLD + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ERR 'VRD + SKIPE VARCNT + ERR 'VND + +AVAR2: 3GET C,D + 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: ADDI D,WPS-1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB + HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + TRO FF,LOCF + 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,GLOLOC + 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,GLOLOC + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,OUTPUT + 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 +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] JRST SIMBLK ;SELECT SBLK 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,[PPSS,,PSS] ;SET PUNCHING PASS AND PASS 2 FLAGS + TRZ FF,GLOLOC ;RE-INITIALIZINT CURRENT LOCATION, CLEAR GLOBAL LOCATION FLAG + 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? + ERSM 'USW ;NO, JUST PLAIN UNDEFINED +PA2B: ADDI A,WPS-1 ;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. + 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 + TLNN C,3INI ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: AOS A + 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 + TDZ FF,[-1-VOT-PTPF-TTYRCH,,-1] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,CONGLO + MOVEM A,CONGOL + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVE A,[SQUOZE 0,.MAIN] + MOVEM A,PRGNM + MOVEIM BKTABP,BKWPB + ;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKLVL,BKPDL,BKCUR +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK] + AOS A.PASS + TLZ FF,INDEFF + MOVEI A,NCONS + MOVEM A,CONCNT + MOVEI A,VARTAB + MOVEM A,VARPNT + MOVEI A,NVARS + MOVEM A,VARCNR + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,CONTAB + MOVEM A,PLIM + 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 + MOVEI A,100 + MOVEM A,CLOC + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + TRO FF,IPSYMS+FIRWD + 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]] + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + SETOM CONSML ;START OUT IN ERROR MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC +] +IFN CREFSW,[ + JUMPGE FF,P2INI1 + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +P2INI1:] + AOSLE TTYINS ;MAYBE WE SHOULD .INSRT TTY:. +CRETN: POPJ P,RETURN + TYPR [ASCIZ/TTY INPUT, END WITH .INEOF +/] +IFNDEF GTYIPA,HALT ;SHOULDN'T SET TTYINS IF CAN'T INSRT TTY. +IFDEF GTYIPA,JRST GTYIPA ;ACTUALLY PUSH TO TTY. + +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,IPSYMS + 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. + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + SETZM WRDRLC + PUSHJ P,PWRD + SETZ A, ;OUTPUT A ZERO WORD. + 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,OUTPUT + PUSHJ P,EBLK + TLZ FF,OUTF + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,CONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK + MOVE B,SYMAOB + JRST SSYMDR + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TLNE CH2,3INI+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL 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 GLOBAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADDI AA,WPS-1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT, + MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,-ST(B) ;AOBJN -> AREA OF SYMTAB IN USE. + IDIVI B,WPS + HRLZI B,(B) + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS. + CAIE C,1 + ADDI C,1 ;BLOCK STRUCTURE => COUNT GLOBAL HEADER. + MOVSI A,(C) + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + MOVEM A,SCKSUM ;SAVE THIS. + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE) + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL + JRST SSYMD6 ;NO BLOCKS IN DEC FMT. + SKIPGE BKTAB1+1 + JRST SSYMG1 ;ONLY 1 BLOCK, PUT ALL IN GLOBAL. + MOVE A,BKTAB(C) + PUSHJ P,PPBCK + HLRZ A,BKTAB+1(C) + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,2] + PUSHJ P,PPBCK ;FOLLOWED BY LEVEL. + JRST SSYMD6 + +SSYMG1: MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK + HRLZ A,BKTAB+2 + ADD A,[-2,,] + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,OUTPUT + HLRZ A,BKTAB+1(C) + PUSHJ P,OUTPUT +SSYMD6: MOVE C,-1(P) ;AOBJN PTR TO 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 + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADDI C,WPS-1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. + JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK. + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3INI + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC 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,OUTPUT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO A,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,OUTPUT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,OUTPUT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + 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 + +;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,[PRINTC /SSYMDT LOSES. +/] + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL + JRST SSYMG3 + SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR, + JRST SSYMG4 + MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK ;PUT A GLOBAL BLOCK WITH NO SYMS AT END. + MOVSI A,-2 + PUSHJ P,PPBCK +SSYMG4: MOVE A,B ;ABS ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0. +BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADDI B,WPS-1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,-WPS(B) ;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. + SUBI B,WPS + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 +REPEAT WPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADDI A,WPS +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 + ERSM 'UCD ;UNDEFINED SYMBOL IN CONDITIONAL +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: PUSHJ P,RCH ;CONDITION FALSE, EAT UP STRING + CAIN A,LBRKT + JRST COND3 +ANULL: TLO I,UNRCHF +ANULL2: PUSHJ P,RCH + CAIE A,15 + CAIN A,12 + JRST ANULL1 + JRST ANULL2 + +COND3: MOVEI C,0 ;LEFT BRACKET ENCOUNTERED + PUSHJ P,RCHCNT ;READ UNTIL MATCHING RIGHT BRACKET + JRST .-1 + JRST MACCR + + ;IF1, IF2 + +COND1: HRRI B,PSS + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,LBRKT ;IF BRACKET-TYPE, + AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + CAIE A,LBRKT ;FLUSH ONLY IF LEFT BRACKET +ANULL1: TLO I,UNRCHF + JRST MACCR + + ;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB C,D ;C HAS BRACKET COUNT, D SQUOZE CHAR COUNT + PUSHJ P,RCH ;GET FIRST CHARACTER + CAIN A,LBRKT + JRST SBCND4 ;ARGUMENT BRACKETED +SBCND2: CAIN A,", ;NOT BRACKETED, CHECK FOR COMMA => END + JRST CONDPP ;END, GO TRY IT + PUSHJ P,SQCKD ;IF CHAR IN A IS SQUOZE, INCREMENT D + PUSHJ P,RCH ;GET NEXT CHARACTER + JRST SBCND2 ;GO PROCESS + +SBCND3: PUSHJ P,SQCKD ;IF CHAR IN A IS SQUOZE, INCREMENT D +SBCND4: PUSHJ P,RCHCNT ;GET NEXT CHAR + JRST SBCND3 ;NOT MATCHING RIGHT BRACKET + JRST CONDPP ;DONE, NOW SEE IF SHOULD ASSEMBLE + + ;IF CHAR IN A IS SQUOZE, INCREMENT D + ;USES GDTAB + +SQCKD: HLRZ B,GDTAB(A) ;GET GDTAB ENTRY + CAIE B,(POPJ P,) ;POPJ => NOT SQUOZE + AOJ D, ;SQUOZE + POPJ P, + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + ERR 'NAM ;NO NAME + 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 + 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 BITF SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,BITF + SOSA A + TRO FF,INVTF + 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,BITF + TRZ FF,BITF + 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 OUTPUT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +OUTPUT: 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,INVTF ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,CONT + 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,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,LOCF + JUMPLE B,EBLK4 ;IGNORE NULL BLOCK UNLESS LOCF SET + TLO FF,OUTF ;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,OUTF ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FIRWD + POP P,B + POP P,A + 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,NLIKF ;SUPPRESS ADR LINKING +PWRD: TRZ FF,NLIKF ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + 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] +] + 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,NLIKF + 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 + BYB LDB A,A,\3RLNK_18. + 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,OUTPUT ;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: BYB LDB A,B,\MINF_18. + 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 + MOVEI A,(B) ;LOCAL, OUTPUT STE ADDR ("PHONY NAME") INSTEAD NAME + 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,OUTPUT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,OUTPUT + 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: 1000,,'IRC + 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 + ERSM 'ROV ;RELOCATION OVERFLOW; TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + + ;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ;DEC FMT IS CONSIDERED ABSOLUTE. + JRST DECPW + MOVE A,GLSP1 + CAME A,GLSP2 + ERR 'ILA ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ERR 'IRA ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FIRWD + 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,FIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + TLO FF,OUTF + 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,GLSP1 +DECPG1: CAMN C,GLSP2 ;ALL DONE => + JRST DECEB1 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP1 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE A,(B) ;GET NAME OF SYM. + TLZ A,740000 + 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 SETS THIS BIT SO I WILL. + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + + ;.LIBRA, .LIFS, ETC. + +A.LIB: 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,SYL + 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: PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,LOCF ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + ERSM 'ULC ;UNDEFINED IN LOADER CONDITIONAL + 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 + +A.GLOB: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST ASSEM1 ;NO NAME => DONE + TLO I,GLI ;SET DOUBLEQUOTE FLAG + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + JRST A.GLOB ;LOOP FOR NEXT SYM + ERSM 'ILG ;ILLEGAL NAME FOR .GLOBAL + JRST A.GLOB ;GET NEXT ANYWAY + + ;.LOP + +A.LOP: SKIPGE CONTRL + ERA 'ILO ;.LOP WHEN NOT IN RELOCATABLE OUTPUT FORMAT + 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: PUSHJ P,GETSLD + JRST ASSEM1 + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LIBRQ + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + +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: ADDI D,WPS-1 + 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 + 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,LOCF ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +AEND: SKIPE CONDEP ; ERROR IF IN CONSTANT. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE BKCUR ;IF NOT IN OUTER BLOCK, ERROR. + ERR 'UMB + MOVE A,CDISP + TLNN A,DWRD + TLO I,UNRCHF ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT + 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 +] + PUSHJ P,AGETWD + ERSM 'USE ;UNDEFINED SYM IN END +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + PUSHJ P,PNTR + PUSHJ P,LPTCLS" ;DONE LISTING + MOVE A,LISTWD +] + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE + TRNN B,DECREL + JRST AEND1A + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST RELOC ADDR SEEN, + SKIPE CRLOC + CAMG A,DECBRK + CAIA + MOVEM A,DECBRK + MOVSI A,DECSTA ;THEN OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD ;WITH THE START-ADDRESS. + PUSHJ P,EBLK + JRST AEND2 + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + +AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART + TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST + PUSHJ P,PPB + JUMPG A,.+3 + ERR 'EWN ;END WORD 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: MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + POPJ P, + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /CONSTANTS AREA INCLUSIVE +FROM TO +/] + BYB LDB B,2(TT),\CGBAL_18. + SKIPE B + TYPR [ASCIZ /GLOBAL+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TAB + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AXWORD: PUSHJ P,GETFLD ;XWD + HRRZ C,CDISP + CAIN C,COMMA + JRST .+3 ;FIELD TERMINATOR WAS COMMA + TRNN I,FLD + JRST AXWORD ;NOT COMMA AND NO FIELD, TRY AGAIN + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + PUSHJ P,GETFLD ;NOW THE SECOND FIELD + TRNN I,FLD ;KEEP TRYING UNTIL A FIELD THERE + JRST .-2 + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.LENGTH: MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH + 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: PUSHJ P,AGETFD ;GET FIELD ARG + ERSM 'USX ;WHAT ELSE TO SAY? + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +AWORD: PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +AEXPUNG: PUSHJ P,GETSLD ;GET NAME + JRST ASSEM1 ;NO MORE NAMES + 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. + JRST AEXPUNG + 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. + PUSHJ P,OUTPUT + JRST AEXPUNG ;LOOP BACK FOR NEXT SYM NAME + +AEQUAL: PUSHJ P,GETSYL + PUSHJ P,ESDEF + MOVEM SYM,ST(D) + PUSH P,D + PUSHJ P,GETSYL + PUSHJ P,ES + ERA 'IEQ +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + POP P,D +IFN CREFSW,[ + LDB SYM,[4000,,ST(D)] + XCT CRFDEF ;CREF THE SYM BEING DEFINED. +] + DPB A,[(400400) ST(D)] + MOVEM B,ST+1(D) + 3GET B,D + TLZ B,3DFCLR ;SAVE OLD 3MAS, 3NCRF + ANDCM C,[3DFCLR,,] + IOR C,B + 3PUT C,D + JRST ASSEM1 + + ;UUO HANDLING ROUTINE + ;41 HAS JSR ERROR + +VBLK +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN TS, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPR_-33 ;TYPR? + JRST TYPR1 ;YES + ;ERROR OF SOME KIND + CAIN T,6 ;6000,,? + JUMPGE FF,ERRET1 ;YES, IF PUNCHING PASS THEN IGNORE + HRRZ T,40 + CAIE T,(SIXBIT /MDT/) ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,(SIXBIT /RES/) + SKIPA T,SYSYM1 + JRST .+4 ;NOT COLON LOSSAGE, SKIP UN-MUNGATUDE + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +IFN TS, PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. + SETZM ERRCCT + 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,TYO ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TAB" ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TAB + 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 + PUSHJ P,TAB ;SEPARATE FROM FOLLOWING WITH TAB + MOVE B,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + PUSHJ P,OCTPNT + PUSHJ P,TAB + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,DPNT] ;TYPE IT OUT IN DECIMAL + PUSHJ P,TAB + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,DPNT] + PUSHJ P,TAB + ;DROPS THROUGH + + ;DROPS THROUGH + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST IAE ;0 => NO RECV + JRST ERR2 ;1000 SYM+MESS + JRST ERR3 ;2000 MESS + JRST ERR6 ;3000 RH(40) HAS JUMP ADR + JRST ERR4 ;4000 IGNORE LINE RET TO ASSEM1 + JRST ERR5 ;5000 RET TO ASSEM1 + JRST ERR2 ;6000 SYM ON PPSS + JRST IAE ;ERF => FATAL. + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYO ;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: ". + "$ + "% + +DPNT: IDIVI A,10. + HRLM B,(P) + SKIPE A + PUSHJ P,DPNT + JRST DPNT1 + +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 TYO + +ERR6: MOVE A,40 ;3000,, => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERR4: PUSHJ P,RCH ;4000,, => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 + +ERR5: MOVEI A,ASSEM1 ;5000,, => RETURN TO ASSEM1 + MOVEM A,ERROR +ERR2: MOVE A,SYM ;1000,, OR 6000,, ON PPSS; TYPE OUT SYM THEN MESSAGE + PUSHJ P,SYMTYP + PUSHJ P,TAB +ERR3: HRLZ B,40 ;2000,, JUST TYPE OUT MESSAGE + PUSHJ P,SIXTYO + PUSHJ P,CRR +ERRET1: POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + + ;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYO + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +IAE: HRLZ B,40 ;OP CODE 0 => NO RECOVERY RETURN TO GO2 + PUSHJ P,SIXTYO + PUSHJ P,TAB + SOS B,ERROR ;MAKE OUTPUT POINT TO ERROR INSTRUCTION + PUSHJ P,OCTPNT +IFN TS-DECSW,.RESET TYIC, + JRST GO2" + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] + 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,TYO ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + ;OUTPUT-FORMAA SELECTING PSEUDOS: + +;.SLDR -- PUNCH OUT SBLK LOADER NOW AND SELECT SBLK FORMAT +A.SLDR: 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 +SRIM: TRO FF,NPSS ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSM B,CONTRL ;STORE NEW CONTRL + PUSHJ P,OUTUPD + JRST ASSEM1 + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS OTHER THAN 1PASS AND .LIBRA +OUTUPD: IFN A1PSW,[ + TRNN FF,PSS ;IF PASS 1, + TLZ FF,PPSS ;THEN INDICATE NOT PUNCHING PASS + TROE FF,NPSS + TLNN FF,OUTF + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,OUTF + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] POPJ P, + +ANOSYMS: TRZ FF,IPSYMS + JRST ASSEM1 + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,PPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] + TRZA FF,NPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,LOCF ;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 POPJ1 + +A.DECREL: PUSHJ P,OUTUPD + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + 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 POPJ1 + +ATITLE: PUSH P,CASSM1 ;RETURN TO ASSEM1 + TRNN FF,PSS ;PRECEDE W/ CR ON PASS 1 + PUSHJ P,CRR + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT1 ;CHAR IS SYLLABLE TERMINATOR + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? + JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR + PUSHJ P,TYO ;NEITHER OF THESE, PRINT CHAR +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;ATIT1 POPJ'S. + ERJ A.ERR1 ;PRINT RANDOM INFO, EXIT TO A.ERR1 . + +APRNTC: +APRNTX: MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH + MOVE T,A +APRTX1: PUSHJ P,RCH + CAIN A,"! + JUMPGE B,.-2 + CAMN A,T + JRST ASSEM1 + PUSHJ P,TYO + JRST APRTX1 + ;.BEGIN - START NEW BLOCK WITH NAME = LAST LABEL DEFINED. +A.BEGIN: SKIPE CONDEP ;IF IN LITERAL, 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? + ERSM 'MDB + 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. + ERF 'TMB + 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 + ERF 'BTD ;(BLOCK PDL OV) + MOVEM C,BKPDL(A) + JRST ASSEM1 + +;.END - POP CURRENT BLOCK. +A.END: SKIPE CONDEP ;IN CONSTANT => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO I,UNRCHF ;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 + 1000,,'UMB ;ERROR, PRINT SYM (BLOCK'S NAME) + JRST A.END1 + +A.END0: SKIPN BKCUR ;NO ARG, OK TO END ANY BLOCK + 5000,,'UMB ;EXCEPT OUTERMOST. +A.END1: MOVE C,BKCUR + 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 +;IN WHICH INITIAL SYMS ARE DEFINED, AS WELL AS ALL SYMS IN +;PROGRAMS NOT USING BLOCK STRUCTURE. +;ITS 2ND AND 3RD WDS ARE 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 [ +PRGNM: ;PROGRAM NAME IS NAME OF OUTERMOST BLOCK. +BKTAB: BLOCK BKTABS +] +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: PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + ERF 'USS ;NO HOPE OF SUCCESS., SYMTAB TOO SMALL. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST ASSEM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ERF 'SCE + SKIPE INICLB ;IF DEFINED ANY MACROS, ETC, + ERF 'INI ;CAN'T RE-INIT SINCE INIT CODE CLOBBERED. + MOVEM A,SYMLEN ;TELL INITS( ABOUT NEW SIZE. + 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: PUSH P,CMACCR ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + ERSM 'U.0 ;UNDEFINED SYMBOL IN FIELD 0 + PUSH P,A + PUSHJ P,AGETFD + ERSM 'U.1 ;UNDEFINED SYMBOL IN FIELD 1 + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + ERSM 'U.2 ;UNDEFINED SYMBOL IN FIELD 2 + 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 + TDNN T,[757,,-1] ;DO NOT SUPPLY AC AND ADR FIELDS IF ANY BITS ON + ;IN INTRUCTION'S AC,X,OR ADR FIELDS + IOR T,[0 A,B] + XCT T + JFCL ;DON'T CARE IF IT SKIPS + 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] + JRST AASC1 + +ASIXBIT: SKIPA D,[440600,,T] +AASCII: MOVE D,[440700,,T] + SETOM AASCF1 ;INDICATE REGULAR +AASC1: TLZE I,MWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + 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 + MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH ;SPACE, GET NEXT CHAR FOR USE AS DELIMITER + 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 + ERR 'N6B +AASC3: IDPB A,D + TRO I,SYL + JRST TEXT7 + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST TEXT5 ;REGULAR OR NOT END OF WORD + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + MOVE D,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,PPSS + MOVE D,[ERSM 'USA] ;PUNCHING PASS, UNDEFINED => REAL ERROR + MOVEM D,AASM1 + CLEARM ASUDS1 + PUSHJ P,AGETFD + XCT AASM1 ;"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 + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,NOOPTF ;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: MOVE A,LIMBO1 + JRST AASC8 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + TLO I,MWRD + MOVE A,T + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + TRO I,FLD + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A + JRST TEXT5 ;ASCIZ + +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 +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASM1: 0 ;EXECUTED IF FIELD FOR .ASCII NOT DEFINED +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 + TLZ I,MWRD + JRST POPAJ + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSHJ P,AGETFD + ERR 'USS + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + ERR 'NAM ;NO NAME? + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + POP P,A + 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: HLLZM B,STGSW + JRST POPJ1 + + ;.TYPE + +A.TYPE: PUSHJ P,GETSLD ;GET NAME + ERR 'NAM ;NO NAME FOR .TYPE TO RETURN TYPE OF + 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 + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + ERSM 'UF1 + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + ERSM 'UF2 + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.BYTE: 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 + ERSM 'UBS + MOVE C,ISAV + TRNN C,FLD + 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 + 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 + +A.WALGN: 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] + SKIPE CONDEP + JRST PBY3 + SKIPE STGSW + ERR 'SWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. + MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST ASSEM0 + 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 +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE + +;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) + +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 RELOCATED BY 4*SHIFT IN MACTAB +CCOMPB: <41000,,MACTBA>*4-4 +CCOMPT: REPEAT 5,<41000,,MACTBA>*4-3+.RPCNT +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, + +VBLK +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT + 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 + +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 ;367, 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 I,UNRCHF + JRST -3(A) + JRST -4(A) + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + + ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC": TLO FF,MACRCH ;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 +] + ERF 'IAE ;RRL1 +IFN .-RCHPSN-RCHMC0,[PRINTC /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,AIRP4 + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + ERR 'UCP ;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,MRSW ;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,AIRP4 + 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: ERA 'QTL ;.QUOTE ON TOP LEVEL + +ATERMI: ERSM 'TTL ;TERMIN ON TOP LEVEL + 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 + ERSM 'USR + JUMPLE A,COND4 ;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 + MOVSI LINK,400000+RDRPTF + PUSHJ P,RDWRDN + MOVEI A,15 + CAIE T,RBRKT + PUSHJ P,PUTREL +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,,# TIMES TO GO THROUGH + 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 + ERF 'IAE ;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 + HRRI B,SCONDF + MOVEM B,SCINST ;STORE TEST INSTRUCTION + MOVEI LINK,0 + PUSHJ P,RDWRDN ;READ IN FIRST STRING + SETOB C,SCONDF + PUSHJ P,RCH ;GET FIRST CHARACTER OF SECOND STRING + CAIN A,LBRKT + MOVEI C,0 ;BRACKETED STRING + SKIPN C +SCND2A: PUSHJ P,RCH + JUMPGE C,SCOND1 ;JUMP IF PROCESSING BRACKETED STRING + CAIN A,", ;NOT BRACKETED, CHECK FOR COMMA + JRST SCOND3 ;END OF SECOND STRING +SCOND6: EXCH A,PRSCND + PUSHJ P,REDINC ;GET COMPARISON CHARACTER + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST SCND2A + CLEARM SCONDF ;STRINGS DIFFER +SCOND5: PUSHJ P,RCH + JUMPGE C,SCOND7 + CAIE A,", + JRST SCOND5 +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 + XCT SCINST + JRST COND4 + JRST COND2 + +SCOND1: PUSHJ P,QSCNT ;SECOND STRING ARG BRACKETED, CHECK CHAR + JRST SCOND6 ;NOT END + JRST SCOND3 ;RIGHT BRACKET + +SCOND7: PUSHJ P,QSCNT + JRST SCOND5 + JRST SCOND3 + +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 +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 A,DMYTOP ;INCR PNTR + CAIL A,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ERF 'TMD ;YES + 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 + ERF 'TMA +CRDWR7: POPJ P,RDWR7 + +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 + ERF 'TMD + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +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: PUSHJ P,AGETWD + ERSM 'USG + MOVEM A,GENSM + JRST ASSEM1 + +;MACRO PROC FLAGS (IN LH(LINK)) + +SCEND==200 ;SCAN END +GENF==400 ;GENERATED ARGS +LNSCN==1000 ;ACTIVATE LINE SCAN ON LAST LINE +ALNSCN==2000 ;LINE SCAN ACTIVE +;400000 SAYS COMMAS DO NOT BREAK ARG +RDRPTF==4000 ;REPEAT +LCRIND=10000 ;CR SEEN AFTER RIGHT BRACKET + +RDWRDA: PUSHJ P,ADDTR1 +RDWRDN: PUSHJ P,RCH ;ENTRY FROM STRING COND, AREPEAT ETC + TLNE LINK,ALNSCN + JRST RDWR3 ;DONT QUIT UNTIL CR OR LF + CAIN A,LBRKT + JRST RDWR1 ;IF FIRST CHAR LBRACK, READ UNTIL MATCHING RBRACK + CAIN A,"\ ;IF FIRST CHAR \ + JUMPGE LINK,RDWR6 ;AND NORM ARG READ, THEN PROCESS FIELD +RDWR3: CAIE A,15 ;ON CR + CAIN A,12 ;OR LF + JRST RDWR2C ;EXIT + CAIN A,"; ;ON SEMI + JUMPGE LINK,RDWR2D ;ON NORMAL SCAN CAUSE SEMI TO BE REINPUT AND RET + CAIN A,", ;IF COMMA + JUMPGE LINK,RDWR2 ;END THIS ARG + PUSHJ P,PUTREL ;NOTA, DEPOSIT THIS CHR + PUSHJ P,RCH ;GET NEXT CHR + JRST RDWR3 ;AND LOOP BACK,NOT CHECKING FOR LBRKT OR \ + +RDWR2D: TLO I,UNRCHF + JRST RDWR2C + +RDWR7: MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 +RDWR2C: TLO LINK,SCEND ;SCAN ENDED +RDWR2: MOVE T,A ;RET LAST CHR IN T + TLNE LINK,RDRPTF ;ON REPEAT, + POPJ P, ;THATS ALL RETURN +RDWR2A: HRL A,PUTCNT ;SAVE COUNT OF LENGTH THIS ARG IN CHRS + HRR A,RDWRDP + HLLM A,-1(A) +STPWR: MOVEI A,375 ;WRITE STOP CODE + JRST PUTREL + + ;PROCESS FIELD + +RDWR6: SOS RDWRDP ;BACK UP RDWRDP, MAY BE USED BY MACRO IN FIELD + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + ERSM 'USM + POP P,LINK + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSHJ P,ADDTR1 ;RE-GENERATE DUMMY + PUSH P,CRDWR7 ;RETURN TO RDWR7 +RDWR6A: 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,RDWR6A + HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +RDWR1: TDZA C,C ;READ UNTIL RIGHT BRACKET +RDWR1A: PUSHJ P,PUTREL + PUSHJ P,RCHCNT + JRST RDWR1A + + TLNE LINK,RDRPTF + JRST RDWR2 ;REPEAT, SKIP FOLLOWING + +RDWR2B: PUSHJ P,RCH + TLO I,UNRCHF + CAIE A,15 + CAIN A,12 + TLO LINK,SCEND+LCRIND ;CR OR LF + JRST RDWR2 + +RCHCNT: PUSHJ P,RCH ;GET CHARACTER +QSCNT: CAIN A,LBRKT ;SKIP IF CHAR IS MATCHING RBRAK + AOJA C,CPOPJ + CAIN A,RBRKT + SOJL C,POPJ1 + POPJ P, + +IFE WRQTSW,[ +WRTSS: MOVE T,[440700,,STRSTO] ;COPY STRING STORAGE (INCL DELIMITER) INTO MACTAB: GET INPUT POINTER + MOVE B,STRCNT ;GET COUNT + SOJL B,CPOPJ ;DECREMENT COUNT, RETURN IF DONE + ILDB A,T ;GET CHAR FROM STRING + PUSHJ P,PUTREL ;COPY OUT + JRST .-3 +] + +IFE WRQTSW,[ ;SLOW WRQOTE + + ;READ IN BODY OF MACRO OR WHATEVER + +WRQOTE: CLEARM DCNT ;CLEAR DEFINE/TERMIN LEVEL COUNT + SETOM INICLB ;WROTE IN MACTAB, CLOBBERED INITS. +WRQOT0: PUSHJ P,GSYL + JUMPE SYM,WRQOT1 ;JUMP ON NO SYM + PUSHJ P,ES + MOVEI A,0 ;NOT SEEN + MOVE TT,A + CAIE A,PSUDO/40000 + JRST WRQOT4 ;NOT PSEUDO + HRRZS B + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE +WRQOT4: MOVEI A,DMYDEF ;NOW CHECK FOR DUMMYS + CAML A,DMYTOP + JRST WRQOT2 ;NO MORE DUMMY NAMES TO COMPARE WITH + CAME SYM,(A) + AOJA A,.-3 + SUBI A,DMYDEF-200 ;DUMMY, CONVERT TO # + 200 + LDB B,FREPTB ;GET LAST CHAR ALREADY THERE + CAIE B,"! ;IF CHAR JUST BEFORE DUMMY NOT EXCLAMATION POINT, + PUSHJ P,PUTREL ;THEN DEPOSIT DUMMY+200 AS NEXT CHAR + CAIN B,"! ;IF LAST CHAR BEFORE DUMMY IS EXCL, + DPB A,FREPTB ;THEN FLUSH IT, CLOBBERING IT WITH DUMMY # + 200 + MOVE A,T + CAIE A,"! + PUSHJ P,PUTREL ;STORE SYL TERMINATOR + JRST WRQOT0 + +WRQOT2: CAIE TT,PSUDO/40000 ;NOT DUMMY, PSEUDO? + JRST WRQOT1 ;NO, COPY INTO MACRO BODY AND LOOP + CAIE B,ADEFINE ;YES, DEFINE? + CAIN B,AIRP ;IRP? + AOS DCNT ;DEFINE OR IRP, MATCHED BY TERMIN +IFN RCHASW,[CAIN B,A.TTYM ;.TTYMAC? + AOS DCNT ;YES +] CAIN B,ATERMIN ;TERMIN? + SOSL DCNT ;TERMIN, SKIP IF MATCHING ONE + JRST WRQOT1 ;NOT MATCHING TERMIN, LOOP + POPJ P, + +WRQOT1: PUSHJ P,WRTSS ;COPY STRING + JRST WRQOT0 + +A.QOT1: MOVE A,LIMBO1 ;.QUOTE DURING READIN, TAKES ARG LIKE ASCII + CAIN A,40 + PUSHJ P,RCH + MOVEM A,A.QOT2 +A.QOT3: PUSHJ P,RCH + CAMN A,A.QOT2 + JRST WRQOT0 + PUSHJ P,PUTREL + JRST A.QOT3 +] + +IFE WRQTSW-1,[ ;FAST WRQOTE + + ;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 + AOJA D,WRQRR ;EIGHTH CHAR OR AFTER + + ;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: POP P,A ;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 + 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: SETZM DCNT ;CLEAR DEFINE/TERMIN LEVEL COUNT + SETOM INICLB ;CLOBBERED INITS. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO I,UNRCHF ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TROA I,SYL\LET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: POP P,C ;LOOP POINT, THROW AWAY POINTER TO LAST SYL +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 + MOVEI B,DMYDEF + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUBI B,DMYDEF-200 ;DUMMY, CONVERT TO NUMBER + 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 I,UNRCHF ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +WRQOT2: PUSH P,C ;SYL ISN'T DUMMY, CHECK FOR PSEUDO + 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 DCNT ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS DCNT ;.TTYMAC +] CAIN B,ATERMIN + SOSL DCNT ;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 +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE B,"! + 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, +] + +ADEFINE: MOVEI A,DMYDEF + MOVEM A,DMYTOP + PUSHJ P,GETSYL + JUMPE SYM,.-1 ;KEEP TRYING UNTIL MACRO NAME THERE + MOVEM SYM,MACNM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + MOVE A,FREEPT + MOVEM A,PRDEF + CLEARB LINK,B ;B COUNT + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO + MOVE T,LIMBO1 +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIN T,"\ + JRST DEFNB + CAIN T,"/ + JRST DEFNE + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSHJ P,PDEF + JUMPE SYM,DEFNC ;JUMP IF NO DUMMY DEFINED + AOJA B,DEFNC ;DUMMY NAME THERE, INCREMENT COUNT + +DEFNE: TRO B,200 ;LAST DELIMITER WAS SLASH, SET FLAG +DEFNB: MOVE A,B ;ENTRY FOR LAST DELIM WAS BACKSLASH + PUSHJ P,PUTREL + MOVEI B,0 + TRO LINK,GENF + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,B ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + PUSHJ P,PUTREL ;DEPOSIT REMAINING COUNT + MOVEI A,0 + TRNN LINK,GENF + PUSHJ P,PUTREL ;DEPOSIT + PUSHJ P,RCH + CAIE A,12 + TLO I,UNRCHF ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + PUSHJ P,STPWR ;WRITE STOP + MOVE SYM,MACNM ;GET MACRO NAME + POP P,ESBK + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + JFCL + 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 + PUSHJ P,VSM2 + JRST ASSEM1 + +MACCL: MOVSI 17,-14 ;MACRO EXPANSION TIME + PUSH P,2(17) + AOBJN 17,.-1 + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + PUSHJ P,REDINC + SKIPN B + TLO I,UNRCHF ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS + MOVEM A,@PRCALP + MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST MAC2A ;NO ARGS SUPPLIED + JUMPE B,MAC4 ;JUMP IF NO DUMMIES IN DEF + TRZE B,200 + TLO LINK,LNSCN +MAC3: PUSH P,B + TLNE LINK,LNSCN + SOJE B,MAC3A +MAC3B: PUSHJ P,RDWRDA + POP P,B + TLNE LINK,SCEND + SOJA B,MAC2 + SOJG B,MAC3 +MAC4: MOVE A,@PRCALP + PUSHJ P,REDINC + MOVEM A,@PRCALP + JUMPE B,MAC1A +MAC5: PUSH P,B + TLNE LINK,SCEND + PUSHJ P,GENSYM + TLNN LINK,SCEND + PUSHJ P,RDWRDA î POP P,B + SOJG B,MAC5 +MAC1A: MOVEI B,RCHSV1 ;RETURN TO RCHSV1 ON END OF MACRO +A.TYM9: PUSHJ P,PUSHEM ;ENTRY FROM .TTYMAC + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP +MACC2: MOVSI 17,-13(P) + HRRI 17,2 + BLT 17,15 +MACC1: SUB P,[14,,14] +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MAC2A: TLO LINK,SCEND ;NO ARGS SUPPLIED TO MACRO + TRZ B,200 +MAC2: SOJL B,MAC4 ;DONE SCANNING ARGS + MOVEI A,0 ;MORE DUMMIES IN DEF, + PUSHJ P,ADDTR2 ;GENERATE NULL DUMMY + JRST MAC2 + +MAC3A: TLO LINK,ALNSCN+400000 + JRST MAC3B + +GENSYM: PUSHJ P,ADDTR1 + MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,[RDWR2A] + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + HLRZ A,(P) + ADDI A,60 + JRST PUTREL + +A.GOMC: IBP A ;.GO ROUTINE TO SKIP PAST MACRO HEADER FLUSH # ARGS + IBP A ;FLUSH # DMY ARGS + 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,MRSW + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: MOVSI 17,-14 + PUSH P,2(17) ;SAVE AC'S IN STANDARD MANNER + AOBJN 17,.-1 + MOVEI A,DMYDEF + MOVEM A,DMYTOP + AOS PRCALP + MOVE A,FREEPT + MOVEM A,@PRCALP + PUSH P,RDWRDP + MOVSI LINK,ALNSCN\400000 + PUSHJ P,GSYL ;READ DUMMY'S NAME + JUMPE SYM,.-1 ;KEEP TRYING UNTIL THERE'S SOMETHING THERE + PUSHJ P,RCH ;NOW GET CHARACTER AFTER DELIMITER + CAIE A,12 ;IF NOT LINE FEED, + TLO I,UNRCHF ;THEN DON'T FLUSH + PUSHJ P,PDEF1 ;ENTER DUMMY NAME IN TABLE + PUSHJ P,WRQOTE ;READ IN BODY + PUSHJ P,STPWR ;WRITE TERMIN + PUSHJ P,GTYIP ;INPUT FROM TTY + PUSHJ P,RDWRDA ;READ IN FROM TTY UNTIL CR, FLUSH CR + MOVEI B,A.TYM8 ;WHEN DONE, RETURN TO A.TYM8 + JRST A.TYM9 +] + + ;NOW IRP + ;IRP PDL STRUCTURE: + ;TWO TWO WORD ENTRIES + + ;BBASE,,CPTR + ;LIMBO1 STATUS,,OLD .IRPCNT + ;SPEC BITS\# A,B,[LIST] GROUPS,,CHAR ADR BEGINNING OF BODY + ;OLD TOPP,,AIRP4 + +AIRP: MOVSI 17,-14 + PUSH P,2(17) + AOBJN 17,.-1 + PUSH P,RDWRDP + HLLZM B,AIRPTT ;SAVE TYPE OF IRP + CLEARB LINK,IRPCR + MOVEI A,DMYDEF + MOVEM A,DMYTOP + ;DROPS THROUGH + + ;DROPS THROUGH + +AIRP1: PUSHJ P,PDEF + CAIE T,", + JUMPE SYM,AIRP2 ;NO DUMMY SPECIFIED (EXIT FROM LOOP) + PUSHJ P,PDEF ;READ OTHER NAME OF PAIR + MOVE TT,AIRPTT + TLNE TT,200000 + PUSHJ P,PUT377 ;OCCUPY THE CHARACTER OF WHAT WILL BE THE SECOND DUMMY + PUSHJ P,ADDTRN ;GENERATE NULL DUMMY (FIRST DUMMY), POINTS TO NEXT CHAR + PUSHJ P,PUT377 ;MARK BEGINNING OF DUMMYS + PUSHJ P,RDWRDA ;READ LIST + MOVE A,RDWRDP ;NOW GET DUMMY POINTER, POINTS TO ONE HIGHER THAN LAST ACTIVE + SOS -1(A) ;BACK UP SECOND ARG'S CHARACTER ADDRESS TO POINT TO STOP WRITTEN + MOVSI TT,200000 + TDNE TT,AIRPTT + SOS -1(A) ;IRPS, BACK UP CHAR ADR TO POINT TO CHAR FOR SECOND DUMMY'S EXCLUSIVE USE + AOS IRPCR ;ANOTHER GROUP + TLNN LINK,SCEND + JRST AIRP1 + TLNE LINK,LCRIND + TLZ I,UNRCHF ;FLUSH CR +AIRP2: MOVE A,FREEPT + MOVEM A,PRIRP + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO I,UNRCHF + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + 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 + IOR A,AIRPTT ;IOR IN SPECIFICATION BITS + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRP4 ;RETURN TO AIRP4 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 + JRST MACC2 + +PUT377: MOVEI A,377 ;WRITE 377 + JRST PUTREL + + ;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRP4: PUSH P,A ;A GETS CHAR ADR LOOKING AT DUMMY + 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 4.9 => IRPC, 4.8 IRPS, 4.7 IRPW, NONE IRP + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,MRSW + JRST AIRP9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRP9 ;JUMP IF NO GROUPS + SKIPGE TT,(B) + JRST AAIRPC ;4.9 => IRPC +AIRP6: SETOM AIRPT1 + HRRZ A,(T) ;GET ADR OF FIRST ARG + TLNE TT,100000 + HRRZ A,1(T) ;IRPW => START FROM SECOND ARG +AIRP6A: PUSHJ P,REDINC ;GET CHARACTER FROM ARG + CAIN B,375 + JRST AIRP10 ;END OF STRING + CAIE B,377 + JRST AIRP6A ;WAIT FOR 377 (=> END OF PREV) + TLNE TT,100000 + JRST AIRPW1 ;IRPW + SETOM AIRPT2 +AIRP7E: MOVEM A,(T) ;STORE NEW CHAR ADR +AIRP7: PUSHJ P,REDINC + CAIN B,375 + JRST AIRP5 + TLNE TT,200000 + JRST AIRPS2 ;IRPS + CLEARM AIRPT + CAIN B,LBRKT + AOSE AIRPT2 + JRST AIRP7A ;NOT NEW LIST +AIRP7C: MOVEI B,376 ;CLOBBER BRACKET IN STRING STORAGE + DPB B,PTAB(CH2) + JRST AIRP7 + +AIRP7A: SKIPL AIRPT2 ;RIGHT BRACKET IN LIST + CAIE B,RBRKT + JRST AIRP7B + SOSGE AIRPT2 ;RIGHT BRACKET IN LIST + JRST AIRP7C ;END OF LIST +AIRP7B: CAIN B,15 + JRST AIRP7D + CAIE B,12 + CAIN B,", + SKIPL AIRPT2 + JRST AIRP7 ;NOT END OF ENTRY + ;DROPS THROUGH + + ;DROPS THROUGH +AIRPS1: MOVEI CH1,-1(A) ;END OF GROUP (ENTRY FROM IRPS, IRPW) + IDIVI CH1,4 + MOVEI B,377 + DPB B,PTAB(CH2) + TLNN TT,300000 + MOVEM A,1(T) ;IRP, STORE CHAR ADR OF REST OF STRING +AIRP8: ADDI T,2 + SOJG C,AIRP6 +AIRP9: 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 + + ;IRPW + ;AIRPT1 -1 => SEMICOLON NOT YET ENCOUNTERED + ;AIRPT -1 => ALL GROUPS NULL SO FAR + +AIRPW1: PUSHJ P,REDINC ;GET CHARACTER (377 ALREADY FOUND) + CAIE B,15 + CAIN B,12 + JRST AIRPW1 ;CR OR LF, IGNORE LEADING BREAK CHAR + CAIN B,375 + JRST AIRP10 ;STOP (ARG EXHAUSTED) + MOVEM A,(T) ;STORE CHARACTER ADR ONE PAST BEGINNING OF FIRST DUMMY + SOS (T) ;MAKE IT POINT TO FIRST ARG + SETZM AIRPT ;SOMETHING THERE, CALL IT NON-NULL GROUP EVEN IF DUMMYS BOTH NULL + JRST AIRPW4 + +AIRPW3: PUSHJ P,REDINC ;GET NEXT CHAR + CAIN B,375 + SOJA A,AIRPWX ;STOP, END OF ARG STRING THIS GROUP + CAIE B,15 + CAIN B,12 + SOJA A,AIRPWD ;DELIMITER => END OF SECOND ARG, MAYBE ALSO END OF FIRST +AIRPW4: CAIN B,"; + AOSE AIRPT1 ;SKIP IF SEMICOLON HASN'T BEEN ENCOUNTERED YET + JRST AIRPW3 ;NOT DELIMITER, TRY NEXT + MOVEI B,377 ;SEMICOLON, CLOBBER WITH STOP MARKING END OF FIRST ARG + DPB B,PTAB(CH2) + MOVEM A,1(T) ;STORE CHAR ADR BEG SECOND ARG + JRST AIRPW3 ;FALL BACK IN + +AIRPWD: SKIPGE AIRPT1 ;DELIMITER (CR OR LF) ENCOUNTERED, SEMI FOUND? + MOVEM A,1(T) ;NO, CLOBBER SECOND DUMMY TO NULL STRING + AOJA A,AIRPS1 ;FALL BACK IN + +AIRPWX: SKIPGE AIRPT1 ;STOP CHAR ENCOUNTERED, SEMI FOUND? + MOVEM A,1(T) ;NO, CLOBBER SECOND ARG TO NULL STRING + AOJA A,AIRP8 ;FALL BACK IN + +AIRPS4: CLEARM AIRPT ;SQUOZE + CLEARM AIRPT1 + JRST AIRP7 + +AIRPS2: HLRZ CH1,GDTAB(B) ;GET GDTAB ENTRY THIS CHAR + CAIN CH1,(POPJ P,) ;POPJ => NOT SQUOZE, + CAIN B,"! ;BUT ALLOW EXCLAMATION POINT + JRST AIRPS4 ;SQUOZE OR ! + SKIPGE AIRPT1 + JRST AIRP7E ;IGNORE NULL SYLLABLES + HRRZ CH1,1(T) + IDIVI CH1,4 + DPB B,PTAB(CH2) ;DEPOSIT DELIMITER AS SECOND ARG + JRST AIRPS1 + +AIRP7D: SKIPL AIRPT2 + JRST AIRP7 + JRST AIRP7C + +AIRP10: CLEARM (T) ;END OF STRING +AIRP5: CLEARM 1(T) + JRST AIRP8 + +AAIRPC: MOVE A,(T) +AIRPC1: PUSHJ P,REDINC + CAIN B,375 + JRST AIRPC3 + CAIE B,377 + JRST AIRPC1 ;WAIT FOR 377 (END OF PREV) + MOVEM A,1(T) ;CHAR ADR OF STRING VALUE OF DUMMY + PUSHJ P,REDINC + CAIN B,375 + JRST AIRPC3 + CLEARM AIRPT + MOVEI CH1,-2(A) + MOVEM CH1,(T) + IDIVI CH1,4 + DPB B,PTAB(CH2) + MOVEI B,377 + DPB B,PTAB+1(CH2) + AOS 1(T) +AIRPC2: ADDI T,2 + SOJG C,AAIRPC + JRST AIRP9 + +AIRPC3: CLEARM (T) + CLEARM 1(T) + JRST AIRPC2 + + ;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 I,UNRCHF + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,MACRCH + 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 + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + 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 +IFN TS, 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, + + ;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: MACL*4 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCINST: 0 ;STRING CONDITIONAL INSTRUCTION +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +MACNM: 0 ;NAME OF MACRO BEING DEFINED +DCNT: 0 ;USED BY WRQOTE CURRENT DEPTH IN DEFINE-IRP-TERMIN LEVEL +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) +AIRPTT: 0 ;TYPE OF IRP (400000) IRPC (200000) IRPS (100000) IRPW 0 IRP, USED DURING READIN +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 +AIRPT1: 0 ; " ,IRPS OR IRPW => (0 => CURRENT DUMMY NOT NULL, -1 => NULL) +AIRPT2: 0 ; " , IRP ONLY, BRACKET COUNT (FOR FLUSHING LIST BRACKETS) +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 +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 + +IFN TS,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 + +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +GC: MOVEM 17,GCSV+15 + MOVE 17,[2,,GCSV] + BLT 17,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADDI A,WPS-1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + 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, + +IFN TS,[ ;NEED MORE CORE FOR MACTAB + +GCCORQ: MOVE A,MACHI + LSH A,-2 ;CONVERT TO WORD # + CAIL A,MXMACL ;WANT MORE THAN ALLOWED? + POPJ P, + MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET. + MOVEI AA,[ASCIZ /MACRO TABLE./] ;TEXT ARG TO CORRQ + PUSHJ P,CORRQ ;GET BLOCK + ADDI A,2000 + MOVEM A,MACTND ;INCREMENT ADDR AFTER END OF MACTAB. + SUB A,MACTAD ;GET # WDS NOW HAVE. + LSH A,2 ;CONVERT TO CHAR ADR + MOVEM A,MACHI ;STORE BACK NEW HIGH PUT ADR + SUBI A,MACRUM*4 + MOVEM A,GCRDHI ;STORE NEW MACTAB HIGH POINTER + ADDI A,MACRUM*4 ;CONVERT BACK TO END POINTER + BCOMP A,-1 ;CONVERT TO BP TO LAST BYTE IN TABLE + MOVEM A,MACHIB ;STORE AS SUCH + POPJ P, +] + + ;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 + ERF 'MCE + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 + MOVS 17,[2,,GCSV] + BLT 17,17 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT + SKIPGE SVF + JRST MSTG ;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 + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE GET + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 +TERMIN + +DEFINE GETT + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +ACSAV: BLOCK 7 +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER + MOVE TM,[P,,ACSAV] + BLT TM,ACSAV+6 + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: GET ;CONTINUE STATEMENT RC + GET ;LF + GET ;. + CAIE A,". ;DOT + JRST BDCONT + GET ;F OR I + GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,PSS ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: GET + CAIE A,12 ;LF + JRST GETLF + MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + JUMPGE FF,PNTR5 + SKIPL LISTON + 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: MOVEI A,15 + PUSHJ P,PILPT + MOVE A,LISTBC + CAIE A,14 + MOVEI A,12 +PNTR5C: PUSHJ P,PILPT +PNTR5D: SETOM LISTBC + +PNTR5: 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, + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LISTON": 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF +LISTBF: BLOCK 50. +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 +] ;END LISTSW CONDITIONAL +IFE LISTSW,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. + TLNE C,3INI + 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 + TLNN C,3INI ;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 + + +; 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, + +;.XCREF , DON'T CREF THOSE SYMS. +A.XCREF: PUSHJ P,GETSLD ;READ SYM. + JRST ASSEM1 + JUMPGE FF,A.XCREF + PUSHJ P,ESDEF + JRST A.XCR1 + TLO C,3NCRF ;TURN ON CREF SUPPRESS BIT. + 3PUT C,D + JRST A.XCREF + +A.XCR1: MOVSI T,LCUDF ;CREATE UNDEF ENTRY + TLO C,3NCRF ;WITH CREFFING SUPPRESSED. + PUSHJ P,VSM2 + JRST A.XCREF ;NEXT SYM. + +A.CRFN: JUMPGE FF,ASSEM1 + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST ASSEM1 + +A.CRFFF: PUSHJ P,CRFOFF ;.CRFOFF, STOP CREFFING. + JRST ASSEM1 +] + +IFN TS,[ ;;TS ;TIME-SHARING ROUTINES + +IFNDEF TYPDLC,TYPDLC==14 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY) +IFNDEF MX.INS,MX.INS==8 ;MAXIMUM DEPTH .INSRT FILES ONLY +IFNDEF MAXIND,MAXIND==20 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT +IFNDEF UTIBFL,UTIBFL==100 ;# WORDS EACH .IOT UTYIC, +IFNDEF TUTIBL,TUTIBL==3*UTIBFL ;TOTAL # WORDS INPUT BUFFER +IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH. +IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER. + +IFN DECSW,[DEFINE .SUSET A + TERMIN ] + +TYIC==1 ;TTY INPUT CHANNEL +TYOC==2 ;TTY OUTPUT CHANNEL +CREFC==3 ;CREF OUTPUT. +UTYOC==4 ;OUTPUT FILE +LPTC==5 ;LISTING (LPT) +ERRC==6 ;ERR DEVICE INPUT +UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+1 USED FOR 1ST .INSRT LEVEL IN DEC VERSION. + +VBLK +INTJPC: 0 ;SAVES .JPC AT INTERRUPT. +INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING + +;NOTE THAT ONLY PDL OV IS NOW ENABLED. + +IFE DECSW,[ +JOBCNI: +TSINT: 0 ;ALL INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS +JOBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS + .SUSET [.RJPC,,INTJPC] + JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT +] PBLK +TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING + MOVE A,JOBCNI ;GET INTERRUPT REQUEST WORD + MOVEI B,'INT ;DEFAULT + SOS JOBTPC ;MAKE IT POINT TO PLACE INTERRUPT CAME FROM + TRNN A,200000 ;PDL OVERFLOW? + JRST TSINT7 ;NO + LDB A,[270400,,@JOBTPC] ;GET AC FIELD OF GUILTY INSTRUCTION + CAIN A,P ;IF P, + MOVE P,[-LPDL,,PDL] ;RESET PDL POINTER + MOVEI B,'PDL +TSINT7: TRNE A,20000 ;MEMORY PROTECTION VIOLATION? + MOVEI B,'ILM ;YES + MOVEM B,40 + AOS A,JOBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY + .SUSET [.SPICL,,[-1]] + JSA A,ERROR + +IFNDEF .IOT,[ ;DON'T DEFINE SYSTEM CALLS IF DEFINED.. + + ;ITS SYSTEM CALLS AS OF ITS 703, 8:56:44 PM, WEDNESDAY, NOV 17,1971 --SSYML.14 + +.RUPC==0? .STTY==400002? .SETM2=42000,,5? .IOPDL=42000,,57 +.RVAL==1? .SFLS==400003? .LOGIN=42000,,6? .ITYIC=42000,,60 +.RTTY==2? .SUNAM==400004? .CLOSE=42000,,7? .MASTE=42000,,61 +.RFLS==3? .SJNAM==400005? .UCLOS=42000,,10? .VSTST=42000,,62 +.RUNAM==4? .SMASK==400006? .ATTY=42000,,11? .DIETI=42000,,66 +.RJNAM==5? .SUSTP==400007? .DTTY=42000,,12? .SHUTD=42000,,67 +.RMASK==6? .SPIRQ==400010? .IOPUS=42000,,13? .ARMOF=42000,,70 +.RUSTP==7? .SINTB==400011? .IOPOP=42000,,14? .NDIS=42000,,71 +.RPIRQ==10? .SMEMT==400012? .DCLOS=42000,,15? .FEED=42000,,72 +.RINTB==11? .SSV40==400013? .DSTOP=42000,,16? .EVAL=42000,,73 +.RMEMT==12? .SIPIR==400014? .RDTIM=42000,,17? .REDEF=42000,,74 +.RSV40==13? .SAPIR==400015? .RDSW=42000,,20? .IFSET=42000,,75 +.RIPIR==14? .SSNAM==400016? .GUN=42000,,21? .UTNAM=42000,,76 +.RAPIR==15? .SPICL==400017? .UDISM=42000,,22? .UINIT=42000,,77 +.RSNAM==16? .SMARA==400020? .GETSY=42000,,23? .RYEAR=42000,,100 +.RPICL==17? .SMARP==400021? .IPDP=42000,,24? .RLPDT=42000,,101 +.RMARA==20? .SUUOH==400022? .GETLO=42000,,25? .RDATI=42000,,102 +.RMARP==21? .SUIND==400023? .SETLO=42000,,26? .RCHST=42000,,103 +.RUUOH==22? .SRUNT==400024? .DISOW=42000,,27? .RBTC=42000,,104 +.RUIND==23? .SMSK2==400025? .MSPAC=42000,,30? .DMPCH=42000,,105 +.RRUNT==24? .SIFPI==400026? .GENSY=42000,,32? .SWAP=42000,,106 +.RMSK2==25? .SAPRC==400027? .LOGOU=42000,,33? .CALL=43000,, +.RIFPI==26? .SSV60==400030? .REALT=42000,,34? .DISMI=43040,, +.RAPRC==27? .SUTRP==400031? .WSNAM=42000,,35? .TRANS=43100,, +.RSV60==30? .SIIFP==400032? .UPISE=42000,,36? .TRANA=43140,, +.RUTRP==31? .SAIFP==400033? .RESET=42000,,37? .VALUE=43200,, +.RIIFP==32? .SIMAS==400034? .ARMOV=42000,,40? .UTRAN=43240,, +.RAIFP==33? .SAMAS==400035? .CBLK=42000,,42? .CORE=43300,, +.RIMAS==34? .SIMSK==400036? .ASSIG=42000,,43? .TRAND=43340,, +.RAMAS==35? .SAMSK==400037? .DESIG=42000,,44? .DSTAR=43400,, +.RIMSK==36? .SJPC==400040? .RTIME=42000,,45? .FDELE=43440,, +.RAMSK==37? .SOPC==400041? .RDATE=42000,,46? .DSTRT=43500,, +.RJPC==40? .SRTMR==400042? .HANG=42000,,47? .SUSET=43540,, +.ROPC==41? .S60H==400043? .EOFC=42000,,50? .LTPEN=43600,, +.RRTMR==42? .IOT=40000,,? .IOTLS=42000,,51? .VSCAN=43640,, +.R60H==43? .OPEN=41000,,? .RSYSI=42000,,52? .POTSE=43700,, +.RIOC==100? .OPER=42000,,? .SUPSE=42000,,53? .USET=44000,, +.RIOS==120? .ITYI=42000,,1? .PDTIM=42000,,54? .BREAK=45000,, +.RIOP==140? .LISTE=42000,,2? .ARMRS=42000,,55? .STATU=46000,, +.SUPC==400000? .SLEEP=42000,,3? .UBLAT=42000,,56? .ACCES=47000,, +.SVAL==400001? .SETMS=42000,,4 + ] ;END IFNDEF .IOT, CONDITIONAL. + +BEG: .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME + .SUSET [.SMASK,,[200000]] ;PDL OVERFLOW ONLY. + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT) + MOVEI FF,0 ;INITIALIZE FLAGS + MOVE P,[-LPDL,,PDL] ;INITIALIZE P +IFN PURESW,[MOVE A,[HALT] + MOVEM A,PURIFY +] MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE + .SUSET [.RJNAM,,A] + CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS + CAMN A,[SIXBIT/MM/] + MOVEI D,SYMMSZ + SKIPGE ISYMF ;THE FIRST TIME THROUGH, + MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE. + PUSHJ P,TTYINI ;NOW OPEN TTY +IFN PURESW,[ + SKIPGE PURIFG + TYPR [ASCIZ /NOTPUR /] +] + MOVE B,[SIXBIT /MIDAS./] + PUSHJ P,SIXTYO + MOVE B,[.FNAM2] + PUSHJ P,SIXTYO +IFE DECSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD + PUSHJ P,TSYMGT ;GET TS SYMS FROM SYSTEM +] ;DROPS THROUGH + + ;RETURN POINT FROM FATAL ERRORS (DROPS THROUGH) + +GO2: MOVEI FF,0 ;INITIALIZE FLAGS + SKIPLE CMPTR + SETZM CMPTR + SETZM TTYINS ;NO T-SWITCHES SEEN YET. +IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME. + MOVEM A,IRUNTM] + PUSHJ P,CMD ;GET TYPED IN COMMAND + SKIPGE SMSRTF + JRST GO21 + TYPR [ASCIZ/SYMTAB CLOBBERED +/] + JRST GO2 + +GO21: PUSHJ P,GINIT ;INITIALIZE STUFF + PUSHJ P,OPNRD ;OPEN INPUT FILE + PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE. +GO3: JSP A,INIT ;INITIALIZE FOR ASSEMBLY + JSP A,PS1 ;DO PASS 1 +IFN A1PSW,[ + TLZ FF,OUTF + AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED + SETOM OUTC ;" " " +] + TRNE FF,NPSS ;IF 2 PASS ASSEMBLY, + PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE + JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT + JSP A,PS2 ;DO PASS 2 + JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE +IFN A1PSW,[ + TRNN FF,NPSS ;IF 1 PASS ASSEMBLY, + JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM +] +RETN2: PUSHJ P,.FILE +IFN RUNTSW,[SKIPE RUNTSX + PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2 +] JRST TSRETN + + ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY + +GINIT: IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +] + MOVE A,[MAXIND,,FDSOFS] + MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE +IFDINI: MOVE A,[DNAM,,IFDS] + BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC. + POPJ P, + +IFN RUNTSW,[ ;TYPE OUT RUN TIME USED + +RNTTYO: TYPR [ASCIZ /RUN TIME = /] + PUSH P,[CRR] ;END WITH CRLF + PUSHJ P,RNTTMA ;GET CURRENT RUN TIME + SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2 + MULI A,4069. ;CONVERT TO NANOSECONDS + DIV A,[10000000.] ;10.**7, CONVERT TO HUNDREDTHS + IDIVI A,100. ;GET SECS AND REMAINDER + HRLM B,(P) ;SAVE REMAINDER + PUSHJ P,HMSTYO ;TYPE OUT SECS + MOVEI A,". + JRST RNTYO2 ;TYPE OUT HUNDREDTHS + + ;TYPE OUT H:MM:SS TIME IN A + ;DOESN'T WORK FOR TIMES .GE. 60. HOURS + +HMSTYO: IDIVI A,60. + JUMPE A,HMSTY2 + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": +RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR + HLRZ A,(P) + IDIVI A,10. + PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A + MOVEI A,"0(B) + JRST TYO + +HMSTY2: MOVE A,B + JRST DPNT + +RNTTMA: .SUSET [.RRUNT,,A] + POPJ P, +] + + ;TS OUTPUT ROUTINES + +TPPB: IDPB A,UTYOP ;OUTPUT WORD + AOSGE UTYOCT ;SKIP IF BUFFER FULL + POPJ P, +TPPBF: EXCH A,UTYOP ;BUFFER FULL OR TPPBF CALLED TO DUMP BUFFER + HRLOI A,-UTOBUF(A) + EQVI A,UTOBUF + TLNE A,-1 ;IGNORE ZERO + .IOT UTYOC,A +WINIT2: MOVNI A,UTOBE-UTOBUF ;(RE)INITIALIZE OUTPUT BUFFER VARIABLES + MOVEM A,UTYOCT + MOVE A,[4400,,UTOBUF-1] + EXCH A,UTYOP + POPJ P, + +.FILE: MOVNI A,1 + MOVE B,CONTRL + TRNN B,DECREL ;UNLESS IN DEC FMT, + PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF + PUSHJ P,TPPBF ;OUTPUT THE BUFFER + .CLOSE UTYIC, + MOVEI A,UTYOC + MOVEM A,ONAM + SETZM ONAM-1 + SKIPE ONAM+2 + JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED + SKIPL B,CONTRL + SKIPA A,[SIXBIT /REL/] + MOVSI A,(SIXBIT /BIN/) + TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE. + MOVE A,['DECREL] + MOVEM A,ONAM+2 +.FILE2: .FDELE ONAM-2 + JFCL + .CLOSE UTYOC, +IFN CREFSW,[ + SKIPN CREFP ;IF CREF FILE OPEN, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK, + PUSHJ P,CRFEND ;EMPTY BUFFER, + MOVEI A,CREFC + MOVEM A,CRFDEV + SETZM CRFDEV-1 + MOVE A,[SIXBIT/CREF/] + SKIPN CRFDEV+2 ;DEFAULT FN2 TO CREF, + MOVEM A,CRFDEV+2 + .FDELE CRFDEV-2 ;RENAME (WAS _MIDAS CRFOUT) + JFCL + .CLOSE CREFC, +] POPJ P, + +WINIT: PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT. + 0 UTYOC,ONAM ;CHNL,NAME-BLOCK. + SIXBIT/OUTPUT/ + TLZ FF,PTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH + .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL + ANDI A,77 ;MASK TO DEVICE CODE + CAIN A,7 ;IF PAPER TAPE PUNCH, + TLO FF,PTPF ;THEN SET PTPF +IFN CREFSW,[ + SKIPN CREFP ;IF CREF REQUESTED, + JRST WINIT2 + PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT + 0 CREFC,CRFDEV + SIXBIT/CRFOUT/ + SETOM CRFCNT ;SAY BUFFER NOT INITTED. + MOVE A,[<177_35>+ASCII/B/] + PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT. + PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK. +] JRST WINIT2 + ; PUSHJ P,OINIT ;OPEN OUTPUT FILE +; 0 CHNL,NAME-BLOCK-ADDR +; SIXBIT/DESIRED-TEMPORARY-FN2/ +OINIT: MOVE A,[SIXBIT/_MIDAS/] + MOVEM A,DNAM+1 ;OPEN AS _MIDAS WHATEVER. + MOVE A,(P) + MOVE A,1(A) ;GET 2ND ARG, + MOVEM A,DNAM+2 ;USE AS FN2. + MOVE A,@(P) ;1ST ARG. + MOVE B,3(A) ;GET SNAME SPECIFIED, + MOVEM B,SNAM + MOVE A,(A) ;DEVICE NAME, + MOVEM A,DNAM + .CALL OINITB ;DELETE OLD TEMP NAME FILE. + JFCL ;THERE WAS NONE. + LDB A,[270400,,@(P)] ;GET CHANNEL NUM. + HRLI A,7 ;OPEN MODE. + .CALL OPENB + JRST OINITL +POPJ2: AOS (P) ;SKIP OVER 2 ARGS. + JRST POPJ1 + +OINITB: SETZ ? SIXBIT/DELETE/ + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + +OINITL: HLLZ A,@(P) ;GET CHNL NUM, + IOR A,[.STATUS A] + XCT A ;READ ITS STATUS, + PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE, + MOVEI A,": ;AND EXPECTATION CHARACTER. + PUSHJ P,TYO + PUSHJ P,GTYIP ;GET TYPEIN + HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES. + PUSHJ P,A.IMP1 + PUSHJ P,RFD ;GET NEW FILE DESCRIPTION + HRRZ A,@(P) ;GET NAME BLOCK ADDR, + MOVEI B,3(A) + HRLI A,DNAM ;COPY NAMES JUST READ INTO IT. + BLT A,(B) + JRST OINIT + +TFEED: TLNN FF,PTPF ;IF OUTPUT DEVICE NOT PTP, + POPJ P, ;THEN DO NOTHING + PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER, +TFEED1: .FEED UTYOC, ;FEED A LINE, + TLZA FF,PTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL + SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES, + POPJ P, ;AND RETURN + +TSRETN: .LOGOUT ;COME HERE TO COMMIT SUICIDE. + .BREAK 16,160000 + + ;TS INPUT ROUTINES + + ;OPEN MAIN INPUT FILE FOR READING + +OPNRD: .IOPDL ;RE-INITIALIZE IO PDL + MOVE A,[-TYPDLS-1,,TTYPDL] + EXCH A,ITTYP ;INITIALIZE "TTY PDL" + CAME A,ITTYP ;ANYTHING PUSHED? + PUSHJ P,MACIN1 ;YES, CLOBBER MACRO EXPANSION STATUS + MOVE A,[440700,,UTIBUF] ;NOW CLOBBER INPUT BUFFER VARIABLES + INSIRP MOVEM A,[IUREDP UREDP UTIBED] ;INITIALIZE EVERYTHING + MOVSI A,EOFCH_<18.-7> + MOVEM A,UTIBUF ;CAUSE EOFCH TO BE FIRST CHARACTER READ + MOVS A,IFDS ;GET DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST OPNRDT ;YES, TREAT SPECIAL + MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE + PUSHJ P,A.IMP1 ;SET UP DNAM, ETC. + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST OPNRDL ;LOSE + HRRZS UTIBED ;WIN, CAUSE RELOADING ON FIRST CALL TO RPA + MOVEI A,0 ;=> INPUT FROM FILE +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2 + SETZM ERRTPF ;NO NEED TO TYPE MAIN FILE'S NAME. + JRST RCHSET ;ADDRESS MODIFY AND RETURN + +OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL + BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED + MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR + JRST OPNRT2 + +OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE + JRST GO2 ;READ NEW COMMAND + + ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL + +OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL. + .CALL OPENB + JRST OPNRD2 ;CAN'T OPEN INPUT FILE. + MOVE A,[UTYIC,,RCHSTB] + .RCHST A, ;RESULTS NEEDED BY WINIT, A.ITR2. + SKIPN A,RCHSTB+1 ;GET SYSTEM FILE NAME 1 + MOVE A,FNAM1 ;SYSTEM DOESN'T KNOW, GET SPECIFIED + MOVEM A,IFNM1 ;SET UP FOR .IFNM1 + MOVEM A,RCHSTB+1 + SKIPN A,RCHSTB+2 ;NOW SAME FOR .IFNM2 + MOVE A,FNAM2 + MOVEM A,IFNM2 + MOVEM A,RCHSTB+2 + MOVE A,[RCHSTB,,ERRDEV] + BLT A,ERRDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE. + HRLZS ERRDEV ;MAKE THE DEV NAME BE LEFT-JUST. + SETOM ERRTPF ;INPUT FILE NAMES HAVE CHANGED, TYPE THEM NEXT ERROR MSG. + AOSA (P) ;CAUSE RETURN TO SKIP +OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP + POPJ P, + +OPENB: SETZ ? SIXBIT/OPEN/ + A ;SHOULD HOLD MODE,,CHANNEL. + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + + ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR + +INCHR3: HRRZ A,UREDP ;GET BYTE POINTER + CAME A,UTIBED ;END OF COMPLETELY READ BLOCK? + JRST RPAEOF ;NO => REALLY EOF + MOVE A,IUREDP ;GET INITIAL UREDP + HLL A,UREDP + ADD A,[70000,,] ;BACK UP OVER EOF CHAR ILDB'D, MAY BE RETURNING FROM .INSRT + MOVEM A,UREDP ;STORE INITIAL UREDP FOR NEXT TIME AROUND + HRLI A,-UTIBFL ;CONVERT TO BLOCK .IOT POINTER + .IOT UTYIC,A ;READ IN BLOCK + TLZ A,377777 ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS + MOVEM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ;STORE EOF WORD + JRST RCHTRA ;NOW TRY NEXT CHAR + + ;EOF WHILE TRYING TO READ CHARACTER + +RPAEOF: PUSH P,B ;SAVE B + MOVE B,ITTYP ;GET PDL POINTER + PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT) + JRST RCHTRB ;RETURN TO GET CHARACTER + + ;EOF FROM MAIN FILE + +NEDCHK: IFN A1PSW,[ PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT + AOBJN A,.-1 + JUMPGE A,RETN2 +] + MOVE A,[70700,,[EOFCH]] + MOVEM A,UREDP + ERF 'NED + +IFN A1PSW,[ ;HOLLAR "NED" IF ANY OF THE FOLLOWING: +NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED + SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT + SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE + TRNN FF,PSS ;CURRENTLY IN PASS 2 +LNEDT==.-NEDT ;LENGTH OF TABLE +] + + ;IO PDL ROUTINES FOR INPUT FILE + ;PUSH THE INPUT FILE + +IPUSH: MOVE A,[UTYIC,,RCHSTB] + .RCHST A, + MOVE A,UREDP ;GET INPUT BYTE POINTER + TLNN A,760000 ;AT END OF WORD? + ADD A,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD + SKIPGE UTIBED ;EOF ON LAST .IOT? + TLO A,40 ;YES + HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING + SKIPGE B,ACCP ;GET .ACCESS POINTER + JRST IPSH2 ;INPUT DEVICE NOT RANDOMLY ACCESSIBLE + ADDI B,(A) + SUB B,UTIBED ;CONVERT TO DESIRED + HRR A,IUREDP ;CLOBBER RH(UREDP TO SAVE) + CAME B,ACCP ;NEW POINTER SAME AS OLD? + .ACCESS UTYIC,B ;NO, HAVE SYSTEM CAUSE RE-INPUT FROM DESIRED WORD + TLZ A,40 ;RANDOM ACCES DEVICE- SILL READ STUFF AGAIN + ;DISREGARD PREV EOF + SKIPA B,IUREDP ;IUREDP TO POINT TO FIRST AVAILABLE WORD +IPSH3: MOVE B,UTIBED +IPSH4: HRLI B,440700 + MOVEM B,IUREDP ;LINK FORWARD + MOVEM B,UREDP ;STORE NEW POINTER + HRRZM B,UTIBED ;STORE EOF CHECK + MOVSI T,EOFCH_<18.-7> + MOVEM T,(B) ;STORE EOF WORD TO CAUSE RELOAD + .IOPUSH UTYIC, ;NOW DO THE .IOPUSH + MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL +IPSHP: +REPEAT 4,PUSH B,ERRDEV+.RPCNT ;SAVE NAMES OF INPUT FILE. + PUSH B,A ;NEW UREDP, RH ALSO RH(IUREDP), <40,,> => SET SIGN OF UTIBED + ;FOLLOWING TWO MUST BE LAST PUSHED + INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL +INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL + MOVEI A,0 ;=> INPUT FROM FILE + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN + ;POP INTO THE INPUT FILE +IPOP: +IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED. + MOVE B,ITTYP ;GET POINTER + INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF +REPEAT 4,POP B,ERRDEV+3-.RPCNT + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + .IOPOP UTYIC, ;POP INTO CHANNEL + HRRZ B,IUREDP ;NOW GET POINTER TO LAST WORD IN BUFFER + TLZE A,40 ;BIT 12. SET? + TLO B,400000 ;YES, SET SIGN BIT IN WHAT WILL BECOME EOF CHECK + MOVEM B,UTIBED + MOVEM A,UREDP ;STORE NEW POINTER + HRRM A,IUREDP ;ALSO POINTER TO BEGINNING OF ACTIVE PART OF BUFFER + MOVE A,[<<<<_7+EOFCH>_7+EOFCH>_7+EOFCH>_7+EOFCH>_1] + MOVEM A,(B) ;STORE EOF CHARACTERS AT END OF BUFFER + SETOM ERRTPF ;CHANGED FILES, NEXT ERROR MUST TYPE NAME. + POPJ P, + + ;IPUSH WHEN DEVICE NOT RANDOMLY ACCESSIBLE + +IPSH2: HRRZ B,IUREDP ;GET POINTER TO BEGINNING OF ACTIVE PART OF BUFFER + CAIN B,(A) ;THAT WHERE UREDP IS? + JRST IPSH3 ;YES, NO BLT NECESSARY + MOVS T,A + HRR T,B ;SET UP BLT POINTER + SUBI B,(A) + HRR A,T + ADDB B,UTIBED + BLT T,(B) ;BLT DOWN STUFF (INCL EOF WRD) TO BOTTOM OF ACTIVE PART OF BUFFER + CAIL B,UTIBE-UTIBFL ;ROOM? + ERF 'IOV ;NO ROOM IN BUFFER FOR ANOTHER INPUT FILE + JRST IPSH4 + + ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY + +PUSHTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET RELEVANT PDL POINTER + MOVEI A,0 + EXCH A,CLNN ;SET UP NEW LINE NUMBER + HRL A,CPGN ;SAVE CURRENT PAGE NUMBER + SETZM CPGN ;NOW RE-INITIALIZE +IFN CREFSW,[ + SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG. + TLO A,400000 +] + PUSH F,A ;SAVE CPGN,,CLNN + MOVE A,-1(P) ;RETRIEVE NEW MODE + PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET PDL POINTER + PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE + POP F,A ;GET CPGN,,CLNN +IFN CREFSW,[ + SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG. + TLZE A,400000 + SETOM CRFILE +] + HLRZM A,CPGN + HRRZM A,CLNN + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;TTY ROUTINES + + ;GET CHARACTER IN A, READ NEW STRING IF OLD EXHAUSTED (USED BY CMD) + +RCHA: ILDB A,CMPTR ;GET CHARACTER + JUMPN A,CPOPJ ;RETURN IF VALID + PUSHJ P,TYRLD ;END OF STRING, RELOAD + JRST RCHA ;TRY AGAIN + + ;CAUSE INPUT FROM TTY (MAIN ROUTINES) + +GTYIP: SKIPA A,[2] ;VERSION TO QUIT ON CR +GTYIPA: MOVEI A,3 ;VERSION TO NOT QUIT ON CR + PUSHJ P,TYRLD ;GET TYPED IN STRING + JSP B,PUSHTT ;SET UP VARIABLES AND RETURN +GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR + JRST POPTT + + ;RCHSET ROUTINES FOR READING FROM TTY + ;3 => DON'T QUIT ON CR + +RCHARC: TLO FF,TTYRCH ;SET FLAG + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CMPTR ;GET CHAR + CAIN A,0 ;END OF STRING MARKED WITH 0 + PUSHJ P,RTYRLD ;RELOAD, JUMP BACK FOR NEXT CHAR +] + HALT ;RRL1 +IFN .-RCHAC1-RCHPSN,[PRINTC /RCHAC1 LOSES. +/] + ILDB A,CMPTR ;SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + + ;2 => QUIT ON CR + +RCHTRC: TLO FF,TTYRCH ;SET FLAG + JSP A,CPOPJ +RCHTC1: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CMPTR + CAIN A,0 + PUSHJ P,RPAEOF +] + HALT ;RRL1 +IFN .-RCHTC1-RCHPSN,[PRINTC /RCHTC1 LOSES. +/] + ILDB A,CMPTR ;SEMIC + CAIN A,0 + PUSHJ P,RPAEOF ;END OF STRING + JRST SEMIC + + ;READ IN STRING + +TYRLD: PUSH P,A + PUSH P,F + MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER + MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ +TYRLD2: PUSHJ P,TYI ;GET CHARACTER + CAIN A,177 ;RUBOUT? + JRST TYRLD3 ;YES + CAIE A,^C + CAIN A,^U + JRST TYRLD5 ;RUB OUT ALL + IDPB A,F ;STORE CHARACTER IN BUFFER + CAIE A,15 ;CR? + JRST TYRLD2 ;NO, GO BACK FOR NEXT + MOVEI A,0 ;YES, + IDPB A,F ;MARK END OF STRING + JRST POPFAJ + +TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER? + JRST TYRLD4 ;YES + LDB A,F ;GET LAST CHARACTER IN BUFFER + PUSHJ P,TYO ;TYPE IT OUT + ADD F,[70000,,] ;DECREMENT POINTER + JUMPGE F,TYRLD2 ;JUMP IF VALID + SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ;CONTROL C, BACK TO BEGINNING OF LINE +TYRLD4: PUSHJ P,CRR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR + JRST TYRLD2 + +RTYRLD: PUSHJ P,TYRLD + JRST RCHTRA + +IFE DECSW,[ ;GET (JUST TYPED IN) CHAR IN A + +TYI: .IOT TYIC,A + JUMPE A,TYI + CAIE A,^L ;SKIP IF FORM-FEED, CLEAR SCREEN ON DISPLAY CONSOLE + POPJ P, + MOVEI A,^P + PUSHJ P,TYO + MOVEI A,"C + PUSHJ P,TYO + MOVEI A,^L + POPJ P, + +TAB: MOVEI A,11 +TYO: .IOT TYOC,A ;TYPE OUT CHAR IN A + POPJ P, + + ;INITIALIZE TTY + +TTYINI: .OPEN TYIC,[20,,SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER + .VALUE + .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT + .VALUE + MOVE A,[CMBUF,,CMBUF+1] + BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD, + MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD. + .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING. + POPJ P, +] ;END IFE DECSW, + +IFN DECSW,[ +TYI: INCHWL A + POPJ P, + +TAB: MOVEI A,^I +TYO: OUTCHR A + POPOPJ P, + +TTYINI: INIT TYIC,100 + 'TTY,, + 0 + JRST TTYINI + SETZM CMBUF + POPJ P, +] + + ;TS DATA STORAGE + +VBLK + +TYPDLS=TYPDLC*TYPDEL+INPDEL*MX.INS + ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE + ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED) + +ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY) +TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE + BLOCK TYPDLC*TYPDEL ;PDL PROPER + + ;INPUT BUFFER AND VARIABLES + +UTIBUF: EOFCH_<36.-7> + BLOCK TUTIBL-1 ;INPUT BUFFER +UTIBE: 0 ;END OF " +IUREDP: 440700,,UTIBUF ;INITIAL UREDP, POINTS TO BEGINNING OF ACTIVE PART OF BUFFER +UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER +UTIBED: 440700,,UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT +IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES + + ;FILE DESCRIPTION STORAGE + +INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE +FDSBEG==. ;BEGINNING OF TABLE AREA +DNAM: 0 ;DEVICE NAME +FNAM1: 0 ;FILE NAME 1 +FNAM2: 0 ;" " 2 +SNAM: 0 ;SYSTEM NAME +LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY +IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE + 0 ;FOR .FDELE AT .FILE TIME +ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED +OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME +IFN CREFSW,[ 0 +CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2. +CRFSNM: 0 ;CREF SNAME. +] +ERRDEV: BLOCK 4 ;FILENAMES OF FILE BEING READ NOW. +ERRTPF: 0 ;SET => NEXT ERROR MESSAGE SHOULD TYPE THEM. +FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA + BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S) +SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES + BLOCK LFDSE*MAXIND ;STORAGE FOR " + +RFNAM1: 0 ;.FNAM1 +RFNAM2: 0 +IFNM1: 0 ;.IFNM1 +IFNM2: 0 +RSYSNM: -1 ;INITIAL SYSTEM NAME + + ;.RCHST BLOCK + +RCHSTB: BLOCK 4 ;DNAM, FN1, FN2, SNAM +ACCP: 0 ;.ACCESS POINTER + BLOCK 4 ;ROOM FOR FURTHER EXPANSION OF .RCHST + + ;TTY VARIABLES + +CMBUF: BLOCK CMBFL ;TYPEIN BUFFER +CMPTR: 440700,,CMBUF ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0. + + ;OPNER VARIABLES + +ERRDNM: (SIXBIT /ERR/) + 3 +ERRNM2: 0 ;.STATUS WORD + + ;OUTPUT VARIABLES + +UTOBUF: BLOCK 200 ;OUTPUT BUFFER +UTOBE: +UTYOP: 0 ;OUTPUT (36. BIT) BYTE POINTER +UTYOCT: 0 ; - # WORDS LEFT IN UTOBUF + +IFN RUNTSW,RUNTSX: 0 ;NON-ZERO TO TYPE OUT RUN TIME AT END OF ASSEMBLY + +IFN CREFSW,[ ;CREF OUTPUT VARS. +CRFBUF: BLOCK CRFBSZ +CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER +CRFPTR: 0 ;BP IN BUFFER +] +PBLK + + ;.INSRT FILEDESCRIPTION + ;INSERT FILE HERE + ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE + ;PUSHES MACRO EXPANSION, OTHER .INSRT'S + ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER + +A.INSR: MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES + PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES + MOVSI A,(SIXBIT /DSK/) + MOVS B,DNAM + CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY, + MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD +A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + PUSHJ P,A.ITRY ;NO, TRY OPENING FILE + MOVE A,DNAM(F) + AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY + SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE +A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH + CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE + JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE + MOVE A,F ;-> SFSFDS + MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT + MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY + CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED + AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY + JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE + ;FILE IS IN TABLE + PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY + PUSHJ P,A.ITRY ;TRY OPENING FILE + MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER), + PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES + PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES + TYPR [ASCIZ / -> /] ;TYPE OUT POINTER + PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE + SETOM DNAM(F) ;"HALF-KILL" ENTRY +A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF +A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY + JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN + + ;FILE NOT IN TABLE + +A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE? + ERF (SIXBIT/TM@/) ;NO + MOVEI A,SFSFDS(F) + HRLI A,DNAM + BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY + SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION + MOVNI A,-LFDSE + ADDM A,INDDP ;UPDATE POINTER INTO TABLE + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY + MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME + MOVEM A,DNAM + JRST A.INT2 + + ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST A.ITRT ;YES, TREAT SPECIAL + PUSHJ P,IPUSH ;SAVE CURRENT STATUS + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST IPOPL ;LOSE, POP AND RETURN + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) + HRLI A,IFNM1 + BLT A,(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK. + PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT POPTT) +] +A.ITR2: + MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED + AOJN A,ASSEM1 + PUSHJ P,A.OMAP ;YES, DO IT + JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL) + + ;.INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF + JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2) + + ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY) + +A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL +A.INEO: TLNE FF,MACRCH ;INPUTTING FROM MACRO? + JRST A.IEF2 ;YES, POP IT OFF + PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR + MOVE B,ITTYP ;GET PDL POINTER + POPJ B, ;RETURN TO POP ROUTINE + +ERRTFL: AOSE ERRTPF ;TYPE FILNAMES IF CHANGED SINCE LAST CALLED HERE. + POPJ P, + MOVE C,[-4,,ERRDEV-DNAM] + PUSHJ P,TYPF1 + JRST CRR + + ;MISC .INSRT + +A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F +A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP + BLT A,DNAM+LFDSE-1 ;DO IT + POPJ P, + +A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC. + HRLI A,DNAM + BLT A,DNAM+LFDSE-1(F) + POPJ P, + + ;MISC TS + +IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT + MOVEI A,"_ ;EXPECTATION CHARACTER + JRST TYO ;TYPE OUT _ TO TELL USER MIDAS WANTS TYPEIN + + ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION + +TYPFIL: MOVSI C,-4 +TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME + PUSHJ P,SIXTYO ;TYPE OUT NAME + HLRZ A,C + MOVE A,FILSPC+4(A) ;NOW GET DELIMITING CHARACTER + PUSHJ P,TYO ;TYPE OUT + AOBJN C,TYPF1 ;LOOP FOR ALL NAMES + POPJ P, + +FILSPC: ": + 40 ;SPACE + 40 + "; + + ;OPENLOSS DOCUMENTATION ROUTINE + +IOPNER: MOVE A,IFSTS ;INPUT +OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD + PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION + PUSHJ P,CRR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING +IFN DECSW,[ + TYPR [ASCIZ/OPEN FAILED/] + JRST CRR +] +IFE DECSW,[ + .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG + .VALUE ;CAN'T OPEN ERR DEVICE? +IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM + CAIN A,14 ;ENDS WITH FORM FEED + POPJ P, + PUSHJ P,TYO ;TYPE OUT CHARACTER + JRST IOPNR2 ;LOOP BACK FOR NEXT +] ;END IFE DECSW, + + ;READ SINGLE FILE DESCRIPTION + +RFD: TRO I,FFFLG ;SET FLAG KEEPING TRACK OF FILENAME COUNT +RFD1: MOVEI C,0 ;INITIALIZE WORD + MOVE B,[440600,,C] ;SET UP BP FOR INPUT +RFD2: PUSHJ P,RCH ;GET CHARACTER IN A + CAIN A,": ;IF COLON... + JRST RFDCOL ;THEN PROCESS AS SUCH + CAIN A,"; ;SIMILARLY FOR SEMICOLON + JRST RFDSEM + CAIN A,^Q ;IF CONTROL Q... + JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL + CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR) + JRST RFDC ;NO +RFD6: JUMPE C,RFD5 ;IGNORE NULL FILENAMES + EXCH C,FNAM2 + TRZN I,FFFLG + MOVEM C,FNAM1 ;MOVE SECOND TO FIRST +RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS. + JRST RFD7] + CAIN A,^R ;CONTROL R, + JRST RFD ;RESETS FILENAME COUNT + CAIE A,15 ;WAS LAST CHAR CR? + JRST RFD1 ;NO, GO BACK FOR NEXT NAME + POPJ P, ;DONE + +RFDCOL: JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN + MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME". +RFDSEM: JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE + MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION + JRST RFD1 ;LOOP + +RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER + CAIN A,15 + JRST RFD6 ;BUT NOT IF CR +RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER. + SUBI A,40 + SUBI A,40 ;CONVERT CHARACTER TO SIXBIT + TLNE B,770000 ;TOO MANY CHARACTERS? + IDPB A,B ;NO + JRST RFD2 ;LOOP + +IFN DECSW,[ +RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM, + HRLM C,(P) + PUSHJ P,RFDOCT ;READ PROGRAMMER NUM. + HLL C,(P) + POPJ P, + +RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C. +RFDOC1: PUSHJ P,RCH + CAIL A,"0 + CAIL A,"8 + POPJ P, ;NOT OCTAL, RETURN. + IMULI C,10 + ADDI C,-"0(A) + JRST RFDOC1 +] + + ;GET COMMAND + +;FLAGS (IN F) (LH => INPUT, RH => OUTPUT) +;OTHER AC'S: C HAS COMPLETE NAME, D NAME BEING BUILT UP, TT BYTE POINTER TO C + +SIF==400000 +COLF==200000 +NAMF==100000 +NAM2F==40000 +DEVF==20000 +SCOLF==10000 +SYSNF==4000 + +CMD: PUSHJ P,CRR + MOVEI F,0 +CMDB: MOVEI D,0 ;CLEAR OUT NAME + MOVE TT,[10600,,D-1] +CMDL: PUSHJ P,RCHA ;READ CHARACTER FROM TTY + CAIN A,": + JRST CMDCOL + CAIN A,"; + JRST CMDSC + CAIN A,"_ + JRST CMDLA +IFN DECSW,[CAIN A,"[ ;] FOR DEC SYS, CAN SPEC PPN. + JRST CMDPPN + CAIE A,".] ;PERIOD SAME AS SPACE FOR DEC SYS. + CAIG A,40 + JRST CMDS + CAIN A,"( + JRST CMDSW + CAIN A,^Q ;^Q => READ ANOTHER CHAR, USE IT INSTEAD. + PUSHJ P,RCHA + CAIN A,^M ;CR ENDS COMMAND. + JRST CMDE +CMDL1: CAIL A,140 ;HANDLE LOWER CASE. + SUBI A,40 + SUBI A,40 + PUSHJ P,SYLEND + TLNE TT,770000 + IDPB A,TT + JRST CMDL + +IFN DECSW,[ +CMDPPN: PUSHJ P,SYLE1 ;END PREVIOUS NAME. + PUSHJ P,RFDPPN ;READ THE PPN. + TLO F,SCOLF+SIF + JRST CMDB ;USE AS SNAME. +] +CMDSC: TLOA F,SCOLF +CMDCOL: TLO F,COLF +CMDS: CAMN TT,[10600,,D-1] + JRST CMDL + TLO F,SIF + MOVE C,D + JRST CMDB + +SYLEND: TLZN F,SIF + POPJ P, +SYLE2: TLZE F,COLF + JRST SYLDV + TLZE F,SCOLF + JRST SYLSN + TLOE F,NAMF + JRST NAM2 + MOVEM C,FNAM1 + POPJ P, +NAM2: TLON F,NAM2F ;NAMES AFTER SECOND GET IGNORED + MOVEM C,FNAM2 + POPJ P, + +SYLSN: TLO F,SYSNF + MOVEM C,SNAM + POPJ P, +SYLDV: TLO F,DEVF + LDB T,[360600,,C] + CAIG T,'9 + CAIGE T,'0 + JRST SYLDV1 + TLNN C,7777 + MOVSI C,(SIXBIT /UT/+T) +SYLDV1: MOVEM C,DNAM + POPJ P, + +CMDLA: PUSHJ P,SYLE1 + HLRZS F + MOVE T,[DNAM,,ONAM] + BLT T,ONAM+3 + JRST CMDB + +SYLE1: CAMN TT,[10600,,D-1] + JRST SYLEND + MOVE C,D + JRST SYLE2 + +CMDSW: PUSHJ P,RCHA + CAIL A,140 ;LOWER CASE TO UPPER. + SUBI A,40 + CAIN A,") + JRST CMDL + CAIN A,"T + SOS TTYINS ;COUNT # T-SWITCHES. +IFN LISTSW,[CAIN A,"L + JRST CMDLST +] +IFN RUNTSW,[CAIN A,"R + SETOM RUNTSX +] +IFN CREFSW,[CAIN A,"C + SETOM CREFP +] JRST CMDSW + IFN CREFSW,[ +;OUTPUT WHATEVER IS IN CREF BUFFER. +CRFEND: SKIPGE CRFCNT + JRST CRFEN3 ;NOT INITTED, DON'T WRITE IT. + MOVE A,CRFPTR + HRLZI A,1-CRFBUF(A) + EQVI A,-1-CRFBUF ;AOBJN -> FILLED PART OF BUFFER. + .IOT CREFC,A +CRFEN3: SETOM CRFCNT ;SAY BUFFER NOT INITTED (WILL INIT ON OUTPUT) + POPJ P, + +CRFOUT: SOSGE CRFCNT + JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER. + IDPB A,CRFPTR + POPJ P, + +CRFOU1: PUSH P,A + AOSGE CRFCNT ;IF HAD BEEN -1, WASN'T INITTED, + JRST CRFOU2 ;DON'T EMPTY, JUST INIT. + MOVE A,[-CRFBSZ,,CRFBUF] + .IOT CREFC,A +CRFOU2: MOVE A,[444400,,CRFBUF] + MOVEM A,CRFPTR + MOVEI A,CRFBSZ + MOVEM A,CRFCNT ;SET UP PTR, CNT SAYING BUFFER EMPTY. + POP P,A + JRST CRFOUT + +CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK. +CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK. + PUSHJ P,CRFOUT + HRLZ A,RCHSTB ;AFTER HEADER COME DEV, FN1, FN2, SNAM + PUSHJ P,CRFOUT + MOVE A,IFNM1 ;ALL LEFT-JUSTIFIED SIXBIT WDS. + PUSHJ P,CRFOUT + MOVE A,IFNM2 + PUSHJ P,CRFOUT + MOVE A,RCHSTB+3 + JRST CRFOUT +] + +IFN LISTSW,[ + + ;PRINTING ROUTINES + + ;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING + +CMDLST: SETOM LISTON + PUSHJ P,MDSSET ;SET UP INSTRUCTIONS TO GO TO RCH +CMDSW1: .OPEN LPTC,[SIXBIT / !LPTWALL PAPER /] + SKIPA A,[30.] + JRST CMDSW + .SLEEP A, + JRST CMDSW1 + + ;PRINT CHARACTER IN A + +PILPT: .IOT LPTC,A + POPJ P, + + ;DONE PRINTING + +LPTCLS: SKIPL LISTON + POPJ P, ;WASN'T PRINTING TO BEGIN WITH + SETZM LISTON ;CLEAR OUT FLAG + MOVEI A,15 ;NOW TO END WITH FOR FEED + PUSHJ P,PILPT + MOVEI A,14 + PUSHJ P,PILPT + .CLOSE LPTC, ;RELEASE PRINTER + POPJ P, +] + + ;CARRIAGE RETURN TYPED + +CMDE: PUSHJ P,SYLE1 + TLNN F,NAMF\DEVF + JRST CMDB ;JUST RANDOM CR, TRY AGAIN + ;NOW FILL IN MISSING NAMES + ;DEVICE + MOVSI T,(SIXBIT /DSK/) + TLNE F,DEVF + SKIPA T,DNAM + MOVEM T,DNAM ;DEFAULT INPUT DEVICE IS DSK + CAMN T,[SIXBIT /TTY/] ;DEFAULT OUTPUT DEVICE IS INPUT DEVICE UNLESS INPUT DEVICE IS TTY, + MOVSI T,(SIXBIT /NUL/) ;IN WHICH CASE DEFAULT OUTPUT DEVICE IS NUL + TRNE F,NAMF\NAM2F\SYSNF ;UNLESS SOME OUTPUT NAME WAS GIVEN. + MOVSI T,'DSK + TRNN F,DEVF ;OUTPUT DEVICE SPECIFIED? + MOVEM T,ONAM ;NO, STORE DEFAULT OUTPUT DEVICE + ;SYSTEM NAME + MOVE T,RSYSNM + TLNN F,SYSNF + MOVEM T,SNAM ;DEFAULT INPUT SYSTEM NAME IS INITIAL SYSTEM NAME + TRNN F,SYSNF + MOVEM T,OSYSNM ;DEFAULT OUTPUT SYSTEM NAME IS ALSO INITIAL SYSTEM NAME + ;INPUT FILE NAMES + MOVE T,[SIXBIT /PROG/] + TLNN F,NAMF ;IF NO INPUT FILE NAMES TYPED, + MOVEM T,FNAM1 ;THEN FIRST INPUT FILE NAME IS "PROG" + MOVSI T,(SIXBIT />/) + TLNN F,NAM2F ;IF FEWER THAN TWO INPUT NAMES TYPED, + MOVEM T,FNAM2 ;THEN INPUT SECOND FILE NAME IS ">" + ;OUTPUT FILE NAMES + TRNE F,NAM2F + JRST CMDE1 ;BOTH OUTPUT FILE NAMES TYPED, RETURN + MOVE T,FNAM1 ;NOT BOTH, + EXCH T,ONAM+1 ;SET FIRST OUTPUT NAME FROM FIRST INPUT NAME + TRNN F,NAMF ;IF ONE OUTPUT NAME TYPED THEN IT IS THE SECOND + MOVEI T,0 ;AT FILE TIME TO BE CHANGED EITHER TO "BIN" OR "REL" + MOVEM T,ONAM+2 +CMDE1: +IFN CREFSW,[ ;SET CREF FILE NAMES. + MOVE T,[ONAM,,CRFDEV] + BLT T,CRFSNM ;FN1, SNAME SAME AS OUTPUT FILE'S, + SETZM CRFDEV+2 ;FN2 WILL DEFAULT TO CREF. + MOVSI T,(SIXBIT/DSK/) + MOVEM T,CRFDEV +] POPJ P, + + ;ALLOCATE FRESH BLOCK OF CORE CONTAINING ADR IN A + ;AA SHOULD HAVE POINTER TO ASCII STRING W/ NAME OF TABLE + ;BEING ALLOCATED FOR + ;CLOBBERS B, + +CORRQB: .VALUE ;LOOP POINT FOR DON'T PROCEED + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + SKIPA A,(P) ;RESTORE A FROM PDL +CORRQ: PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN +IFE DECSW,[ + HRLI A,10001 ;(CODE FOR FRESH PAGE, _1) + LSH A,-1 + .CBLK A, ;TRY GETTING BLOCK +] +IFN DECSW,[ + ADDI A,2000 + CORE A, +] + JRST CORRQL ;LOSE + JRST POPAJ ;WIN + +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPR [ASCIZ / +NO CORE FOR /] + TYPR (AA) ;TYPE TABLE NAME +CORQL1: TYPR [ASCIZ / +TRY AGAIN? /] +CORQL2: PUSHJ P,TYI ;GET CHAR + CAIN A,"Y ;Y, + JRST CORRQA ;=> TRY AGAIN + CAIN A,"N ;N, + JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN + CAIN A,"? ;?, + 3000,,CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB + TYPR [ASCIZ /? /] ;SOMETHING ELSE + JRST CORQL2 + +] ;END TS CONDITIONAL + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED" +PPB: JUMPGE FF,CPOPJ +PPBA: JRST TPPB" + +VBLK + +IFN PURESW&TS,[ ;PURIFICATION ROUTINE + +PURIFY: JRST PURIF1 ;OR .VALUE MESSAGE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT": +VPATCH": BLOCK 20 +VPATCE"=.-1 + +PBLK + +CONSTANTS + +PAT": +PATCH": BLOCK 100 +IFE PURESW,PATCHE"=.-1 + +IFN PURESW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==./2000 ;FIRST PAGE ABOVE PURE PAGES +PRINTA PURE PAGES = ,\MAXPUR-MINPUR +] + +VBLK +PDL": BLOCK LPDL+1 +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFN PURESW,MINBNK==<.+1777>/2000 ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\. + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. +IFN TS,IFNDEF SYMMAX,SYMMAX==40000 ;MAX. # SYMS IN SYMTAB. +IFG MOBY-TS, IFNDEF SYMMAX, SYMMAX==40000 +IFE MOBY&TS,IFNDEF SYMMAX,SYMMAX==<<16.*2000>-ST-1-MACL>/WPS +IFE TS,SYMDSZ==SYMMAX ;WHY TRY TO SAVE CORE IF NOT TS? + + BLOCK WPS*SYMDSZ + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMULI AA,WPS ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF MACTAB. + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN TS-DECSW,[ ;YES, GET CORE FOR INCREASE. + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. + .CALL INITSB(CH1) + .VALUE + MOVE AA,SYMSIZ ;LEAVE IN AA WHAT WE FOUND. + ADDI AA,ST +] +IFN DECSW,[ + MOVEI AA,MACL+1777(AA) + ANDI AA,-2000 + CORE AA, + HALT + MOVE AA,SYMSIZ + ADDI AA,ST +] + 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) + LSH AA,2 ;RELOCATE PTRS TO 4*MACTBA. + MOVSI A,CCOMPB-CCOMPE + ADDM AA,CCOMPB(A) + AOBJN A,.-1(CH1) + LSH AA,-2 ;AA AGAIN HAS SHIFT IN MACTAB. + 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 + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM BKCUR ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3INI + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +EISYMP": ;MAY BE MUNGED +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + MOVE B,1(AA) + MOVSI C,3INI + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 + AOS AA + AOJA AA,SP1(CH1) + +IFN TS-DECSW,[ +INITSB: SETZ ? 'CORBLK + 1000,,600000 ;BOTH READ AND WRITE. + 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI 400001 ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,PURIFD ;NOT PURIFIED => FLUSH PAGES + MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + MXIMAC*1001 +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, + +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIF1: MOVEI P,17 ;START PDL AT 20 + JSP F,PURIFD ;CALL .CBLK ROUTINE + MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB) + MINBNK*1001 + MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED. + MXICLR*1001 + MAXPUR-MINPUR ;PURIFY PURE PAGES. + 400000+MINPUR*1001 + SETZM PURIFG ;SET "PURIFIED" FLAG + MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF + MOVEI 1,0 + BLT 40 + .VALUE [ASCIZ /:PURIFIEDî/] + + ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS + ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS + ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO + ;SECOND INITIAL .CBLK AC CONTENTS + +PURIFD: MOVE C,(F) ;GET COUNT + TLNE C,777000 ;CHECK INSTRUCTION PART + JRST (F) ;INSTRUCTION => RETURN TO IT + JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT + MOVE A,1(F) ;GET INITIAL .CBLK ARG +PURID1: .CBLK A, + .VALUE + ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE + SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES +PURID2: ADDI F,2 + JRST PURIFD + +] ;END PURESW CONDITIONAL +] ;END TS CONDITIONAL + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +UFA=FSC-(2000) ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: UFA ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +SQUOZE 10,UFA ;PDP10 INSTRUCTION +SQUOZE 10,DFN ;PDP10 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 +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRL +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRL +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR + SQUOZE 10,FMPRL +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRL +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +0 + SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG + +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE + SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI + SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB + +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR + SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS + +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE + +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN + +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +SQUOZE 10,APR +0 +SQUOZE 10,PI +4 +SQUOZE 10,PTP +100 +SQUOZE 10,PTR +104 +SQUOZE 10,TTY +120 +SQUOZE 10,LPT +124 +SQUOZE 10,DIS +130 +SQUOZE 10,DC +200 +SQUOZE 10,UTC +210 +SQUOZE 10,UTS +214 + + +SQUOZE 10,LDBI ;REALLY ILDB, +LDBI +SQUOZE 10,DPBI ;AND IDPB +DPBI +SQUOZE 10,CLEAR +CLEAR +SQUOZE 10,CLEARI +CLEARI +SQUOZE 10,CLEARM +CLEARM +SQUOZE 10,CLEARB +CLEARB +IRPS INST,,FAD FSB FMP FDV +SQUOZE 10,INST!RI +INST!RL +TERMIN + +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,.MLLIT +CONSML,,INTSYM +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +IRPS X,,[END TITLE .BEGIN .END VARIAB SIXBIT ASCII ASCIZ .ASCII +BLOCK LOC OFFSET RELOCA 1PASS .DECRE NOSYMS EXPUNGE EQUALS NULL +WORD .SYMTAB] +SQUOZE 4,X +A!X +TERMIN + SQUOZE 4,.PASS +A.PASS,,INTSYM +SQUOZE 4,.PPASS +A.PPASS,,INTSYM + + ;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,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 D,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG D,SBCND + +SQUOZE 4,PRINTX +APRNTX +SQUOZE 4,PRINTC +(400000)APRNTC +SQUOZE 4,.ERR +A.ERR + +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,.AOP ;DOESN'T HAVE VALUE +A.AOP +SQUOZE 4,.OP +A.OP +SQUOZE 4,.FORMAT +A.FORMAT +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 +STGWS +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +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,.XCREF +A.XCREF +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 + A.XCREF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +AIRP +SQUOZE 4,IRPC +AIRP(400000) +SQUOZE 4,IRPS +(200000)AIRP +SQUOZE 4,IRPW +100000,,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 +] + +SQUOZE 4,.STGSW +STGSW,,INTSYM +SQUOZE 4,.AVAL1 +AVAL1,,INTSYM ;C(AC) AFTER .AOP, .OP +SQUOZE 4,.AVAL2 +AVAL2,,INTSYM ;C(E) AFTER " +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +SQUOZE 4,.IFNM1 +IFNM1,,INTSYM +SQUOZE 4,.IFNM2 +IFNM2,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN TSSYMS,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN +] +EISYMT": PRINTA \.-MACTBA-1, WORDS INITIALIZATION CODING. + +IFN TS,[ + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +] + +IFN TS\DECSW,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT, + ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE. + ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER + ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION + +END 100 +  \ No newline at end of file