From 4c41ce04e298ee39a1efb789938f102e1d10b784 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 9 Jan 2017 09:38:47 +0100 Subject: [PATCH] Build FAIL from sources and JOBDAT REL. --- README.md | 2 +- bin/sail/jobdat.rel | Bin 0 -> 1232 bytes build/build.tcl | 16 + src/sail/fail.200 | 13906 +++++++++++++++++++++++++++++++++++++++++ src/sail/fail.loader | 4 + src/sail/stktrn.39 | 102 +- 6 files changed, 13980 insertions(+), 50 deletions(-) create mode 100755 bin/sail/jobdat.rel create mode 100644 src/sail/fail.200 create mode 100644 src/sail/fail.loader diff --git a/README.md b/README.md index eaa1b07b..9a187175 100644 --- a/README.md +++ b/README.md @@ -135,7 +135,7 @@ A list of [known ITS machines](doc/machines.md). - DUMP/LOAD, tape backup and restore. - EMACS, editor. - EXECVT, convert 20x.exe (SSAVE) file to ITS BIN (PDUMP) file. - - FAIL, assembler from SAIL (binary). + - FAIL, assembler from SAIL. - FDIR, fast directory listing. - FED, font editor. - FIND, search for files. diff --git a/bin/sail/jobdat.rel b/bin/sail/jobdat.rel new file mode 100755 index 0000000000000000000000000000000000000000..dd7d464f36cdc2c3b2e8ab1a8cfc53988222c6af GIT binary patch literal 1232 zcmZ9MzfV(99K~;m51%Q>%d4RsEK&`H@~ebuAQnwyz>rh|O(=wvK1i3EP)LZ04N8el zF8&L|7zg9%Wa8q8i%}OHT{^f>T#7bC>p8ucd#`tD?iY%>WB^~(5Td&eWkQ3VRx=u2G|b} z3;`6<8mJzAkN~B|HIOdnW6}ePCCvjMa*?IRjtiDo)Jj!qhpkdkDBJ}NRBPiOspyZF z{CBn$K#t%nb3|Z%w_gEx>{(RA;Ng3rK%-g<)FnN)sdT^?I-2hV$shESuEl&qtTQ3!tc!Q61 zuv(PK6ShC3CC8~occ~btpID#XCRDJE#CW-f^Fm#5H4oPsSiHV&uFOEi!0s zM5}~hKPzLPRloj=u|h>3V_Yyic4SB3(XMp_huWFssRjwOe3-YAyeF8u+C2eeueO?wN`oUtzO6?{5k?B< zK<(p}zRNcNK~Q@GoE`aUFbSXaSA!3Ue1N#VUF`v;%bt6k-fIAx-G;~8m)I9!c+7N( bkRu%am8;qK+59GY?bC19p9h`Zt0vc98&Tcg literal 0 HcmV?d00001 diff --git a/build/build.tcl b/build/build.tcl index e332e007..a1aeb3d6 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -933,6 +933,22 @@ expect ":KILL" respond "*" ":fail sail;stktrn rel_sail;stktrn >\r" respond "*" "\032:kill\r" +# fail +respond "*" ":fail sail;fail rel_sail;fail >\r" +respond "*" "\032:kill\r" +respond "*" ":stink\r" +respond "\n" "m sail;jobdat rel\033l\033\033" +respond "\n" "m sail;stktrn rel\033l\033\033" +respond "\n" "m sail;fail rel\033l\033\033" +respond "\n" "m sail;fail bin\033y\033\033" +expect ":KILL" +respond "*" ":job fail\r" +respond "*" ":load sail;fail bin\r" +respond "*" "\033\0331l decsys;decbot bin\r" +respond "*" ".jbsa/strt\r" +respond "'" "\033y sys;ts fail\r" +respond "*" ":kill\r" + # who% respond "*" ":midas sys1;ts who%_sysen3;who%\r" expect ":KILL" diff --git a/src/sail/fail.200 b/src/sail/fail.200 new file mode 100644 index 00000000..2f53fa13 --- /dev/null +++ b/src/sail/fail.200 @@ -0,0 +1,13906 @@ +;[SRI-NIC]SRC:FAIL.FAI.3, 21-Jun-85 15:36:00, Edit by KLH +; Fixed polish fixup output at POLOUT to clear any unused reloc bits or +; halfword at end of block (random leftover junk caused %LNKJPB load errs) +;FAIL.FAI.2, 17-Feb-85 02:01:26, Edit by SATZ +; Use device name passed to us for .REQUEST and .REQUIRE +; instead of the one devined by JFNS%. Also zero PPN field. +;ACCT:FAIL.FAI.1, 12-Oct-81 17:07:42, Edit by B.BOMBADIL +;LOTS changes +; REG - add IFB and IFNB pseudo-ops +; RMK - better handling of .REQUIRE SYS:FOO, where FOO is on a directory +; other than the first one on the SYS: search path + + TITLE FAIL +SUBTTL CONDITIONAL ASSEMBLY + + +;VERSION STUFF +VFAIL__12 ;REG 12/27/76 +VMINOR__0 +VWHO__0 +VEDIT__0 + LOC 137 + BYTE(3)VWHO(9)VFAIL(6)VMINOR(18)VEDIT ;DEC-STYLE VERSION + RELOC 0 + +XALL + +;ITS ASSEMBLY ADDED 6/18/73 --PJ +;CMU ASSEMBLY ADDED 10/6/73 -- MM/FW +;DWP ASSEMBLY ADDED 27 FEB 74 -- INCREASES PLEN AND DELETES LITERAL COMPARE FOR LISP +;SYMDMP SWITCH: ADDS CODE THAT WRITES ASCII VERSION OF THE SYMBOL TABLE (FOR REG) +;KI10SW CONDITIONAL FOR KI-10 MNEMONICS +;TENEX ASSEMBLY MERGED 4/26/74 +;TENEX I/O ADDED 11/13/74 -- TMW +;TOPS-20 ASSEMBLY ADDED. 12/5/76 REG + +DEFINE SETSW(SWIT,VAL)SWIT__SWIT&1> +DEFINE SETSWX(SWIT,VAL)SWIT__SWIT> + +;THE INTENTION OF THE FOLLOWING CODE IS TO ALLOW YOU TO MAKE A NEW ASSEMBLY WITH +;THE SAME SWITCHES THAT WERE ON IN THE FAIL WITH WHICH YOU ARE ASSEMBLING. +;THE ONLY TIME THIS DOESN'T WORK IS TO ASSEMBLE A VERSION TO RUN ELSEWHERE, IN +;WHICH CASE, THE SWITCHES MUST BE SET EXPLICITLY FROM THE TTY: OR BY A HEADER FILE + +IFDEF SPCWAR, ;STANFORD +IFDEF .IOT, ;MIT +IFDEF CMUDEC, ;CMU +IFDEF HALTF, ;TENEX or TOPS-20 +IFDEF DMOVNM, ;KI-10 OPCODES +IFOP PSTIN, ;PSTIN JSYS EXISTS AT TENEX SITE +IFDEF KLGOT, ;THIS IS IMSSS +IFDEF SOUTR, ;THIS IS TOPS-20 +IFDEF AUXCAL, + +SETSW KI10SW,1 ;KI-10 MNEMONICS (ALSO KL10 MNEMONICS) +SETSW ITSSW,0 ;ITS (MIT) VERSION +SETSW CMUSW,0 ;CMU VERSION +SETSW TENEX,0 ;TENEX VERSION +SETSW TOPS20,0 ;TOPS-20 VERSION +SETSW STANSW,0 ;STANFORD VERSION +SETSW TYMSW,0 ;TYMSHARE VERSION + +SETSW DWPSW,0 ;DAVID POOLE VERSION FOR LISP +SETSW SYMDMP,0 ;REG VERSION FOR HARDCOPY OF INITIAL SYMBOL TABLE + +SETSW STNKSW,ITSSW +SETSW EDITSW,STANSW!CMUSW!TYMSW ;SWITCH TO ALLOW CALLING EDITOR + ;NOT USEFUL WITH TOPS-10 RUN UUO WHICH CLOBBERS ACS + +SETSW STOPSW,CMUSW ;SWITCH TO MAKE /R DEFAULT MODE (ONLY CMU LIKES IT) +SETSW TMPCSW,<1-> ;SWITCH TO ALLOW TMPCOR TYPE RPG INTERFACE + +SETSW IMSSSW,0 ;PRESENTLY CONTROLS ONLY DELETIONS IN PSTIN, LOCAL JSYSES +SETSW PSTISW,0 ;ONE IF TENEX SITE HAS PSTIN JSYS +SETSW KAFLG,1 ;IF PSTIN SIMULATION IS TO RUN ON A KA +SETSW KIFLG,<1-KAFLG> ;IF PSTIN TO RUN ON KI + +IFN TENEX!TOPS20,> + +DEFINE ITS, +DEFINE NOITS, + +DEFINE STINK, +DEFINE NOSTINK, + +DEFINE TNX, +DEFINE NOTNX, +DEFINE T20, +DEFINE NOT20, +IFE STANSW!ITSSW!CMUSW!TENEX!TYMSW,< + OSFAIL== + PRINTS /TOPS10 VERSION +/> + +IFN STANSW,< + OSFAIL== + PRINTS /SAIL VERSION +/> + +IFN TENEX,< +IFE TOPS20,< + OSFAIL== + PRINTS /TENEX VERSION +/>;NO TOPS20 +IFN TOPS20,< + OSFAIL== + PRINTS /TOPS20 VERSION +/>;TOPS20>;TENEX + +IFN CMUSW,< + OSFAIL== + PRINTS /CMU VERSION +/ +> + +IFN ITSSW,< + OSFAIL== + PRINTS /ITS VERSION +/> + +IFN TYMSW,< + OSFAIL== + PRINTS /TYMSHARE VERSION +/> + SUBTTL AC'S, PDL'S, AND INITIAL CONSTANTS + +;AC'S +;0 FOR FLAGS +T_1 +FS_T+1 +O_FS+1 +N_4 +NA_N+1 +PN_NA+1 +CP_7 +B_10 +C_B+1 +L_12 +TAC_13 +BC_14 +FC_15 +M_16 +P_17 + +ERPLEN__100 ;NO. OF ERROR MESSAGES +SETSWX LINLEN,=120 ;CHARACTERS/LINE +SETSWX LNPP,=60 ;LINES/PAGE FOR MOST PEOPLE +IFN STANSW, +CHRPL: LINLEN ;CHaRacters Per Line - normally =120, but reduced + ;by eight for CREFFing. - JHS +HASH__=101 ;HASH SIZE +PLEN__400 + +IFN DWPSW,{PLEN__2000} ;FOR MACRO EXPLOSIONS (I.E., LISP!) + +CPLEN__200 +RPGSW: 0 +RPGNEED:0 ;HACK FOR PEOPLE WHO LEAVE THE CRLF OFF THEIR COMMAND FILES +PDL: BLOCK PLEN ;PDLOV ERR PRINT WILL OVERFLOW INTO CPDL +CPDL: BLOCK CPLEN + +LSTLAB: BLOCK 5 ;0=LAST LABEL DEFINED BY : + ;1=BLOCK NAME AT LAST : + ;2=LAST SYMBOL DEFIND BY : OR _ + ;3=CURRENT BLOCK NAME + ;4=LOC OF LAST LABEL + +PATCH: BLOCK 20 ;GOD FORBID ANYONE SHOULD EVER HAVE TO DEBUG THIS, BUT +PATCH1: BLOCK 20 ;HERE'S A LITTLE SPACE FOR YOU. +PATCH2: BLOCK 20 +PATCH3: BLOCK 20 + + +EFSLEN__500;LENGTH OF AREA FOR POLISH +EFS: BLOCK EFSLEN + +UNIVSW: 0 ;SET TO -1 WHEN DOING UNIVERSAL PROGRAM +UNIVLH: 0 ;LIST HEADER FOR THE UNIVERSALS +UNIVFF: 0 ;FIRST FREE LOCATION ABOVE OU'S +UNIVBS: 0 ;BASE OF THE OU'S +U.SYM: 0 ;IN BEND, CHAIN OF SYMBOLS. +U.OPC: 0 ; OPCODES +U.MAC: 0 ; MACROS +US.S: 0 ;ADDRESS OF "FREE STORAGE LIST" FOR SYMBOLS +US.M: 0 ; FOR MACROS +US.O: 0 ; FOR OPCODES + +FUNSUP: 0 ;SET TO -1 TO PREVENT .FUN FILE FROM BEING WRITTEN + +IFE STANSW,< NOTNX,< NOITS,>> + +MACRT: BLOCK HASH +SYMTAB: BLOCK HASH + 0 +LITPNT: BLOCK HASH + -1 +LOB: BLOCK 3 +ODB: BLOCK 3 +OPCDS: BLOCK HASH + +TNX,< +DEFINE TSVAC (ACL) < +ZOT__0 +FOR AC IN (ACL) < + MOVEM AC,TNXACS+ZOT +ZOT__ZOT+1 +>> + +DEFINE TRSTAC (ACL) < +ZOT__0 +FOR AC IN (ACL) < + MOVE AC,TNXACS+ZOT +ZOT__ZOT+1 +>> + +TNXACS: BLOCK 4 ;TEMP AC STORAGE FOR JSYS CALLS + +MXCOR__762777 ;MAX CORE AVAIL TO FAIL (LEAVE RM FOR BUFFS, DDT) + +;DEFINE BUFFER PAGES, ETC. +ZOT__763 +FOR @' BUF IN (INDBF,LSTBF,BINBF,SRCBF) < +BUF'P__ZOT +BUF__BUF'P*1000 +ZOT__ZOT+1 +> +TRMP__ZOT +TRM__ZOT*1000 +IBUF1_SRCBF + +>;TNX + +IFE STANSW,< +NOTNX,< + 0 +IBUF1: 201,,IBUF2 + BLOCK 201+1 + 0 +IBUF2: 201,,IBUF3 + BLOCK 201+1 + 0 +IBUF3: 201,,IBUF4 + BLOCK 201+1 + 0 +IBUF4: 201,,IBUF5 + BLOCK 201+1 + 0 +IBUF5: 201,,IBUF1 + BLOCK 201+1 +>;NOTNX +>;IFE STANSW + +IFN STANSW,< + 0 ;1 WORD FOR SYSTEM +IBUF1: 201,,.+204 ;ANOTHER FOR SYSTEM + BLOCK 203 ;1 FOR SYS, 200 FOR DATA, 1 SPARE, 1 FOR SYS IN NEXT BUFFER +REPEAT =17,< 201,,.+204 + BLOCK 203 >;REPEAT =17 + 201,,IBUF1 + BLOCK 202 +>; + +ITS,< +SRCSTS: BLOCK 10 ;FOR CHANNEL STATUS +>;ITS + +IDB: 0 +INPNT: BLOCK 2 + +;MACRO TO MARK CURRENT PC AS LEGAL PLACE FOR MPV INTERRUPT +DEFINE LEG{FOR @! X_LEGNUM,LEGNUM{^^%$L!X::}^^LEGNUM__LEGNUM+1 } +LEGNUM__0 + + DEFINE DELHN < + DPB B,LSTPNT ;PUT ZERO OVER DELETE + ILDB C,INPNT ;GET NEXT + XCT DELTAB(C) ;HANDLE + ILDB C,INPNT ;GET NEXT + DPB C,LSTPNT ;DEPOSIT FOR LIST > + + DEFINE GFST(A,B) +< SKIPN A,B + JSR NOFSL +> + +;SRC1: SEARCH SYMBOL TABLE CHAIN +; A= AC CONTAINING SIXBIT SYMBOL NAME +; B= CONTAINS FIRST ADDR OF HASH CHAIN +; C= ADDRESS TO JRST TO ON SUCCESS +; D= INSTR. TO XCT IF YOU LOSE. +; ASSUMES 2ND WORD OF SYMBOL ENTRY IS FULL WORD OF LINK TO NEXT ENTRY + + DEFINE SRC1 (A,B,C,D) +< CAMN A,(B) + JRST C + SKIPN B,1(B) + D + CAMN A,(B) + JRST C + SKIPN B,1(B) + D + JRST .-10 +> + +;SRC2: SEARCH SYMBOL TABLE CHAIN. +; A= AC CONTAINING 6BIT SYMBOL NAME +; B= AC CONTAINING FIRST ADR. OF HASH CHAIN. +; C= ADDRESS TO JUMP TO IF YOU FIND IT +; D= INSTR TO XCT IF YOU FAIL, IF BLANK, FALL THROUGH. +; ASSUMES 2ND WORD OF SYMBOL ENTRY CONTAINS RIGHT HALF LINK TO NEXT + + DEFINE SRC2 (A,B,C,D) +< CAMN A,(B) + JRST C + HRRZ B,1(B) + JUMPN B,.-3 + D +> + + DEFINE ACALL ;TO CALL ASSMBL +< PUSHJ P,[POPJ CP,]> + DEFINE RETN ;TO RETURN FROM ASSMBL +< PUSHJ CP,[PUSH CP,[ASSMBL] + POP CP,-2(CP) + POPJ P,]> + DEFINE EDEPO (AC,PNT,NUM) +< MOVEI AC,177 +LEG IDPB AC,PNT + MOVEI AC,NUM +LEG IDPB AC,PNT +> + DEFINE RVALUA ;TO CALL REVAL +< PUSH P,[16] + PUSHJ P,REVAL + MOVE FS,(P) + TRZE POLERF + SETZM (FS) +> + +IFN CMUSW,< +OPDEF CMUDEC [CALLI -2] +OPDEF DECCMU [CALLI -3] +> + +TNX,< +OPDEF OUTSTR [7B8] +OPDEF OUTCHR [10B8] +OPDEF UMOVE [100B8] ;OPDEFS FOR TENEX +OPDEF UMOVEI [101B8] +OPDEF UMOVEM [102B8] +OPDEF UMOVES [103B8] +OPDEF JSYS [104B8] +NOT20, >;IFE PSTISW>;NOT20 +>;TNX + +OPDEF ERROR[11B8] +OPDEF FATAL[12B8] +OPDEF FOUT[13B8] +OPDEF OUTP[14B8] +OPDEF POUT[15B8] +OPDEF TRAN[16B8] +OPDEF BBOUT[17B8] +OPDEF CREF6 [20B8] +OPDEF CREF66 [21B8] +OPDEF CREF7 [22B8] + +ITS,< +OPDEF USETI [74B8] +OPDEF RELEASE [71B8] +OPDEF CLOSE [70B8] +OPDEF TTYUUO [51B8] +OPDEF PTYUUO [711B8] +OPDEF CALLI [47B8] +OPDEF INIT [41B8] +OPDEF LOOKUP [76B8] +OPDEF ENTER [77B8] +OPDEF IN [56B8] +OPDEF OUT [57B8] +OPDEF INPUT [66B8] +OPDEF OUTPUT [67B8] +OPDEF INBUF [64B8] +OPDEF OUTBUF [65B8] +OPDEF STATO [61B8] +OPDEF STATZ [63B8] +OPDEF GETSTS [62B8] +OPDEF MTAPE [72B8] + +OPDEF TTCALL [TTYUUO] +OPDEF INCHRW [TTYUUO 0,] +OPDEF OUTCHR [TTYUUO 1,] +OPDEF INCHRS [TTYUUO 2,] +OPDEF OUTSTR [TTYUUO 3,] +OPDEF INCHWL [TTYUUO 4,] +OPDEF INCHSL [TTYUUO 5,] +OPDEF GETLIN [TTYUUO 6,] +OPDEF SETLIN [TTYUUO 7,] +OPDEF RESCAN [TTYUUO 10,] +OPDEF CLRBFI [TTYUUO 11,] +OPDEF CLRBFO [TTYUUO 12,] +OPDEF INSKIP [TTYUUO 13,] +OPDEF INWAIT [TTYUUO 14,] + +OPDEF DEVCHR [CALLI 4] +OPDEF APRENB [CALLI 16] + +OPDEF DSKPPN [CALLI 400071] +OPDEF PTWR1S [PTYUUO 7,] +OPDEF PTWRS9 [PTYUUO 12,] + +IFNOP .OPEN,< + +OPDEF .OPEN [41000,,0] +OPDEF .IOT [40000,,0] +OPDEF .CORE [43300,,0] ;43 6,0 +OPDEF .RESET [42000,,37] +OPDEF .SUSET [43540,,0] ;43 13,0 +OPDEF .DISMI [43040,,0] ;43 1,0 +OPDEF .VALUE [43200,,0] ;43 4,0 +OPDEF .CLOSE [42000,,7] +OPDEF .RDATE [42000,,46] +OPDEF .RTIME [42000,,45] +OPDEF .RCHST [42000,,103] +OPDEF .IOPUSH [42000,,13] +OPDEF .IOPOP [42000,,14] +OPDEF .GETSYS [42000,,23] +OPDEF .EVAL [42000,,73] + +.SMASK_400006 +.SSNAM_400016 +.RMEMT__12 +OPTCMD__40000 ;BIT IN .OPTION THAT SAYS COMMAND TO BE READ +>;IFNOP .OPEN + +INTERNAL GBOUT1 +EXTERNAL STKTRN + +;DDT COMMAND GOODIES + +DDTCMD: 0 ;DDT COMMAND FLAG + +>;ITS + +notnx,< +IFE STANSW,< +NOTNX,< OPDEF RESET [CALLI 0] >;NOTNX +TNX,< OPDEF RESET [104000000147] >;TNX + +OPDEF DEVCHR [CALLI 4] +OPDEF CORE [CALLI 11] +OPDEF EXIT [CALLI 12] +OPDEF UTPCLR [CALLI 13] +OPDEF DATE [CALLI 14] +OPDEF APRENB [CALLI 16] +OPDEF MSTIME [CALLI 23] +OPDEF PJOB [CALLI 30] +OPDEF RUN [CALLI 35] +OPDEF TMPCOR [CALLI 44] +>;IFE STANSW +>;notnx + +EXTERN .JBREL,.JBFF,.JBSA,.JBAPR,.JBTPC,.JBCNI + +SNB__400000 ;VERY HANDY NUMBER WHICH ONE GETS TIRED OF TYPING + +LABLTP: 0 +LABLTC: 0 +LSTPNT: 0 + +IBUFR1_IBUF1 +BLOCK: 1 +DBLCK: XWD DAF,-1 + +PCNT: BLOCK 2 ;LEAVE CONTIGUOUS & IN THIS ORDER +OPCNT: BLOCK 2 +WRD: BLOCK 2 +DPCNT: BLOCK 2 + +NOTNX,< +;FILE-STACK +;0/ DEVICE +;1/ FILE +;2/ EXT +;3/ OLD INPNT (USELESS EXCEPT IF EXPANDING MACRO) +;4/ PPN +;5/ PAGE,,RECORD +;6/ TVFILE,,INLINE +;7/ ADDRESS OF FILE-INPNT (POINTS INTO MACRO-PDL SOMETIMES, OR TO INPNT) + +FILSTL__10 ;LENGTH OF EACH FILE-STACK ENTRY +>;NOTNX + +TNX,< +;FILE-STACK +;0/ JFN (SGN BIT SET IF PMAPPABLE) +;1/ OLD INPNT +;2/ USER PAGE,,FILE PAGE +;3/ TVFILE,,INLINE +;4/ ADDR OF FILE-INPNT + +FILSTL__5 +>;TNX + +FILSTK: BLOCK FILSTL*10 ;FILE-STACK - ROOM FOR 8 LEVELS OF FILE NESTING +FILSTP: FILSTK ;POINTER TO NEXT AVAILABLE "ENTRY" IN FILE-STACK +FILSTC: 0 ;STACK DEPTH +IRECN: 0 ;RECORD NUMBER IN THE CURRENT INPUT FILE. +INPNTP: INPNT ;INPNT-POINTER. ALWAYS POINTS TO FILE-INPNT +ERCNT: 0 ;COUNT OF ERRORS ON THIS LINE. + +DEFINE PSHPNT(AC)< + PUSH M,INPNTP ;POINTER TO FILE-INPNT + PUSH M,INPNT ;INPUT BYTE POINTER + MOVE AC,INPNTP + CAIN AC,INPNT + HRRZM M,INPNTP ;NEW VALUE IF WE JUST PUSHED FILE-INPNT +> + SUBTTL DEFINITION OF FLAGS FLAGS FLAGS +;AC 0 IS FLAG REGISTER +;AC 0 FLAGS (LEFT HALF): + +SFL__200000 ;SCANNER AHEAD ONE CHR. +IFLG__100000 ;SCAN SAW IDENT +NFLG__40000 ;SCAN SAW NUMBER +SCFL__20000 ;SCAN SAW SPC.CHR. +FLTFL__10000 ;SCAN -- FLOATING POINT NUMBER +ESNG__4000 ;EVAL SAW ONLY SINGLE THING +ESPF__2000 ;EVAL SAW ONLY SPC CHR +REUNBF __1000 ;REVAL TEMP BIT -- UNBAL PARENS +OPFLG__400 ;AN OPCODE WAS SEEN +RELEF__200 ;REDUC -- RELOC ERROR +SOPF__100 ;SCANS -- OPCODE FOUND +PSOPF__40 ;SCANS -- PSEUDO-OP FOUND +MLFT__20 ;LEFT HALF FIXUPS SHOULD BE GENERATED +UNDF__10 ;MEVAL -- UNDEF. +PAWF__4 ;PARENS AROUND WHOLE -- MEVAL +AUNDF__2 ;ASSMBL -- PART IS UNDEFINED + +;RIGHT HALF BITS: + +NOFXF__200000 ;MEVAL -- DONT GENERATE FIXUPS +IOSW__100000 ;ASSMBL -- IO OPCODE +BDEV__40000 ;BIN DEVICE EXISTS +LDEV__20000 ;LIST DEVICE EXISTS +BLOSW__10000 ;TEMP BIT FOR LISTING SYNC +ADFL__4000 ;TEMP BIT USED BY ASSMBLE TO KEEP TRACK OF # OF ADRSES +FLFXF__2000 ;USED BY ASSMBL TO TELL MEVAL TO MAKE FULL WORD FIXUPS +TRBF__1000 ;ASSMBL -- TERMINATED BY ] +POLERF__400 ;POLISH ERROR +MACUNF__200 ;A MACRO WAS ENTERED (FOR UNDERLINING) +RWARN1==100 ;BAD DIGIT IN NUMBER SCAN WARNING +RWARN2==40 ;BAD DIGIT IN NUMBER SCAN WARNING +IOFLGS__BDEV!LDEV!BLOSW ;FLAGS PERTAINING TO I/O + +;THE FOLLOWING ARE BITS USED TO IDENTIFY CHARACTERS IN THE TABLE +;LEFT HALF BITS: +;SNB OR 400000 (SIGN) ;NUMBER OR LETTER +NMFLG__200000 ;NUMBER +SPFL__100000 ;SPACE(TAB) +SPCLF__40000 ;ANY SPC. CHR. +ARFL__20000 ;ARITH OPERATOR +ARMD__10000 ;ARITH OP MODIFIER (-,/,&,,UN -) +ARMD1__4000 ;ADDITIONAL MODIFIER +UNOF__2000 ;UNARY OP (- , ^E (NOT)) +BFL__1000 ;B +EFL__400 ;E +DLETF__200 ;DELETE +CRFG__100 ;CR RET +LBRF__40 ;< OR [ +RBRF__20 ;> OR ] +.FL__10 ;. +LNFD__4 ;LINE FEED +ENMF__2 ;INDICATES THAT ANY STRING STARTING WITH + ;THIS CHR. WILL BE SCANNED AS A NUMERICAL VALUE +SCRF__1 ;SPC.CHR. REQUIRING HANDLING BY SCANNER + + +;THE FOLLOWING ARE RIGHT HALF BITS + +SHRPF__400000 ;# +BSLF__200000 ;\ (BACKSLASH) () +UDARF__100000 ;^ OR DOWN-ARROW +LACF__40000 ;_ OR : +COMF__20000 ;, +LFPF__10000 ;( +RTPF__4000 ;) +ATF__2000 ;@ +RBCF__1000 +LBCF__400 +INF__200 ; +EPSF__100 ; +TP2F__2 ;SUB-CLASS 2 +TP1F__1 ;SUB-CLASS 1 + +;THE FOLLOWING ARE NUMBER (FLAG PART) BITS USED TO TELL +; ABOUT NUMBERS AND SYMBOLS +;LEFT HALF: +DEFFL__200000 ;UNDEFINED IF ON +VARF__100000 ;"VAR"--(DEFINED WITH #) +INCF__20000 ;"IN CORE" VALUE (IN ASSEMBLER CORE) +UPARF__10000 ;UP ARROW (SYMBOL ONLY) +DAF__4000 ;DOWN ARROW(SYMBOL ONLY) +DBLF__2000 ;DOUBLE _ (__) (SYMBOL ONLY) +GLOBF__1000 ;GLOBAL +INTF__400 ;INTERNAL +EXTF__200 ;EXTERNAL +UDSF__100 ;SYMBOL HAS BEEN DEFINED WITH AN UNDEFINED DEFINITION +SYMFIX__40 ;WE NEED A SYMBOL TABLE FIXUP FOR THIS SYMBOL +DBLUPF__20 ;THIS IS A DOUBLE UPARROWED SYMBOL (SYMBOL ONLY);;;; +COLONF__10 ;SYM WAS DEFINED WITH : +REFBIT__4 ;SYM HAS BEEN REFERENCED +ITS,<ANONF__2> ;THIS SYMBOL ANONYMOUS TO LOADER +SUPBIT__1 ;THIS BIT IS ON TO SUPPRESS SUPERFLUOUS DEFINITIONS + +;RIGHT HALF HAS BITS FOR LEVELS AT WHICH DEFINED. + +NOLIT + +;RANDOM CONSTANT MEMORY CELLS + +CPOPJ1: AOS (P) +CPOPJ: POPJ P, + +NOTNX,<TTCRLF:> +IFN TOPS20,<TTCRLF: > +CRLF: BYTE(7)15,12 + +IFE TOPS20,,> + +STAR: BYTE(7)15,12,"*" + BEGIN OPTBL  SUBTTL THE OPCODE TABLE +GLOBAL HASH +xall + FOR @$ I_0,HASH-1 +< IBQ$I_0 +> + DEFINE ENT $(A,B,C) +< XLIST + IBQ_'A'-'A'/HASH*HASH + IFL IBQ, + EN1(A,\IBQ,B,C) + LIST +> + +;GOBBLE BIT 14 TO SIGNIFY CALLI (AT CMU) + DEFINE EN1 $(A,B,C,D) +< 'A' + IFIDN <>,, + IFDIF <>,,<777767,,IBQ$B> + IFDIF <>,,,,> + IBQ$B_.-2 + IFDIF <>,, + > + DEFINE EMO(A) +< FOR @$ B IN(A) +< ENT(B) + ENT(B$I) + ENT(B$M) + ENT(B$S) +> +> + +IFE STANSW!ITSSW,< + DEFINE ECALLI $ (A,NUM) ;NEEDED FOR DEC SYSTEMS +< ENT(A,NUM$B12+10B17+) +>> + + + DEFINE ERG(A) + +> + +;THE EARLIER AN ENTRY APPEARS HERE, THE LONGER IT TAKES TO FIND IN SEARCHES + +IFN KI10SW,< ENT(ADJSP,105B8+) ;OPCODES FOR KL10 PROCESSOR TOO + ENT(ADJBP,<>) ;IDIOT ALTERNATE NAME + ENT(DFAD,110B8+) ;OPCODES FOR KI10 PROCESSOR + ENT(DFSB,111B8+) + ENT(DFMP,112B8+) + ENT(DFDV,113B8+) + ENT(DADD,114B8+) + ENT(DSUB,115B8+) + ENT(DMUL,116B8+) + ENT(DDIV,117B8+) + ENT(DMOVE,120B8+) + ENT(DMOVN,121B8+) +IFE STANSW,< ENT(FIX,122B8+) ;> ENT(KIFIX,122B8+) ;DIFFERENT NAME + ENT(EXTEND,123B8+) + ENT(DMOVEM,124B8+) + ENT(DMOVNM,125B8+) + ENT(FIXR,126B8+) + ENT(FLTR,127B8+) + ENT(PORTAL,<>) + ENT(MAP,257B8+) >;IFN KI10SW + +TNX,< + ENT(ASSIGN,0,%ASSIG) ;ASSIGN PSEUDO-OP +T20,< + ENT(ERJMP,<>) + ENT(ERCAL,<>) +>;T20 + + +> ;IFN TENEX + +ENT (.WCTAB,0,%WCTAB) ;.WCTAB CHAR,VAL +ENT (.RCTAB,0,%RCTAB) ;.RCTAB CHAR +ENT (.COMMO,0,%COMMN) ;.COMMON - FOR MACRO-10 +ENT (.ASSIG,0,%ASSIG) ;.ASSIGN PSEUDO-OP - SAME AS FOR TENEX +ENT (.TEXT,2,%ASCII) ;.TEXT FOR LINK-10 +ENT (.DIREC,0,%DIREC) ;.DIRECTIVE LIKE IN MACRO-10 +ENT (.FATAL,0,%FATAL) +ENT (GDEFIN,0,%GDEF) ;LIKE ^^DEFINE +ENT (PRINTX,0,%PRNTX) +ENT (PRINTS,0,%PRNTC) +ENT (SEARCH,0,%SEAR) +ENT (UNIVER,0,%UNIV) +ENT (SUPPRE,0,%SUPPR) +ENT (ASUPPR,0,%ASUPP) +ENT (XPUNGE,0,%XPUNG) +ENT (PURGE,0,%PURGE) +ENT (.LIBRA,17,%LBLCK) +ENT (.LOAD,16,%LBLCK) +ENT (.REQUE,17,%LBLCK) ;.REQUEST LIKE .LIBRARY +ENT (.REQUI,16,%LBLCK) ;.REQUIRE LIKE .LOAD +ERG () +ENT (PHASE,0,PHAZ) +ENT (DEPHAS,0,DPHAZ) +ENT (PZE, ,) +ENT (PAGE,0,%PAGE) +ENT (SUBTTL,0,%SUB) +ENT (RADIX,0,%RADIX) +ENT (TITLE,0,%TITLE) +ENT (END,9,%END) +ENT (PRGEND,0,%PRGEN) + DEFINE IO(A) + +> +IO() +FOR @$ QRN IN (USE,SET,NOSYM,LIT,VAR,LIST,LALL) + +ENT(XLIST,-1,%LIST) +ENT(XALL,-1,%LALL) +ENT(XLIST1,1,%LIST) +ENT(LOC,0,%ORG) +ENT(RELOC,-1,%ORG) +ENT(ORG,1,%ORG) +ENT(.ORG,1,%ORG) ;.ORG - SAME AS ORG + DEFINE ENQ(A) +< FOR B IN(A) + +> + +IFE STANSW!ITSSW,< +ENQ() +ENQ() +ENQ() +> ;IFE STANSW!ITSSW + +NOTNX,< +IFE STANSW!ITSSW,< ;THE FOLLOWING ARE FOR ALL DEC SYSTEMS +$IBQ_-1 +FOR ZOT IN ( +,RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT,GETCHR, +,WAIT,CORE,EXIT,UTPCLR,DATE,LOGIN,APRENB, +,SWITCH,REASSI,TIMER,MSTIME,GETPPN,TRPSET,TRPJEN, +,PJOB,SLEEP,SETPOV,PEEK,GETLIN,RUN,SETUWP, +,GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR,SYSSTR, +,STRUUO,SYSPHY,FRECHN,DEVTYP,DEVSTS,DEVPPN,SEEK, +,LOCK,JOBSTS,LOCATE,WHERE,DEVNAM,CTLJOB,GOBSTR,<> +,<>,HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN, +,CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN,FRCUUO, +,PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.,TRMOP., +,UNLOK.,DISK.,DVRST.,DVURS.) +,, +$IBQ_$IBQ+1 +> + +>;IFE STANSW!ITSSW +>;NOTNX + +TNX,< +;THIS ONE RESOLVES JSYS/CALLI CONFLICTS IN FAVOR OF THE JSYS +;PROBLEMS WITH RESET,WAIT,LOGIN,DEVNAM,PEEK +IFE STANSW!ITSSW,< ;THE FOLLOWING ARE FOR ALL DEC SYSTEMS +$IBQ_-1 +FOR ZOT IN ( +,<>,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT,GETCHR, +,<>,CORE,EXIT,UTPCLR,DATE,<>,APRENB, +,SWITCH,REASSI,TIMER,MSTIME,GETPPN,TRPSET,TRPJEN, +,PJOB,SLEEP,SETPOV,<>,GETLIN,RUN,SETUWP, +,GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR,SYSSTR, +,STRUUO,SYSPHY,FRECHN,DEVTYP,DEVSTS,DEVPPN,SEEK, +,LOCK,JOBSTS,LOCATE,WHERE,<>,CTLJOB,GOBSTR,<> +,<>,HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN, +,CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN,FRCUUO, +,PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.,TRMOP., +,UNLOK.,DISK.,DVRST.,DVURS.) +,, +$IBQ_$IBQ+1 +> +>;IFE STANSW!ITSSW +>;TNX + +IFN CMUSW,< ;THE FOLLOWING ARE FOR CMU ONLY ! +$IBQ_-2 +FOR ZOT IN (CMUDEC,DECCMU,MSGSND,MSGPOL,JENAPR, +,STOP,TIME,UNTIME,RSTUUO,INT11,LNKRDY,PRIOR,IMPUUO) +,, +$IBQ_$IBQ-1 +> +>;IFN CMUSW + +ENT(INTERN,0,%INT) +ENT(.GOPDE,0,%GOPDE) +ENT(OPDEF,0,%OPDEF) +ENT(ENTRY,0,%ENTRY) +ENT(LINK,0,%LINK) +ENT(LINKEN,0,%ENDL) +ENT(.LINK,0,%LINK) ;.LINK - LIKE LINK +ENT(.LNKEN,0,%ENDL) ;.LNKEND - LINKEND +ENT(RADIX5,0,%RAD5) +ENT(CREF,0,%ONCRF) +ENT(XCREF,0,%OFCRF) +ENT(NOLIT,0,%NOLIT) +ENT(ARRAY,0,%ARAY) +ENT(INTEGE,0,%INTEG) +ENT(GLOBAL,0,%GLOB) + DEFINE MAT $(B) +) +ENQ() +> + +MAT(TS) +FOR @$ C IN(FAD,FSB,FMP,FDV) +) +> +ENQ() +ENT(TTCALL,51B8+) +IFN STANSW,< +ENT(DPYOUT,703B8+) +ENT(INTJEN,723B8+) ;AN ALTERNATIVE TO INTDEJ +> +IFE STANSW< +ENT(OPEN,50B8+) +ENT(RENAME,55B8+) +ENT(TTYUUO,51B8+) +ENT(INCHRW,<>) +ENT(OUTCHR,<>) +ENT(INCHRS,<>) +ENT(OUTSTR,<>) +ENT(INCHWL,<>) +ENT(INCHSL,<>) +ENT(GETLIN,<>) +ENT(GETLCH,<>) ;DEC MNEMONIC +ENT(SETLIN,<>) +ENT(SETLCH,<>) ;DEC MNEMONIC +ENT(RESCAN,<>) +ENT(CLRBFI,<>) +ENT(CLRBFO,<>) +ENT(INSKIP,<>) +ENT(SKPINC,<>) ;ALTERNATE MNEMONIC +ENT(SKPINL,<>) ;DEC MNEMONIC +ENT(IONEOU,<>) ;NEW DEC TTCALL +ENT(IN,56B8+) +ENT(OUT,57B8+) +> ;IFE STANSW + +ENT(JFFO,243B8+) +ENT(UFA,130B8+) +ENT(DFN,131B8+) +ENT(FADRI,145B8+) +ENT(FSBRI,155B8+) +ENT(FMPRI,165B8+) +ENT(FDVRI,175B8+) + +IFN STANSW,< ENT(KAFIX,247B8+) >;IFN STANSW + +ENT(JEN,<>) +ENT(HALT,<>) +ENT(JRSTF,<>) +ENT(JFOV,<>) +ENT(JOV,<>) +ENT(JCRY,<>) +ENT(JCRY0,<>) +ENT(JCRY1,<>) +ENT(DEFINE,0,%DEF) +ENT(HISEG,0,%HISEG) +ENT(TWOSEG,0,%TWOSEG) +ENT(REPEAT,0,%REP) +ENT(FOR,0,%FOR) +ENT(POINT,0,%POINT) +ENT(BYTE,0,%BYTE) +ENT(OCT,10,%CON) +ENT(DEC,12,%CON) +ENQ() +ERG() +MAT(TD) +DEFINE MAH $(A) +) +> +MAH(E) +MAH(O) +ERG() +ERG() +ENT(COMMEN,0,%COMMT) +ENT(EXTERN,0,%EXT) +DEFINE JSK(A) +) +> +> +JSK() + +TNX,< ENT(JSYS) + EMO(UMOVE) > + +ENT(JSR) +JSK(CAM) +MAH() +JSK(CAI) +ENQ() +EMO() +ERG(SETZ) +ENT(BLOCK,0,%BLOCK) +ENT(EXCH) +MAH(Z) +ENT(BEGIN,0,%BEG) +ENT(BEND,0,%BEND) +JSK(SKIP) +ERG(SUB) +ENQ() +ERG(ADD) +JSK(JUMP) +MAT(TR) +MAT(TL) +ENQ() +ENT (ASCII,0,%ASCII) +ENT (ASCIZ,1,%ASCII) +ENT (ASCID,-1,%ASCII) +ENT(SIXBIT,0,%SIX) +ENT(XWD,0,%XWD) +EMO(MOVE) +ENT(JRST) +IFN TYMSW,>) +ENT (OUTCHI,<>) +ENT (IONEOU,<>) +ENT (SKPINL,<>) +ENT (SKPINC,<>) +$IBQ_-60 +FOR ZOT IN (XCHARG,SETFRC,TYMCHG,DATUUO,DDT620,VALRMT, +,IDLRMT,ZAPRMT,CRERMT,AUXRED,ZAPCIR,CREAUX,REDPIP,TINASS,SETTR2, +,SETTIM,INTASS,INTACT,INTENB,INTADR,HANG,CHKLIC,LEVDEF,MOVBUF, +,RUNSEG,SYSDVF,DISMIS,DSKCLR,SETJAL,ONEJOB,SETMAL,GETTMC, +,REDNXT,WAITCH,POKE,SETPRV,SETLIC,SETE,ATTACH,<>,<>,<>,<>, +,RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT,GETCHR,DDTRL,WAIT,CORE, +,UTPCLR,DATE,LOGIN,APRENB,LOGOUT,SWITCH,REASSI,TIMER,MSTIME, +,TRPSET,TRPJEN,RUNTIM,PJOB,SLEEP,SETPOV,PEEK,GETLIN,RUN, +,REMAP,GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR,SYSSTR,JOBSTR, +,SYSPHY,FRECHN,DEVTYP,DEVSTS,DEVPPN,SEEK,RTTRP,LOCK,JOBSTS, +,WHERE,DEVNAM,CTLJOB,GOBSTR,<>,<>,HPQ,HIBER,WAKE,CHGPPN, +,DEFGEN,OTHUSR,CHKACC,DEVSIZ) +,, +$IBQ_$IBQ+1 +>> ;TYMSW + +;ASSEMBLE TABLE OF OPCODES THAT HAVE BEEN DEFINED THUS FAR +^OPCDS1:FOR @$ I_0,HASH-1 + +FOR @$I_0,HASH-1 + +DEFINE MENT (AR,BR,QR) +<'AR' +IBQ_'AR'-'AR'/HASH*HASH +IFL IBQ, +MENQ (\IBQ) +0 +XWD -1,BR +QR + > +DEFINE MENQ $(A) + +FOR ROM IN (,,,,,) + +FOR FOO IN (, + ,, + ,, + ,, + ,, + ,,) + +^%IOWD: 'IOWD' +IBQ_'IOWD'-'IOWD'/HASH*HASH +MENQ (\IBQ) +0 +2 +.+1 +%IOWD +ASCII/ XWD / +BYTE (7)"-","(",177,1,0,")",",",177,1,1,"-","1",40,177,3 +FOR @! X IN(.,$.) +< 'X' +IBQ__'X'-'X'/HASH*HASH +MENQ \IBQ +0 +-2,,SCAN!X +SCNMPT +> + +'.FNAM1' ;ENTRIES FOR .FNAM1, .FNAM2 PSEUDO-MACROS +IBQ_'.FNAM1'-'.FNAM1'/HASH*HASH +MENQ \IBQ +0 +-1,,%FNM1 +SCNMPT + +'.FNAM2' +IBQ_'.FNAM2'-'.FNAM2'/HASH*HASH +MENQ \IBQ +0 +-1,,%FNM2 +SCNMPT + + +' .CPU.' ;.CPU. IS ALSO A PSEUDO-MACRO +IBQ_' .CPU.'-' .CPU.'/HASH*HASH +MENQ \IBQ +0 +-1,,%CPU +SCNMPT + +'.OSFAI' ;.OSFAIL PSEUDO-MACRO +IBQ_'.OSFAI' - '.OSFAI'/HASH*HASH +MENQ \IBQ +0 +-1,,%OSFAI +SCNMPT + +'.INSER' ;ENTRY FOR .INSERT AS A PSEUDO-MACRO +IBQ_'.INSER'-'.INSER'/HASH*HASH +MENQ \IBQ +0 +-1,,0 +%INSER + + +;GENERATE TABLE OF PREDFINED MACROS (INCLUDES IFS, IOWD, "." AND "$.") +^MACRT1: FOR @$ I_0,HASH-1 + + +COMMENT % + FAIL symbol table format REG 3-18-74 + +There are three symbol tables: SYMTAB, MACRT, and OPCDS. These store +user-defined symbols, macros, and opcodes. SYMTAB is empty at the start +of an assembly. MACRT and OPCDS are initialized from MACRT1 and OPCDS1 +which contain FAIL's initial symbol table, including the definition of +all opcodes, pseudo-ops, IFs, IOWD, etc. Also, the Stanford version adds +the Stanford CALLIs and IOT uuos to OPCDS1. + +Every symbol table entry contains at least two words. The first word +is the right-adjusted sixbit for the symbol name. The right half of +the second word contains a pointer to the next symbol table entry, or +zero. The symbol table entries are hash coded. The hash function +is ABS(REM(sixbit symbol name, hash table length)). + +OPCDS + 1. initialized from OPCDS1 - permanent definitions + 2. Added to by OPDEF pseudo-op + 3. user-defined opcodes are deleted at block-exit. + opcodes are written into the REL file. + + 4. Entry format: + 0: Symbol name in right-adjusted sixbit + 1: code,,link to next + if code has bits 13 and 14 off, then code,,0 is the value + if code has bit 14 on then it is a predefined CALLI + if code has bit 0 on, it is a pseudo-op + otherwise, it is a user-defined opdef. + + CALLIs: at Stanford, bits 0-12 are the calli index, except + if that field exceeds UCLDLN, add SLCOFF to it. + at CMU, ASH bits 0-12 right 23 bits for the calli number. + + Pseudo-ops: four word entries, others are: + 2: 0,,address of processing routine + 3: value (i.e., argument) + + Opdefs: five word entries, others are: + 2: Block bit + 3: Value + 4: flags + + +MACRT + 1. initialized from MACRT1 - permanent definitions + 2. Added to by DEFINE pseudo-op + 3. User macros are deleted at block-exit + 4. Entry format: + 0: Macro name, right adjusted sixbit + 1: 0,,link to next + 2: 0 + 3: code,,number of arguments + 4: processing address or definition string + code is negative for a macro-pseudo op: + processing address is a dispatch. If bit + 17 is off, CREF information will not be emitted + (for "." and "$."). For "." and "$." bit 12 + (LBRF) must be on - see SPCCHK. + if code is zero, the right side is the number of arguments + else, the right side is an argument (as in the IFS). + the address of the definition string is given. + The macro definition string contains as its first word, + length,,back-pointer. Length is the length of the definition + string, and the back-pointer points to the entry in MACRT. + The ascii text of the macro body appear in sequential bytes. + The code 177 3 terminates the macro, the code 177 1 n denotes + argument n (first argument is number zero). + +SYMTAB + 1. Initially empty + 2. Every symbol seen that is not a macro name or opcode + is added to this table + 3. Symbols that are defined within a block and are not up-arrowed + are deleted at block exit. Symbol definitions are written into + the REL file + 4. Entry format: + 0: Symbol name, right adjusted sixbit + 1: 0,,link to next + 2: symbol flags,,block bits + 3: value if defined, else fixup list + 4: value flags if defined, else polish fixup list +% + BEGIN SYMWRT +;THIS IS THE CODE THAT DUMPS THE SYMBOL TABLE TO HELP REG MAKE THE FAIL MANUAL +;FAIRLY MINIMAL HACK. CALLED FROM COMMAND: ,FILE/Y +;NOT YET TENEXIZED...PROBABLY SHOULD BE...TMW + +IFN SYMDMP,< +^^SYMWRT: + TRNN LDEV + HALT ;MUST HAVE A LISTING, ELSE THIS IS POINTLESS + MOVSI M,-HASH + MOVEI BC,0 ;FLAG NORMAL SYMBOL TABLE +SYMW1: SKIPE FC,OPCDS1(M) ;DOES THIS CHAIN EXIST? + PUSHJ P,SYMCH ;YES. PROCESS IT + AOBJN M,SYMW1 ;LOOP THRU ALL CHAINS. + MOVEI BC,1 ;FLAG MACRO TABLE + MOVSI M,-HASH +SYMW2: SKIPE FC,MACRT1(M) + PUSHJ P,SYMCH + AOBJN M,SYMW2 + CLOSE 4, + RELEAS 4, + EXIT + +SYMCH: MOVE FS,(FC) ;GET A SIXBIT THING + PUSHJ P,SYM62A ;WRITE IN ASCII + MOVEI FS,[BYTE(7)11,40,40] + PUSHJ P,SYMSTR ;TAB + JUMPN BC,SYMCH6 ;JUMP IF PROCESSING MACRO TABLE + HLLZ FS,1(FC) ;GET VALUE + TLNE FS,30 ;SPECIAL VALUE? + JRST SYMCH2 ;YES. +SYMCH0: PUSHJ P,SYMO2A ;OCTAL TO ASCII +SYMCH1: MOVEI FS,[BYTE(7)15,12] + PUSHJ P,SYMSTR + HRRZ FC,1(FC) + JUMPN FC,SYMCH + POPJ P, + +SYMCH2: TLZN FS,10 ;CALLI? + JRST SYMCH3 ;NO. + ROT FS,15 ;YES. ROTATE CALLI NUMBER + CAML FS,UCLDLN + ADD FS,SCLOFF + PUSH P,FS ;SAVE NUMBER + MOVEI FS,[ASCIZ/CALLI /] + PUSHJ P,SYMSTR + MOVE T,(P) + PUSHJ P,SYMOCT ;WRITE OCTAL + POP P,FS + CAIGE FS,400000 ;STANFORD? + JRST SYMCH1 ;NO. + MOVEI FS,[ASCIZ/ S/] + JRST SYMC5A + +SYMCH3: JUMPL FS,SYMCH4 ;JUMP IF PSEUDO-OP + MOVE FS,3(FC) ;MUST BE OPDEF? + JRST SYMCH0 + +SYMCH4: HRRZ FS,2(FC) ;SEE IF WE KNOW THIS IS SPECIAL + CAIN FS,%IO ;IO OPCODE? + JRST SYMCH5 ;YES + MOVEI FS,[ASCIZ/Pseudo-Op/] + JRST SYMC5A + +SYMCH5: MOVE FS,3(FC) + MOVEI O,6 ;ONLY 6 CHARACTERS + PUSHJ P,SYMO2B + MOVEI FS,[ASCIZ %,,0 I/O%] +SYMC5A: PUSHJ P,SYMSTR + JRST SYMCH1 + +SYMCH6: SKIPGE FS,3(FC) ;IS THIS A PERMANENT MACRO? + JRST SYMCH7 ;NO. + MOVEI FS,[ASCIZ/Predefined Macro/] + JRST SYMC5A + +SYMCH7: HRRI FS,[ASCIZ/Conditional/] + TLNN FS,1 + MOVEI FS,[ASCIZ/Predefined Symbol/] + JRST SYMC5A + +SYMOCT: MOVEI O,6 + IDIVI T,10 + HRLM T+1,(P) + SUBI O,1 + JUMPE T,.+2 + PUSHJ P,SYMOCT+1 + MOVEI T," " + JUMPLE O,.+3 + PUSHJ P,SYMOT + SOJG O,.-1 + HLRZ T,(P) + ADDI T,"0" + JRST SYMOT + +SYMO2A: MOVEI O,14 +SYMO2B: MOVEI T,0 + LSHC T,3 + ADDI T,"0" + PUSHJ P,SYMOT + SOJG O,SYMO2B + POPJ P, + +SYM62A: JUMPE FS,CPOPJ ;PRINT 6BIT IN FS AS ASCII + MOVEI T,0 + LSHC T,6 + JUMPE T,SYM62A + ADDI T," " ;MAKE ASCII, WRITE IT + PUSHJ P,SYMOT + JRST SYM62A + +SYMOT: SOSG LOB+2 ;WRITE ONE CHARACTER FROM T + OUTPUT 4, + IDPB T,LOB+1 +SYMOT1: POPJ P, + +SYMSTR: HRLI FS,440700 + ILDB T,FS + JUMPE T,SYMOT1 + PUSHJ P,SYMOT + JRST SYMSTR+1 + +>;IFN SYMDMP +BEND SYMWRT + +BEND + ;ROUTINE TO GET SYSTEM CALL DEFS FROM SYSTEM - STANFORD ONLY +IFN STANSW< +SYSTOP__265 +CALLPT__272 +SYS__400000 + +OPSET: MOVEI T,SYSTOP ;GET SIZE OF MEMORY + PEEK T, + PEEK T, ;INDIRECT + TDNE T,[-1,,401777] + JRST OPSLUZ + MOVSI T,-2000+1(T) ;MAKE PR WORD (WITH UWP BIT) + SETPR2 T, + JRST OPSLZ2 + MOVE C,SYS+CALLPT + LDB NA,[221100,,C] ;# DEC CALLIS + MOVEM NA,UCLDLN# + SUBI NA,400000 + MOVNM NA,SCLOFF# + LDB N,[331100,,C] ;TOTAL # CALLIS + CAIG N,300 + CAIG N,400000(NA) + JRST OPSLUZ ;UNREASONABLE CRAP + MOVN NA,N + MOVSI T,(NA) ;MAKE AOBJN PNTR + MOVE L,SYS(C) + CAME L,['RESET '] + JRST OPSLUZ ;TABLE LOOKS WRONG + MOVE O,.JBFF + SETZM OPCDS ;INITIALIZE THIS + MOVE N,[OPCDS,,OPCDS+1] ;IT WILL KEEP TRACK OF THE ENDS OF THE HASH CHAINS + BLT N,OPCDS+HASH-1 ;AS THEY ARE NEEDED + MOVEI L,10 ;BIT FOR CALLI OPCODE ENTRIES + HRLI C,T + MOVEI B,40 ;INCREMENT + PUSHJ P,OPST1 ;DEFINE CALLIS + HRR C,@C ;GET MAJOR OPCODE TABLE ADR + MOVSI T,-40 ;# LOW UUOS + MOVEI L,40000 ;STARTING VAL + MOVEI B,1000 ;INC + PUSHJ P,OPST1 ;DEFINE LOW UUOS + HLL T,SYS-1(C) ;GET # HIGH UUOS IN LH + TLC T,-1 + ADDI T,SYS ;CARRY WILL MAKE 2'S COMP + MOVEI L,700000 ;NEW INIT VAL (PNTR & INC SAME AS BEFORE) + PUSHJ P,OPST1 ;DEFINE HIGH UUOS + MOVEI B,40 ;NOW SET UP INC FOR SECONDARY OPCODES +OPSLP1: HRR C,SYS-1(C) ;GET NEXT TABLE LOC + TRNN C,-1 + JRST OPSDON ;DONE IF ADR 0 + HLRZ L,SYS-1(C) ;ELSE GET BASE VAL & CNT + LDB T,[50400,,L] ;GET CNT-1 + MOVNI T,1(T) + MOVSI T,(T) ;MAKE AOBJN PNTR + ANDI L,777000 ;ISOLATE STARTING VAL + PUSHJ P,OPST1 ;DEFINE THIS SECONDARY SET + JRST OPSLP1 ;AND TRY FOR ANOTHER GRP + +OPSDON: MOVEM O,.JBFF ;UPDATE BOTH + HRLM O,.JBSA ;COPIES OF JOBFF +OPSTX: SETOM OPSOK ;DON'T NEED TO DO THIS AGAIN + MOVEI T, + CORE2 T, ;FLUSH PR2 + POPJ P, + POPJ P, + +;ADDS A CALLI OR OTHER MNEMONIC AT THE END OF THE OPCDS1 TABLE. +OPST1: TRNN C,600000 + TRNN C,-200 + JRST OPSLUZ ;BAD ADDRESS + IORI T,SYS ;PUT OFFSET IN PNTR +OPSTL: SKIPA N,@C + LSH N,-6 + TRNN N,77 ;RIGHT-JUSTIFY IF NECESSARY (SIGH) + JUMPN N,.-2 ;BUT AVOID LOOP ON 0 + JUMPE N,OPSNXT ;IGNORE 0'S +LEG MOVEM N,(O) ;STORE NAME + IDIVI N,HASH + MOVM NA,NA + SKIPE PN,OPCDS(NA) ;DO WE ALREADY KNOW THE END OF THIS CHAIN? + JRST OPSTL2 ;YES + TROA PN,OPCDS1-1(NA) ;NO - FIND IT SO THESE CAN GO AT END + MOVEI PN,(FS) ;WHERE THEY WON'T INTERFERE WITH + HRRZ FS,1(PN) ;NORMAL OPCODES + JUMPN FS,.-2 +OPSTL2: HRRM O,1(PN) ;LINK IN +LEG MOVSM L,1(O) ;STORE VALUE + MOVEM O,OPCDS(NA) ;THIS IS NOW END OF LIST + ADDI O,2 +OPSNXT: ADDI L,(B) ;COUNT VALUE FIELD + AOBJN T,OPSTL + POPJ P, + +OPSLUZ: OUTSTR [ASCIZ /GARBAGEY DATA IN SYSTEM CALL TABLE/] +OPSLZ3: OUTSTR [ASCIZ /, YOU LOSE! +/] + EXIT + +OPSLZ2: OUTSTR [ASCIZ /SETPR2 TO GET CALLI NAMES FAILED/] + JRST OPSLZ3 + +OPSEND__. ;OPSET THRU HERE GIVEN TO FREE STORAGE AFTER THE FIRST TIME + +OPSOK: 0 +>;IFN STANSW + ITS,< + +;CONVERT SIXBIT TO ASCII AND TYPE +FNMOUT: HRLI 1,440600 ;BYTE POINTER IN LEFT HALF + MOVEI 2,6 ;COUNT + ILDB 3,1 ;GET A BYTE + JUMPE 3,.+4 ;IGNORE BLANKS + ADDI 3," " ;MAKE ASCII + OUTCHR 3 ;TYPE IT + SOJG 2,.-4 ;FOR 6 CHARACTERS + POPJ P, + +;CALLED AT INITIALIZATION TIME TO GOBBLE SYSTEM SYMBOLS INTO SYMBOL TABLE + + BEGIN GETSYS + +^GETSYS:MOVE TAC,[RADIX50 0,SYSYMB] + .EVAL TAC, + JRST 4,. + MOVE T,[RADIX50 0,SYSYME] + .EVAL T, + JRST 4,. + ADDI T,1 + SUBB T,TAC ;LENGTH OF GETSYS AREA + ASH TAC,-1 ;GUESS AT CORE NEEDED + IMULI TAC,5 + ADD TAC,.JBFF ;END OF GETSYS AREA + CAMGE TAC,.JBREL + JRST NONEED ;NO EXTRA CORE NEEDED + PUSH P,TAC + CORE TAC, + JRST 4,. + POP P,TAC +NONEED: MOVE B,TAC ;BEGINING OF GETSYS AREA + SUB B,T + MOVN C,T + HRL B,C ;AOBJN POINTER TO GETSYS AREA + PUSH P,B + MOVE C,[SIXBIT /CALLS/] + .GETSYS B, + JRST 4,. + POP P,B ;B/ AOBJN POINTER TO GETSYS AREA + MOVE C,.JBFF ;C/ POINTER TO ORIGIN OF FREE STORAGE +GETLOP: CAIL C,(B) + JRST 4,. + MOVE N,(B) ;SQUOZE + PUSHJ P,R50TOX ;CONVERT TO SIXBIT + MOVEM L,(C) ;SAVE SIXBIT + MOVE N,L + IDIVI N,HASH + MOVM NA,NA ;MAKE HASH POSITIVE. + MOVE N,1(B) ;VALUE + TDNN N,[777000,,0] ;OPCODE OR SYMBOL + JRST [ MOVEI PN,SYMTAB(NA) ;SYMBOL + SETZM 1(C) + HRLOI NA,ANONF!UPARF!DBLUPF + JRST LONG] + MOVEI PN,OPCDS(NA) ;OPCODE + TDNN N,[0,,-1] ;LONG OR SHORT ENTRY + JRST [ MOVEM N,1(C) ;SHORT + MOVEI NA,2 ;ENTRY LENGTH + JRST GETLP1] + MOVSI NA,20 ;MARK AS LONG ENTRY OPCODE + MOVEM NA,1(C) + MOVE NA,[ANONF,,1] +LONG: MOVEM NA,2(C) + MOVEM N,3(C) ;VALUE + SETZM 4(C) ;NO RELOCATION + MOVEI NA,5 ;ENTRY SIZE +GETLP1: MOVE N,(PN) ;POINTER TO CHAIN + HRRM N,1(C) ;NEW ENTRY POINTING TO CHAIN + MOVEM C,(PN) ;POINTER TO CHAIN + ADD C,NA ;UPDATE FREE STORAGE POINTER + ADD B,[1,,1] + AOBJN B,GETLOP ;MORE + MOVEM C,.JBFF + POPJ P, + +;RADIX50 TO SIXBIT CONVERSION +; CALLED WITH SQUOZE IN N +; RETURNS SIXBIT IN L +; NA CLOBBERED + +R50TOX: TLZ N,740000 ;CLEAR FLAGS FOR SPITE + MOVEI L,0 + JUMPE N,CPOPJ ;AVOID INFINITE LOOP +R50TX1: IDIVI N,50 + JUMPE NA,R50XF1 ;NULL + CAIG NA,12 + JRST [ ADDI NA,'0'-1 ;ITS A DIGIT + JRST R50XF] + CAIG NA,44 + JRST [ ADDI NA,'A'-13 ;ITS A LETTER + JRST R50XF] + MOVE NA,.$%-45(NA) ;SPECIAL CHARATCER +R50XF: OR L,NA + ROT L,-6 +R50XF1: JUMPN N,R50TX1 + TRNE L,77 + POPJ P, + LSH L,-6 + JRST .-3 + +.$%: '.' + '$' + '%' + + BEND GETSYS + +>;ITS + SUBTTL TENEX INITIAL SYMBOLS AND OPDEFS +TNX,< +NOT20,< + +DEFINE EENT(NAME,VALUE)< + XLIST + 'NAME' + 600000+VALUE + LIST +> + +INISMT: +EENT (LGINX1,10) +EENT (LGINX2,11) +EENT (LGINX3,12) +EENT (LGINX4,13) +EENT (LGINX5,14) + +EENT (CRJBX1,20) +EENT (CRJBX2,21) +EENT (CRJBX3,22) +EENT (CRJBX4,23) +EENT (CRJBX5,24) +EENT (CRJBX6,25) +EENT (CRJBX7,26) + +EENT (LOUTX1,35) +EENT (LOUTX2,36) + +EENT (CACTX1,45) +EENT (CACTX2,46) + +EENT (EFCTX1,50) +EENT (EFCTX2,51) +EENT (EFCTX3,52) +EENT (GJFX1,55) +EENT (GJFX2,56) +EENT (GJFX3,57) +EENT (GJFX4,60) +EENT (GJFX5,61) +EENT (GJFX6,62) +EENT (GJFX7,63) +EENT (GJFX8,64) +EENT (GJFX9,65) +EENT (GJFX10,66) +EENT (GJFX11,67) +EENT (GJFX12,70) +EENT (GJFX13,71) +EENT (GJFX14,72) +EENT (GJFX15,73) +EENT (GJFX16,74) +EENT (GJFX17,75) +EENT (GJFX18,76) +EENT (GJFX19,77) +EENT (GJFX20,100) +EENT (GJFX21,101) +EENT (GJFX22,102) +EENT (GJFX23,103) +EENT (GJFX24,104) +EENT (GJFX25,105) +EENT (GJFX26,106) +EENT (GJFX27,107) +EENT (GJFX28,110) +EENT (GJFX29,111) +EENT (GJFX30,112) +EENT (GJFX31,113) +EENT (GJFX32,114) +EENT (GJFX33,115) + +EENT (OPNX1,120) +EENT (OPNX2,121) +EENT (OPNX3,122) +EENT (OPNX4,123) +EENT (OPNX5,124) +EENT (OPNX6,125) +EENT (OPNX7,126) +EENT (OPNX8,127) +EENT (OPNX9,130) +EENT (OPNX10,131) +EENT (OPNX11,132) +EENT (OPNX12,133) +EENT (OPNX13,134) +EENT (OPNX14,135) +EENT (OPNX15,136) +EENT (OPNX16,137) +EENT (OPNX17,140) +EENT (OPNX18,141) +EENT (OPNX19,142) +EENT (OPNX20,143) +EENT (OPNX21,144) +EENT (OPNX22,145) +EENT (DESX1,150) +EENT (DESX2,151) +EENT (DESX3,152) +EENT (DESX4,153) +EENT (DESX5,154) +EENT (DESX6,155) +EENT (DESX7,156) + +EENT (CLSX1,160) +EENT (CLSX2,161) + +EENT (RJFNX1,165) +EENT (RJFNX2,166) +EENT (RJFNX3,167) + +EENT (DELFX1,170) + +EENT (SFPTX1,175) +EENT (SFPTX2,176) +EENT (SFPTX3,177) + +EENT (CNDIX1,200) +EENT (CNDIX2,201) +EENT (CNDIX3,202) +EENT (CNDIX4,203) +EENT (CNDIX5,204) + +EENT (SFBSX1,210) +EENT (SFBSX2,211) + +EENT (IOX1,215) +EENT (IOX2,216) +EENT (IOX3,217) +EENT (IOX4,220) +EENT (IOX5,221) +EENT (IOX6,222) + +EENT (PMAPX1,240) +EENT (PMAPX2,241) + +EENT (SPACX1,245) + +EENT (FRKHX1,250) +EENT (FRKHX2,251) +EENT (FRKHX3,252) +EENT (FRKHX4,253) +EENT (FRKHX5,254) +EENT (FRKHX6,255) + +EENT (GTABX1,267) +EENT (GTABX2,270) + +EENT (RUNTX1,273) + +EENT (STADX1,275) +EENT (STADX2,276) + +EENT (ASNDX1,300) +EENT (ASNDX2,301) +EENT (ASNDX3,302) + +EENT (CSYNX1,312) + +EENT (ATACX1,320) +EENT (ATACX2,321) +EENT (ATACX3,322) +EENT (ATACX4,323) +EENT (ATACX5,324) + +EENT (DCHRX1,330) ;USED ? + +EENT (STDVX1,332) + +EENT (DEVX1,335) +EENT (DEVX2,336) +EENT (DEVX3,337) + +EENT (MNTX1,345) +EENT (MNTX2,346) +EENT (MNTX3,347) + +EENT (TERMX1,350) + +EENT (ATIX1,352) +EENT (ATIX2,353) + +EENT (DTIX1,355) + +EENT (TTYX1,360) + +EENT (CFRKX2,362) +EENT (CFRKX3,363) + +EENT (KFRKX1,365) +EENT (KFRKX2,366) + +EENT (RFRKX1,367) + +EENT (GFRKX1,371) + +EENT (GETX1,373) +EENT (GETX2,374) + +EENT (SFRVX1,377) + +EENT (NOUTX1,407) +EENT (NOUTX2,410) + +EENT (IFIXX1,414) +EENT (IFIXX2,415) +EENT (IFIXX3,416) + +EENT (GFDBX1,424) +EENT (GFDBX2,425) +EENT (GFDBX3,426) + +EENT (CFDBX1,430) +EENT (CFDBX2,431) +EENT (CFDBX3,432) +EENT (CFDBX4,433) + +EENT (DUMPX1,440) +EENT (DUMPX2,441) +EENT (DUMPX3,442) +EENT (DUMPX4,443) + +EENT (RNAMX1,450) +EENT (RNAMX2,451) + +EENT (BKJFX1,454) + +EENT (TIMEX1,460) +EENT (ZONEX1,461) +EENT (ODTNX1,462) +;463 FREE +EENT (DILFX1,464) +EENT (TILFX1,465) +EENT (DATEX1,466) +EENT (DATEX2,467) +EENT (DATEX3,470) +EENT (DATEX4,471) +EENT (DATEX5,472) +EENT (DATEX6,473) +EENT (TMONX1,515) +EENT (SMONX1,515) + +EENT (CPRTX1,520) + +EENT (SACTX1,530) +EENT (SACTX2,531) +EENT (SACTX3,532) +EENT (SACTX4,533) + +EENT (GACTX1,540) +EENT (GACTX2,541) + +EENT (FFUFX1,544) +EENT (FFUFX2,545) +EENT (FFUFX3,546) + +EENT (DSMX1,555) + +EENT (RDDIX1,560) + +EENT (SIRX1,570) + +EENT (SSAVX1,600) +EENT (SSAVX2,601) + +EENT (SEVEX1,610) + +EENT (WHELX1,614) + +EENT (CRDIX1,620) +EENT (CRDIX2,621) +EENT (CRDIX3,622) +EENT (CRDIX4,623) +EENT (CRDIX5,624) +EENT (CRDIX6,625) + +EENT (GTDIX1,640) +EENT (GTDIX2,641) + +EENT (FLINX1,650) +EENT (FLINX2,651) +EENT (FLINX3,652) +EENT (FLINX4,653) + +EENT (FLOTX1,660) +EENT (FLOTX2,661) +EENT (FLOTX3,662) + +EENT (FDFRX1,700) +EENT (FDFRX2,701) + +EENT (ATPX1,710) +EENT (ATPX2,711) +EENT (ATPX3,712) +EENT (ATPX4,713) +EENT (ATPX5,714) +EENT (ATPX6,715) +EENT (ATPX7,716) +EENT (ATPX8,717) +EENT (ATPX9,720) +EENT (ATPX10,721) +EENT (ATPX11,722) +EENT (ATPX12,723) +EENT (ATPX13,724) + +EENT (CVSKX1,730) +EENT (CVSKX2,731) + +EENT (DPX1,734) +EENT (DPX2,735) + +EENT (STRDX1,740) +EENT (STRDX2,741) +EENT (STRDX3,742) + +EENT (STTX1,744) + +;ADD JSYS ERROR CODES HERE + +EENT (ILINS1,770) +EENT (ILINS2,771) +EENT (ILINS3,772) +INISME: 0 ;ZERO TERMINATES + BLOCK 40 ;PATCH SPACE FOR 16 MORE + + +>;NOT20 ;FOR TOPS-20 YOU SHOULD SEARCH MONSYM + + DEFINE JENT(NAME,NUMBER)< +XLIST +'NAME' +JSYS NUMBER +IFNOP NAME,> +LIST +> + +TNXOPS: ;TABLE OF TENEX OPDEFS STARTS HERE +$IBQ_0 +FOR ZOT IN (<>,LOGIN,CRJOB,LGOUT,CACCT,EFACT,SMON, +,GETAB,ERSTR,GETER,GJINF,TIME,RUNTM,SYSGT, +,GTJFN,OPENF,CLOSF,RLJFN,GTSTS,STSTS,DELF, +,JFNS,FFFFP,RDDIR,CPRTF,CLZFF,RNAMF,SIZEF, +,STDIR,DIRST,BKJFN,RFPTR,CNDIR,RFBSZ,SFBSZ, +,BIN,BOUT,SIN,SOUT,RIN,ROUT,PMAP, +,SPACS,RMAP,SACTF,GTFDB,CHFDB,DUMPI,DUMPO, +,ASND,RELD,CSYNO,PBIN,PBOUT,PSIN,PSOUT, +,CFIBF,CFOBF,SIBE,SOBE,DOBE,GTABS,STABS, +,SFMOD,RFPOS,RFCOC,SFCOC,STI,DTACH,ATACH, +,STDEV,DEVST,MOUNT,DSMNT,INIDR,SIR,EIR, +,DIR,AIC,IIC,DIC,RCM,RWM,DEBRK, +,DTI,CIS,SIRCM,RIRCM,RIR,GDSTS,SDSTS, +,RPCAP,EPCAP,CFORK,KFORK,FFORK,RFORK,RFSTS, +,SFACS,RFACS,HFORK,WFORK,GFRKH,RFRKH,GFRKS, +,HALTF,GTRPW,GTRPI,RTIW,STIW,SOBF,RWSET, +,GET,SFRKV,SAVE,SSAVE,SEVEC,GEVEC,GPJFN, +,SETNM,FFUFP,DIBE,FDFRE,GDSKC,LITES,TLINK, +,ODTIM,IDTIM,ODCNV,IDCNV,NOUT,NIN,STAD, +,ODTNC,IDTNC,FLIN,FLOUT,DFIN,DFOUT,<>,<> +,CRDIR,GTDIR,DSKOP,SPRIW,DSKAS,SJPRI,STO,<> +,<>,<>,<>,<>,<>,<>,<>,<> +,ASNDP,RELDP,ASNDC,RELDC,STRDP,STPDP,STSDP, +,WATDP,<>,<>,<>,ATPTY,CVSKT,CVHST, +,GCVEC,SCVEC,STTYP,GTTYP,BPT,GTDAL,WAIT, +,USRIO,PEEK,MSFRK,ESOUT,SPLFK,ADVIS,JOBTM, +,SWTCH) +,<>, +$IBQ_$IBQ+1 +> + +T20,< +$IBQ_500 +FOR ZOT IN (RSCAN,HPTIM,CRLNM,INLNM,LNMST,RDTXT,SETSN, +,MSEND,MRECV,MUTIL,ENQ,DEQ,ENQC,SNOOP, +,ALLOC,CHKAC,TIMER,RDTTY,TEXTI,UFPGS,SFPOS, +,DIAG,SINR,SOUTR,RFTAD,SFTAD,TBDEL,TBADD, +,STCMP,SETJB,GDVEC,SDVEC,COMND,PRARG,GACCT, +,GFUST,SFUST,ACCES,RCDIR,RCUSR) +,<>, +$IBQ_$IBQ+1 +> + +JENT(THIBR,770) ;Temporary JSYS Definitions +JENT(TWAKE,771) +JENT(MRPAC,772) +JENT(SETPV,773) +JENT(MTALN,774) +JENT(TTMSG,775) + + +>;T20 + +IFN IMSSSW,< ;LOCAL JSYSES FOR IMSSS INSTALLATION +$IBQ_600 +FOR ZOT IN (PBTIN,TTCVT,KIDNO,LOGSV,DATSV,SCEDR,SCEDS,CNTSZ,SYSLK, +,RAND,KLGOT,PTINF,GTINF,SETWS,CLRWS,AUTWS,RDWS,CLAWS,KLGIN,DEVCT, +,SJPCT,RJPCT,IIT,PARRD,PARST,STCHA,GTBLT,DRMOP,RECO,RDREC) +,<>, +$IBQ_$IBQ+1> +JENT(DATSX,660) +JENT(FONCT,661) +JENT(SETAU,677) +>;IMSSS + +NOT20,< +JENT(MRPAC,772) +JENT(TTMSG,775) +JENT(EXEC,777) +>;NOT20 + 0 ;ZERO TO END THE TABLE + +^INISM: MOVEI NA,1 + MOVEM NA,OPDTMP ;BLOCK NUMBER OF DEFINITION + MOVSI NA,NONEM ;USUAL BITS FOR WRD+1 + MOVEM NA,WRD+1 + MOVEI NA,TNXOPS-2 ;ADDRESS OF THE TABLE + PUSH P,NA +STNXP1: AOS (P) ;GET THE INDEX + AOS NA,(P) + SKIPN L,(NA) ;GET THE SIXBIT + JRST STNXP2 ;ALL DONE + MOVE N,1(NA) + MOVEM N,WRD + PUSHJ P,OPDINS ;INSERT "OPDEF" + MOVSI NA,SUPBIT + IORM NA,2(PN) ;SET SUPPRESS BIT IN NEW DEFINITION + JRST STNXP1 + +STNXP2: SUB P,[1,,1] + SETZM WRD + +T20,< POPJ P, >;TOPS-20 HAS NO OTHER SYMBOLS +NOT20,< + + MOVEI T,INISMT ;ADD TENEX INITIAL SYMBOLS +INISML: GFST (FS,FSTPNT) ;GET FREE STORAGE. + SKIPN N,0(T) ;ANY SYMBOLS LEFT? + POPJ P, ;NOPE. RETURN. + MOVEM N,0(FS) ;STORE SYMBOL NAME IN FS BLOCK + IDIVI N,HASH ;CALC. HASH CODE + MOVMS NA + MOVE L,SYMTAB(NA) ;LINK THIS FS BLOCK INTO SYMBOL TABLE + MOVEM FS,SYMTAB(NA) + EXCH L,1(FS) + MOVEM L,FSTPNT ;DELINK BLOCK FROM FREE LIST + MOVE L,1(T) + MOVEM L,3(FS) ;STORE VALUE + SETZM 4(FS) ;NO RELOCATION + MOVE L,[SUPBIT!UPARF,1] ;OUTER BLOCK, UPARROWED, SUPPRESSED + MOVEM L,2(FS) + ADDI T,2 + JRST INISML +>;NOT20 + + +>;TNX + BEGIN INIT  SUBTTL DEVICE INITIALIZATION + +^FNREAD: JSR IN ;FILE NAME READER INSTRUCTION (GETS CLOBBERED) + +;THIS IS WHAT WE CALL TO SCAN FILE NAMES FROM THE INPUT STREAM +^AFSCAN:PUSHJ P,SCAN1 + MOVE 2,C ;MOVE CHARACTER TO RIGHT AC + POPJ P, + +NOTNX, ;SAIL and IMSSS like sixbit ppns +NA1: XCT FNREAD + CAIE 2,11 + CAIN 2," " + JRST NA1 ;SKIP BLANKS AND TABS + MOVEM 5,NAMES5# ;SAVE AN AC + TDZA 6,6 ;INITALIZE 6BIT AC AND SKIP +LOOP1: XCT FNREAD ;GET A CHR + CAIE 2,"." + SKIPL 5,CTAB(2) ;CHECK FOR NUMBER OR LETTER + JRST STOPN ;NO, SOME DELIMITER + TLNE 6,770000 ;SEEN 6 CHARS YET? + JRST LOOP1 ;YES, IGNORE THIS + LSH 6,6 ;MAKE ROOM + ANDI 5,77 ;SIXBIT ONLY, FROM CHAR TABLE + IORI 6,(5) + MOVEI 2,40(5) ;GET UPPER CASE VERSION OF CHAR +IFE STANSW!IMSSSW,< LSH 13,3 ;MAKE OCTAL PPN IN 13 + IORI 13,-'0'(5) ;MAKE OCTAL PPN> + JRST LOOP1 + +STOPN: MOVE 5,NAMES5 ;RESTORE AC + JUMPE 6,@NAME ;IF 0 RETURN + JRST .+2 +STOPN2: XCT FNREAD + CAIE 2," " + CAIN 2,11 + JRST STOPN2 ;DON'T STOP AT BLANK OR TAB. GET REAL DELIMITER +IFE STANSW!IMSSSW,< MOVEM 13,SVNAM> ;SAVE OCTAL FOR PPNS +IFN STANSW!IMSSSW,< MOVEM 6,SVNAM> ;SAVE RIGHT ADJUSTED SIXBIT FOR PPNS +STOPN1: TLNE 6,770000 ;NOW, LEFT JUSTIFY + JRST @NAME + LSH 6,6 + JRST STOPN1 + +IFN CMUSW,< +^RDPPN: 0 + SETZM PPNBUF + SETZM PPNBUF+1 + SETZM PPNBUF+2 + MOVEM 5,RDPTMP# +RDPPN1: XCT FNREAD + CAIE 2," " + CAIN 2,11 + JRST RDPPN1 ;SKIP BLANKS AND TABS + MOVEI 5,=13 ;MAX CHARACTER COUNT + SKIPA 6,[440700,,PPNBUF] +RDPPN2: XCT FNREAD + CAIN 2,"," + JRST RDPPOK ;COMMA IS LEGAL + SKIPL CTAB(2) + JRST RDPPX ;OTHER DELIMS NOT. + CAIL 2,"A"+40 + CAILE 2,"Z"+40 + JRST .+2 + SUBI 2,40 ;MAKE UPPER CASE +RDPPOK: IDPB 2,6 + SOJG 5,RDPPN2 +RDPPX: MOVE 6,[4,,PPNBUF] + CMUDEC 6, ;CONVERT STRING TO 36 BIT NUMBER + JFCL ;(BARF?) (SOMEONE, SOMEWHERE WILL LOSE) + MOVE 5,RDPTMP + JRST @RDPPN + +PPNBUF: BLOCK 3> +BEND NAME + +BEGIN GETFIL +;RETURNS +1 IF LOSE +; +2 IF WIN. 1:DEVICE, 5:FILE, 3: EXT, 4: PPN + +^SVNAM: 0 + +^^GETFIL:0 + JSR NAME ;READ A NAME + JUMPE 6,@GETFIL ;RETURN IF NONE THERE + AOS GETFIL ;ELSE SET FOR SKIP RETURN + CAIE 2,":" ;DEVICE NAME? + JRST NODEV ;NO, TRY FILE NAME + MOVE 1,6 ;SET DEVICE + JSR NAME ;GET ANOTHER NAME + JUMPE 6,@GETFIL ;NONE, END (PTR: IS LEGAL) +NODEV: MOVE 5,6 ;FILE NAME + CAIE 2,"." ;MAYBE EXTENSION? + JRST NOEXT ;NO. + JSR NAME ;GET EXT - NULL EXT IS NOT AN ERROR. + HLLZ 3,6 ;SET EXTENSION (CLEARS RH BITS FROM 3) +NOEXT: CAIE 2,"<" ;ALLOW BROKETS TO DENOTE PPNS + CAIN 2,"[" ;CHECK FOR PPN + JRST INPPN ;READ PPN + JRST @GETFIL ;NO, RETURN +INPPN: +IFE CMUSW,< JSR NAME ;GET LEFT HALF + JUMPE 6,ERR3 ;NOT THERE + HRLZ 4,SVNAM ;GET LEFT HALF + CAIE 2,"," ;MUST BE THERE + JRST ERR3 + JSR NAME ;REPEAT FOR RIGHT HALF + HRR 4,SVNAM > +IFN CMUSW,< JSR RDPPN > + CAIE 2,">" ;ALLOW BROKET + CAIN 2,"]" ;] PRESENT? + XCT FNREAD ;YES SKIP IT. (NOT AN ERROR TO OMIT) + JRST @GETFIL + BEND GETFIL +>;NOITS>;NOTNX + +TNX,< +;TGETF -- GET TENEX FILE NAME FROM INPUT STREAM. +;PRESENTLY CALLED ONLY BY INITL, .INSERT CODE BUT MAY BE USED BY .LOAD, .LIB +; IF ANYBODY EVER FIXES THE LOADER... +;VERY QUICK AND DIRTY. NO INTERACTIVE USE OF GTJFN BECAUSE OF SWITCHES... +^^TGETF: 0 + XCT FNREAD + CAIE 2,11 ;TAB + CAIN 2," " + JRST .-3 ;SKIP LEADING SPACES, TABS + SKIPA 1,[POINT 7,GTNAM] +TGETF1: XCT FNREAD + JSR ISTRM ;CHECK FOR 'TERMINAL' IN SWITCH CONTEXT + JRST TGETFX ;YEP + CAIE 2,15 ;THROW OUT CR + IDPB 2,1 ;SAVE CHAR FOR GTJFN IN INITIT + JRST TGETF1 ;BACK FOR MORE +TGETFX: CAME 1,[POINT 7,GTNAM] + AOS TGETF ;IF SUCCESSFUL + JRST @TGETF + +;PRESENTLY CALLED FROM .LIBRARY (.LOAD) ONLY. +^^TGETFY: XCT FNREAD ;slurp something + CAIE 2,11 ;TAB + CAIN 2," " + JRST TGETFY ;SKIP LEADING SPACES, TABS + SKIPA 1,[POINT 7,GTNAM] +TGETY1: XCT FNREAD + CAIE 2,15 ;also break on CR for .LOAD + JSR ISTRM ;CHECK FOR 'TERMINAL' IN SWITCH CONTEXT + JRST TGETY2 ;YEP + IDPB 2,1 ;SAVE CHAR FOR GTJFN IN INITIT + JRST TGETY1 ;BACK FOR MORE +TGETY2: CAME 1,[POINT 7,GTNAM] + AOS (P) ;SOMETHING WAS SEEN + TLO SFL ;SET SCANNER AHEAD + POPJ P, + +ISTRM: 0 + MOVE 6,[XWD -TRMTL,TRMTBL] + CAME 2,(6) + AOBJN 6,.-1 ;IF MORE TO DO + SKIPL 6 + AOS ISTRM ;NON-TERMINAL EXIT + JRST @ISTRM + +TRMTBL: "/" + "_" + "," + "=" + "(" + "@" + "!" + " " + 11 ;TAB + 12 ;LF, BECAUSE RPG FLUSHES CR + ")" ;FOR SCAN IN SEARCH PSEUDO OP +TRMTL__.-TRMTBL + +>;TNX + ITS,< BEGIN ITSSCN ;ITS STYLE COMMAND LINE SCANNER + +DEV_1 +FN1_5 +FN2_3 +SNAME_4 +BREAK_2 +CHAR_7 +ACPTR_13 +AC_6 + +^^LIMBO: 0 ;SCANNER READ AHEAD CHARACTER + ;SCANNER WILL NOT LET US LEAVE UNTIL ZERO + +GETCC: 0 ;GET CHARACTER FOR COMMAND LINE SCANNER + SKIPE LIMBO + SKIPA BREAK,LIMBO + XCT FNREAD ;READ NEXT CHARACTER (USUALLY JSR IN). + SETZM LIMBO + JRST @GETCC + +NAME: 0 ;BREAK OFF WORD FROM INPUT STREAM +NA1: JSR GETCC + CAIE BREAK," " + CAIN BREAK,11 + JRST NA1 ;IGNORE LEADING BLANKS AND TABS + MOVE ACPTR,[440600,,AC] ;DEPOSIT LEFT ADJUSTED SIXBIT + TDZA AC,AC +NAME1: JSR GETCC ;GET CHARACTER + JSR BRKTST ;CHECK FOR A BREAK + JRST NAMBRK ;THIS IS A BREAK CHARACTER +NAME2: TLNE ACPTR,770000 ;IGNORE EVERYTHING AFTER 6 CHARACTERS + IDPB CHAR,ACPTR + JRST NAME1 + +NAMBRK: JUMPN CHAR,@NAME ;NO TRAILING SPACES +NAMBR1: JSR GETCC + CAIE BREAK," " + CAIN BREAK,11 + JRST NAMBR1 ;FLUSH TRAING SPACES + JSR BRKTST ;IS THIS A REAL BREAK? + JRST @NAME ;YES. RETURN THAT BREAK CHARACTER + MOVEM BREAK,LIMBO ;NO. WE CONSIDER THAT SPACE WAS THE BREAK. + MOVEI BREAK," " ;PUT THE OTHER BREAK BACK (INTO LIMBO) FOR LATER + JRST @NAME + +;CONVERTS BREAK TO SIXBIT AND PUTS RESULT IN CHAR +;^Q QUOTES NEXT CHARACTER +;FAILS TO SKIP ON BREAK CHARACTER + +BRKTST: 0 + CAIN BREAK,11 + MOVEI BREAK," " + JSR SIXTST + JUMPL CHAR,[ CAIE BREAK,21 ;^Q + JRST @BRKTST ;NON-SIXBIT BREAKS US + JSR GETCC + JSR SIXTST + JUMPL CHAR,@BRKTST ;NON-SIXBIT + JRST BRKT1] + JUMPE CHAR,@BRKTST + CAIE CHAR,',' + CAIN CHAR,'_' + JRST @BRKTST + CAIE CHAR,':' + CAIN CHAR,';' + JRST @BRKTST + CAIE CHAR,'(' + CAIN CHAR,')' + JRST @BRKTST + CAIE CHAR,'@' + CAIN CHAR,'/' + JRST @BRKTST + CAIE CHAR,'+' ;MAKE + AND = WORK (ALTERNATIVES TO , AND _) + CAIN CHAR,'=' + JRST @BRKTST +BRKT1: AOS BRKTST ;WHEW! + JRST @BRKTST + +;CONVERT BREAK TO SIXBIT + +SIXTST: 0 + MOVNI CHAR,1 + CAIL BREAK," " + CAILE BREAK,"_" + JRST SIXT1 ;MIGHT BE LOWER CASE + MOVEI CHAR,-" "(BREAK) + JRST @SIXTST + +SIXT1: CAIL BREAK,"a" + CAILE BREAK,"z" + JRST @SIXTST + MOVEI CHAR,-100(BREAK) ;LOWER CASE TO SIXBIT + JRST @SIXTST + +;THIS ROUTINE SCANS COMMAND LINE FOR FILE SPECIFICATION + +^^GETFIL:0 + JSR NAME ;GET A WORD + JUMPE AC,@GETFIL + AOSA GETFIL ;ARRANGE FOR SKIP RETURN +GETF1: JSR NAME + JUMPE AC,@GETFIL + CAIE BREAK,":" ;DEVICE NAME? + JRST GETF2 ;NO. + MOVE DEV,AC + JRST GETF1 + +GETF2: CAIE BREAK,";" ;USER NAME? + JRST GETF3 ;NO + MOVE SNAME,AC ;REMEMBER USER NAME. + JRST GETF1 ;(SET SNAME WITH DSKPPN UUO AT INITIT) + +GETF3: CAIE BREAK," " ;BREAK IS BLANK? + JRST GETF4 + JUMPN FN1,[MOVE FN2,AC + JRST GETF1] + MOVE FN1,AC + JRST GETF1 + +GETF4: JUMPN FN1,[MOVE FN2,AC + JRST @GETFIL] + MOVE FN1,AC + JRST @GETFIL + + BEND ITSSCN +>;ITS + BEGIN INITIT + +;IO CHANNELS: 2: INPUT, 3: BINARY, 4: LISTING, 6: RPG OR COMMAND +; CHANNEL 1 IS USED FOR UNIVERSAL FILE I/O + +NOTNX,< + +^^INITIT:0 + DPB 6,[POINT 4,INIT1,12] ;CLOBBER IO CHANNEL IN INIT + SETZM FPPN ;IN CASE WE DO NOT STORE + MOVEM 1,NAM ;SET NAME + MOVEM 1,LFDEV ;SAVE DEVICE (LAST FILE DEVICE) + MOVEM 5,FNAM ;AND FILE NAME +ITS,< MOVEM 3,FEXT ;WHOLE WORD FOR FNAM2> +NOITS,< HLLZM 3,FEXT ;HALF WORD FOR EXTENSION + CAIGE 6,5 ;PPNS FOR SPECIAL ONES + CAIN 6,2 > ;NO PPN UNLESS INPUT + MOVEM 4,FPPN + CAIN 6,2 ;SKIP UNLESS INPUT FILE. + MOVEM 4,SAVPPN ;SAVE PPN FOR EDITOR. TVR 10/72 +ITS,< DSKPPN 4, ;SET SNAME FOR LOOKUP > +IFN STANSW,< MOVSI 1,400000 ;ASSUME DMP NEVER. + CAIE 6,4 > ;SKIP IF IO CODE 4 - LIST FILE. + MOVEI 1,0 ;NOT A LIST FILE. + MOVEM 1,FEXT+1 ;STANSW: LIST FILE PROT=400, DUMP NEVER. + MOVE 1,TBL1-2(6) ;GET BUFFER INFO + MOVEM 1,INIT2 ;STORE FOR INIT + +INIT1: INIT 0,@TBL3-2(6) ;CLOBBER CHANNEL IN INIT +^NAM: 0 ;DEVICE NAME HERE +INIT2: 0 ;AND BUFFER HEADERS HERE + JRST ERR1 ;DEVICE NOT AVAILABLE +INIT3: MOVE 1,[FNAM,,LNAM] + BLT 1,LNAM+3 ;SAVE LAST FILE NAME ATTEMPTED + XCT TBL2-2(6) ;LOOKUP OR ENTER + JRST INIT4 ;LOSE + CAIE 6,2 ;INPUT FILE? + JRST @INITIT ;NO. RETURN NOW. + ;SET UP FILNM FOR ERROR TYPEOUT + +ITS,< MOVE 6,[2,,SRCSTS] + .RCHST 6, + MOVE 5,[440600,,SRCSTS+1] ;FILE NAME >;ITS + +NOITS,< SKIPN 5,LNAM ;FILE NAME + SETZM LNAM+1 ;NULL FILE IMPLIES NULL EXT + SKIPN 5 + MOVE 5,LFDEV ;USE DEVICE NAME IF NULL FILE>;NOITS + + +IFE STANSW,< NOTNX,< NOITS,< + SETZM INTTYF ;ASSUME INPUT DEVICE IS NOT TTY + MOVEI 6,2 ;CHANNEL NUMBER + DEVCHR 6, ;GET DEVICE CHARACTERISTICS + TLNE 6,10 + SETOM INTTYF ;THIS IS A TTY. SEE INP. +>;NOITS >;NOTNX >;IFE STANSW + + SETZM FILNM + SETZM FILNM+1 + SETZM FILNM+2 + SETZM FILNM+3 + SETZM FILNM+4 ;6 DEV, :, 6 NAME, . 6 EXT, NULL + MOVE 6,[440700,,FILNM] + MOVEI 3," " + IDPB 3,6 + JSR NOLS3 ;CONVERT SIXBIT TO ASCII +ITS,< MOVEI 3," " > ;A MATTER OF TASTE +NOITS,< HLLZS 3,LNAM+1 ;LEFT HALF ONLY + MOVEI 5,":" ;(POSSIBLE DEVICE NAME) + JUMPE 3,[SKIPN LNAM ;WAS THERE A FILE NAME? + IDPB 5,6 ;SEND : FOR DEVICE + JRST NOLS4] ;DON'T TYPE A BLANK EXTENSION + MOVE 5,LNAM+1 ;EXTENSION + MOVEI 3,"." > + IDPB 3,6 ;SPACE OR POINT BETWEEN FILE NAMES + JSR NOLS3 + MOVEI 3,0 +NOLS4: IDPB 3,6 ;NULL MARKS END OF FILE NAME + SKIPE 3,FILSTC ;GET FILE-STACK DEPTH + OUTSTR [ASCIZ/ /] ;TYPE 2 LEADING SPACES FOR EACH LEVEL DEEP + SOJG 3,.-1 + OUTSTR FILNM + OUTSTR TTCRLF + JRST @INITIT ;RETURN + +ITS,< +NOLS3: 0 + MOVEI 4,6 + ILDB 3,5 + ADDI 3," " ;CONVERT TO ASCII + IDPB 3,6 + SOJG 4,.-3 + JRST @NOLS3 + +>;ITS + +NOITS,< +NOLS3: 0 +NOLS3A: MOVEI 4,0 + LSHC 4,6 + ADDI 4," " + IDPB 4,6 + JUMPN 5,NOLS3A + JRST @NOLS3 +>;NOITS + + + +INIT4: CAIE 6,2 ;INPUT FILE? + JRST ERR2 ;NO. WE CAN'T WIN +ITS,< JUMPN 3,ERR2 ;LOSE IF EXPLICIT EXT + MOVSI 3,360000 > ;GREATER THAN +NOITS,< TRNN 3,-1 ;SKIP IF THIS WAS DEFAULT EXT + JRST ERR2 ;NO. USER SPECIFIED EXT. + MOVEI 3,0 > ;TRY NULL EXTENSION + MOVEM 3,FEXT + JRST .+2 ;TRY AGAIN +^REENT: MOVEM 1,INITIT ;JSP HERE TO DO ENTER OVER AFTER UTPCLR + MOVEM 4,FPPN + JRST INIT3 + + +TBL3: 1 ;SOURCE MODE 1 + 14 ;BINARY MODE 14 + 1 ;LISTING MODE 1 + 16 ;UNKNOWN + 1 ;COMMANDS MODE 1 + +TBL1: IDB + ODB,,0 + LOB,,0 + 0 + CTLBUF + +TBL2: LOOKUP 2,FNAM + ENTER 3,FNAM + ENTER 4,FNAM + LOOKUP 5,FNAM + LOOKUP 6,FNAM + + +^^FNAM: 0 +FEXT: 0 + 0 +^FPPN: 0 + +^^LFDEV: 0 ;LAST DEVICE ATTEMPTED +^^LNAM: BLOCK 4 ;LAST NAME ATTEMPTED (FOR LOOKUP) +>;NOTNX + +TNX,< +;INITIT -- GTJFN AND OPEN FILE +;GTNAM SHOULD BE SET UP ON ENTRY. PNTR TO STRING END IN 1, TERMINATOR IN 2. +;DEFAULT EXT STRING PTR IN 3, 'CHANNEL' IN 6 AS BEFORE. +^^INITIT: 0 + MOVE 5,2 ;SAVE TERMINATOR + MOVEM 3,GTEXT ;SAVE EXT FOR GTJFN + SETZ 3, + IDPB 3,1 ;TERMINAL NULL + MOVEI 1,GTTBL ;PARAM BLOCK FOR GTJFN + HRROI 2,GTNAM ;FILE NAME STRING + MOVE 3,TBL3-2(6) ;GTJFN BITS FOR CHAN + MOVEM 3,GTTBL + GTJFN + JRST ERR1 ;CAN'T FOR ONE REASON OR ANOTHER + MOVEM 1,JFNTBL-2(6) ;SAVE JFN + MOVE 2,TBL2-2(6) ;OPENF FLAGS FOR CHAN + OPENF + JRST ERR2 ;CAN'T OPEN + DVCHR + SETZ 1, + LDB 2,DEVPTR ;PICK UP DEVICE TYPE + SKIPN 2 + TLO 1,400000 ;IF DISK + CAIN 2,12 ;TTY:? + TLO 1,200000 ;YEP + HLLM 1,JFNTBL-2(6) ;SAVE FLAGS + CAIE 6,2 + JRST INITX1 ;NOT SOURCE FILE + JSR XJFNS +INITX: MOVE 2,5 ;RESTORE TERMINATOR + JRST @INITIT ;EXIT + +INITX1: CAIE 6,6 ;IF INDIRECT + SKIPL 1,JFNTBL-2(6) + JRST INITX ;IF NOT PMAPPABLE + HRLI 1,11 ;FDBSIZ,,JFN + HRLZI 2,007700 ;BYTE SIZE BITS + LDB 3,SZPTR ;LOAD UP CORRECT SIZE + LSH 3,=24 ;JUSTIFY + CHFDB ;SET SIZE FOR PEOPLE WHO DON'T PMAP + JRST INITX + +SZPTR: POINT 6,TBL2-2(6),5 ;POINTER TO BYTE SIZE FIELD IN OPENF PARAM +DEVPTR: POINT 9,2,17 ;POINTER TO DEVICE TYPE FIELD IN DVCHR RET + +;GTJFN PARAMETER BLOCK +^^GTTBL: 0 ;FLAG,,DEF VER + XWD 377777,377777 ;NO JFNS +^^GTDEV:0 ;DEF DEV + 0 ;DEF DIR + 0 ;DEF NAME +^^GTEXT:0 ;DEF EXT + 0 ;PROT + 0 ;ACCT + 0 ;REQ JFN + +^^GTNAM: BLOCK =26 ;FILE NAME STRING + +;JFN TABLE +;B0 SET IF FILE IS PMAPPABLE +^^JFNTBL: BLOCK 5 + +;OPENF FLAG BITS +TBL2: XWD 440000,200000 ;INPUT: 36 BIT, READ ONLY + XWD 440000,300000 ;BIN: 36 BIT, READ/WRITE... + XWD 070000,300000 ;LIST: 7 BIT, READ/WRITE... + 0 ;UNUSED (I HOPE) + XWD 440000,200000 ;IND: 36 BIT, READ ONLY + +;GTJFN FLAG BITS +TBL3: XWD 100000,0 ;INPUT: OLD FILE + XWD 400000,0 ;BIT: FOR OUTPUT + XWD 400000,0 ;LIST: FOR OUTPUT + 0 ;UNUSED + XWD 100000,0 ;IND: OLD FILE + +MAKSIX: 0 + MOVEI 2,0 + MOVEI 3,6 +MAKSX1: ILDB 4,1 + JUMPE 4,MAKSX2 ;STOP AT NULL + CAIL 4," " ;FLUSH IF OUT OF RANGE + CAIL 4,140 ;THERE SHOULD BE NO LOWERCASE + JRST MAKSX3 + LSH 2,6 + IORI 2,-" "(4) +MAKSX3: SOJG 3,MAKSX1 ;LOOP UNTIL DONE +MAKSX2: JUMPE 2,@MAKSIX + TLNE 2,770000 + JRST @MAKSIX + LSH 2,6 + JRST .-3 + +^^XJFNS:0 ;CALLED FROM .INSRT TOO + HRRZ 2,JFNTBL ;JFN AGAIN + HRROI 1,FILNM1 ;GET THE FIRST FILE NAME + MOVSI 3,001000 ;FILE NAME ONLY. NO PUNCT. + JFNS + MOVE 1,[POINT 7,FILNM1] + JSR MAKSIX ;CONVERT NAME TO SIXBIT + MOVEM 2,FILNM1 ;SAVE FOR .FNAM1 FUNCTION + HRROI 1,FILNM2 + HRRZ 2,JFNTBL + MOVSI 3,000100 ;EXTENSION ONLY. NO PUNCT. + JFNS + MOVE 1,[POINT 7,FILNM2] + JSR MAKSIX + MOVEM 2,FILNM2 + HRRZ 2,JFNTBL ;JFN + HRROI 1,FILNM ;FOR TITLES + MOVE 3,[XWD 211110,1] ;DEF DEV, FRC DIR, NAME, EXT, VER W/PUNC + JFNS + HRROI 1,[ASCIZ/ /] ;2 SP FOR EACH NESTING LEVEL + SKIPE 3,FILSTC + PSOUT + HRROI 1,[ASCIZ/ /] ;2 SP FOR EACH NESTING LEVEL + SOJG 3,.-2 + HRROI 1,FILNM + PSOUT ;AND FILE NAME + SETZ 3, ;END WITH A WORD OF NULLS + REPEAT 5, + SUBI 1,FILNM + MOVNS 1 + HRLM 1,FILCNT + HRROI 1,TTCRLF ;CRLF FOR USER'S TERMINAL + PSOUT + JRST @XJFNS +>;TNX + BEND INITIT + +^RELFIL:BLOCK 5 ;SAVE REL FILE NAME FOR RENAME AT END + ;PROCESS ENTIRE COMMAND LINE (CO-ROUTINE) DOES @ AND ! COMMANDS + +^INITL: 0 + SETZM RPGNEED ;CLEAR EOF HACK FOR COMMAND FILE + +NOTNX,< + + MOVEI 1,0 +NOITS,< HRLOI 3,'REL'> ;NOITS, -1 RH FLAGS DEFAULT EXTENSION +ITS,< SETZM LIMBO + MOVSI 3,'REL' >;ITS + SETZB 5,4 ;NO FILE NAME, PPN + JSR GETFIL + JRST NOBIN ;NO FILE THERE + CAIN 2,"!" ;CHECK FOR LOAD COMMAND + JRST DOLOD + JUMPN 1,.+2 ;NULL DEVICE? + MOVSI 1,'DSK' ;YES. ASSUME DSK + CAIN 2,"@" + JRST DOAT ;PROCESS COMMAND FILE. + MOVEM 5,RELFIL ;FILE NAME +NOITS,< HLLZM 3,RELFIL+1 > ;STORE REL FILE EXT. (NOT RIGHT HALF BITS) +ITS,< MOVEM 3,RELFIL+1 > ;STORE THE WHOLE WORD FOR EXT + MOVEM 1,RELFIL+4 ;DEVICE NAME + TRO BDEV ;INDICATE WE HAVE A BINARY DEVICE + MOVEI 6,3 ;DEVICE 3 FOR BINARY + +ITS,< CAIE 2,15 + CAIN 2,12 + SKIPA 2,[12] ;PRECISELY CRLF. SET DELIM TO LF + JRST INITL1 + MOVEM 2,RPGNEED + SETZM MOINSW + MOVSI 3,'REL' + EXCH 3,RELFIL+1 + CAMN 3,RELFIL+1 + MOVEI 3,0 + MOVEM 3,SOUT ;SAVE SOURCE FILE EXT + MOVSI 3,'REL' ;USE DEFAULT BINARY FILE EXT + JSR INITIT + OUTBUF 3,2 + MOVE 3,SOUT ;EXTENSION + MOVE 1,RELFIL+4 ;DEVICE + MOVE 5,RELFIL ;FILE NAME + JRST NOLS3 +>;ITS + +INITL1: JSR INITIT +IFE STANSW,< OUTBUF 3,2 >;NO STANFORD +IFN STANSW,< OUTBUF 3,=10 >;STANFORD + JSR SWITCH ;GO SEE IF WE HAVE A SWITCH TO PROCESS +NOBIN: CAIE 2,"," ;DOES HE WANT LISTING + JRST NOLST ;APPEARANTLY NOT + MOVSI 1,'DSK' ;ASSUME DSK OUTPUT + SETZB 5,4 ;NO FILE, NO PPN +IFN STANSW, ;ASSUME LST +IFE STANSW, ;FOR CREF. + JSR GETFIL + JRST NOLST ;MUST BE ,_ + MOVEI 6,4 ;SET IO CHANNEL FOR LISTING + JSR INITIT + TRO LDEV + SETOM LISTSW +IFE STANSW,< OUTBUF 4,5 >;NOT STANFORD +IFN STANSW,< OUTBUF 4,=10 >;STANFORD + JSR SWITCH +NOLST: CAIE 2,"_" + CAIN 2,"=" ;ALTERNATIVE FOR RPG HACKERS + JRST .+2 + JRST ERR3 + SETZM MOINSW ;HAVEN'T SEEN ANY INPUT FILES ON THIS LINE + MOVSI 1,'DSK' ;DEFAULT DEVICE +NOLS2: MOVEI 5,12 + MOVEM 5,RPGNEED ;SET EOF HACK. IN CASE OF EARLY EOF ON COMMAND FILE + SETZB 4,5 ;NO PPN, NO FILE. +NOITS,< HRLOI 3,'FAI' > ;ASSUME DEFAULT EXT +ITS,< MOVEI 3,0 > ;ASSUME NO EXTENSION + JSR GETFIL + JRST [CAIN 2,12 ;FILE SPEC WAS EMPTY. + SKIPN MOINSW ;HAVE WE SEEN A FILE ON THIS LINE? + JRST ERR3 + SKIPN RPGSW ;RPG MODE? + OUTSTR [BYTE(7)15,12,"_"] ;PROMPT IF WE'RE TAKING TTY COMMANDS + SETZM MOINSW ;THIS IS TO CATCH CRLF AS ILLEGAL + JRST NOLS2] ;SAW ...FILE, (OR ..._) +NOLS3: MOVEM 1,SAVDEV# ;SAVE FOR NEXT TIME + MOVEI 6,2 ;DEVICE 2 = INPUT FILE. + JSR INITIT + + SETZM IRECN ;INITIALIZE RECORD NUMBER FOR RANDOM ACCESS IO + MOVEI 12,IBUFR1 ;ADDRESS OF THE FIRST BUFFER + TLO 12,400000 + MOVEM 12,IDB ;SET UP BUFFER + JSR SWITCH ;SEE IF THERE ARE ANY SWITCHES + SETZM MOINSW# +NOITS,< CAIN 2,";" ;ALLOW SEMICOLON TO EQUAL COMMA (RPG HACKERS) + SETOM MOINSW > + CAIE 2,"+" ;ALLOW + TO DENOTE MORE INPUT (RPG HACKERS) + CAIN 2,"," + SETOM MOINSW ;SAY HE HAS MORE TO COME + +>;NOTNX + +TNX,< + HRROI 3,[ASCIZ /REL/] ;DEF EXT FOR BIN FILE + JSR TGETF ;GET TENEX FILE NAME + JRST NOBIN ;NO FILE FOUND + CAIN 2,"!" + JRST DOLOD ;WANTS .SAV FILE RUN + CAIN 2,"@" + JRST DOAT ;INDIRECT COMMAND FILE + TRO BDEV ;GOT A BIN FILE + MOVEI 6,3 ;GOES ON CHANNEL 3 + JSR INITIT ;GTJFN,OPENF + SETOM ODB ;IN CASE IT IS PMAPABLE... + SETZM ODB+2 ;CLEAR COUNTER + JSR SWITCH ;LOOK FOR SWITCHES +NOBIN: CAIE 2,"," + JRST NOLST ;BIN_ + HRROI 3,[ASCIZ /LST/] ;DEF LIST EXTENSION + JSR TGETF ;GET TENEX FILE NAME + JRST NOLST ;BIN,_ + MOVEI 6,4 ;CHANNEL FOR FOR LIST FILE + JSR INITIT ;GTJFN,OPENF + SETOM LOB ;IN CASE IT IS PMAPABLE, FIX IT SO WE GET 0 FIRST + SETZM LOB+2 ;CLEAR COUNTER!! + TRO LDEV + SETOM LISTSW + JSR SWITCH ;LOOK FOR SWITCHES +NOLST: CAIE 2,"_" + CAIN 2,"=" + JRST .+2 + JRST ERR3 ;NO BACK ARROW + SETZM MOINSW# +NOLS2: MOVEI 5,12 ;EOF JOINS HERE... + MOVEM 5,RPGNEED ;SUPER DUPER HACK + HRROI 3,[ASCIZ /FAI/] ;DEF SOURCE EXT + JSR TGETF ;GET TENEX FILE NAME + JRST [CAIN 2,12 + SKIPN MOINSW + JRST ERR3 + SKIPN RPGSW + OUTSTR [ASCIZ / +_/] ;PROMPT INTERACTIVE USER. + SETZM MOINSW + JRST NOLS2] + MOVEI 6,2 ;SOURCE ON CHAN 2 + JSR INITIT ;GTJFN, OPENF + JSR SWITCH ;LOOK FOR SWITCHES + SETZM MOINSW + CAIN 2,"," + SETOM MOINSW ;IF MORE FILES ON THIS LINE + SETOM IRECN ;FIRST INCR WILL MAKE THIS ZERO + MOVEI 1,400000 ;THIS FORK + DIR ;DISABLE INTERRUPTS + TRNE LDEV + SKIPGE JFNTBL+2 + JRST .+2 ;NO LIST OR PMAPABLE + MOVE 3,LSTBF ;GUARANTEE THAT IT IS MAPPED + TRNE BDEV + SKIPGE JFNTBL+1 + JRST .+2 ;NO BIN OR PMAPABLE + MOVE 3,BINBF ;GUARANTEE THAT IT IS MAPPED + SKIPL JFNTBL + MOVE 3,SRCBF ;GUARANTEE THAT IT IS MAPPED + MOVE 3,TRM ;ALWAYS HIT TERMINATOR PAGE... + CIS ;IN CASE THERE WERE ANY PAGE FAULTS + EIR ;TURN INTERRUPTS ON AGAIN + +>;TNX + + AOS INITL ;FORM SKIP RETURN + MOVEM 17,INSV+17 ;SAVE ACS FOR CO-ROUTINE CALL FROM EOF + MOVEI 17,INSV + BLT 17,INSV+16 + MOVE 17,INSV+17 + JRST @INITL ;RETURN TO CALLER. + +INSV: BLOCK 20 ;SAVE AC'S FOR CO-ROUTINE CALL FROM EOF +^^TSV: BLOCK 20 ;SAVE MAIN AC'S FROM EOF DURING CO-ROUTINE CALL + +^EOF: 0 ;HERE AT EOF ON INPUT FILE + SKIPN MOINSW ;ARE THERE MORE INPUT FIELDS? + JRST FAT ;NO. LOSE BIG +NOTNX,< RELEAS 2,> ;YES. RELEASE INPUT FILE + MOVEM 17,TSV+17 ;SAVE OUR AC'S + MOVEI 17,TSV + BLT 17,TSV+16 +TNX,< JSR CLSSRC> + MOVEI 17,EOFRT ;SETUP RETURN ADDRESS FROM INITL + MOVEM 17,INITL + MOVSI 17,INSV ;RESTORE AC'S THAT INITL SAVED + BLT 17,17 +ITS,< MOVE 17,TPDP > ;I WANT A PUSH DOWN POINTER! +TNX,< MOVE 17,TPDP > ;INITL DOES UUOS, NEEDS STACK +NOTNX,< MOVE 1,SAVDEV> ;GET THE LAST DEVIC NAME THAT WE WERE USING + JRST NOLS2 ;JUMP INTO INITL +EOFRT: JRST FAT ;RETURN FROM INITL - FAILURE + MOVSI 17,TSV ;SUCCESS. RESTORE MAIN AC'S + BLT 17,17 + JRST @EOF ;RETURN TO CALLER. WE HAVE MORE FILE TO MUNCH + + +NOTNX,< + +SWPR: BLOCK 6 ;PUT PARAMS FOR SWAP HERE +^^SAVPPN: 0 + +DOLOD: JUMPN 1,.+2 ;CHANGE DEFAULT TO SYS + MOVSI 1,'SYS' + TRNE 3,-1 ;RH OF 3 WILL BE NON-ZERO IF EXPLICT EXTENSION SEEN + MOVSI 3,0 ;DEFAULT TO MONITOR SUPPLIED .DMP (OR .SAV, ETC.) + MOVEM 1,SWPR ;DEVICE + MOVEM 5,SWPR+1 ;FILE NAME + MOVEM 3,SWPR+2 ;EXTENSION + MOVEM 4,SWPR+4 ;PPN + MOVEI 1,SWPR + SKIPGE RPGSW + HRLI 1,1 ;START IN RPG MODE IF WE WERE STARTED IN RPG MODE + JSR DELRPG + RESET + MOVE 0,.JBFF + CORE 0, ;SHRINK BECAUSE TOPS-10 IS STUPID + JFCL + RUN 1, + JRST 4, ;(AT STANFORD, YOU CAN'T GET HERE.) + + +DOAT: MOVEI 6,6 ;HERE WHEN FILE@ COMMAND IS SEEN. +ITS,< CAMN 3,['REL '] + MOVSI 3,'CMD' ;CHANGE DEFAULT EXTENSION > ;ITS +NOITS,< TLZ 3,(3)> ;IF NO EXT GIVEN, RIGHT HALF IS -1. MAKE NULL + MOVEI 6,6 ;DEVICE 6 + JSR INITIT ;GO GET IT SET UP + PUSHJ P,RPGS1 ;NOW FAKE READING THE RPG FILE. + JRST RPGGO ;SET RETURN FROM RPGS1 +>;NOTNX + +IFN TENEX!ITSSW,< +TPDP: -20,,TPDL-1 +TPDL: BLOCK 20 +> + +TNX,< +STRTCD: + PHASE 5 ;TO EXEC IN ACS +NOT20,< + HRR 2,3 ;400000,,PG ;5 + PMAP ;OUT OF CORE ;6 + AOBJN 3,.-2 ;IF MORE PAGES ;7 +>;NOT20 +T20,< + PMAP + JFCL + JFCL +>;T20 + MOVE 1,4 ;400000,,JFN ;10 + GET ;LOAD FORK UP ;11 + MOVEI 1,400000 ;THIS FORK ;12 + GEVEC ;13 + HRRZ 1,.JBSA ;ASSUME 10/50 FORMAT ;14 + TLNN 2,777000 ;15 + HRRZ 1,2 ;TENEX FORMAT ;16 +XXSTRT::JRST (1) ;START US UP ;17 + ;THIS GETS CLOBBERED TO JRST 1(1) + ;FOR RPG MODE STARTUP + DEPHASE +LCD__.-STRTCD + +DOLOD: SETZ 3, + IDPB 3,1 ;TERMINAL NULL ON FILE NAME +NOT20,< HRROI 3,[ASCIZ /SAV/] ;DEF RUN EXTENSION >;NOT20 +T20,< HRROI 3,[ASCIZ /EXE/] ;DEF RUN EXTENSION >;T20 + MOVEM 3,GTEXT + HRROI 3,[ASCIZ/SYS/] + MOVEM 3,GTDEV ;default device for run + JSR DELRPG ;DELETE RPG FILE, IF ANY. + MOVEI 1,GTTBL ;GTJFN PARAM BLOCK + HRROI 2,GTNAM ;FILE NAME STRING + MOVE 3,[XWD 100000,0];OLD FILE + MOVEM 3,GTTBL + GTJFN + JRST TNXERR ;LOSE BIG + HRLI 1,400000 ;THIS FORK + MOVE 4,1 ;400000,,JFN OF NEW FILE + MOVEI 1,400000 ;THIS FORK + SETO 2, ;ALL INTS + DIC ;OFF!! + SETO 1, + MOVE 2,[XWD STRTCD,5] + BLT 2,5+LCD-1 ;MOVE STARTUP CODE TO ACS + SKIPGE RPGSW ;IN RPG MODE? + HRRI XXSTRT,1 ;SET ENTRY OFFSET +NOT20,< + HRLZI 2,400000 + MOVE 3,[XWD -777,1] +>;NOT20 +T20,< + MOVE 2,[400000,,1] ;PROCESS HANDLE,,FIRST PAGE + MOVE 3,[400000,,777] ;PAGE COUNT +>;T20 + JRST 5 ;LOAD ON TOP OF SELF AND START + +^TNXERR: + MOVEI 1,101 + HRLOI 2,400000 ;PROCESS HANDLE, MOST RECENT ERROR + MOVEI 3,0 + ERSTR + JFCL + JFCL + HALTF + JRST .-1 +DOAT: MOVEI 6,6 ;CHAN 6 FOR INDIRECT FILE + SETZ 3, ;NO DEF EXT + JSR INITIT ;GTJFN, OPENF + HLLOS RPGSW ;0,,-1 IS INDIRECT (I HOPE) + SETZM CTLBUF+2 ;CLEAR COUNTER + MOVEI 1,400000 ;THIS FORK + DIR ;KILL INTERRUPTS + MOVE 3,INDBF ;MAP BUFFER PAGE + CIS ;CLEAR INTERRUPTS + EIR ;ENABLE INTERRUPTS + JRST RPGGO ;OFF WE GO... + +>;TNX + + + ERR3: OUTSTR [ASCIZ /INPUT SYNTAX ERROR/] +ERR: OUTSTR TTCRLF + MOVEI 4,0 + SKIPN RPGSW ;IF IN RPG MODE, SCAN TO END OF LINE + JRST @INITL +ERRL: CAIN 2,12 + JRST @INITL + JSR IN + JRST ERRL + +NOTNX,< +ERR1: OUTSTR [ASCIZ /DEVICE NOT AVAILABLE: /] + MOVE 7,NAM +ERRM: PUSHJ P,MS6 + OUTSTR TTCRLF + MOVEI 4,0 + JRST @INITL + +ERR2: CAIE 6,3 ;SKIP IF ENTER FAILURE ON BINARY + CAIN 6,4 ;SKIP IF NOT ENTER FAILURE ON LIST + SKIPA 6,[[ASCIZ /ENTER FAILED /]] ;ENTER FAILURE + MOVEI 6,[ASCIZ /FILE NOT FOUND /] ;LOOKUP FAILURE + OUTSTR (6) + MOVE 7,FNAM + PUSHJ P,MS6 + OUTCHR ["."] +ITS,< MOVE 7,FNAM+1> +NOITS,< HLLZ 7,FNAM+1> + JRST ERRM + +MS6: MOVEI 6,0 ;PRINT SIXBIT CONTENTS OF 7 + JUMPE 7,CPOPJ + LSHC 6,6 + ADDI 6," " + OUTCHR 6 + JRST MS6 +>;NOTNX + + +TNX,< +ERR1: OUTSTR [ASCIZ /Can't get JFN: /] + OUTSTR GTNAM +ERR1A: OUTSTR TTCRLF + MOVE 2,5 ;RESTORE TERMINATOR + JRST @INITL ;FAIL + +ERR2: OUTSTR [ASCIZ /Can't open file: /] + MOVEI 1,101 ;PRIMARY OUTPUT + HRRZ 2,JFNTBL-2(6) ;JFN + MOVE 3,[XWD 211110,1] ;DEF DEV,FRC DIR,NAM,EXT,VER W/PUNC + JFNS ;SPIT OUT OFFENDING FILE NAME + MOVE 1,2 + RLJFN ;RELEASE JFN + JFCL + JRST ERR1A +>;TNX + BEGIN SWITCH +^SWITCH:0 + CAIE 2,"/" + CAIN 2,"(" + JRST .+2 + JRST @SWITCH ;WE'RE NOT INTERESTED IN THIS CHARACTER. + SETZM LPARF# ;NOT IN PARENTHESES SWITCHES + CAIN 2,"(" + SETOM LPARF ;MARK PARENS TYPE SWITCH +SW0: MOVEI 10,0 ;NUMBER COUNT +SW1: JSR IN ;GET A SWITCH + CAIN 2,")" ;SEE IF END + JRST RPAR ;YES + CAIG 2,"9" + CAIGE 2,"0" + JRST SW1A + IMULI 10,=10 ;ACCUMULATE NUUMBERS + ADDI 10,-"0"(2) + JRST SW1 + +SW1A: CAIL 2,140 ;CHANGE LOWER TO UPPER + SUBI 2,40 + CAIL 2,"A" + CAILE 2,"Z" + JRST ERR4 ;OUT FOR BOUNDS - ILLEGAL + HLRZ 7,TBL1-"A"(2) ;GET INSTRUCTION + CAIN 7,() ;IS THIS ILLEGAL ON INPUT? + CAIE 6,2 ;YES. SKIP IF THIS INPUT TERM + JRST OK ;SWITCH IS OK HERE + JRST ERR5 ;ILLEGAL ON INPUT TERM + +OK: XCT TBL1-"A"(2) ;PERFORM SWITCH FUNCTION +SW4: SKIPE LPARF ;IN PARENS? + JRST SW0 ;YES - LOOK FOR MORE +SW3: JSR IN ;GET ANOTHER CHR + JRST SWITCH+1 + +RPAR: SKIPE LPARF ;IN PARENS? + JRST SW3 ;YES, EXIT TIME + JRST ERR3 ;NO, LOSAGE + +ERR4: SKIPA 6,[[ASCIZ /UNKNOWN SWITCH: /]] +ERR5: MOVEI 6,[ASCIZ /SWITCH ILLEGAL ON INPUT TERM: /] + OUTSTR (6) + OUTCHR 2 + JRST ERR + +;IF THE INSTRUCTION IS A JUMPA, IT IS ILLEGAL ON THE INPUT TERM + +IFE SYMDMP, + +TBL1: NOTNX, JRST ERR4 ;A - ADVANCE + NOTNX, JRST ERR4 ;B - BACKSPACE + JUMPA CREFST ;C - CREF (ILLEGAL ON INPUT TERM) + JRST ERR4 ;D - ILLEGAL + JUMPA SLSHE ;E - SET MAIN PDL LENGTH (ILLEGAL ON INPUT) + SETZM ERSTSW ;F - DON'T STOP AT ERRORS + JRST ERR4 ;G - ILLEGAL + JRST ERR4 ;H - ILLEGAL + SETOM XL1IG ;I - IGNORE XLIST1 + JRST ONCRF ;J - TURN ON CREF FOR THIS (INPUT) TERM + SETZM XCRFSW ;K - TURN OFF CREF FOR THIS (INPUT) TERM + SETOM NOLTSW ;L - DON'T LIST LITERAL VALUES WITH TEXT + JRST ERR4 ;M - ILLEGAL + SETOM TTYERR ;N - DON'T LIST ERRORS ON TTY + SETOM FUNSUP ;O - OMIT .FUN FILE OUTPUT + JUMPA SLSHP ;P - SET SIZE OF PDL (ILLEGAL ON INPUT TERM) + JRST ERR4 ;Q - ILLEGAL + SETOM ERSTSW ;R - STOP ON ERRORS + SETOM SYMOUT ;S - LIST SYMBOL TABLE + NOTNX, JRST ERR4 ;T - ADVANCE TO END OF TAPE + SETOM UNDLNS ;U - UNDERLINE MACRO EXPANSION + JUMPA PAGER ;V - SET PAGE LENGTH FOR LISTING + NOTNX, JRST ERR4 ;W - REWIND TAPE + SETOM NOEXP ;X - DON'T LIST MACRO EXPANSIONS + JRST SYMWRT ;Y - FOR REG'S SYMBOL TABLE OUTPUT + JUMPA ZER ;Z - ZERO DECTAPE DIRECTORY + ;THE MAGTAPE SWITCHES +NOTNX,< +ZER: DPB 6,[POINT 4,ZERA,12] ;/Z SWITCH + DPB 6,[POINT 4,ZERA+1,12] +ZERA: UTPCLR + CLOSE + JSP 1,REENT ;GO DO ENTER AGAIN + JRST SW4 + + DEFINE MAG (A,B) +< DPB 6,[POINT 4,.+1,12] + MTAPE A + SOJG 10,.-1 ;DO IT A NUMBER OF TIMES + IFN B,< XCT .-2 + DPB 6,[POINT 4,.+3,12] + DPB 6,[POINT 4,.+3,12] + DPB 6,[POINT 4,.+3,12] + MTAPE 0 + STATO 1B24 + MTAPE 16> + JRST SW4 +> + +WND: MAG 1,0 +ADV: MAG 16,0 +BSP: MAG 17,1 +LND: MAG 10,0 +>;NOTNX + +TNX,< +ZER: HRRZ 1,JFNTBL-2(6) ;JFN + DVCHR ;CONVERT TO DEVICE + INIDR ;GOD HELP YOU IF THIS IS NOT DTAN: + JRST [OUTSTR [ASCIZ /Can't clear directory: /] + MOVEI 1,101 ;PRIMARY OUTPUT + HRRZ 2,JFNTBL-2(6) ;JFN + MOVE 3,[XWD 111110,1];FRC DEV, DIR, NAM, EXT, VER W/PUNC + JFNS ;SPIT IT OUT + MOVE 1,2 + CLOSF ;HAVENT MAPPED ANYTHING ANYHOW + JFCL + JRST ERR] + JRST SW4 + +;NO HOPE OF MAGTAPES EVER WORKING ANYHOW... +>;TNX + +CREFST: SETOM CREFSW + SETOM XCRFSW + MOVEI 10,LINLEN-8 + MOVEM 10,CHRPL ;SET CHRPL SO CREF LISTINGS WON'T OVERFLOW - JHS + JRST SW4 + +ONCRF: SKIPE CREFSW + SETOM XCRFSW + JRST SW4 + +SLSHP: SKIPN 10 + MOVEI 10,1 + ADDM 10,PSWIT + JRST SW4 + +SLSHE: SKIPN 10 + MOVEI 10,1 + ADDM 10,ESWIT + JRST SW4 + +PAGER: CAIL 10,20 + MOVEM 10,PAGSIZ ;SET PAGE SIZE FROM V SWITCH + JRST SW4 + +BEND SWITCH + ; HERE FOR FATAL ERROR. END OF FILE AND NO END STATEMENT +FAT: + MOVEI 3,LITMS + SKIPE LITPG + PUSHJ P,FMES ;IN LITERAL. + + MOVEI 3,TXTMS + SKIPE TXTPG + PUSHJ P,FMES ;IN ASCII, SIXBIT + + MOVEI 3,SARMS + SKIPE SARGPG + PUSHJ P,FMES ;MACRO ARGUMENT SCAN + + MOVEI 3,REPMS + SKIPE REP0PG + PUSHJ P,FMES ;REPEAT 0, CONDITIONAL, OR COMMENT + + MOVEI 3,TXTIMS + SKIPE TXTIPG ;FOR OR DEFINE? + PUSHJ P,FMES + FATAL [ASCIZ /FATAL END OF FILE & NO END STMT/] ;COUP DE GRAS + +;FMES IS ALSO CALLED BY PSLIT TO HELP POOR USERS DETECT TROUBLE SOONER + +^FMES: MOVE 2,[ASCII / /] ;5 BLANKS + SKIPG 1,@-1(3) ;SKIP IF THERE'S AN SOS LINE NUMBER + MOVEM 2,@-1(3) ;STORE BLANKS INTO LINE NUMBER WORD + JUMPGE 1,FMES2 ;JUMP IF THERE WAS AN SOS NUMBER OR EMPTY + MOVEI 1,1(1) ;LINE NUMBER CAME FROM INLINE. + MOVSI 4,440700 + HRRI 4,@-1(3) ;MAKE POINTER TO THE LINE NUMBER TEXT WORD + PUSHJ P,RNUM ;CONVERT TO TEXT. +FMES2: MOVE 1,-2(3) ;GET PAGE NUMBER + MOVE 4,-1(3) ;GET ADDRESS OF LINE NUMBER TEXT + ADDI 4,2 ;ADVANCE PAST THE TEXT OF " PAGE " + HRLI 4,() ;POINTER TO TRAILING BLANK OF " PAGE " + PUSHJ P,RNUM ;CONVERT PAGE NUMBER TO PAGE NUMBER. +NOTNX,< + MOVE 1,[POINT 7,-5(3)] ;POINTER TO THE FILE NAME (LEADING SPACE) + ILDB 2,1 ;READ A BYTE... APPEND FILE NAME TO END OF + IDPB 2,4 ;STUFF A BYTE ... ERROR MESSAGE + JUMPN 2,.-2 ;LOOP. END ON NULL +>;NOTNX +TNX,< + MOVE 1,4 ;CORRECT BYTE POINTER + HRRZ 2,-3(3) ;JFN + MOVE 4,3 ;SAVE ADDR + MOVE 3,[XWD 211110,1] ;DEF DEV, FRC DIR,NAM,EXT,VER W/PUNC + JFNS ;EXPAND IT + MOVE 3,4 ;RESTORE ADDR +>;TNX + ERROR (3) ;MAKE AN ERROR MESSAGE + POPJ P, + +RNUM: IDIVI 1,=10 + HRLM 2,(P) + SKIPE 1 + PUSHJ P,RNUM + HLRZ 1,(P) + ADDI 1,"0" + IDPB 1,4 + POPJ P, + +^LITFIL:BLOCK NOTNX,<5;> 1 ;FILE NAME IN WHICH LITERAL OCCURS +^LITPG: 0 ;PAGE NUMBER + LITLIN ;POINTER TO LINE NUMBER +^LITMS: ASCII / LITERAL LINE / ;PRECISELY SOME MULTIPLE OF 5 CHARACTERS +^LITLIN:0 ;LINE NUMBER HERE BECOMES TEXT. + ASCII / PAGE / ;PRECISELY 6 CHARACTERS + BLOCK NOTNX,<4;> =27 ;TEXT OF PAGE NUMBER, FILE NAME COPIED HERE + +^TXTFIL:BLOCK NOTNX,<5;> 1 +^TXTPG: 0 + TXLIN +TXTMS: ASCII /TEXT STATEMENT LINE / +^TXLIN: 0 + ASCII / PAGE / + BLOCK NOTNX,<4;> =27 + +^SARFIL:BLOCK NOTNX,<5;> 1 +^SARGPG:0 + SARLN +SARMS: ASCII /REPEAT OR MACRO ARGUMENT LINE / +^SARLN: 0 + ASCII / PAGE / + BLOCK NOTNX,<4;> =27 + +^REPFIL:BLOCK NOTNX,<5;> 1 +^REP0PG:0 + REPPG +REPMS: ASCII / REPEAT 0, CONDITIONAL, OR COMMENT LINE / +^REPPG: 0 + ASCII / PAGE / + BLOCK NOTNX,<4;> =27 + +^TXTIFL:BLOCK NOTNX,<5;> 1 +^TXTIPG:0 + TXTIL +TXTIMS: ASCII / FOR OR DEFINE LINE / +^TXTIL: 0 + ASCII / PAGE / + BLOCK NOTNX,<4;> =27 + +BEND INIT + BEGIN RPG  SUBTTL INITIALIZATION OF PROGRAM +;SETRPG. CALLED WITH PUSHJ. SKIPS ON FAILURE OF ANY KIND + +^SETRPG: + SKIPL RPGSW ;IN RPG MODE? + JRST CPOPJ1 ;NO. GIVE THE SKIP RETURN +NOTNX,< +IFN TMPCSW,< MOVSI 1,'FAI' + MOVEM 1,RPGNAM ;FILE NAME ARGUMENT FOR TMPCOR + MOVE 1,[-200,,RPGBUF-1] + MOVEM 1,RPGNAM+1 ;IOWD FOR READING TMPCOR FILE + MOVE 1,[POINT 7,RPGBUF] + MOVEM 1,CTLBUF+1 ;BYTE POINTER FOR IN + MOVE 1,[2,,RPGNAM] ;READ AND DELETE FILE. + TMPCOR 1, + JRST DSKRPG ;NOT IN SERVICE, OR NO FILE THERE + CAILE 1,200 ;MAKE SURE WE GOT IT ALL + JRST RPGIN5 ;WE LOSE. + SETZM RPGBUF(1) ;CLEAR FIRST FREE WORD. NEED A NULL AT END + IMULI 1,5 ;CNVT WC FROM TMPCOR TO CHAR CNT + ADDI 1,1 ;BE SURE TO INCLUDE THE EXTRA NULL + MOVEM 1,CTLBUF+2 ;SAVE BYTE COUNT + SETOM TMPCOR# ;FLAG WE ARE DOING TMPCORE + JRST RPGS5 +>;IFN TMPCSW + +DSKRPG: MOVSI 1,'FAI' + PJOB 2, ;JOB NUMBER + MOVEI 4,3 ;3 CHARACTERS OF JOB NUMBER + IDIVI 2,=10 ;3_LEAST SIGNIFICANT DIGIT + IORI 1,20(3) ;INCLUDE IN NAME + ROT 1,-6 + SOJG 4,.-3 ;LOOP FOR 3 CHARACTERS + MOVSI 2,'TMP' ;FILE EXTENSION + MOVEM 1,RPGNAM ;STORE FILE NAME FOR RPG FILE + MOVEM 2,RPGNAM+1 + SETZM RPGNAM+3 ;PPN + INIT 6,1 + 'DSK ' + CTLBUF + JRST CPOPJ1 ;SEE US LOSE. (SKIP RETURN) + LOOKUP 6,RPGNAM ;NOW SEE IF FILE IS THERE + JRST CPOPJ1 ;LOSE (SKIP RETURN) +^RPGS1: MOVEI 1,RPGBUF ;THIS IS WHERE WE WANT OUT BUFFER PUT + EXCH 1,.JBFF ;(SAVE .JBFF) + INBUF 6,1 ;GET ONE BUFFER. + MOVEM 1,.JBFF ;(RESTORE OLD .JBFF) +>;NOTNX + +TNX,< +T20,< ;RELEASE 3 of TOPS-20 simulates TMPCOR.... + MOVE 1,[1,,400000] ;READ for this fork + MOVEI 2,RPGBUF ;ARG BLOCK + MOVEI 3,200 ; + PRARG + CAILE 3,200 ;number of words read + JRST [OUTSTR [asciz/Too many words in TMP file +/] + JRST CPOPJ1] ;return to tty scanner + JUMPE 3,DSKRPG ;the bus isn't running. take subway + MOVN 3,3 + MOVSI 3,(3) + HRRI 3,RPGBUF +TMCLP1: HLRZ 1,(3) + CAIN 1,'FAI' ;is this the right place? + JRST TMCLP2 ;yes. stop the bus + AOBJN 3,TMCLP1 + JRST DSKRPG ;transfer to the subway + +TMCLP2: HRRZ 1,(3) +; SUBI 1,1 ;removed for release 4 + IMULI 1,5 ;CONVERT TO CHARACTER COUNT + MOVEM 1,CTLBUF+2 ;store count + HRLI 3,000700 + MOVEM 3,CTLBUF+1 ;store byte pointer + SETOM TMPCOR# + JRST RPGS5 +>;T20 +DSKRPG: GJINF + MOVE 2,3 ;JOB NO TO 2 + HRROI 1,RPGFIL + MOVE 3,[XWD 140003,=10] ;LEADING FILL ZEROES, BASE 10 + NOUT + JRST CPOPJ1 ;HUH? + HRROI 2,RPGFI1 + SETZ 3, + SOUT + IDPB 3,2 ;END WITH A NULL + HRLZI 1,100001 ;OLD FILE, SHORT FORM + HRROI 2,RPGFIL + GTJFN + JRST CPOPJ1 ;OOPS, NO FILE + MOVE 2,[XWD 440000,200000] ;36 BIT, READ ONLY + OPENF + JRST [RLJFN + JRST CPOPJ1 + JRST CPOPJ1] + MOVEM 1,JFNTBL+4 ;SAVE JFN + SETZM CTLBUF+1 ;KILL COUNTER + MOVEI 1,400000 ;THIS FORK + DIR ;INT OFF + MOVE 3,INDBF ;MAP PAGE FOR BUFFER + CIS ;CLEAR AN MPV INTERRUPT + EIR ;REEANBLE INTS +>;TNX +RPGS5: HLLOS RPGSW ;(IF DOING @ FILE, SET RPGSW TO 0,,-1) + + POPJ P, ;NON-SKIP FOR SUCCESS. + +TNX,< +RPGFIL: ASCIZ /nnnFAI.TMP/ ;RPG FILE NAME +RPGFI1: ASCIZ /FAI.TMP/ +>;TNX + +^RPGRS: LDB 2,CTLBUF+1 ;SCAN TO END OF LINE +RPGRS2: CAIN 2,12 + JRST RPGGO + JSR IN + JRST RPGRS2 + +;RPGIN IS CALLED FROM IN TO READ NEXT CHARACTER FROM RPG OR @ FILE. +;RETURNS CHARACTER IN 2. +; IF EOF OR ERROR ON RPG FILE, JUMPS TO RPGXIT + + +RPGIN3: AOS CTLBUF+1 ;HERE TO FLUSH SOS LINE NUMBER + MOVNI 2,5 ;GRONK BYTE POINTER. + ADDM 2,CTLBUF+2 ;ADJUST BYTE COUNT. GET NEXT CHARACTER +^RPGIN: SOSG CTLBUF+2 ;CALLED FROM IN + JRST RPGIN2 ;END OF BUFFER. +RPGIN1: IBP CTLBUF+1 ;ADVANCE BYTE POINTER + MOVE 2,@CTLBUF+1 ;GET THE CURRENT WORD + TRNE 2,1 ;SOS LINE NUMBER? + JRST RPGIN3 ;YES. FLUSH IT + LDB 2,CTLBUF+1 + JUMPE 2,RPGIN ;IGNORE NULLS + CAIE 2,14 ;IGNORE FORM FEEDS + CAIN 2,15 ;IGNORE CR'S + JRST RPGIN + JRST @IN + +RPGIN2: ;HERE AT END OF BUFFER. +T20,< SKIPE TMPCOR ;exit at eof on tmpcor + HALTF >;T20 +NOTNX,< +IFN TMPCSW,< SKIPE TMPCOR ;AT EOB IN TMPCORE, EXIT + EXIT >;IFN TMPCSW + IN 6, ;READ NEXT + JRST RPGIN1 ;GOT SOME. DO IT. + STATZ 6,20000 ;EOF? + JRST RPGIN4 ;YES. +RPGIN5: OUTSTR [ASCIZ /ERROR READING COMMAND (OR RPG) FILE, OR TMPCOR TOO BIG/] +>;NOTNX + +TNX,< + TSVAC <1,3> + HRRZ 1,JFNTBL-2+6 ;IND FILE JFN + MOVE 2,[POINT 36,INDBF] + HRROI 3,-1000 ;MAX NO BYTES + SIN + ADDI 3,1000 ;COMPUTE BYTES XFERED + IMULI 3,5 ;CONV TO 7 BIT BYTES + MOVEM 3,CTLBUF+2 ;SET COUNT + MOVE 2,[POINT 7,INDBF] + MOVEM 2,CTLBUF+1 ;AND POINTER + TRSTAC <1,3> + SKIPE CTLBUF+2 + JRST RPGIN1 ;GOT SOME + JRST RPGIN4 ;EOF +>;TNX +RPGXIT: JSR DELRPG ;DELETE RPG FILE + SKIPGE RPGSW ;RPG MODE? +NOTNX,< EXIT> ;YES. DIE NOW. +TNX,< HALTF> + SETZM RPGSW + JRST STRT1 + + +RPGIN4: MOVEI 2,0 ;PERHAPS HE NEEDS A TERMINATOR + EXCH 2,RPGNEED ;SEE IF HE DOES. + JUMPE 2,RPGXIT ;JUMP IF NO PROVIDED FOR HIM + DPB 2,CTLBUF+1 ;GOT ONE. PUT WHERE WE CAN SEE IT AGAIN. + JRST @IN ;GIVE IT TO HIM. + +^DELRPG:0 +NOTNX,< +IFN TMPCSW,< SKIPE TMPCOR ;DOING TMPCOR? + JRST @DELRPG ;YES. LET'S NOT DELETE RPG FILE > + SKIPGE RPGSW ;SKIP IF @ FILE, OR NOT RPG MODE + RENAME 6,ZEROS ;RENAME TO DELETE CURRENT FILE + JFCL ;IGNORE FAILURE FROM DELETE + RELEAS 6, + JRST @DELRPG +>;NOTNX +TNX,< +T20,< SKIPN TMPCOR ;NO DELETE IF TMPCOR >;T20 + SKIPN RPGSW ;EITHER RPG OR INDIRECT MODE? + JRST @DELRPG ;NEITHER + HRRZ 1,JFNTBL-2+6 + HRLI 1,400000 ;KEEP JFN THRU CLOSE + CLOSF + JFCL + SKIPL RPGSW ;RPG MODE? + JRST DELRP1 ;NO. MUST BE INDIRECT FILE. + HRRZ 1,JFNTBL-2+6 ;GET THE JFN AGAIN + HRLI 1,400000 ;KEEP JFN + DELF ;DELETE FILE + JFCL +DELRP1: HRRZ 1,JFNTBL-2+6 + RLJFN + JFCL + SETZM JFNTBL-2+6 + JRST @DELRPG +>;TNX + +^CTLBUF:BLOCK 3 +NOTNX, ;BUFFER SPACE FOR RPG/TMPCOR/COMMAND-FILE +TNX, +RPGNAM: BLOCK 4 +ZEROS: REPEAT 4,<0> +BEND RPG + ;HERE TO READ COMMAND LINE OR CMD FILE + +IN: 0 ;JSR HERE. RETURN CHARACTER IN 2. + SKIPE RPGSW ;RPG MODE? (RPG OR @ FILE) + JRST RPGIN ;YES. DO IT FROM FILE +IN1: ILDB 2,TTYPTR ;GET A BYTE FROM THE TTY + JUMPN 2,@IN ;IF NOT NULL, RETURN IT + MOVE 2,[440700,,TTYBUF] ;INITIALIZE BYTE POINTER + MOVEM 2,TTYPTR +NOTNX,< + MOVEM 2,SOUT +ITS,< + AOSN DDTCMD + JRST [MOVE 2,[TTYBUF,,TTYBUF+1] + SETZM TTYBUF + BLT 2,TTYBUF+TTYBFL-1 + .BREAK 12,[5,,TTYBUF] + JRST IN1] +>;ITS +IN2: INCHWL 2 ;WAIT FOR A NEW LINE + ANDI 2,177 ;MASK CHARACTER + JUMPE 2,IN2 ;FLUSH NULLS + CAIN 2,15 + JRST IN2 ;AND FLUSH CRS + IDPB 2,SOUT ;STORE CHARACTERS + CAIE 2,12 + JRST IN2 + MOVEI 2, ;STOP ON LF. INVENT A NULL + IDPB 2,SOUT + JRST IN1 ;IT'S NOT OBVIOUS WHY IT'S DONE THIS WAY + +SOUT: 0 +>;NOTNX +TNX,< + TSVAC <1,3> + HRROI 1,TTYBUF + MOVEI 2,5*TTYBFL-2 +NOT20,< SETZ 3, ;SHORT FORM CALL + PSTIN ;IMSSS LOCAL >;NOT20 +T20,< HRROI 3,[ASCIZ/*/] + RDTTY + ERJMP .+1 + MOVEI 3,0 >;T20 + IDPB 3,1 ;END WITH NULL + TRSTAC <1,3> + JRST IN1 ;ONWARD... +>;TNX + +TTYPTR: 0 +TTYBFL__40 +TTYBUF: BLOCK TTYBFL + ; START HERE + + +STRT: TDZA T,T + MOVNI T,1 + MOVEM T,RPGSW ;SAVE STATE OF RPG SWITCH + MOVE T,[JSR UUO] + MOVEM T,41 ;UUO HANDLER + MOVE T,[350700,,TLBLK+1] + MOVEM T,LSTPNT ;SET UP EARLY FOR ERR PRT + MOVE P,[-PLEN,,PDL-1] ;AND THE STACK. + PUSHJ P,GTCPTM ;GET STARTING CPU TIME + +ITS,< SETZM DDTCMD + .SUSET [.ROPTI,,1] + TLNE 1,OPTCMD + SETOM DDTCMD >;ITS + + PUSHJ P,CORINI ;SET UP MPV INTERRUPTS (FOR OPSET) +T20,< SETZM TMPCOR#> ;no tmpcor to start +IFN TMPCSW,< SETZM TMPCOR# > ; + +IFN STANSW,< SKIPN OPSOK + PUSHJ P,OPSET ;DEFINE SYSTEM OPCODES FIRST TIME >;STANSW + + SETZM UNIVSW ;NOT DOING UNIVERSALS YET + PUSHJ P,SETRPG + JRST RPGGO ;WE ARE HAVE STARTED RPG MODE SUCESSFULLY + SETZM RPGSW ;REG/RPH 11/26/74. RPGSW_0 IF SETRPG FAILS +NOITS,< HLLZS 42> ;NOT IN RPG MODE. CLEAR ERROR CELL. +;HERE AFTER COMPLETE ASSEMBLY, OR WHEN COMMAND FILE RUNS OUT. +STRT1: MOVE P,[-PLEN,,PDL-1] ;DON'T USE OLD STACK MADE BY /E + SKIPE RPGSW ;ARE WE IN RPG MODE? + JRST RPGRS ;SCAN TO END OF LINE OF RPG FILE. TO RPGGO + RESET + PUSHJ P,CORINI ;RE-ENABLE INTS AFTER RESET (SIGH) + PUSHJ P,USHUFF ;SHUFFLE UNIVERSALS. SET JOBFF FROM JOBSA +NOTNX,< MOVE 1,.JBFF ;SHRINK CORE BEFORE CONTINUING + CORE 1, + JFCL >;NOTNX +RPGGO: MOVE P,[-PLEN,,PDL-1] + PUSHJ P,USHUFF ;SHUFFLE UNIVERSALS. SET JOBFF FROM JOBSA + + FOR A IN (NOEXP#,TTYERR#,SYMOUT#,XL1IG#,PSWIT#,ESWIT#, + ,NOLTSW#,CREFSW#,XCRFSW#,INLINE#, + ,PGNM,SPGNM,TTYPTR,INCLIN#,FUNSUP) +< SETZM A +> + +IFE STOPSW,< SETZM ERSTSW# ;>SETOM ERSTSW# + + MOVSI 1 + MOVEM CHRCNT# + SETOM LNCNT ;SET THESE TWO CELLS TO FORCE HEADING + AOS PGNM + MOVEI + SKIPN RPGSW + +NOITS,< OUTSTR STAR > + +ITS,< + JRST [ MOVEI 1,[.FNAM1] + PUSHJ P,FNMOUT + OUTCHR ["."] + MOVEI 1,[.FNAM2] + PUSHJ P,FNMOUT + OUTCHR [15] + OUTCHR [12] + SKIPL DDTCMD + OUTCHR ["*"] + JRST .+1] +>;ITS + + MOVEI 1,FILSTK + MOVEM 1,FILSTP ;INITIALIZE FILE-STACK POINTER + SETZM FILSTC ;FILE-STACK DEPTH + + MOVE 1,[CXTAB,,CTAB] ;INITIALIZE CHARACTER TABLE + BLT 1,CTAB+177 + + JSR INITL ;DECODE COMMAND FILE, SET UP BUFFERS.. + JRST [RESET ;SOMETHING IS AMISS. AVOID WRITING ANYTHING + SKIPE RPGSW + NOTNX, HALTF ;IN CASE OF RPG, THE PARTY'S OVER + JRST STRT1] ;FOR MANUAL USER, TRY AGAIN + MOVE 1,.JBFF + MOVEM 1,IOFF# ;SAVE ADDRESS ABOVE THE IO BUFFERS +IFN STANSW,< PUSHJ P,TVSKIP >;MAYBE SKIP DIRECTORY AT STANFORD +IFE STANSW,< PUSHJ P,INP > ;READ INITIAL RECORD + + +;HERE FROM PRGEND TO START NEXT ASSEMBLY. +STRT2: MOVE P,[-PLEN,,PDL-1] + MOVE 1,IOFF + MOVEM 1,.JBFF ;RESET .JBFF TO INCLUDE IO BUFFERS - NOT MACRO PDL + PUSHJ P,USHUF1 ;SHUFFLE UNIVERSALS. (IOACTIVE. DON'T REDUCE .JBFF) + SETZM SYMTAB + MOVE 1,[XWD SYMTAB,SYMTAB+1] + BLT 1,HASH-1+SYMTAB ;CLEAR USER SYMBOL TABLE + MOVE 1,[XWD OPCDS1,OPCDS] ;INITIALIZE OPCODE TABLE FROM + BLT 1,HASH-1+OPCDS ;PREFINED+CALLIS + MOVE 1,[XWD MACRT1,MACRT] ;INITIALIZE MACRO TABLE + BLT 1,HASH-1+MACRT + + MOVE 1,[CXTAB,,CTAB] ;INITIALIZE CHARACTER TABLE + BLT 1,CTAB+177 + + SETZM LSTLAB ;CLEAR LAST LABLE NAMES + MOVE 1,[LSTLAB,,LSTLAB+1] + BLT 1,LSTLAB+4 + +ITS,< PUSHJ P,GETSYS > ;GET SYSTEM SYMBOLS + ANDI IOFLGS ;CLEAR ALL BUT I/O FLAGS + FOR A IN (LOCNT#,%BCUR,POLPNT#,SEG#, + ,XPUNGS#,SYMEM#,CODEM#,VARLST#,LGARB,XL2SW#,TABMSW#) +< SETZM A +> + SETOM XPNDSW + SETOM INMCSW# + SETOM TITLSW# + MOVE FS,['.MAIN'] + MOVEM FS,BNAM ;SET INITIAL PROGRAM NAME + MOVEM FS,LSTLAB+3 + PUSHJ P,R5CON + MOVEM FS,TPOL3 ;SAVE RADIX50 FOR NAME BLOCK OUTPUT + MOVSI FS,12 ;PROCESSOR ID 12 = FAIL IN BLOCK TYPE 6 + MOVEM FS,TPOL4 + MOVE 2,[XWD -ERPLEN,ERPD-1] + MOVEM 2,ERPNT + MOVE 1,PSWIT + ADDI 1,1 + LSH 1,7 ;FORM MACRO PDL LENGTH + + SKIPG 3,ESWIT ;ANY EXTRA LONG MAIN PDL? + JRST .+3 ;NO. + LSH 3,7 + ADDI 3,PLEN ;SIZE OF NEW PDL + + MOVE M,.JBFF + MOVEI 2,=1024*5(M) ;FIRST FREE + 5K + ADDI 2,(1) ;+SIZE OF MACRO PDL + ADDI 2,(3) ;+SIZE OF MAIN PDL +NOTNX,< CORE 2,> ;GET THE CORE. IF ANYONE NEEDS LESS THAN +TNX,< MOVEM 2,.JBREL + CAILE 2,MXCOR ;WATCH FOR OVERFLOW INTO BUFFERS AND DDT +>;TNX + PUSHJ P,COERR ;5 K, HE DESERVES OUR CONGRATULATIONS. + ADDM 1,.JBFF ;ADVANCE JOBFF PAST THE MACRO PDL + SUBI M,1 + MOVNS 1 + HRL M,1 ;MACRO PDL POINTER NOW IS IN M + + JUMPE 3,STRT2A ;JUMP UNLESS BUILDING EXTRA PDL + MOVE P,.JBFF ;HERE'S WHERE THE PDL STARTS + ADDM 3,.JBFF ;ADVANCE JOBFF PAST THE MAIN PDL + SUBI P,1 + MOVNS 3 + HRL P,3 ;MAIN PDL POINTER NOW IS IN M +STRT2A: + + HRRZ 2,.JBREL ;GET END OF CORE + MOVEI 3,-1(2) + HRRZ 5,.JBFF ;GET END OF PROGRAM + SUB 3,5 ;FORM LENGTH OF FREE AREA + ASH 3,-1 + MOVEM 2,MTBLST# ;SET END OF FREE AREA + MOVE 2,5 + ADD 2,3 + MOVEM 2,MTBPNT# ;FORM START OF FREE AREA + IDIVI 3,5 ;FORM COUNT + MOVEM 5,FSTPNT# ;START OF FREE STRG + ADDI 5,5 ;INCREMENT TO NEXT + MOVEM 5,-4(5) ;STORE LINK + SOJG 3,.-2 ;LOOP + SETZM -4(5) ;TERMINATE + SETZM LOCNT + SETZM ABSCNT# + MOVEI T,LOCNT + MOVEM T,CURBRK# + MOVEI CP,400000 + MOVEM CP,HICNT# + HLLOS BRK# + + SETZM PCNT ;LOCATION COUNTERS. RELOC 0 + MOVEI T,1 + MOVEM T,PCNT+1 + SETZM OPCNT + MOVEM T,OPCNT+1 + SETZM DPCNT + MOVEM T,DPCNT+1 + + MOVEI CP,ASSMBL ;GET ADDRESS + MOVEM CP,CPDL ;INITIALIZE THE SPECIAL PDL + MOVE CP,[XWD CPDL,CPDL+1] ;USED FOR THE + BLT CP,CPDL+CPLEN-1 ;RECURSIVE CO-ROUTINE ASSMBL + MOVE CP,[XWD SNB+CPLEN-3,CPDL+CPLEN-2] + + SETZB BC,FBLK+1 + MOVE FC,[XWD -22,FBLK+2] + PUSHJ P,SBINI ;INITIALIZE SYMBOL OUTPUT. + MOVNI B,BBLK+2 + HRRM B,BFX + MOVNI B,FBLK+2 + HRRM B,FFX + MOVE B,[POINT 7,TLBLK+1,6] + MOVEM B,LSTPNT + MOVSI B,() + MOVEM B,TLBLK+1 + MOVE B,[POINT 7,CREFTB,13] + MOVEM B,CREFPT + MOVE B,[LSH N,3] + MOVEM B,SRAD + MOVE B,CTAB+"8" + MOVEM B,RTEST + + MOVEI B,LINLEN ;NORMAL LINE SIZE - JHS + SKIPE CREFSW ;EXCEPT, ARE WE CREFFING? + MOVEI B,LINLEN-10 ;YES - REDUCE LINE SIZE BY 8 + MOVEM B,CHRPL + + MOVEI B,LNPP + SKIPN PAGSIZ + MOVEM B,PAGSIZ ;INITIALIZE PAGE SIZE UNLESS SET BY SWITCH. + MOVE B,[LITPNT-1,,LITPNT] + BLT B,LITPNT+HASH-1 + MOVEI B,1 + MOVEM B,BLOCK + MOVE B,[XWD DAF,-1] + MOVEM B,DBLCK + MOVE B,[XWD SNULN,NULN] + BLT B,NULN+5 + MOVE B,[XWD -EFSLEN,EFS-1] + MOVEM B,EFSPNT# + SETZM TITCNT+1 + MOVE B,[XWD -1,TITCNT+1] + MOVEM B,TITCNT + MOVE B,[XWD -1,SUBCNT+1] + MOVEM B,SUBCNT +NOTNX,< MOVE B,[BYTE (7)15,12,15,12]> +TNX,< MOVE B,[BYTE (7)11,11,11,11,11] + SETZM SUBCNT+2 +>;TNX + MOVEM B,SUBCNT+1 + SETZM GARBAG +IFN STANSW,< MOVEI C,OPSET + MOVEI B,OPSEND + PUSHJ P,MACRET > ;GIVE OPCODE-GETTER TO FREE STORAGE +TNX,< PUSHJ P,INISM > ;SET INITIAL SYMBOL TABLE. + JRST MAIN ;OFF TO SEE THE WIZARD, THE WONDERFUL ... + ;NOFSL + +CELCNT: 0 + +BEGIN NOFSL + +^NOFSL: 0 ;JSR HERE WHEN OUT OF FREE STORAGE + PUSH P,O + PUSH P,T ;SAVE + PUSH P,FS ;... + PUSH P,N + PUSH P,NA + MOVEI NA,GARBAG-1 + SKIPN T,GARBAG ;GET GARBAGE LIST + JRST NOGAR ;NONE + SETZB FS,CELCNT ;ZERO CELL COUNT +LOOP2: MOVE O,2(T) ;GET START ADDRESS + MOVE N,(T) ;GET COUNT + CAIGE N,5 ;BIG ENOUGH? + JRST NOMO ;NO +LOOP1: MOVEM FS,1(O) ;DEPOSIT POINTER + MOVE FS,O ;FORM NEW ONE + ADDI O,5 + SUBI N,5 ;DECREASE COUNT + AOS CELCNT + CAIL N,5 ;ROOM FOR MORE? + JRST LOOP1 ;YES +NOMO: JUMPE N,USET ;USED IT ALL? + MOVEM N,(T) ;NO, DEPOSIT NEW COUNT + MOVEM O,2(T) ;DEPOSIT NEW START + MOVE NA,T + SKIPN T,1(T) ;GET NEXT + JRST NOMGAR ;NO MORE GARBAGE + JRST LOOP2 + +USET: MOVE O,1(T) ;GET POINTER + MOVEM O,1(NA) ;REMOVE THIS CELL... + MOVEM FS,1(T) ;& PUT INTO + MOVE FS,T ;FREE STORAGE + AOS CELCNT + SKIPE T,O + JRST LOOP2 +NOMGAR: SKIPE T,GARBAG + MOVE T,3(T) + MOVEM T,LGARB + MOVE T,CELCNT + CAIGE T,20 ;WERE AT LEAST 20 CELLS CREATED? + JRST NOTNUF ;NO +LOOP4: MOVE T,NOFSL ;GET ADDRESS + LDB O,[POINT 4,-2(T),12] ;GET AC FLD + DPB O,[POINT 4,RSET,12] ;DEPOSIT + POP P,NA + POP P,N ;RESTORE + HRRM FS,RSET ;DEPOSIT FREE STORAGE POINTER + POP P,FS + POP P,T + POP P,O +RSET: MOVEI ;LOAD NEW POINTER ***AC AND ADDRESS CLOBBERED*** + JRST @NOFSL ;RETURN + +NOGAR: MOVEI FS,0 +NOTNUF: MOVE T,.JBREL ;GET END OF CORE + SUB T,MTBPNT ;SUB CURRENT START OF FREE AREA + CAIGE T,300 ;AT LEAST 300 WORDS LEFT? + PUSHJ P,COEXP ;NO, EXPAND CORE + MOVE T,.JBREL ;GET DIF + SUB T,MTBPNT ;... + LSH T,-1 ;DIV BY 2 + ADD T,MTBPNT ;USE HALF FOR FREE STRG + MOVE O,MTBPNT ;GET START +LOOP3: MOVEM FS,1(O) ;DEPOSIT POINTER + MOVE FS,O ;GET NEW ONE + ADDI O,5 ;GO TO NEXT + CAMGE O,T ;FAR ENOUGH? + JRST LOOP3 ;NO + MOVEM O,MTBPNT ;YES, DEPOSIT NEW MTBPNT + JRST LOOP4 + + ;CORINI, COEXP, WAIT, TSINT, PDLOV, PDLOVI + +SV: BLOCK 2 ;TEMP CELLS FOR MPV INTERRUPTS + +NOTNX,< + +^COERR: OUTSTR [ASCIZ/ +Need more core but none is available. Strike any key to try again:/] + PUSHJ P,WAIT +^COEXP: MOVE T,.JBREL ;GET CURRENT END OF CORE + ADDI T,2000 ;EXPAND BY 1K + CORE T, + JRST COERR ;NO CORE + POPJ P, + +^WAIT: CLRBFI + INCHRW T + CAIN T,15 + INCHRW T + POPJ P, + +^CORINI:MOVEI T,IFE STANSW,<620000;>220000 ;REPETITIVE ENABLE ON DEC SYSTEMS + APRENB T, + MOVEI T,.JBAPR-1 + PUSHJ T,CORI2 + HRRZS O,T ;TRAP HERE TO SEE HOW MUCH PC CHANGED + SUBI O,@.JBTPC + JRST 2,1(T) ;SKIP TEST INSTR, CLEAR FLAGS (ESP. BIS) + +CORI2: JSP T,.+1 + SETZM -1 ;GET PC OFFSET FOR WRITE INSTRUCTIONS + MOVEM O,REGOFF# + JSP T,.+1 + DPB [,-1] ;GET OFFSET FOR BYTE INSTRUCTIONS + MOVEM O,BYTOFF# + MOVEI T,.JBAPR-1 + PUSHJ T,CPOPJ ;SET TRAP ADDRESS TO TSINT +^TSINT: MOVEM FS,SV ;SAVE + MOVEM T,SV+1 + MOVE T,.JBCNI + TRNE T,200000 + JRST PDLOVI + MOVE FS,.JBTPC ;GET PC WORD + TLNE FS,20000 ;TEST BIS FLAG TO SEE IF LOSING INST WAS BYTE INST + SKIPA FS,BYTOFF ;SELECT APPROPRIATE OFFSET + MOVE FS,REGOFF + ADDB FS,.JBTPC ;ADD OFFSET TO PC WORD + ANDI FS,-1 ;GET RID OF FLAGS + MOVSI T,-LEGCNT +LOP1: CAME FS,LEGTAB(T) ;SEE IF LEGAL PC + AOBJN T,LOP1 + JUMPL T,MPVOK + OUTSTR [ASCIZ/ +Assembler error: Unexpected ILL MEM REF. at user PC = /] + PUSH P,FS + PUSH P,FS+1 + PUSHJ P,OCTTYO + POP P,FS+1 + POP P,FS + OUTSTR TTCRLF + PUSHJ P,TTYERP + OUTSTR [ASCIZ/Type any key to continue anyway: /] + PUSHJ P,WAIT +MPVOK: PUSHJ P,COEXP ;EXPAND CORE + MOVE FS,SV + MOVE T,SV+1 ;RESTORE + JRST 2,@.JBTPC ;& RETURN + +OCTTYO: IDIVI FS,10 + HRLM FS+1,(P) + JUMPE FS,.+2 + PUSHJ P,OCTTYO + HLRZ FS,(P) + ADDI FS,"0" + OUTCHR FS + POPJ P, + +>;NOTNX + +PDLOVI: MOVEI T,[ASCIZ /UNRECOGNIZABLE/] + JUMPL CP,.+2 + MOVEI T,[ASCIZ /COROUTINE/] + JUMPL M,.+2 + MOVEI T,[ASCIZ /MACRO/] + JUMPL P,.+3 +^PDLOV: MOVEI T,[ASCIZ /MAIN/] + ANDI P,-1 ;AVOID RECURSIVE PDLOVS + OUTSTR (T) + OUTSTR [ASCIZ / PDL OVERFLOW, CAN'T CONTINUE. +/] + JUMPL M,.+2 + OUTSTR [ASCIZ \USE /P TO EXPAND MACRO PDL +\] + JUMPL P,.+2 + OUTSTR [ASCIZ \USE /E TO EXPAND MAIN PDL +\] + PUSHJ P,LSTCHK ;MAKE SURE WE CAN TYPE LISTING BUFFER + PUSHJ P,TTYERP +TNX,< HALTF  JRST .-1> +NOTNX,< HALT . > + + + +TNX,< +^COEXP: MOVE T,.JBREL ;HERE TO EXPAND CORE - GET CURRENT END OF CORE + TRO T,1777 ;JUST TO BE ON PAGE BOUND ALWAYS + ADDI T,2000 + CAILE T,MXCOR ;WATCH BUFFERS AND DDT + JRST COERR ;REALLY? + MOVEM T,.JBREL ;MAINTAIN THE FICTION + POPJ P, + +^COERR: OUTSTR [ASCIZ / +Virtual memory is full. Can't continue. +/] + HALTF + JRST .-1 + +^WAIT: MOVEI 1,100 ;PRIMARY INPUT + CFIBF + PBIN ;WAIT + POPJ P, + +^CORINI:RESET ;WHY NOT? +^CORINX:MOVEI 1,400000 ;THIS FORK + MOVE 2,[LEVTAB,,CHNTAB] + SIR ;SET TABLE ADDR + EIR ;ENABLE SYSTEM + MOVE 2,[000400,,020000] ;PDLOV, NXPG + AIC ;ARM + POPJ P, + +;STORAGE FOR INTERRUPT SYSTEM +SVEADR: 0 ;EFFECTIVE ADDR OF ILLEGAL REFERENCE +^SVPCS: BLOCK 3 ;PC AT INTERRUPT TIME +^LEVTAB:SVPCS + SVPCS+1 + SVPCS+2 +^CHNTAB:BLOCK =9 + XWD 1,PDLOVI ;PDL OVERFLOW + BLOCK =12 + XWD 1,TSINT ;NXPG + BLOCK =9 + +^TSINT: MOVEM FS,SV ;SAVE + MOVEM T,SV+1 + MOVEI 1,400000 ;THIS FORK + GTRPW + TLNE 1,1 + JRST LEGREF ;MONITOR MODE IS SPURIOUS + HRRZ 2,1 ;EFFECTIVE ADDR OF OFFENDING WORD + MOVEM 2,SVEADR ;SAVE IT + CAMG 2,.JBREL + JRST LEGREF ;FIRST HIT ON ALLOCATED PAGE +IFN TOPS20,< CAIL 2,700000 ;IS THIS A REFERENCE TO IOSPACE? + JRST LEGREF >;YES, I HOPE. LET IT BE. + HRRZ FS,SVPCS ;ADDR OF OFFENDING INSTR +IFE TOPS20,< SUBI FS,1 > ;PC+1 ON TENEX +;DONT BELIEVE JSYS MANUAL ABOUT THAT TRAP WORD... + MOVSI T,-LEGCNT +LOP1: CAME FS,LEGTAB(T) ;SEE IF LEGAL PC + AOBJN T,LOP1 + JUMPL T,MPVOK + OUTSTR [ASCIZ/ +Assembler error: Unexpected ILL MEM REF. at user PC = /] + PUSH P,1 + PUSH P,2 + PUSH P,3 + HRRZ 2,FS ;ARGUMENT IN 2 + MOVEI 1,101 ;PRIMARY OUTPUT DEVICE + MOVE 3,[140006,,10] ;6 CHARACTERS, RADIX 8, LEADING 0 FILL + NOUT + JFCL + POP P,3 + POP P,2 + POP P,1 + OUTSTR TTCRLF + PUSHJ P,TTYERP + OUTSTR [ASCIZ/Type any key to continue anyway:/] + PUSHJ P,WAIT +MPVOK: MOVE T,SVEADR ;GET ADDRESS THAT WE MUST MAKE LEGAL + IORI T,1777 + CAILE T,MXCOR ;WITHIN MAX ALLOCATION OF VIRTUAL MEM? + JRST COERR ;NO. LOSE + MOVEM T,.JBREL ;SIMULATE THIS ADDRESS BEING LEGAL +LEGREF: MOVE FS,SV + MOVE T,SV+1 ;RESTORE + DEBRK ;DISMISS INTERRUPT + +>;TNX + +BEND NOFSL + SUBTTL CHARACTER TABLE FOR SCANNER + +CTAB: BLOCK 200 +CXTAB: 0 ;0 NULL + XWD SPCLF,UDARF!TP1F ;1 DOWN ARROW + XWD SPCLF,0 ;2 ALPHA + XWD SPCLF,0 ;3 BETA + XWD SPCLF!ARFL!ARMD,6 ;4 LOGICAL AND (CARET) + XWD SPCLF!ARFL!UNOF,12 ;5 LOGICAL NOT + XWD SPCLF,EPSF ;6 EPSILON + XWD SPCLF,0 ;7 PI + XWD SPCLF,0 ;10 LAMBDA + XWD SCRF!SPFL!SPCLF,5 ;11 TAB + XWD SPCLF!LNFD!SCRF,1 ;12 LINE FEED + XWD SPCLF,0 ;13 VERTICAL TAB + XWD SPCLF!SCRF!LNFD,7 ;14 FF (LOOKS SOMETHING LIKE LF) + XWD SPCLF!CRFG,6 ;15 CR (6 IS FOR LOUT) + XWD SPCLF,0 ;16 INFINITY + XWD ARFL!SPCLF!ARMD!ARMD1,10 ;17 PARTIAL (REMAINDER IN DIVISION) + XWD SPCLF,INF ;20 CONTAINMENT (OPEN HORSE SHOE) + XWD SPCLF,0 ;21 (CLOSE HORSE SHOE) + XWD SPCLF,0 ;22 SET INTERSECTION + XWD SPCLF,0 ;23 SET UNION + XWD SPCLF,0 ;24 FOR ALL + XWD SPCLF!ARFL!UNOF!ARMD1,12 ;25 THERE EXISTS - JFFO OPERATOR + XWD SPCLF!ARFL,4 ;26 CIRCLE TIMES + XWD SPCLF!LNFD!CRFG,2 ;27 DOUBLE ARROW. SIMULATE CRLF + XWD SNB!.FL!ENMF,'.' ;30 UNDERSCORE (LOOKS LIKE . IN SYMS) + XWD SPCLF,BSLF ;31 RIGHT ARROW + XWD SPCLF,UDARF!TP2F ;32 TILDA - SAME AS UPARROW + XWD SPCLF!ARFL!ARMD1,6 ;33 NOT EQUALS (XOR) + XWD SPCLF,0 ;34 LESS OR EQUAL + XWD SPCLF!ARFL!ARMD1,6 ;35 GREATER OR EQUAL (XOR) + XWD SPCLF,0 ;36 EQUIVALENCE + XWD SPCLF!ARFL,6 ;37 LOGICAL OR + XWD SCRF!SPCLF!SPFL,5 ;40 SPACE + XWD SPCLF!ARFL,6 ;41 ! LOGICAL OR + XWD SPCLF!SCRF!ENMF,2 ;" + XWD SPCLF,SHRPF ;# + XWD SNB!ENMF,'$' ;$ + XWD SNB!ENMF,'%' ;% + XWD SPCLF!ARFL!ARMD,6 ;& + XWD SPCLF!SCRF!ENMF,3 ;' + XWD SPCLF,LFPF ;( + XWD SPCLF,RTPF ;) + XWD SPCLF!ARFL,10 ;* + XWD SPCLF!ARFL,12 ;+ + XWD SPCLF,COMF ;, + XWD SPCLF!ARFL!ARMD!UNOF,12 ;- + XWD SNB!.FL!ENMF,'.' ;. + XWD ARFL!SPCLF!ARMD,10 ;/ + XWD SNB!NMFLG!ENMF,'0' ;0 + XWD SNB!NMFLG!ENMF,'1' ;1 + XWD SNB!NMFLG!ENMF,'2' ;2 + XWD SNB!NMFLG!ENMF,'3' + XWD SNB!NMFLG!ENMF,'4' + XWD SNB!NMFLG!ENMF,'5' + XWD SNB!NMFLG!ENMF,'6' + XWD SNB!NMFLG!ENMF,'7' + XWD SNB!NMFLG!ENMF,'8' + XWD SNB!NMFLG!ENMF,'9' + XWD SPCLF,LACF!TP2F ;: + XWD SPCLF!CRFG,2 ;; + XWD SPCLF!SCRF!ENMF!LBRF,10 ;WILL BE XWD SPCLF!ENMF!LBRF,LBCF!TP2F;< + XWD SPCLF!SCRF!ENMF,4 ;= + XWD SPCLF!SCRF!RBRF,11 ;WILL BE XWD SPCLF!RBRF,TP2F!RBCF;> + XWD SPCLF,UDARF!TP1F ;? SAME AS DOWN-ARROW + XWD SPCLF,ATF ;@ + XWD SNB!ENMF,'A' ;A + XWD SNB!ENMF!BFL,'B' ;B POSSIBLE BINARY SHIFTING + XWD SNB!ENMF,'C' ;C + XWD SNB!ENMF,'D' ;D + XWD SNB!ENMF!EFL,'E' ;E POSSIBLE EXPONENT IN FLOATING NUMBER +FOR I_'F','Z' + + XWD SPCLF!ENMF!LBRF,TP1F;[ + XWD SPCLF,BSLF ;\ + XWD SPCLF!RBRF,TP1F ;] + XWD SPCLF,UDARF!TP2F ;^ + XWD SPCLF,LACF!TP1F ;_ + XWD SPCLF,ATF ;140 ` SAME AS @ + XWD SNB!ENMF,'A' ;a + XWD SNB!ENMF!BFL,'B' ;b + XWD SNB!ENMF,'C' ;c + XWD SNB!ENMF,'D' ;d + XWD SNB!ENMF!EFL,'E' ;e + FOR I_'F','Z' + + XWD SPCLF!SCRF,10 ;WILL BE XWD SPCLF,LBCF!TP2F;{ + XWD SPCLF!ARFL!UNOF!ARMD!ARMD1,12 ;174 VERTICAL BAR - ABS OPERATOR + XWD SPCLF!SCRF,11 ;WILL BE XWD SPCLF,RBCF!TP2F;} + XWD SPCLF!SCRF,11 ;AS ABOVE + XWD SPCLF!SCRF!DLETF,0 ;DELETE + 0 +COMBTS__SCRF!SPCLF!ENMF!LBRF!RBRF!DLETF!LNFD ;OR OF BITS FOR LF DEL <>{} + BEGIN SCAN  SUBTTL SCANNER AND FRIENDS + + ;RETURNS WITH NEXT THING +;IF AN IDENTIFIER -- SIXBIT IN L +;IF A NUMBER -- VALUE IN N AND NA +;IF A SPC. CHR. -- BITS FOR CHR IN N +;IN ALL CASES, THE NEXT NON-BLANK CHR. AFTER THE +; THING RETURNED IS IN C AND ITS BITS ARE IN B. + +^SCAN: MOVEI L,1 ;PREPARE TO TEST FOR LINE NUM + TLZE SFL ;SHOULD WE RETURN CURRENT THING? + JRST AHEDW ;YES +LOOP3: ILDB C,INPNT ;GET CHR. +LOOP3A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING +^AHED: TDNE L,@INPNT ;LINE NUM? + JRST LNUM ;YES + SKIPL B,CTAB(C) ;GET BITS, IS IT NUM OR LET? +AHEDW: JUMPGE B,SPCRET ;NO + TLNE B,NMFLG ;NUM? + JRST NUMS ;YES. COLLECT NUMBER + HRRZ L,B ;IT'S A LETTER, PUT IN L +LOOP3B: ;here from DSCAN; ACT NORMAL +REPEAT 5,< ILDB C,INPNT ;GET NEXT + IDPB C,LSTPNT ;DEPOSIT FOR LIST + SKIPL B,CTAB(C) ;GET BITS + JSR NOLT ;NOT LET OR NUM + LSH L,6 + ORI L,(B) ;OR IN SIXBIT> +LOOP1: ILDB C,INPNT ;GET NEXT CHR. + IDPB C,LSTPNT ;DEPOSIT FOR LIST + SKIPL B,CTAB(C) ;GET BITS, LET OR NUM? + JSR NOLT ;NO + JRST LOOP1 ;YES,SKIP + +NOLT: 0 + JUMPN B,NOLT1 + JSP B,NULSKP + ILDB C,INPNT + IDPB C,LSTPNT + SKIPGE B,CTAB(C) + JRST @NOLT +NOLT1: TLNE B,SCRF ;SPC HANDLING? + XCT NOLB(B) ;YES + TLO SFL!IFLG ;SET 'SCAN AHEAD' AND 'IDENT' + TLZ NFLG!SCFL!FLTFL ;CLEAR NUM & SPC.CHR. + POPJ P, + +DEFINE EMPS (A) +< PUSHJ P,LBROK + JRST A> + + ;HERE TO SCAN NUMBERS +^RTEST: SNB!NMFLG!ENMF,,'8' ;Test for bad digits +NUMS: MOVEI N,-20(B) ;PUT VALUE IN N FIRST DIGIT + TRZ RWARN1!RWARN2 ;CLEAR DIGIT WARNINGS FOR BAD RADIX + CAML B,RTEST ;SKIP IF THIS DIGIT IS OK + TRO RWARN1 ;SET FIRST DIGIT IS BAD FLAG + SKIPA NA,FLTB-20(B) ;FLOATING VALUE ACCUMULATES IN NA +LOOP2A: JSP B,NULSKP +LOOP2: ILDB C,INPNT ;GET NEXT CHR. + IDPB C,LSTPNT +NLOP: SKIPL B,CTAB(C) ;GET BITS + JRST NONM ;NOT A LETTER OR A NUMBER + TLNN B,NMFLG ;NUM? + JRST NLET ;NO, LETTER FOLLOWS NUMBER (OR .) +^SRAD: LSH N,3 ;MULT BY RADIX (THIS GETS CLOBBERED) + ADDI N,-20(B) ;ADD IN THIS DIGIT + FMPR NA,[10.0] ;MULT FLOATING BY 10 + FADR NA,FLTB-20(B) ;ADD IN THIS DIGIT + TRNN RWARN1!RWARN2 ;IS EITHER WARNING SET? + CAML B,RTEST ;NO WARNING YET. SHOULD WE SET IT? + TRO RWARN2 ;YES. THIS IS DEFINITE MISTAKE. + JRST LOOP2 + +NLET: TLNE B,.FL ;LETTER FOLLOWS NUM. IS IT "."? + JRST DOT ;YES, DO FLOATING POINT THING + TLNE B,BFL ;B? + JRST BSH ;B-SHIFT OPERATOR + TLNE B,EFL ;E? + JRST EXP + ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/] +NONM: JUMPE B,LOOP2A ;NULL TYPE CHR? + TRNE RWARN2 ;NUMBER ERROR? + ERROR [ASCIZ/INCORRECT DIGITS FOR THIS RADIX/] +NONM1: TLNE B,SCRF ;SPC HAND? + XCT NOTB(B) ;YES + MOVEI NA, + TLO SFL!NFLG ;SET 'AHEAD' AND NUM + TLZ SCFL!IFLG!FLTFL ;CLEAR SPC,CHR & IDENT + POPJ P, + +FLTB: DEC 0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0 + +NOTB: JRST NOND + PUSHJ P,LSTLF + JFCL + JFCL + JFCL + JSR SPCSKP + JFCL + PUSHJ P,NEWPAG + EMPS BNOTB + +BNOTB: PUSHJ P,RTBFND + JRST NONM + JRST LOOP2 + +NOND: DELHN + JRST NLOP + +EQLS: PUSHJ P,SCAN1 ;PEEK AHEAD + CAIE C,74 ;POINTED BRACKET? + JRST EQLS1 ;NO + MOVEI N,12 + MOVEM N,DHRADX ;SAVE FOR HACK RADIX + PUSHJ P,SPCRET ;MAKE IT LOOK REAL + JRST XSCANS ;TIE THE STACK IN KNOTS! + +EQLS1: TLO SFL ;MAKE SURE WE SCAN THIS AGAIN + PUSH P,SRAD ;SAVE CURRENT RADIX + PUSH P,RTEST + MOVE N,[IMULI N,12] ;SET TO 10... + MOVEM N,SRAD ;... + MOVE N,CTAB+"0" + ADDI N,12 + MOVEM N,RTEST + PUSHJ P,SCAN ;SCAN NUMBER + POP P,RTEST + POP P,SRAD ;RESTORE RADIX + TLNN NFLG ;WAS A NUMBER SEEN? + ERROR [ASCIZ/NOT A NUMBER AFTER EQUALS/] + POPJ P, + + ;HERE TO DO FLOATING POINT NUMBERS + +DOT: MOVE N,NA ;GET FLOATING NUM SO FAR + SKIPA NA,[1.0] ;Accumulate divisor +LOOP5A: JSP B,NULSKP +LOOP5: ILDB C,INPNT ;GET NEXT + IDPB C,LSTPNT ;DEPOSIT +DNLOP: SKIPL B,CTAB(C) ;GET BITS + JRST DNONM ;NOT NUM - Do DIVISION + TLNN B,NMFLG ;NUM? + JRST DNLET ;NO,LETTER + FMPR N,[10.0] ;ACCUMULATE NEW DIGIT + FADR N,FLTB-20(B) + FMPR NA,[10.0] ;And accumulate divisor + JRST LOOP5 + +DNLET: FDVR N,NA ;DIVIDE TO ADJUST FRACTION DIGITS + TLNE B,EFL ;E? + JRST EXP1 ;YES + ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/] + JRST DNONM2 ;some ordinary letter has been seen + +EXP: MOVE N,NA ;GET FLOATING VERSION +EXP1: PUSHJ P,SCAN1 ;GET NEXT CHR. + MOVEI NA,EXT1 + HRRM NA,EXTP + TLNN B,UNOF ;- OR NOT (TREAT BOTH THE SAME)? + JRST PT5 ;NO + MOVEI NA,EXT2 ;YES, HANDLE... + HRRM NA,EXTP ;... + PUSHJ P,SCAN1 ;GET NEXT +PT5: TLNN B,NMFLG ;NUM? + ERROR [ASCIZ/NO NUM AFTER E/] + MOVEI NA,-20(B) ;GET VALUE + PUSHJ P,SCAN1 ;GET NEXT + TLNN B,NMFLG ;NUM? + JRST PT6 ;NO + ADDI NA,12 ;SECOND HALF OF TABLE + FMPR N,@EXTP ;SCALE + MOVEI NA,-20(B) ;GET VALUE + PUSHJ P,SCAN1 ;GET NEXT +PT6: FMPR N,@EXTP ;SCALE + TLNE B,NMFLG + ERROR [ASCIZ/TOO MANY NUMS AFTER E/] + JRST DNONM2 ;anything special already done by SCAN1 + +DNONM: JUMPE B,LOOP5A ;NULL TYPE? +DNONM1: TLNE B,SCRF ;SPECIAL AHNDLE? + XCT DNOTB(B) ;YES, HANDLE + FDVR N,NA ;DIVIDE TO ADJUST FRACTION DIGITS +DNONM2: MOVSI NA,FLTFL ;SET AS FLOATING + TLO SFL!NFLG!FLTFL ;SET NUM&FLOATING & AHEAD + TLZ IFLG!SCFL ;CLEAR SPC CHR. & IDENT + POPJ P, + +DNOTB: JRST DNDH ;DELETE + PUSHJ P,LSTLF ;LF + JFCL + JFCL + JFCL + JSR SPCSKP + JFCL + PUSHJ P,NEWPAG + EMPS BDNOTB + +BDNOTB: PUSHJ P,RTBFND + JRST DNONM1 + JRST LOOP5 + +DNDH: DELHN + JRST DNLOP + +EXTP: XWD NA,EXT1 +EXT1: 1.0 + 10.0 + 100.0 + 1000.0 + 10000.0 + 100000.0 + 1000000.0 + 10000000.0 + 100000000.0 + 1000000000.0 + 1.0 + 1.0E10 + 1.0E20 + 1.0E30 + 1.0E40 + 1.0E50 + 1.0E60 + 1.0E70 + 1.0E80 + 1.0E90 + +EXT2: 1.0 + 0.1 + 0.01 + 0.001 + 0.0001 + 0.00001 + 0.000001 + 0.0000001 + 0.00000001 + 0.000000001 + 1.0 + 1.0E-10 + 1.0E-20 + 1.0E-30 + 1.0E-40 + 1.0E-50 + 1.0E-60 + 1.0E-70 + 1.0E-80 + 1.0E-90 + + ;DSCAN, DSCANM, DSCANS +;DSCAN HANDLE ^D69, etc, CALLED TO SIMULATE SCANS,SCANM, and SCAN + +DHTBL: 10,,'O' + 12,,'D' + 2,,'B' +DHTBLN==.-DHTBL + +;SCAN ALLOWING ^D89 for instance. ^ SEEN ALREADY. NEXT MUST +;BE EITHER: ^, an identifier and colon, or one of the special forms +^DSCANS:PUSHJ P,DSCANM ;SIMULATE CALL TO SCANM + TLNE N,LBRF ;WAS EITHER [ or < SEEN? + TLNN SCFL ;SPECIAL CHARACTER? + JRST SCANS1 ;NOT SPECIAL + SKIPE DHACK ;SKIP IF ORDINARY RETURN FROM DSCAN + TRNE N,TP1F ;< SEEN? + JRST SCANS1 ;NOPE. IT WAS [ +^XSCANS:PUSH P,SRAD ;ENTER HERE FROM SCANS IF SPECIAL FLAG + PUSH P,RTEST + MOVSI TAC,() + HRR TAC,DHRADX + MOVEM TAC,SRAD + ADDI TAC,'0' + HRRM TAC,RTEST + PUSHJ P,SCANS1 + POP P,RTEST + POP P,SRAD + POPJ P, + +DSCANM: PUSHJ P,DSCAN ;SIMULATION OF SCANM + TLNN IFLG ;IDENT SEEN? + POPJ P, ;NOPE + JRST SCANM1 ;LET THE REAL SCANM TAKE OVER + + +DSCAN: SETZM DHACK# ;ASSUME NORMAL + TLZE SFL ;SHOULD WE RETURN CURRENT THING? + JRST DAHDW +DSLP3: ILDB C,INPNT ;GET CHR. +DSLP3A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING + SKIPL B,CTAB(C) ;GET BITS, IS IT NUM OR LET? +DAHDW: JUMPGE B,SPCRET ;NO + TLNE B,NMFLG ;NUM? + JRST NUMS ;YES. COLLECT NUMBER ERROR! + HRRZ L,B ;IT'S A LETTER, PUT IN L + MOVSI B,-DHTBLN + HRRZ C,DHTBL(B) + CAME C,L + AOBJN B,.-2 + JUMPGE B,LOOP3B ;NOT A SPECIAL LEAD IN CHR. + HLRZ C,DHTBL(B) + MOVEM C,DHRADX# ;RADIX TO ACCUMULATE WITH + SETOM DHACK ;ASSUME WE HAVE A CHANCE + MOVEI NA,0 ;ACCUMLATE SLUDGE HERE +REPEAT 5,< + ILDB C,INPNT ;GET NEXT + IDPB C,LSTPNT ;DEPOSIT FOR LIST + SKIPL B,CTAB(C) ;GET BITS + JSR DSNOLT ;NOT LET OR NUM + LSH L,6 + ORI L,(B) ;OR IN SIXBIT + TLNN B,NMFLG ;NUMBER? + SETZM DHACK ;NO. GIVE UP + MOVEI B,-'0'(B) ;REDUCE CHARACTER TO NUMBER + CAML B,DHRADX ;LESS THAN CURRENT RADIX? + SETZM DHACK ;no give up + IMUL NA,DHRADX + ADDI NA,(B) +> +DSLP1: ILDB C,INPNT ;GET NEXT CHR. + IDPB C,LSTPNT ;DEPOSIT FOR LIST + SKIPL B,CTAB(C) ;GET BITS, LET OR NUM? + JSR DSNOLT ;NO + TLNN B,NMFLG ;NUMBER? + SETZM DHACK ;NO. GIVE UP + MOVEI B,-'0'(B) ;REDUCE CHARACTER TO NUMBER + CAML B,DHRADX ;LESS THAN CURRENT RADIX? + SETZM DHACK ;no give up + IMUL NA,DHRADX + ADDI NA,(B) + JRST DSLP1 + +DSNOLT: 0 + JUMPN B,DSNLT1 + JSP B,NULSKP + ILDB C,INPNT + IDPB C,LSTPNT + SKIPGE B,CTAB(C) + JRST @DSNOLT +DSNLT1: TLNE B,SCRF ;SPC HANDLING? + XCT DSNOLB(B) ;YES +;NOW, IF NEXT CHARACTER IS A COLON, LEFT ARROW, OR EQUALS, THEN +;WHAT WE'VE PARSED IS AN IDENTIFIER. IF DHACK IS ZERO, WE +;PARSED AN IDENTIFIER (AND ERROR IS HAPPENING). OTHERWISE, +;WE HAVE A NUMBER, EXCEPT, IF THE IDENTIFIER WE HAVE IS ONE +;LETTER LONG AND TERMINATES WITH AN OPEN BROKET, WE ARE SETTING +;THE RADIX WHILE A COMPLEX ATOM IS PARSED. + SKIPE DHACK + TRNE B,LACF ;COLON OR LEFT-ARROW OR EQUAL? + JRST DSNIDN ;RETURN AN IDENTIFIER + TRNE B,LBCF ;BROKET SEEN? + JRST DSNBRK ;YES. HANDLE IT. +DSNNUM: MOVE N,NA + MOVEI NA,0 + TLO SFL!NFLG + TLZ SCFL!IFLG!FLTFL + POPJ P, + +DSNBRK: TRNE L,7700 ;ONE CHARACTER ONLY IN NAME? ^D<23*3> + JRST DSNNUM ;NO. DO YOUR WORST. + TLZ NFLG!FLTFL!IFLG + TLO SCFL!SFL + MOVE N,B ;RETURN FLAGS IN N (LIKE SPCRET) + JSR SPCSKP + POPJ P, ;RETURN SPECIAL CHARACTER + + +DSNIDN: TLO SFL!IFLG ;SET 'SCAN AHEAD' AND 'IDENT' + TLZ NFLG!SCFL!FLTFL ;CLEAR NUM & SPC.CHR. + POPJ P, + +DSNOLB: JRST DSNOLD ;DEL + PUSHJ P,LSTLF ;LF + JFCL ;" + JFCL ;' + MOVE B,CTAB+"_" ;MAKE = LOOK LIKE _ AFTER SYMS + JSR SPCSKP ;SP or TAB + JFCL ;unknown + PUSHJ P,NEWPAG ;FF + PUSHJ P,LBROK ;Handle open broket or brace + JRST DBNOLB ;Handle close broket or brace + +DBNOLB: PUSHJ P,RTBFND + JRST DSNOLT+1 + ILDB C,INPNT + IDPB C,LSTPNT + SKIPL B,CTAB(C) + JRST DSNOLT+1 + JRST @DSNOLT + +DSNOLD: DELHN + SKIPL B,CTAB(C) + JRST DSNOLT+1 + JRST @DSNOLT + + ^SPCSKP:0 ;skip until non blank + PUSH P,L + MOVEI L,1 +SPCCN1: ILDB C,INPNT ;GET NEXT +SPCCN2: IDPB C,LSTPNT ;DEPOSIT +SPCCN3: XCT AHED + JRST [JSR SLNUM + JRST SPCCN1] + SKIPGE B,CTAB(C) ;GET BITS + JRST SPCKRT ;NNUM OR LET +SPCCON: JUMPE B,SPCNUL + TLNE B,SCRF ;SPC. HAND? + XCT SPKT(B) ;YES +SPCKRT: POP P,L + JRST @SPCSKP + +SPCNUL: JSP B,NULSKP + JRST SPCCN1 + JRST SPCCN2 + +SPKT: JRST SPCDEL + JFCL + JFCL + JFCL + JFCL + JRST SPCCN1 + JFCL + JFCL + EMPS BSPKT + +BSPKT: PUSHJ P,RTBFND + JRST SPCKRT + JRST SPCCN1 + +SPCDEL: DELHN + JRST SPCCN3 + +SPCRET: JUMPE B,LOOP3Q ;IGNORE CHR? + TLNE B,SCRF ;DOES THIS CHR REQUIRE SPEC. ATT. BY SCAN? + XCT SPCTB(B) ;YES, HANDLE +SPCRT2: TLZ IFLG!NFLG!FLTFL ;CLEAR IDENT ,NUM + TLO SCFL!SFL ;SET SPC CHR,AHEAD + MOVE N,B ;PUT BITS IN N + JSR SPCSKP ;SKIP TO NEXT NON-BLANK CHR. + POPJ P, + +LOOP3Q: JSP B,NULSKP + JRST LOOP3 + JRST LOOP3A + +NULSKP: JUMPN C,(B) ;IF NOT A NULL +NULSK1: SKIPE @INPNT ;ZERO WORD? + JRST LOOP3Z ;NO + MOVSI TAC,700 ;SKIP REST OF WORD + HRR TAC,INPNT ;AND PREPARE TO SKIP MORE + SKIPN 1(TAC) + AOJA TAC,.-1 + MOVEM TAC,INPNT +LOOP3Z: ILDB C,INPNT ;NO, A NULL, GET NEXT + JUMPE C,NULSK1 ;SKIP NULLS IN TAIL OF WORD/TMW + JRST 2,@[20000,,1(B)] ;SET BIS & GO TO IDPB FOR LISTING + BSPCTB: PUSHJ P,RTBFND + JRST SPCRET + JRST LOOP3 + +^BROKCT:0 + +LBROK: HRRI B,LBCF!TP2F + TLZ B,SCRF + AOS BROKCT + POPJ P, + +SPCTB: JRST DELT ;DELETE -- HANDLE + PUSHJ P,LSTLF ;HANDLE LINE FEED + JRST DQT ;HANDLE DOUBLE QUOTE + JRST SQT ;HANDLE SINGLE QUOTE + JRST EQLS ;HANDLE = + JRST LOOP3 ;SKIP SPACES + JFCL + PUSHJ P,NEWPAG + EMPS BSPCTB + ^RTBFND:HRRI B,TP2F!RBCF + TLZ B,SCRF + SKIPN RTFLST ;ANY TO CHECK? + POPJ P, ;NO + PUSH P,N ;SAVE + MOVE N,BROKCT ;GET CURRENT COUNT + CAMN N,@RTFLST ;SAME? + JRST RFNDQ ;YES + SOS BROKCT ;NO, DECREMENT COUNT AND RETURN + POP P,N + POPJ P, + +RFNDQ: PUSH P,L + MOVE L,RTFLST ;GET POINTER + MOVE N,FSTPNT ;PUT THIS ONE... + EXCH N,1(L) ;BACK ON FREE STRG. + MOVEM L,FSTPNT ;... + MOVEM N,RTFLST ;... + SOS BROKCT ;DECREMENT COUNT + POP P,L + POP P,N + JRST CPOPJ1 ;SKIP REUTRN + + ;HANDLE SOS LINE NUMBERS, PAGE MARKS. +LNUM: JSR SLNUM + JRST LOOP3 + + ;WE GET HERE AND WE'VE IDPB'D INTO LSTPNT +^SLNUM: 0 ;SKIP LINE NUMBERS OR PAGE MARKS + CAIGE C,60 ;NUMBER? + JRST POPMK ;NO. THIS MUST BE A PAGE MARK +LNMC: MOVE C,@INPNT + MOVEM C,TLBLK + MOVEM C,SVLNUM + AOS INPNT ;SKIP LINE NUM WD + SKIPL @INPNT ;SEE IF WE RAN OFF BUFFER (RUBOUT WD WILL BE NEG) + JRST .+3 ;STILL IN BUFFER + PUSHJ P,INP ;GET NEXT BUFFER + IBP INPNT ;AND SKIP TAB + MOVEI C,0 + DPB C,LSTPNT ;NULL OUT THAT SPURIOUS DIGIT + JRST @SLNUM + +POPMK: MOVE C,[ASCID/ /] + CAME C,@INPNT ;PAGE MARK? + JRST LNMC ;NO + AOS INPNT ;SKIP FIRST PAGE MARK WD + SKIPGE @INPNT + PUSHJ P,INP ;READ ANOTHER BUFFER IF NEEDED + AOS INPNT ;SKIP SECOND PAGE MARK WD + MOVSI C,440700 + HLLM C,INPNT + TRNE LDEV ;MAKE SURE THERE IS A LIST DEV + SKIPN XPNDSW ;AND THAT WE HAVE NOT SAID XLIST + TDZA C,C + MOVEI C,14 ;IN THAT CASE WE WILL MAKE A PAGE HEADING + DPB C,LSTPNT ;NULL (OR FF) OUT THAT SPACE. + PUSH P,SLNUM ;PREPARE TO RETURN +^NEWPAG:SKIPL AHED ;DON'T UPDATE THESE CELLS IF TEXT IS FROM MACRO + JRST LSTFRC + SETZM INLINE + AOS PGNM + SETZM SPGNM + JRST LSTFRC + + NOLD: DELHN + SKIPL B,CTAB(C) + JRST NOLT+1 + JRST @NOLT + +DELT: DELHN + JRST AHED + +^DELTAB:PUSHJ P,INPDT ;GET NEXT BUFFER (SOMETIMES DOES: IBP LSTPNT) + PUSHJ P,GETARG ;GO TO MACRO ARGUMENT + POP M,INPNT ;LEAVE ARGUMENT + PUSHJ P,LVMAC ;LEAVE MACRO + PUSHJ P,LVREP ;LEAVE REPEAT + PUSHJ P,LVFORL ;LEAVE NUMERIC FOR + PUSHJ P,LVFORI ;LEAVE "IN" FOR + PUSHJ P,EFORSH ;LEAVE "E" FOR + DEFINE QUOT ' (M) +< MOVEI L,1 + SETZB N,NA +QP'M: ILDB C,INPNT +QQ'M: IDPB C,LSTPNT +QT'M: XCT AHED + JRST [JSR SLNUM + JRST QP'M] + JUMPE C,QN'M + MOVE B,CTAB(C) + TLNE B,SCRF + XCT SCQT'M(B) +QU'M: +IFE M,< TRZN C,100 + TRZA C,40 + TRO C,40> + LSH N,6+M + OR N,C + JRST QP'M + +BSCQT'M:PUSHJ P,RTBFND + JRST QU'M + JRST QP'M + +QN'M: JSP B,NULSKP + JRST QP'M + JRST QQ'M +> + + +SCQT1: JRST DH1 + PUSHJ P,LSTLF + JRST SCR1 + JFCL + JFCL + JFCL + JFCL + PUSHJ P,NEWPAG + EMPS BSCQT1 + +SCQT0: JRST DH0 + PUSHJ P,LSTLF + JFCL + JRST SCR0 + JFCL + JFCL + JFCL + PUSHJ P,NEWPAG + EMPS BSCQT0 + +DQT: QUOT(1) + + DEFINE QUOTS ' (A) + + + QUOTS(1) +SQT: QUOT(0) + QUOTS(0) + NOLB: JRST NOLD + PUSHJ P,LSTLF + JFCL + JFCL + MOVE B,CTAB+"_" ;MAKE = LOOK LIKE _ AFTER SYMS + JSR SPCSKP + JFCL + PUSHJ P,NEWPAG + EMPS BNOLB +BNOLB: PUSHJ P,RTBFND + JRST NOLT+1 + ILDB C,INPNT + IDPB C,LSTPNT + SKIPL B,CTAB(C) + JRST NOLT+1 + JRST @NOLT + + BSH: TRNE RWARN2 + ERROR [ASCIZ/INCORRECT DIGITS FOR THIS RADIX/] + PUSH P,N ;SAVE THE NUMBER WE HAVE SO FAR + PUSH P,SRAD ;CONVERT RADIX FOR NUMBERS TO =10 + PUSH P,RTEST + MOVE N,[IMULI N,=10] + MOVEM N,SRAD + MOVE N,CTAB+"0" + ADDI N,12 + MOVEM N,RTEST + MOVEI N,1(P) + BLT N,4(P) ;SAVE 0,1,2,3 ON STACK + ADD P,[4,,4] + TDO [OPFLG,,NOFXF] ;NO OPCODE LOOKUP, NO FIXUPS WANTED + PUSHJ P,SCANS ;EVALUATE ARGUMENT FOLLOWING THE B + TLNN UNDF!ESPF + TRNE NA,17 + PUSHJ P,BSH1 + MOVSI NA,-3(P) ;RESTORE ACS + BLT NA,3 + SUB P,[4,,4] + MOVN NA,N ;GET THE SHIFT FACTOR + POP P,RTEST + POP P,SRAD + POP P,N ;THE ORIGINAL NUMBER + LSH N,=35(NA) + JRST NONM1 + +BSH1: ERROR [ASCIZ/Undefined B-Shift argument - taken as 0/] + MOVEI N,0 + POPJ P, + ; LEAVE MACRO, REPEAT, LVMAC,LVREP,GETARG + +LVMAC: POP M,C ;GET OLD MTBPNT + JUMPE C,LVNO ;NO ARGS? + POP M,B ;GET OLD NEW MTBPNT + PUSHJ P,MACRET + SKIPA +LVNO: SUB M,[1(1)] + POP M,INPNT ;SET SCAN POINTER BACK + POP M,INPNTP + +;THIS IS SUPPOSED TO ADD A CLOSE CHARACTER AFTER THE MACRO EXPANSION +;UNFORTUNATELY, IT ALSO CAUSES THE CLOSE CHARACTER TO BE UNDERLINED. + MOVEI C,IFN STANSW,<"";>"^" ;INDICATE END OF MACRO ON LISTING + DPB C,LSTPNT ;STUFF A BYTE + IBP LSTPNT ;ACCOUNT FOR THE CLOSING CHARACTER + + POP M,C ;RESTORE CHR. SIZE FOR LISTING + DPB C,[POINT 6,LSTPNT,11] + HRRZM C,XPNDSW + HLRZM C,INMCSW + POP M,C + MOVEM C,AHED + MOVEM C,LOOP6 + SKIPE UNDLNS ;UNDERLINING? + SKIPE NOEXP ;NO EXPAND? + JRST ARNMC ;NO + SKIPN INMCSW ;IN A MACRO? + JRST ARNMC ;YES + HRR C,LSTPNT + ADDI C,TLBLK-MBLK ;GO BACK TO NORMAL POINTER + HRRM C,LSTPNT +ARNMC: POP M,C ;GET CHR. + JRST CPOPJ1 ;SKIP NEXT ILDB + +GETARG: ILDB C,INPNT ;GET ARG # + ADD C,(M) ;GET POINTER + PUSH M,INPNT ;SAVE OLD PNTR. + MOVE C,(C) + MOVEM C,INPNT + POPJ P, + +LVREP: SOSG -1(M) ;DECREMENT COUNT + JRST LRDON ;DONE + MOVE C,(M) ;GET... + HRLI C,440700 ;POINTER + MOVEM C,INPNT + POPJ P, + +LRDON: POP M,C ;GET POINTER + SUB M,[1(1)] + POP M,B ;GET OLD NEW MTBPNT + PUSHJ P,MACRET +ALDON: PUSHJ P,LSTCHK ;A GOOD PLACE TO CATCH LOSSAGE FROM MOBY LINES + POP M,INPNT ;RESTORE SCAN POINTER + POP M,INPNTP + POP M,C ;RESTORE... + DPB C,[POINT 6,LSTPNT,11] ;LISTING + HRRZM C,XPNDSW + HLRZM C,INMCSW + POP M,C + MOVEM C,AHED ;RESTORE LINE NUM SKIPPING + MOVEM C,LOOP6 + SKIPE UNDLNS ;UNDERLINING? + SKIPE NOEXP ;NO EXPAND? + POPJ P, + SKIPN INMCSW ;IN A MACRO? + POPJ P, + HRR C,LSTPNT + ADDI C,TLBLK-MBLK + HRRM C,LSTPNT + POPJ P, + ; LVFORL, LVFORI, EFORSH + +LVFORL: MOVE B,-4(M) ;GET INCREMENT + ADDB B,-2(M) ;ADD NUM + SKIPG -4(M) ;NEG INCREMENT? + JRST NTST ;YES + CAMLE B,-3(M) ;DONE? + JRST LFDON ;YES +NLFD: MOVE C,(M) ;GET ARG POINTER + ADD C,[XWD 440700,2] + PUSHJ P,BKSLSH ;CON TO ASCII + EDEPO (B,C,2) ;DEPOSIT END OF ARG + MOVE B,-1(M) ;GET START + ADD B,[XWD 440700,2] + MOVEM B,INPNT + JRST LSTCHK + +NTST: CAML B,-3(M) ;DONE? (NEGATIVE INCREMENT) + JRST NLFD ;NO +LFDON: HRRZ C,-1(M) ;GET START OF THROW-AWAY + SUB M,[5(5)] + POP M,B ;GET OLD NEW MTBPNT + PUSHJ P,MACRET + JRST ALDON + +LVFORI: MOVE B,(M) ;GET ARG POINTER + MOVE B,1(B) ;GET POINTER + ILDB C,B ;GET FIRST CHR. OF SECOND ARG + CAIE C,177 ;IS IT DELETE? + JRST IFORSH ;NO, GET NEXT ARG SETUP + SUB M,[2(2)] ;YES, NO MORE ITERATIONS + POP M,C ;GET START OF THROW-AWAY + POP M,B ;GET OLD NEW MTBPNT + PUSHJ P,MACRET + JRST ALDON + +^EFORSH:MOVE B,(M) ;GET ARG POINTER + ILDB C,1(B) ;GET NEXT CHR. + MOVE B,(B) ;GET FIRST ARG POINTER + IDPB C,B ;DEPOSIT CHR. + CAIN C,177 ;DONE? + JRST DYES ;YES + MOVE B,-1(M) ;GET TEXT POINTER + MOVEM B,INPNT ;DEPOSIT + JRST LSTCHK + +DYES: POP M,C ;GET STRT OF REMOVABLE AREA + SUBI C,2 ;ADJUST + SUB M,[1,,1] ;ADJUST STACK + POP M,B ;END OF REMOVABLE AREA + PUSHJ P,MACRET + JRST ALDON ; + SUBTTL SCAN1,SCNTIL, SCANM + +^SCAN1: TLZE SFL ;AHEAD? + JRST S1PT ;YES +^SCAN1A:MOVEI L,1 ;PREPARE TO TEST FOR LINE NUM +LOOP4: ILDB C,INPNT ;GET CHR. +LOOP4A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING +^LOOP6: TDNE L,@INPNT ;LINE NUM? + JRST [JSR SLNUM + JRST LOOP4] + SKIPN B,CTAB(C) ;GET BITS, NULL CHR? + JRST LOOP4Q ;YES, NULL CHR. +S1PT: TLNE B,SCRF ;SPECIAL HANDLING? + XCT SC1T(B) ;YES, HANDLE + POPJ P, + +LOOP4Q: JSP B,NULSKP + JRST LOOP4 + JRST LOOP4A + +SC1T: JRST SC1DH + PUSHJ P,LSTLF + JFCL + JFCL + JFCL + JFCL + JFCL + PUSHJ P,NEWPAG + EMPS BSC1T + +BSC1T: PUSHJ P,RTBFND + POPJ P, + JRST LOOP4 + +SC1DH: DELHN + JRST LOOP6 + ^SCNTIL:TLZE SFL ;AHEAD? + JRST LOPP3 ;YES +LOPP1: ILDB C,INPNT ;GET CHR. +LOPP1A: IDPB C,LSTPNT ;DEPOSIT +LOPP2: SKIPN B,CTAB(C) ;GET BITS + JRST LOPP1Q ;NULL CHR +LOPP3: TLNE B,SCRF ;SPECIAL? + XCT STTB(B) ;YES + MOVSI B,777777-COMBTS ;WATCH US SKIP COMMENTS FAST + MOVE TAC,INPNT +LOP69: +REPEAT 5,< ILDB C,TAC + IDPB C,LSTPNT + TDNN B,CTAB(C) + JRST LOP105 > + JRST LOP69 + +LOP105: MOVEM TAC,INPNT + JRST LOPP2 + +LOPP1Q: JSP B,NULSKP + JRST LOPP1 + JRST LOPP1A + +STTB: JRST STDH ;DELETE + JRST LSTLF ;LINE FEED, FORCE LISTING AND RETURN + JFCL + JFCL + JFCL + JFCL + JFCL + JRST NEWPAG ;FORM FEED, ADVANCE PAGE AND RETURN + EMPS BSTTB + +BSTTB: PUSHJ P,RTBFND + JRST LOPP1 + JRST LOPP1 + +STDH: DELHN + JRST LOPP2 + ^SLURP: PUSH P,BROKCT ;ROUTINE TO EAT TEXT UP TO MATCHING BROKET + SETZM BROKCT + JSP TAC,SLRP0 + SOSL BROKCT + JRST SLRP1 + POP P,TAC + ADDM TAC,BROKCT + POPJ P, + +^SLURPC:MOVE TAC,CTAB(C) ;EATS TEXT UP TO MATCHING CHAR + TLNN TAC,777777-COMBTS + TLNN TAC,SCRF + JRST .+3 + ERROR [ASCIZ /ILLEGAL DELIMETER/] + POPJ P, + PUSH P,TAC + HRLOI TAC,SCRF ;-1 INDEX MEANS EXIT VIA SLRPX + MOVEM TAC,CTAB(C) + TLZ SFL + JSP TAC,SLRP0 + PUSHJ P,RTBFND + JRST SLRP1 + JRST SLRP1 + +SLRP0: HRRM TAC,SRBINS + MOVEI L,1 ;FOR LINE NUMBER TEST + TLZE SFL + JRST SLRP2 +SLRP1: ILDB C,INPNT +SLRP1A: IDPB C,LSTPNT +SLRP2: XCT AHED ;TEST FOR LINE NUMBER IF APPROPRIATE + JRST [JSR SLNUM ;FLUSH LINE NUMBER (SPECIAL) + JRST SLRP1] + SKIPN B,CTAB(C) + JRST SLRPN +SLRP3: TLNE B,SCRF + XCT SLTB(B) + MOVSI B,777777-COMBTS ;PREPARE TO IGNORE ALMOST EVERYTHING + MOVE TAC,INPNT +SLRP4: +REPEAT 5,< + ILDB C,TAC + IDPB C,LSTPNT + TDNN B,CTAB(C) + JRST SLRP5 +> + JRST SLRP4 + +SLRP5: MOVEM TAC,INPNT + JRST SLRP2 + +;XCT TABLE FOR SPECIAL CHARACTER DISPATCH + JRST SLRPX ;EXIT FROM SLURPC RESTORE CTAB +SLTB: JRST SLDH + JRST [PUSHJ P,LSTLF ;FORCE LISTING NOW + JRST SLRP1] + REPEAT 7-2, + PUSHJ P,NEWPAG + AOS BROKCT +SRBINS: JRST .-. ;ADDRESS GETS CLOBBERED + + +SLRPN: JSP B,NULSKP + JRST SLRP1 + JRST SLRP1A + +SLDH: DELHN + JRST SLRP2 + +SLRPX: POP P,B + MOVEM B,CTAB(C) + POPJ P, + ;SCANM HERE FOR SCAN IF MACROS ARE TO BE EXPANDED +;SCANM1 alternate entry from DSCANM +^SCANM: PUSHJ P,SCAN + TLNN IFLG ;IDENTIFIER? + POPJ P, ;NO +SCANM1: MOVE N,L ;GET SIXBIT + IDIVI N,HASH ;HASH + MOVMS NA + SKIPN TAC,MACRT(NA) ;GET START OF MACRO TABLE CHAIN + POPJ P, ;NONE THERE. + SRC1(L,TAC,SCNMF,) ;SEARCH FOR THIS IDENT AS A MACRO +SCNMF: MOVEI NA,(TAC) ;NA=SYMBOL BLOCK FOR THIS MACRO + SKIPN N,3(NA) ;ANY ARGS? + JRST NOAG ;NO + JUMPL N,SCNMPO ;JUMP IF MACRO "PSEUDO OP" (IFs, ".", .FNAM1, ETC) + PUSH P,NA ;SAVE POINTER TO MACRO SYMBOL ENTRY + PUSH P,MTBPNT ;SAVE ARGUMENT POINTER + PUSHJ P,ARGIN ;GET ARGUMENTS + JUMPN C,.+2 + IBP LSTPNT + POP P,N ;GET POINTER TO THE ARGUMENT LIST + HRRZM NA,MTBPNT ;DEPOSIT NEW POINTER TO MACRO FREE SPACE + POP P,NA ;RESTORE POINTER TO MACRO SYMBOL ENTRY +NOAG: SKIPE XCRFSW ;CREF IN PROGRESS RIGHT NOW? + JRST [CAIN NA,%IOWD ;YES. IS THE IOWD PREDEFINED MACRO? + CREF7 5,(NA) ;YES. IOWD. CREF IT AS AN OPCODE/PSEUDO-OP + CAIE NA,%IOWD + CREF6 5,(NA) ;OTHERWISE CREF IT AS A MACRO + JRST .+1] + PUSH M,C ;SAVE CHR. +; TRNE B,LBCF!RBCF ;DID WE FUCK UP BROKCT? +; JRST [ TRNE B,LBCF +; SOSA BROKCT +; AOS BROKCT +; JRST .+1] + PUSH M,AHED ;SAVE STATE OF LINE NUMBER LOOKING FOR + LDB C,[POINT 6,LSTPNT,11] ;SAVE STATE... + HRL C,INMCSW ;IN MACRO &... + PUSH M,C ;INSIDE MACRO FLAG,,STATE OF LISTING + PSHPNT (C) ;SAVE SCAN POINTER, ETC + PUSH M,MTBPNT + PUSH M,N ;DEPOSIT ARG POINTER + TLZ SFL ;CLEAR "SCAN AHEAD" +IFN STANSW,< MOVEI N,"";>MOVEI N,"^" + DPB N,LSTPNT ;ERASE LAST CHR IN LISTING + MOVEI N, + SKIPE NOEXP ;NO MACRO EXPAND? + DPB N,[POINT 6,LSTPNT,11] ;YES,DISCONTINUE LISTING + SKIPE NOEXP + SETZM XPNDSW + SETZM INMCSW ;FLAG WE ARE INSIDE MACRO EXPANSION + MOVE N,4(NA) ;GET TEXT POINTER + HRLI N,700 ;MAKE INTO BYTE POINTER + MOVEM N,INPNT ;SET MACRO-INPNT (DISTINCT FROM FILE-INPNT) + MOVSI N,() + MOVEM N,AHED ;AVOID SKIPING... + MOVEM N,LOOP6 ;LINE NUMBERS + SKIPN NOEXP ;NO EXPAND? + SKIPN UNDLNS ;UNDERLINE? + JRST SCANM ;NO + HRRZ N,LSTPNT ;GET LIST. POINTER + CAIL N,TLBLK ;ALREADY CHANGED? + SUBI N,TLBLK-MBLK ;NO,CHANGE IT + HRRM N,LSTPNT + TRO MACUNF ;SET BIT - MACRO UNDERSCORE + JRST SCANM + +SCNMPO: TLNE N,1 ;MACRO PSEUDO OP. EMIT TO CREF? + SKIPN XCRFSW ;YES. BUT ARE WE DOING CREF? + JRST @4(NA) ;NO TO ONE OF THE ABOVE, PROCESS PSEUDO-OP + CREF7 5,(NA) ;EMIT TO CREF AND PROCESS + JRST @4(NA) + +^SCNMPT:TLZ IFLG ;HERE FOR "." AND "$." FAKE SCANS INTO CALLING + POPJ P, ;SPCCHK ...ALSO .FNAM1,.FNAM2 + ;ARITHMETIC IFS, IFIDN + +^REPSW: 0 ;0 FOR CONDITIONALS, -1 FOR REPEATS +Q%SV: 0 +Q%SVBL: 0 + +^Q%IF: DPB N,[POINT 3,Q%T,8] ;DEPOSIT TEST CONDITION + MOVEI N,1(P) + BLT N,4(P) ;SAVE AC'S + ADD P,[4,,4] + TDO [OPFLG,,NOFXF] + PUSHJ P,MEVAL ;GET VALUE + TLNN UNDF!ESPF + TRNE NA,17 ;CHECK FOR DEFINED + PUSHJ P,IFER ;ERROR - ARGUMENT IS UNDEFINED. + MOVSI NA,-3(P) + BLT NA,3 ;RESTORE AC'S + SUB P,[4,,4] +Q%T: SKIP N ;***INSTRUCTION IS CLOBBERED*** + TDZA N,N ;N_0 AND SKIP. + MOVEI N,1 ;N_1 + SETZM REPSW ;DO NOT INSERT CR LF AT END OF CONDITIONAL + PUSHJ P,REP ;DO THE REPEAT. N IS THE REPEAT COUNT + JRST SCANM + +IFER: ERROR [ASCIZ /UNDEFINED IF ARGUMENT - TAKEN AS 0/] + MOVEI N,0 + POPJ P, + +^Q%IFD: HRREM N,Q%SV ;SAVE "VALUE" (0 OR -1) + JSR LGET ;GET THE { + MOVE NA,MTBPNT ;MAKE POINTER + HRLI NA,440700 ;... + PUSHJ P,SARGIN ;READ IN FIRST ARG. + MOVEI N,0 ;FIVE MORE ZEROES TO END THE FIRST ARG +REPEAT 5, + HRRZ N,NA ;N_STARTING ADDRESS OF SECOND ARG. + HRLI NA,440700 ;MAKE POINTER + JSR LGET ;GET THE { + PUSHJ P,SARGIN ;READ IN SECOND ARG + MOVEI TAC,0 ;SUPPLY EXTRA ZEROS +REPEAT 5, + HRRZ NA,NA ;ENDING ADDRESS OF SECOND ARG. + SUB NA,N + ADD NA,MTBPNT + CAME NA,N ;SAME LENGTH? + JRST FLS ;NO. - FALSE + MOVE NA,MTBPNT ;GET POINTER + MOVE PN,N ;SAVE END +Q%LOP: MOVE TAC,(N) ;GET WORD + XOR TAC,(NA) ;ARE THEY THE SAME? TAC_0 IF SO. + TRZ TAC,1 ;(IGNORE BIT 35 IN COMPARE) + JUMPN TAC,FLS ;JUMP IF DIFFERENT. (FALSE) + ADDI NA,1 + CAMGE NA,PN ;DONE? + AOJA N,Q%LOP ;NO. ADVANCE N AND LOOP. +TR: SETCMM Q%SV ;TRUE - COMPLEMENT FLAG +FLS: AOS N,Q%SV ;FALSE. GET VALUE (N_0 OR 1) + SETZM REPSW ;NO CRLF AT END + PUSHJ P,REP ;DO IT + JRST SCANM + + +;handler for IFB and IFNB. Enter with N=0 for IFNB +^Q%IFB: HRREM N,Q%SVBL ;SAVE "VALUE" (0 OR -1) + JSR LGET ;GET THE { + MOVE NA,MTBPNT ;MAKE POINTER + HRLI NA,440700 ;... + PUSHJ P,SARGIN ;READ IN the ARG. + MOVEI N,0 ;ZERO TO END THE ARG + IDPB N,NA + MOVE NA,MTBPNT ;GET POINTER + HRLI NA,440700 ;to the argument string +Q%IFBL: ILDB TAC,NA ;read argument string + JUMPE TAC,Q%IFBT ;was all blank + CAIE TAC,40 + CAIN TAC,11 + JRST Q%IFBL ;LOOP WHILE BLANKS ARE SEEN + SETO TAC, +Q%IFBT: MOVEI N,1 ;assume it's ok + CAMN TAC,Q%SVBL + MOVEI N,0 ;if equal, we don't expand + SETZM REPSW ;NO CRLF AT END + PUSHJ P,REP ;DO IT + JRST SCANM + + + ; IFDEF, IFAVL, IFMAC AND IFOP + +QERR: ERROR [ASCIZ/NOT IDENT AFTER IFDEF,IFAVL, ETC. /] + JRST SCANM + +^QIF%D: HRREM N,Q%SV ;SAVE VALUE + PUSHJ P,SCAN ;GET SYMBOL + TLNN IFLG ;IDENT? + JRST QERR ;NO + MOVE NA,L ;GET SIXBIT + IDIVI NA,HASH ;HASH + MOVM PN,PN + SKIPN PN,SYMTAB(PN) ;GET START OF CHAIN + JRST QICOM ;NONE + SRC1 (L,PN,DFND,JRST QICOM) +DFND: MOVE N,2(PN) ;GET FLAGS + TLNE N,DEFFL ;DEFINED ANYWHERE? + JRST QICOM ;NO + JRST TR + +^QIF%A: HRREM N,Q%SV ;SAVE VALUE + PUSHJ P,SCAN ;GET SYMBOL + TLNN IFLG ;IDENT? + JRST QERR ;NO + MOVE NA,L ;GET SIXBIT + IDIVI NA,HASH ;HASH + MOVM PN,PN + SKIPN PN,SYMTAB(PN) ;GET START + JRST QICOM ;NONE + SRC1 (L,PN,AFND,JRST QICOM) +AFND: MOVE N,2(PN) ;GET FLAGS + TLNN N,DEFFL ;DEFINED AT ALL? + TDNN N,BLOCK ;YES. DEFINED IN THIS BLOCK? + JRST QICOM ;NO + JRST TR ;YES + +QICOM: MOVE NA,L ;GET SIXBIT + IDIVI NA,HASH ;HASH + MOVM PN,PN + SKIPN PN,MACRT(PN) ;GET START OF MACRO TABLE + JRST QIOP ;NONE + SRC1 (L,PN,TR,JRST QIOP) +QIOP: MOVE NA,L ;GET SIXBIT + IDIVI NA,HASH ;HASH + MOVM PN,PN + SKIPN PN,OPCDS(PN) ;GET START + JRST FLS ;NONE + SRC2 (L,PN,TR) + JRST FLS + +;IFOP IFNOP ;REG 3-15-74 +^QIF%O: HRREM N,Q%SV ;SAVE VALUE + PUSHJ P,SCAN ;GET SYMBOL + TLNN IFLG ;IDENT? + JRST QERR ;NO + JRST QIOP + +;IFMAC IFNMAC +^QIF%M: HRREM N,Q%SV ;SAVE VALUE + PUSHJ P,SCAN ;GET SYMBOL + TLNN IFLG ;IDENT? + JRST QERR ;NO + MOVE NA,L ;GET SIXBIT + IDIVI NA,HASH ;HASH + MOVM PN,PN + SKIPN PN,MACRT(PN) ;GET START + JRST FLS ;NONE + SRC2 (L,PN,TR) + JRST FLS ;NONE + ; .INSERT + +;FORMAT IS .INSERT DEV:FILE.EXT[PRJ,PRG] +;THIS USES THE SAME SCANNER AS THE COMMAND LINE SCANNER! MODIFIERS BEWARE!! + +^%INSER: + MOVE N,FILSTP ;GET FILE-STACK POINTER + CAIL N,FILSTP ;POINTS BEYOND END OF FILE-STACK? + JRST INSRET ;YES. TOO MANY NESTED INSERTS + +NOTNX,< HRLI N,LFDEV ;SOURCE,,DESTINATION IN N. + MOVEI NA,(N) + BLT N,5(NA) ;STORE PERMANENT FILE PARAMETERS (DEV,FIL,EXT,PPN) + MOVE N,LFDEV ;GET DEVICE NAME OF PRESENT DEV + DEVCHR N, ;GET DEC-STYLE CHARACTERISTICS + TLNN N,200000 ;MUST BE DSK. + JRST INSRED ;LOSE. +>;NOTNX ;SO FAR I'M HAPPY. LET'S PARSE A FILE NAME. + +TNX,< MOVE NA,JFNTBL ;INPUT JFN PLUS FLAGS + MOVEM NA,(N) ;STACK IT + JUMPGE NA,INSRED ;NON-DISK DEVICE. >;TNX + + MOVEM 16,TSV+16 ;SAVE AC'S DURING FILE NAME SCAN + MOVEI 16,TSV + BLT 16,TSV+15 + MOVE 16,TSV+16 ;RESTORE 16 NOW (MACRO PDL) + + PUSH P,FNREAD ;SAVE NORMAL COMMAND LINE READER. + MOVE N,[PUSHJ P,AFSCAN] + MOVEM N,FNREAD + +ITS,< PUSH P,LIMBO + SETZM LIMBO > + +NOTNX,< MOVSI 1,'DSK' ;ASSUMED DEVICE + SETZB 5,4 ;NO ASSUMPTION ABOUT FILE NAME OR PPN >;NOTNX + +NOITS,< MOVEI 3,0 ;NO ASSUMPTION ABOUT EXTENSION >;NOITS +ITS,< MOVSI 3,360000 ;USE "GREATER THAN" AS EXTENSION >;ITS + +;GETFIL CALLS SCAN1. CLOBBERS AC'S 0-13. +;0 IS SETUP CORRECTLY +;1,2,4,5,6,12,13 ARE CONSIDERED SCRATCH (T,FS,N,NA,PN,TAC) +;10,11 (B,C) ARE SET CORRECTLY TO LAST CHARACTER SEEN +;7 (CP) IS USED AS THE COROUTINE PDL + + SETZM INSRFG# ;FLAG FOR SUCESSFUL SCAN + JSR NOTNX, TGETF ;GET A FILE NAME + SETOM INSRFG ;CAN'T PARSE FILE NAME. + MOVEM 16,TSV+16 ;SAVE M SINCE SCANNER MAY BE INSIDE A MACRO + +ITS,< POP P,LIMBO > + + POP P,FNREAD + TLO SFL ;LETS SEE THE CHARACTER BY WHICH WE TERMINATED + SKIPE INSRFG + JRST INSREF ;SCAN ERROR. + TRZ NOFXF +INSR1: PUSHJ P,SCAN1 + TLNN B,CRFG!LNFD!RBRF ;SCAN TO NEXT LF OR RIGHT BRACE + JRST INSR1 + MOVEM 16,TSV+16 ;SAVE M SINCE SCANNER MAY BE INSIDE A MACRO + TLNE B,RBRF ;BRACE? + JRST ISWITC ;YES (AVOID FORM FEED, ETC) + TLNN B,LNFD ;LINE FEED YET + PUSHJ P,SCNTIL + MOVEI 16,1 + MOVEM 16,LNCNT ;ARRANGE FOR NEXT LF TO MAKE NEW PAGE +ISWITC: MOVE 16,@INPNTP ;GET FILE-INPNT (INPUT BYTE POINTER) + SUB 16,INPOFS ;BYTE-OFFSET + MOVEM 16,@INPNTP ;SAVE BYTE-OFFSET (MAY CLOBBER REAL INPNT) + MOVE 16,INPNT ;GET PRESENT INPNT (NEEDED IF CALLED FROM MACRO) + MOVE 15,FILSTP ;FILE-STACK POINTER + MOVEM 16,NOTNX,<3(15);> 1(15) ;SAVE OLD-INPNT + HRLZ 16,PGNM ;GET PAGE NUMBER + HRR 16,IRECN ;GET RECORD NUMBER + MOVEM 16,NOTNX,<5(15);> 2(15) ;SAVE RECORD NUMBER AND PAGE NUMBER + HRRZ 16,INLINE + +IFN STANSW,< HRL 16,TVFILE >;SAVE STATE OF TVFILE + + MOVEM 16,NOTNX,<6(15);> 3(15) + MOVE 16,INPNTP ;GET POINTER TO FILE-INPNT + MOVEM 16,NOTNX,<7(15);> 4(15) ;SAVE ON FILE-STACK + ADDI 15,FILSTL ;PUSH FILE-STACK POINTER PAST THIS ENTRY + MOVEM 15,FILSTP ;SAVE IT. + AOS FILSTC ;INCREMENT FILE-STACK DEPTH + MOVEI 6,INSNOF ;SET UP FOR FAILURE FROM INITIT + MOVEM 6,INITL ;(ICK!) + MOVEI 6,2 ;SET FOR DEVICE 2 (INPUT FILE) + JSR INITIT ;SWITCH TO ALTERNATE INPUT FILE. + +NOTNX,< MOVEI NA,IBUFR1 ;ADDRESS OF THE FIRST BUFFER + TLO NA,400000 + MOVEM NA,IDB ;SET UP BUFFER >;NOTNX + + SETZM IRECN ;SET RECORD COUNT + MOVE 16,[TSV+1,,1] + BLT 16,16 ;RESTORE OLD AC'S (0 AND P ARE OK) + SETZM PGNM ;SETUP LINE AND PAGE STUFF + AOS PGNM + SETZM INLINE + SETZM SPGNM + SETZM TLBLK ;FLUSH SOS LINE # + SETZM SVLNUM ;" + PUSHJ P,TVSKIP ;SETUP TO READ FIRST RECORD, AND RETURN + JRST SCANM ;CONTINUE MACRO-SCAN + +INSREF: ERROR [ASCIZ/CAN'T PARSE FILE NAME/] + MOVE 16,[TSV+1,,1] ;(PRESENT CONTENTS OF 0 ARE RIGHT) + BLT 16,16 ;RESTORE AC'S (EXCEPT P) + JRST SCANM ;RETURN AND DON'T SWITCH. + +INSRET: ERROR [ASCIZ/.INSERT NESTED TOO DEEP/] + JRST SCANM + +INSRED: ERROR [ASCIZ/MUST SWITCH FROM DSK:/] + JRST SCANM + +INSNOF: FATAL [ASCIZ/FATAL: CANNOT LOCATE INSERTED FILE/] + SUBTTL SCANS -- MAIN SCANNER IF SYMBOLS ARE TO BE LOOKED UP + +;SCANS GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED AND +; SYMBOLS ARE TO BE LOOKED UP + +;SCANS1 is alternate entry point to SCANS from DSCANS + +^SCANS: PUSHJ P,SCANM ;ANY MACRO FOUND WILL BE EXPANDED. +SCANS1: TLNN IFLG ;IDENT? + JRST SPCCHK ;NO, SPC CHR. + TLNN OPFLG ;HAS AN OPCODE BEEN SEEN? + SKIPN PN,OPCDS(NA) ;NO. CHECK OPCODE TABLE GET START OF CHAIN + JRST PT1 ;NONE + SRC2 (L,PN,PT2) +PT1: SKIPN TAC,SYMTAB(NA) + JRST PT4 ;NONE THERE AT ALL + CAMN L,(TAC) + JRST PT69 ;FIRST SYM IN LIST. DON'T MOVE IT. +SR: SKIPN PN,1(TAC) + JRST PT4 ;END OF LIST + CAMN L,(PN) ;IF IT MATCHES + JRST PT3 + SKIPN TAC,1(PN) ;ELSE TRY NEXT + JRST PT4 ;HERE IF SYM NOT FOUND + CAME L,(TAC) ;SEE US PLAY LEAPFROG WITH AC'S + JRST SR ;KEEP LOOKING + EXCH TAC,PN ;STRAIGHTEN OUT AC'S +;HERE PN IS SYM FOUND, AND TAC IS PREVIOUS SYM IN LIST +;SYM IS MOVED TO FRONT OF LIST TO FIND "POPULAR" SYMS FAST +PT3: MOVE N,2(PN) + TDNN N,BLOCK ;RIGHT BLOCK? + JRST PT4 ;NO - MUST NOT BE THERE + EXCH N,1(PN) ;NEXT GUY + EXCH N,1(TAC) ;DELINK & GET CURRENT (SAME AS PN) + EXCH N,SYMTAB(NA) ;SWAP CURRENT WITH FIRST + EXCH N,1(PN) ;AND POINT CURRENT AT REST OF LIST (RESTORING N) +PT69R: SKIPE XCRFSW + CREF6 1,(PN) +PT3B: TRNE B,SHRPF!UDARF ;# OR ^ NEXT? + JRST VRHN ;YES +PT3A: TLNE N,DEFFL ;DEFINED? + JRST NODF ;NO + TLON N,REFBIT + JRST [TLZ N,SUPBIT ;NO LONGER SUPPRESSED + MOVEM N,2(PN) ;STORE NEW FLAGS + JRST .+1] + MOVE N,3(PN) ;YES,GET VALUE ... + MOVE NA,4(PN) ;.... + POPJ P, + +NODF: MOVE N,PN ;NO DEFINITION. VALUE IS POINTER + HLLZ NA,2(PN) + POPJ P, + +PT1X: TRNN B,SHRPF ;TERMINATES WITH SHARP? + TRNE B,TP2F ;NO. UPARROW? + JRST PT1 ;TERMINATES WITH ^ (OR TILDE) OR # + JRST PT2X ;TERMINATES WITH DOWN-ARROW (OR ?) ASSUME THIS IS OPCODE + +;HERE FROM MEVAL&DEFN WHEN SYMBOL WAS FOUND AS AN OPCODE, +; BUT WE WANT TO DEFINE IT AS A LABEL (PARAMETER, ETC.) +^RESCN: MOVE N,L ;GET SIXBIT + IDIVI N,HASH ;HASH + MOVMS NA + JRST PT1 + ;HERE WHEN AN OPCODE IS FOUND +PT2: TRNE B,SHRPF!UDARF ;TERMINATES WITH # OR ^ + JRST PT1X ;YES. IT MIGHT NOT BE AN OPCODE! +PT2X: TLO SOPF ;OPCODE FOUND +^OPVAL: MOVEI NA, ;ZERO NA + HLLZ N,1(PN) ;GET FLAGS (VALUE) + TLNN N,30 ;REGULAR OPCODE? + POPJ P, ;YES, RETURN IT + +NOITS,< TLZE N,10 ;CALLI? + JRST CALLOP ;YES. > + + JUMPL N,PSOP ;PSEUDO-OP? + + MOVE N,2(PN) ;THIS IS AN OPDEF + TLON N,REFBIT ;MARK AS REFERENCED IN FLAG WORD + JRST [TLZ N,SUPBIT ;AND NOT SUPPRESSED. + MOVEM N,2(PN) ;(ONLY WRITE IF IT NEEDS TO.) + JRST .+1] + MOVE N,3(PN) ;NO, GET VALUE + MOVE NA,4(PN) ;AND VALUE FLAGS + POPJ P, ;RETURN + +PSOP: TLO PSOPF ;PSEUDO-OP SEEN + MOVE NA,2(PN) ;GET PSEUDO-OP ROUTINE ADDRESS + MOVE N,3(PN) ;GET VALUE + POPJ P, + +NOITS,< +CALLOP: +IFN STANSW,< ROT N,15 + CAML N,UCLDLN ;SMALLER THAN STANFORD SPECIAL CALLIS? + ADD N,SCLOFF ;NO. ADD OFFSET TO MAKE CALLI 400000+ > + +IFE STANSW,< ASH N,-27 ;SIGN EXTEND CALLI NUMBER TO RIGHT SIDE > + + HRLI N,() + POPJ P, +>;NOITS + +^MKNEW: PUSH P,N ;SAVE + PUSH P,NA + PUSH P,L + MOVE L,(PN) ;GET SIXBIT + MOVE N,L + IDIVI N,HASH ;HASH + MOVM NA,NA + PUSHJ P,PT4 ;MAKE A PLACE + POP P,L ;RESTORE + POP P,NA + POP P,N + POPJ P, + PT69: MOVEI PN,(TAC) ;UNSHUFFLE AC'S + MOVE N,2(PN) + TDNE N,BLOCK ;RIGHT BLOCK? + JRST PT69R ;YES +PT4: GFST PN,FSTPNT ;MAKE AN ENTRY FOR A NEW SYMBOL. GET SOME FREE STG. + SKIPE XCRFSW + CREF6 1,(PN) + MOVEM L,(PN) ;DEPOSIT SIXBIT + MOVE N,SYMTAB(NA) ;GET CURRENT POINTER + MOVEM PN,SYMTAB(NA) ;REPLACE WITH POINTER HERE + EXCH N,1(PN) ;POINT NEW TO OLD AND ... + MOVEM N,FSTPNT ;ADVANCE FREE STRG PNT. + SETZM 3(PN) ;NO FIXUPS YET + SETZM 4(PN) ;NO POLFIX'S YET + MOVSI N,DEFFL ;UNDEFINED + OR N,BLOCK ;GET BLOCK BIT +PT4A: TRNE B,SHRPF!UDARF ;# OR ^ NEXT? + JRST VARH ;YES + MOVEM N,2(PN) ;SET FLAGS + HLLZ NA,N + MOVEI N,(PN) ;VALUE IS POINTER + POPJ P, + +MAKEXT: PUSHJ P,SCAN1A ;SKIP THE ^ + MOVE L,(PN) ;RESTORE SIXBIT IN CASE LABEL + TLNN N,DEFFL + TLOA N,INTF!REFBIT ;CONSIDER THESE TO BE REFERENCES + TLO N,EXTF!REFBIT + POPJ P, + +EXTH: PUSHJ P,MAKEXT ;FIRST OCCURANCE OF SYMBOL HAS ^ FOLLOWING + JRST PT4A + +;HERE WHEN FIRST OCCURENCE OF SYMBOL HAS ^ OR # FOLLOWING. +VARH: TRNE B,UDARF ;# OR ^ ? + JRST EXTH ;WAS ^ + PUSHJ P,SCAN1A ;PASS THE # + TRNE B,SHRPF ;IS NEXT ANOTHER #? + JRST EXTH ;YES. ## MEANS EXTERNAL + TLO N,VARF!UDSF!REFBIT ;SET # BIT. CONSIDER THIS TO BE A REFERENCE + MOVEM N,2(PN) ;& STORE + SKIPN XCRFSW + JRST VARH1 ;NOT DOING CREF + MOVEI NA,2 ;GIVE # TO CREF + SKIPE LISTSW + IDPB NA,CREFPT +VARH1: GFST NA,FSTPNT + MOVEM PN,(NA) + MOVE N,VARLST + MOVEM NA,VARLST + EXCH N,1(NA) + MOVEM N,FSTPNT + SETZM 2(NA) ;ONE WORD + HLLZ NA,2(PN) ;GET FLAGS + MOVE N,PN ;VALUE IS POINTER + POPJ P, ;RETURN + ;HERE WHEN SYMBOL NAME HAS BEEN SEEN BEFORE, AND THIS TIME HAS # OR ^ FOLLOWING. + +EXHN: PUSHJ P,MAKEXT + MOVEM N,2(PN) + JRST PT3B + +VRHN: TLON N,REFBIT + MOVEM N,2(PN) ;CONSIDER THIS IS A REFERENCE + TRNE B,UDARF + JRST EXHN + PUSHJ P,SCAN1A + TRNE B,SHRPF ;## SEEN? + JRST EXHN ;MEANS EXTERNAL + SKIPN XCRFSW + JRST VRHN1 ;NOT DOING CREF + MOVEI NA,2 + SKIPE LISTSW + IDPB NA,CREFPT +VRHN1: TLNN N,DEFFL + JRST PT3A ;ALREADY DEFINED, JUST LEAVE IT + TLOE N,UDSF!VARF ;TURN ON AND CHECK + JRST PT3P + MOVEM N,2(PN) ;SAVE FLAGS + GFST NA,FSTPNT ;GET FREE STORAGE + MOVEM PN,(NA) ;SAVE PNTR TO SYMBOL + MOVE N,VARLST + MOVEM NA,VARLST ;PUT ON VARIABLE LIST + EXCH N,1(NA) + MOVEM N,FSTPNT + SETZM 2(NA) ;MARK AS ONE WORD VARIABLE + SKIPA N,2(PN) +PT3P: MOVEM N,2(PN) ;SAVE FLAGS + JRST PT3A + + SPCCHK: TLNN NFLG ;NUMBER? + TLNN N,LBRF ;NO. LEFT BRACKET, OR "." OR "$." KLUDGE? + POPJ P, ;NO + TLNN SCFL + JRST (N) ;NOT A SPECIAL CHAR; IT MUST BE "." "$." + ;ALSO .FNAM1,.FNAM2 + PUSH P,EFSPNT + MOVEM FS,EFSPNT + ADD P,[XWD 12,12] + JUMPGE P,PDLOV + MOVSI TAC,PCNT ;PUSH PCNT & +1... + HRRI TAC,-11(P) ; OPCNT & +1... + BLT TAC,-4(P) ;& WRD & +1 + HRRZI TAC,-3(P) + BLT TAC,(P) ;SAVE AC'S + TLZ MLFT ;...0 TO 3 + TRNN N,TP1F ;[ OR ) ;GET NEXT + MOVEM N,2(T) ;DEPOSIT POINTER TO VALUE + MOVEM N,OPCNT ;SET CURRENT LOC. TO IN CORE &... + MOVEM N,PCNT ;HERE + MOVSI TAC,INCF ;AND TO "IN CORE" + MOVEM TAC,OPCNT+1 ;... + MOVEM TAC,PCNT+1 ;... + SETZM (N) ;ZERO REVERSE FIXUP POINTER FOR VALUE + SETZM 2(N) ;NO FLAGS + SETZM 3(N) ;NO BACK PNTR + MOVE TAC,1(N) ;GET POINTER TO REST OF FREE STRG + MOVEM TAC,FSTPNT ;& DEPOSIT + SETZM 3(T) ;NO FIXUPS YET + SETZM 4(T) ;... + PUSH P,LITFIL + +NOTNX,< PUSH P,LITFIL+1 + PUSH P,LITFIL+2 >;NOTNX + + PUSH P,LITPG + PUSH P,LITLIN + PUSH P,LABLTP + PUSH P,LABLTC + PUSH P,N + PUSH P,T + SETZM LABLTP ;INIT FOR ANY LABELS... + SETZM LABLTC ;IN THIS LITTERAL + SKIPN T,TLBLK + HRRO T,INLINE + MOVEM T,LITLIN + MOVE T,PGNM + MOVEM T,LITPG + +NOTNX,< MOVE T,[FILNM,,LITFIL] + BLT T,LITFIL+4 >;NOTNX + +TNX,< MOVE T,JFNTBL ;JFN FOR CURRENT INPUT FILE + MOVEM T,LITFIL >;TNX + +TCALL: ACALL ;CALL ASSEMBL + SKIPN WRD+1 ;EMPTY? + JRST LEMP ;YES + AOS @(P) ;COUNT # OF WORDS IN LIT. + AOS LABLTC +LEMCON: MOVE N,-1(P) ;GET POINTER TO VALUE + MOVE TAC,WRD + MOVEM TAC,3(N) ;SET VALUE... + MOVE TAC,WRD+1 + MOVEM TAC,4(N) ;... + TRZE TRBF ;TERM BY ]? + JRST ANOBR ;YES + GFST T,FSTPNT ;GET FREE STRG. + MOVEM T,1(N) ;POINT TO HERE + MOVEM N,3(T) ;POINT BACK + MOVEM T,PCNT ;SET LOC... + MOVEM T,OPCNT ;COUNTERS + MOVE N,1(T) ;GET REST OF FREE STRG. + MOVEM N,FSTPNT ;SET FSTPNT + MOVEM T,-1(P) ;SET NEW POINTER + SETZM (T) ;ZERO REVERSE FIXUP POINTER + SETZM 2(T) ;NO FLAGS + JRST TCALL + +ANOBR: SETZM 1(N) ;ZERO VALUE POINTER(NO MORE) + POP P,NA + MOVE T,LABLTP + HRLM T,2(NA) ;STORE PNTR TO LABELS + MOVE T,(NA) ;INVENT A CONSTANT HASH FCN FORMERLY: T,3(N) + IDIVI T,HASH + MOVMS FS + MOVE O,LITPNT(FS) + MOVEM NA,LITPNT(FS) +; PUSHJ P,LITCOM ;THIS MIGHT SAVE CORE, BUT IT WASTES LOTS OF TIME. + MOVEM O,1(NA) + MOVE PN,NA +LITNUL: MOVE T,NOTNX,<-13(P);> -11(P) ;GET OLD FLAGS + TDZ REFLAG + AND T,REFLAG + OR T ;RESTORE CERTAIN FLAGS + TDZ [XWD NFLG!SCFL!PSOPF!SOPF,TRBF] + TLO IFLG + SUB P,[1,,1] + POP P,LABLTC ;RESTORE OLD COUNT + POP P,LABLTP ;RESTORE OLD + POP P,LITLIN + POP P,LITPG + +NOTNX,< POP P,LITFIL+2 + POP P,LITFIL+1 >;NOTNX + + POP P,LITFIL + HRLZI N,-2(P) + ADDI N,1 + BLT N,3 ;RESTORE AC'S + MOVSI N,-11(P) + HRRI N,PCNT + BLT N,PCNT+5 ;RESTORE PCNT ETC. + SUB P,[XWD 12,12] + PUSHJ P,SCAN1 ;GET A PEEK AT NEXT (FOR CALLER) + TLO SFL ;BUT ONLY A PEEK + MOVSI NA,DEFFL + MOVE N,PN ;MARK AS UNDEFINED LABEL + POP P,EFSPNT + JUMPN N,.+3 + MOVEI NA, + TLC IFLG!NFLG ;JUST GIVE 0 IF NULL + POPJ P, + +LEMP: TRNN TRBF ;TERM BY > OR ]? + JRST TCALL ;NO + MOVE T,-1(P) ;PNTR TO VAL + MOVE N,FSTPNT + MOVEM N,1(T) + MOVEM T,FSTPNT ;RETURN UNUSED BLK + SKIPE N,3(T) ;GET LAST PNTR + JRST ANOBR ;FINISH IT OFF + ERROR [ASCIZ/NULL LITERAL/] ;OOPS + POP P,PN + MOVEM T,1(PN) + MOVEM PN,FSTPNT ;RETURN HEADER + MOVEI PN, + JRST LITNUL + ;PROCESS "PREDEFINED SYMBOLS" $. . .FNAM1 .FNAM2 + +^SCAN.: MOVE N,DPCNT ;HERE FOR . + MOVE NA,DPCNT+1 + TLO IFLG + POPJ P, + +^SCAN$.:TLO IFLG ;HERE FOR $. + MOVE N,OPCNT + MOVE NA,OPCNT+1 + TLNN NA,INCF + POPJ P, ;NOT IN LIT - EASY + GFST PN,FSTPNT ;IN LIT - KLUDGE UP A PSEUDO LITLAB + MOVEI T, + EXCH T,1(PN) + MOVEM T,FSTPNT + SETZM (PN) ;THIS WILL DISTINGUISH IT + SETZM 3(PN) + SETZM 4(PN) + MOVSI T,DEFFL!UDSF + PUSHJ P,MAKLL + MOVEI N,(PN) + MOVSI NA,DEFFL!UDSF + POPJ P, + +;THIS IS A LOW PRIORITY ITEM FOR TENEXIZING -- SO IT ISN'T +^%FNM1: ;.FNAM1 +ITS,< MOVE N,SRCSTS+1 > ;ITS - GET FULL WORD FILE NAME +NOTNX,> +TNX,< MOVE N,FILNM1 > + MOVEI NA,0 ;NO RELOCATION + TLO IFLG ;IDENTIFIER + POPJ P, + +^%FNM2: +ITS,< MOVE N,SRCSTS+2 > +NOTNX,> +TNX,< MOVE N,FILNM2 >;TNX + MOVEI NA,0 + TLO IFLG + POPJ P, + +^%CPU: JFCL 17,.+1 ;.CPU. PSEUDO-MACRO. CLEAR FLAGS + MOVEI N,1 ;INITIAL ASSUMPTION (1=PDP6) + JRST .+1 + JFCL 1,%166 ;166 PROCESSOR HAS PC CHANGE FLAG + MOVNI NA,1 + AOBJN NA,.+1 + JUMPN NA,%KA ;KA10 CARRIES ACROSS HALFWORDS + MOVEI NA,0 + BLT NA,0 + JUMPE NA,%KI ;KL10 ALWAYS UPDATES BLT POINTER +%KL: ADDI N,1 ;KL = 4 +%KI: ADDI N,1 ;KI = 3 +%KA: ADDI N,1 ;KA = 2 +%166: MOVEI NA,0 ;166= 1. SET RELOCATION TO ZERO + TLO IFLG ;SET IDENTIFIER SEEN + POPJ P, ;RETURN VALUE. + +^%OSFAI:MOVE N,[OSFAIL] + MOVEI NA,0 + TLO IFLG ;IDENT SEEN. + POPJ P, + + ;COMPLEX ATOMS - EXPRESSIONS INSIDE BROKETS + +^REFLAG:OPFLG!RELEF!MLFT!UNDF!ESPF!PAWF,,NOFXF!IOSW!ADFL!FLFXF + +IRBO: PUSH P,[0] ;HERE TO DO COMPLEX ATOMS (BROKETED EXPRESSION) + PUSH P,[0] +DRIBL: TRO NOFXF ;NO FIXUPS + ACALL + TLNE AUNDF + ERROR [ASCIZ /UNDEFINED WORD IN <>/] + TRZN TRBF ;WAS EXPRESSION TERMINATED BY ] OR >? + JRST NIRBO ;NO. FLUSH UNTIL WE GET A BROKET +NEMP: TLON SFL ;HAVE WE SCANNED AHEAD? + PUSHJ P,SCAN ;NO, DO IT + MOVE T,-5(P) ;GET OLD FLAGS + TDZ 0,REFLAG + AND T,REFLAG ;RESTORE APPROPRIATE FLAGS + OR 0,T + TDZ 0,[SOPF!SCFL!PSOPF!IFLG,,TRBF] + TLO 0,NFLG + MOVE N,WRD + MOVE NA,WRD+1 ;RETURN VALUE + MOVSI L,-4(P) + ADDI L,1 + BLT L,3 ;RESTORE AC'S + MOVSI L,-13(P) + HRRI L,PCNT + BLT L,PCNT+5 ;RESTORE PCNT ETC. + SUB P,[XWD 14,14] + POP P,EFSPNT + POPJ P, + + +NIRBO: MOVEI N,-1(P) ;SAVE VALUE WE SCANNED. + HRLI N,WRD ;... + BLT N,(P) +SLOP: TRO NOFXF ;NO FIXUPS + ACALL ;READ STUFF AND THROW IT AWAY + TRZN TRBF ;TERM BY ] OR >? + JRST SLOP ;NO. READ MORE AND THROW IT AWAY + MOVSI N,-1(P) ;PUT OLD VALUE... + HRRI N,WRD ;IN... + BLT N,WRD+1 ;WRD + JRST NEMP + + BEGIN INP ;INP USED BY SCAN TO GET NEXT BUFFER + +IFN STANSW,< +^^TVFILE:0 +TVMSK: ASCII /________________00000______/ +TVTXT: ASCII /COMMENT  VALID 00000 PAGES/ +LTVTXT__.-TVTXT +>;STANSW + +^^INPOFS: 0 ;USED WHEN SWITCHING TO CALCULATE OFFSET. +INTEM: 0 + 0 +RDDELF: 0 + +EOFPOP: MOVEM 17,TSV+17 + MOVEI 17,TSV + BLT 17,TSV+16 + +TNX,< JSR CLSSRC> + + MOVNI 7,FILSTL + ADDB 7,FILSTP ;POP STACK + SOS FILSTC ;DECREMENT FILE-STACK DEPTH + +NOTNX,< MOVE 1,(7) ;DEVICE + MOVE 5,1(7) ;FILE + MOVE 3,2(7) ;EXT + MOVE 4,4(7) ;PPN + MOVEI 6,2 ;IO CHANNEL NUMBER + JSR INITIT ;LOOKUP THE FILE >;NOTNX + +TNX,< MOVE 1,(7) + MOVEM 1,JFNTBL ;JFN >;TNX + + + MOVE 1,NOTNX,<7(7);> 4(7) + MOVEM 1,INPNTP ;POINTER TO FILE-INPNT (CURRENTLY THE BYTE-OFFSET) + MOVE 1,NOTNX,<3(7);> 1(7) ;GET OLD-INPNT + MOVEM 1,INPNT ;RESTORE OLD-INPNT (COULD BE THE BYTE-OFFSET THOUGH) + MOVE 1,@INPNTP ;GET THE REAL BYTE-OFFSET + MOVEM 1,BYPOFF# ;SAVE BYTE POINTER OFFSET + MOVE 1,NOTNX,<5(7);> 2(7) ;GET RECORD NUMBER + HLRZM 1,PGNM ;STORE FILE PAGE NUMBER + MOVE 2,NOTNX,<6(7);> 3(7) + HRRZM 2,INLINE + +IFN STANSW,< HLREM 2,TVFILE ;RESTORE TVFILE >;STANSW + +NOTNX,< USETI 2,(1) ;SET FOR CORRECT RECORD NUMBER + MOVEM 1,IRECN ;SET RECORD NUMBER (AVOID INCREMENT LATER) >;NOTNX + +TNX,< HRRZM 1,IRECN + JSR XJFNS ;SEE INITIT +>;TNX + +NOTNX,< MOVEI 1,IBUFR1 ;ADDRESS OF THE FIRST BUFFER + TLO 1,400000 + MOVEM 1,IDB ;SET UP BUFFER >;NOTNX + + MOVSI 17,TSV + BLT 17,17 + JRST NXTFL1 ;PROCESS "NEXT FILE" + +^NXTFL: SETZM BYPOFF ;BYTE POINTER OFFSET + SKIPE FILSTC ;ANYTHING ON THE FILE-STACK? + JRST EOFPOP ;YES. PROCESS IT. + JSR EOF ;GET NEXT FILE IF ANY + SETZM PGNM + AOS PGNM + SETZM INLINE +NXTFL1: SETZM SPGNM + SETZM TLBLK ;FLUSH SOS LINE # + SETZM SVLNUM ;" + TRNN LDEV + JRST .+4 + MOVEI TAC,14 + SKIPE XPNDSW + IDPB TAC,LSTPNT + PUSHJ P,LSTFRC + SKIPE RDDELF + IBP LSTPNT ;NEED THIS BECAUSE NEXT CHR GETS STOWED WITH DPB + SETZM RDDELF + SKIPE BYPOFF ;ANY BYTE-POINTER OFFSET? + JRST INPX0 ;YES. LET'S SKIP THIS. + + +^^TVSKIP: ;ROUTINE TO IDENTIFY TVEDIT FILES + SETZM RDDELF + SETZM BYPOFF + +NOTNX,< IN 2, ;READ FIRST REC + AOSA IRECN ;COUNT A RECORD READ + JRST INP0 ;LOSE >;NOTNX + +TNX,< SETZM IRECN + JSR TNXIN >;TNX + +IFN STANSW,< ;AT STANFORD, IDENTIFY TV FORMAT FILES + SETZM TVFILE ;FIRST ASSUME NON-TV + MOVSI B,-LTVTXT + MOVSI TAC,B + ADD TAC,INPNT + IBP TAC +TVSKP1: MOVE C,@TAC ;SEE IF THIS IS A DIRECTORY + XOR C,TVTXT(B) + TDNN C,TVMSK(B) + AOBJN B,TVSKP1 + JUMPL B,INP0A + SETOM TVFILE ;REMEMBER THIS FOR EDITOR CALL >;STANSW + + JRST INP0A + +^^INP: TDZA B,B ;FLAG THAT THIS IS NOT A CALL VIA DELTAB +^INPDT: MOVEI B,1 + MOVEM B,RDDELF ;SAVE FLAG + AOS IRECN ;INCREMENT RECORD NUMBER. + SETZM BYPOFF ;NO BYTE-POINTER OFFSET +INPX0: +NOTNX,< INPUT 2, >;NOTNX - GET NEXT BUFFERFUL +TNX,< JSR TNXIN >;TNX + +NOTNX,< +INP0: STATZ 2,740000 + FATAL [ASCIZ \FATAL I/O ERROR ON INPUT\] + STATZ 2,20000 + JRST NXTFL >;NOTNX + +INP0A: MOVE B,INPNT ;INPNT IS IDB+1 + IBP B + HRRZM B,INPOFS ;STORE FIRST ADDRESS + MOVE B,IDB+2 ;CHARATER COUNT + MOVEM B+1,INTEM ;B+1 IS ABOUT TO BE CLOBBERED + ADDI B,4 ;ROUND UP TO MAKE A WORD COUNT + IDIVI B,5 ;B_NUMBER OF WORDS IN BUFFER + ADD B,INPOFS ;ADDRESS OF END OF BUFFER + MOVE B+1,[BYTE(7)177,0] + MOVEM B+1,(B) ;STUFF 177 0 INTO END OF BUFFER. +IFE STANSW,;NOITS>;NOTNX >;IFE STANSW + +INP0A9: MOVE B+1,INTEM ;RESTORE B+1 + SKIPN B,BYPOFF ;ANY BYTE-OFFSET? + POPJ P, + ADD B,INPOFS ;ADD FIRST ADDRESS TO THE OFFSET. + PUSH P,B ;B NOW CONTAINS THE FILE-INPNT + MOVE B,FILSTP ;GET FILE-STACK POINTER + MOVE B,NOTNX,<3(B);> 1(B) ;GET OLD-INPNT + MOVEM B,INPNT ;SAVE IT (IN CASE WE'RE IN A MACRO) + POP P,@INPNTP ;STORE NEW FILE-INPNT + SETZM BYPOFF ;DEPARTMENT OF REDUNDANCY DEPARTMENT + POPJ P, + +TNX,< +;READ NEXT BUFFER FULL (GENERALLY A PMAP, WE HOPE) +TNXIN: 0 + TSVAC <1,2,3> + SKIPL 1,JFNTBL + JRST TNXIN2 ;IF NOT A PMAPPABLE FILE + HRRZS 1,1 + MOVE 2,[XWD 2,11] ;TWO WDS, FDBBYV,FDBSIZ + MOVEI 3,2 ;TO AC 2 + GTFDB + LSH 2,-30 ;JUSTIFY BYTE SIZE + ANDI 2,77 ;AND MASK OFF + CAIE 2,7 ;IS IT 7 BIT ASCII? + IMULI 3,5 ;MUST BE FULL WORDS... + MOVE 2,IRECN + IMULI 2,1000*5 ;TOT BYTES NOT INCL THIS PAGE + CAML 2,3 + JRST NXTFL ;EOF + ADDI 2,1000*5 + SUB 3,2 ;SIZE-TOT BYTES TO END OF THIS PAGE + SKIPL 3 + SETZ 3, ;EOF NOT ON THIS PAGE + ADDI 3,1000*5 + MOVEM 3,INPNT+1 ;CORRECT NUMBER OF BYTES (I HOPE) + HRLS 1,1 + HRR 1,IRECN ;JFN,,PAGE + MOVE 2,[XWD 400000,SRCBFP] ;THIS FORK, SOURCE BUFFER PAGE + HRLZI 3,100400 ;READ/CPY WRITE + PMAP +TNXIN1: MOVE 1,[POINT 7,SRCBF] + MOVEM 1,INPNT ;SET POINTER + TRSTAC <1,2,3> + JRST @TNXIN + +TNXIN2: TLNE 1,200000 ;TERMINAL BIT + JRST TNXIN3 ;IS A TTY...SPEC EOF CONVENTION + HRRZS 1,1 ;CLEAR FLAGS + MOVE 2,[POINT 36,SRCBF] + MOVNI 3,1000 + SIN + ADDI 3,1000 ;FORM COUNT OF BYTES READ + IMULI 3,5 ;CONV TO 7 BIT BYTES + JUMPE 3,NXTFL ;LOSE + MOVEM 3,INPNT+1 ;SET COUNTER + SETZ 3, +REPEAT 5,< IDPB 3,2 ;SO THE BUFEND DETECTION WONT FUCK UP > + JRST TNXIN1 + +TNXIN3: TLNE 1,100000 ;OUR OWN EOF BIT + JRST NXTFL ;YEP.... + HRROI 1,SRCBF + MOVEI 2,1000*5-1 ;LV ROOM FOR LF +TNXI3A: SETZ 3, +NOT20,< + PSTIN ;HAD BETTER BE CONTROLLING TTY +>;NOT20 +T20,< HRLI 2,(1B0!1B3) ;BREAK ON CRLF, ESC, OR ^Z. + RDTTY + ERJMP .+1 + HRRZ 2,2 ;leave count only +>;T20 + LDB 3,1 ;GET TERMINATOR + CAIN 3,32 ;CTRLZ FOR EOF? + JRST TNXI3B ;IF EOF... +T20,< CAIN 3,12 ;BREAK ON LF TOO + JRST TNXI3D ;SPECIAL PLACE FOR LF >;T20 + CAIN 3,15 ;IS IT CR? + JRST TNXI3C ;YES, CR + JUMPG 2,TNXI3A ;ARB TERMINATOR, ROOM REMAINS + MOVEI 3,1000*5-1 + MOVEM 3,INPNT+1 ;UNLIKELY BUT BUFFER IS FULL + JRST TNXIN1 +TNXI3B: MOVEI 3,15 ;CR + DPB 3,1 ;STORE OVER CTRLZ + MOVE 3,JFNTBL + TLO 3,100000 ;EOF BIT + MOVEM 3,JFNTBL +TNXI3C: MOVEI 3,12 ;LF + IDPB 3,1 ;STORE IT + SOJ 2, ;AND ACCOUNT FOR IT +TNXI3D: SUBI 2,1000*5-1 + MOVNS 2,2 ;NUMBER OF BYTES READ + MOVEM 2,INPNT+1 + SETZ 3, +REPEAT 5,< IDPB 3,1 ;SO BUF TERM TEST WONT FUCKUP > + JRST TNXIN1 +>;TNX + +BEND INP + +BEND SCAN + SUBTTL REVAL -- EVALUATES EXPRESION INTO LIST-POLISH +BEGIN REVAL +^REVAL: MOVE O,FS ;INITIALIZE + TLNE SCFL ;SPC CHR? + JRST SPC1 ;YES +REVAL1: PUSH FS,N ;PUT NUM... + PUSH FS,NA ;INTO STRG + TLNN B,ARFL ;ARITH OP COMING UP? + JRST NOA1 ;NO + TLZE B,UNOF + CAIN C,"-" + JRST .+2 + PUSHJ P,UOPERR +REVALU: MOVE T,B + TLO T,SNB ;MARK AS OPERATOR + PUSH FS,FS ;STORE POINTER TO NUM... + PUSH FS,T ;WITH OPERATOR + HRRZ O,FS ;SET "OLD OP" POINTER +LOOP2: PUSHJ P,SCANS ;GET A PREVIEW +LOOP4: TLNN B,ENMF ;NOT A NUM COMING? + JRST SPC2 ;NOT A NUM COMING + PUSHJ P,SCANS ;GET NEXT NUM +LOOP4A: HRRZ T,B ;ENTER HERE FROM SPC2B + TLNN B,ARFL ;ARITH OP COMING? + MOVEI T,16 ;NO,SET LEVEL=16 +LOOP3: CAIGE T,@(O) ;COMPARE NEW OP LEVEL WITH OLD + JRST NLOW ;NEW ONE LOWER + PUSH FS,N ;PUT NUM... + PUSH FS,NA ;IN STRG + HRLM FS,-1(O) ;AND POINT OLD OP AT IT +LOOP1: CAML T,-1(P) ;COMPARE NEW OP WITH LIMIT + JRST NGL ;NEW GREATER OR EQUAL LIMIT + MOVE T,B ;MARK NEW OP ... + TLO T,SNB ;AS OPERATOR + TLZE T,UNOF + CAIN C,"-" + JRST .+2 + PUSHJ P,UOPERR + PUSH FS,O ;POINT TO OLD OP + PUSH FS,T ;WITH NEW + HRRZ O,FS ;SET "OLD OP" + JRST LOOP2 + +NGL: MOVEM O,-1(P) ;RETURN "OLD OP" + POPJ P, + +NLOW: PUSH P,O ;SAVE "OLD OP" + MOVEI O,@(O) ;GET LEVEL OF OLD OP + PUSH P,O ;USE AS LIMIT + PUSHJ P,REVAL ;CALL REVAL + MOVE O,-1(P) ;GET OD OP POINTER + EXCH T,(P) ;GET RETURNED VALUE + HRLM T,-1(O) ;POINT OLD OP AT IT + POP P,T ;RESTORE T + SUB P,[XWD 1,1] ;POP + JRST LOOP1 + +UOPERR: ERROR [ASCIZ/UNARY OPERATOR ILLEGAL AFTER AN EXPRESSION/] + TRO POLERF + MOVEI C,"+" ;CHANGE TO A BINARY OPERATOR + MOVE B,[SNB!SPCLF!ARFL,,12] + MOVE T,B + POPJ P, + SPC2: TLNE B,UNOF ;UNARY OPERATOR? + JRST UNAR ;YES + TRNE B,LFPF ;(? + JRST LFTP + TRNE B,UDARF ;POSSIBLE UPARROW? + TRNN B,TP2F ;DEFINITE UPARROW? + JRST SPC2A ;NOT UPARROW + TLZ SFL ;SKIP THE ^ + PUSHJ P,DSCANS ;TRY TO READ DECIMAL (OR WHATEVER) NUMBER + TLNE NFLG ;GOT A NUMBER? + JRST LOOP4A ;YES. USE IT. +SPC2A: TRO POLERF ;SET ERROR FLAG + ERROR [ASCIZ/ILLEGAL CHR AFTER OPERATOR/] + JRST NGL ;RETURN + +UNAR: HRRI B,2 ;MARK AS UNARY + PUSH P,O ;SAVE OLD OP PNT + MOVEI O,@(O) ;GET LEVEL OF OLD OP + PUSH P,O ;USE AS LIMIT IN CALL + PUSHJ P,REVALU ;CALL REVAL(OTHER ENTRANCE) +OLF: MOVE O,-1(P) ;GET OLD OP + EXCH T,(P) ;GET RETURNED VALUE + HRLM T,-1(O) ;PNT OLD OP AT IT + POP P,T ;RESTORE T + SUB P,[XWD 1,1];POP + JRST LOOP1 + +LFTP: TLZ SFL ;IGNORE PAREN + PUSHJ P,SCANS ;GET NEXT + PUSH P,O ;SAVE O + PUSH P,[16] ;SET LIMIT =16 + PUSHJ P,REVAL ;CALL REVAL + MOVE O,-1(P) ;GET OLD OP + EXCH T,(P) ;GET RETURNED VALUE + HRLM T,-1(O) ;PNT OLD OP AT IT + POP P,T ;RESTORE T + SUB P,[XWD 1,1] + TRNN B,RTPF ;RIGHT PAREN LAST THING? + JRST NRP ;NO + PUSHJ P,SCANS ;GET THE RIGHT PAREN FF. + TLNN B,ARFL ;ARITH OP NEXT? + JRST NGL ;NO + HRRZ T,B ;YES, SET T ... + CAIL T,@(O) ;COMPARE LEVEL + JRST LOOP1 ;AND PROCEED + MOVE T,B + TLO T,SNB + TLZE T,UNOF + CAIN C,"-" + JRST .+2 + PUSHJ P,UOPERR + PUSH P,O ;SAVE OLD OP + HLRZ O,-1(O) ;GET RETURNED VALUE BACK + PUSH FS,O ;POINT NEW OP AT IT + PUSH FS,T ;PUSH OP + HRRZ O,FS ;SET OLD OP + HRRZ T,@(P) ;GET LEVEL + PUSH P,T + PUSHJ P,LOOP2 + JRST OLF + +NRP: TLON REUNBF ;SET UNBAL FLAG + ERROR [ASCIZ/UNBAL PARENS/] + TRO POLERF ;SET ERROR FLAG + JRST NGL ;RETURN + SPC1: TLNE N,UNOF ;UNARY OPERATOR? + JRST UNAR1 ;YES + TRNE N,LFPF ;(? + JRST LFTP1 ;YES + TRNE N,UDARF ;POSSIBLE UPARROW? + TRNN N,TP2F ;YES. IS IT REALLY UPARROW? + JRST SPC1A ;NOT UPARROW + PUSHJ P,DSCANS ;TRY TO FIND A NUMBER + TLNE NFLG ;GOT A NUMBER? + JRST REVAL1 ;YES! +SPC1A: ERROR[ASCIZ/ILLEGAL CHR STARTS EXPRESSION/] + TRO POLERF ;SET ERROR FLAG + MOVEI T,16 + JRST NGL + +UNAR1: PUSH FS,FS ;PUSH ANY OLD THING + HLLZ T,N + OR T,[XWD SNB,2];MARK AS UNARY OP + PUSH FS,T + HRRZ O,FS + JRST LOOP4 + +LFTP1: PUSHJ P,SCANS ;GET +^LFTP2: PUSH P,[16] ;SET LIMIT=16 + PUSHJ P,REVAL ;GET VALUE + POP P,O ;GET VALUE + TRNN B,RTPF ;)? + JRST NRP ;NO + PUSHJ P,SCANS ;GET PAST THE ) + TLNE B,ARFL ;ARITH OP NEXT? + JRST PARAR ;YES + TLO O,SNB ;MARK VALUE AS "PARENS AROUND WHOLE" + MOVEM O,-1(P) ;RETURN + POPJ P, + +^PARAR: PUSH FS,O ;POINT TO VALUE... + MOVE T,B ;... + TLO T,SNB ;... + TLZE T,UNOF + CAIN C,"-" + JRST .+2 + PUSHJ P,UOPERR + PUSH FS,T ;FROM CURRENT OP + HRRZ O,FS ;SET OLD OP + JRST LOOP2 + +NOA1: HRRZM FS,-1(P) ;RETURN OPERAND + MOVEI T,16 ;SET LEVEL=16 + POPJ P, ;RETURN + +BEND + + SUBTTL REDUC -- REDUCES THE LIST STRUCTURE POLISH POINTED TO BY FS + +BEGIN REDUC +^REDUC: SKIPL (FS) ;SINGLE OPERAND? + POPJ P, ;YES + PUSH P,FS ;SAVE POINTER + MOVE O,(FS) ;GET BITS + TLNE O,UNOF ;UNARY OP? + JRST PT1 ;YES + MOVE FS,-1(FS) ;GET POINTER TO FIRST OPERAND + SKIPGE (FS) ;OPERATOR OR OPERAND? + PUSHJ P,REDUC ;OPERATOR, REDUCE +PT1: MOVE FS,(P) ;GET POINTER + MOVS FS,-1(FS) ;GET POINTER TO SECOND OPERAND + SKIPGE (FS) ;OPERATOR? + PUSHJ P,REDUC ;YES, REDUCE + MOVE FS,(P) ;GET POINTER + MOVE O,(FS) ;GET BITS + TLNE O,UNOF ;UNARY OP? + JRST PT2 ;YES + MOVE O,-1(FS) ;GET PNTR TO FIRST OP + SKIPGE FS,(O) ;OPERAND? + JRST CPOP ;NO, CAN'T REDUCE + TLNE FS,DEFFL ;DEFINED? + JRST CPOP ;NO, CAN'T REDUCE +PT2: MOVE FS,(P) ;GET PNTR. + MOVS FS,-1(FS) ;GET PNTR TO SECOND OP + SKIPGE T,(FS) ;OPERAND? + JRST CPOP ;NO, CAN'T REDUCE + TLNE T,DEFFL ;DEFINED? + JRST CPOP ;NO, CAN'T REDUCE + MOVE T,(P) ;GET POINTER + MOVE T,(T) ;GET OPERATION + DPB T,[POINT 5,T,4] ;TACK ARMD & ARMD1 ... + LDB T,[POINT 7,T,6] ;ONTO LEVEL + HRRZ T,OPTB1-10(T) ;GET DISPATCH ADDRESS + JUMPN T,(T) ;DO IT. + ERROR [ASCIZ/UNKNOWN ILLEGAL OPERATOR IN POLISH REDUCTION/] + SETZB O,T ;SET VALUES TO ZERO AND FALL INTO RRETT +RRETT: POP P,FS ;GET POINTER + MOVEM T,-1(FS) ;DEPOSIT VALUE + MOVEM O,(FS) ;DEPOSIT BITS + POPJ P, ;RETURN + +CPOP: POP P,O + POPJ P, + +DEFINE AROP(BOP,SPC1,SPC2,BTOP,MGNM,Q) +< MOVE T,-1(O) ;GET SECOND OP + SPC1 + BOP T,-1(FS) ;BOP FIRST OP + SPC2 + MOVE O,(O) ;GET BITS FOR SECOND OP + BTOP O,(FS) ;BTOP BITS FOR FIRST + TRNE O,MGNM ;LEGAL RELOC? + JRST CPOP ;NO +Q DPB O,[POINT 4,(FS),35] +Q MOVE O,(FS) ;GET NEW BITS + JRST RRETT +> + +;HERE ARE THE ROUTINES FOR THE REDUCTION OF POLISH EXPRESSIONS BY THE ASSEMBLER +TM: 0 ;TEMP CELL FOR ROUTINES BELOW + +ADOP: AROP(ADD,,,ADD,12) +SBOP: AROP(SUB,,,SUB,12) +MULOP: AROP(IMUL,,,OR,17,<;>) +DIVOP: AROP(IDIV,,,OR,17,<;>) +ANOP: AROP(AND,,,OR,17,<;>) +OROP: AROP(OR,,,OR,17,<;>) +XROP: AROP(XOR,,,OR,17,<;>) +LSHF: AROP(LSH @ ,,,OR,17,<;>) + +REMOP: MOVE T,-1(O) ;GET SECOND OP + MOVEM FS,TM + IDIV T,-1(FS) ;DIVIDE BY FIRST OP + MOVE T,FS ;GET RESULT INTO T + MOVE FS,TM ;RESTORE FS + MOVE O,(O) ;GET BITS FOR SECOND OP + OR O,(FS) ;OR BITS FOR FIRST + JRST UNMIN2 ;CHECK FOR LEGAL RELOC + +UNMIN: MOVN T,-1(FS) ;NEGATE NUM +UNMIN1: MOVE O,(FS) ;GET BITS +UNMIN2: TRNE O,17 ;RELOC LEGAL? + JRST CPOP ;NO + JRST RRETT + +UNABS: MOVM T,-1(FS) ;ABSOLUTE VALUE + JRST UNMIN1 + +UNNOT: SETCM T,-1(FS) ;INVERT NUM + JRST UNMIN1 ;CHECK FOR LEGAL RELOC + +JFFOOP: MOVE T,-1(FS) ;GET OPERAND + MOVEM FS,TM ;SAVE T+1 + JFFO T,.+2 ;SET FS AND JUMP + MOVEI FS,44 ;T WAS ZERO. DESIRED RESULT IS 44 + MOVE T,FS ;RESULT IN T + MOVE FS,TM ;RESTORE FS + JRST UNMIN1 ;MAKE SURE WE HAVE NO RELOC PROBLEMS + +;DISPATCH TABLE FOR POLISH OPERATORS. +;RH IS ADDRESS FOR REDUCTION. +;LH IS CORRESPONDING OPERATOR FOR THE LOADER (SHIFTED BY 6) USED BY LABINS&POLOUT + +^^OPTB1:1300,,UNNOT ;10 NOT (^E) + 1500,,JFFOOP ;11  + 1400,,UNMIN ;12 UNARY - + 1700,,UNABS ;13 ABSOLUTE VALUE + 0 + 0 + 0 + 0 + 1100,,LSHF ;20  + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 1000,,OROP ;30  + 1200,,XROP ;31 XOR + 700,,ANOP ;32  + 0 + 0 + 0 + 0 + 0 + 500,,MULOP ;40 * + 0 + 600,,DIVOP ;42 / + 1600,,REMOP ;43  + 0 + 0 + 0 + 0 + 300,,ADOP ;50 + + 0 + 400,,SBOP ;52 BINARY - + +BEND + SUBTTL MEVAL -- MAIN EVALUATER ------- + +;MEVAL -- EVALUATES AN ADDRESS FIELD EXPRESSION & GENERATES +;FIXUPS. RETURNS OPCODES UNTOUCHED. +;IF MLFT IS ON, GENERATES LEFT HALF FIXUPS INSTEAD OF RIGHT. + +BEGIN MEVAL +^MEVAL: TLZ SOPF!PSOPF!PAWF!ESPF!UNDF + MOVE FS,EFSPNT + PUSHJ P,SCANS ;GET THING + TLNE SCFL ;SPEC. CHR? + JRST MSPEC ;YES + TLNE NFLG ;NUM? + JRST MNUM ;YES + TRNE B,LACF ;TERM BY _ OR :? + JRST DEFN ;YES + TLNE SOPF ;OPCODE? + TLOA OPFLG +MNUM: TLOA OPFLG ;STOP OPCODE LOOKUP + POPJ P, + TLNE B,ARFL ;ARITH OP NEXT? + JRST NONSIM ;YES + TLNN NA,DEFFL ;DEFINED? + POPJ P, ;YES + TLO UNDF ;NO, SET BIT + TRNE NOFXF ;GENERATE FIXUPS? + POPJ P, ;NO + MOVE T,OPCNT+1 ;GET CURRENT OUTPUT LOC. COUNTER BITS + TLNE T,INCF ;IN CORE? + JRST NOTHER ;YES + SKIPN O,3(PN) ;GET FIXUP POINTER + JRST NOTHER ;NONE +LOOP1: SKIPN (O) ;ZERO DEVIATION? + JRST FND1 ;YES, FOUND +LOOP2: SKIPE O,1(O) ;END OF CHAIN? + JRST LOOP1 ;NO +NOTHER: GFST O,FSTPNT ;GET SOME FREE STRG + SETZM (O) ;ZERO DEVIATION +LOOP4: MOVEM T,4(O) ;DEPOSIT CURRENT LOCAT. CNT.FLAGS + MOVE TAC,OPCNT ;GET CURRENT LOC. CNT. + MOVEM TAC,3(O) ;DEPOSIT + SETZM 2(O) ;MAKE FLAGS + TLNE MLFT ;LEFT HALF? + JRST [AOS 2(O) ;YES SET BIT + TLNE T,INCF ;IN CORE? + MOVEM O,2(TAC) ;YES + JRST SARND] + TLNE T,INCF ;IN CORE? + MOVEM O,(TAC) ;YES, SET REVERSE FIXUP PNTR. + MOVEI T,2 + TRNE FLFXF ;FULL WORD FIXUPS? + ORM T,2(O) ;YES, MARK +SARND: MOVE T,3(PN) ;FIXUP PNTR. + EXCH T,1(O) ;PUT NEW THINGS... + MOVEM O,3(PN) ;INTO CHAIN + MOVEM T,FSTPNT ;ADVANCE FREE STRG PNTR. + SETZB N,NA ;VALUE IS 0 + HRRZS O + POPJ P, + +FND1: MOVE TAC,4(O) ;GET NUM FLAGS + TLNE TAC,INCF ;IN CORE? + JRST LOOP2 ;YES + MOVE TAC,2(O) ;GET FLAGS + TLNN MLFT ;LEFT HALF NOW? + TRCN TAC,1 ;IS THIS LEFT HALF? + TRNN TAC,1 ;OR THIS? + JRST LOOP2 ;NO MATCH + TRNN FLFXF ;FULL WORD NOW? + TRCN TAC,2 ;IS THIS FULL WORD? + TRNN TAC,2 ;OR THIS? + JRST LOOP2 ;NO MATCH +FND1A: MOVE N,OPCNT ;GET NEW VALUE AND SWITCH WITH OLD. + MOVE NA,OPCNT+1 ;FOR SIMPLE FIXUP, VALUE RETURNED IS LOCATION OF + EXCH N,3(O) ;THE PREVIOUS REFERENCE. + EXCH NA,4(O) ;NEW VALUE IS LOC. CNTR. + HRRZS O + POPJ P, + NONSIM: TLZ RELEF!REUNBF ;CLEAR FLAGS + TLO OPFLG ;INHIBIT OPCODE LOOKUP + MOVE FS,EFSPNT +NONSM2_.+2 ;RET FROM REVAL + RVALUA + PUSHJ P,REDUC ;REDUCE TO VALUE IF POS. + TLNE RELEF ;RELOC ERROR? + ERROR [ASCIZ/RELOCATION ERROR/] + POP P,FS ;GET POINTER TO POLISH + SKIPGE FS ;PARENS AROUND WHOLE? + TLO PAWF ;YES + SKIPGE O,(FS) ;DEFINED? + JRST NOTDF ;NO + MOVE N,-1(FS) ;GET VALUE... + MOVE NA,O ;AND VALUE FLAGS + TLNE NA,DEFFL ;MAKE SURE UNDEF HAS BEEN SET RIGHT + TLO UNDF + POPJ P, + +NOTDF: TLO UNDF ;UNDEF. + TRNE NOFXF ;GENERATE NO FIXUPS? + POPJ P, ;NO + HRRZ T,O ;GET LEVEL + CAIE T,12 ;+ OR -? + JRST POLFIX ;NO + MOVE PN,-1(FS) ;GET POINTER TO RIGHT ARG. + MOVS T,PN ;GET POINTER TO LEFT ARG. + SKIPGE N,(PN) ;GET RIGHT ARG -- OPERAND? + JRST POLFIX ;NO + SKIPGE NA,(T) ;GET LEFT ARG. -- OPERAND? + JRST POLFIX ;NO + TLNN NA,DEFFL ;LEFT ARG DEFINED? + JRST OK1 ;YES + TLNE N,DEFFL ;RIGHT ARG DEFINED? + JRST POLFIX ;NO + TLNE O,ARMD ;+ OR -? + JRST POLFIX ;- + EXCH PN,T + EXCH NA,N ;SWITCH ARGS +OK1: TRNE NA,17 ;ANY RELOC ON LEFT ARG? + JRST POLFIX ;YES + TLNN O,ARMD ;-? + SKIPA NA,-1(T) ;NO, GET VALUE + MOVN NA,-1(T) ;YES, GET NEGATIVE VALUE + MOVE PN,-1(PN) ;GET SYMBOL TABLE POINTER +^CCFIX: MOVE T,OPCNT+1 ;GET FLAGS + TLNE T,INCF ;IN CORE? + JRST NOF ;YES + SKIPN O,3(PN) ;GET FIXUP CHAIN + JRST NOF ;NONE +SRC: SRC1(NA,O,FND2,JRST NOF) +^DBLUP: 0 +FND2: MOVE TAC,4(O) ;GET NUM FLAGS + TLNE TAC,INCF ;IN CORE? + JRST SRC+2 ;YES + MOVE TAC,2(O) ;GET FLAGS + TLNN MLFT ;LEFT HALF NOW? + TRCN TAC,1 ;IS THIS LEFT HALF? + TRNN TAC,1 ;OR THIS? + JRST SRC+2 ;NO MATCH, CONTINUE SEARCH + TRNN FLFXF ;FULL WORD NOW? + TRCN TAC,2 ;IS THIS FULL WORD? + TRNN TAC,2 ;OR THIS? + JRST SRC+2 ;NO MATCH + JRST FND1A + NOF: GFST O,FSTPNT ;GET SOME FREE STRG. + MOVEM NA,(O) ;STORE DEVIATION + JRST LOOP4 + +MSPEC: TDNN N,[XWD UNOF,LFPF!UDARF] ;( OR UP/DOWN arrow OR UNARY OP? + JRST [TLO OPFLG!ESPF + POPJ P,] + TRNE N,LFPF + JRST IXTST ;( SEE IF INDEX + TLNE N,UNOF + JRST NONSIM ;UNARY OP + SETZM DBLUP ;NO DOUBLE UP ARROW YET. + PUSH P, ;SAVE FLAGS + PUSH P,N ;SAVE UP/DOWN + TLO OPFLG ;INHIBIT OPCODE SEARCH + TRNN N,TP1F ;UP OR DOWN? + JRST MSPE2 ;UP ARROW SEEN +MSPE1: PUSHJ P,SCANS ;GET IDENTIFIER + TLNE IFLG ;IDENT SEEN? + TRNN B,LACF ;YES. WAS : or = SEEN NEXT? + JRST ERR1 ;NO IDENT OR IMPROPER TERMINATION + MOVEM L,LSTLAB+2 ;SAVE SIXBIT OF LAST NAME DEFINED + POP P,L ;GET UP/DOWN FLAG + ANDI L,TP1F!TP2F ;SET UP/DOWN ONLY + TRNE B,TP1F ;= OR : NEXT? + JRST LADF ;= NEXT + JRST PTQ1 ;: NEXT + +MSPE2: PUSHJ P,DSCANS ;GET IDENT - POSSIBLE NUMBER HERE (^D69) + TLNN IFLG ;IDENT? + JRST [TLNE NFLG ;POSSIBLE NUMBER? + JRST [SUB P,[2,,2] + JRST MNUM] ;TREAT AS NUMBER + TRNN N,TP2F ;ANOTHER ^ + JRST ERR1 ;NO -- LOSE + SETOM DBLUP ;SET ^^FLAG + JRST MSPE1] ;GOBBLE ORDINARY IDENT NEXT + TRNN B,LACF ;: OR _ NEXT? + JRST ERR1 ;NO - ERROR + MOVEM L,LSTLAB+2 ;SAVE SIXBIT + POP P,L + MOVEI L,TP2F ;SET UPARROW + TRNE B,TP1F ;_ OR :? + JRST LADF ;_ +PTQ1: MOVE NA,PCNT+1 ;GET LOCATION FLAGS + TLNE NA,INCF ;IN CORE? + JRST PTQ2 ;AVOID CONFUSION CAUSED BY LABELS IN LITERALS + MOVE N,LSTLAB+2 ;SET UP LABEL NAME + MOVEM N,LSTLAB + MOVE N,LSTLAB+3 ;AND BLOCK NAME + MOVEM N,LSTLAB+1 ;FOR ERROR MESSAGE PRINTER + MOVE N,PCNT ;GET CURRENT LOC... + MOVEM N,LSTLAB+4 ;DEPOSIT FOR ERROR PRINT +PTQ2: MOVE N,PCNT ;(NECESSARY IF WE TAKE THE SHORT CUT) + EXCH L,(P) ;GET OLD FLAGS, SAVE LABINS FLAGS + ANDCA L,[XWD OPFLG,0] ;CLEAR ALL BUT OPFLG + ANDCM L ;TURN OFF OPFLG IF IT WAS OFF + PUSHJ P,SCAN1A ;LOOK FOR ANOTHER : + POP P,L ;GET BACK FLAGS FOR LABINS + TLO L,COLONF ;MARK : TYPE + TRNN B,LACF ;ANOTHER :? + JRST .+3 ;NO + TLZ SFL ;SKIP SECOND : + TLO L,DBLF ;MARK __ TYPE (::) + PUSHJ P,LABINS ;INSERT (DEFINE) LABEL + SETZM DBLUP ;FLUSH ARROWS THAT ARE LURKING + SKIPE XCRFSW ;CREF? + SKIPN LISTSW ;YES. AND LISTING? + JRST MEVAL ;NO. + MOVEI N,2 ;YES + IDPB N,CREFPT + JRST MEVAL + + +ERR1: SUB P,[1,,1] + ERROR [ASCIZ/NO IDENT OR NO : OR _ AFTER UP-ARROW OR DOWN-ARROW/] + POP P,N + ANDCA N,[XWD OPFLG,0] ;GETSTORE ... + ANDCM N ;OLD OPFLG + JRST MEVAL + + ;HERE WHEN = OR : SEEN FOLLOWING A SYMBOL NAME +DEFN: PUSH P, ;SAVE OLD FLAGS + TLO OPFLG ;INHIBIT OPCODE LOOKUP + TLNE SOPF ;FOUND AS OPCODE? + PUSHJ P,RESCN ;YES , FIND AS LABEL + MOVEM L,LSTLAB+2 ;SAVE SIXBIT + MOVEI L, ;NO FLAGS (NO ^ OR DOWN-ARROW) + TRNN B,TP1F ;_ OR :? + JRST PTQ1 ;: +LADF: MOVEI O,0 ;INITIALIZE COUNT +LLOP: SKIPE XCRFSW ;CREF IN PROGRESS NOW? + JRST [MOVEI TAC,7 ;YES DELETE PREVIOUS SYMBOL OUTPUT + SKIPE LISTSW ;LISTING IN PROGRESS NOW? + IDPB TAC,CREFPT ;YES. + JRST .+1] + SKIPE DBLUP ;^^ SEEN? + TLO L,DBLUPF ;YES. MARK IT + SETZM DBLUP ;CLEAR CORE FLAG + PUSH P,PN ;SAVE POINTER INTO SYMTAB + PUSH P,L ;SAVE FLAGS + ADDI O,1 ;COUNT + TLZ SFL ;SKIP THE _ + CAIN C,"=" ;WAS CHAR REALLY =? + JRST EQLDEF ; = SEEN. CHECK FOR == +LLOP1: PUSHJ P,SCANS ;GET NEXT + TLNE SCFL ;SPC CHR? + JRST SCHAN ;YES + TLNN IFLG ;IDENT? + JRST LNMM ;NO, MUST BE A NUM. + TRNN B,LACF ;_ OR : NEXT? + JRST LNMM ;NO. MUST BE THE VALUE TO ASSIGN + MOVEI L,0 ;YES + JRST LLOP + +SCHAN: TRNN N,LACF ;_ OR : NEXT? + JRST SCNT ;NO + TRNN N,TP1F ;SKIP IF _ NEXT + SKIPA N,[INTF,,0] ;WAS : MUST BE =: OR ==: +SCHLA: MOVSI N,DBLF ;SET __ + ORM N,(P) ;SET FLAG (EITHER DBLF OR INTF) + JRST LLOP1 + +SCNT: TRNN N,UDARF ;^ OR DOWN-ARROW? + JRST LNMM ;NO + PUSH P,N ;SAVE CHR. + TRNN N,TP1F ;UP OR DOWN? + JRST SCNT2 ;UPARROW +SCNT1: PUSHJ P,SCANS ;GET IDENTIFIER + TLNE IFLG ;IDENT SEEN? + TRNN B,LACF ;YES, AND : OR = NEXT? + JRST ERR2 ;NO TO ONE OF ABOVE + POP P,L + ANDI L,TP1F!TP2F ;MASK OUT IRRELEVANCIES + JRST LLOP ;DO REST + +SCNT2: PUSHJ P,DSCANS ;GET IDENT (POSSIBLE NUMBER: ^D69) + TLNE NFLG ;POSSIBLE NUMBER. + JRST [SUB P,[1,,1] + JRST LNMM] ;HANDLE AS A NUMBER + TLNN IFLG ;IDENT SEEN NEXT? + JRST [TRNN N,TP2F ;ANOTHER ^ NEXT? + JRST ERR2 ;NO. AN ERROR. + SETOM DBLUP ;MARK CORE FLAG FOR ^^ + JRST SCNT1] ;FIND IDENT + TRNN B,LACF ;: OR _ NEXT? + JRST ERR2 ;NOPE, LOSE + POP P,L ;GET CHARACTER BACK + ANDI L,TP1F!TP2F ;CLEAR REST + JRST LLOP + +ERR2: SUB P,[1,,1] + ERROR [ASCIZ/NO IDENT OR NO _ AFTER UP-ARROW OR DOWN-ARROW/] + TLNN B,CRFG ;CR NEXT? + JRST LLOP1 ;NO. TRY AGAIN + TLO SFL ;SET SCAN AHEAD (AVOID ERRORS ABOUT COMMENTS + SETZB N,NA + JRST LLOP2 ;"DEFINE" THE SYMBOLS WE'VE SEEN. + +EQLDEF: PUSHJ P,SCAN1 ;KLUDGE TO MAKE == WORK + CAIN C,"=" + JRST SCHLA ;IF VERY NEXT CHAR IS =, TREAT IT AS _ + TLO SFL ;OTHERWISE REPROCESS IT NORMALLY + JRST LLOP1 + LNMM: PUSH P,O ;SAVE COUNT + MOVE FS,EFSPNT + TLZ RELEF!REUNBF ;CLEAR FLAGS + RVALUA + PUSHJ P,REDUC ;REDUCE TO VALUE + POP P,FS ;GET POINTER + TLNE RELEF ;RELOC ERROR? + ERROR[ASCIZ/RELOCATION ERROR/] + SKIPGE NA,(FS) ;DEFINED? + JRST [ ERROR[ASCIZ/UNDEFINED VALUE AFTER_/] + MOVEI NA,;THIS IS TO FIX MYSTERIOUS BUG + JRST .+1] + TLZE NA,DEFFL ;DEFINED? + JRST .-2 ;NO , ERROR + MOVE N,-1(FS) ;GET VALUE + POP P,O ;GET COUNT +LLOP2: POP P,L ;GET FLAGS + POP P,PN ;GET POINTER + SKIPE XCRFSW + CREF6 1,(PN) + PUSHJ P,LABINS ;INSERT DEFINITION + SKIPE XCRFSW + JRST [MOVEI L,2 + SKIPE LISTSW + IDPB L,CREFPT + JRST .+1] + SOJG O,LLOP2 ;COUNT, DONE? + EXCH N,WRD + EXCH NA,WRD+1 + PUSHJ P,LBLOUT ;LIST VALUE + MOVEM N,WRD + MOVEM NA,WRD+1 + POP P,N ;YES, RESTORE OPFLG ... + ANDCA N,[XWD OPFLG,0] ;... + ANDCM N ;... + SETZM DBLUP ;FLUSH ARROWS THAT ARE LURKING + JRST MEVAL + ;SAW ( CHECK FOR INDEX CONSTRUCT & GET OUT QUICKLY IF SO +IXTST: TLO OPFLG + PUSHJ P,SCANS ;SEE WHAT FOLLOWS + TRNE B,RTPF + TLNE SCFL + JRST IXTST2 ;SPEC CHR AFTER ( OR NOT ) AFTER THAT + PUSHJ P,SCAN1A + TLNE B,ARFL + JRST IXTST3 ;ARITH OP AFTER ) + TLO PAWF ;HURRAY, IT'S AN INDEX + TLNE B,SPFL + JSR SPCSKP ;MAKE SURE WE'RE PAST BLANK + TLNE NA,DEFFL + TLO UNDF + POPJ P, ;SEE HOW EASY THAT WAS + +;HERE WE SIMULATE HAVING GOTTEN THIS FAR INTO REVAL +IXTST2: TLZ RELEF!REUNBF + MOVE FS,EFSPNT + PUSH P,[16] + PUSHJ P,LFTP2 + JRST NONSM2 + +;HERE WE SIMULATE HAVING GOTTEN EVEN FARTHER INTO REVAL +IXTST3: TLZ RELEF!REUNBF + MOVE FS,EFSPNT + PUSH FS,N + PUSH FS,NA + MOVEI O,(FS) + PUSH P,[16] + PUSHJ P,PARAR + JRST NONSM2 + POLFIX: MOVE T,MTBPNT ;GET NEXT FREE AREA + MOVE N,OPCNT ;GET FIXUP LOCATION +LEG MOVEM N,2(T) ;DEPOSIT + MOVE O,OPCNT+1 ;GET FLAGS +LEG MOVEM O,3(T) ;DEPOSIT + TLNN O,INCF ;IN CORE? + JRST NOINCF ;NO + TLNE MLFT ;LEFT HALF? + JRST [HRROM T,2(N);YES -- SET REVERSE PNTR + JRST NOINCF] + HRROM T,(N) ;SET REVERSE POINTER +NOINCF: SETZM 1(T) ;CLEAR COUNT + HRRO O,T ;GET STRT POINTER + ADDI T,5 ;INCREMENT POINTER + PUSHJ P,POLMOV ;MOVE POLISH + SUBI T,1 + MOVEM T,MTBPNT ;UPDATE FREE AREA POINTER + SUBI T,(O) ;FORM LENGTH + TLNE MLFT ;LEFT HALF? + TLO T,1 ;YES + TRNE FLFXF ;FULL WORD FIXUP? + TLO T,2 ;YES + MOVSM T,(O) ;DEPOSIT + SETZB N,NA ;"VALUE" IS 0 + SKIPE 1(O) ;NO UNDEFS? + POPJ P, + MOVE T,3(O) ;GET FIXUP LOC FLAGS + TLNE T,INCF ;IN CORE? + POPJ P, ;YES + MOVE T,POLPNT ;GET CURRENT POINTER + MOVEM T,1(O) ;PUT IN... + HRRZM O,POLPNT ;CHAIN.. + POPJ P, + POLMOV: SKIPL N,(FS) ;OPERATOR OR OPERAND? + JRST OPRD ;OPERAND +LEG MOVEM N,(T) ;DEPOSIT + TLNE N,UNOF ;UNARY OP? + JRST UNPT ;YES + MOVE N,-1(FS) ;GET POINTERS + ADDI T,2 ;INCREMENT POINTER +LEG MOVSM T,-3(T) ;DEPOSIT FIRST POINTER + PUSH P,T ;SAVE NEW POINTER + PUSH P,N ;SAVE OLD POINTER + HLRZ FS,N ;SET NEW OLD POINTER + PUSHJ P,POLMOV ;PUT IN FIRST OPERAND + POP P,FS ;GET LEFT OPERAND OLD POINTER + POP P,N ;GET OLD NEW POINTER + HRRM T,-3(N) ;DEPOSIT NEW LEFT POINTER + JRST POLMOV ;MOVE LEFT OPERAND + +UNPT: MOVE N,-1(FS) ;GET OPERANDS + ADDI T,2 +LEG MOVSM T,-3(T) ;DEPOSIT NEW POINTER + HLRZ FS,N ;SET UP POINTER + JRST POLMOV + +OPRD: TLNN N,DEFFL ;DEFINED? + JRST DEFND ;YES +LEG MOVEM N,(T) ;DEPOSIT FLAGS + MOVE N,-1(FS) ;GET "VALUE" +LEG MOVEM N,-1(T) ;DEPOSIT + MOVE NA,O ;GET STRT OF POLFIX + HRLI NA,-1(T) ;GET POINTER + EXCH NA,4(N) ;INSERT POLFIX IN CHAIN +LEG MOVEM NA,1(T) ;... + ADDI T,3 ;INCREMENT + AOS 1(O) ;COUNT UNDEF SYMBOL + POPJ P, + +DEFND: +LEG MOVEM N,(T) ;DEPOSIT FLAGS + MOVE N,-1(FS) ;GET VALUE +LEG MOVEM N,-1(T) ;DEPOSIT + ADDI T,2 ;INCR. POINTER + POPJ P, +BEND + BEGIN LABINS + +COMMENT + +LABINS -- CALL, TO DEFINE A LABEL, WITH THE VALUE + IN N & NA, THE POINTER TO THE TABLE ENTRY IN + PN AND FLAGS (AS FOLLOWS) IN L (LH SAME AS IN SYM) + RH: TP1F -- DOWN-ARROW + TP2F -- ^ + LH: DBLF -- __ OR :: + COLONF -- : TYPE (ERR ON REDEF) + INTF -- ==: OR =: OCCURRED SET INTERNAL + DBLUPF -- ^^ OCCURRED IN SYMBOL ++ + +^^LVDEF: + MOVEI L, ;HERE TO DEFINE LITERALS & VARIABLES + MOVSI T,UDSF!VARF + ANDCAB T,2(PN) +^^LABINS: + HLLZ T,L + IOR T,2(PN) ;GET FLAGS + TLNE L,DBLUPF ;WAS ^^ SEEN? + SETOM DBLUP ;YES. MARK IN CORE CELL TOO. + TLZE T,EXTF + TLO T,INTF ;TURN EXTERNAL  INTERNAL IF DEFINED + TLNE T,UDSF ;UNDEFINED - DEFINED + JRST ERR ;YES + TLZN T,DEFFL ;DEFINED? + JRST DEFD ;YES + TRNE L,TP1F ;DOWN-ARROW? + OR T,DBLCK + TRNE L,TP2F ;^? + TLO T,UPARF ;YES + SKIPE DBLUP + TLO T,DBLUPF ;DOUBLE UP ARROW FLAG. + TLNE NA,INCF ;IN CORE VALUE + JRST LILHN ;YES + MOVEM T,2(PN) + EXCH N,3(PN) ;SWITCH VALUE WITH FIXUP POINTER + EXCH NA,4(PN) ;SWITCH VALUE FLAGS WITH POLFIX PNTR. + SKIPE N ;SKIP IF NO FIXUPS + PUSHJ P,GFIX ;DO FIXUPS. + MOVE N,NA + SKIPE NA ;SKIP IF NO POLFIXES. + PUSHJ P,PFIX ;DO POLFIXES + MOVE N,3(PN) ;RESTORE N ... + MOVE NA,4(PN) ;AND NA + MOVE T,2(PN) ;GET FLAGS + TLNN T,SYMFIX ;SEE IF SYMBOL TABLE FIXUP NEEDED + POPJ P, ;NO + MOVE FS,1(PN) ;BLOCK NAME + PUSHJ P,R5CON + MOVEM FS,SYMFXP+5 + MOVE FS,(PN) ;SYMBOL NAME + PUSHJ P,R5CON + MOVEM FS,SYMFXP+4 + MOVE N,3(PN) + HLRM N,SYMFXP+2 ;VALUE IN 2 HALVES + HRLM N,SYMFXP+3 + DPB NA,[POINT 1,SYMFXP+1,2] ;RELOC + LSH NA,-2 + DPB NA,[POINT 1,SYMFXP+1,1] + POUT 6,SYMFXP + MOVE NA,4(PN) ;GET RELOC BACK + POPJ P, + +^SYMFXP: 11,,4 ;SYMBOL TABLE FIXUPS + 0 ;RELOC BITS FOR SYMBOL VALUE + 1,,0 ;OPERAND,,LEFT HALF + 0,,-6 ;RIGHT HALF,,FULL-WORD SYMBOL STORE OPERATOR + 0 ;R50 SYMBOL NAME + 0 ;R50 BLOCK NAME + + +LILHN: TLO T,DEFFL!UDSF ;MARK AS UNDEFINED - DEFINED +^MAKLL: MOVEM T,2(PN) ;DEPOSIT FLAGS + GFST T,FSTPNT + MOVE FS,LABLTP ;GET POINTER TO LIST OF LIT. LABS + EXCH FS,1(T) ;CONS ON + MOVEM FS,FSTPNT + MOVEM T,LABLTP + MOVE FS,(PN) ;GET SIXBIT + MOVEM FS,(T) ;DEPOSIT + MOVE FS,LABLTC ;GET COUNT + MOVEM FS,3(T) ;DEPOSIT + MOVEM PN,4(T) ;THE LOCATION OF THE SYMBOL BLOCK + POPJ P, + ;GFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND +; FIRST FIXUP POINTER IN N. USES T,FS,L,TAC + +^GFIX: MOVSI T,REFBIT + IORM T,2(PN) ;MUST BE REFERENCED IF FIXUP NEEDED +LOOP1: MOVE FS,4(PN) ;GET FLAGS + MOVE TAC,2(N) ;GET FIXUP FLAGS + MOVE L,4(N) ;GET VALUE FLAGS + MOVE T,3(PN) ;GET VALUE + ADD T,(N) ;ADD DEVIATION + TRNE TAC,2 ;FULL WORD? + JRST FULFX ;YES + DPB L,[POINT 1,FS,34];SET LEFT HALF RELOC BIT + HRL T,3(N) ;PUT IN POINTER + TLNE L,INCF ;IN CORE? + JRST INCFX ;YES + TRNN TAC,1 ;LEFT HALF? + JRST .+4 ;NO + CAML FC,[-1,,0] + PUSHJ P,BFFRC ;FORCE BINARY AND FIXUPS: DON'T SEND -1 AS LAST WORD + FOUT LFX ;SEND -1 SIGNIFYING LEFT HALF FIXUP + FOUT T ;OUTPUT FIXUP +LOOP2: MOVE L,FSTPNT ;RETURN TO FREE STORAGE + EXCH L,1(N) ;LINK TO NEXT FIXUP INTO L + MOVEM N,FSTPNT + SKIPE N,L ;GET NEXT, DONE? + JRST LOOP1 ;DO MORE. + POPJ P, + +FULFX: TLNE L,INCF ;IN CORE? + JRST FINCFX ;YES + HRLM T,FULF+3 ;DEPOSIT VALUE + HLRM T,FULF+2 ;... + DPB FS,[POINT 1,FULF+1,2];DEP. RELOC. + LSH FS,-2 + DPB FS,[POINT 1,FULF+1,1];... + MOVE T,3(N) ;GET FIXUP PLACE + HRLM T,FULF+4 ;DEPOSIT + DPB L,[POINT 1,FULF+1,4];DEP. RELOC. + PUSHJ P,BFRC ;FORCE OUT BIN + POUT 5,FULF ;OUTPUT POLFIX + JRST LOOP2 + +LFX: -1 ;WORDS FOR LEFT HALF FIXUP + 0 + +FULF: XWD 11,3 ;FULLWORD FIXUPS + 0 + XWD 1,0 + XWD 0,-3 + 0 + +FINCFX: MOVE TAC,3(N) ;GET PLACE FULL-WORD IN-CORE FIXUP + MOVEM T,3(TAC) ;DEPOSIT VALUE... + ORM FS,4(TAC) ;& RELOC. + SETZM (TAC) + JRST LOOP2 + +INCFX: TRNE TAC,1 ;LEFT HALF? + JRST LINCFX ;YES + MOVS TAC,T ;RIGHT-HALF INCORE FIXUP + HRRM T,3(TAC) ;DEPOSIT VALUE + DPB FS,[POINT 1,4(TAC),35];DEPOSIT RELOC. + SETZM (TAC) ;ZERO REVERSE POINTER + JRST LOOP2 + +LINCFX: MOVS TAC,T ;LEFT-HALF INCORE FIXUP + HRLM T,3(TAC) ;DEPOSIT VALUE + DPB FS,[POINT 1,4(TAC),33];DEPOSIT RELOC. + SETZM 2(TAC) ;ZERO REVERSE POINTER + JRST LOOP2 + DAREDF: MOVE FS,BLOCK ;GET BLOCK BIT + TRNE L,TP2F + LSH FS,-1 + SKIPE DBLUP + MOVEI FS,1 + SUBI FS,1 ;FORM ALL HIGHER BLOCK BITS + AND FS,T ;ANY HIGHER LEVEL BITS ON + JUMPE FS,DEFD1 ;NO + SKIPE XCRFSW + JRST [MOVEI FS,7 + SKIPE LISTSW + IDPB FS,CREFPT + JRST .+1] + PUSHJ P,MKNEW ;CREATE A NEW ENTRY + ERROR [ASCIZ /WARNING - DOWN-ARROWED SYMBOL REDEFINED/] + JRST LABINS + +DEFD: TLNE T,DAF ;DOWN ARROW? + JRST DAREDF ;YES +DEFD1: TLZ T,UPARF ;CLEAR UPARROW BIT + TLNN T,COLONF + TLNE L,COLONF + JRST CHKDEF ;PROBABLY ERR IF EITHER NEW OR OLD IS : TYPE +DEFOK: TRNE L,TP1F ;DOWN-ARROW? + OR T,DBLCK + TRNE L,TP2F ;^? + TLO T,UPARF ;YES + SKIPE DBLUP + TLO T,DBLUPF + MOVEM T,2(PN) ;STORE FLAGS + MOVEM N,3(PN) ;DEPOSIT VALUE + MOVEM NA,4(PN) ;... + POPJ P, + +CHKDEF: CAMN N,3(PN) + CAME NA,4(PN) + JRST ERR + JRST DEFOK ;NOT ERR IF REDEF WITH SAME VAL + +ERR: ERROR[ASCIZ/MULTIPLE DEFINITION/] + POPJ P, + ;PFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND POLISH +; FIXUP CHAIN POINTER IN N. USES T,FS,TAC,L + +^PFIX: MOVSI T,REFBIT + IORM T,2(PN) ;INDICATE REFERENCED +PFIX1: MOVS T,N ;GET OPERAND POINTER + MOVE FS,3(PN) ;GET VALUE + MOVEM FS,(T) ;DEPOSIT + MOVE FS,4(PN) ;GET FLAGS + MOVEM FS,1(T) ;DEPOSIT + MOVE FS,2(T) ;SAVE NEXT... + MOVEM FS,T2SAV ;POINTER + SOSLE 1(N) ;DECREMENT UNDEF SYM COUNT + JRST SUL ;Some Undefs. Left + MOVEI FS,5(N) ;GET START OF POLISH + PUSH P,O ;SAVE O + PUSHJ P,REDUC ;REDUCE + POP P,O ;RESTORE O + SKIPGE FS,5(N) ;VALUE OR OPERATOR? + JRST PLOUT ;OPERATOR + MOVE L,3(N) ;GET FIXUP FLAGS + TLNE L,INCF ;IN CORE FIXUP? + JRST PINC ;YES + MOVE TAC,(N) ;GET LEFT HALF FLAG + TRNE TAC,2 ;FULL WORD? + JRST PFULX ;YES + TRNN TAC,1 ;LEFT HALF? + JRST .+4 ;NO + CAML FC,[-1,,0] + PUSHJ P,BFFRC ;FORCE BINARY AND FIXUPS NOW. (AVOID SENDING -1 AS LAST WORD) + FOUT LFX ;SEND -1 SIGNIFYING LEFT HALF FIXUP + MOVE T,4(N) ;GET VALUE + HRL T,2(N) ;GET FIXUP + DPB L,[POINT 1,FS,34];DEPOSIT FIXUP RELOC + FOUT T ;PUT OUT FIXUP +PPT1: PUSH P,B ;SAVE + PUSH P,C + HRRZ C,N ;GET START ADDRESS + HLRZ B,(N) ;GET LENGTH + ADD B,C ;GET END + PUSHJ P,MACRET ;RETURN SPACE + POP P,C ;RESTORE + POP P,B +SUL: SKIPE N,T2SAV ;GET NEXT POLFIX + JRST PFIX1 + POPJ P, ;NO MORE + PFULX: MOVE T,4(N) ;GET VALUE + HLRM T,FULF+2 ;DEPOSIT + HRLM T,FULF+3 ;... + DPB FS,[POINT 1,FULF+1,2];DEPOSIT RELOC + LSH FS,-2 + DPB FS,[POINT 1,FULF+1,1] + MOVE T,2(N) ;GET FIXUP + HRLM T,FULF+4 ;DEPOSIT + DPB L,[POINT 1,FULF+1,4];DEPO. RELOC + PUSHJ P,BFRC ;FORCE OUT BIN + POUT 5,FULF ;PUT OUT FIXUP + JRST PPT1 +PINF: MOVE T,4(N) ;GET VALUE + MOVE TAC,2(N) ;GET LIT LOC + MOVEM T,3(TAC) ;DEPOSIT VALUE + ORM FS,4(TAC) ;DEPOSIT RELOC + SETZM (TAC) + JRST PPT1 +PINC: MOVE TAC,(N) ;GET FLAGS + TRNE TAC,2 ;FULL WORD? + JRST PINF ;YES + TRNE TAC,1 ;LEFT HALF? + JRST PINCL ;YES + MOVE TAC,2(N) ;GET LIT LOC. + MOVE T,4(N) ;GET VALUE + HRRM T,3(TAC) ;DEPOSIT + SETZM (TAC) ;CLEAR REVERSE POINTER + DPB FS,[POINT 2,4(TAC),35];DEP RELOC. + JRST PPT1 +PINCL: MOVE TAC,2(N) ;GET LIT LOC. + MOVE T,4(N) ;GET VALUE + HRLM T,3(TAC) ;DEPOSIT + SETZM 2(TAC) ;CLEAR REV. PNTR. + DPB FS,[POINT 2,4(TAC),33];DEP RELOC. + JRST PPT1 + HALOUT: HRROM L,HALP1 ;DEPOSIT RIGHT HALF OF POINTER + SETCMM HALP1 ;AND COMPLEMENT IT + IBP L ;INCREMENT RELOC POINTER + TDNE L,HALP1 ;DID IT GO TO NEXT WORD? + JRST HALP2 ;YES +HALRET: +LEG IDPB TAC,HALP3 ;DEPOSIT HALFWORD + MOVSS TAC +LEG DPB TAC,L ;DEPOSIT RELOC + AOS HALP4 ;COUNT + POPJ P, + +HALP2: ADDI L,=18 ;INCREMENT RELOC POINTER +LEG SETZM (L) ; Ensure unused reloc bits will be clear + AOS HALP3 ;INCREMENT HALFWORD POINTER + JRST HALRET + +T2SAV: 0 +HALP1: 0 ; Check RH to see when reloc BP (in L) overflows wd. +HALP3: 0 ; Halfword BP into block being written +HALP4: 0 ; # of halfwords deposited in block + +PLOUT: MOVE L,3(N) ;GET FIXUP FLAGS + TLNE L,INCF ;IN CORE? + JRST SUL ;YES + MOVEI FS,5(N) + PUSHJ P,POLOUT + JRST PPT1 + ^POLOUT: + HRRZ L,MTBPNT ;GET A FREE PLACE TO PUT FIXUP + PUSH P,N ;SAVE N + ADD L,[XWD 442200,2] ;MAKE HALFWORD POINTER + SETZM HALP4 ;ZERO COUNT + MOVEM L,HALP3 ;DEPOSIT + ADD L,[440100000001-442200000002] ;MAKE RELOC POINTER +LEG SETZM (L) ; Ensure unused reloc bits will be 0 + PUSHJ P,PPFFXX ;DO FIXUP + POP P,N ;GET N + HRRZ T,(N) ;GET FLAGS + MOVN TAC,T ;FORM... + ADDI TAC,-1 ;STORE OP + PUSHJ P,HALOUT ;OUTPUT IT + MOVE TAC,2(N) ;GET FIXUP + HRL TAC,3(N) ;& RELOC + PUSHJ P,HALOUT ;OUTPUT IT + MOVE T,MTBPNT ;GET START + MOVE FS,HALP4 ;GET COUNT + TRNE FS,1 ; If it's odd, + JRST [ SETZ TAC, ; there is an empty RH left... ensure + IDPB TAC,HALP3 ; that it's clear, to avoid LINK + AOJA FS,.+1] ; %LNKJPB errors. + LSH FS,-1 ;FORM REAL COUNT + HRLI FS,11 ;BLOCK TYPE +LEG MOVEM FS,(T) ;DEPOSIT + PUSHJ P,BFRC ;FORCE OUT BINARY + MOVN TAC,HALP3 ;FORM... + ADDI TAC,-1(T) ;LENGTH + HRL TAC,T ;GET START + MOVSM TAC,HALP3 + BBOUT HALP3 + POPJ P, ;RETURN + +PPTT1: MOVS FS,-1(FS) ;GET ARG POINTER +PPFFXX: SKIPL T,(FS) ;OPERAND OR OPERATOR? + JRST POPND ;OPERAND + DPB T,[POINT 5,T,4] ;CALUCULATE OPERATOR INDEX + LDB T,[POINT 7,T,6] ;INCLUDE MODIFIER BITS + LDB TAC,[POINT 12,OPTB1-10(T),11] ;CONVERT INDEX TO LOADER'S FORMAT + JUMPN TAC,.+2 + ERROR [ASCIZ/UNKNOWN OPERATOR IN EMISSION OF POLISH FIXUP/] + PUSHJ P,HALOUT ;PUT OUT OPERATOR + MOVE T,(FS) + TLNE T,UNOF ;UNARY OP? + JRST PPTT1 ;YES + MOVE FS,-1(FS) ;GET FIRST ARG POINTER + PUSH P,FS ;SAVE + PUSHJ P,PPFFXX ;PUT OUT + MOVS FS,(P) ;GET SECOND ARG POINTER + SUB P,[1(1)] + JRST PPFFXX ;PUT OUT & RETURN + +POPND: TLNE T,DEFFL ;DEFINED? + JRST POPUN ;NO + MOVE TAC,-1(FS) ;GET VALUE + TLNN TAC,-1 ;SHORT OR LONG WORD? + TRNE T,14 ;LEFT RELOC? + JRST POPLNG ;LONG + MOVEI TAC, ;GET FLAGS + PUSHJ P,HALOUT ;PUT OUT + MOVE TAC,-1(FS) ;GET WORD + DPB T,[POINT 2,TAC,17];DEPOSIT RELOC + JRST HALOUT ;PUT OUT HALFWORD & RETURN + +POPLNG: LDB N,[POINT 2,T,32];GET LEFT RELOC + MOVEI TAC,1 + PUSHJ P,HALOUT + MOVS TAC,-1(FS) + HRL TAC,N + PUSHJ P,HALOUT ;PUT OUT LEFT HALF + HRRZ TAC,-1(FS) ;GET RIGHT HALF + DPB T,[POINT 2,TAC,17];DEPOSIT RELOC + JRST HALOUT ;PUT IT OUT & RETURN + +POPUN: MOVEI TAC,2 + PUSHJ P,HALOUT + MOVE N,-1(FS) ;GET POINTER + MOVE FS,(N) ;GET SIXBIT + PUSHJ P,R5CON ;CON TO RADIX50 + TLO FS,40000 ;MARK AS EXTERNAL (POLISH TYPE) + HLRZ TAC,FS ;PUT OUT LEFT HALF + PUSHJ P,HALOUT + HRRZ TAC,FS ;PUT OUT RIGHT HALF... + JRST HALOUT ;AND RETURN + + BEND LABINS + SUBTTL ASSMBL -- ASSEMBLES A LINE & RETURNS VALUE +; CALLED IN A STRANGE FASHION BECAUSE IT IS +; RECURSIVE AND A CO-ROUTINE + +BEGIN ASSMBL + ^NONEM__10 ;TEMP BIT USED TO MAKE NONZERO INDICATION +^RBARET:TRO TRBF ;TERM BY ] + TRNE NOFXF ;NO FIXUPS? + JRST ARET ;YES, DONT LIST + SKIPE WRD+1 + PUSHJ P,BLOUT +^ARET: RETN +^ASSMBL:TDZ[XWD OPFLG!AUNDF,ADFL!TRBF!IOSW] + SETZM WRD ;CLEAR WRD + SETZM WRD+1 +LOOP1: +LOOP2: SKIPN WRD+1 ;EMPTY SO FAR? + TRO FLFXF ;YES, TELL MEVAL TO GENERATE FULL WORD FIXUPS + PUSHJ P,MEVAL ;GET NEXT THING + TRZ FLFXF + TLNE SOPF ;OPCODE? + JRST OPCD ;YES + TLNE ESPF ;SPC CHR? + JRST SPCL ;YES + TLNE PAWF ;()? + JRST IXFLD ;YES + TRNE B,COMF ;TERM BY ,? + JRST ACFLD ;YES + TROE ADFL ;ALREADY GOT AN ADDRESS? + JRST LERRA ;YES + TLNE UNDF ;DEFINED? + TLO AUNDF ;NO + SKIPN WRD+1 ;ANYTHING YET? + JRST EMP ;NO + HRRM N,WRD ;DEPOSIT AS ADDRESS + ANDI NA,1 ;GET RELOCATION +LOOP69: ORM NA,WRD+1 ;DEPOSIT + JRST LOOP2 + EMP: MOVEM N,WRD ;DEPOSIT VALUE + HLL NA, ;GET AUNDF FLAG (MEANS FW FIXUP GENERATED) + AND NA,[AUNDF,,5] ;ISOLATE FLAG & RELOCATION + TLO NA,NONEM ;SET "NON EMPTY" + MOVEM NA,WRD+1 ;DEPOSIT + JRST LOOP2 + +LERRA: ERROR[ASCIZ/TWO ADDRESS FIELDS OR UNDEF OPCODE/] + JRST LOOP1 ;NO OR NO + +OPCD: SKIPN XCRFSW ;CREF? + JRST OPCD2 + MOVE FS,1(PN) ;PN STILL POINTS TO ENTRY, GET FLAGS + JUMPL FS,ORDOP + TLNN FS,20 ;IS IT REGULAR TYPE? + JRST ORDOP ;YES + HRRZ FS,2(PN) ;BLOCK BITS + JUMPE FS,ORDOP + CREF6 5,(PN) ;OPDEF, PUT OUT AS MACRO + SKIPA +ORDOP: CREF7 3,L ;YES +OPCD2: TLNE PSOPF ;PSEUDO OP? + JRST (NA) ;YES +^OPCDR: MOVEM N,WRD ;DEPOSIT IN WRD + TLO NA,NONEM ;SET NON-EMPTY + MOVEM NA,WRD+1 ;DEPOSIT + TRNE N,-1 + TRO ADFL ;TO WARN ABOUT MISUSED CALLIS + JRST LOOP2 + IXFLD: TLNE UNDF ;DEFINED? + ERROR[ASCIZ/UNDEFINED INDEX FIELD/] + MOVSS N + TRNE N,-1 ;RIGHT HALF ZERO? + TRON ADFL ;GOT AN ADDRESS? + JRST IXFLD1 ;NO ADDRESS YET, OR RIGHT HALF IS ZERO + TRZ N,-1 + ERROR [ASCIZ/INDEX EXPRESSION WAS TRUNCATED TO AVOID CLOBBERING ADDRESS FIELD/] +IXFLD1: ORM N,WRD ;OR INTO WRD + TRZE NA,17 ;RELOC? + ERROR [ASCIZ/RELOCATABLE INDEX FIELD/] + TLOA NA,NONEM ;SET "NON-EMPTY" +ACFL2: DPB N,[270400,,WRD] ;STORE AC FIELD +ACFL3: ORB NA,WRD+1 ;OR IN, GET OLD FLAGS + TLNE NA,AUNDF + ERROR [ASCIZ /AC OR INDEX FIELD CLOBBERED BY FIXUP/] + JRST LOOP1 + +ACFLD: PUSHJ P,SCAN1A ;GET NEXT + TRNE B,COMF ;ANOTHER ,? + JRST CCOM ;YES + TLNE UNDF ;DEFINED? + ERROR[ASCIZ/UNDEFINED AC FIELD/] + TRZE NA,17 ;RELOC? + ERROR[ASCIZ/RELOC AC FLD/] + TLO NA,NONEM ;SET "NON-EMPTY" + TRNN IOSW ;IO OP? + JRST ACFL2 ;NO + LSH N,-2 + DPB N,[POINT 7,WRD,9] + JRST ACFL3 + CCOM: TLZ SFL ;SKIP THE , + SKIPE WRD+1 ;ANYTHING ASSEMBLED YET? + ERROR [ASCIZ /ILLEGAL ,,/] ;YES -- COMPLAIN + TLNN UNDF ;UNDEFINED? + JRST CCOM2 ;NO. JUST STORE VALUE. + TLO AUNDF ;YES -- TELL SOMEONE + JUMPL O,CCPOL ;JUMP IF WE HAVE SCREWED POLISH FIXUPS. + MOVE T,4(O) ;NO WE DID A REGULAR FIXUP + JUMPE NA,CCFOK ;JUMP IF WE CREATED A NEW FIXUP +CCOM0: MOVEM N,3(O) ;RESTORE + MOVEM NA,4(O) ;OLD VALUE & FLAGS + MOVE NA,(O) ;LINKED TO WRONG THING -- GET OFFSET + TLO MLFT ;LET'S DO IT LEFT THIS TIME + PUSHJ P,CCFIX ;HAVE TO DO THIS OVER AGAIN + TLZ MLFT ;STOP DOING LEFT HALF FIXUPS, FRED - REG/JBR + JRST CCOM2 ;NOW FINISH + +CCFOK: JUMPN N,CCOM0 ;IN ABS ASSEMBLY, NEED TO TEST N TOO. + ;JUMP IF THAT WASN'T A NEW FIXUP + MOVEI T,1 ;LH ONLY + DPB T,[(200)2(O)] ;FIX FLAGS + MOVE T,4(O) ;SEE IF + TLNN T,INCF ;IN CORE? + JRST CCOM2 ;NO -- OK + MOVE T,3(O) ;YES -- WHERE? +CCRFX: SETZM (T) ;NO LONGER RH + MOVEM O,2(T) ;NOW LH REV PNTR + JRST CCOM2 ;NOW STORE + +CCPOL: MOVEI T,1 ;LH ONLY + DPB T,[(200+O)] ;FIX FLAGS IN FIXUP + MOVE T,3(O) ;SEE WHAT IT'S FOR + TLNN T,INCF ;SOMETHING IN CORE? + JRST CCOM2 ;NO -- ALL DONE + MOVE T,2(O) ;YES -- FIND OUT WHERE + JRST CCRFX ;NOW FIX REV PNTRS +CCOM2: HRLM N,WRD ;STORE LH + DPB NA,[20200,,NA] ;MOVE RELOC BITS + TRZ NA,3 ;& FLUSH FROM RH + TLO NA,NONEM ;SOMETHING THERE + TLO OPFLG ;STOP OPCODE LOOKUP + JRST LOOP69 ;SET FLAGS & GO ON + SPCL: TLNE N,CRFG!LNFD;CR? + JRST SCR ;YES + TRNE N,ATF ;@? + JRST SAT + TLNE N,RBRF ;> OR ]? + JRST RBARET ;YES, RETURN + MOVSI NA,NONEM ;PREPARE TO MAKE NON-EMPTY + TRNE N,COMF ;IF COMMA + JRST LOOP69 ;CAUSE 18-BIT TRUNCATION + ERROR[ASCIZ/UNREC SPC CHR/] + JRST LOOP1 +^ASCR: +SCR: TRNE NOFXF ;NO FIXUPS TO BE GEN'D? + JRST .+3 ;YES, DON'T LIST BINARY + SKIPE WRD+1 ;ANYTHING? + PUSHJ P,BLOUT ;YES, DEPOSIT BINARY + TLNN N,LNFD ;LINE FEED? + PUSHJ P,SCNTIL ;NO, SKIP TO IT + JRST ARET + +SAT: MOVSI N,20 ;GET @ BIT + MOVSI NA,NONEM ;GET NON-EMPTY BIT + ORM N,WRD ;DEPOSIT + ORM NA,WRD+1 ;... + JRST LOOP1 +BEND ASSMBL + BEGIN POPS  SUBTTL PSEUDO-OP ROUTINES ;BLOCK, HISEG, TWOSEG + +^%BLOCK:MOVE N,OPCNT+1 ;ILLEGAL IN LIT + TLNE N,INCF + JRST PSLIT + TRO NOFXF ;NO FIXUPS IF UNDEF + PUSHJ P,MEVAL ;GET VALUE + TRNN NA,17 + TLNE ESPF!UNDF ;SPC. CHR? + JRST BERR ;YES + JUMPGE N,.+2 + ERROR [ASCIZ/NEGATIVE ARGUMENT TO BLOCK/] + PUSHJ P,BFFRC ;FORCE OUT BINARY AND THEN FIXUPS + ADDM N,PCNT ;ADD TO LOC CNTRS + ADDM N,OPCNT ;.... + HRRZS PCNT + HRRZS OPCNT + SETZM WRD+1 + SOS OPCNT + PUSHJ P,VBLOUT + AOS OPCNT + MOVE N,OPCNT + CAMGE N,BRK ;HIGH SEGMENT? + JRST .+5 ;NO,LOW SEG + CAMGE N,HICNT ;YES, IS OPCNTHICNT? + JRST .+5 ;NO + MOVEM N,HICNT ;YES,INCREMENT HIGH + JRST .+3 + CAML N,@CURBRK ;IS OPCNTLOCNT? + MOVEM N,@CURBRK ;YES,INCREMENT LOW + JRST SPCFN +BERR: ERROR[ASCIZ/NOT EXPRESSION AFTER BLOCK/] + SETZM WRD+1 + JRST SPCFN + + +^%HISEG:SETZM WRD+1 + SETOM SEG + MOVEI N,400000 + MOVEM N,OPCNT + MOVEM N,PCNT + MOVEM N,DPCNT + HRRM N,HIBLK+2 + MOVEI N,1 + MOVEM N,OPCNT+1 + MOVEM N,PCNT+1 + MOVEM N,DPCNT+1 + SETZM BRK + POUT 3,HIBLK + JRST SPCFN + +HIBLK: XWD 3,1 + XWD 200000,0 + XWD 400000,400000 + +^%TWOSEG:TRO NOFXF + SETOM SEG + PUSHJ P, MEVAL + MOVEM N,NA + SETZM WRD+1 + TLNE ESPF ;ARGUMENT? + MOVEI N,400000 ;NO + TLNE UNDF ;YES. DEFINED? + JRST TWOERR ;NO. ERROR + HRRZM N,BRK + HRRM N,HIBLK+2 + POUT 3,HIBLK ;YES + MOVE N,NA + TLNN ESPF + JRST SPCFN + JRST NSPCFN + +TWOERR: ERROR[ASCIZ/TWOSEG ARGUMENT UNDEFINED./] + JRST SPCFN + ; ASCII, ASCIZ, ASCID, .TEXT SPCFN,SCR +TM1: 0 + +^%ASCII: + TLZ SFL ;CLEAR SCAN AHEAD + MOVEM N,TM1 ;SAVE VALUE (-1=ASCID,0=ASCII,1=ASCIZ,2=.TEXT) + HRRM C,TM2 ;SAVE TERM CHR. + HRRM C,TXM2 ;SAVE TERM CHR FOR TEXT TOO. + +;IN CASE OF ACCIDENT, WE SAVE WHERE WE STARTED. + SKIPN C,TLBLK ;GET SOS LINE NUMBER + HRRO C,INLINE ;NONE. USE OUR COUNT + MOVEM C,TXLIN ;SAVE AS LINE NUMBER WHERE TEXT PSEUDO-OP BEGINS + MOVE C,PGNM ;GET PAGE NUMBER + MOVEM C,TXTPG ;SAVE PAGE WHERE TEXT PSEUDO-OP BEGINS + +NOTNX,< MOVE C,[FILNM,,TXTFIL] + BLT C,TXTFIL+4 ;SAVE CURRENT FILE NAME >;NOTNX + +TNX,< MOVE C,JFNTBL + MOVEM C,TXTFIL ;JFN OF THE FILE >;TNX + + CAIN N,2 ;.TEXT? + JRST TXLP2 ;YES. + +LOOP2: MOVEI N, ;CLEAR + MOVEI NA,5 ;COUNT +LOOP1: PUSHJ P,SCAN1 ;GET CHR. +TM2: CAIN C,0-0 ;TERM CHR? + JRST FND ;YES + LSH N,7 ;NO,SHIFT + OR N,C ;AND INSERT + SOJG NA,LOOP1 ;5 CHRS? + LSH N,1 ;YES + SKIPGE TM1 ;ASCID? + ORI N,1 ;YES + MOVEM N,WRD ;DEPOSIT VALUE + MOVSI N,NONEM ;PREPARE FLAGS + MOVEM N,WRD+1 ;DEPOSIT + PUSHJ P,BLOUT ;LIST BINARY + RETN ;COROUTINE RETURN + JRST LOOP2 ;CONTINUE + +FND: SETZM TXTPG ;CLEAR STATE OF BEING INSIDE TEXT-OP + CAIN NA,5 ;NONE IN THIS WORD? + JRST NONW ;YES, NONE + LSH N,7 ;ADJUST + SOJG NA,.-1 ;... + LSH N,1 + SKIPGE TM1 ;ASCID? + ORI N,1 ;YES + MOVEM N,WRD ;DEPOSIT VALUE +LOP1: MOVSI N,NONEM + MOVEM N,WRD+1 ;SET FLAGS +^SPCFN: TRZ NOFXF + PUSHJ P,SCAN1 ;GET CHR. + TLNN B,CRFG!RBRF ;CR, OR ], OR >? + JRST SPCFN ;NO + TLNE B,CRFG ;CR? + JRST SCR ;YES. + TLO SFL ;SET SCANNER AHEAD TO RESCAN ] OR > + PUSHJ P,SCAN ;EXIT SCAN VIA SPCRET, DOING GOOD THINGS + JRST RBARET ;RETURN FROM ASSMBL FOR ] OR > + +^SCR: SKIPE WRD+1 ;ANYTHING? + PUSHJ P,BLOUT ;YES. LIST IT. + TLNN B,LNFD ;LF YET? + PUSHJ P,SCNTIL ;NO, GET TO IT + JRST ARET + +NONW: SETZM WRD ;ZERO WORD + SKIPLE TM1 ;ASCIZ? + JRST LOP1 ;YES, RETURN 0 + SETZM WRD+1 ;"NOTHING ON LINE" + JRST SPCFN ;RETURN + + +TXLP2: SETZB N,WRD+1 ;CLEAR AC + MOVEI NA,5 ;COUNT +TXLP1: PUSHJ P,SCAN1 ;GET CHR. +TXM2: CAIN C,0-0 ;TERM CHR? + JRST TXFND ;YES + LSH N,7 ;NO,SHIFT + IORI N,(C) ;AND INSERT + SOJG NA,TXLP1 ;5 CHRS? +TXLP3: LSH N,1 ;YES. MOVE ONE MORE + MOVEM N,WRD ;DEPOSIT VALUE + POUT 1,WRD ;WRITE THE WORD IN THE BINARY + PUSHJ P,LBLOUT ;LIST BINARY + SKIPE TM1 ;LAST TIME THRU? + JRST TXLP2 ;NO. CONTINUE + JRST SPCFN ;FLAG NOTHING IN WORD. RETURN + +TXFND: SETZM TXTPG ;CLEAR STATE OF BEING INSIDE TEXT-OP + LSH N,7 ;ADJUST + SOJG NA,.-1 ;... + SETZM TM1 ;FLAG EXIT FROM .TEXT + JRST TXLP3 + ; XWD NSPCFN .RCTAB .WCTAB + +^%XWD: TLO MLFT ;LEFT HALF + PUSHJ P,MEVAL + TLNE ESPF ;SPC CHR? + JRST XER ;YES - ERROR + TRNN B,COMF ;TERM BY ,? + ERROR [ASCIZ/NO COMMA AFTER XWD OR BLANK FIELD/] + TRNE NA,14 ;LEFT HALF RELOC? + ERROR [ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/] + PUSH P,N ;SAVE + PUSH P,NA ;SAVE + TRNE B,COMF ;IF NOT COMMA, DON'T SKIP DELIM. + PUSHJ P,SCAN ;SKIP THE , + TLNE B,CRFG!RBRF ;NOTHING MORE? + JRST [SETZB N,NA ;NO. USE ZERO FOR RIGHT HALF. + JRST XWD3] + TLZ MLFT ;NO LONGER LEFT HALF + PUSHJ P,MEVAL + TLNE ESPF ;SPC CHR? + JRST XERQ ;YES + TRNE NA,14 ;LEFT HALF RELOC? + ERROR [ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/] +XWD3: TLO NA,NONEM + MOVEM N,WRD ;DEPOSIT VALUE + MOVEM NA,WRD+1 + POP P,NA ;GET BITS + DPB NA,[POINT 2,WRD+1,33] ;DEPOSIT RELOC + POP P,NA ;GET VALUE + HRLM NA,WRD ;DEPOSIT + JRST SPCFN + +XERQ: SUB P,[2,,2] +XER: ERROR [ASCIZ/NO EXPRESSION AFTER XWD/] +^NSPCFN:TLNN N,CRFG!RBRF ;CR RET? + JRST SPCFN ;NO + TRZ NOFXF + TLNE N,CRFG ;CR? + JRST ASCR + JRST RBARET + +^%RCTAB:TRO NOFXF + PUSHJ P,MEVAL ;GET CHAR TO READ + TRNN NA,17 ;NO RELOC ALLOWED + TLNE UNDF!ESPF + JRST CHERR + ANDI N,177 + MOVE N,CTAB(N) + MOVEM N,WRD + SETZM WRD+1 + JRST SPCFN + +CHERR2: ERROR [ASCIZ/NO COMMA IN .WCTAB/] + JRST SPCFN + +CHERR3: POP P,(P) +CHERR: ERROR [ASCIZ/ILLEGAL VALUE TO CTAB/] + JRST SPCFN + +^%WCTAB:TRO NOFXF + PUSHJ P,MEVAL ;GET CHAR TO SET + TRNN NA,17 + TLNE UNDF!ESPF + JRST CHERR + TRNN B,COMF + JRST CHERR2 + PUSH P,N ;SAVE CHAR + PUSHJ P,SCAN ;SKIP , + TRO NOFXF + PUSHJ P,MEVAL ;VALUE TO SET IT TO + TRNN NA,17 + TLNE UNDF!ESPF + JRST CHERR3 + POP P,TAC + ANDI TAC,177 + MOVEM N,CTAB(TAC) + JRST SPCFN + + ; LIT, RADIX +^%LIT: MOVE N,OPCNT+1 + TLNE N,INCF + JRST PSLIT ;NOT IN LIT + PUSHJ P,LITOUT + SETZM WRD+1 + JRST SPCFN + +^%RADIX:TRO NOFXF + PUSHJ P,MEVAL ;GET VALUE + TRNN NA,17 + TLNE ESPF!UNDF ;SPC. CHR? + JRST RERR ;YES + PUSHJ P,RADX ;SET RADIX + SETZM WRD+1 + JRST SPCFN + +RERR: ERROR[ASCIZ/NOT EXPRESSION AFTER RADIX/] + TLNE ESPF + JRST NSPCFN + JRST SPCFN + +^RADX: MOVE NA,[IMULI N,];PREPARE INSTRUCTION + HRR NA,N + CAIN N,10 ;OCTAL? + MOVE NA,[LSH N,3];YES + MOVEM NA,SRAD ;SET RADIX + MOVE NA,CTAB+"0" + ADDI NA,(N) + MOVEM NA,RTEST + POPJ P, + ; DEC AND OCT, %IO - HANDLE MACHINE IO OPCODES, PSLIT + +CONSVR: 0 +CONSVT: 0 + +^%CON: MOVE TAC,SRAD ;SAVE CURRENT RADIX - OCT AND DEC + MOVEM TAC,CONSVR + MOVE TAC,RTEST + MOVEM TAC,CONSVT + PUSHJ P,RADX ;SET RADIX + MOVSI N,NONEM + MOVEM N,WRD+1 +CONLOP: PUSHJ P,SCANM ;GET NUM + TLNN NFLG ;NUM? + JRST CONERR ;NO + MOVEM N,WRD ;DEPOSIT NUMBER + TRNN B,COMF ;TERM BY ,? + JRST CONLST ;NO, LAST ONE + PUSHJ P,BLOUT ;PRINT BINARY + RETN ;CO-ROUTINE WILL RETURN BELOW FOR NEXT + TLZ SFL ;SKIP THE , + JRST CONLOP + +CONERR: ERROR [ASCIZ/NOT A NUMBER/] +CONLST: MOVE TAC,CONSVR ;RESTORE RADIX + MOVEM TAC,SRAD + MOVE TAC,CONSVT + MOVEM TAC,RTEST + JRST SPCFN + + +^%IO: TRO IOSW ;TURN ON IO SWITCH - HARDWARE I/O MNEMONIC SEEN. + MOVEI NA, ;CLEAR OUT BITS + JRST OPCDR ;PROCEED + +^PSLIT: ERROR [ASCIZ /ILLEGAL PSEUDOOP IN LITERAL/] + ADD P,[17,,17] + MOVEM 16,(P) + MOVEI 16,-16(P) + BLT 16,-1(P) + MOVE 16,(P) + MOVEI 3,LITMS + PUSHJ P,FMES ;LITERAL LINE N PAGE P FILE FOO.BAR + MOVSI 16,-16(P) + BLT 16,16 + SUB P,[17,,17] + SETZM WRD+1 + JRST SPCFN + ; PHASE, DEPHASE, LIST, XLIST, XLIST1, COMMENT + +PERR: ERROR [ASCIZ/UNDEFINED OR SPECIAL CHR/] + JRST SPCFN + +^PHAZ: MOVE N,OPCNT+1 ;PHASE + TLNE N,INCF + JRST PSLIT ;NOT LEGAL IN LITERAL + TRO NOFXF + PUSHJ P,MEVAL ;GET VALUE + TLNE UNDF!ESPF ;DEFINED? + JRST PERR ;NO. LOSE + MOVEM N,PCNT ;DEPOSIT VALUE... + MOVEM NA,PCNT+1 ;RELOCATION + JRST SPCFN + +^DPHAZ: MOVE N,OPCNT+1 + TLNE N,INCF + JRST PSLIT + MOVE N,[XWD OPCNT,PCNT] + BLT N,PCNT+1 + JRST SPCFN + +^%LIST: JUMPE N,LST1 ;JUMP IF LIST + JUMPL N,LST2 ;JUMP IF XLIST + SKIPN XL1IG ;SKIP IF IGNORE XLIST1 (/I SWITCH) +LST2: SETOM XL2SW ;XLIST: TERMINATE LISTING + JRST SPCFN + +LST1: SETZM XL2SW ;TERMINATE THINKING ABOUT XLIST + SKIPN LISTSW ;LISTING DEVICE EXISTS? + JRST SPCFN ;NO + TRO LDEV ;YES. START LISTING + MOVE N,LSTPNT ;GET THE LISTING BYTE POINTER + MOVEI NA,0 +REPEAT 5,< IDPB NA,N > ;STUFF NULL BYTES IN + SETZM (N) + HRLI N,(N) + ADDI N,1 + BLT N,LTEST-1 ;CLEAR OUT THE LISTING BUFFER + JRST SPCFN + +^%COMMT: ;COMMENT + SKIPN TAC,TLBLK ;REPEAT 0 + HRRO TAC,INLINE + MOVEM TAC,REPPG + MOVE TAC,PGNM + MOVEM TAC,REP0PG +NOTNX,< MOVE TAC,[FILNM,,REPFIL] + BLT TAC,REPFIL+4 +>;NOTNX +TNX,< + MOVE TAC,JFNTBL + MOVEM TAC,REPFIL ;SAVE JFN OF FILE +>;TNX + PUSHJ P,SLURPC ;EAT EVERYTHING UP TO MATCHING CHAR + SETZM REP0PG + JRST SPCFN + ; BYTE +^%BYTE: TRNN B,LFPF ;( NEXT? + JRST BERR1 ;NO + SETZM WRD + TRO NOFXF ;NO FIXUPS + MOVE N,[POINT 3,WRD] + MOVEM N,PNTR +PARLOP: PUSH P,SRAD ;SAVE RADIX + PUSH P,RTEST + MOVEI N,12 + PUSHJ P,RADX ;CONVERT TO DEC. + PUSHJ P,MEVAL ;GET VALUE + TLNN PAWF ;()? + ERROR[ASCIZ/AMBIGUITY ERROR/] + TLNE UNDF!ESPF ;UNDEF OR SPC CHR? + ERROR[ASCIZ/UNREC OR UNDEF SIZE/] + TRNE NA,17 ;RELOC FIELD? + ERROR[ASCIZ/RELOC SIZE/] + POP P,RTEST + POP P,SRAD ;RESTORE RADIX + DPB N,[POINT 6,PNTR,11];DEPOSIT SIZE + TRNE B,LFPF ;( NEXT? + JRST PARLOP ;YES + TRNE B,COMF ;, NEXT? + JRST NULF ;YES +BLOP: PUSHJ P,MEVAL ;GET NEXT BYTE + TLNE UNDF ;UNDEF? + ERROR[ASCIZ/UNDEF BYTE/] + TRNE NA,17 ;RELOC? + ERROR[ASCIZ/RELOC BYTE/] + TLNE ESPF ;SPC CHR? + ERROR[ASCIZ/SPC. CHR. IN BYTE FIELD/] +DBYT: IDPB N,PNTR ;DEPOSIT + HRRZ NA,PNTR ;DID WE ADVANCE... + CAIE NA,WRD ;TO NEXT WORD? + JSR GOTWRD ;YES + TRNN B,COMF ;, NEXT? + JRST NOCOM ;NO + PUSHJ P,SCAN ;GET THE , + TRNE B,COMF ;, NEXT? + JRST NULF ;YES + TRNN B,LFPF ;( NEXT? + JRST BLOP ;NO +NULF: SETZB N,NA ;ZERO BYTE + JRST DBYT +NOCOM: TRNE B,LFPF ;(NEXT? + JRST PARLOP ;YES + MOVSI N,NONEM + MOVEM N,WRD+1 + TRZ NOFXF ;RESTORE + JRST SPCFN ;LEAVE, THROUGH + +GOTWRD: 0 + MOVSI N,NONEM ;MARK WRD+1... + EXCH N,WRD+1 ;AND GET NEXT BYTE... + MOVEM N,NSAV ;& SAVE + PUSHJ P,BLOUT ;LIST BINARY + RETN ;RETURN THIS WORD + MOVE N,NSAV + MOVEM N,WRD ;GET SAVED BYTE + SOS PNTR ;ADJUST PNTR + JRST @GOTWRD + +BERR1: ERROR[ASCIZ/NOT SIZE FIELD AFTER BYTE/] + JRST SPCFN +PNTR: 0 +NSAV: 0 + ; POINT +^%POINT:PUSH P,SRAD ;SAVE CURRENT RADIX + PUSH P,RTEST + MOVEI N,12 + PUSHJ P,RADX ;SET RADIX TO DEC. + TRO NOFXF ;NO FIXUPS THIS FIELD + PUSHJ P,MEVAL + TRNN NA,17 + TLNE UNDF!ESPF ;SPC CHR. OR UNDEF? + JRST PER1 ;YES + POP P,RTEST + POP P,SRAD ;RESTORE RADIX + SETZM WRD + SETZM WRD+1 + DPB N,[POINT 6,WRD,11];DEPOSIT SIZE + TRNN B,COMF ;, NEXT? + JRST PER2 ;NO + TLZ SFL ;SKIP THE , +PPT3: TRZ ADFL!NOFXF ;FIXUPS OK NOW +PLOP: PUSHJ P,MEVAL ;GET NEXT EXPR. + TLNE ESPF ;SPC. CHR? + JRST PSPC ;YES + TLNE PAWF ;()? + JRST PAWT ;YES + TROE ADFL ;GOT AN ADDRESS ALREADY? + JRST LERR ;YES + HRRM N,WRD ;DEPOSIT ADDRS. + ORM NA,WRD+1 ;DEPOSIT RELOC +PPT: TLNE B,CRFG!RBRF ;CR OR ] OR >? + JRST PEND ;YES + TRNN B,COMF ;TERM BY ,? + JRST PLOP ;NO + TLZ SFL ;SKIP THE , +PPT2: MOVSI NA,NONEM + ORM NA,WRD+1 + TRO NOFXF + PUSH P,SRAD ;SAVE RADIX + PUSH P,RTEST + MOVEI N,12 + PUSHJ P,RADX ;SET TO DEC. + PUSHJ P,MEVAL ;GET VALUE + TRNN NA,17 + TLNE ESPF!UNDF ;SPC CHR. OR UNDEF? + JRST PER3 ;YES + MOVNS N ;INVERT & ADD... + ADDI N,43 ;43 + DPB N,[POINT 6,WRD,5] ;& DEPOSIT +PPT1: POP P,RTEST + POP P,SRAD + TRZ NOFXF + JRST SPCFN + +PAWT: MOVSS N ;SWAP HALVES + TRNE NA,17 ;RELOC? + ERROR[ASCIZ/RELOC INDEX FIELD/] + TLZ N,777760 ;CLEAR PART + ORM N,WRD ;OR IN + TLNE UNDF ;DEFINED? + ERROR[ASCIZ/UNDEF INDEX FIELD/] + JRST PPT + +PSPC: TRNE N,COMF ;,? + JRST PPT2 ;YES + TRNE N,ATF ;@? + JRST PSAT ;YES + ERROR[ASCIZ/UNREC SPC CHR/] + JRST PPT + +PSAT: MOVSI N,20 ;GET @ BIT + ORM N,WRD ;DEPOSIT + JRST PPT + +PEND: MOVEI NA,44 ;GET 44 + DPB NA,[POINT 6,WRD,5];DEPOSIT AS POSITION + MOVSI NA,NONEM ;MARK NONEMPTY + ORM NA,WRD+1 + JRST SPCFN + +PER1: ERROR[ASCIZ/UNREC, UNDEF, OR RELOC SIZE/] + JRST PPT1 + +PER2: ERROR[ASCIZ/NO COMMA AFTER SIZE/] + JRST PPT3 + +PER3: ERROR[ASCIZ/UNREC, UNDEF, OR RELOC POSITION/] + JRST PPT1 + +LERR: ERROR[ASCIZ/UNREC SYNTAX/] + JRST PPT + ; SIXBIT +^%SIX: TLZ SFL ;SKIP CHR. + MOVEM N,TM1 ;SAVE VALUE (OF OP) + HRRM C,TM3 ;SAVE TERM CHR. + +;IN CASE OF ACCIDENT, WE SAVE SOME THINGS HERE + SKIPN C,TLBLK + HRRO C,INLINE + MOVEM C,TXLIN + MOVE C,PGNM + MOVEM C,TXTPG +NOTNX,< MOVE C,[FILNM,,TXTFIL] + BLT C,TXTFIL+4 +>;NOTNX +TNX,< + MOVE C,JFNTBL + MOVEM C,TXTFIL ;SAVE JFN +>;TNX + +LOPS2: MOVEI N, ;CLEAR + MOVEI NA,6 ;COUNT +LOPS1: PUSHJ P,SCAN1 ;GET CHR. +TM3: CAIN C, ;TERM CHR? + JRST SFND ;YES + LSH N,6 ;NO, SHIFT + TRZN C,100 ;CONVERT... + TRZA C,40 ;TO... + TRO C,40 ;SIXBIT + OR N,C ;INSERT + SOJG NA,LOPS1 ;6 CHRS? + MOVEM N,WRD ;YES + MOVSI NA,NONEM ;PREPARE FLAGS + MOVEM NA,WRD+1 ;DEPOSIT + PUSHJ P,BLOUT ;LIST BINARY + RETN ;RETURN WRD + JRST LOPS2 + +SFND: SETZM TXTPG + CAIN NA,6 ;NONE IN THIS WORD? + JRST SNON ;NONE + LSH N,6 ;ADJUST + SOJG NA,.-1 ;... + MOVEM N,WRD ;DEPOSIT VALUE + MOVSI NA,NONEM ;AND... + MOVEM NA,WRD+1 ;FLAGS + JRST SPCFN ;RETURN + +SNON: SETZM WRD+1 + JRST SPCFN + ; OPDEF + +OPERR1: ERROR [ASCIZ/NO IDENTIFIER AFTER OPDEF/] + SETZM WRD+1 + JRST SPCFN + +OPERR2: SUB P,[1,,1] + ERROR [ASCIZ/VALUE OF OPDEF MUST BE DEFINED -- USE A MACRO/] + SETZM WRD+1 + JRST SPCFN + +^OPDTMP:0 + +^%OPDEF:SKIPA N,BLOCK ;DEFINE AT CURRENT BLOCK +^%GOPDE:MOVEI N,1 ;DEFINE AT OUTERMOST BLOCK (GOPDEF) + MOVEM N,OPDTMP ;STORE BLOCK LEVEL FOR THIS DEFINITION. + PUSHJ P,SCAN ;GET SIXBIT + TLNN IFLG ;IDENT? + JRST OPERR1 ;NO. ILLEGAL + PUSH P,L ;SAVE SIXBIT +OPDF1A: PUSHJ P,SCAN ;GET NEXT + TLNN SCFL ;SPC. CHR? + JRST OPDF1A ;NO. IGNORE IT. + TLNN N,LBRF ;[ OR ? + ERROR [ASCIZ/UNRECOGNIZED TERMINATION CHARACTER -- OPDEF/] + POP P,L ;GET SIXBIT + PUSHJ P,OPDINS ;INSERT OPDEF +OPDF4: SKIPE XCRFSW + CREF6 6,(PN) + PUSHJ P,LBLOUT + TRZ NOFXF + SETZM WRD+1 + JRST SPCFN + +;CALL OPDINS WITH L=SIXBIT, WRD,WRD+1 SETUP, AND OPDTMP SETUP TO BLOCK +^OPDINS:MOVE N,L + IDIVI N,HASH ;HASH + MOVM NA,NA + SKIPN PN,OPCDS(NA) + JRST OPDF2 ;NO PREVIOUS DEFINITION. + SRC2 L,PN,OPDFF ;CHECK FOR PREVIOUS DEFINITION +OPDF2: MOVEI NA,OPCDS-1(NA) ;SEARCH FOR PLACE TO INSERT NEW DEF. + ;NA_"PREVIOUS ITEM". +OPDF2A: SKIPN T,1(NA) ;T_"NEXT" + JRST OPDF2B ;NO NEXT. INSERT AFTER (NA) + SKIPL PN,1(T) ;IS "NEXT" PERMANENT? + TLNN PN,20 ;NO. SKIP IF MADE BY OPDEF + JRST OPDF2B ;"NEXT" IS PERMANENT. INSERT AFTER (NA) + HRRZ PN,2(T) ;GET BLOCK BITS + CAMG PN,OPDTMP ;SKIP IF "NEXT" IS NESTED DEEPER THAN THIS DEF. + JRST OPDF2B ;"NEXT" IS AT SAME OR OUTER LEVEL AS THIS DEF. + MOVE NA,T + JRST OPDF2A + +OPDF2B: GFST PN,FSTPNT ;INSERT DEFINITION + MOVEM L,(PN) ;DEPOSIT SIXBIT + MOVSI N,20 ;MARK THIS OPCODE WAS DEFINED BY THE USER + HRR N,1(NA) ;INSERT... + EXCH N,1(PN) ;IN LIST + HRRM PN,1(NA) + MOVEM N,FSTPNT + MOVE N,OPDTMP + MOVEM N,2(PN) ;SET BLOCK BIT +OPDF3: MOVE T,WRD + MOVE N,WRD+1 + MOVEM T,3(PN) ;INVALIDATE EACH INTERMEDIATE DEFINITION. + MOVEM N,4(PN) + POPJ P, + +OPDFF: SKIPL N,1(PN) ;HERE IF PREVIOUS DEFINITION EXISTS. CHECK ITS TYPE + TLNN N,20 ;SKIP IF OLD DEFINITION WAS BY OPDEF. + JRST OPDF2 ;OLD IS PERMANENT - MUST INSERT NEW + HRRZ T,2(PN) ;BLOCK NUMBER OF PREVIOUS DEFINITION. + CAMN T,OPDTMP + JRST OPDF3 ;SAME BLOCK - CLOBBER VALUE OF OLD DEF. + MOVE T,OPDTMP + CAIE T,1 ;IS THIS .GOPDEF? + JRST OPDF2 ;NO. INSERT LOCAL DEFINITION. + MOVE T,3(PN) ;INVALIDATE EACH INTERMEDIATE DEFINITION. + MOVE N,4(PN) + CAMN T,WRD + CAME N,WRD+1 + ERROR [ASCIZ/AN OPDEF, GLOBAL TO THIS BLOCK, IS BEING CHANGED/] + HRRZ PN,PN + MOVEI N,OPCDS-1(NA) ;N_"PREVIOUS NODE ADDRESS" +OPDFF1: HRRZ T,1(N) ;T_NEXT NODE ADDRESS + CAIN T,(PN) ;SAME AS THE ONE WE'RE DELETING? + JRST OPDFF2 ;YES. DELINK THIS NODE. + MOVEI N,(T) ;MAKE THIS NODE THE "PREVIOUS NODE" + JRST OPDFF1 + +OPDFF2: EXCH PN,FSTPNT ;FREE LIST POINTS TO (PN). PN CONTAINS FREE POINTER + EXCH PN,1(T) ;PN_REMAINDER OF OPCODE CHAIN. FREE LIST RESTORED. + HRRM PN,1(N) ;STORE IN PREVIOUS NODE. + JRST OPDINS ;DIFFERENT BLOCK - INSERT NEW + ; .LOAD AND .LIBRARY PSEUDO-OPS + +;FORMAT IS .LOAD DEV:FILE[PRJ,PRG] +; OR .LOAD DEV:FILE.REL[PRJ,PRG] + +;FILE EXTENSION REL IS ASSUMED, IF AN EXTENSION IS SEEN, IT MUST BE REL. +;THIS USES THE SAME SCANNER AS THE COMMAND LINE SCANNER! MODIFIERS BEWARE!! + +;IF ANYBODY EVER FIXES THE LOADER, THIS SHOULD BE TENEXIZED... + +LIBBLK: 0,,3 ;BLOCK TYPE 16 (OR 17), 3 DATA WORDS + 0 ;RELOCATION IS ZERO + 0 ;FILE NAME (SIXBIT) + 0 ;PPN (WHATEVER'S RIGHT) + 0 ;DEVICE (SIXBIT) + +^%LBLCK: + HRLM N,LIBBLK ;STORE THE REQUEST TYPE (16 OR 17) + SETZM LIBBLK+1 + PUSH P,CP ;SAVE FOR LATER. VERY IMPORTANT + PUSH P,O ;THIS MAY BE NEEDED + PUSH P,FNREAD ;SAVE NORMAL COMMAND LINE READER. + MOVE N,[PUSHJ P,AFSCAN] + MOVEM N,FNREAD + +ITS,< PUSH P,LIMBO >;ITS + +NOTNX,< MOVSI 1,'DSK' ;ASSUMED DEVICE + SETZB 5,4 ;NO ASSUMED NAME OR PPN + MOVSI 3,'REL' ;ASSUME EXT>;NOTNX + + +;GETFIL CALLS SCAN1. CLOBBERS AC'S 0-13. +;0 IS SETUP CORRECTLY +;1,2,4,5,6,13 ARE CONSIDERED SCRATCH (T,FS,N,NA,PN,TAC) +;10,11 (B,C) ARE SET CORRECTLY TO LAST CHARACTER SEEN +;3,7 (O,CP) ARE PRESERVED BY PUSHING AND POPPING + +NOTNX,< JSR GETFIL ;GET A FILE NAME + JRST LIBER1 ;ERROR: Can't parse name + JUMPE 3,LBLCK1 ;HAPPY WITH NO EXTENSION + CAME 3,['REL '] + ERROR [ASCIZ/EXTENSION MUST BE REL/] +LBLCK1: MOVEM 1,LIBBLK+4 ;STORE DEVICE + MOVEM 4,LIBBLK+3 ;STORE PPN + MOVEM 5,LIBBLK+2 ;STORE FILE NAME +>;NOTNX + +TNX,< PUSHJ P,TGETFY ;GET TENEX FILE SPEC + JRST LIBER1 ;CAN'T PARSE NAME + MOVEI 3,0 + IDPB 3,1 ;NULL TO FINISH TEXT STRING + MOVSI 1,(1B2) ;OLD ONLY. + MOVEM 1,GTTBL + MOVEI 1,[ASCIZ/REL/] ;DEFAULT EXTENSION OF REL. + MOVEM 1,GTEXT + MOVEI 1,GTTBL ; GET A JFN FROM THIS MESS. + HRROI 2,GTNAM ; STRING START THERE. + GTJFN + JRST [OUTSTR [ASCIZ/CAN'T FIND /] + OUTSTR GTNAM + OUTSTR [ASCIZ/, PASSING FILE NAME TO LINKER +/] + MOVSI 1,(1B12!1B17) ; JUST TRY FOR THE FAKE FILE NAME + HRROI 2,GTNAM ; AND LET LINK DO THE REST. + GTJFN + JRST LIBER1 ; THROW UP OUR HANDS IN DISGUST. + JRST .+1] ; ELSE WIN. + HRRZM 1,LIBBLK+1 ;A SAFE PLACE. + SETZM LIBBLK+4 ;CLEAR DEVICE FIELD + MOVE 1,[POINT 7,GTNAM1] ;A PLACE TO PUT DEVICE STRING + MOVE 2,[POINT 7,GTNAM] ;FROM HERE +LBLCK2: ILDB 3,2 ;GET A BYTE + IDPB 3,1 ;PUT A BYTE + JUMPN 3,LBLCK2 ;UNTIL WE SEE NULL + PUSHJ P,MSIX + CAIN 3,":" ;FIELD TERMINATED BY THIS CHARACTER + MOVEM 1,LIBBLK+4 ;SAVE DEVICE +T20,< +REPEAT 0,< + HRROI 1,GTNAM1 ;GET DIRECTORY AND DEVICE + MOVE 2,LIBBLK+1 + MOVE 3,[110000,,1] ;PUNCTUATE PROPERLY + JFNS + MOVSI 1,1 ;EXACT MATCH + HRROI 2,GTNAM1 + RCDIR ;CONVERT TO DIRECTORY NUMBER FOR SPECIFIC STRUCTURE + TLNE 1,(1b3) ;skip if ok. + ERROR [ASCIZ/CAN'T TRANSLATE TO DIRECTORY NUMBER/] + HRLI 3,4 ;THE "PROJECT" PART + MOVEM 3,LIBBLK+3 ;SAVE PPN +>;REPEAT 0 + SETZM LIBBLK+3 ;ZERO PPN +>;T20 +NOT20,< HRROI 1,GTNAM1 ;STORE DIRECTORY NAME HERE + MOVE 2,LIBBLK+1 ;JFN + MOVSI 3,010000 ;OUTPUT DIR NAME ONLY + JFNS + HRROI 2,GTNAM1 ;STRING OF DIR NAME + MOVEI 1,0 ;EXACT MATCH + STDIR + JFCL + ERROR [ASCIZ/CAN'T TRANSLATE TO DIRECTORY NUMBER/] + HRLI 1,4 + MOVEM 1,LIBBLK+3 ;STORE PPN +>;NOT20 + + HRROI 1,GTNAM1 ;STORE FILE NAME HERE + MOVE 2,LIBBLK+1 ;JFN + MOVSI 3,001000 ;FILE NAME + JFNS + PUSHJ P,MSIX + MOVEM 1,LIBBLK+2 ;file + HRROI 1,GTNAM1 + MOVE 2,LIBBLK+1 + MOVSI 3,000100 ;EXT + JFNS + PUSHJ P,MSIX + JUMPE 1,MSRT + CAME 1,['REL '] + ERROR [ASCIZ/EXTENSION MUST BE REL/] +MSRT: MOVE 1,LIBBLK+1 + RLJFN + JUMP 16,.+1 + SETZM LIBBLK+1 +>;TNX + POUT 5,LIBBLK +LIBRET: +ITS,< POP P,LIMBO > + POP P,FNREAD + POP P,O + POP P,CP + TLO SFL ;LET SPCFN SEE THE CHARACTER BY WHICH WE TERMINATED + JRST SPCFN ;FINISH UP + +LIBER1: ERROR [ASCIZ/CAN'T PARSE FILE NAME/] + JRST LIBRET + +TNX,< +GTNAM1: BLOCK =26 + +MSIX: MOVEI 1,0 ;ACCUMULATE SIXBIT HERE + MOVE 2,[POINT 7,GTNAM1] + MOVE 4,[POINT 6,1] +MSIXLP: ILDB 3,2 ;GET A BYTE + JUMPE 3,CPOPJ ;RETURN ON NULL + CAIE 3,":" + CAIN 3,"." + POPJ P, + TRZ 3,40 + TRNE 3,100 + TRO 3,40 + TLNN 4,770000 ;SKIP IF THERE'S ROOM FOR A BYTE + JRST [ERROR [ASCIZ/FILE NAME COMPONENT EXCEEDS 6 LETTERS/] + POPJ P,] + IDPB 3,4 + JRST MSIXLP +>;TNX + ; PURGE XPUNGE + +PU6: ERROR [ASCIZ/NO SUCH SYMBOL/] +PURCON: TRNN B,COMF ;HERE TO CONTINUE SCAN. COMMA NEXT? + JRST SPCFN ;NO. DONE + TLZ SFL ;SKIP THE COMMA +^%PURGE: + PUSHJ P,SCAN ;GET AN ID NAME + TLNN IFLG ;IDENT? + JRST PNOI ;NO. LOSE + MOVE N,L + IDIVI N,HASH + MOVM NA,NA + MOVEI PN,OPCDS-1(NA) ;DEFINED AS AN OPCODE? + PUSHJ P,PRSRCH + JRST PU2 ;NO. +PU1: PUSHJ P,PU1C ;DELINK THIS + MOVE NA,1(N) + TLNN NA,30 ;REGULAR OPCODE? + JRST PU1O ;YES. (WE CAN'T RECLAIM SPACE) +IFN CMUSW!STANSW,< TLNE NA,10 ;PREDEFINED CALLI? + JRST PU1O> ;YES. CAN'T RECLAIM SPACE EITHER + JUMPGE NA,PU1D ;JUMP IF AN OPDEF, WE CAN RECLAIM SPACE. +PU1O: SKIPE XCRFSW ;CREFFING? + CREF7 3,(N) ;YES. EMIT NORMAL OPCODE TO CREF. + JRST PURCON + +PU1D: SKIPE XCRFSW + CREF6 5,(N) ;EMIT USE OF OPDEF TO CREF. + SKIPE CREFSW ;CREF IN PROGRESS? (EVEN IF XCREF) + CREF66 13,(N) ;YES. EMIT OPDEF "DEFINITION" TO CREF + +PU1B: PUSH P,[PURCON] ;SET RETURN ADDRESS FROM PU1A +PU1A: MOVE PN,FSTPNT + HRRZM PN,1(N) ;STORE POINTER TO FREE LIST IN US + MOVEM N,FSTPNT ;STORE POINTER TO US IN FREE LIST. + POPJ P, + +PU1C: MOVE NA,1(N) ;GET LINK OUT + HRRM NA,1(PN) ;STORE IN PREVIOUS. DELINKS N. + POPJ P, + +PU3A: TLNE NA,1 ;MACRO PSEUDO OP. EMIT TO CREF? +PU3B: SKIPN XCRFSW ;YES. BUT ARE WE DOUING CREF? + JRST .+2 ;NO TO ONE OF THE ABOVE. + CREF7 5,(N) ;EMIT TO CREF + PUSHJ P,PU1C ;DELINK MACRO-ENTRY + JRST PU1B ;RETURN MACRO-ENTRY + +PU2: MOVEI PN,MACRT-1(NA) ;DEFINED AS A MACRO? + PUSHJ P,PRSRCH + JRST PU4 ;NO +PU3: SKIPGE NA,3(N) ;SKIP IF REGULAR MACRO (OR IOWD) + JRST PU3A ;SPECIAL MACRO PSEUDO-OP (IF, "." OR .FNAM1) + CAIN N,%IOWD ;IS THIS IOWD? + JRST PU3B ;YES + SKIPE XCRFSW ;CREF IN PROGRESS RIGHT NOW? + CREF6 5,(N) ;CREF A MACRO REFERENCE + SKIPE CREFSW ;CREF IN PROGRESS AT ALL? + CREF66 13,(N) ;YES. EMIT MACRO "DEFINITION" TO CREF + PUSH P,B ;PURGE A MACRO. COPIED FROM MAC&REDEF + PUSH P,C + MOVE C,4(N) ;POINTER TO MACRO DEF. + PUSHJ P,PU1C ;DELINK SYMBOL ENTRY + PUSHJ P,PU1A ;GIVE BACK 5-WORD BLOCK POINTED TO BY N. + HLRZ B,(C) ;WORD COUNT OF MACRO DEF + ADDI B,(C) ;COMPUTE ADDRESS ABOVE THE MACRO DEF. + PUSHJ P,MACRET ;GIVE BACK THE MACRO DEFINITION. + POP P,C + POP P,B + JRST PURCON + +PU4: MOVEI PN,SYMTAB-1(NA) ;DEFINED AS A SYMBOL? + PUSHJ P,PRSRCH + JRST PU6 + MOVE NA,2(N) ;GET THE BLOCK BITS AND SYMBOL FLAGS + TDNN NA,BLOCK ;THIS BLOCK? + JRST PU6 ;NO. + TLNE NA,DEFFL!SYMFIX!INTF!EXTF!UDSF ;THESE ARE ALL REASONS NOT TO. + JRST PNOD + SKIPE XCRFSW ;CREF RIGHT NOW? + CREF6 1,(N) ;YES. THIS IS A REFERENCE TO SYMBOL + SKIPE CREFSW ;ARE WE DOING CREF? (EVEN IF XCREF) + CREF66 11,(N) ;YES. OUTPUT DEFINITION + PUSHJ P,PU1C ;DELINK SYMBOL ENTRY + JRST PU1B ;RETURN NODE TO FREE LIST + + +PNOD: ERROR [ASCIZ/CAN'T PURGE SYMBOL/] + JRST PURCON + +PNOI: ERROR [ASCIZ/NOT IDENT/] + JRST SPCFN + +;SEARCH FOR A SYMBOL TO PURGE (REMEMBER PREVIOUS LINK) +;CALL WITH: MOVEI PN,SYMTAB-1(NA) +; PUSHJ P,PRSRCH +PRSRCH: HRRZ N,1(PN) ;IS THERE A FORWARD LINK? + JUMPE N,CPOPJ ;IF NOT, FAIL. + CAMN L,(N) ;DOES IT MATCH? + JRST PRSRC1 ;YES. PN IS PREVIOUS, N IS CURRENT. + MOVEI PN,(N) ;PREVIOUS_CURRENT + JRST PRSRCH + +PRSRC1: AOS (P) + POPJ P, + +^%XPUNG: + SETOM XPUNGSW ;SET FLAG FOR BEND TO EXPUNGE SYMBOLS + JRST SPCFN + ; SUPPRESS ASUPPRESS + +SUPON1: SKIPN 3(N) ;THIS IS EXTERNAL. SKIP IF ANY FIXUPS + SKIPE 4(N) + POPJ P, ;THERE ARE FIXUPS. DON'T SUPPRESS SYMBOL. +SUPON2: TLO NA,SUPBIT ;DEFINED AND NOT REFERENCED. TURN ON SUPPRESS BIT + MOVEM NA,2(N) ;TURN ON THE SUPRRESS BIT FOR THIS SYMBOL + POPJ P, + +;HERE TO SUPPRESS ONE SYMBOL POINTED TO BY N. CLOBBERS NA. +SUPONE: MOVE NA,2(N) ;GET THE VALUE FLAGS + TLNE NA,EXTF ;IS THIS DECLARED EXTERNAL? + JRST SUPON1 ;YES. HANDLE SPECIALLY. + TLNN NA,DEFFL!REFBIT!INTF ;IS THIS REF'D, INT OR UNDEF? + JRST SUPON2 ;NO. DEFINED BUT NOT REFERENCED. + POPJ P, + +SU3: SKIPE XCRFSW + CREF7 3,(N) ;EMIT OPCODE (NOT OPDEF) TO CREF + JRST SUPCON + +SU2: SKIPE XCRFSW + CREF6 1,(N) ;EMIT SYMBOL TO CREF +SU1: PUSHJ P,SUPONE ;SUPPRESS SYMBOL +SUPCON: TRNN B,COMF ;HERE TO CONTINUE SCAN. COMMA NEXT? + JRST SPCFN ;NO. DONE + TLZ SFL ;SKIP THE COMMA +^%SUPPR: + PUSHJ P,SCAN ;GET AN ID NAME + TLNN IFLG ;IDENT? + JRST SNOI ;NO. LOSE + MOVE N,L + IDIVI N,HASH + MOVM NA,NA + MOVEI PN,SYMTAB-1(NA) ;ENTRY AS A SYMBOL? + PUSHJ P,PRSRCH + JRST .+2 ;NO. + JRST SU2 ;YES. + MOVEI PN,OPCDS-1(NA) ;ENTRY AS AN OPDEF? + PUSHJ P,PRSRCH + JRST SNOS ;NO. WELL, WE CAN'T DO THAT. + MOVE NA,1(N) ;GET OPCODE VALUE + TLNN NA,20 ;SKIP IF THIS IS AN OPDEF + JRST SU3 ;CAN'T DO THIS TO OPCODES + JUMPL NA,SU3 ;CAN'T DO THIS TO PSEUDO-OPS + SKIPE XCRFSW + CREF6 5,(N) ;EMIT OPDEF TO CREF + JRST SU1 ;BUT WE CAN DO IT TO OPDEFS + +SNOI: ERROR [ASCIZ/NOT IDENT/] + JRST SPCFN + +SNOS: ERROR [ASCIZ/NO SUCH SYMBOL/] + JRST SUPCON + +^%ASUPP: + MOVSI PN,-HASH +ASUPP1: SKIPN N,SYMTAB(PN) ;GET A HASH POINTER + JRST ASUPP3 ;NONE THERE +ASUPP2: PUSHJ P,SUPONE ;SUPPRESS IT. + HRRZ N,1(N) ;LINK ON. + JUMPN N,ASUPP2 ;THRU ALL THIS CHAIN +ASUPP3: AOBJN PN,ASUPP1 + + MOVSI PN,-HASH ;NOW FOR THE OPDEFS +ASUPP4: SKIPN N,OPCDS(PN) ;GET A HASH POINTER + JRST ASUPP6 ;NONE THERE +ASUPP5: MOVE NA,1(N) ;MAKE SURE THIS IS AN OPDEF + TLNE NA,20 ;THIS BIT IS ON FOR OPDEF AND PSUEDO + JUMPG NA,.+2 ;JUMP IF OPCODE (AND NOT PSEUDO) + JRST ASUPP6 ;NO USER DEFINED CODES AFTER THIS POINT. + MOVE NA,2(N) + TLNN NA,REFBIT ;REFERENCED YET? + TLO NA,SUPBIT ;NO. SET SUPRESSION BIT + MOVEM NA,2(N) + HRRZ N,1(N) ;LINK ON. + JUMPN N,ASUPP5 ;THRU ALL THIS CHAIN +ASUPP6: AOBJN PN,ASUPP4 + SKIPE UNIVSW + SETOM UASUPF# ;SET UNIVERSAL-ASUPPRESS + JRST SPCFN + ; SHUFFLE UNIVERSAL SYMBOLS + +Comment $ + + Up and down, up and down, + I will lead them up and down: + I am fear'd in field and town: + Goblin, lead them up and down. + + A Midsummer Night's Dream, Act III Scene 2 + + +All the universal symbols are divided into four categories: + VOU Very Old Universals + OU Old Universals + SU Scattered Universals + NU New Universals + +The different categories are distinguished as follows: + VOU Left half of JOBSA points above the highest VOU symbol + OU UNIVBS = first word of OU area. UNIVFF = first word above OU area + SU are compact but they are scattered around above UNIVFF + NU have not been compacted yet. + +There are two calls on the shuffler, USHUFF, where there's no io active +(except @ file, RPG file, or TMPCOR file), and USHUF1 when there is +io active that shouldn't be disturbed. +For USHUFF, OU are compacted into VOU, and USHUF1 is called. +For USHUF1, SU are moved to high core. NU are compacted to high core. + Then both are joined with OU. If called from USHUFF, the OU + become VOU by advancing JOBFF and lh of JOBSA +$ + +^USHUFF: ;HERE WHEN NO IO ACTIVE. REDUCE JOBFF + HLRZ 1,.JBSA ;SET JOBFF FROM LH. OF JOBSA. + HRRZM 1,.JBFF + SKIPN 2,UNIVBS ;ARE THERE ANY OU? + JRST USHUF1 ;NO. + + SUBI 1,(2) ;THIS IS THE OFFSET AMOUNT (NEGATIVE) + MOVEI 3,UNIVLH-1 +USHF.1: MOVEI 2,(3) ;SHUFFLE POINTER. + HRRZ 3,1(2) ;ADVANCE TO NEXT UNIV TABLE 3=CURRENT, 2=PREVIOUS + JUMPE 3,USHF.2 ;JUMP IF NO MORE + CAMGE 3,.JBFF ;SKIP IF THESE ARE NOT VOU + JRST USHF.2 ;VOU SYMBOLS DON'T GET MOVED + CAMGE 3,UNIVFF ;SKIP IF THESE ARE SU + ADDM 1,1(2) ;OU WILL BE MOVED. ADJUST PREVIOUS POINTER. + JRST USHF.1 ;LOOP. UNTIL WE FIND VOU. + +;BLT OU TO VOU ADDRESSES +USHF.2: HRLZ 3,UNIVBS ;GET SOURCE + HRR 3,.JBFF ;DESTINATION + MOVE 4,UNIVFF ;LAST WORD OF SOURCE, +1 + SUB 4,UNIVBS ;-FIRST WORD OF SOURCE, =LENGTH + ADD 4,.JBFF ;+DESTINATION = LAST WORD OF DESTINATION,+1 + BLT 3,-1(4) + HRRZM 4,.JBFF + HRLM 4,.JBSA + SETZM UNIVBS ;NO OU SYMBOLS ANY MORE. + SETZM UNIVFF ;JOBFF=LH(JOBSA) SET TO FIRST FREE SPACE FOR NU. + +^USHUF1: ;HERE AFTER PRGEND, DON'T CONFLICT WITH BUFFERS + MOVE 16,MTBPNT ;HERE'S WHERE WE MOVE SU TO GET THEM TO SAFETY. + MOVEM 16,SUNBAS# ;BASE OF SU SYMBOLS + MOVEI 3,UNIVLH-1 +USHX.1: MOVEI 2,(3) + HRRZ 3,1(2) ;ADVANCE TO NEXT GROUP. 3=CURRENT, 2= PREVIOUS + JUMPE 3,USHX.4 ;JUMP IF NO MORE + CAMGE 3,.JBFF ;SKIP IF THESE ARE NOT VOU AND NOT OU + JRST USHX.4 ;THESE ARE VOU OR OU, NO MORE SU. + MOVE 16,MTBPNT ;DESTINATION OF BLT + HRRM 16,1(2) ;FIX THE BACK POINTER TO SHOW WHERE IT'S BEING PUT + HRLI 16,(3) ;SOURCE,,DESTINATION +USHX.2: HLRZ 4,1(3) ;GET THE LENGTH OF THIS GROUP + ADDI 4,(16) ;LAST WORD OF DESTINATION+1 + CAMG 4,.JBREL ;MAKE SURE IT'S THERE + JRST USHX.3 ;IS OK. + PUSHJ P,COEXP + JRST USHX.2 + +USHX.3: MOVEI 3,(16) ;ADJUST CURRENT POINTER TO NEW LOC + BLT 16,-1(4) ;MOVE CRUD + MOVEM 4,MTBPNT ;UPDATE FS. POINTER + JRST USHX.1 ;LOOP THRU ALL SU SYMBOLS + +USHX.4: SKIPN UNIVSW ;WAS THERE A UNIVERSAL FILE LAST? + JRST USHY ;NO. NOTHING TO DO. + SETZM UNIVSW ;CLEAR IT TO AVOID A SECOND CALL + +;JOBFF IS THE LOWEST ADDRESS AVAILABLE FOR UNIVERSALS. +;COPY ALL THE UNVERSALS TO THE TOP OF CORE. +;RELOCATE NU SYMBOLS TO ADDRESS CONTAINED IN JOBFF. +;IF JOBFF=LH(JOBSA) THEN ADVANCE AND SET JOBFF AND JOBSA. +;IF JOBFF .NE. LH(JOBSA) STORE JOBFF IN UNIVBS, ADVANCE JOBFF AND STORE IN UNIVFF +;BNAM IS THE BLOCK NAME FOR THE UNIVERSALS. +;U.SYM, U.OPC, U.MAC ARE PARAMETERS + + HRRZ 16,MTBPNT ;POINTER TO MACRO FREE SPACE. + MOVEI 14,(16) ;ADDRESS OF THE UNIV BLOCK + + MOVNI 15,(16) ;OFFSET (NEGATIVE) TO LOCATE AT "ZERO" + +LEG SETZM 1(14) + MOVE 1,BNAM ;BLOCK NAME FOR THE UNIV SYMBOLS + MOVEM 1,(14) + ADDI 16,5 ;ADVANCE FREE POINTER + + MOVEI 12,0 + MOVEI 11,U.SYM-1 + PUSHJ P,USHUF2 +LEG MOVEM 12,2(14) ;STORE SYM POINTER. + + MOVEI 12,0 + MOVEI 11,U.OPC-1 + PUSHJ P,USHUF2 +LEG MOVEM 12,3(14) ;STORE OPC POINTER. + + MOVEI 12,0 + MOVEI 11,U.MAC-1 + PUSHJ P,USHUF3 +LEG MOVEM 12,4(14) ;STORE MAC POINTER + +;14 = FIRST ADDRESS. 16=LAST ADDRESS+1. + MOVEM 16,MTBPNT ;STORE FIRST FREE ADDRESS + MOVEI 10,(16) ;GET LAST ADDRESS+1 + SUBI 10,(14) ;-FIRST ADDRESS = NUMBER OF WORDS + HRLM 10,1(14) ;STORE WORD COUNT HERE. + +;HERE WE WRITE THE .FUN FILE IF WE MUST + SKIPE FUNSUP ;SUPRESS FUN FILE? + JRST USHF1B ;YES. +;PARAMETERS FOR WRITING FUN FILE: 14 IS FIRST ADDRESS 16 IS LAST ADDRESS+1 +;ONE EXTRA WORD 0(16) IS WRITTEN BECAUSE OF LOSING DISK CHANNEL AT STANFORD +NOTNX,< + MOVSI FS,'DSK' + MOVEI T,17 + MOVEI O,0 + OPEN 1,T + JRST [OUTSTR [ASCIZ/DSK: OPEN TO WRITE .FUN FILE LOST +/] + JRST USHF1B] + SKIPN 1,BNAM ;GET BLOCK NAME (UNIVERSAL NAME) + MOVSI 1,'FUN' + TLNE 1,770000 + JRST .+3 + LSH 1,6 + JRST .-3 + MOVSI 2,'FUN' ;LEAVE HIGH DATE ZERO FOR DEFAULT + SETZB 3,4 ;LOW DATE AND PPN DEFAULT + ENTER 1,1 + JRST [OUTSTR [ASCIZ/ENTER TO WRITE .FUN FILE FAILED +/] + JRST USHF1B] +>;NOTNX +TNX,< + SKIPN 1,BNAM ;NORMAL NAME IS FROM UNIV NAME + MOVSI 1,'FUN' ;DEFAULT NAME IS FUN.FUN + TLNE 1,770000 + JRST .+3 + LSH 1,6 + JRST .-3 + MOVE 2,[POINT 7,GTNAM] ;PLACETO ASSEMBLE ASCIZ STRIN + PUSHJ P,UNXNM + MOVEI 3,"." + IDPB 3,2 + MOVSI 1,'FUN' + PUSHJ P,UNXNM + MOVEI 3,0 + IDPB 3,2 + HRROI 2,GTNAM + MOVSI 1,400001 ;NEXT VERSION. SHORT FORM + GTJFN ;GET JFN FOR FUN FILE + JRST UNVOER ;OPEN/GETJFN ERROR + HRRZM 1,UNVJFN# + HRRZ 1,1 + MOVE 2,[447400,,300000] ;DUMP MODE. + OPENF + JRST UNVOER + JRST UNVOK + +UNXNM: LDB 3,[POINT 6,1,5] + ADDI 3," " + IDPB 3,2 + LSH 1,6 + JUMPN 1,UNXNM + POPJ P, + +UNVOER: OUTSTR [ASCIZ\I/O failure when writing .FUN file. +\] + JRST USHF1B +>;TNX +UNVOK: +LEG SETZM (16) ;WE NEED THIS WORD AT STANFORD AI + MOVEI 3,(14) ;FIRST ADDRESS + SUBI 3,1(16) ;-(LAST ADDRESS+1) = -(WC+1) + HRLI 3,-1(14) ;MA-1 IN LEFT HALF + MOVS 3,3 ;IOWD IN 3 + MOVEI 4,0 +NOTNX,< + OUTPUT 1,3 + CLOSE 1, + RELEAS 1, +>;NOTNX +TNX,< + MOVE 1,UNVJFN + MOVEI 2,3 ;POINTER TO COMMAND LIST + DUMPO ;WRITE DATA + JRST UNVOER + MOVE 1,UNVJFN + CLOSF ;CLOSE AND RELEASE JFN + JRST UNVOER +>;TNX + +USHF1B: MOVE 15,UNIVLH ;GET POINTER OTHER U TABLES + HRRM 15,1(14) ;STORE POINTER HERE + HRRZM 14,UNIVLH ;STORE MAIN POINTER. + SETZM UASUPF ;NO LONGER UNIVERSAL-ASUPPRESS + +USHY: MOVE 4,SUNBAS + CAML 4,MTBPNT + POPJ P, ;NOTHING TO DO + +;SOURCE IS SUNBAS, DESTINATION IS JOBFF. JUST QUICK RELOCATE ALL POINTERS + SUB 4,.JBFF ;THIS IS DISTANCE MOVED (POSITIVE) + MOVN 4,4 ;OFFSET (NEGATIVE) + MOVEI 3,UNIVLH-1 +USHY.1: MOVEI 2,(3) + HRRZ 3,1(2) ;ADVANCE TO NEXT GROUP. 3=CURRENT, 2= PREVIOUS + JUMPE 3,USHY.2 ;JUMP IF NO MORE + CAMGE 3,SUNBAS ;SKIP IF THESE ARE SU OR NU + JRST USHY.2 ;NO MORE SU! + ADDM 4,1(2) ;SET OFFSET IN PREVIOUS POINTER + JRST USHY.1 ;LOOP + +USHY.2: MOVS 10,SUNBAS ;SOURCE + HRR 10,.JBFF ;DESTINATION + MOVE 16,MTBPNT ;GET THE LAST ADDRESS + SUB 16,SUNBAS ;CALCULATE LENGTH + ADD 16,.JBFF ;LAST ADDRESS+1 OF BLT + BLT 10,-1(16) ;DO IT. + MOVE 11,.JBFF ;GET OLD JOBFF + MOVEM 16,.JBFF ;SET NEW JOBFF + HLRZ 10,.JBSA ;GET JOBSA + CAMN 10,11 ;SAME AS OLD JOBFF? + JRST [HRLM 16,.JBSA ;YES STORE JOBSA TOO + POPJ P,] ;ALL DONE NOW. + MOVEM 16,UNIVFF ;FIRST FREE ABOVE OU'S + MOVEM 11,UNIVBS ;BASE OF OU'S + POPJ P, + + +;HERE TO MOVE SYMBOL,OPCODE, OR MACRO-ENTRY FROM (11) TO (16) +;UPDATES +USHUF4: MOVE 10,4(11) ;GET LAST WORD. +LEG MOVEM 10,4(16) ;STORE IN FREE SPACE + MOVE 10,3(11) + MOVEM 10,3(16) + MOVE 10,2(11) + TLZ 10,REFBIT ;CLEAR REFBIT - UNIV NOT REFERENCED YET + SKIPE UASUPF ;UNIVERSAL-ASUPPRESS? + TLO 10,SUPBIT ;YES. SET SUPPRESS BIT + MOVEM 10,2(16) + MOVE 10,0(11) + MOVEM 10,0(16) + + MOVE 10,1(11) ;PRESERVE LEFT HALF IN CASE OF OPDEF + HRR 10,12 + MOVEM 10,1(16) ;STORE POINTER TO PREVIOUS SYMBOL + + MOVEI 12,(16) ;GET POINTER TO THIS + ADD 12,15 ;ADD OFFSET = FINAL ADDRESS AFTER BLT + ADDI 16,5 + POPJ P, + +;HERE FOR LIST OF OPC AND SYM +USHUF2: HRRZ 11,1(11) ;ADVANCE TO NEXT ENTRY. + JUMPE 11,CPOPJ ;JUMP IF THERE IS NO NEXT. + PUSHJ P,USHUF4 + JRST USHUF2 ;ADVANCE TO NEXT ENTRY + +;HERE FOR MACRO LIST +USHUF3: SKIPN 11,1(11) ;ADVANCE TO NEXT ENTRY + POPJ P, + PUSHJ P,USHUF4 ;MOVE THE MACRO-ENTRY + MOVE 10,16 ;GET FREE ADDRESS + ADD 10,15 ;ADD OFFSET TO MAKE CORRECT ADDRESS + EXCH 10,-1(16) ;EXCH WITH MACRO-BODY ADDRESS + HRRM 12,(10) ;SET BACK-POINTER ADDRESS IN THE MACRO-BODY + HLRZ 7,(10) ;GET THE SIZE OF THE MACRO-BODY + ADDI 7,(16) ;CALCULATE FINAL ADDRESS+1 + MOVS 10,10 ;SOURCE ADDRESS IN LEFT + HRRI 10,(16) ;DESTINATION IN RIGHT +LEG SETZM (7) ;ADDRESS BEYOND THE BLT + BLT 10,-1(7) + MOVEI 16,(7) ;FIXUP FREE STORAGE POINTER. + JRST USHUF3 ;LOOP FOR ALL MACROS + + ; SEARCH + +SRNOI: ERROR [ASCIZ/SEARCH - NO ID/] + JRST SPCFN + +SERCN0: TRNN B,LFPF ;TERMINATED BY LEFT PARENS? + JRST SPCFN ;NO. WE'RE DONE + TLZ SFL ;CLEAR SCAN AHEAD + PUSHJ P,SCAN1 ;GET NEXT CHARACTER + TDNN B,[CRFG,,RTPF] ;RIGHT PARENS OR END OF LINE? + JRST .-2 ;NO. GO UNTIL WE GET ONE +SERCON: TRNE B,RTPF ;RIGHT PARENS? + PUSHJ P,SCAN1 ;YES. GET NEXT AFTER PARENS + TLO SFL ;SET SCAN AHEAD. CHARACTER NEEDS TO BE SEEN AGAIN + TRNN B,COMF ;TERMINATED BY COMMA? + JRST SERCN0 ;NO. CHECK FOR TERMINATED BY LEFT PARENS. + TLZ SFL ;CLEAR SCAN AHEAD +^%SEAR: PUSHJ P,SCANM ;GET AN ID NAME + TLNN IFLG + JRST SRNOI ;NO ID AFTER SEARCH + MOVEI N,UNIVLH-1 ;SEARCH FOR RIGHT NAME +SEAR1: HRRZ N,1(N) + JUMPE N,SRTRD ;LOSE IF THERE ARE NO MORE + CAME L,(N) ;MATCHES? + JRST SEAR1 ;NO. LOOP ON + +;NOW, N IS THE POINTER TO THE UNIVERSAL BLOCK. +;2(N) SYMBOLS - ADD TO END OF SYMBOL TABLE +;3(N) OPCODES - INSERT IN OPCODE TABLE IN FRONT OF PREDEFINED OPCODES +;4(N) MACROS - INSERT AT THE END +SEAR1A: PUSH P,N ;SAVE FOR GOOD LUCK. + MOVEI PN,1(N) ;POINTER (POINTER TO THE SYMBOLS)-1 +SEAR2: HRRZ PN,1(PN) ;ADVANCE + JUMPE PN,SEAR3 ;NO MORE SYMBOLS + ADD PN,(P) ;ADD BASE OFFSET TO PN. + GFST (N,FSTPNT) ;GET FREE STORAGE + MOVE NA,1(N) ;GET NEXT POINTER + MOVEM NA,FSTPNT ;KEEP FREE LIST HONEST + MOVSI NA,(PN) ;SOURCE + HRR NA,N ;DESTINATION + BLT NA,4(N) ;COPY NAME AND DEFINITION TO NEW BLOCK + SETZM 1(N) ;CLEAR LINK ADDRESS +;The following code was added by REG. Apparently he wanted to normalize +; the flags. However in the original form it removed the effect of +; downarrows in the unv file. I now copy their effect. If that isn't +; good enough, feel free to simply delete these lines. -- Clh + HLLO NA,2(N) ;old flags,,-1 + TLNN NA,DAF ;if downarrow, that's right + HRRI NA,1 ;but if not, set for outer block only + HRRM NA,2(N) ;now put in the normalized block level +;End of section referred to above ^^ + PUSH P,N ;SAVE BLOCK ADDRESS + MOVE N,(PN) ;SYMBOL NAME + IDIVI N,HASH + MOVM NA,NA ;HASH VALUE +;NA = HASH VALUE. SEEK END OF THE LIST + MOVEI N,SYMTAB-1(NA) ;PREVIOUS ADDRESS +SEAR2A: MOVEI NA,(N) + HRRZ N,1(NA) ;GET NEXT ADDRESS + JUMPN N,SEAR2A + POP P,1(NA) ;STORE NEW SYMBOL BLK ADDR AT END OF LIST. + JRST SEAR2 ;GET NEXT SYMBOL + +SEAR3: MOVE N,(P) ;GET UNIV BLK ADDR FROM STACK + MOVEI PN,2(N) +SEAR3A: HRRZ PN,1(PN) + JUMPE PN,SEAR4 ;NO OPCODES LEFT. DO MACROS + ADD PN,(P) + GFST (N,FSTPNT) ;GET FREE STORAGE + MOVE NA,1(N) ;GET NEXT POINTER + MOVEM NA,FSTPNT ;KEEP FREE LIST HONEST + MOVSI NA,(PN) ;SOURCE + HRR NA,N ;DESTINATION + BLT NA,4(N) ;COPY NAME AND DEFINITION TO NEW BLOCK + HLLZS 1(N) ;CLEAR LINK ADDRESS + PUSH P,N ;SAVE BLOCK ADDRESS. + MOVE N,(PN) ;SYMBOL NAME + IDIVI N,HASH + MOVM NA,NA ;HASH VALUE + MOVEI NA,OPCDS-1(NA) ;PREVIOUS ADDRESS +SEAR3B: MOVEI N,(NA) + HRRZ NA,1(N) ;GET NEXT ADDRESS + JUMPE NA,SEAR3C ;NO NEXT ADDR. N=ADDR OF LAST BLOCK + HLRZ L,1(NA) ;GET THE CODE BITS + CAIN L,20 ;PRECISELY 20 MEANS OPDEF + JRST SEAR3B ;THIS IS AN OPDEF. ADVANCE N TO CURRENT (NA) BLOCK +SEAR3C: POP P,L ;GET ADDR OF NEW SYMBOL + HRRM NA,1(L) ;STORE LINK OUT + HRRM L,1(N) ;STORE LINK IN + JRST SEAR3A ;DO MORE. + +SEAR4: MOVE N,(P) ;GET UNIV BLK ADDR FROM STACK + MOVEI PN,3(N) +SEAR4A: HRRZ PN,1(PN) + JUMPE PN,[POP P,(P) ;FIX STACK + JRST SERCON] ;NO MACROS LEFT. GET NEXT ARGUMENT + ADD PN,(P) + GFST (N,FSTPNT) ;GET FREE STORAGE + MOVE NA,1(N) ;GET NEXT POINTER + MOVEM NA,FSTPNT ;KEEP FREE LIST HONEST + MOVSI NA,(PN) ;SOURCE + HRR NA,N ;DESTINATION + BLT NA,4(N) ;COPY NAME AND DEFINITION TO NEW BLOCK + HLLZS 1(N) ;CLEAR LINK ADDRESS + MOVE NA,(P) ;GET OFFSET + ADDM NA,4(N) ;ADD TO THIS BLOCK. POINTS AT OLD DEFINITION + PUSH P,N ;SAVE BLOCK ADDRESS. + MOVE N,(PN) ;SYMBOL NAME + IDIVI N,HASH + MOVM NA,NA ;HASH VALUE + HRRZ N,MACRT1(NA) ;INSERT IN FRONT OF PERMANENT DEFINITIONS + PUSH P,N ;TARGET ADDRESS - A PERMANENT DEF. + MOVEI N,MACRT-1(NA) ;PREVIOUS ADDRESS +SEAR4B: MOVEI NA,(N) + HRRZ N,1(NA) ;GET NEXT ADDRESS + CAME N,(P) ;MATCHES THE PERMANENT DEFINITION? + JUMPN N,SEAR4B ;NO MATCH. LOOP WHILE THERE'S STILL A LIST + CAME N,(P) ;MAKE SURE WE'RE WINNING. + ERROR [ASCIZ/FAIL BUG IN SEARCH /] + SUB P,[1,,1] ;THROW AWAY ADDRESS + POP P,L ;ADDRESS OF MACRO HEADER BLOCK + HRRM N,1(L) ;MAKE THIS BLOCK POINT TO PERMANENT DEFS. + HRRM L,1(NA) ;AND INSERT THIS NEW MACRO BLK ADDR INTO LIST. + HLRZ N,@4(L) ;LENGTH OF MACRO DEFINTION + ADD N,MTBPNT ;LAST ADDRESS OF DESTINATION+1 +LEG SETZM -1(N) ;MAKE SURE ADDRESS EXISTS + HRLZ NA,4(L) ;ADDRESS OF MACRO DEFINITION (SOURCE) + HRR NA,MTBPNT ;ADDRESS OF MACRO FREE STORAGE. (DESTINATION) + HRRM NA,4(L) ;STORE NEW ADDRESS OF MACRO DEFINITION. + BLT NA,-1(N) + HRRM L,@MTBPNT ;STORE BACK POINTER IN MACRO DEFINITION + MOVEM N,MTBPNT ;UPDATE FREE STG POINTER + JRST SEAR4A + + ; SEARCH - CONTINUED. FIND AND READ A SUITABLE FUN FILE + +SRTRD: PUSH P,L ;SAVE NAME OF THIS UNIVERSAL TABLE. + TRNN B,LFPF ;TERMINATED BY LEFT PARENS? + JRST SRTRD1 ;NO. THIS MEANS WE TAKE .FUN AS THE FILE + TLZ SFL ;ADVANCE OVER THE PARENS + +;THIS USES THE SAME SCANNER AS THE COMMAND LINE SCANNER! MODIFIERS BEWARE!! +;CODE COPIED FROM .LOAD + + PUSH P,CP ;THIS GETS CLOBBERED AND IT'S SLIGHTLY NECESSARY + PUSH P,O ;THIS MAY BE NEEDED + PUSH P,FNREAD ;SAVE NORMAL COMMAND LINE READER. + MOVE N,[PUSHJ P,AFSCAN] + MOVEM N,FNREAD +ITS,< PUSH P,LIMBO > + SETZM UNVGTE# ;NO ERROR YET +NOTNX,< MOVSI 1,'DSK' ;ASSUMED DEVICE + SETZB 5,4 ;NO ASSUMPTION ABOUT FILE NAME OR PPN + MOVSI 3,'FUN' ;ASSUME EXT + +;GETFIL CALLS SCAN1. CLOBBERS AC'S 0-13. +;0 IS SETUP CORRECTLY +;1,2,4,5,6,13 ARE CONSIDERED SCRATCH (T,FS,N,NA,PN,TAC) +;10,11 (B,C) ARE SET CORRECTLY TO LAST CHARACTER SEEN +;3,7 (O,CP) ARE PRESERVED BY PUSHING AND POPPING + + JSR GETFIL ;GET A FILE NAME +>;NOTNX + +TNX,< HRROI 1,[ASCIZ/DSK/] + MOVEM 1,GTDEV ;DEFAULT DEVICE + HRROI 1,[ASCIZ/FUN/] + MOVEM 1,GTEXT ;DEFAULT EXTENSION + JSR TGETF ;READ USER'S SPEC INTO GTNAM +>;TNX + + CAIA ;ERROR + TRNN B,RTPF ;TERMINATED BY RIGHT PARENS? + SETOM UNVGTE ;ERROR + +TNX,< MOVEI 2,0 + IDPB 2,1 ;TERMINATE NAME WITH A NULL >;TNX + + MOVE PN,O ;PN _ EXTENSION +ITS,< POP P,LIMBO > + POP P,FNREAD + POP P,O + POP P,CP + SKIPE UNVGTE ;ANY ERROR? + JRST SRCER2 ;YES, COMPLAIN. + +;1=T=DEVICE, 5=NA=FILE, 6=PN=EXT, 4=N=PPN + PUSHJ P,UNVOPN ;OPEN DEVICE. + JRST SRCER1 ;NOT FOUND +SRTRD0: POP P,L ;GET NAME OF UNIVERSAL TABLE. + MOVEM L,(N) ;STORE IT (NEED NOT BE SAME AS IN FILE) + MOVE PN,UNIVLH ;GET LIST HEADER + HRRM PN,1(N) ;STORE IT INTO NEW UNIV TABLE + HRRZM N,UNIVLH ;AND STORE NEW UNIV ADDRESS IN LIST HEAD + JRST SEAR1A ;WE DID IT. NOW PROCESS AS NORMAL + +;HERE WHEN "SEARCH FOO" APPEARS. LOOK FOR FOO.UNV ON DSK:,SYS: UNV: +SRTRD1: MOVE NA,L ;GET THE SOUGHT NAME INTO NA + TLNE NA,770000 + JRST .+3 ;JUMP WHEN LEFT ADJUSTED + LSH NA,6 + JRST .-3 ;LOOP UNTIL LEFT ADJUSTED +NOTNX,< MOVSI PN,'FUN' ;SET UP EXTENSION + MOVEI N,0 ;PPN=0 +>;NOTNX +TNX,< HRROI PN,[ASCIZ/FUN/] + MOVEM PN,GTEXT + MOVE 1,NA + MOVE 2,[POINT 7,GTNAM] + PUSHJ P,UNXNM ;COPY FILE NAME TO GTNAM IN ASCII + IDPB 1,2 ;TERMINATE WITH NULL +>;TNX + MOVSI FS,-SRDVTL +SRTRD2: MOVE T,SRDVTB(FS) ;GET A DEVICE NAME +TNX,< MOVEM T,GTDEV ;SAVE DEVICE NAME>;TNX + PUSHJ P,UNVOPN ;OPEN THE DEVICE + JRST SRTRD3 ;NOT THERE + JRST SRTRD0 ;WE HAVE IT. + +SRTRD3: AOBJN FS,SRTRD2 + ERROR [ASCIZ/NO SUCH UNIVERSAL TABLE/] +SRCERR: POP P,L ;LOSE. RESET STACK + JRST SERCON + + +NOTNX,< DEFINE UNVDVM(A) >;NOTNX +TNX,< DEFINE UNVDVM(A)<-1,,[ASCIZ/A/]> >;TNX +SRDVTB: + FOR ZOT IN (DSK,UNV,SYS) < + UNVDVM(ZOT) > +SRDVTL__.-SRDVTB + +SRCER1: ERROR [ASCIZ/BINARY UNIVERSAL FILE (OR DEVICE) COULD NOT BE FOUND/] + JRST SRCERR + +SRCER2: ERROR [ASCIZ/CAN'T PARSE FILE NAME/] + JRST SRCERR + +NOTNX,< + +SRCTMP: BLOCK 4 + +;ENTER WITH 2=DEVICE, 5=FILE, 6=EXT, 4=PPN +UNVOPN: MOVEM T,SRCTMP+1 + MOVEI T,17 + MOVEM T,SRCTMP + SETZM SRCTMP+2 + OPEN 1,SRCTMP ;TRY TO OPEN DEVICE + JRST UNVRD3 + MOVEM NA,SRCTMP + HLLZM PN,SRCTMP+1 + SETZM SRCTMP+2 + MOVEM N,SRCTMP+3 + LOOKUP 1,SRCTMP + JRST UNVRD3 ;FAIL + HLRES SRCTMP+3 ;FORM -WC IN SRCTMP+3 RPH/REG 11/25/74 +UNVRD0: MOVE T,MTBPNT ;GET FREE STORAGE ADDRESS + SUB T,SRCTMP+3 ;CALCULATE NEXT FREE ADDRESS + CAMG T,.JBREL + JRST UNVRD1 ;IS OK + PUSHJ P,COEXP + JRST UNVRD0 ;LOOP UNTIL BIG ENOUGH + +UNVRD1: HRL T,SRCTMP+3 ;GET -WC + HRR T,MTBPNT + SUBI T,1 + MOVEM T,SRCTMP ;STORE IOWD + SETZM SRCTMP+1 ;STOP COMMAND LIST + INPUT 1,SRCTMP + STATZ 1,740000 + JRST UNVRD2 ;INPUT ERROR + MOVE N,MTBPNT ;GET FREE STORAGE ADDRESS + SUB N,SRCTMP+3 ;CALCULATE NEXT FREE ADDRESS + EXCH N,MTBPNT ;ADVANCE FS. GET POINTER TO UNIV. TABLE + AOS (P) +UNVRD2: CLOSE 1, +UNVRD3: RELEAS 1, + POPJ P, +>;NOTNX + +TNX,< +;DEVICE NAME, EXTENSION IN GTDEV, GTEXT. FILE STRING IN GTNAM + +UNVOPN: PUSH P,FS + MOVEI 1,GTTBL ;PARAMETERS FOR LONG GTJFN + HRROI 2,GTNAM ;STRING FROM USER OR FILE NAME + MOVSI 3,100000 ;ACCESS OLD FILE + MOVEM 3,(1) ;FLAGS IN PARAM BLOCK + SETZM UNVJFN ;NO JFN YET + GTJFN ;GET A HANDLE ON FILE. + JRST UNVOPX ;NO SUCH FILE (OR DEVICE) ETC. + HRRZM 1,UNVJFN ;SAVE JFN + MOVE 2,[447400,,200000] ;READ ACCESS IN DUMP MODE + OPENF ;OPEN FILE + JRST UNVOPX ;ERROR + HRRZ 1,UNVJFN + MOVE 2,[1,,12] ;GET SIZE OF FILE IN WORDS + MOVEI 3,5 + GTFDB ;SIZE OF FILE TO 4 + MOVE T,MTBPNT + ADDI T,(5) +LEG SETZM (T) ;REFERENCE CORE/EXPAND CORE + MOVN 3,5 + HRL 3,3 ;-WC IN LEFT HALF + HRR 3,MTBPNT + SUBI 3,1 ;MA-1 IN RIGHT. + MOVEI 4,0 ;COMMAND LIST IN 3 AND 4 + HRRZ 1,UNVJFN + MOVEI 2,3 ;POINTER TO COMMAND LIST + DUMPI ;READ DUMP INPUT + JRST UNVOPX ;LOSE. + AOS -1(P) ;WIN + MOVE N,MTBPNT + ADD N,5 + EXCH N,MTBPNT ;ADVANCE FS POINTER. RETURN + ;POINTER TO NEW UNIV. BLOCK +UNVOPX: SETZM GTDEV ;RESTORE DEVICE NAME TO DEFAULT + HRRZ 1,UNVJFN ;IS THIS JFN STILL HERE? + JUMPE 1,UNVOPY ;NO. + CLOSF ;CLOSE AND RELEASE JFN + CAIA + SETZM UNVJFN + SKIPE 1,UNVJFN + RLJFN ;RELEAS + JFCL + SETZM UNVJFN +UNVOPY: POP P,FS + POPJ P, +>;TNX + ; HERE IS A MACRO FOR TITLE, SUBTTL, UNIVERSAL + DEFINE TIT $(TITCNT,Q,EXTRA,X1) +< MOVE T,[POINT 7,TITCNT+1] +IFN X1,< + MOVEI FS,0 +TLOP: PUSHJ P,SCAN1 ;GET CHARACTER + JUMPGE B,TPOL ;JUMP IF NOT NUM OR LET + LSH FS,6 ;ACCUMULATE SIXBIT + ORI FS,(B) + TLNE FS,770000 ;6 CHARACTERS YET? + JRST TPOL ;YES + IDPB C,T ;NOT YET. STUFF THE ASCII + JRST TLOP + +TPOL: AOSE TITLSW + ERROR [ASCIZ /TWO TITLE STATEMENTS, OR TITLE APPEARS AFTER CODE EMITTED/] + SKIPL RPGSW + JRST TPOL1 + PUSH P,C + PUSH P,T + IDPB C,T + MOVEI C,15 + IDPB C,T + MOVEI C,12 + IDPB C,T + MOVEI C,0 + IDPB C,T + OUTSTR [ASCIZ /FAIL: /] + OUTSTR TITCNT+1 + POP P,T + POP P,C +TPOL1: MOVEM FS,BNAM ;DEPOSIT BLOCK NAME + MOVEM FS,LSTLAB+3 + PUSHJ P,R5CON + MOVEM FS,TPOL3 ;SAVE RADIX50 FOR NAME BLOCK OUTPUT + JRST TLOP$Q+1 +>;IFN X1 +TLOP$Q: PUSHJ P,SCAN1 ;GET CHR. + TLNE B,CRFG ;CR? + JRST .+3 ;YES + IDPB C,T ;DEPOSIT + JRST TLOP$Q + EXTRA + MOVEI N, + REPEAT 5,< IDPB N,T> + SUBI T,TITCNT+1 ;FORM COUNT + MOVNS T ;NEGATE + HRLM T,TITCNT ;DEPOSIT + JRST SCR +> + ; TITLE, UNIVERSAL, SUBTTL, GLOBAL + +^%UNIV: SETOM UNIVSW ;SET FLAG FOR THIS BEING A UNIVERSAL ASSEMBLY + SETZM UASUPF ;NOT DOING UNIVERSAL-ASUPPRESS YET +^%TITLE: + TIT(TITCNT,1,,1) + + +^%SUB: TIT(SUBCNT,A,;NOTNX +TNX,< MOVEI N,11 + IDPB N,T + IDPB N,T>;NTX + >,0) + +^%GLOB: PUSHJ P,SCANM ;GET IDENT + TLNN IFLG ;IDENT? + JRST NOIG ;NO + MOVE N,L ;GET SIXBIT + IDIVI N,HASH ;HASH + MOVMS NA + SKIPN PN,SYMTAB(NA);GET POINTER + JRST GER1 ;NONE +GSR: SRC1(L,PN,FNDG,JRST GER1) +GER1: ERROR[ASCIZ/GLOBAL -- NO PREVIOUS DEFINITION/] + JRST CONTG + +FNDG: MOVE N,2(PN) ;GET FLAGS + TLNE N,UDSF ;UDEFINED-DEFINED IS GOOD ENOUGH + JRST GLDEF + TLNE N,DEFFL ;DEFINED? + JRST GSR+2 ;NO, TRY AGAIN +GLDEF: OR N,BLOCK ;TURN ON BLOCK BIT + TLNN N,DAF ;DOWN ARROW? + TLO N,GLOBF ;NO, SET GLOBAL + MOVEM N,2(PN) ;RESTORE FLAGS +CONTG: TRNN B,COMF ;, NEXT? + JRST SPCFN ;NO, DONE + TLZ SFL ;SKIP THE , + JRST %GLOB ;CONTINUE + +NOIG: ERROR[ASCIZ/NOT IDENT AFTER GLOBAL/] + JRST NSPCFN + + ; EXTERN, INTERN, PAGE, LALL, XALL, NOSYM, NOLIT, CREF, XCREF +^%EXT: PUSHJ P,SCANS ;GET IDENT + TLNN IFLG ;IDENT? + JRST NOIE ;NO + MOVE T,2(PN) ;GET FLAGS + TLNN T,DEFFL ;DEFINED? + JRST EER1 ;YES + TLNE T,INTF + JRST EER2 + TLO T,EXTF ;TURN ON EXT FLAG + MOVEM T,2(PN) ;DEPOSIT +CONTE: TRNN B,COMF ;, NEXT? + JRST SPCFN ;NO, DONE + TLZ SFL ;SKIP THE , + JRST %EXT +EER1: ERROR[ASCIZ/EXTERNAL -- ALREADY DEFINED/] + JRST CONTE +EER2: ERROR [ASCIZ /EXTERNAL -- ALREADY INTERNAL/] + JRST CONTE +NOIE: ERROR[ASCIZ/NOT IDENT AFTER EXTERN/] + JRST NSPCFN + +^%INT: PUSHJ P,SCANS ;GET IDENT + TLNN IFLG ;IDENT? + JRST NOII ;NO + MOVE T,2(PN) + TLNE T,EXTF + JRST IER1 + TLO T,INTF + MOVEM T,2(PN) +CONTI: TRNN B,COMF ;, NEXT? + JRST SPCFN ;NO + TLZ SFL ;YES, SKIP THE , + JRST %INT +IER1: ERROR [ASCIZ /INTERNAL -- ALREADY EXTERNAL/] + JRST CONTI +NOII: ERROR[ASCIZ/NOT IDENT AFTER INTERN/] + JRST NSPCFN + +^%PAGE: MOVEI TAC,14 + IDPB TAC,LSTPNT + JRST SPCFN + +^%LALL: JUMPL N,LAL + SETZM NOEXP + JRST SPCFN +LAL: SETOM NOEXP + JRST SPCFN + +^%NOSYM:SETZM SYMOUT + JRST SPCFN + +^%NOLIT:SETOM NOLTSW + JRST SPCFN + +^%ONCRF:SKIPE CREFSW + SETOM XCRFSW + JRST SPCFN + +^%OFCRF:SETZM XCRFSW + JRST SPCFN + ; INTEGER, ARRAY, .COMMON +^%INTEG:PUSHJ P,SCANS ;GET A SYMBOL + TLNN IFLG + JRST NOII2 ;NOT IDENT + MOVE T,2(PN) + TLON T,UDSF!VARF ;SET FLAGS + TLNN T,DEFFL + JRST NXT ;BUT IGNORE IF DEFINED + MOVEM T,2(PN) + GFST TAC,FSTPNT ;GET FREE BLOCK + MOVE T,VARLST + MOVEM TAC,VARLST + EXCH T,1(TAC) + MOVEM T,FSTPNT + MOVEM PN,(TAC) + SETZM 2(TAC) ;ONE WORD +NXT: TRNN B,COMF ;IS IT A COMMA NEXT + JRST SPCFN ;GO AWAY + TLZ SFL ;GET PAST IT + JRST %INTEG ;AND TRY FOR MORE +NOII2: ERROR [ASCIZ /NOT IDENT AFTER INTEGER/] + JRST NSPCFN + +^%ARAY: SETZM ARCNT# ;NUMBER OF THINGS PUSHED INTO STACK +%ARAY1: PUSHJ P,SCANS ;GET A SYMBOL + TLNN IFLG + JRST NOAR ;NOT IDENT SO LOSE + MOVE T,2(PN) ;CHECK FLAGS + TLON T,UDSF!VARF + TLNN T,DEFFL + ERROR [ASCIZ /ARRAY NAME ALREADY DEFINED/] + MOVEM T,2(PN) ;BUT THEM BACK + GFST TAC,FSTPNT + MOVE T,VARLST + MOVEM TAC,VARLST + EXCH T,1(TAC) + MOVEM T,FSTPNT + MOVEM PN,(TAC) + PUSH P,TAC + AOS ARCNT + TLNE B,LBRF ;CHECK FOR < OR [ + TRNN B,TP1F ;AND THEN MAKE SURE OF [ + JRST ARR3 + TLZ SFL ;STOP SCANNING AHED + TRO NOFXF + PUSHJ P,MEVAL + TRNN NA,17 + TLNE UNDF!ESPF ;CHECK SPECIAL OR UNDEF + JRST ARAYER + SUBI N,1 ;STORE ONE LESS +ARRY: POP P,TAC ;GET BACK A POINTER + MOVEM N,2(TAC) + SOSLE ARCNT + JRST ARRY ;GET MORE + TLNE B,RBRF + TRNN B,TP1F + JRST ARR2 + PUSHJ P,SCAN + TRNN B,COMF + JRST SPCFN + TLZ SFL + JRST %ARAY +ARR3: TRNN B,COMF + JRST ARR1 + TLZ SFL + JRST %ARAY1 ;GO GET ANOTHER NAME + +ARR1: ERROR [ASCIZ /NEED [ AFTER ID IN ARRAY OR COMMON/] + JRST COMAER ;GO GET STUFF OFF STACK + +ARAYER: ERROR [ASCIZ /ILLEGAL EXPRESSION AFTER [/] + JRST COMAER + +ARR2: ERROR [ASCIZ /NO ] AFTER EXPRESSION/] + JRST COMAER + +NOAR: ERROR [ASCIZ /NEED IDENT/] + JRST COMAER + + POP P,TAC +COMAER: SOSL ARCNT + JRST .-2 + JRST NSPCFN + +^%COMMN: ;.COMMON + SETZM ARCNT# ;NUMBER OF THINGS PUSHED INTO STACK +COMM1: PUSHJ P,SCANM ;GET A SYMBOL (ALLOW MACRO EXPANSION) + TLNN IFLG + JRST NOAR ;NOT IDENT SO LOSE + MOVE FS,L ;GET SIXBIT NAME + PUSHJ P,R5CON ;CONVERT TO RADIX50 + PUSH P,FS ;SAVE RADIX50 NAME ON STACK. + AOS ARCNT ;COUNT NUMBER OF THINGS PUSHED. + TLNE B,LBRF ;CHECK FOR < OR [ + TRNN B,TP1F ;AND THEN MAKE SURE OF [ + JRST COMM3 ;PERHAPS A COMMA + TLZ SFL ;STOP SCANNING AHEAD + TRO NOFXF ;DON'T GENERATE FIXUPS + PUSHJ P,MEVAL ;GET EXPRESSION + TRNN NA,17 + TLNE UNDF!ESPF ;CHECK SPECIAL OR UNDEF + JRST ARAYER + MOVEM N,COMMB2 ;SAVE VALUE + TLNE B,RBRF + TRNN B,TP1F + JRST ARR2 ;FAILED TO TERMINATE WITH ] +COMM2: POP P,COMMB1 ;STORE RADIX50 NAME INTO LOADER BLOCK. + POUT 4,COMMB ;SEND COMMON BLOCK TO LOADER + SOSLE ARCNT ;COUNT DOWN, POPPING STACK + JRST COMM2 ;GET MORE + PUSHJ P,SCAN ;SCAN NEXT CHARACTER + TRNN B,COMF ;COMMA? + JRST SPCFN ;NO. WE'RE DONE. + TLZ SFL ;SKIP THE COMMA + JRST %COMMN ;BACK TO THE TOP. + +COMM3: TRNN B,COMF ;COMMA BETWEEN NAMES? + JRST ARR1 ;NO. + TLZ SFL ;YES. SKIP COMMA. + JRST COMM1 ;GO GET ANOTHER NAME + +COMMB: 20,,2 ;BLOCK TYPE 20. 2 WORDS + 0 ;ZERO RELOCATION BITS +COMMB1: 0 ;STORE COMMON NAME HERE +COMMB2: 0 ;AND BLOCK SIZE HERE + ; ENTRY + BEGIN ENTRY +^^%ENTRY: + SKIPE CODEM ;WAS CODE EMITTED? + ERROR [ASCIZ /ENTRY AFTER CODE EMITTED/] + PUSH P,BC ;USE THIS REGISTER AS AOBJN POINTER + MOVE BC,[XWD -=18,ENTBLK] ;FOR STORING ENTRIES +ENTR1: PUSHJ P,SCANS ;FIND A SYMBOL + TLNN IFLG ;WAS THERE A SYMBOL THERE? + JRST NOII ;NO, GIVE ERROR + MOVSI T,INTF ;SET AS INTERNAL + ORM T,2(PN) ;INTO FLAGS + MOVE FS,(PN) ;GET THE SIXBIT FOR THIS ONE + PUSHJ P,R5CON ;CONVERT TO RADIX50 + MOVEM FS,(BC) ;PUT INTO ENTRY BLOCK + AOBJP BC,EMIT ;PUT OUT BLOCK IF OUT OF ROOM +GOENT: TRNN B,COMF ;COMMA FOLLOWING? + JRST ENDENT ;ALL DONE + TLZ SFL ;SET TO IGNORE COMMA + JRST ENTR1 ;AND GET MORE + +ENDENT: HLRZ TAC,BC ;GET THE CURRENT COUNT + CAIN TAC,-=18 ;SEE IF ANY HAVE BEEN PUT IN + JRST FINENT ;NO, MUST HAVE BEEN A MULTIPLE OF 18 + ADDI TAC,=18 ;GET COUNT (IF YOU IGNORE LEFT HALF + HRRM TAC,ENTWHO ;PUT IN BLOCK HEADER + ADDI TAC,2 + MOVNS TAC + HRLM TAC,ENTHD ;AND -COUNT INTO OUTPUT POINTER + BBOUT ENTHD ;DO THE OUTPUT +FINENT: POP P,BC ;RESTORE THIS + SETZM WRD+1 ;TELL THEM NOTHING THERE + JRST SPCFN ;FINISH UP LINE + +NOII: ERROR [ASCIZ /NOT IDENT AFTER ENTRY/] + JRST FINENT ;FINISH UP + +EMIT: MOVE TAC,[XWD -=20,ENTWHO] ;AMOUTN TO DUMP + MOVEM TAC, ENTHD + MOVEI TAC,=18 ;NUMBER OF WORDS IN THE BLOCK + HRRM TAC,ENTWHO ;INTO BLOCK HEADER + BBOUT ENTHD ;OUTPUT IT + MOVE BC,[XWD -=18,ENTBLK] + JRST GOENT ;AND CONTINUE + +ENTHD: ENTWHO +ENTWHO: XWD 4,0 + 0 ;RELOCATION BITS +ENTBLK: BLOCK =18 + +BEND ENTRY + + ; LINK, LINKEND + +^%ENDL: PUSHJ P,BFFRC ;FORCE OUT BINARY AND FIXUPS + TRO NOFXF + PUSHJ P,MEVAL + MOVNS N ;USE NEGATIVE OF NUMBER + JRST LINK1 ;GO CHECK AND GET REST OF JUNK + +^%LINK: PUSHJ P,BFRC ;FORCE OUT BINARY AND FIXUPS + TRO NOFXF + PUSHJ P,MEVAL +LINK1: TLNN ESPF!UNDF + TRNE NA,17 ;IF SPECIAL CHR OR UNDEF EXPR + JRST LNKERR ;GIVE ERROR MESSAGE + MOVEM N,LNKNUM ;STORE NUMBER FOR OUTPUT + TRNN B,COMF ;THERE SHOULD BE A COMMA THERE + ERROR [ASCIZ /NO COMMA AFTER LINK NUMBER/] + TLZ SFL ;SKIP THE COMMA + PUSHJ P,MEVAL ;GET THE ADDRESS + TLNE UNDF!ESPF + JRST LNKERR ;UNDEF OR SPECIAL NOT PERMITTED + DPB NA,[POINT 1,LKRLC,3] ;PUT IN RELOC BIT + HRRZM N,LNKADR ;AND ADDRESS + POUT 4,LNKBLK ;OUTPUT IT + SKIPA +LNKERR: ERROR [ASCIZ /NOT EXPRESSION AFTER LINK OR LINKEND/] + SETZM WRD+1 ;RETURN NOTHING + JRST SPCFN ;DONE + +LNKBLK: XWD 12,2 ;HEADER +LKRLC: 0 ;RELOC BITS +LNKNUM: 0 ;NUMBER OF LINK +LNKADR: 0 ;ADDRESS OF LINK + + ; RADIX50 PRINTX PRINTC .FATAL +^%RAD5: TRO NOFXF + PUSHJ P,MEVAL ;GET NUMBER + TRNN NA,17 + TLNE UNDF!ESPF ;IF UNDEF OR SPECIAL CHR + JRST RAD5ER + TRNN B,COMF + ERROR [ASCIZ /NO COMMA AFTER RADIX50/] + LSH N,-2 ;JUSTIFY + DPB N,[POINT 4,WRD,3] ;SAVE IN WORD + TLZ SFL ;IGNORE COMMA + PUSHJ P,SCAN ;GET IDENT + TLNN IFLG + ERROR [ASCIZ /NO IDENT AFTER RADIX50/] + MOVE FS,L ;GET SIXBIT + PUSHJ P,R5CON ;AND CONVERT + IORM FS,WRD ;PUT IN + MOVSI N,NONEM ;THERE IS SOMETHING THERE + MOVEM N,WRD+1 ;WITH NO RELOC + JRST SPCFN ;AND AWAY WE GO + +RAD5ER: ERROR [ASCIZ /NOT EXPRESSION AFTER RADIX50/] + SETZM WRD+1 + JRST SPCFN + +;TYPE THE ARGUMENT TO PRINTX WITH FILE NAME, PAGE NUMBER, ETC. +^%PRNTX:PUSHJ P,ERRHED ;TYPE FILE NAME, ETC. ON TTY + TLZ SFL ;CLEAR SCANNER AHEAD. WE'RE TAKING THAT CHR. +PRNTX1: OUTCHR C + TRZ NOFXF + PUSHJ P,SCAN1 ;GET CHR. + TLNN B,CRFG!RBRF ;CR, OR ], OR >? + JRST PRNTX1 + OUTSTR TTCRLF + TLNE B,CRFG ;CR? + JRST SCR ;YES. + TLO SFL ;SET SCANNER AHEAD TO RESCAN ] OR > + PUSHJ P,SCAN ;EXIT SCAN VIA SPCRET, DOING GOOD THINGS + JRST RBARET ;RETURN FROM ASSMBL FOR ] OR > + +;TYPE THE ARGUMENT TO .FATAL AND DIE. + +^%FATAL:OUTSTR [ASCIZ/.FATAL /] + TLZ SFL ;MARK THAT WE'VE USED UP A CHARACTER +FATAL1: OUTCHR C + TRZ NOFXF + PUSHJ P,SCAN1 ;GET CHR. + TLNN B,CRFG!RBRF ;CR, OR ], OR >? + JRST FATAL1 ;NO. TYPE IT. + OUTSTR TTCRLF + FATAL [ASCIZ/.FATAL PSEUDO-OP ENCOUNTERED./] + +;TYPE TEXT DELIMITED LIKE "ASCIZ" ON TERMINAL. +^%PRNTC: + TLZ SFL ;CLEAR SCAN AHEAD + HRRM C,PRNTC2 ;SAVE TERM CHR IN INSTRUCTION + +;IN CASE OF ACCIDENT, WE SAVE WHERE WE STARTED. + SKIPN C,TLBLK ;GET SOS LINE NUMBER + HRRO C,INLINE ;NONE. USE OUR COUNT + MOVEM C,TXLIN ;SAVE AS LINE NUMBER WHERE TEXT PSEUDO-OP BEGINS + MOVE C,PGNM ;GET PAGE NUMBER + MOVEM C,TXTPG ;SAVE PAGE WHERE TEXT PSEUDO-OP BEGINS + +NOTNX,< MOVE C,[FILNM,,TXTFIL] + BLT C,TXTFIL+4 ;SAVE CURRENT FILE NAME >;NOTNX + +TNX,< MOVE C,JFNTBL + MOVEM C,TXTFIL ;SAVE INPUT JFN >;TNX + +PRNTC1: PUSHJ P,SCAN1 ;GET CHR. +PRNTC2: CAIN C, ;TERM CHR? (ADDRESS PART CLOBBERED) + JRST PRNTC3 ;YES + OUTCHR C ;NO. TYPE IT. + JRST PRNTC1 + +PRNTC3: SETZM TXTPG ;CLEAR STATE OF BEING INSIDE TEXT-OP + JRST SPCFN + ; ASSIGN FOR TENEX (RST 9 MARCH 70) (NOT SUPPORTED BY OLD LOADER!) +; FOR TENEX, THIS IS ASSIGN, ELSEWHERE, .ASSIGN + +;SYNTAX IS: ASSIGN ID1,ID2,EXP +;EXP IS OPTIONAL (1 IS THE DEFAULT). +;THE EFFECT IS TO ASSIGN THE VALUE OF ID1 TO ID2 AND THEN TO INCREMENT THE +;VALUE OF ID1 BY EXP. + + +ASHED: -5,,ASWHO +ASWHO: 100,,3 + 0 +ASBLK: BLOCK 3 + +ASSNE1: ERROR [ASCIZ/NO IDENT/] + JRST NSPCFN + +ASSNE2: ERROR [ASCIZ/ALREADY DEFINED/] + JRST NSPCFN + +ASSNE3: ERROR [ASCIZ/NEED COMMA/] + JRST NSPCFN + +^%ASSIG: + PUSHJ P,BFFRC ;FORCE OUT ANY BINARY AND FIXUPS + PUSHJ P,SCANS ;GET IDENT + TLNN IFLG ;IS IDENT NEXT? + JRST ASSNE1 + MOVE T,2(PN) ;GET FLAGS FOR THIS IDENT + TLNN T,DEFFL ;ALREADY DEFINED? + JRST ASSNE2 + TLO T,EXTF ;MAKE IT EXTERNAL + MOVEM T,2(PN) + TRNN B,COMF ;WAS IDENT TERMINATED BY COMMA? + JRST ASSNE3 + MOVE FS,(PN) ;GET SYMBOL + PUSHJ P,R5CON ;CONVERT TO RADIX 50 + MOVEM FS,ASBLK ;PUT IN BLOCK FOR OUTPUT + TLZ SFL ;SKIP OVER THE COMMA + PUSHJ P,SCANM ;GET SECOND IDENT + MOVE FS,L + PUSHJ P,R5CON ;CONVERT TO RADIX 50 + MOVEM FS,ASBLK+1 + MOVEI N,1 ;DEFAULT INCREMENT IS 1 + TRNN B,COMF ;IF NO COMMA + JRST ASGN1 + TLZ SFL ;SKIP THE COMMA + TRO NOFXF ;NO FIXUPS ALLOWED + PUSHJ P,MEVAL ;EVALUATE THE EXPRESSION + TRNN NA,17 ;MUST NOT BE RELOCATED + TLNE UNDF!ESPF ;OR UNDEFINED OR SPECIAL RELOCATION + JRST PER1 ;IF IT IS, OUTPUT ERROR MESSAGE +ASGN1: MOVEM N,ASBLK+2 ;STORE SIZE IN BLOCK FOR OUTPUT + BBOUT ASHED ;OUTPUT THE BLOCK + JRST SPCFN ;AND CONTINUE + ; .DIRECT + +DIRCO1: ERROR [ASCIZ/UNKNOWN FUNCTION NAME/] +DIRCON: TRNN B,COMF ;HERE TO CONTINUE SCAN. COMMA NEXT? + JRST SPCFN ;NO. DONE + TLZ SFL ;SKIP THE COMMA +^%DIREC: + PUSHJ P,SCANM ;GET AN ID NAME + TLNN IFLG ;IDENT? + JRST PNOI ;NO. LOSE "NOT IDENT" + MOVSI N,-DIRTLN + CAME L,DIRTBL(N) + AOBJN N,.-1 + JUMPGE N,DIRCO1 + XCT DIRTB2(N) + JRST DIRCON + +DIRTBL: ' KA10' ;DENOTE CODE TO RUN ON KA10 ONLY + ' KI10' ;DENOTE CODE TO RUN ON KI10 ONLY + '.ITABM' ; + '.XTABM' ;IGNORE TABS AND BLANKS IN MACRO ARGS, + '.NOBIN' ;NO BINARY OUTPUT + '.NOUNV' ;NO BINARY UNIVERSAL OUTPUT +DIRTLN__.-DIRTBL + +DIRTB2: PUSHJ P,DIRSTA ;KA10 + PUSHJ P,DIRSTI ;KI10 + SETZM TABMSW ;.ITABM + SETOM TABMSW ;.XTABM + PUSHJ P,DIRBSP ;.NOBIN + SETOM FUNSUP ;.NOUNV - SUPPRESS FUN FILE + +DIRSTA: SKIPA N,[1] ;SET KA10 +DIRSTI: MOVEI N,2 ;SET KI10 + DPB N,[POINT 6,TPOL4,5] ;STORE WHERE TITLE OUTPUT WILL DO IT. + SKIPLE TITLSW ;TITLE OUTPUT ALREADY? + ERROR [ASCIZ/KA10 OR KI10 DIRECTIVE MUST PRECEDE CODE EMISSION/] + POPJ P, + +DIRBSP: TRZN BDEV ;CLEAR BINARY DEVICE + POPJ P, +NOTNX,< + CLOSE 3,1 ;CLOSE OUTPUT. SUPRRESS CLOSE OUTPUT + RELEAS 3,1 ;RELEASE FILE. SUPPRESS CLOSE OUTPUT +>;NOTNX +TNX,< + HRRZ 1,JFNTBL-2+3 ;JFN FOR BINARY FILE + TLO 1,400000 ;DON'T RELEASE JFN + CLOSF + JRST DIRBXX + HRRZ 1,JFNTBL-2+3 + SETZM JFNTBL-2+3 + DELF +DIRBXX: PUSHJ P,[ERROR [ASCIZ/(Can't delete binary file.)/] + POPJ P,] +>;TNX + POPJ P, + +BEND POPS + SUBTTL MAIN: THIS HERE IS THE ASSEMBLER + +MAINQ: MOVE N,PCNT+1 ;GET RELOC + MOVEM N,DPCNT+1 ;AND SET RELOC OF . + MOVE N,PCNT + MOVEM N,DPCNT +MAIN: TLZ OPFLG!MLFT + ACALL ;CALL ASSMBL + SKIPN WRD+1 ;ANYTHING ON LINE? + JRST MAINQ ;NO, NOTHING + OUTP WRD ;OUTPUT THE STUFF + AOS OPCNT ;INCREMENT + MOVE N,OPCNT + CAMGE N,BRK ;HIGH SEGMENT? + JRST MAIN.1 ;NO,LOW SEGMENT + CAML N,HICNT ;YES. IS OPCNTHICNT? + MOVEM N,HICNT ;YES. INCREMENT HIGH + JRST MAIN.2 + +MAIN.1: CAML N,@CURBRK ;IS OPCNTLOCNT? + MOVEM N,@CURBRK ;YES, INCREMENT LOW +MAIN.2: AOS N,PCNT ;INCREMENT + MOVEM N,DPCNT ;SET ADDRESS OF . + SKIPN N,POLPNT ;ANY POLFIXES FOR NOW? + JRST MAIN ;NO + SETZM POLPNT ;CLEAR POINTER + PUSHJ P,BFRC ;FORCE OUT BIN +MAINL: MOVEI FS,5(N) ;SET UP POINTER + MOVE NA,1(N) ;GET NEXT PNTR. + PUSHJ P,POLOUT ;PUT OUT POLFIX + SKIPN N,NA ;ANY MORE? + JRST MAIN ;NO + JRST MAINL ;YES + BEGIN UUO  SUBTTL UUO HANDLER AND OUTPUT ROUTINES + +^UUO: 0 + PUSH P,TAC ;SAVE AN AC. + LDB TAC,[POINT 5,40,8] ;GET UUO # + MOVE TAC,UUOTB(TAC) ;GET DISPATCH ADDRESS + EXCH TAC,(P) ;RESTORE AC, PUT DISPATCH ADDRESS ON STACK + PUSHJ P,@(P) ;CALL ROUTINE + SUB P,[1,,1] ;REMOVE DISPATCH ADDR FROM STACK + JRST @UUO ;RETURN + +UUOTB: ;UUO DISPATCH TABLE + +NOTNX,>;NOTNX + +TNX, +UOUTST +UOUTCH +>;TNX + +UERR +UFAT +UFOUT +UOUTP +UPOUT +UTRAN +UBBOUT +UCREF6 +UCRF66 +UCREF7 +FOR I_23,37 + +ILUUO: OUTSTR [ASCIZ/ILLEGAL USER UUO +/] + JRST 4,CPOPJ + +BEND UUO + ; BINARY I/O HANDLING ROUTINES + + +BEGIN BIO +^BBLK: XWD 1,0 + BLOCK 23 +^FBLK: XWD 10,0 + BLOCK 23 + +^UOUTP: JUMPN BC,NOINI ;NOT FIRST WORD? + MOVE TAC,OPCNT ;GET OUTPUT ADDRESS + MOVEM TAC,BBLK+2 ;STORE + MOVE TAC,OPCNT+1 ;GET RELOCATION + LSH TAC,2 ;SHIFT + MOVEM TAC,BBLK+1 ;STORE + MOVE BC,[XWD -21,BBLK+3] +NOINI: MOVE TAC,@40 ;GET WORD + MOVEM TAC,(BC) ;STORE + AOS 40 + MOVE TAC,@40 ;GET RELOC + DPB TAC,[POINT 1,TAC,34] + LDB TAC,[POINT 2,TAC,34] + OR TAC,BBLK+1 ;OR IN + AOBJP BC,FULL ;FULL? + LSH TAC,2 ;NO + MOVEM TAC,BBLK+1 ;STORE + POPJ P, + +FULL: MOVEM TAC,BBLK+1 ;STORE RELOCATION + MOVEI TAC,22 + HRRM TAC,BBLK ;SET COUNT + MOVE BC,[XWD -24,BBLK] ;OUTPUT COUNT + PUSHJ P,GBOUT ;OUTPUT THE BLOCK + MOVEI BC, + POPJ P, + ;UBBOUT, GBOUT + +UBBSV: 0 + +^UBBOUT:MOVEM BC,UBBSV + MOVE BC,40 + MOVE BC,(BC) + PUSHJ P,GBOUT + MOVE BC,UBBSV + POPJ P, + +^GBOUT: HLRZ TAC,(BC) ;GET BLOCK TYPE + CAIE TAC,4 ;IGNORE IF ENTRY + SETOM CODEM ;FLAG THAT CODE WAS PUT OUT + CAIN TAC,2 ;ALSO CHECK SYMBOLS + SETOM SYMEM + TRNN BDEV ;BIN DEVICE? + POPJ P, ;NO + SKIPG TITLSW ;TITLE (NAME) OUTPUT YET? + SKIPN CODEM ;NO. IS THIS AN ENTRY BLOCK? + JRST GBOUT0 ;TITLE (NAME) IS OUT OR THIS IS AN ENTRY BLOCK. + SKIPL TITLSW ;TITLE SET BY USER YET? + JRST GBOUTT ;YES. DO TITLE NOW. + SKIPN SYMEM ;IS THIS A SYMBOL GOING OUT. + JRST GBOUT0 ;NO. WELL, WE CAN WAIT LONGER TO INVENT NAME BLOCK +GBOUTT: PUSH P,BC + MOVE BC,[-4,,TPOL2] + HRRZM BC,TITLSW ;SET WE HAVE WRITTEN TITLE. + PUSHJ P,GBOUT0 ;WRITE 4 WORDS OF NAME BLOCK. + POP P,BC ;RESTORE ACTUAL BINARY POINTER. + +GBOUT0: +STINK,< PUSHJ P,STKTRN ;TRANSLATE TO STINK FORMAT + PUSHJ P,GBOUT1 + POPJ P, ;STKTRN SKIPS UPON OCCASION + +^^GBOUT1: >;STINK + +GBOUT2: MOVE TAC,(BC) + SOSLE ODB+2 + JRST GBPT +GBOUT3: +NOTNX,< OUT 3, + JRST GBPT + OUTSTR [ASCIZ /OUTPUT ERROR ON BINARY FILE. TYPE ANY CHAR TO RETRY./] + PUSH P,T + PUSHJ P,WAIT + POP P,T + OUTSTR TTCRLF + JRST GBOUT3 +>;NOTNX + +TNX,< + TSVAC <1,2,3> + SKIPL JFNTBL-2+3 + JRST GBOU3B ;IF FILE NOT PMAPPABLE + AOS 1,ODB ;BUMP PAGE NUMBER + HRL 1,JFNTBL-2+3 ;JFN,,PAGE + MOVE 2,[XWD 400000,BINBFP] ;THIS FORK, BIN BUFF PG + HRLZI 3,140000 ;READ/WRITE + PMAP ;CREATE NEW FILE PAGE! +GBOU3A: MOVEI 1,1000 + MOVEM 1,ODB+2 ;SET BYTE COUNTER + MOVE 1,[POINT 36,BINBF] + MOVEM 1,ODB+1 ;SET POINTER + TRSTAC <1,2,3> + JRST GBPT + +GBOU3B: HRRZ 1,JFNTBL-2+3 ;JFN + HRROI 2,BINBF + MOVNI 3,1000 + SKIPL ODB+2 ;SKIP IF FIRST BUFFER NOT YET READY + SOUT + JRST GBOU3A +>;TNX + +GBPT: IDPB TAC,ODB+1 + AOBJN BC,GBOUT2 + POPJ P, + +^BFRC: JUMPE BC,CPOPJ +^BFX: MOVEI TAC,(BC) ;ADDRESS GETS FIXED UP TO -(BBLK+2) + HRRM TAC,BBLK ;COUNT + MOVE TAC,BBLK+1 ;GET RELOC BITS + LSH TAC,-2 + LSH TAC,2 + AOBJN BC,.-1 ;SHIFT RELOC BITS + MOVEM TAC,BBLK+1 + MOVN BC,BBLK ;GET - COUNT + HRLI BC,-2(BC) ;SUBTRACT 2 & PUT IN LEFT HALF + HRRI BC,BBLK ;SET ADRESS + PUSHJ P,GBOUT + MOVEI BC, + POPJ P, + +TPOL2: 6,,2 ;BUILD NAME BLOCK HERE. + 0 +^^TPOL3:0 ;THIS IS WHERE WE PUT THE RADIX50 PROGRAM NAME. +^^TPOL4:12,,0 ;PROCESSOR TYPE 12 = FAIL. + ^UFOUT: MOVE TAC,@40 ;GET WORD + MOVEM TAC,(FC) ;DEPOSIT + AOS 40 + MOVE TAC,@40 ;GET RELOC + ANDI TAC,3 + OR TAC,FBLK+1 ;OR IN + AOBJP FC,FFUL ;FULL? + LSH TAC,2 ;NO, SHIFT + MOVEM TAC,FBLK+1 ;STORE + POPJ P, + +FFUL: MOVEM TAC,FBLK+1 ;STORE RELOC BITS + MOVEI TAC,22 + HRRM TAC,FBLK ;SET COUNT + PUSHJ P,BFRC ;FORCE OUT BIN + MOVE BC,[-24,,FBLK] + PUSHJ P,GBOUT ;OUTPUT IT + MOVE FC,[-22,,FBLK+2] ;INIT + SETZB BC,FBLK+1 + POPJ P, + + ;BFFRC, FFX, UPOUT + +^BFFRC: PUSHJ P,BFRC ;FORCE BINARY, AND THEN... + CAMN FC,[-22,,FBLK+2] ;FORCE ANY FIXUPS + POPJ P, +^FFX: MOVEI TAC,(FC) ;ADDRESS GETS FIXED UP TO -(FBLK+2) + HRRM TAC,FBLK ;SET COUNT + MOVE TAC,FBLK+1 ;GET RELOC BITS + LSH TAC,-2 + LSH TAC,2 ;SHIFT + AOBJN FC,.-1 ;LOOP + MOVEM TAC,FBLK+1 + MOVN FC,FBLK ;GET -COUNT + HRLI FC,-2(FC) ;SUB 2 & PUT IN LEFT + HRRI FC,FBLK ;SET ADDRESS + EXCH FC,BC + PUSHJ P,GBOUT ;OUTPUT IT + MOVE BC,FC + MOVE FC,[-22,,FBLK+2] ;INIT + SETZM FBLK+1 + POPJ P, + +^UPOUT: PUSH P,BC ;SAVE + MOVE BC,40 ;GET ADDRESS + LDB TAC,[POINT 4,BC,12] ;GET COUNT + MOVNS TAC ;NEGATE + HRL BC,TAC ;PUT IN LEFT + PUSHJ P,GBOUT ;OUTPUT IT + POP P,BC ;RESTORE + POPJ P, + +^BNAM: BLOCK =20 ;BLOCK NAMES + ;R5CON +; COMVERTS SIXBIT IN FS TO RADIX50 & PUTS RESULT IN FS, USES N + +^R5CON: MOVEM FS,R5C1 + MOVE FS,[POINT 6,R5C1] + MOVEM FS,R5C1+1 + ILDB FS,R5C1+1 ;GET FIRST CHR. + MOVE FS,R5TAB(FS) ;CON TO R5 + ILDB N,R5C1+1 + IMULI FS,50 + ADD FS,R5TAB(N) + ILDB N,R5C1+1 + IMULI FS,50 + ADD FS,R5TAB(N) + ILDB N,R5C1+1 + IMULI FS,50 + ADD FS,R5TAB(N) + ILDB N,R5C1+1 + IMULI FS,50 + ADD FS,R5TAB(N) + ILDB N,R5C1+1 + IMULI FS,50 + ADD FS,R5TAB(N) + POPJ P, + +R5C1: BLOCK 2 +R5TAB: FOR I_0,'$'-1 + <0 + > + 46 + 47 + FOR I_'%'+1,'.'-1 +<0 +> + 45 + FOR I_'.'+1,'0'-1 +<0 +> + FOR I_1,12 + + FOR I_'9'+1,'A'-1 +<0 +> + FOR I_13,44 + + FOR I_'Z'+1,77 +<0 +> + +BEND + BEGIN LIO  SUBTTL LISTING I/O STUFF + +^UERR: LDB TAC,LSTPNT ;GET CURRENT CHR + PUSH P,TAC ;SAVE + MOVEI TAC,177 ;GET DELETE + DPB TAC,LSTPNT ;OUTPUT + MOVEI TAC,13 ;PRINT... + IDPB TAC,LSTPNT ;INTEGRAL SIGN +ARNT: POP P,TAC ;GET BACK THAT CHR + IDPB TAC,LSTPNT + MOVE TAC,ERPNT ;GET ERROR POINTER + PUSH TAC,40 ;SAVE ADDRESS + AOS ERCNT ;COUNT + MOVEM TAC,ERPNT + POPJ P, + +^UFAT: PUSHJ P,UERR ;PUT OUT MESSAGE + PUSHJ P,LSTFRC + JRST FEND + +^BLOUT: TRNE LDEV ;LIST DEVICE? + SKIPE XL2SW ;INSIDE XLIST? + POPJ P, ;NO LIST DEVICE, OR IN XLIST + MOVE TAC,PCNT+1 + TLNE TAC,INCF ;IN CORE? + JRST LBLOUT ;YES + TROE BLOSW ;SET & TEST + JSR BLOT ;NO LSTFRC SINCE LAST BLOUT +BLRET: PUSH P,T ;SAVE T + PUSH P,FS ;SAVE FS + MOVS FS,OPCNT ;GET OUTPUT LOCATION + MOVE TAC,OPCNT+1 ;GET RELOC + PUSHJ P,OCON ;CONVERT TO ASCII OCTAL + MOVEM T,LBLK ;STORE IN BUFFER + MOVEM FS,LBLK+1 ;... +LBCON: MOVE FS,WRD ;GET LEFT HALF + MOVE TAC,WRD+1 ;GET RELOC... + LSH TAC,-2 ;... + PUSHJ P,OCON ;CONVERT + MOVEM T,LBLK+2 + MOVEM FS,LBLK+3 + MOVS FS,WRD ;GET RIGHT HALF + MOVE TAC,WRD+1 ;GET RELOC + PUSHJ P, OCON ;CONVER + MOVEM T,LBLK+4 + MOVEM FS,LBLK+5 + POP P,FS ;RESTORE... + POP P,T + POPJ P, + +BLOT: 0 + PUSHJ P,LSTCHK ;MAKE SURE LOUT IS INTACT + MOVE TAC,[-6,,LBLK] + PUSHJ P,LOUT ;OUTPUT THE BINARY OCTAL... + MOVE TAC,[-1,,LCR] + PUSHJ P,LOUT ;AND A CRLF + JRST @BLOT + +^LBLOUT:TRNE LDEV ;LIST DEVICE? + SKIPE NOLTSW ;NO LITTERAL LIST? + POPJ P, ;NO + TROE BLOSW ;SET & TEST + JSR BLOT ;NO LSTFRC SINCE... + PUSH P,T ;SAVE + PUSH P,FS + MOVE T,[BLNKS,,LBLK] + BLT T,LBLK+1 ;BLANK LOCATION FIELD + JRST LBCON + +BLNKS: ASCII / / + BYTE (7)40,40,11 + ASCII / / + BYTE (7)40,40,11 + ^VBLOUT:TRNN LDEV ;LIST DEVICE? + POPJ P, ;NO + TROE BLOSW ;ANY LSTFRC SINCE? + JSR BLOT ;NO + PUSH P,T ;SAVE + PUSH P,FS + MOVS FS,OPCNT ;GET LOCATION + MOVE TAC,OPCNT+1 ;&RELOC + PUSHJ P,OCON ;CONVERT TO ASCII + MOVEM T,LBLK + MOVEM FS,LBLK+1 + MOVE T,[BLNKS,,LBLK+2] + BLT T,LBLK+5 ;BLANK VALUE + POP P,FS + POP P,T + POPJ P, + +^UTRAN: TRNN LDEV ;LIST DEV EXIST? + POPJ P, ;NO + TROE BLOSW ;SET & TEST + JSR BLOT ;EXTRA BINARY, DUMP IT + MOVS TAC,40 ;GET ADDRESS + HRRI TAC,LBLK ;SET UP BLT WRD + BLT TAC,LBLK+5 ;BLT + POPJ P, + +LCR: BYTE (7)15,12 + +^OCON: HRRI FS,0 ;CONVERT OCTAL IN LH OF FS TO ASCII IN FS AND T. + MOVEI T,0 + LSHC T,3 ;MOVE DIGIT IN. + LSH T,4 ;SHIFT TO MAKE ROOM FOR THE NEXT. + LSHC T,3 + LSH T,4 + LSHC T,3 + LSH T,4 + LSHC T,3 + LSH T,4 + LSHC T,3 + LSH T,1 + IOR T,[ASCII/00000/] + LSH FS,-4 ;SHIFT THE LAST DIGIT BACK. + IOR FS,[BYTE(7)60,40,11,0,0] + TRNE TAC,1 ;RELOC? + ADD FS,[BYTE(7)0,<"'"-40>] + POPJ P, + ^LSTLF: SKIPGE AHED ;LINE FEED SEEN -- IF NOT FROM MACRO + SETOM INCLIN ;PREPARE TO UPDATE LINE NUM (FOR NON-SOS FILES) +^LSTFRC:PUSHJ P,LSTCHK ;CHECK FOR CLOBBERAGE + JRST FLST + +LBCLOB: ASCII / ****** LISTING LINE CLOBBERED ******/ +LBCLBL__.-LBCLOB + +^LSTCHK:MOVNI TAC,1 + CAMN TAC,LTEST ;OVERRUN? + POPJ P, ;NO + CAMN TAC,LTEST2 + JRST LST2OK + MOVE TAC,SVLNUM + MOVEM TAC,TLBLK + MOVE TAC,[LBCLOB,,TLBLK+1] + BLT TAC,TLBLK+LBCLBL ;CLOBBER LISTING LINE + MOVE TAC,[440700,,TLBLK+LBCLBL+1] + MOVEM TAC,LSTPNT +LST2OK: OUTSTR [ASCIZ /Line buffer overflow -- assembler clobbered. +/] + +NOTNX,< SETZB TAC,.JBAPR ;NO MORE MPV INTERRUPTS + APRENB TAC, ;ENABLE NO INTERRUPTS +>;NOTNX + +TNX,< MOVEI 1,400000 ;THIS FORK + DIR ;DISABLE INTERRUPTS +>;TNX + + PUSHJ P,TTYERP + MOVE TAC,[JRST LSTFRC] + MOVEM TAC,STRT+2 ;MAKE IT DIFFICULT TO RESTART +NOTNX,< JRST 4,LSTFRC >;NOTNX +TNX,< HALTF + JRST .-1 >;TNX + +^ERRHED:OUTSTR FILNM ;TYPE CURRENT FILE NAME (CALLED FROM PRINTX) + OUTSTR [ASCIZ /, PAGE /] + PUSH P,NA + MOVE N,PGNM + PUSHJ P,PGOUT + SKIPE TLBLK + JRST ERRHD1 ;SOS LINE NUM EXISTS -- USE IT + OUTSTR [ASCIZ /, LINE /] + MOVE N,INLINE + ADDI N,1 + PUSHJ P,PGOUT ;NO NUM -- USE OUR OWN +ERRHD1: POP P,NA + OUTSTR TTCRLF + POPJ P, + + +^TTYERP:PUSH P,TAC + MOVE TAC,LSTPNT + TLO TAC,700 ;SIZE MIGHT BE 0 IN MACRO + PUSH P,T + MOVEI T,15 ;MAKE SURE WE GET A CR-LF + IDPB T,TAC + MOVEI T,12 + IDPB T,TAC + PUSH P,N + PUSHJ P,ERRHED ;TYPE ERROR HEADING TEXT + MOVEI N,TLBLK + SKIPN TLBLK ;ANY SOS LINE NUM? + SKIPA TAC,[350700,,1(N)] ;NO, SKIP IT + MOVSI TAC,(<440700,,(N)>) ;YES, PRINT IT +CLOP3: ILDB T,TAC ;GET CHR OF LINE + JUMPE T,CLOP5 +CLOP6: CAIN T,177 ;DELETE? + JRST CLOP2 ;YES +CLOP4: OUTCHR T ;TYPE IT + CAIE T,12 ;DONE IF IT'S LF + JRST CLOP3 + MOVE TAC,LSTPNT + MOVEI T, + IDPB T,TAC ;NULL OUT FORCED CRLF (MAY SCREW UNDERLINE KLUDGE) + IDPB T,TAC + POP P,N + POP P,T +TTYERX: POP P,TAC + POPJ P, + +CLOP2: ILDB T,TAC + CAIN T,13 ;INTEGRAL SIGN? + HRROI T,12 ;YES, USE LINE-FEED (BUT AVOID COMPARE) + JRST CLOP4 + +CLOP5: TRNE TAC,-LBFSZ ;NULL - SEE IF REALLY UNDERLINE KLUDGE + JRST CLOP3 ;CAN'T BE IF OFF END + XORI N,MBLKTLBLK ;TRY OTHER BUFFER + LDB T,TAC + JUMPN T,CLOP6 ;YUP - TIME TO SWITCH BUFFERS + XORI N,MBLKTLBLK + JRST CLOP3 + +PGOUT: IDIVI N,12 + JUMPE N,.+4 + HRLM NA,(P) + PUSHJ P,PGOUT + HLRZ NA,(P) + MOVEI T,"0"(NA) + OUTCHR T + POPJ P, + ; DATA AREA FOR LISTING STUFF + +^TITCNT: XWD -1,.+1 + 0 + BLOCK 40 + +HEDCNT: XWD -LHEAD,.+1 + ASCII / FAIL / +HEAD: BLOCK 4 +NOTNX,<^FILNM: BLOCK 5;> BYTE (7)11,11 + ASCII / Page/ +PG: ASCII / / + BLOCK 3 ;ALLOW ROOM FOR BLOCK NAME TOO + 11*200*2 ;FINISH WITH A TAB +LHEAD__.-HEDCNT-1 + +^SUBCNT: XWD -1,.+1 +NOTNX,< BYTE (7)15,12,15,12;> BYTE (7)11,11,11,11,11 + BLOCK 40 +PTPNT: 0 + +TNX,< +^FILCNT: XWD -1,FILNM ;LH GETS CLOBBERED +^FILNM1: 0 +^FILNM2: 0 +^FILNM: BLOCK =28 ;ROOM FOR TENEX FILE NAME AND MISC JUNK +>;TNX + +;I SEE IT, I UNDERSTAND IT, BUT I DON'T BELIEVE IT. REG +;FROM A DEC SYSTEM, I'LL BELIEVE ANYTHING... TMW +NOTNX,< +MOTAB: +FOR ZOT IN (NAJ,BEF,RAM,RPA,YAM,NUJ,LUJ,GUA,PES,TCO,VON,CED)<"ZOT" +> +>;NOTNX + +^SPGNM: 0 +^PGNM: 0 +^LNCNT: 0 +^PAGSIZ:0 ;PAGE SIZE FOR LISTING +^ERPD: BLOCK ERPLEN +^ERPNT:0 +^PGBF: 0 ;FOR TYPING PAGE NUMBERS IN ERROR MESSAGES--DCS 2/6/70 + 0 +^XPNDSW:0 +^SVLNUM:0 + BYTE (7)11,11,11 +LBFSZ__200 ;SIZE OF LINE BUFFER - MUST BE POWER OF 2 (SEE TTYERP) +^MBLK: BLOCK LBFSZ +LTEST2: -1 +^LBLK: BLOCK 6 +^TLBLK: BLOCK LBFSZ +^LTEST: -1 + + ;HERE SPEC CHRS & LINE OVERFLOW ARE HANDLED + JRST LOUT2 ;FOR SLURP HACK ETC. +LOUTTB: JRST LOUTDL ;RUBOUT + JRST LOUTLF ;LF + JFCL ;" or <==> (^W) + JRST LOUT2 ;' + JRST LOUT2 ;= + JRST LOUTSP ;SP & TAB + JRST LOUTCR ;CR + JRST LOUTFF ;FF + JRST LOUT2 ;<{ + JRST LOUT2 ;>} + +LOUTLF: SOSLE LNCNT + JRST LOUT3 ;JUST OUTPUT IF NO PAGE OFLO + SKIPL LNCNT ;DON'T CLOBBER CHAR IF ABOUT TO DO HEADING + MOVEI T,14 ;ELSE TURN INTO FF +LOUTFF: SKIPGE LNCNT ;IF ALREADY OFF PAGE + JRST LOUTH ;THEN DO HEADING + SKIPGE CHRCNT ;SEE IF DOING CREF STUFF + JRST LOUT3 ;AND AVOID SPECIAL TREATMENT FOR FF + MOVSI TAC,1 ;OTHERWISE USE A BIG NUMBER + MOVEM TAC,CHRCNT ;TO GET US TO LOUTH ON THE NEXT CHAR + SETOM LNCNT ;MARK US OFF PAGE + JRST LOUT3 ;AND GO OUTPUT FF + +LOUTCR: HLLZS CHRCNT ;CR RESETS POS EXCEPT HEADING FLAG + JRST LOUT3 + +LOUTSP: CAIE T,11 ;SEE IF THIS "SPACE" IS A TAB + JRST LOUT2 ;NO + MOVEI TAC,7 ;YES - UPDATE POS TO TAB STOP + IORM TAC,CHRCNT ;(ACTUALLY 1 SHORT) + JRST LOUT2 ;AOS AT LOUT2 WILL MAKE IT RIGHT + +LOUTOV: TLNE TAC,-1 ;CHECK IF THIS IS REALLY HEADING FLAG + JRST LOUTH ;YES + HRROI TAC,[ASCIZ / +/] + PUSHJ P,LOUT ;JUST OFLO - STICK IN CRLF + JRST LOUT1A ;& REPROCESS CURRENT CHAR + LOUTDL: SKIPLE LNCNT + JRST LOUT3 ;PASS RUBOUT QUIETLY IF HEADING NOT NEEDED +LOUTH: PUSHJ P,LOUTH1 ;DO HEADING STUFF + JRST LOUT1A ;REPROCESS CURRENT CHAR + +LOUTH1: HRROI TAC,[BYTE (7)15] ;HEADING TIME - FIRST OUTPUT CR + PUSHJ P,LOUT + SETZM CHRCNT ;& CLEAR FLAG + MOVE TAC,PAGSIZ + MOVEM TAC,LNCNT ;RESET LINE COUNTER + MOVE TAC,TITCNT + PUSHJ P,LOUT + PUSHJ P,PTIM + MOVE TAC,HEDCNT + PUSHJ P,LOUT + MOVE TAC,SUBCNT ;SUBTTL + +TNX,< PUSHJ P,LOUT + MOVE TAC,FILCNT ;FILE NAME + PUSHJ P,LOUT + HRROI TAC,[BYTE(7)15,12,15,12] >;TNX + + JRST LOUT + + DEFINE DEP +< ADDI N,60 + ADDI NA,60 + IDPB N,PTPNT + IDPB NA,PTPNT +> + PTIM: PUSH P,N + PUSH P,NA +NOTNX,< + DATE N, ;GET DATE + MOVE NA,[POINT 7,HEAD] + MOVEM NA,PTPNT + IDIVI N,=31 ;GET DAY + MOVEM N,PG+1 ;SAVE + MOVEI N,(NA)1 ;GET DAY + IDIVI N,12 ;CON TO DEC + SKIPN N ;ZERO LEADING DIGIT? + MOVNI N,20 ;YES, CON TO BLANK + DEP + MOVEI N,"-" + IDPB N,PTPNT + MOVE N,PG+1 + IDIVI N,=12 ;GET MONTH & YEAR + MOVE NA,MOTAB(NA);GET MONTH NAME + IDPB NA,PTPNT ;DEPOSIT + LSH NA,-7 + IDPB NA,PTPNT + LSH NA,-7 + IDPB NA,PTPNT + MOVEI NA,"-" + IDPB NA,PTPNT + ADDI N,=64 + IDIVI N,12 + DEP + MOVEI N,40 + IDPB N,PTPNT + IDPB N,PTPNT + MSTIME N, ;GET TIME + IDIVI N,=60000 ;THROW AWAY M.S & SEC + IDIVI N,=60 ;GET HRS & MINS + MOVEM NA,PG+1 ;SAVE MINS + IDIVI N,12 ;CON TO DEC + SKIPN N + MOVNI N,20 + DEP + MOVE N,PG+1 + MOVEI NA,":" + IDPB NA,PTPNT + IDIVI N,12 + DEP +>;NOTNX +TNX,< + TSVAC <1,2,3> + HRROI 1,HEAD + SETO 2, ;USE CURRENT DATE/TIME + HRLZI 3,000200 ;PROPER FORMAT AS BEFORE + ODTIM + TRSTAC <1,2,3> +>;TNX + SETZM PG+1 + SETZM PG+2 + SETZM PG+3 + HRRZS PG+4 + MOVE N,[POINT 7,PG,13] + MOVEM N,PTPNT + MOVE N,PGNM ;GET PAGE NUM + PUSHJ P,PGCON + AOS N,SPGNM + CAIG N,1 + JRST PTIM2 + MOVEI NA,"-" + IDPB NA,PTPNT + PUSHJ P,PGCON +PTIM2: MOVEI N,15 + IDPB N,PTPNT + MOVEI N,12 + IDPB N,PTPNT + MOVE NA,[440600,,LSTLAB+3] ;TO GET BLOCK NAME +REPEAT 6,< ILDB N,NA + ADDI N,40 + IDPB N,PTPNT> + POP P,NA + POP P,N + POPJ P, +PGCON: IDIVI N,12 ;CON TO DEC + JUMPE N,PGCOA ;0? + HRLM NA,(P) ;SAVE REMAINDER + PUSHJ P,PGCON + HLRZ NA,(P) ;GET REMAINDER +PGCOA: ORI NA,60 + IDPB NA,PTPNT + POPJ P, + FLST: SKIPN ERCNT ;ANY ERRORS? + JRST QLST ;NO + SKIPN TTYERR ;IF ANYBODY WILL WANT MESSAGE, + JRST LSTAR ;THEN PRINT STARS + SKIPN LISTSW + JRST QLST ; DON'T EVEN CONSIDER IT +LSTAR: PUSH P,N + MOVEI N,[ASCIZ /#####/] + SKIPL ERCNT ;DON'T PRINT STARS FOR PRINTX + PUSHJ P,ERLST ;PRINT STARS + POP P,N + SKIPN TTYERR ;LIST ERRORS ON TTY? + PUSHJ P,TTYERP ;YES - DO IT +QLST: AOSN INCLIN ;IF NECESSARY, + AOS INLINE ;UPDATE LINE NUM AFTER TTYERP + TRNE LDEV ;LISTING? + JRST YESL ;YES + HRRZ TAC,LSTPNT + CAIGE TAC,TLBLK ;POINTER IN MACRO? + SKIPA TAC,[POINT 7,MBLK+1,6] ;YES + MOVE TAC,[POINT 7,TLBLK+1,6] + SKIPN XPNDSW + TLZ TAC,7700 + MOVEM TAC,LSTPNT ;RESET LSTPNT + SKIPN UNDLNS ;UNDERLINING? + JRST ERSCN ;NO + SETZM MBLK + MOVE TAC,[XWD MBLK,MBLK+1] + BLT TAC,LTEST-1;CLEAR BUFFER + SETOM LTEST2 + MOVE TAC,[BYTE (7) 11] + MOVEM TAC,TLBLK+1 + JRST ERSCN ;PRINT ERRORS + +;ROUTINE TO OUTPUT TO LISTING FILE - AOBJN PNTR IN TAC +^LOUT: PUSH P,T ;SAVE + PUSH P,FS ;SAVE +LOUT0: PUSH P,TAC + MOVE FS,(TAC) + ANDCMI FS,1 ;CLEAR UNUSED BIT 35 +LOUT1: MOVEI T,0 + LSHC T,7 ;MOVE CHARACTER FROM FS TO T +LOUT1A: SKIPL TAC,CTAB(T) + JRST LOUTS ;MIGHT BE SPECIAL + +IFE STANSW,< ;STANFORD AI PRINTER WINS + CAIN T,30 ;AI version of underscore + MOVEI T,"." ;convert to period otherwise +>;STANSW + +LOUT2: AOS TAC,CHRCNT + CAML TAC,CHRPL + JRST LOUTOV ;OVERFLEW LINE +LOUT3: SOSG LOB+2 +NOTNX,< OUTPUT 4,> +TNX,< JRST LOUT3A +LOUT30: >;TNX + IDPB T,LOB+1 +LOUT4: JUMPN FS,LOUT1 + POP P,TAC + AOBJN TAC,LOUT0 + POP P,FS + POP P,T + POPJ P, + +TNX,< +LOUT3A: TSVAC <1,2,3> + SKIPL JFNTBL-2+4 + JRST LOUT3C ;IF NOT PMAPPABLE FILE + AOS 1,LOB ;UPDATE PAGE NUMBER + HRL 1,JFNTBL-2+4 ;JFN,,PAGE + MOVE 2,[XWD 400000,LSTBFP] + HRLZI 3,140000 ;READ/WRITE + PMAP ;CREATE NEW PAGE +LOUT3B: MOVEI 1,1000*5 + MOVEM 1,LOB+2 ;SET COUNT + MOVE 1,[POINT 7,LSTBF] + MOVEM 1,LOB+1 ;AND POINTER + TRSTAC <1,2,3> + JRST LOUT30 + +LOUT3C: HRRZ 1,JFNTBL-2+4 + HRROI 2,LSTBF + MOVNI 3,1000*5 + SKIPL LOB+2 ;SKIP IF FIRST BUFFER NOT YET READY + SOUT + JRST LOUT3B +>;TNX + + +LOUTS: TLNE TAC,SCRF!CRFG ;need special handling? + XCT LOUTTB(TAC) ;THIS CHAR NEEDS WORRYING +IFE STANSW,< ;stanford AI printer will do anything +LOUTSX: CAIGE T,40 ;INSTR GETS CLOBBERED FOR CREF OUTPUT! + JUMPN TAC,CTLCON ;convert ctl chars for output +>;IFE STANSW + JUMPN TAC,LOUT2 ;JUST ORDINARY SPEC CHR? + JRST LOUT4 ;FLUSH NULLS + +IFE STANSW,< +CTLCON: ADDI T,100 ;convert character to alpha form + LSHC T,-7 ;put it back for next time + MOVEI T,"^" + MOVE TAC,CTAB(T) + JRST LOUT2 +>;IFE STANSW + YESL: SKIPN XPNDSW ;NOT EXPANDING NOW? + POPJ P, ;YES + TRNN MACUNF ;WAS A MACRO SEEN? + JRST LARND ;NO + PUSH P,N + PUSH P,NA + MOVE N,[POINT 7,MBLK] + MOVE NA,[POINT 7,TLBLK] +LOOP1: ILDB TAC,NA ;GET CHR FROM PRIMARY BUFFER + JUMPE TAC,LNUL ;NULL? + CAIN TAC,177 ;DELETE? + JRST LDEL ;YES + CAIN TAC,11 ;TAB? + JRST LSPA ;YES + CAIN TAC,15 ;CR? + JRST LCRE ;YES + MOVEI TAC,40 ;NONE OF THE ABOVE (USE SPACE) +LSPA: IDPB TAC,N ;DEPOSIT IN SECONDARY BUFFER + JRST LOOP1 +LDEL: IBP N + ILDB TAC,NA + JRST LSPA +LNUL: ILDB TAC,N ;GET OTHER CHR. + JUMPE TAC,LOOP1 ;BOTH NULL? + CAIN TAC,177 ;DELETE? + JRST LOOP1 ;YES + CAIN TAC,11 ;TAB? + JRST OTAB ;YES + CAIN TAC,15 ;CR? + JRST OCRE ;YES + CAIN TAC,40 ;SPACE? + JRST OTAB ;YES + MOVEI TAC,30 ;UNDERLINE + OTAB: DPB TAC,NA + JRST LOOP1 +LCRE: IDPB TAC,N +OCRE: DPB TAC,NA + MOVEI TAC, + IDPB TAC,N + MOVEI TAC,12 + IDPB TAC,NA +LARND: SKIPN CREFSW ;CREFING? + JRST NOCREF ;NO + MOVEI TAC,177 ;DEPOSIT... + IDPB TAC,CREFPT ;END... + MOVEI TAC,101 ;OF... + IDPB TAC,CREFPT ;CREF + PUSHJ P,CREFR ;DUMP THE INFO +NOCREF: TRNN MACUNF + JRST NOMAC + MOVN TAC,N + ADDI TAC,MBLK-2 + HRLI TAC,MBLK-1 + MOVSS TAC + PUSHJ P,LOUT + MOVN TAC,NA + SKIPA +NOMAC: MOVN TAC,LSTPNT ;FORM... + ADDI TAC,LBLK-1 ;COUNT + HRLI TAC,LBLK + TRZE BLOSW ;ANY BINARY + JRST BYES ;YES + ADDI TAC,5 ;REDUCE COUNT + PUSH P,[BYTE (7)11,11,11];TAB ACROSS + POP P,LBLK+5 + HRLI TAC,LBLK+5 ;SET ADDRESS +BYES: MOVSS TAC ;SET UP CONTROL WORD FOR... + PUSHJ P,LOUT ;LOUT + SETZM MBLK + MOVE TAC,[XWD MBLK,MBLK+1] + BLT TAC,LTEST-1;CLEAR BUFFERS + SETOM LTEST2 + MOVE TAC,[BYTE (7) 11] + MOVEM TAC,TLBLK+1 + HRRZ TAC,LSTPNT + TRNN MACUNF + JRST .+3 + POP P,NA + POP P,N + CAIL TAC,TLBLK + SKIPA TAC,[POINT 7,TLBLK+1,6] + SKIPA TAC,[POINT 7,MBLK+1,6] + TRZ MACUNF ;CLEAR FLAG + MOVEM TAC,LSTPNT ;RESET LSTPNT + SKIPE XL2SW ;START XLIST NOW? + JRST [SETZM XL2SW ;YES. + TRZ LDEV + JRST .+1] +;FALL OFF THE PAGE INTO ERSCN + ERSCN: SKIPN ERCNT ;ANY? + POPJ P, ;NONE +NOITS,< SKIPL ERCNT ;IS THIS REALLY PRINTX? + HLLOS 42 > ;NO. MARK THAT ERRORS HAVE HAPPENED + SKIPN LISTSW ;LIST DEVICE? + SKIPN TTYERR ;ERRORS ON TTY? + JRST ERS1 ;SOMEONE WANTS ERROR MEXXAGES + MOVE TAC,[XWD -ERPLEN,ERPD-1] + MOVEM TAC,ERPNT ;NO ONE WANTS THESE ERROR MESSAGES + SETZM ERCNT + POPJ P, + +ERS1: PUSH P,N ;SAVE + PUSH P,NA ;SAVE NA + PUSH P,T + PUSH P,FS + MOVE FS,LSTLAB+1 ;GET BLOCK NAME + PUSHJ P,AFROM6 ;CON TO ASCII + MOVEM T,LABPRT ;SAVE + MOVE N,FS ;SAVE LAST CHR + MOVE FS,LSTLAB ;GET LABEL NAME + PUSHJ P,AFROM6 ;CON TO ASCII + OR N,[BYTE(7)0,40,"&",40] + ROT T,7 + DPB T,[POINT 7,N,34] + MOVEM N,LABPRT+1 ;DEPOSIT SECOND WORD + ROT FS,7 + DPB FS,[POINT 7,T,34] + MOVEM T,LABPRT+2 ;DEPOSIT THIRD WORD + MOVE N,PCNT + SUB N,LSTLAB+4 ;GET DEVIATION + SETZM LABPRT+3 + JUMPE N,RCQ + MOVE T,[POINT 7,LABPRT+3] ;SET UP POINTER + MOVEI NA,"+" + IDPB NA,T ;DEPOSIT + + PUSHJ P,RCR ;CONVERT + MOVEI NA,0 ;NULL TO END IT + IDPB NA,T + RCQ: MOVEI N,LABPRT + SKIPL ERCNT ;SKIP IF PRINTX. + PUSHJ P,ERLST + POP P,FS + POP P,T + SKIPG ERCNT ;PRINTX? + JRST ELOPX ;YES. SKIP LOCATION STUFF + MOVE NA,ERPNT ;GET ERROR POINTER +ELOP: POP NA,N ;GET MESSAGE + PUSHJ P,ERLST ;LIST IT + SOSLE ERCNT ;ANY MORE? + JRST ELOP ;YES + MOVEM NA,ERPNT ;RESTORE +ELOPX: POP P,NA + POP P,N + SKIPE ERCNT ;IS THIS REALLY PRINTX? + JRST [SETZM ERCNT ;YES. + POPJ P,] ;SO WE DON'T STOP + SKIPN ERSTSW ;SHOULD WE STOP? + POPJ P, ; NO + +IFE EDITSW,< +TNX,< TSVAC <1> > +OUTSTR [ASCIZ /REPLY [CR] TO CONTINUE, [LF] TO CONTINUE AUTOMATICALLY +_/] +> +IFN EDITSW,< +OUTSTR [ASCIZ /REPLY 'E' - EDIT, [CR] - CONTINUE, [LF] - CONTINUE AUTOMATICALLY +_/] +> +NOTNX,< + CLRBFI ;CLEAR TYPEAHEAD + INCHRW TAC ;WAIT FOR ACTI + CLRBFI ;CLEAR TTY INPUT BUFFER +>;NOTNX +TNX,< + MOVEI 1,100 ;PRIMARY INPUT + CFIBF + PBIN + MOVE TAC,1 + MOVEI 1,100 + CFIBF + TRSTAC <1> +>;TNX + +IFN EDITSW < + CAIE TAC,"e" + CAIN TAC,"E" + JRST EDGO +> + CAIN TAC,12 ;TURN OFF ERSTSW? + SETZM ERSTSW ;YES + POPJ P, + +IFN EDITSW,< +EDGO: OUTSTR TTCRLF + MOVE 14,FNAM ;GET FILENAME + HLLZ 13,FNAM+1 ;GET EXTENSION + MOVE 11,SAVPPN ;GET PPN + MOVE 16,PGNM ;GET PAGE NUMBER + + SKIPN 15,TLBLK ;DOES IT HAVE LINE NUMBERS? + SKIPA 2,[SIXBIT /TECO/] ;NO, FIRST WE'LL ASSUME TECO +IFE TYMSW,< +IFE CMUSW,< SKIPA 2,[SIXBIT /SOS/] ;YES, USE SOS> +IFN CMUSW,< SKIPA 2,[SIXBIT /LINED/]>> ;CMU STILL CALLS IT LINED (SIGH) +IFN TYMSW,< SKIPA 2,[SIXBIT /EDIT10/]> ;(SIGH) + MOVE 15,INLINE ;NO LINE NUMBERS, GET COUNT INSTEAD +IFN STANSW,< SKIPE TVFILE + MOVSI 2,'E ' > + MOVEM 2,EDITOR + MOVE [1,,RUNBLK] + JSR DELRPG +IFN TYMSW, + RUN + HALT .-1 ;IN CASE IT LOSES + +RUNBLK: SIXBIT /SYS/ +EDITOR: BLOCK 5 >;IFN EDITSW + +LABPRT: BLOCK 6 +RCR: IDIVI N,10 + JUMPE N,.+4 + HRLM NA,(P) + PUSHJ P,RCR + HLRZ NA,(P) + ORI NA,60 + IDPB NA,T + POPJ P, + +^ERLST: SETZM SW1 +NOITS,< HLLOS 42> ;MARK THAT ERRORS HAVE HAPPENED + PUSH P,T + PUSH P,FS + PUSH P,O +ELOP2: HRROI TAC,(N) + SKIPE LISTSW ;LIST DEVICE? + PUSHJ P,LOUT ;YES + MOVEI O,5 + MOVE FS,(N) ;GET FIRST WORD +ELOP1: MOVEI T, + LSHC T,7 ;GET CHR. + JUMPE T,EDON ;DONE? + SKIPN TTYERR ;NO, TTY ERR LIST? + OUTCHR T + SOJG O,ELOP1 ;MORE THIS WORD? + AOJA N,ELOP2 ;NO, GET NEXT WORD +SW1: 0 + +EDON: SKIPE SW1 + JRST EDON1 + SETOM SW1 + MOVEI N,CRLF + JRST ELOP2 + +EDON1: POP P,O + POP P,FS + POP P,T + POPJ P, + ;CREF6, CREF7, CREF66 + +COMMENT $ +Here's what you didn't want to know about CREF: +CREF6 sends ASCII characters for a symbol's address in FAIL's core image. + CREF6 1, ;symbol reference + CREF6 1, followed by '002 in file ;symbol definition + CREF6 10, followed by CREF 0, ;combine symbol chains at BEND + CREF6 5, ;Macro reference, opdef reference + CREF6 6, ;Macro definition, opdef definition + +these give a symbol name to what was formerly known only by number + CREF66 11, ;flush symbol, litlabs, globals + CREF66 13, ;flush macro, opdefs + +These are for sending ascii of the symbol name. + CREF7 3, ;opcode reference + CREF7 5, ;macro pseudo-op (IFs,IOWD) ref + CREF7 15, ;BEGIN block name + CREF7 16, ;BEND block name +$ + + +^CREFPT:0 ;BYTE POINTER INTO CREFTB +^CREFTB:BYTE (7)177,102 ;ACCUMULATE CREF DATA + BLOCK 100 + +;CREF6 AC,ADDR +;EMITS TO CREF: '177 AC 6 +;IF AC=0 THEN: 6 + +^UCREF6:SKIPN LISTSW ;LISTING? + POPJ P, ;NO + LDB TAC,[POINT 4,40,12] ;NO SIZE CHECK IF 0 + JUMPE TAC,OENT ;AND NO IDPB CREFPT EITHER + HRRZ TAC,CREFPT ;GET THE POINTER ADRESS + CAIGE TAC,CREFTB+70 ;SEE IF WE ARE ALMOST AT THE END + JRST NOCDM ;PLENTY OF ROOM. GO ON. + MOVEI TAC,177 + IDPB TAC,CREFPT + MOVEI TAC,104 ;'177 D MEANS EAT DATA + IDPB TAC,CREFPT ;GIVE IT A JUST EAT OP + PUSHJ P,CREFR ;AND DUMP +NOCDM: LDB TAC,[POINT 4,40,12] ;GET TYPE + IDPB TAC,CREFPT ;DEPOSIT +OENT: HRRZ TAC,40 ;GET SIXBIT + PUSH P,L ;SAVE L + MOVEI L,6 ;INIT SIZE + IDPB L,CREFPT ;DEPOSIT SIZE + PUSH P,T ;SAVE T +CLOOP1: LDB T,[POINT 3,TAC,20] ;GET CHR. + ADDI T,"0" + IDPB T,CREFPT ;DEPOSIT CHR. + LSH TAC,3 ;SHIFT + SOJG L,CLOOP1 ;DONE? +CRFRT: POP P,T ;YES, RESTORE + POP P,L + POPJ P, + + + +;CREF7 AC,ADDR +;EMITS '177 AC N + +^UCREF7:SKIPN LISTSW + POPJ P, + HRRZ TAC,CREFPT ;GET THE POINTER ADRESS + CAIGE TAC,CREFTB+70 ;SEE IF WE ARE ALMOST AT THE END + JRST NOCDM7 ;NO, GO ON + MOVEI TAC,177 + IDPB TAC,CREFPT + MOVEI TAC,104 + IDPB TAC,CREFPT ;GIVE IT A JUST EAT OP (RUBOUT D) + PUSHJ P,CREFR ;AND DUMP +NOCDM7: LDB TAC,[POINT 4,40,12] + IDPB TAC,CREFPT + JRST UCRF67 + +;CREF66 AC,ADDR DOES BOTH CREF6 AC,ADDR AND CREF7 AC,ADDR + +^UCRF66:SKIPN LISTSW ;LISTING? + POPJ P, ;NO + PUSHJ P,UCREF6 +UCRF67: MOVE TAC,@40 ;NOW GET THE SIXBIT + PUSH P,L + MOVEI L,5 + TLNE TAC,770000 ;JUSTIFY + AOJA L,LADJ + LSH TAC,6 + SOJG L,.-3 + MOVEI L,1 +LADJ: IDPB L,CREFPT + PUSH P,T +CLOOP2: LDB T,[POINT 6,TAC,5] + ADDI T,40 + IDPB T,CREFPT + LSH TAC,6 + SOJG L,CLOOP2 + JRST CRFRT + +;FORCE CREF INFO TO LISTING. +CREFR: MOVEI TAC,0 ;PUT OUT THE CREF INFO + REPEAT 5, + PUSHJ P,LSTCHK + SKIPG LNCNT + PUSHJ P,LOUTH1 ;OUTPUT HEADING IF NEEDED (BEFORE CREF JUNK) + MOVN TAC,CREFPT ;- LAST ADDRESS + ADDI TAC,CREFTB ;+ FIRST ADDRESS = -WORD COUNT + HRLI TAC,CREFTB ;ADDRESS,,-WC + MOVS TAC,TAC ;-WC,,ADDRESS FOR LOUT + PUSH P,CHRCNT + PUSH P,LNCNT + HLLZM TAC,CHRCNT ;SET COUNTS TO PREVENT + HRRZM TAC,LNCNT ;OVERFLOW DETECTION + +IFE STANSW,< PUSH P,LOUTSX ;SAVE INSTRUCTION + PUSH P,[CAIA] + POP P,LOUTSX ;CLOBBER INSTR >;NOT SU AI + + PUSHJ P,LOUT ;PUT OUT CREF + +IFE STANSW,< POP P,LOUTSX ;RESTORE INSTR >;NOT SU Ai + + POP P,LNCNT ;RESTORE COUNTS + POP P,CHRCNT + MOVE TAC,[POINT 7,CREFTB,13] + MOVEM TAC,CREFPT ;REINITIALIZE BYTE POINTER FOR LATER DEPOSIT + POPJ P, + BEND + BEGIN ENDS  SUBTTL END, PRGEND, BEND, BEGIN + +;SUBROUTINE FOR MOST OF END, PRGEND + +PRDEC: IDIVI T,=10 + HRLM FS,(P) + SKIPE T + PUSHJ P,PRDEC + HLRZ T,(P) + ADDI T,"0" + ROT T,-7 + MOVEM T,LBLK + HRROI TAC,LBLK +MSGOUT: SKIPN RPGSW + OUTSTR (TAC) + TRNE LDEV + PUSHJ P,LOUT + POPJ P, + +DEFINE PRDCON(X) +< PUSHJ P,PRDEC + HRROI TAC,[ASCIZ/X/] + PUSHJ P,MSGOUT +> + +DEFINE TWODIG(X) +< CAIL T,=10 + JRST .+3 + HRROI TAC,[ASCIZ/0/] + PUSHJ P,MSGOUT + PRDCON () +> + +DEFINE THRDIG(X) +< CAIL T,=100 + JRST .+3 + HRROI TAC,[ASCIZ/0/] + PUSHJ P,MSGOUT + TWODIG () +> + +^GTCPTM: +TNX,< MOVEI 1,400000 + RUNTM + MOVEM 1,CPUTM +>;TNX +NOTNX,< +NOITS,< MOVEI 1,0 + RUNTIM + MOVEM 1,CPUTM +>;NOITS +>;NOTNX + POPJ P, + +CPUTM: BLOCK 2 + +DOEND: MOVE N,OPCNT+1 ;LOCATION COUNTER FLAGS + TLNE N,INCF ;ARE WE IN AN UNTERMINATED LITERAL? + JRST [SUB P,[1,,1] ;YES. FIX STACK AND MAKE A LOSE MESSAGE + JRST PSLIT] + PUSHJ P,VAR ;OUTPUT THE VARIABLES + PUSH P,0 ;SAVE FLAGS + TRZ LDEV ;STOP LISTING: I DON'T WANT TO SEE THESE. REG + PUSHJ P,LITOUT ;PUT OUT LITERALS + POP P,N ;RESTORE FLAG REGISTER + ANDI N,LDEV ;MASK OFF ALL BUT THIS + TDO 0,N ;RESTORE LISTING IF IT WAS ON BEFORE. + HRRZ N,BLOCK + CAIE N,1 ;AT OUTER LEVEL? + ERROR [ASCIZ/NOT ENOUGH "BEND" PSEUDO-OPS./] + TRO NOFXF + SETZM EN1+1 + SETZM EN1+2 + PUSHJ P,MEVAL ;GET ADDRESS + TLNE ESPF ;SPECIAL CHR? + JRST SPC ;YES + TLNE UNDF ;DEFINED? + ERROR [ASCIZ/UNDEFINED ADDRESS -- END/] + MOVEM N,EN1+2 ;DEPOSIT STARTING ADDRESS + ANDI NA,1 ;FORM RELOCATION + ROT NA,-2 ;RELOCATION + MOVEM NA,EN1+1 ;AND DEPOSIT + POUT 3,EN1 ;PUT OUT THE STARTING ADDRESS NOW + JRST EZERF +SPC: TLNN N,CRFG ;CR? + ERROR [ASCIZ/UNREC SPEC CHR -- END/] +EZERF: PUSHJ P,EBEND ;OUTPUT THIS BLOCK'S SYMBOLS. SPECIAL BEND FOR UNIV. + PUSHJ P,BFFRC ;FORCE OUT BINARY AND FIXUPS + MOVEI O,HASH-1 ;INIT COUNT +ELOOP2: SKIPN PN,SYMTAB(O) ;GET START OF CHAIN + JRST NONTE ;NONE +ELOOP1: SKIPE CREFSW + CREF66 11,(PN) + MOVE N,2(PN) ;GET FLAGS + TLNE N,EXTF ;EXTERNAL? + JRST EEXT ;YES + TLNE N,DEFFL ;DEFINED? + JRST EUND ;NO + TLNE N,INTF ;INTERNAL? + JRST EINT ;YES + ;REMAINDER ARE DOUBLE UP-ARROWED. +ELOOP3: ; ^^SYMS, INTERNALS, & EXTERNALS. + MOVE N,@US.S + EXCH N,1(PN) ;STORE FREE STG POINTER IN THIS NODE + MOVEM PN,@US.S ;STORE NODE ADDRESS IN FS POINTER + SKIPE PN,N ;SHUFFLE REGISTERS + JRST ELOOP1 ;THERE ARE MORE ON THIS CHAIN + JRST NONTE ;NONE LEFT. + +ECON: SKIPE PN,1(PN) ;GET NEXT + JRST ELOOP1 +NONTE: SOJGE O,ELOOP2 ;NO MORE, GET NEXT CHAIN + PUSHJ P,SBFRC ;FORCE OUT SYMBOLS + SKIPN SEG + JRST NBK ;NO UPPER SEGMENT + MOVE N,HICNT ;YES GET HIGH BREAK + MOVE NA,LOCNT ;GET LOW BREAK + MOVEM NA,WRD + MOVSI T,240000 ;BOTH RELOC + JRST ENDOUT + +NBK: MOVE N,LOCNT ;GET PROGRAM BREAK + MOVEM N,WRD + MOVE NA,ABSCNT ;AND ABS PROG BREAK + CAIG NA,140 + MOVEI NA, ;ONLY SET IF PAST 140 + MOVSI T,200000 ;ONLY FIRST IS RELOC +ENDOUT: MOVEM T,EN2+1 ;RELOCATION + MOVEM N,EN2+2 ;IF SEG THEN ELSE + MOVEM NA,EN2+3 ;IF SEG THEN ELSE + POUT 4,EN2 ;OUTPUT IT + MOVE N,EN1+2 + MOVE NA,EN1+1 + ROT NA,2 + MOVEM N,WRD + MOVEM NA,WRD+1 + PUSHJ P,LBLOUT ;LIST STARTING ADDRESS + PUSHJ P,SCNTIL ;GET TO LF AND FORCE LISTING + SETOM XPNDSW + PUSHJ P,LSTFRC ;FORCE LISTING + SKIPG EN2+2 ;LOW OR HIGH SET? + JRST ENDOT1 ;NO. + SKIPE SEG ;SEGMENT + SKIPA TAC,[-HIMLNG,,HIMES] ;YES. USE HIGH BREAK + MOVE TAC,[-PRMLNG,,PRMES] ;ELSE PROGRAM BREAK + PUSHJ P,MSGOUT + MOVS FS,EN2+2 ;GET THE BINARY ADDRESS + MOVE TAC,EN2+1 + ROT TAC,2 + ANDI TAC,3 + PUSHJ P,OCON + MOVEM T,LBLK + MOVEM FS,LBLK+1 + MOVE TAC,[-2,,LBLK] + PUSHJ P,MSGOUT + HRROI TAC,TTCRLF + PUSHJ P,MSGOUT + PUSHJ P,LSTFRC ;NOW REALLY FORCE LISTING +ENDOT1: SKIPG EN2+3 ;ABS OR LOW SET? + JRST ENDOT2 ;NO + SKIPE SEG ;SEGMENT + SKIPA TAC,[-LOMLNG,,LOMES] ;YES. LOW BREAK + MOVE TAC,[-ABMLNG,,ABMES] ;NO. ABS BREAK + PUSHJ P,MSGOUT + MOVS FS,EN2+3 ;GET THE BINARY + MOVE TAC,EN2+1 + ROT TAC,4 + ANDI TAC,3 + PUSHJ P,OCON + MOVEM T,LBLK + MOVEM FS,LBLK+1 + MOVE TAC,[-2,,LBLK] + PUSHJ P,MSGOUT + HRROI TAC,TTCRLF + PUSHJ P,MSGOUT + PUSHJ P,LSTFRC ;FORCE WHAT WE HAVE SO FAR +ENDOT2: PUSH P,CPUTM + PUSHJ P,GTCPTM ;GET CPU TIME + POP P,T ;GET OLD CPU TIME + SUB T,CPUTM ;LESS NEW CPU = -CPU ELAPSED TIME + MOVNM T,CPUTM+1 ;STORE CPU ELAPSED TIME + MOVE TAC,[-CPTMSL,,CPTMSG] + PUSHJ P,MSGOUT + MOVE T,CPUTM+1 + IDIVI T,=1000 ;MILLISECONDS INTO FS + PUSH P,FS + IDIVI T,=60 + PUSH P,FS ;SECONDS + IDIVI T,=60 + PUSH P,FS ;MINUTES. HOURS IN T + JUMPE T,NOHRS ;JUMP IF NO HOURS TO PRINT + PRDCON (<:>) ;PRINT HOURS: + MOVE T,(P) ;GET MINUTES + CAIL T,=10 ;NEED EXTRA DIGITS? + JRST NOHRS ;No. + HRROI TAC,[ASCIZ/0/] + PUSHJ P,MSGOUT +NOHRS: POP P,T + PRDCON (<:>) ;PRINT MINUTES: + POP P,T + TWODIG (<.>) ;SECONDS. + POP P,T + THRDIG (< >) ;MILLISECONDS + HRROI TAC,TTCRLF + PUSHJ P,MSGOUT + JRST LSTFRC + + +HIMES: ASCII /HIGH SEGMENT BREAK / +HIMLNG__.-HIMES + 0 +LOMES: ASCII /LOW SEGMENT BREAK / +LOMLNG__.-LOMES + 0 +PRMES: ASCII /PROGRAM BREAK / +PRMLNG__.-PRMES + 0 +ABMES: ASCII /ABSOLUTE BREAK / +ABMLNG__.-ABMES + 0 +CPTMSG: ASCII /ELAPSED CPU TIME / +CPTMSL==.-CPTMSG + 0 + ; END HANDLE INTERNALS, EXTERNALS, UNDEFINEDS +EINT: MOVE FS,(PN) ;GET SIXBIT + PUSHJ P,R5CON ;CON TO R5 + TLO FS,40000 ;MARK AS INTERNAL + MOVE N,2(PN) +ITS,< TLNE N,SUPBIT!ANONF >;ITS +NOITS,< TLNE N,SUPBIT >;NOITS DON'T PASS ON SUPPRESSED SYMS. + JRST ELOOP3 + TLNE N,DBLF + TLO FS,SNB ;THESE CAN BE HALF-KILLED, TOO + MOVEM FS,IOU+2 ;DEPOSIT + MOVE L,3(PN) ;GET VALUE + MOVEM L,IOU+3 ;DEPOSIT + MOVE L,4(PN) ;GET RELOC + DPB L,[POINT 1,IOU+1,3] ;DEPOSIT + POUT 4,IOU ;OUTPUT IT + JRST ELOOP3 ;EMIT TO UNIV. CONTINUE SCAN FOR SYMBOLS + +IOU: XWD 2,2 + BLOCK 3 + +EUND: MOVE FS,(PN) ;GET SIXBIT + PUSHJ P,AFROM6 ;CON TO ASCII + MOVEM T,EUOUT ;DEPOSIT + OR FS,[BYTE (7)0,11,"U","N","D"] + MOVEM FS,EUOUT+1 ;DEPOSIT + SKIPE FS,3(PN) ;GET FIXUP POINTER + SKIPA TAC,4(FS) ;GET RELOC + SKIPA TAC,[0] ;NO RELOC(NO FIXUP) + MOVE FS,3(FS) ;GET FIXUP VALUE + MOVSS FS + PUSHJ P,OCON ;CON TO OCTAL ASCII + MOVEM T,EUOUT+3 ;DEPOSIT + MOVEM FS,EUOUT+4 ;... + MOVEI N,EUOUT + PUSHJ P,ERLST ;LIST + JRST ECON + +EEXT: MOVEI N,1 ;IN CASE THIS IS BEING KEPT AS A UNIVERSAL, REG 9/75 + IORB N,2(PN) ;SET A BLOCK BIT SO SUBSEQUENT USERS WILL SEE IT. + MOVE FS,2(PN) ;GET FLAGS. + SKIPN 3(PN) ;IS THERE A FIXUP POINTER? + TLNN FS,SUPBIT ;NO. IS THIS SUPPRESSED? + JRST EEXT1 ;FIXUP POINTER, OR NOT SUPPRESSED + SKIPN 4(PN) ;SUPPRESSED AND NO FIXUPS. ANY POLISH FIXUPS? + JRST ELOOP3 ;NO REFERENCES AND THIS IS SUPRRESSED. OMIT SYMBOL. +EEXT1: MOVE FS,(PN) ;GET SIXBIT + PUSHJ P,R5CON ;CON TO R5 + TLO FS,600000 ;MARK AS EXT + MOVEM FS,IOU+2 ;DEPOSIT + SKIPN N,3(PN) ;GET FIXUP POINTER + JRST [SETZM IOU+1 ;ISSUE NULL REQUEST + SETZM IOU+3 ;TO ABS 0 + POUT 4,IOU + JRST ECONN] ;OUTPUT IT. SCAN MORE SYMBOLS +EXCON: SKIPE NA,(N) ;GET DEVIATION + JRST POLEX ;NOT 0. NEED TO USE POLISH + MOVE TAC,2(N) ;GET FLAGS + TRNE TAC,3 ;LEFT HALF OR FULL? + JRST POLEX ;YES - USE POLISH + MOVE TAC,3(N) ;GET VALUE + MOVEM TAC,IOU+3 ;DEPOSIT + MOVE TAC,4(N) ;RELOC + DPB TAC,[POINT 1,IOU+1,3] ;DEPOSIT + POUT 4,IOU ;OUTPUT + SKIPE N,1(N) ;IS THERE MORE? + JRST EXCON ;YES. DO IT. +ECONN: SKIPN N,4(PN) ;ANY POLFIXES? + JRST ECONN1 ;NO. +ECLOP: SOSG 1(N) ;LAST SYM? + JRST LAST ;YES + MOVSS N + SKIPE N,2(N) ;GET NEXT + JRST ECLOP ;MORE +ECONN1: SETZM 3(PN) ;IN CASE OF UNIVERSALS, FLUSH OLD FIXUPS. + SETZM 4(PN) + JRST ELOOP3 + + ; PROCESS EXTERNALS - CONTINUED + +LAST: MOVEI FS,5(N) ;SET UP POINTER + PUSH P,O + PUSHJ P,REDUC ;REDUCE POLISH + POP P,O + PUSHJ P,BFRC ;FORCE OUT BIN + MOVEI FS,5(N) ;SET UP POINTER + MOVS NA,N ;GET NEXT + MOVE NA,2(NA) + PUSHJ P,POLOUT ;PUT OUT POLISH + SKIPN N,NA ;ANY MORE? + JRST ECON ;NO + JRST ECLOP ;YES + +EXPOL: 11,,5 + 0 + 3,,2 + 0 + 1,,0 + 0 + 0 + +POLEX: MOVE NA,N + MOVE FS,(PN) ;GET SIXBIT + PUSHJ P,R5CON ;CON TO RADIX50 + TLO FS,40000 + MOVEM FS,EXPOL+3 ;DEPOSIT + MOVE FS,(NA) ;GET DEVIATION + HRLM FS,EXPOL+5 ;DEPOSIT + HLRM FS,EXPOL+4 ;... + MOVE FS,2(NA) ;GET FLAGS + ANDI FS,3 + SETCA FS, ;FORM STORE OP + HRRM FS,EXPOL+5 ;DEPOSIT + MOVE FS,3(NA) ;GET FIXUP LOC. + HRLM FS,EXPOL+6 ;DEPOSIT + MOVE FS,4(NA) ;GET RELOC + DPB FS,[POINT 1,EXPOL+1,8] ;DEP. + POUT 7,EXPOL ;OUTPUT IT + SKIPE N,1(NA) ;GET NEXT + JRST EXCON ;MORE + JRST ECONN ;NO MORE + ; END AND PRGEND +^%END: PUSHJ P,DOEND + +NOTNX,< +^FEND: CLOSE 1, +^FEND1: RELEAS 4, + RELEAS 2, + +NOITS,< MOVE N,RELFIL+4 ;DEVICE NAME WHERE REL FILE IS GOING + DEVCHR N, ;GET DEVICE CHARACTERISTICS WORD + TRNE BDEV ;SKIP IF THERE'S NO BINARY ANYWAY + TLNN N,200000 ;DVDSK? + JRST FEND2 ;NO BINARY, OR NOT DISK. AVOID RENAME. + CLOSE 3, ;DSKSER SCREWS FILE IF RENAME BEFORE CLOSE +IFE TYMSW,< +FEND0: DATE NA, ;GET DATE + TIMER N, ;GET TIME IN JIFFIES + DATE T, + CAME T,NA + JRST FEND0 ;AVOID BEING SCREWED AT MIDNIGHT! + IDIVI N,=3600 ;MINUTES IN N. + HRRM T,RELFIL+1 ;SET DATE + LDB NA,[POINT 3,T,23] ;GET HIGH PART OF DATE + DPB NA,[POINT 3,RELFIL+1,20] ;STUFF IT + DPB N,[POINT 11,T,23] ;STORE TIME + TLO T,600 ;SET MODE TO 14 +IFN STANSW,< TLO T,400000 ;SET DUMP NEVER > + MOVEM T,RELFIL+2 + SETZM RELFIL+3 + RENAME 3,RELFIL ;ADJUST DATE & TIME TO END OF ASSEMBLY + JFCL ; (LESS RPG LOSSAGE)> + +FEND2: >;NOITS + RELEAS 3, + JRST STRT1 +>;NOTNX + +TNX,< +^FEND: +^FEND1: JSR CLSSRC + TRNE LDEV + JSR CLSLST + TRNE BDEV + JSR CLSBIN + JRST STRT1 + +;ROUTINES TO CLOSE VARIOUS FILES. SOME CARE IS NEEDED, ESPECIALLY IF WE +; PMAPPED THE FILE IN THE FIRST PLACE. +^CLSSRC: 0 + TSVAC <1,2,3> + SKIPL 1,JFNTBL + JRST CLSSR1 ;IF NOT PMAPPABLE + SETO 1, + MOVE 2,[XWD 400000,SRCBFP] + SETZ 3, + PMAP ;OUT OF CORE + MOVE 1,JFNTBL +CLSSR1: HRRZS 1,1 + TLO 1,400000 ;DO NOT RELEASE JFN!!! (ERROR HANDLING...) + CLOSF + JFCL ;I HOPE WE DON'T LAND HERE + TRSTAC <1,2,3> + JRST @CLSSRC + +^CLSBIN: 0 + TSVAC <1,2,3> + SKIPG ODB+2 ;WAS ANYTHING EVER WRITTEN? + JRST CLSBI1 ;NO. JUST CLOSE THE FILE. + SKIPL 1,JFNTBL-2+3 ;GET JFN. SKIP IF PMAPABLE + JRST CLSBI3 ;NOT PMAPPABLE + SETO 1, ;REMOVE FILE PAGE FROM CORE. + MOVE 2,[XWD 400000,BINBFP] + SETZ 3, + PMAP ;OUT OF CORE + MOVE 3,ODB ;CURRENT PAGE NUMBER + AOJ 3, ;PLUS 1 = PAGE COUNT + LSH 3,=9 ;TOTAL NUMBER OF BYTES IF FULL + SUB 3,ODB+2 ;MINUS NUM REMAINING + AOJ 3, ;PLUS ONE BECAUSE COUNT IS OFF + SETO 2, ;SET ALL BITS IN FDB WORD + HRR 1,JFNTBL-2+3 ; + HRLI 1,12 ;FDBSIZ,,JFN + CHFDB ;SET EOF WORD +CLSBI1: HRRZ 1,JFNTBL-2+3 ;JFN + CLOSF ;CLOSE AND RELEASE JFN + JFCL ;NO ERRORS I HOPE + SETZM JFNTBL-2+3 + TRSTAC <1,2,3> + JRST @CLSBIN + +CLSBI3: MOVE 3,ODB+2 ;BYTE COUNTER (# REMAINING) + SUBI 3,1001 ;3=- + HRRZ 1,JFNTBL-2+3 + HRROI 2,BINBF + SOUT ;DUMP BUFFER + JRST CLSBI1 + +^CLSLST: 0 + TSVAC <1,2,3> + SKIPG LOB+2 ;ANYTHING EVER WRITTEN? + JRST CLSLS1 ;NO. NOTHING TO FORCE OUT + SKIPL 1,JFNTBL-2+4 ;GET JFN. SKIP IF PMAPPED + JRST CLSLS3 ;NOT PMAPPABLE + SETO 1, ;FORCE CURRENT PAGE FROM CORE + MOVE 2,[XWD 400000,LSTBFP] + SETZ 3, + PMAP ;OUT OF CORE + MOVE 3,LOB ;LAST PAGE NUMBER OF FILE + AOJ 3, ;PLUS 1 IS PAGE COUNT + IMULI 3,1000*5 ;TOTAL NUMBER OF BYTES IF FULL + SUB 3,LOB+2 ;MINUS NUM REMAINING + AOJ 3, ;ADD ONE SINCE COUNT IS OFF + SETO 2, ;SET ENTIRE WORD OF FILE SIZE + HRR 1,JFNTBL-2+4 + HRLI 1,12 ;FDBSIZ,,JFN + CHFDB ;SET EOF +CLSLS1: HRRZ 1,JFNTBL-2+4 + CLOSF + JFCL + SETZM JFNTBL-2+4 + TRSTAC <1,2,3> + JRST @CLSLST + +CLSLS3: MOVE 3,ODB+2 ;GET # OF BYTES REMAINING + SUBI 3,1000*5+1 ;3=- + HRRZ 1,JFNTBL-2+4 + HRROI 2,LSTBF + SOUT ;DUMP BUFFER + JRST CLSLS1 +>;TNX + +EUOUT: BLOCK 2 + ASCII /EF / + BLOCK 2 + +EN1: XWD 7,1 + 0 + 0 + +EN2: 5,,2 + 200000,, + 0 + 0 + +;PRGEND -- DOES END STUFF & RESTARTS PAST I/O INITIALIZATION +^%PRGEN:PUSHJ P,DOEND ;SIMULATE END + HRROI TAC,[BYTE (7)14] + TRNE LDEV + PUSHJ P,LOUT ;DO PAGE HEADING IF NECC + JRST STRT2 + ;ROUTINE TO PUT OUT SYMBOLS IN REASONABLE FASHION. +;CALL IS WITH: +; FS RADIX 50 FOR SYMBOL. +; NA VALUE +; L IF NON-ZERO, RELOCATED. + +BDOUT: XWD 2,22 + 0 ;RELOCATION INFORMATION + BLOCK 22 ;ROOM FOR MANY MANY SYMBOLS..... + +BNPT: ASCII / / + BLOCK 3 + ASCII / / + +SBOUT: + PUSH P,O ;NEED AN AC. + AOS BDOUT + AOS O,BDOUT + MOVEM FS,BDOUT(O) ;NAME. + MOVEM NA,BDOUT+1(O) ;VALUE + TRZ L,12 + TRZE L,4 ;CHANGE RELOCATION BITS. + TRO L,2 + IDPB L,BYTPT ;STORE SAME. + CAME O,[XWD 2,22] ;DONE? + JRST STSQM ;DONE THIS SOON. + PUSH P,SBRRT ;RETURN FROM SBFRC TO STSYM +SBFRC: PUSH P,TAC + PUSH P,BC + MOVEI BC,BDOUT + HRRZ TAC,BDOUT ;COUNT + TRNN TAC,-1 + JRST SBDON + MOVNS TAC ;- COUNT. + HRLI BC,-2(TAC) ;NEW COUNT. + PUSHJ P,GBOUT ;WRITE IT OUT. +SBDON: POP P,BC + POP P,TAC +SBRRT: POPJ P,STSYM ;(RETURN ADDRESS FOR FALL THRU CALL) +^SBINI: PUSH P,O ;HERE TO INITIALIZE SYMBOL TABLE OUTPUT +STSYM: HLLZS BDOUT ;RESTART COUNT. + MOVE O,[POINT 4,BDOUT+1] + MOVEM O,BYTPT ;RESTART BYTE POINTER. +STSQM: POP P,O + POPJ P, + +BYTPT: 0 + BEGIN BEND + +^EBEND: SKIPN UNIVSW ;CALLED FROM DOEND. SET UP FOR UNIVERSAL + JRST BEND ;NOTHING SPECIAL + SETZM U.OPC ;CLEAR POINTERS TO CHAINS OF SYMBOLS. + SETZM U.MAC + SETZM U.SYM + MOVEI O,U.MAC ;FOR UNIVERSALS, WE DON'T GIVE THINGS + MOVEM O,US.M ; AWAY TO FREE STORAGE, BUT WE MAKE OUR + MOVEI O,U.OPC ; OWN LISTS INSTEAD. + MOVEM O,US.O + MOVEI O,U.SYM + MOVEM O,US.S + MOVE O,[HLLM FS,1(N)] + MOVEM O,OLOPX# ;HACK TO FIXUP OPCODES + MOVSI O,() ;SET MLOPX INSTRUCTION FOR GIVING BACK MACROS. +NOTNX,< JRST BEND.1 > +TNX,< PUSHJ P,BEND.1 ;PERFORM USUAL FUNCTIONS OF BEND + MOVSI NA,-HASH ;CHASE THRU OPCODE TABLE AND EMIT JSYS'S +EBEND1: SKIPN N,OPCDS(NA) + JRST EBEND4 ;EMPTY CHAIN + PUSH P,NA +EBEND2: SKIPLE FS,1(N) ;SKIP IF PSEUDO-OP (OR SOME MACHINE OPS) + TLNN FS,20 ;NOT PSEUDO. SKIP IF OPDEF. + JRST EBEND3 + PUSH P,N + MOVE FS,(N) ;GET SYMBOL NAME + SKIPE CREFSW + CREF66 13,(N) ;EMIT TO CREF + PUSHJ P,R5CON + POP P,N + TLO FS,100000 + MOVE NA,3(N) ;GET VALUE + MOVE L,4(N) + PUSHJ P,SBOUT ;EMIT SYMBOL +EBEND3: HRRZ N,1(N) + JUMPN N,EBEND2 + POP P,NA +EBEND4: AOBJN NA,EBEND1 + POPJ P,> + + +^^BEND: MOVEI O,FSTPNT ;(SEE EBEND FOR WHAT HAPPENS TO UNIVERSALS) + MOVEM O,US.S ;ADDRESS OF "FREE STORAGE LIST" FOR SYMBOLS + MOVEM O,US.M ; FOR MACROS + MOVEM O,US.O ; FOR OPCODES + MOVSI O,() + MOVEM O,OLOPX + MOVE O,[PUSHJ P,MACRET] +BEND.1: MOVEM O,MLOPX# ;SET INSTRUCTION FOR RETURNING MACRO SPACE + MOVE NA,BLOCK + SUBI NA,1 ;FORM WORD WITH ALL... + MOVEM NA,OBLK ;HIGHER LEVEL BITS ON + MOVE NA,BLOCK + LSH NA,-1 ;FORM WORD WITH NEXT... + MOVEM NA,BLOCKN ;BIT ON + MOVE NA,BLOCK ;GET BLOCK... + FAD NA,[0] ;NUMBER + LDB NA,[POINT 8,NA,8] + MOVE FS,BNAM-347(NA) ;GET NEXT BLOCK NAME UP + CAILE NA,346 ;AVOID MISTAKE AT END + MOVEM FS,LSTLAB+3 ;DEP FOR ERROR PRINT + MOVE FS,BNAM-346(NA) ;GET BLOCK NAME + PUSHJ P,R5CON ;CON TO R5 + TLO FS,140000 + SUBI NA,345 + PUSH P,L + SETZM L ;NO RELOCATION. + PUSHJ P,SBOUT ;OUTPUT SYMBOL. + POP P,L + MOVE FS,BNAM-1(NA) ;GET NAME + MOVEM FS,NMBLK ;SAVE THE NAME + SKIPE CREFSW ;CREF? + CREF7 16,FS ;YES + PUSHJ P,AFROM6 ;CON TO ASCII + MOVEM T,BNPT+2 ;DEPOSIT + ORI FS,20000+22 + MOVEM FS,BNPT+3 + IDIVI NA,12 ;CONVERT LEVEL TO... + ORI PN,60 ;DECIMAL... + SKIPN NA ;... + SUBI NA,20 + ADDI NA,60 ;... + DPB PN,[POINT 7,BNPT+4,13] ;AND.. + DPB NA,[POINT 7,BNPT+4,6] ;DEPOSIT + MOVE NA,MTBPNT ;SET UP... + MOVEM NA,SPNT ;FOR PSYM + MOVEM NA,SSPNT ;... + SETZM SCOUNT ;... + SETOM MERCNT ;INIT MULT... + MOVEI NA,MERSTR ;DEF. LAB... + MOVEM NA,MERPNT ;MESSAGE AREA + ;HERE WE CHASE THRU THE SYMBOLS AND PASS THE LOCAL ONES TO THE LOADER + SKIPN XPUNGS ;ARE WE EXPUNGING SYMBOLS? + SKIPA O,[PUSHJ P,SBOUT] ;NO. REPAIR INSTRUCTIONS BELOW. + MOVSI O,() ;YES. NO-OP INSTRUCTIONS BELOW. + MOVEM O,IXPUNG# ;SET INSTR. TO BE XCT'D + + MOVEI NA,HASH ;INITIAL SYMTAB COUNTER +LOOP1: MOVEM NA,NASAV ;SAVE + MOVEI NA,SYMTAB-1(NA) ;GET FIRST OF CHAIN + SKIPN O,(NA) + JRST NONC ;NONE +LOOP2: MOVE N,2(O) ;GET FLAGS + TDNN N,BLOCK ;THIS BLOCK? + JRST NOTHS ;NO. SKIP TO THE NEXT SYMBOL + TLNE N,UDSF ;IS THIS A DEFINED-UNDEFINED? + JRST LITLAB ;YES, SPECIAL CODE FOR ALL OF IT + TLNE N,DEFFL ;DEFINED? + JRST NODEF ;NO + TLNE N,DAF!GLOBF ;IS IT GLOBAL OR DOWN ARROW? + JRST DGLOB ;YES +CONT: SKIPE SYMOUT ;SYMBOL TABLE LISTING? + JRST [TLNN N,SUPBIT ;YES. BUT IS THIS SUPPRESSED? + PUSHJ P,PSYM ;NOT SUPPRESSED. LIST THIS. + JRST .+1] + TLNE N,INTF ;INTERNAL? + JRST UPAR1 ;YES. DEFER EMISSION 'TIL LATER + TLNE N,UPARF ;UPARROW? + SKIPN BLOCKN ;AND NOT AT OUTER LEVEL + SKIPA + JRST UPAR1 ;THEN DO NOT PUT OUT DEF + MOVE FS,(O) ;GET SIXBIT + SKIPE CREFSW + CREF66 11,(O) + PUSHJ P,R5CON ;CON TO R5 + TLO FS,100000 ;BITS + MOVE N,2(O) ;GET FLAGS + TLNE N,DBLF ;__? + TLO FS,SNB ;YES -SET BIT TO SUPPRESS THE SYMBOL + PUSH P,NA + MOVE NA,3(O) ;GET VALUE + MOVE L,4(O) ;GET RELOC +ITS,< TLNE N,ANONF ;DON'T PUT IT OUT IF ANONYMOUS + JRST CONT1> + TLNN N,SUPBIT ;SKIP IF WE SHOULD SUPPRESS THIS SYMBOL. + XCT IXPUNG ;PUSHJ P,SBOUT, OR JFCL IF XPUNGS IS SET! +CONT1: POP P,NA + TLNE N,UPARF ;EMIT THIS LATER (WHY??) + JRST UPAR1 ;(SEE ELOOP3) +DEL: MOVE T,@US.S ;GET FREE STRG PNTR. (FSTPNT, UNLESS UNIVERSALS) + EXCH T,1(O) ;PUT THIS BACK ON FREE STRG. + MOVEM O,@US.S ;... +DEL2: MOVEM T,(NA) ;& REMOVE FROM CHAIN + SKIPE O,T ;ANY MORE? + JRST LOOP2 ;YES +NONC: SOSLE NA,NASAV ;GET NEXT SYMTAB CHAIN + JRST LOOP1 + +;HERE WE CHASE THRU THE OPCODE TABLE AND EMIT USER'S OPDEFS TO THE LOADER. +LDON: PUSH P,B + PUSH P,C + MOVEI NA,HASH ;PREPARE TO CUT BACK OPDEFS. + MOVE T,BLOCK ;TEST WORD + MOVSI FS,20 ;@ BIT - SIGNIFIES OPDEF +OLOP1: SKIPN N,OPCDS-1(NA) ;GET FIRST CHAIN + JRST NONT ;NONE +OLOP: TDNE FS,1(N) ;ORDINARY OP? + SKIPGE 1(N) ;NO. MAYBE A PSEUDO-OP? + JRST ENDF ;YES. STOP HERE. (MACHINE OPS AND CALLI'S LEFT) + TDNN T,2(N) ;THIS BLOCK? + JRST ENDF ;NO, QUIT (GET THIS LATER) + PUSH P,N ;SAVE POINTER + MOVE FS,(N) ;GET OPDEF NAME + SKIPE CREFSW + CREF66 13,(N) + PUSHJ P,R5CON ;TO RADIX50 FOR DDT + POP P,N + TLO FS,100000 ;SET AS LOCAL + PUSH P,NA ;SAVE IT. + PUSH P,L + MOVE NA,3(N) ;GET VALUE + MOVE L,2(N) ;GET FLAGS + +NOITS,< TLNE L,SUPBIT ;SUPPRESSED? >;NOITS +ITS,< TLNE L,ANONF!SUPBIT ;SUPPRESSED OR ANONYMOUS? >;ITS + JRST OLOP2 ;YES. DON'T EMIT TO LOADER + + MOVE L,4(N) ;GET VALUE + XCT IXPUNG ;PUSHJ P,SBOUT, OR IF XPUNGES IS SET, JFCL +OLOP2: POP P,L + POP P,NA +OLOP3: MOVSI FS,20 ;REPAIR FS. + MOVE O,@US.O ;ADD THIS OPCODE TO FREE STORAGE, OR TO UNIVERSALS + EXCH O,1(N) + MOVEM N,@US.O ;PUT BACK IN FREE STRG + XCT OLOPX ;JFCL, OR HLLM FS,1(N), IF UNIVERSAL + HRRZ N,O ;GET NEXT + JUMPN N,OLOP ;ANY MORE? +ENDF: MOVEM N,OPCDS-1(NA) +NONT: SOJG NA,OLOP1 ;CONTINUE WITH NEXT CHAIN + SETZM XPUNGS ;NO LONGER EXPUNGING + PUSHJ P,SBFRC ;FORCE THE SYMBOLS OUT NOW + PUSHJ P,SBINI ;REINITIALIZE SYMBOL OUTPUT + +;AND HERE WE CHASE THRU THE MACROS, EMITTING THEIR NAMES TO CREF, RECLAIMING SPACE + MOVEI NA,HASH ;PREPARE TO CUT BACK MACROS +MLOP1: SKIPN N,MACRT-1(NA) ;GET BASE OF CHAIN + JRST MLOP4 ;CHAIN IS EMPTY +MLOP2: TDNN T,2(N) ;MACRO BELONGS TO THIS BLOCK? + JRST MLOP3 ;NO. NOTHING LEFT TO DO ON THIS CHAIN + SKIPE CREFSW + CREF66 13,(N) + MOVE C,4(N) ;GET START + HLRZ B,(C) ;GET LENGTH + ADD B,C ;GET END + XCT MLOPX ;GIVE BACK MACRO SPACE. (PUSHJ P,MACRET, OR JFCL) + MOVE O,@US.M ;PUT BACK ON FREE STRG. (OR GIVE TO UNIVERSAL) + EXCH O,1(N) ;STOR FS ADDRESS IN THIS BLOCK. ADDRESS OF NEXT IN O + MOVEM N,@US.M ;STORE ADDRESS OF THIS BLOCK IN FS HEADER + SKIPE N,O ;LINK TO NEXT. + JRST MLOP2 ;LOOP IF THERE'S MORE TO DO. +MLOP3: MOVEM N,MACRT-1(NA) ;STORE NEW LINK TO MACRO LIST +MLOP4: SOJG NA,MLOP1 ;GET NEXT CHAIN + + MOVE N,BLOCK ;FORM NEXT-OUTER BLOCK BITS + LSH N,-1 ;BLOCK... + MOVEM N,BLOCK + MOVN N,N ;TWOS COMPLEMENT TO FORM DBLCK + HRLI N,DAF + MOVEM N,DBLCK ;DBLCK + SKIPE SYMOUT ;SYMBOL LISTING? + PUSHJ P,PSYMGO ;YES + TRAN BNPT ;LIST BLOCK NAME + POP P,C + POP P,B + POPJ P, + ;HERE FOR INTERNALS, OR UP-ARROWED SYMS. MOVE SYMBOL OUT ONE BLOCK +UPAR1: MOVE L,(O) ;GET SIXBIT OF CURRENT SYMBOL + SKIPN PN,1(O) ;ANY MORE? + JRST UPAR + MOVE T,O +UPAR1A: CAMN L,(PN) ;LOOK FOR ANOTHER SYMBOL WITH THE SAME NAME AS THIS. + JRST UNFD ;HERE WE HAVE ANOTHER ONE WITH THE SAME NAME. + MOVE T,PN + SKIPN PN,1(PN) + JRST UPAR + JRST UPAR1A ;PN POINTS TO SYMBOL. T= ADDR OF CELL THAT POINTS AT PN + +UNFD: MOVEM T,SVLNK ;SAVE LINK (THIS IS NEEDED TO DELINK SYMBOL. + MOVE T,2(PN) ;GET FLAGS + TDNN T,BLOCKN ;NEXT BLOCK? + JRST UPAR ;NO. WE JUST GO MOVE THIS OUT ONE BLOCK + TLNN T,UDSF ;OR IF DEFINED-UNDEFINE + TLZN T,DEFFL ;DEFINED? + JRST MERR ;YES + TLNE N,DBLUPF + TRZA N,-1 ;DON'T CLEAR ^ FLAG IF ^^ + TDZ N,[XWD UPARF,-1] + OR T,N ;TRANSFER BITS + TLZE T,EXTF ;IF OUTER BLOCK SYMBOL WAS EXTERNAL, + TLO T,INTF ; IT BECOMES INTERNAL + TLNE T,UDSF + JRST [MOVEM T,2(O) + MOVE T,SVLNK ;ELIM UPPER BLOCK + MOVE N,FSTPNT ;GET SECOND BLOCK ONTO FREE STORAGE + EXCH N,1(PN) + MOVEM N,1(T) + MOVEM PN,FSTPNT + EXCH PN,O ;EXCHANGE SO FIXUP COMBINE DONE RIGHT + JRST UPNOD1] ;AND AWAY WE GO + MOVEM T,2(PN) ;DEPOSIT + EXCH PN,O + SKIPE N,3(O) ;FIXUPS? + PUSHJ P,GFIX ;YES + SKIPE N,4(O) ;POL-FIXES? + PUSHJ P,PFIX ;YES + EXCH PN,O + SKIPN CREFSW + JRST .+3 + CREF6 10,(O) ;COMBINE TWO CHAINS + CREF6 0,(PN) + HRLI N,3(O) ;DEFINE.. + HRRI N,3(PN) ;IT ... + BLT N,4(PN) ;ABOVE + JRST DEL ;AND DELETE IT BELOW + MERER: ASCII /MULTIPLY DEFINED BY ^ +/ ;PRECISELY A MULTIPLE OF 5 CHARS. +MERSTR: BLOCK 57 +MEREND: BLOCK 4 +MERCNT: 0 +MERPNT: 0 + +MERR: AOSN MERCNT ;ANY YET? + ERROR MERER ;NO, THIS IS FIRST + MOVE FS,MERPNT + CAIL FS,MEREND ;IS TABLE TOO FULL? + JRST MERR1 ;YES, ADD ENDING MESSAGE. + MOVE FS,(PN) ;NO, GET SIXBIT + PUSHJ P,AFROM6 ;CON TO ASCII + MOVEM T,@MERPNT ;DEPOSIT + AOS MERPNT ;INCREMENT + OR FS,[BYTE(7)0,40,40,15,12] + MOVEM FS,@MERPNT ;DEPOSIT + AOS MERPNT ;INCREMENT + SETZM @MERPNT ;MAKE SURE IT GETS STOPPED. + JRST DEL + +MERR1: MOVE T,[ASCII/MORE /] + MOVEM T,(FS) + MOVE T,CRLF + MOVEM T,1(FS) + JRST DEL + +UPAR: HRRES N ;GET BLOCK BIT + LSH N,-1 ;SHIFT + HLL N,2(O) ;GET FLAGS + TLNN N,DBLUPF ;NOT IF DOUBLE UP ARROW. + TLZ N,UPARF ;CLEAR UPARROW BIT + MOVEM N,2(O) ;REDEPOSIT +NOTHS: MOVEI NA,1(O) ;PASS THIS ONE... + SKIPE O,1(O) ;AND LEAVE... + JRST LOOP2 ;ALONE + JRST NONC ;NO MORE THIS CHAIN + +DGLOB: TDNN N,OBLK ;ANY OTHER BLOCK BITS ON? + JRST CONT ;NO +GLB1: TLNN N,DAF ;DOWN-ARROW? + TDZ N,BLOCK ;NO, GLOBAL, TURN OFF THIS BIT + MOVEM N,2(O) ;DEPOSIT + JRST NOTHS + + ;HERE WE'RE LEAVING A BLOCK, AND AN UDEFINED SYMBOL HAS BEEN REFERENCED +NODEF: MOVE L,(O) ;GET SIXBIT + SKIPN PN,1(O) ;ANY MORE? + JRST UPAR ;NO. THERE IS NO OTHER DEFINITION OF THIS SYMBOL + SRC1 (L,PN,NFND,JRST UPAR) +NFND: MOVE T,2(PN) ;GET FLAGS + TDNN T,BLOCKN ;NEXT BLOCK UP? + JRST UPAR ;NO. WE MOVE THIS SYMBOL ONE BLOCK OUT + TLNE T,DEFFL ;DEFINED? + JRST UPNOD ;NO. MOVE IT OUT, MERGING WITH OTHER FIXUPS + TLNE T,UDSF ;UNDEFINED - DEFINED SYMBOL + JRST MERR ;YES (I DON'T UNDERSTAND HOW THIS CAN HAPPEN - REG) + SKIPN CREFSW ;SYMBOL HAS BEEN DEFINED IN OUTER BLOCK. + JRST .+3 + CREF6 10,(O) + CREF6 0,(PN) + SKIPE N,3(O) ;ANY FIXUPS? + PUSHJ P,GFIX ;YES, PUT OUT + SKIPE N,4(O) ;ANY POLFIXES? + PUSHJ P,PFIX ;YES, DO + JRST DEL ;NOW, FLUSH THE SYMBOL DEFINITION + +;HERE THE SYMBOL IS UNDEFINED IN THE NEXT-OUTER BLOCK. MERGE FIXUPS +UPNOD: MOVE L,2(O) ;GET FLAGS + AND L,[XWD EXTF!INTF!VARF!UDSF,0] + ORM L,2(PN) ;DEPOSIT CERTAIN FLAGS +UPNOD1: SKIPN CREFSW ;MERGE O-SYMBOL FROM INNER WITH PN-SYMBOL FROM OUTER + JRST .+3 + CREF6 10,(O) + CREF6 0,(PN) + SKIPN L,3(O) ;ANY FIXUPS + JRST AHD ;NO. DO POLISH FIXUPS + MOVE T,3(PN) ;SAVE FIXUPS FROM OUTER BLOCK SYMBOLS + MOVEM L,3(PN) ;STORE INNER BLOCK FIXUPS IN OUTER BLOCK SYMBOL +ALOP: SKIPN FS,1(L) ;FIND THE END OF THE INNER BLOCK FIXUPS. + JRST EFND ;GOT IT 1(L) IS THE END OF THE INNER FIXUP LIST + MOVE L,FS ;LINK ON + JRST ALOP + +EFND: MOVEM T,1(L) ;APPEND OUTER BLOCK FIXUP LIST TO THE END OF FIXLIST +AHD: SKIPN L,4(O) ;REPEAT THE ABOVE FOR POLFIXES + JRST PFND1 + MOVE T,4(PN) + MOVEM L,4(PN) + MOVSS L +PLOP: MOVEM PN,(L) ;EXCEPT LINK IS THE LEFT HALF OF THIRD WORD + SKIPN FS,2(L) ;AND WE STORE THE NEW SYMBLOCK (PN) IN EACH POLFIX + JRST PFND + MOVS L,FS + JRST PLOP + +PFND: MOVEM T,2(L) ;OTHER +PFND1: MOVE T,2(PN) ;MORE FLAGS + CAME O,FSTPNT ;THIS WILL BE TRUE ONLY IF WE CAME FROM ^UDSF (UNFD) + JRST DEL + EXCH PN,O + JRST NOTHS ;SKIP DELETING THIS + +OBLK: 0 +NASAV: 0 +BLOCKN: 0 +NMBLK: 0 +SVLNK: 0 + LITLAB: TLNE N,DAF!GLOBF ;BOY ARE THESE A PAIN + JRST LITGLB + SKIPE SYMOUT + PUSHJ P,PSYM + TLNE N,INTF!UPARF ;BUT THESE ARE WORSE + JRST UPAR1 ;BECAUSE OF THE PAIN THEY CAUSE HERE +LITCNT: MOVE FS,(O) ;GET SIXBIT + SKIPE CREFSW + CREF66 11,(O) + PUSHJ P,R5CON + TLO FS,100000 ;SET TO LOCAL + MOVSI N,SYMFIX ;SAY WE NEED SYMBOL TABLE FIXUP + IORB N,2(O) ;GET FLAGS + TLNE N,DBLF + TLO FS,SNB ;SET DELETE FLAG (HALF KILLED) + PUSH P,L + PUSH P,NA + SETZB L,NA + PUSHJ P,SBOUT + POP P,NA + POP P,L + MOVE T,NMBLK + EXCH T,1(O) ;PUT BLOCK NAME IN + JRST DEL2 ;GO FINISH THE DELETE + +LITGLB: TDNN N,OBLK + JRST LITCNT + JRST GLB1 + ;SYMBOL TABLE LISTING. PSYM, PSYMGO + +SNBN__377777 + +;ENTER HERE TO INCLUDE ONE SYMBOL IN SYMBOL TABLE LISTING. POINTER TO SYM IN O +PSYM: TRNN LDEV ;LIST DEV? + POPJ P, ;NO + HRRZ T,SPNT ;DESTINATION FOR BLT + HRLI T,2(O) ;SOURCE FOR BLT + MOVEI L,3 ;INCREMENT SPNT FOR NEXT SYMBOL + ADDB L,SPNT +LEG SETZM -1(L) ;ADDRESS CHECK THE BLT AND EXPAND CORE IF NEEDED + BLT T,-1(L) ;SAVE VALUES + SKIPA T,(O) ;GET SIXBIT + LSH T,6 + TLNN T,770000 ;LEFT ADJUST SIXBIT + JRST .-2 + TLC T,SNB ;INVERT SIGN FOR COMPARE + MOVEM T,-3(L) ;DEPOSIT + AOS SCOUNT ;COUNT ONE MORE SYMBOL SEEN + POPJ P, + +;HERE TO SORT THE SYMBOLS AND OUTPUT THEM. (ANOTHER LOSING N-SQUARED SORT) +PSYMGO: SKIPN SCOUNT ;ANY SYMBOLS TO LIST? + POPJ P, ;NO + PUSHJ P,LSTCHK + MOVEI TAC,CRLF + PUSHJ P,LOUT +SLOOP2: HRLOI FS,SNBN ;INIT - LARGEST POSSIBLE NUMBER + MOVE NA,SCOUNT ;GET COUNT + MOVE PN,SSPNT ;GET START OF SYMBOLS +SLOOP1: CAMG FS,(PN) ;COMPARE + JRST SPT1 ;NEW ONE LARGER + MOVE N,PN ;SAVE POINTER + MOVE FS,(PN) ;GET NEW SIXBIT +SPT1: ADDI PN,3 ;GO TO NEXT + SOJG NA,SLOOP1 ;LOOP + CAMN FS,[SNBN,,-1] ;DONE? + JRST [MOVEI TAC,CRLF ;YES. RETURN + JRST LOUT] + HRLOI NA,SNBN ;REMOVE... + MOVEM NA,(N) ;THIS ONE + TLC FS,SNB ;REINVERT SIGN + PUSHJ P,AFROM6 ;CON TO ASCII + MOVEM T,SOUTX ;DEPOSIT + TLO FS,220 ;PUT IN TAB + MOVEM FS,SOUTX+1 ;DEPOSIT + MOVS FS,1(N) ;GET VALUE... + MOVE TAC,2(N) ;& RELOC + SETZM SOUTX+2 + MOVEI T,22 ;ANOTHER TAB + MOVEM T,SOUTX+3 + TRNN FS,-1 ;LEFT HALF =0? + JRST SPT2 ;YES + MOVSS FS ;GET LEFT HALF + LSH TAC,-2 ;& RELOC + PUSHJ P,OCON ;CON TO OCTAL ASCII + MOVEM T,SOUTX+2 ;DEPOSIT + MOVEM FS,SOUTX+3 ;... + MOVS FS,1(N) ;GET RIGHT HALF + MOVE TAC,2(N) ;& RELOC +SPT2: PUSHJ P,OCON ;CONVERT + MOVEM T,SOUTX+4 ;DEPOSIT + MOVEM FS,SOUTX+5 ;... + MOVE TAC,[XWD -7,SOUTX] + PUSHJ P,LOUT ;OUTPUT IT + JRST SLOOP2 + +SOUTX: BLOCK 6 + BYTE (7)15,12 + +;AFROM6: CONVERTS 6-BIT TO ASCII. CALL WITH 6-BIT IN FS. +; RETURNS ASCII IN T & FS. + +^^AFROM6: + MOVEI T,0 +ALE1: LSHC T,6 ;GET CHR. + TRCE T,40 ;CON TO ASCII + TRO T,100 ;... + LSH T,1 ;LEAVE ROOM + TLNN T,700000 ;5 CHRS? + JRST ALE1 ;NO + LSH FS,-1 ;ADJUST FINAL CHR. + TLCE FS,200000 ;CON TO ... + TLO FS,SNB ;ASCII + POPJ P, + +SCOUNT: 0 +SPNT: 0 +SSPNT: 0 + BEND BEND + BEND ENDS + ; BEGIN AND BEND +%BEG: MOVE N,BLOCK ;GET BLOCK... + TRNE N,600000 ;LEGAL BEGIN? + ERROR[ASCIZ/BLOCKS NESTED TOO DEEP/] + LSH N,1 ;SHIFT + MOVEM N,BLOCK ;RESTORE + MOVNS N ;FORM DBLK (MASK FOR ALL LOWER BLOCKS) + HRLI N,DAF ;... + MOVEM N,DBLCK ;... + AOS %BCUR ;INCREMENT COUNT OF BEGINS + PUSHJ P,SCAN ;GET NAME, IF ANY + TLNE IFLG ;IDENT? + JRST %BPT ;YES + MOVE L,['A.000'];GET BASIC + MOVE FS,%BCUR ;GET CURRENT NUM + DPB FS,[POINT 3,L,35] + LSH FS,-3 + DPB FS,[POINT 3,L,29] + LSH FS,-3 + DPB FS,[POINT 3,L,23] +%BPT: MOVEM L,LSTLAB+3 ;DEPOSIT FOR ERROR MESSAGE PRINTER + MOVE T,BLOCK + FAD T,[0] + LDB T,[POINT 8,T,8];GET NUM + MOVEM L,BNAM-346(T);DEPOSIT NAME + SKIPE CREFSW ;CREF? + CREF7 15,L ;YES + MOVE FS,L ;GET NAME + MOVE NA,T + PUSHJ P,AFROM6 ;CON TO ASCII + MOVEM T,%BQ+2 ;DEPOSIT + ORI FS,20022 ;... + MOVEM FS,%BQ+3 ;... + SUBI NA,345 ;GET LEVEL NUMBER + IDIVI NA,12 ;CON TO... + SKIPN NA ;DECIMAL... + SUBI NA,20 ;... + ADDI NA,60 ;... + ADDI PN,60 ;... + DPB NA,[POINT 7,%BQ+4,6] + DPB PN,[POINT 7,%BQ+4,13] + TRAN %BQ ;LIST BLOCK NAME & LEVEL + JRST NSPCFN + +%BCUR: 0 +%BQ: ASCII / / + BLOCK 3 + ASCII / / + +%BEND: MOVE T,BLOCK + SOJLE T,BERR ;BARF IF ALREADY OUTER BLOCK + PUSHJ P,SCAN ;GET OPTIONAL BLOCK NAME + TLNN IFLG + JRST BENDNA + MOVE T,BLOCK + FSC T,32 + ROT T,9 + CAME L,BNAM(T) + ERROR [ASCIZ /BLOCK NAME MISMATCH/] +BENDNA: PUSH P,N + PUSHJ P,BEND + POP P,N + JRST NSPCFN + +BERR: ERROR [ASCIZ /TOO MANY BENDS/] + JRST NSPCFN + BEGIN LITOUT  SUBTTL LITOUT OUTPUT LITERALS, VARIABLES + +^LITOUT: + MOVSI O,-HASH +LITLP0: SKIPN NA,LITPNT(O) ;ANYTHING TO DO HERE? + JRST LITLP1 ;NO. + PUSH P,O ;SAVE INDEX TO LITPNT +IFE DWPSW,< PUSHJ P,LITSRT > ;SORT LITERALS. IDENTICAL ONES ARE MERGED +LOP2: MOVE O,1(NA) ;GET NEXT LITERAL + HLRZ L,2(NA) ;ANY LABELS? + JUMPE L,NOLBS ;NO + PUSH P,O + PUSH P,NA + MOVE O,L +PT1: MOVE PN,4(O) ;GET POINTER TO SYMBOL TABLE ENTRY + MOVE N,PCNT ;GET VALUE + MOVE NA,PCNT+1 + ADD N,3(O) ;ADD COUNT + PUSHJ P,LVDEF ;DEFINE IT + MOVE N,FSTPNT + SKIPE (O) ;CHECK FOR $. KLUDGE + JRST LLOK ;NOPE + MOVEM N,1(PN) ;RETURN "SYM" TO FS + MOVEI N,(PN) +LLOK: EXCH N,1(O) ;NOW RET LITLAB BLK + MOVEM O,FSTPNT + SKIPE O,N + JRST PT1 + POP P,NA ;RESTORE + POP P,O +NOLBS: MOVEI PN,PCNT-3 ;SET UP "VALUE" POINTER FOR GFIX + SKIPE N,3(NA) ;GET FIXUP POINTER + PUSHJ P,GFIX ;PUT OUT FIXUPS + SKIPE N,4(NA) + PUSHJ P,PFIX + MOVE N,FSTPNT ;GET FREE STRG + MOVEM N,1(NA) ;PUT THIS BACK ON FREE STRG + MOVEM NA,FSTPNT ;... + HRRZ L,2(NA) ;GET VALUES +LOP1: SKIPN 4(L) ;ANYTHING HERE? + JRST LPT3 ;NO + HRLI PN,3(L) ;GET POINTER TO VALUE + HRRI PN,WRD + BLT PN,WRD+1 ;PUT IN WRD + PUSHJ P,BLOUT ;LIST VALUE + OUTP 3(L) ;OUTPUT VALUE + SKIPN N,(L) ;REVERSE FIXUP? + JRST LPT1 ;NO + JUMPGE N,.+3 ;POLISH FIXUP? + PUSHJ P,POLHAN ;YES, HANDLE + JRST LPT1 + HRRI TAC,3(N) + HRLI TAC,OPCNT + BLT TAC,4(N) ;SET FIXUP WHICH POINTS HERE + ; TO POINT TO CORE +LPT1: SKIPN N,2(L) ;REVERSE FIXUP, LEFT HALF? + JRST LPT2 ;NO + JUMPGE N,.+3 + PUSHJ P,POLHAN + JRST LPT2 + HRRI TAC,3(N) + HRLI TAC,OPCNT + BLT TAC,4(N) ;SET THIS ONE +LPT2: AOS OPCNT ;INCREMENT + MOVE N,OPCNT + CAMGE N,BRK + JRST .+5 + CAMGE N,HICNT + JRST .+5 + MOVEM N,HICNT + JRST .+3 + CAML N,@CURBRK + MOVEM N,@CURBRK + AOS PCNT ;... +LPT3: MOVE N,FSTPNT + EXCH N,1(L) ;PUT THIS BACK... + MOVEM L,FSTPNT ;IN FREE STRG. + SKIPE L,N ;ANY MORE + JRST LOP1 ;YES + SKIPE NA,O ;GET NEXT LITERAL, MORE? + JRST LOP2 ;THERE ARE MORE + POP P,O ;RESTORE INDEX TO LITPNT + SETZM LITPNT(O) ;CLEAR CHAIN +LITLP1: AOBJN O,LITLP0 + POPJ P, + +POLHAN: MOVE TAC,OPCNT ;GET PLACE WHERE THIS IS... + MOVEM TAC,2(N) ;GOING & MAKE POLFIX... + MOVE TAC,OPCNT+1 ;POINT THERE + MOVEM TAC,3(N) + SKIPLE 1(N) ;NO UNDEF SYMS LEFT? + POPJ P, ;SOME LEFT + MOVEI FS,5(N) ;SET UP POINTER + PUSH P,O ;SAVE + PUSH P,L + PUSHJ P,REDUC ;REDUCE THE POLISH + PUSHJ P,BFRC ;FORCE OUT BINARY + MOVEI FS,5(N) ;SET UP POINTER + PUSHJ P,POLOUT ;PUT OUT POLFIX + POP P,L + POP P,O + POPJ P, + + ;SORT THE LITERALS. DO CONTANT'S OPTIMIZATION. +LITSRT: JUMPE NA,CPOPJ ;NO WORK FOR NO LIST + SKIPN FS,1(NA) ;GET LINK TO NEXT + POPJ P, ;NO NEXT. - A ONE-ELMENT LIST IS SORTED. +;NA AND FS WILL BE NEARLY-EQUAL LENGTH LISTS + MOVE O,FS ;TAIL OF THE FS LIST + MOVE L,NA ;TAIL OF THE NA LIST +LITSR1: MOVE N,1(O) ;GET LINK-OUT OF FS LIST + MOVEM N,1(L) ;STORE AS LINK-OUT IN NA LIST + SKIPN L,N ;ADVANCE NA-TAIL + JRST LITSR2 ;NO NEXT + MOVE N,1(L) ;GET LINK-OUT OF NA-LIST + MOVEM N,1(O) ;STORE AS LINK-OUT OF FS-LIST + SKIPE O,N ;ADVANCE FS-TAIL + JRST LITSR1 ;MAKE LISTS OF ALTERNATE ELEMENTS. +LITSR2: PUSH P,FS ;SAVE FS-LIST + PUSHJ P,LITSRT ;SORT THE NA-LIST (RECUR UNTIL DONE) + EXCH NA,(P) ;EXCH SORTED LIST WITH FS-LIST + PUSHJ P,LITSRT ;AND SORT FS-LIST + POP P,FS ;(FS AND NA ARE INTERCHANGED, BUT WHO CARES) +;FS AND NA NOW (ASSUME) POINT TO SORTED LISTS. MERGE THEM INTO ONE LIST. + MOVEI L,O-1 ;MERGE LIST HEAD IN O + JUMPE NA,LITSR4 ;NO MERGE IF NA IS EMPTY. ADD FS TO OUT-LIST + EXCH NA,FS ;SWAP THEM (WHO CARES?) + JUMPE NA,LITSR4 ;NO MERGE IF NA IS EMPTY. ADD FS TO OUT-LIST +LITSR3: PUSHJ P,LCOMP ;COMPARE CAR(FS) AND CAR(NA). + ; RETURN SMALLEST IN NA + MOVEM NA,1(L) ;NA;NOTNX +TNX,< + MOVE PN,JFNTBL + MOVEM PN,TXTIFL ;SAVE INPUT JFN +>;TNX + + JRST NLOOP + +NLOOP1: LEG IDPB C,N +NLOOP: PUSHJ P,SCAN1 ;GET CHR. + JUMPGE B,SPCCHR ;SPC. CHR? + TLNE B,NMFLG ;NUM? + JRST SNUMS ;YES + MOVEM N,NSTO +LEG IDPB C,N + MOVEI PN,(B) ;GET SIXBIT +ILOOP: PUSHJ P,SCAN1 ;GET CHR. + JUMPGE B,ISPC ;SPC CHR? +LEG IDPB C,N ;NO, DEPOSIT + TLNE PN,770000 ;6 CHRS? + JRST ILOOP ;YES + LSH PN,6 + ORI PN,(B) ;INSERT + JRST ILOOP + +ISPC: JUMPE T,SPCCHR ;NO ARGS? + MOVE TAC,T ;GET COUNT + MOVE L,NA ;GET POINTER +ALOOP: CAMN PN,(L) ;IS THIS IDENT WE SCANNED AN ARG? + JRST YUP ;YUP + ADDI L,1 + SOJG TAC,ALOOP ;LOOP MATCHING THIS ID TO ANY FORMAL ARG +SPCCHR: CAMN C,-1(P) ;CONCAT CHR? + JRST NLOOP ;YES + TRNE B,LBCF ;{ ? + AOS BCNT ;YES, COUNT + TRNE B,RBCF ;} ? + SOSL BCNT ;YES,COUNT + JRST NLOOP1 ;RETURN + SETZM TXTIPG + POPJ P, ;RETURN + + +YUP: MOVEI PN,177 ;DEPOSIT ARG POINTER... + MOVE N,NSTO ;GET POINTER +LEG IDPB PN,N ;... + MOVEI PN,1 ;... +LEG IDPB PN,N ;... + MOVE L,T ;FORM ARG NUMBER... + SUB L,TAC ;... +LEG IDPB L,N ;AND DEPOSIT + JRST SPCCHR + +SNUMS: LEG IDPB C,N ;DEPOSIT + PUSHJ P,SCAN1 ;GET CHR. + JUMPL B,SNUMS ;NOT SPC CHR? + JRST SPCCHR ;SPCCHR +NSTO: 0 +BCNT: 0 + + BEGIN ARGIN +;ARGIN: CALL TO READ IN ARGS. USES NEXT FREE SPACES + ; IN CONTIGUOUS AREA. USES N,PN,TAC,NA + ; # OF ARGS SHOULD BE IN N + +^^ARGIN: + HRRZ NA,MTBPNT ;GET FREE AREA + PUSH P,NA ;SAVE ON PDL (RECURSIVE) + ADD NA,N ;ADD # OF ARGS + HRLI NA,440700 ;MAKE INTO POINTER + PUSHJ P,SCAN1 ;GET NEXT CHR. + TRNN B,LFPF ;(? + JRST CRMOD ;NO - ARGUMENT LIST IS NOT IN PARENS +LOOP2: PUSHJ P,SCAN1 ;YES,PASS IT +LEG MOVEM NA,@(P) ;DEPOSIT POINTER TO FIRST ARG + TRNE B,BSLF ;BACKSLASH? \ ()? + PUSHJ P,BKHAN ;YES. HANDLE IT. (ALWAYS SKIPS!) + PUSHJ P,SARGIN ;GET ARG + TRNN B,RBCF ;}? + TLNN B,CRFG!RBRF ;DID IT STOP ON CR? + JRST .+3 ;NO + PUSHJ P,SARCON ;YES, CONTINUE + JRST .-3 + MOVEI TAC,177 ;DEPOSIT... +LEG IDPB TAC,NA ;END... + MOVEI TAC,2 ;OF ARG... +LEG IDPB TAC,NA ;INDICATION + ADDI NA,1 + HRLI NA,440700 ;NEXT AREA +LOOP1: TRNE B,COMF ;,? + JRST GNXT1 ;YES + TRNE B,RTPF ;)? + JRST GTERM1 ;YES + PUSHJ P,SCAN1 ;NO, IT MUST BE } + JRST LOOP1 +GNXT1: SOJLE N,GALL1 ;NO MORE ALLOWED? + AOS (P) ;YES, MORE , ADVANCE POINTER + JRST LOOP2 + + CRMOD: ;ARGUMENTS NOT IN PARENS +LEG MOVEM NA,@(P) ;DEPOSIT POINTER + TRNE B,BSLF ;BACKSLASH \ ()? + PUSHJ P,BKHAN ;YES. HANDLE IT. (ALWAYS SKIPS!) + PUSHJ P,SARGIN ;GET ARG + TRNN B,RTPF ;)? + JRST .+3 ;NO + PUSHJ P,SARCON ;YES, CONTINUE + JRST .-3 + MOVEI TAC,177 ;DEPOSIT... +LEG IDPB TAC,NA ;END... + MOVEI TAC,2 ;OF ARG... +LEG IDPB TAC,NA ;INDICATION + ADDI NA,1 + HRLI NA,440700 +LOOP3: TRNE B,COMF ;,? + JRST GNXT2 ;YES + TLNE B,CRFG!RBRF ;CR? + JRST GTERM2 ;YES + PUSHJ P,SCAN1 ;MUST BE } + JRST LOOP3 + +GNXT2: SOJLE N,GALL2 ;NO MORE ALLOWED? + AOS (P) ;YES, MORE + PUSHJ P,SCAN1 + JRST CRMOD + +GTERM1: SETZB B,C ;PASS THE ) (RETURNING NOTHING) +GTERM2: SOJLE N,GL ;GOTTEM ALL + MOVEI TAC,177 ;NO, DEPOSIT +LEG IDPB TAC,NA ;A NULL... + MOVEI TAC,2 ;ARG... +LEG IDPB TAC,NA ;... + HRLI NA,440700 +LOOP4: AOS (P) ;INCREMNT POINTER +LEG MOVEM NA,@(P) ;DEPOSIT + SOJG N,LOOP4 + ADDI NA,1 +GL: SUB P,[1,,1] ;FLUSH PNTR FROM PDL + POPJ P, + +;HERE WHEN WE HAVE ALL THE ARGS WE NEED. +GALL1: PUSHJ P,SCAN1 ;GET CHR. (ARGS ARE IN PARENS. SCAN TO CLOSE PAREN) + TRNN B,RTPF ;)? + JRST GALL1 ;NO +GALL2: SUB P,[1,,1] ;FLUSH PNTR. + JRST SCAN1 ;EAT THE ) OR , AND RETURN + ; HANDLE BACKSLASH ARGUMENTS + +;WARNING! This code knows everything about it's environment all the way back +;to what the caller of ARGIN pushed on the stack. Modifiers beware!! + +BKHAN: ANDI NA,-1 ;RIGHT SIDE ONLY + MOVEM NA,MTBPNT ;UPDATE IN CASE MEVAL NEEDS IT FOR MACRO HACKING + MOVEI TAC,1(P) ;SOURCE=0, DESTINATION = PDL + BLT TAC,7(P) ;SAVE AC'S (0-6) + ADD P,[7,,7] ;ADJUST STACK + TRO NOFXF ;NO FIXUPS FROM MEVAL + PUSHJ P,MEVAL ;GET VALUE + TLNN UNDF!ESPF + TRNE NA,17 + TDZA N,N ;UNDEFINED. SET VALUE TO ZERO AND SKIP TO LOSE MSG + JRST .+2 ;VALUE IS OK. AVOID LOSE MESSAGE + ERROR [ASCIZ /UNDEFINED \ ARGUMENT/] + EXCH N,B ;SAVE NUMBER IN B, CHARACTER FLAGS IN N + EXCH C,NA-6(P) ;EXCHANGE CHAR WITH OLD MTBPNT POINTER. + HRRZS MTBPNT ;MAKE SURE MTBPNT IS RIGHT SIDE ONLY +BKHAN0: CAME C,MTBPNT ;HAVE WE BEEN SCREWED BY MEVAL? + JRST BKHAN1 ;YES. NOW LETS GO FIX IT. + HRLI C,440700 ;MAKE ARG PNTR UP TO DATE + MOVEM C,@-7-1(P) ;MAKE SURE ARG PNTR IS UP TO DATE + PUSHJ P,BKSLSH ;CON TO ASCII + MOVE B,N ;CHARACTER FLAGS GO BACK TO B + EXCH C,NA-6(P) ;RESTORE CHAR, PUT BACK NEW PNTR + SUB P,[7,,7] + MOVSI TAC,2(P) + HRRI TAC,1 + BLT TAC,6 ;RESTORE AC'S + MOVE TAC,1(P) + TDZ REFLAG + AND TAC,REFLAG + OR TAC ;RESTORE FLAGS + TLZ SFL ;SKIP THE , OR ) OR WHATEVER + AOS (P) ;ALWAYS SKIP RETURN + POPJ P, + +;THE FOLLOWING KLUDGE FIXES A HORRIBLE BUG IN STORAGE MANAGEMENT +;C CONTAINS FIRST LOC TO NOT MOVE. +BKHSVC: 0 +BKHSVN: 0 +BKHSVB: 0 + +;I ADDED THIS CODE TO NOTICE IF FREE STORAGE GOT USED BY CALL TO MEVAL +;IF SO, WE HAVE TO MOVE THE ARGUMENTS ACCUMULATED BY ARGIN - REG + +BKHAN1: MOVEM N,BKHSVN + MOVEM C,BKHSVC ;SAVE TOP ADDRESS FOR MACRET + HRRZS NA,-12(P) ;MAKE CERTAIN THAT THIS IS RIGHT SIDE ONLY! + MOVEM NA,BKHSVB ;SAVE BOTTOM FOR MACRET + HRLZ NA,-12(P) ;SOURCE = CALLER'S OLD MTBPNT + HRR NA,MTBPNT ;DESTINATION = CURRENT MTBPNT + ADD C,MTBPNT + SUB C,-12(P) ;THIS IS THE ENDING ADDRESS OF BLT +LEG SETZM -1(C) + BLT NA,-1(C) ;MOVE ARGUMENT LIST TO A NEW HOME + ;C= FIRST FREE LOCATION. + HRRZ NA,MTBPNT + SUB NA,-12(P) ;CALC OFFSET + ADDM NA,-12(P) ;FIX CALLER'S MTBPNT + ADDM NA,-10(P) ;FIX ARGUMENT POINTER + HRRZ N,-10(P) ;GET ARGUMENT POINTER + ADDM NA,(N) ;FIX ONE ARGUMENT + CAMLE N,MTBPNT ;DONE FIRST ARG YET? + SOJA N,.-2 ;NO. LOOP + HRRZM C,MTBPNT ;SET NEW MTBPNT + EXCH C,BKHSVC ;GET TOP ADDRESS OF BLOCK + PUSH P,B + MOVE B,BKHSVB + EXCH C,B ;LOW ADDRESS IN C, HIGH ADDRESS IN B + PUSHJ P,MACRET + POP P,B + MOVE C,BKHSVC ;GET NEW OLD MTBPNT + MOVE N,BKHSVN ;RESTORE CHARACTER FLAGS TO N + JRST BKHAN0 ;RETURN. C SETUP. CHECK AGAIN BECAUSE + ;SOMETIMES MACRET SCREWS UP MTBPNT! +BEND ARGIN + ;SARGIN: CALL TO READ IN A SINGLE ARGUMENT. POINTER FOR + ;DEPOSIT SHOULD BE IN NA. +; STARTS WITH CURRENT CHR. & TERMINATES ON , OR CR OR ) OR > OR ]. +; USES TAC . IF FIRST IS { , TERMS ON } + +^SARGIN:PUSH P,TAC + SKIPN TAC,TLBLK + HRRO TAC,INLINE + MOVEM TAC,SARLN ;SAVE FOR FATAL EOF TYPEOUT + MOVEM TAC,SARLIN + MOVE TAC,PGNM + MOVEM TAC,SARGPG + MOVEM TAC,SARPG +NOTNX,< MOVE TAC,[FILNM,,SARFIL] + BLT TAC,SARFIL+4 >;NOTNX +TNX,< + MOVE TAC,JFNTBL + MOVEM TAC,SARFIL ;SAVE INPUT JFN +>;TNX + POP P,TAC + SETZM TABMFG# ;SET AFTER WE'VE SEEN CRUD + TRNE B,LBCF ;{ ? + JRST BROK ;YES + SKIPE TABMSW ;NEW TAB IN ARGUMENT HACK? + JRST RLOOP1 ;YES. WE HAVE TO WORK HARDER +SLOOP: TRZ B,RBCF + TDNE B,[XWD RBRF!CRFG,RTPF!COMF] ;, OR CR OR ) OR > OR ]? + JRST BFND ;YES +SARCO: LEG IDPB C,NA ;NO, DEPOSIT + PUSHJ P,SCAN1 ;GET NEXT + JRST SLOOP + +RLOOP3: LEG IDPB C,NA ;NO, DEPOSIT + TLNN B,SPFL ;SPACE OR TAB? + MOVEM NA,TABMFG ;NO. REMEMBER LAST SIGNIFICANT CHR +RLOOP4: PUSHJ P,SCAN1 ;GET NEXT +RLOOP1: SKIPN TABMFG ;SEEN ANYTHING YET? + TLNN B,SPFL ;NO. BLANK OR TAB? + TRZA B,RBCF ;SEEN SOMETHING, OR NOT BLANK + JRST RLOOP4 ;IGNORE LEADING BLANKS + TDNN B,[XWD RBRF!CRFG,RTPF!COMF] ;, OR CR OR ) OR > OR ]? + JRST RLOOP3 ;NO. CONTINUE + SKIPE TABMFG + EXCH NA,TABMFG ;LOAD NA FROM TABMFG + SETZM SARGPG + POPJ P, + + +BROK: SETZM SARTAC ;HERE WHEN FIRST CHARACTER OF ARG IS { + JRST BLOOP + +BLOOP1: LEG IDPB C,NA ;DEPOSIT CHR. +BLOOP: PUSHJ P,SCAN1 ;GET CHR. + TRNE B,LBCF ;{ ? + AOS SARTAC ;YES + TRNE B,RBCF ;} ? + SOSL SARTAC ;YES + JRST BLOOP1 ;NOT AT THE END YET + TLZ B,RBRF ;CLEAR END OF LINE +BFND: SETZM SARGPG + POPJ P, + + +SARTAC: 0 +SARLIN: 0 +SARPG: 0 + +^SARCON:PUSH P,SARLIN + POP P,SARLN + PUSH P,SARPG + POP P,SARGPG + SKIPN TABMSW ;SPECIAL TAB HANDLING? + JRST SARCO ;NO. + SKIPE TABMFG ;WAS THERE AN OLD NA STORE HERE AT EXIT? + EXCH NA,TABMFG ;YES. WELL, PUT IT BACK! + JRST RLOOP3 ;YES. PICKUP IN THE RIGHT LOOP + ;ROUTINE TO RETURN MACRO TABLE SPACE +;CALLED WITH B: (HIGHEST ADDRESS OF THIS BLOCK)+1 +; C: LOWEST ADDRESS OF THIS BLOCK + +^MACRET:CAME B,MTBPNT ;IS THIS JUST BELOW MTBPNT? + JRST MACR2 ;NO SUCH LUCK. + MOVEM C,MTBPNT ;YES. JUST BACK UP MTBPNT TO INCLUDE THIS + CAME C,LGARB ;DOES THIS ABUT GARBAGE AREA? + POPJ P, ;NOPE. ALL DONE NOW. + MOVE B,GARBAG ;ABUTS GARBAGE AREA: BACK UP MTBPNT SOME MORE + MOVE C,2(B) ;GET LOW ADDRESS OF THIS BLOCK + MOVEM C,MTBPNT ;IS NEW MTBPNT + + MOVE C,FSTPNT ;RETURN GARBAGE PNTR (REMOVE FROM GARBAGE, + EXCH C,1(B) ;ADD TO FSTPNT + MOVEM C,GARBAG + MOVEM B,FSTPNT + + JUMPE C,.+2 ;SO, IS THERE ANY GARBAGE LEFT? + MOVE C,3(C) ;YES. GET HIGH ADDRESS IN GARBAGE + MOVEM C,LGARB ;SET UP NEW "LAST GARBAGE" PNTR + POPJ P, + +;NOT AT END - INSERT IN ORDERED LIST, COMBINING WITH OLD ENTRIES IF POSSIBLE +MACR2: PUSH M,T + PUSH M,N +MACR2A: SKIPA N,[-1,,GARBAG-1] +MACR3: MOVEI N,(T) + SKIPN T,1(N) ;ANYTHING LEFT ON THE LIST? + JRST MACRE ;NO. WE RAN OFF THE END + CAMG B,3(T) ;ARE WE ABOVE THE NEXT GUY? + JRST MACR3 ;NO. GO DOWN. + CAMN C,3(T) ;HERE WE HAVE PROPER POSITION + JRST MACRL ;LOW END OF US MATCHES HIGH END OF OLD +MACRE: JUMPL N,.+3 ;JUMP IF THIS IS HIGHEST GARBAGE + CAMN B,2(N) ;HIGH END MATCHES OLD? + JRST MACRH ;YES. SEE US COMBINE TWO BLOCKS + EXCH N,FSTPNT ;NEITHER MATCHES - CREATE NEW ENTRY + JUMPE N,MACRLZ ;JUMP IF NO FS + EXCH T,1(N) ;GOBBLE THE FS BLOCK + EXCH T,FSTPNT + MOVEM N,1(T) ; + SETZM (N) ;ZERO SIZE FOR UPCOMING "COMBINE" + JUMPGE T,.+2 + MOVEM B,LGARB ;UPDATE END ADR IF HIGHEST POS + MOVEM B,3(N) +MACRH: MOVEM C,2(N) + SUBI B,(C) + ADDM B,(N) +MACRX: POP M,N + POP M,T + POPJ P, + MACRL: JUMPL N,[MOVEM B,LGARBJRST .+3] ;UPDATE LGARB, AVOID TEST IF AT END + CAMN B,2(N) + JRST MACRB ;BOTH ENDS MATCH - WE HAVE CLOSED A HOLE! + MOVEM B,3(T) +MACRL2: SUBI B,(C) + ADDM B,(T) + JRST MACRX + +MACRB: MOVE C,2(T) ;COMBINE ALL 3 PIECES INTO ONE, RETURN ONE OLD PNTR BLK + MOVEM C,2(N) + EXCH N,FSTPNT + EXCH N,1(T) + EXCH T,FSTPNT + MOVEM N,1(T) + JRST MACRL2 + +;HERE IF NO FS FOR PNTR + N, ;ARG FOR NOFSL +MACRLZ: JSR NOFSL ;THIS MAY CHANGE LIST, SO ... + MOVEM N,FSTPNT ;PUT BACK FS + JRST MACR2A ;AND START SCAN OVER + +^GARBAG:0 +^LGARB: 0 + +^LGET: 0 + PUSHJ P,SCAN1 ;GET CHR. + TRNN B,LBCF ;{ ? + JRST .-2 ;NO + JRST @LGET ;YES + ;REPEAT - %REP, REP + + DEFINE MACEX (AC) +< LDB AC,[POINT 6,LSTPNT,11] + HRL AC,INMCSW + PUSH M,AC + PUSH M,INPNTP + PUSH M,INPNT + MOVE AC,INPNTP + CAIN AC,INPNT + HRRZM M,INPNTP + MOVEI AC, + SKIPN NOEXP + JRST .+4 + IBP LSTPNT + DPB AC,[POINT 6,LSTPNT,11] + SETZM XPNDSW + SETZM INMCSW +> + +^%REP: TRO NOFXF ;GENERATE NO FIXUPS + PUSHJ P,MEVAL ;EVALUATE EXPR. + TRNN NA,17 + TLNE UNDF!ESPF ;DEFINED & NOT SPC. CHR? + JRST REPER ;NO + JUMPL N,REPER ;NEG. COUNT? + SETOM REPSW ;SET REPEAT SWITCH (PUT CR LF AT END) + PUSHJ P,REP ;GO DO + TRZ NOFXF + JRST ASSMBL ;PROCEED + + PUSHJ P,SCAN1 ;GET NEXT +^REP: TRNN B,LBCF ;{ ? + JRST REP-1 ;NO + TLZ SFL +LBFN: JUMPE N,REP0 ;REPEAT 0? + CAIN N,1 ;REPEAT 1? + JRST REP1 ;YES + MOVE NA,MTBPNT ;MAKE READ-IN POINTER + HRLI NA,440700 ;... + PUSHJ P,SARGIN ;READ IN + SKIPN REPSW ;REPEAT? + JRST NOREP ;NO + MOVEI TAC,15 ;YES, INSERT CR LF +LEG IDPB TAC,NA + MOVEI TAC,12 +LEG IDPB TAC,NA +NOREP: MOVEI TAC,177 ;DEPOSIT... +LEG IDPB TAC,NA ;END... + MOVEI TAC,4 ;OF REPEAT... +LEG IDPB TAC,NA ;... + PUSH M,AHED ;PUSH LINE NUMBET TEST + MOVSI TAC,() + MOVEM TAC,AHED ;INHIBIT... + MOVEM TAC,LOOP6 ;LINE NUMBER SKIPPING + MACEX (TAC) + HRRZI NA,1(NA) ;INCREMENT & ZERO LEFT + PUSH M,NA ;SAVE NEW MTBPNT + PUSH M,N ;SAVE COUNT + PUSH M,MTBPNT ;SAVE OLD MTBPNT (POINTS TO STRT) + MOVEM NA,MTBPNT ;RESET MTBPNT + MOVE NA,(M) ;GET POINTER + HRLI NA,440700 + MOVEM NA,INPNT ;POINT TO STRT + + DEFINE MACUND (ZORCHL) +< SKIPN NOEXP + SKIPN UNDLNS + ZORCHL + HRRZ TAC,LSTPNT + CAIL TAC,TLBLK + SUBI TAC,TLBLK-MBLK + HRRM TAC,LSTPNT + TRO MACUNF> + + MACUND () + POPJ P, + REP0: SKIPN TAC,TLBLK ;REPEAT 0 + HRRO TAC,INLINE + MOVEM TAC,REPPG + MOVE TAC,PGNM + MOVEM TAC,REP0PG +NOTNX,< MOVE TAC,[FILNM,,REPFIL] + BLT TAC,REPFIL+4 >;NOTNX +TNX,< MOVE TAC,JFNTBL + MOVEM TAC,REPFIL ;SAVE INPUT JFN +>;TNX + PUSHJ P,SLURP ;EAT ALL THE TEXT + SETZM REP0PG + POPJ P, + +REP1: SKIPN TAC,RTFLST ;GET POINTER + SETZM BROKCT ;ZERO COUNT IF AT OUTSIDE LEVEL + GFST NA,FSTPNT + HRRZM NA,RTFLST ;GET FREE STRG. + EXCH TAC,1(NA) + MOVEM TAC,FSTPNT + MOVE TAC,BROKCT ;GET COUNT + MOVEM TAC,@RTFLST ;DEPOSIT + POPJ P, + +REPER: ERROR [ASCIZ/REPEAT -- ILLEGAL EXPRESSION FOR COUNT/] + JRST SPCFN + +;BKSLSH: CALL, WITH BYTE POINTER IN C & NUM IN B. +; PUTS ASCII FOR NUM (IN CURRENT RADIX) AT PLACE POINTED TO BY C. +^BKSLSH:JUMPE B,BKZER ;HANDLE ZERO SPECIALLY + MOVEM C,BKPNT ;DEPOSIT BYTE POINTER + PUSH P,N ;SAVE N + MOVEI N,1 ; + XCT SRAD ;GET RADIX + MOVEM N,BKRAD ;SAVE + POP P,N ;RESTORE N + JUMPL B,BKNEG ;NEG? +NLOPN: PUSHJ P,BKCON ;DO IT + MOVE C,BKPNT ;RESTORE POINTER + POPJ P, ;LEAVE +BKNEG: MOVEI C,"-" ;GET - SIGN +LEG IDPB C,BKPNT + MOVMS B + JRST NLOPN +BKRAD: 0 +BKPNT: 0 +BKCON: IDIV B,BKRAD ;DIVIDE BY RADIX + JUMPE B,BZER ;ZERO? + HRLM C,(P) ;NO, SAVE REMAINDER + PUSHJ P,BKCON ;CONVERT REST OF NUM + HLRZ C,(P) ;GET REMAINDER BACK +BZER: ORI C,60 ;CON TO ASCII +LEG IDPB C,BKPNT ;PUT OUT + POPJ P, ;LEAVE +BKZER: MOVEI B,"0" ;HANDLE ZERO... +LEG IDPB B,C ;AS A SPECIAL... + POPJ P, ;CASE + ; FOR STATEMENT + +FER1A: ERROR [ASCIZ/NO IDENT AFTER FOR/] + JRST SPCFN + +FERR2: ERROR [ASCIZ/NO IDENT FOR SECOND ARG -- FOR/] + JRST SPCFN + +FERR3: ERROR [ASCIZ/NUMBER AFTER ARGS -- FOR/] + JRST SPCFN + +FERR5: ERROR [ASCIZ /ILLEGAL CONCATENATION CHR -- FOR/] + JRST SPCFN + + +^%FOR: MOVE O,MTBPNT ;FREE STG POINTER + PUSHJ P,SCAN ;GET FIRST ARG + MOVEI FS,200 ;ASSUME NO CONCAT CHR. + TLNE IFLG ;IDENT? + JRST F1RT ;YES. THERE IS NO CONCAT. CHR. + TLNE SCFL ;LOOKING FOR CONCAT. CHR. SPC CHR? + TRNN N,ATF ;YES. IS IT @? + JRST FER1A ;NO TO EITHER OF THE ABOVE. LOSE + MOVE FS,C ;YES, GET CONCAT CHR. + TRNE B,RBCF ;IS IT A > OR A } + JRST FERR5 ;YES. ILLEGAL + TLZ SFL ;SKIP CHR. + PUSHJ P,SCAN ;GET NEXT + TLNN IFLG ;IDENT? + JRST FER1A ;NO. LOSE +F1RT: ;FS=CONCATENATION CHR, L=FIRST ARGUMENT +LEG MOVEM L,(O) ;SAVE +LEG SETZM 1(O) ;MAKE SURE THIS CELL EXISTS, (WE MAY NOT USE IT) + MOVEI T,1 ;ARG COUNT + TRNN B,COMF ;COMMA NEXT? + JRST NOSEC ;NO. THERE'S NO SECOND ARGUMENT + TLZ SFL ;SKIP THE COMMA + PUSHJ P,SCAN ;GET NEXT + TLNN IFLG ;IDENT? + JRST FERR2 ;NO + MOVEM L,1(O) ;SAVE. 1(O) IS NOT AN MPV BECAUSE WE CHECKED ABOVE. + MOVEI T,2 ;ARG COUNT +NOSEC: PUSHJ P,SCAN ;GET NEXT + TLNE IFLG ;IDENT? + JRST ICHK ;YES - CHECK FOR "IN" OR "E" + TLNN SCFL ;SPC. CHR? + JRST FERR3 ;NO. LOSE + TRNE N,LACF ;_? + JRST LFOR ;YES - ARITHMETIC FOR + TRNE N,EPSF ;EPSILON? + JRST EFOR ;YES + TRNE N,INF ;? + JRST INFOR ;YES +FERR6: ERROR [ASCIZ/UNREC IDENT OR UNREC CHR. AFTER ARGS -- FOR/] + JRST SPCFN + +ICHK: CAIN L,'IN' ;IN? + JRST INFOR ;YES + CAIE L,'E' ;E? + JRST FERR6 ;NO. LOSE + JRST EFOR ;YES + ; SETUP ARITHMETIC FOR + +OSAV: BLOCK 2 +CONSAV: 0 +FSVV: 0 +TSVV: 0 + +FERR4B: POP P,N +FERR4A: POP P,N +FERR4: ERROR [ASCIZ/UNDEFINED ARG -- FOR/] + JRST SPCFN + +LFOR: MOVEM FSVV ;SAVE FLAGS + TRO NOFXF ;NO FIXUPS + MOVEM T,TSVV ;SAVE ARG COUNT + MOVEM FS,CONSAV ;SAVE CONCAT CHR. + MOVE T,(O) ;SAVE... + MOVEM T,OSAV ;ARGS + MOVE T,1(O) + MOVEM T,OSAV+1 + PUSHJ P,MEVAL ;GET VALUE + TRNN NA,17 + TLNE UNDF!ESPF ;DEFINED? + JRST FERR4 ;NO + PUSH P,N ;SAVE + TLZ SFL + PUSHJ P,MEVAL ;GET VALUE + TRNN NA,17 + TLNE UNDF!ESPF ;DEFINE? + JRST FERR4A ;NO + PUSH P,N ;SAVE + MOVEI N,1 ;ASSUME NO THIRD ARGUMENT. DEFAULT VALUE IS 1 + TRNN B,COMF ;, NEXT? + JRST NOTHRD ;NO. NO THIRD ARGUMENT + TLZ SFL + PUSHJ P,MEVAL ;GET VALUE + TRNN NA,17 + TLNE UNDF!ESPF ;DEFINED? + JRST FERR4B ;NO +NOTHRD: MOVE T,TSVV ;GET ARG COUNT + MOVE O,FSVV ;GET OLD FLAGS + TDZ REFLAG + AND O,REFLAG + OR T ;RESTORE FLAGS + MOVE O,MTBPNT ;GET FREE STG POINTER + MOVE NA,OSAV ;REDEPOSIT ARGS +LEG MOVEM NA,(O) ;THIS IS DONE IN CASE MEVAL CHANGED MTBPNT + MOVE NA,OSAV+1 +LEG MOVEM NA,1(O) + MOVE NA,(P) ;GET TERMINATION VALUE + JUMPL N,LFOR1 ;JUMP IF INCREMENT IS NEGATIVE + CAML NA,-1(P) ;ZERO TIMES? + JRST LFOR2 ;NO + JRST NOTIM ;YES + +LFOR1: CAMLE NA,-1(P) ;ZERO TIMES? + JRST NOTIM ;YES +LFOR2: PUSH P,N ;SAVE N + MOVEI N,2(O) ;MAKE POINTER + HRLI N,440700 ;... + MOVE FS,CONSAV + CAIN FS,200 ;IS THERE A CONCAT CHR? + JRST FLOP1 ;NO + PUSH P,CTAB(FS) ;SAVE BITS + MOVSI NA,SPFL!SPCLF ;GET NEW BITS + MOVEM NA,CTAB(FS) +FLOP1: PUSH P,FS ;SAVE CONCAT CHR. + MOVE NA,O ;ARG POINTER + JSR LGET ;GET TO THE { + PUSHJ P,TXTIN ;GET TEXT OF FOR-BODY. + PUSH M,AHED ;SAVE LINE NUM SKIP + MOVSI FS,() + MOVEM FS,AHED + MOVEM FS,LOOP6 ;INHIBIT LINE NUM SKIP + MACEX (FS) + EDEPO (L,N,5) ;DEPOSIT END OF FOR + HRRZI N,6(N) ;INCREMENT + PUSH M,N ;SAVE + POP P,FS ;GET CONCAT CHR + CAIE FS,200 ;ANY? + POP P,CTAB(FS) ;YES, RESTORE BITS + PUSH M,(P) ;SAVE INCREMENT + PUSH M,-1(P) ;SAVE TERM NUM + PUSH M,-2(P) ;SAVE STARTING # + PUSH M,O ;SAVE STARTING ADDRS -2 + MOVEI FS,-5(N) ;GET ARG POINTER + PUSH M,FS ;SAVE + SUB P,[3(3)] + MOVEM N,MTBPNT ;RESET MTBPNT + MOVEI C,-3(N) + HRLI C,440700 +LEG MOVEM C,-5(N) ;DEPOSIT ARG ... +LEG MOVEM C,-4(N) ;POINTERS + MOVE B,-2(M) ;GET NUMBER + PUSHJ P,BKSLSH ;CONVERT TO ASCII + EDEPO (TAC,C,2) ;DEPOSIT END OF ARG + ADD O,[XWD 440700,2] + MOVEM O,INPNT ;DEPOSIT + MACUND (JRST ASSMBL) + JRST ASSMBL ;GO, MAN + +;ASSEMBLE THE FOR-BODY ZERO TIMES. +NOTIM: SUB P,[2(2)] ;CLEAR STACK + MOVEI N,0 ;REPEAT 0 + PUSHJ P,REP + JRST ASSMBL + + ; SETUP "IN" FOR +INFOR: PUSHJ P,SCAN ;GET TO THE ( + TLNN SCFL ;SPCL CHR? + JRST .-2 ;NO + TRNN N,LFPF ;(? + JRST .-4 ;NO + PUSHJ P,SCAN1 ;GET NEXT CHR. + MOVEI NA,5(O) ;GET POINTER FOR ARGS + HRLI NA,440700 ;... +LEG MOVEM NA,3(O) ;DEPOSIT SECOND ARG POINTER +INLOP2: TRNE B,LBCF ;{? +LEG IDPB C,NA ;YES, DEPOSIT IT + PUSHJ P,SARGIN ;GET FIRST ARG. +INLOP1: TRNE B,RTPF ;TERM BY )? + JRST RTERM ;YES + TRNE B,COMF ;TERM BY COMMA? + JRST MYCON ;YES + PUSHJ P,SARCON ;NO, CONTINUE + JRST INLOP1 + +MYCON: +LEG IDPB C,NA + PUSHJ P,SCAN1 + TRNE B,LBCF ;{? +LEG IDPB C,NA ;YES, DEPOSIT + PUSHJ P,SARGIN + JRST INLOP1 + +RTERM: EDEPO (N,NA,2) ;DEPOSIT END OF ARG + CAIN FS,200 ;ANY CONCAT CHR? + JRST IFLOP ;NO + PUSH P,CTAB(FS) ;SAVE BITS + MOVSI N,SPFL!SPCLF ;MAKE NEW BITS + MOVEM N,CTAB(FS) +IFLOP: MOVEI N,4(O) ;GET... + HRLI N,440700 ;FIRST ARG... + MOVEM N,2(O) ;POINTER + MOVEI N,1(NA) ;MAKE TEXT... + HRLI N,440700 ;POINTER + PUSH P,FS ;SAVE CONCAT CHR. + MOVE FS,N ;& SAVE + JSR LGET ;GET TO THE { + MOVE NA,O ;SET ARG POINTER + PUSHJ P,TXTIN ;GET TEXT IN + PUSH M,AHED ;SAVE LINE NUM TEST + MACEX (L) + MOVSI L,() + MOVEM L,AHED ;INIHIBIT LINE NUM... + MOVEM L,LOOP6 ;SKIPPING + EDEPO (L,N,6) ;DEPOSIT END OF FOR-IN + HRRZI N,1(N) ;FORM NEW MTBPNT + PUSH M,N ;SAVE + PUSH M,MTBPNT ;SAVE OLD + MOVEM N,MTBPNT + PUSH M,FS ;SAVE STRT OF TEXT + MOVEI N,2(O) ;GET ARG POINTER + PUSH M,N ;SAVE + POP P,FS ;GET CONCAT + CAIE FS,200 ;ANY? + POP P,CTAB(FS) ;YES, RESTORE + PUSHJ P,IFORSH ;SET UP ARGS + MACUND JRST ASSMBL + JRST ASSMBL + ^IFORSH:MOVE B,(M) ;GET ARG POINTER + MOVE C,1(B) ;GET SECOND ARG POINTER + PUSH P,N ;SAVE N + MOVE B,(B) ;GET FIRST ARG POINTER + ILDB TAC,C ;GET CHR. + SKIPGE N,CTAB(TAC) ;GET BITS + JRST ILOPI2 + TLNE N,SCRF ;CHECK FOR SPECIAL ({ AND < AND > AND }) + XCT IFORT(N) + TRNE N,LBCF ;{? + JRST LBRK ;YES +ILOPI1: TRNE N,COMF ;,? + JRST COMTOM ;YES + TLNE N,DLETF ;DELETE? + JRST DELTOM ;YES +ILOPI2: IDPB TAC,B ;DEPOSIT + ILDB TAC,C ;GET NEXT + SKIPL N,CTAB(TAC) ;GET BITS + JRST ILOPI1 + JRST ILOPI2 + +IFORT: FOR I_0,7 + HRRI N,LBCF!TP2F ;< OR { + HRRI N,RBCF!TP2F ;> OR } + +DELTOM: MOVE C,(M) ;GET ARG POINTER + MOVEM B,1(C) ;DEPOSIT SECOND ARG POINTER + EDEPO (TAC,B,2) + JRST FINIT + +COMTOM: EDEPO (N,B,2) + MOVE N,(M) ;GET ARG POINTER + MOVEM C,1(N) ;DEPOSIT SECOND ARG POINTER +FINIT: POP P,N ;RESTORE + MOVE B,-1(M) ;GET START + MOVEM B,INPNT ;DEPOSIT + JRST LSTCHK + +LBRK: SETZM IFOCNT ;ZERO {} COUNT + SKIPA +LILO1: IDPB TAC,B + ILDB TAC,C ;GET CHR. + SKIPGE N,CTAB(TAC) ;GET BITS + JRST LILO1 ;NOT SPC CHR. + TLNE N,SCRF + XCT IFORT(N) + TRNE N,LBCF ;{? + AOS IFOCNT ;YES + TRNE N,RBCF ;}? + SOSL IFOCNT ;YES, DONE? + JRST LILO1 ;NO +LILO2: ILDB TAC,C ;GET NEXT + SKIPGE N,CTAB(TAC) ;GET BITS + JRST LILO2 + TRNE N,COMF ;,? + JRST COMTOM ;YES + TLNE N,DLETF ;DELETE? + JRST DELTOM ;YES + JRST LILO2 ;NO +IFOCNT: 0 + EFOR: JSR LGET ;GET TO THE { + MOVEI NA,5(O) ;SET UP POINTER... + HRLI NA,440700 ;TO READ IN ARG... +LEG MOVEM NA,3(O) ;DEPOSIT + PUSHJ P,SARGIN ;GET ARG. + EDEPO (TAC,NA,2) ;DEPOSIT END OF ARG + MOVEI TAC,4(O) ;FORM FIRST ARG... + HRLI TAC,440700 ;POINTER + MOVEM TAC,2(O) ;DEPOSIT + JSR LGET ;GET TO THE { + MOVEI N,1(NA) ;FORM TEXT POINTER + HRLI N,440700 ;... + PUSH P,N ;SAVE + CAIN FS,200 ;ANY CONCAT CHR? + JRST EFLOP ;NO + PUSH P,CTAB(FS) ;SAVE BITS + MOVSI NA,SPFL!SPCLF ;MAKE... + MOVEM NA,CTAB(FS) ;NEW BITS +EFLOP: PUSH P,FS ;PUSH CONCAT CHR. + MOVE NA,O ;ARG POINTER + PUSHJ P,TXTIN ;READ IN BODY OF TEXT + EDEPO (L,N,7) ;DEPOSIT END OF FOR + PUSH M,AHED ;SAVE LINE NUM SKIPPING + MACEX (L) + MOVSI L,() + MOVEM L,AHED + MOVEM L,LOOP6 + POP P,L ;GET CONCAT + CAIE L,200 ;ANY? + POP P,CTAB(L) ;YES, RESTORE BITS + MOVEI N,1(N) ;FORM NEW MTBPNT + PUSH M,N ;SAVE + MOVEM N,MTBPNT ;DEPOSIT + MOVE N,2(O) ;GET FIRST ARG POINTER + IBP N + EDEPO (TAC,N,2) ;DEPOSIT END OF ARG + POP P,L ;GET START OF TEXT + PUSH M,L ;SAVE + MOVEI L,2(O) ;GET ARG POINTER + PUSH M,L ;SAVE + PUSHJ P,EFORSH ;SET UP FIRST + MACUND (JRST ASSMBL) + JRST ASSMBL + BEND MAC ;LEGTAB + +LEGTAB: FOR @! X_0,LEGNUM-1{,%$L!X +} +LEGCNT__LEGNUM ;DEFINE LEGAL LOCATIONS FOR MPV + + SUBTTL TENEX/IMSSS SPECIAL CODE + +TNX,< + +UOUTST: PUSH P,1 + HRRO 1,40 + PSOUT + POP P,1 + POPJ P, + +UOUTCH: PUSH P,1 + HRRZ 1,@40 + PBOUT + POP P,1 + POPJ P, + +NOT20,;NO TOPS20 +T20,< BYTE (9)210,011,212,213 + BYTE (9)214,015,216,217 >;TOPS20 + byte (9)220,221,404,223 + byte (9)224,225,026,402 + byte (9)403,231,232,233 + byte (9)234,235,236,215 + +xxx==40 +repeat 27,< + byte (9)xxx,xxx+1,xxx+2,xxx+3 + xxx=xxx+4 > + + byte (9)174,375,375,401 + + +ctrtae==.-ctrtab + + ; string input routine +; enter here via JSR .PSTIN + +;*** open +^^.pstin: 0 + MOVEM 17,PSTACS+17 + SETOM PSTFLG ;ONLY 17 SHOULD BE RESTORED + HRRZI 17,PSTACS + BLT 17,PSTACS+16 ;SAVE FAIL ACS + HRRZM 17,PSTFLG ;NOW ALL MAY BE RESTORED + MOVE PPP,[XWD -PSSLEN,PSTACK-1] +;*** close + setz 15,0 ;used for rfmod on backspace + MOVEI 1,100 + RFMOD + PUSH PPP,2 ;SAVE MODES + TRO 2,17B23 ;BREAK ON EVERYTHING + SFMOD + rfcoc + push PPP,2 + push PPP,3 + tlz 2,140000 ;ctrl a + tlz 3,600360 ;ctrl r,w,x + trz 3,600000 ;altmod + sfcoc + TIME + push PPP,1 ; -1(PPP) time + setz 7,0 ;flag register +IFN IMSSSW,< + gjinf ;THIS IS THE WRONG THING TO DO YOU KNOW... + movei 1,400000(4) + gttyp + andi 2,37 ;test for imlac + cain 2,12 + tlo 7,(1b16) ;imlac + cain 2,11 + tlo 7,(1b15) ;OR TEC +>;END OF IMSSS + move 5,PSTACS+1 ;*** + hrlzi 1, 440700 + jumpg 5, psin0 + caml 5, [777777000000] + hllm 1, PSTACS+1 ;*** +psin0: move 4, PSTACS+1 ;*** string ptr +IFN KAFLG, +IFN KIFLG, + move 5,4 ; starting pointer + move 6,PSTACS+3 ;*** get flags + move 16,PSTACS+2 ;*** get byte count + tlnn 6,(1b2) ;skip bytes + jrst psin1 ; no + move 10,5 + move 11,PSTACS+4 ;*** + hlrz 11,11 ; get byte count + jumple 11,psin1 + sub 16,11 ; update byte count left + PUSHJ PPP,bpplus ; add to byte pointer + move 4,11 +psin1: skipg 16 ; get total count + tlo 7,(1b0) ; set break +psin2: tlne 7,(1b0) ; break + jrst psend +IFN IMSSSW,< + tlnn 6,777 ; timing + jrst [ pbin + jrst psin22 ] + PUSHJ PPP,pstim ;check time +psin25: jrst [ movei 1,222 + jrst psin24 ] + pbtin + cain 1,22 + jrst psin25 +>;END OF IMSSS +IFE IMSSSW,< PBIN> +psin22: ldb 2,[point 7,6,26] + ldb 3,[point 7,6,35] + caie 2,(1) + cain 3,(1) + tlo 7,(1b0) ; break + idivi 1,4 + tlnn 6,(1b0) ;break table specified + jrst [ move 3,ctrtab(1) + jrst psin23 ] + move 3,PSTACS+4 ;*** + addi 1,(3) + move 3,(1) ;*** +psin23: xct psinb(2) + trze 1,400 + jrst psin4 ;special handling +psin24: PUSHJ PPP,pscha + jrst psin2 ;loop + +psin4: cail 1,psedl + setz 1,0 + xct psedr(1) + jrst psin2 ;loop + +psinb: ldb 1,[point 9,3,8] + ldb 1,[point 9,3,17] + ldb 1,[point 9,3,26] + ldb 1,[point 9,3,35] + +psedr: jfcl 0 ;noop + PUSHJ PPP,psdel ;delete charachter + PUSHJ PPP,psbaw ;delete word + PUSHJ PPP,psbal ;delete line + PUSHJ PPP,psret ;retype line + PUSHJ PPP,pslf ;special linefeed handling +psedl==.-psedr + + + ;bpPlus, dbp, countB + +bp1==10 +bp2==11 +cnt==11 +tmp1==12 +tmp2==13 + + +; Add to byte pointer +; ------------------- +; Accepts: +; BP1: Byte pointer +; CNT: Byte count, must be at least -500000 (octal), and +; may not cause BP1 to wrap around memory +; Returns: +; BP1: unchanged +; CNT: Updated byte pointer such that "LDB" will work (at +; least one "IBP" has been performed on the pointer) +; CNT+1: lost + +bpPlus: +;===== + addi cnt, 500004 ; Add 100001 (full) words to make the + ; count positive. Assures non- + ; negative remainder in division. + ; One byte discrepency for initial IBP. + idivi cnt, 5 ; Divide it to full words + ; and left-over bytes (in CNT+1) + subi cnt, 100001 ; Remove the added words + add cnt, bp1 ; CNT becomes the new pointer + ibp cnt ; Add left-over byte + sojge cnt+1, .-1 ; All left-over bytes done? + popj PPP, ; Yes + + + +; Decrement byte pointer +; ---------------------- +; Accepts: +; BP1: Byte pointer +; Returns: +; BP1: The byte pointer decremented by one byte + +dbp: +;== + add bp1, [xwd 70000,0] ; Put back one byte + tlne bp1, 400000 ; Owerflow to previous word? + sub bp1, [xwd 430000,1] ; Yes, account for it + popj PPP, + + +; Count bytes between two byte pointers +; ------------------------------------- +; Accepts: +; BP1: First (from) byte pointer +; BP2: Second (to) byte pointer +; Returns: +; BP1: unchanged +; BP2: Byte count from BP1 to BP2 +; TMP1: lost +; TMP2: lost + +countB: +;===== + ldb tmp1, [point 6,bp1,5] ; Bits to the right of byte 1 + ldb tmp2, [point 6,bp2,5] ; Bits to the right of byte 2 + subi tmp1, (tmp2) ; Bit difference + idivi tmp1, 7 ; Within-word byte difference + + subi bp2, (bp1) + hrre bp2, bp2 ; Full word difference + imuli bp2, 5 ; Convert it to byte difference + add bp2, tmp1 ; Add count derived form within-word bytes + popj PPP, + + ;pscha, psdel, psbaw + +pscha: tlze 7,(1b1) ;rubout in progress + jrst [ push PPP,1 + movei 1,"]" + tlnn 7,(1B15+1b16) ; imlac OR TEC + pbout + pop PPP,1 + PUSHJ PPP,psrmod + tlnn 7,(1B15+1b16) + pbout + tlnn 7,(1b16) ;to correct prob of + caie 1, 215 ;cr terminating delete + jrst .+1 ;no prob on imlac + movei 1, 12 ;must have lf to get off + pbout ;same line as delete + movei 1, 215 ;since only cr was sent + jrst .+1 ] ;fixed 8-2-73 /ron +IFN KAFLG, +IFN KIFLG, + idpb 1,4 ;*** + sosle 16 + trne 1,200 ;break charachter + tlo 7,(1b0) ;yes + POPJ PPP, + +psdel: move 10,5 + move 11,4 + PUSHJ PPP,countb ;how many left + jumpe 11,psbal ;none left-line delete + PUSHJ PPP,psmod ;set no echo + movei 1,"[" + tlnn 7,(1b1+1B15+1b16) + pbout + tlo 7,(1b1) ;set rubout in progress + aos 16 +IFN KAFLG, +IFN KIFLG, + ldb 1,4 ;*** get byte + cain 1,12 + jrst psdel2 ;special handling for lf + tlne 7,(1B15+1b16) ;imlac OR TEC + JRST [PUSHJ PPP,PSDELC ;;;MOVei 1,177 + JFCL ;ILLEGAL OR LINE EMPTY + JRST PSDEL1] + pbout +psdel1: move 10,4 + PUSHJ PPP,dbp ;decr. byte pointer + move 4,10 + POPJ PPP, + +psdel2: hrroi 1,[asciz /^^ +/] + psout + jrst psdel1 + +psbaw: trz 7,1 ;backspace word + move 10,5 + move 11,4 + PUSHJ PPP,countb ;how many bytes left + jumpe 11,psbal + tlne 7,(1B15+1b16) ;imlac OR TEC + jrst psbaw1 + hrroi 1,[asciz /__ /] + psout +psbaw1: IFN KAFLG, + IFN KIFLG, + ldb 1,4 ;*** + cain 1,12 ;line feed is special + jrst psbaw3 + caie 1,40 ;space + cain 1,11 ;tab + jrst [ trnn 7,1 + jrst .+2 + POPJ PPP,] + tro 7,1 ;set char. found flag +;;; movei 1,177 +;;; tlne 7,(1b16) ;imlac +;;; pbout + TLNN 7, (1B15+1B16) ;IMLAC OR TEC + JRST PSBAW2 + PUSHJ PPP,PSDELC ;DO DELETE + JFCL ;DON'T WORRY IF EMPTY + +psbaw2: aos 16 ;incr. byte count + move 10,4 + PUSHJ PPP,dbp ;decr. byte pointer + move 4,10 + move 10,5 + move 11,4 + PUSHJ PPP,countb + jumpn 11,psbaw1 ;not done yet + POPJ PPP, + +psbaw3: trne 7,1 ;already char. found + POPJ PPP, ;yes, all done + hrroi 1,[asciz /^^ +/] + psout + jrst psbaw2 + +pslf: movei 1,15 + pbout ;send line feed + movei 1,12 + jrst pscha + +psmod: tlne 7,(1b1+1B15+1b16) + POPJ PPP, ;not for imlac or if in rubout mode + movei 1,100 + rfmod + move 15,2 ;save in ac15 + trz 2,3b25 ;reset echo mode + sfmod + POPJ PPP, + +psrmod: skipn 2,15 ;echo mode saved + POPJ PPP, ;no + push PPP,1 + movei 1,100 + sfmod + setz 15,0 ;reset flag + pop PPP,1 + POPJ PPP, + +IFE IMSSSW, +IFN IMSSSW,< +PSDELC: MOVEI 1, 101 ;PRIMARY OUTPUT + DELCH + JFCL ;*** + 1 - NOT TTY - SHOULDN'T GET HERE + POPJ PPP, ;+ 2 - EMPTY LINE, NO SKIP + JRST [AOS (PPP) ;+ 3 -- SKIP IF DONE OK + POPJ PPP,] + JFCL ;*** + 4 - IF NOT DISPLAY + POPJ PPP, ;A LOZER +>;END OF IMSSS + + psbal: move 4,PSTACS+1 ;*** del line + move 5,4 + move 16,PSTACS+2 ;*** +psbal1: movei 1,"#" + pbout + pbout + movei 1,37 + pbout + tlz 7,(1b1) ;reset rubout mode + PUSHJ PPP,psrmod ;reset echo mode + tlnn 6,(1b1) ;optioanal string + POPJ PPP, ;no + move 2,PSTACS+5 ;*** + jumpg 2,psbal2 + caml 2,[ 777777000000 ] + hrli 2, 440700 +psbal2: IFN KAFLG, + IFN KIFLG, + ildb 1,2 ;*** + jumpe 1,Scpopj ;*** to POPJ PPP, + pbout + jrst psbal2 ;keep looping + +psret: PUSHJ PPP,psbal1 ;clean up at end of line + move 10,5 + move 11,4 + PUSHJ PPP,countb ;count bytes left + move 2,5 +psret1: sojl 11,Scpopj ;*** to popj PPP, - no more +IFN KAFLG, +IFN KIFLG, + ildb 1,2 ;*** + cain 1,12 ;line feed + movei 1,37 ; make eol + pbout + jrst psret1 + +psend: movem 4,PSTACS+1 ;*** + movem 16,PSTACS+2 ;*** + pop PPP,1 ;time + pop PPP,3 + pop PPP,2 + movei 1,100 + sfcoc ;reset tty modes + pop PPP,2 + sfmod +;*** open + HRLZI 17,PSTACS ;restore FAIL ACS + BLT 17,17 + SETZM PSTFLG ;FLAG OUT SAFELY + JRST @.PSTIN +;*** close + +IFN IMSSSW,< +pstim: ldb 3, [point 8, 6, 17] ; do timing + TIME + sub 1, -1(PPP) + lsh 1, -^d10 ; conv to seconds + sub 3, 1 + jumple 3, pstim1 + aos (PPP) ; double skip + move 1,3 ; return time lept +pstim1: POPJ PPP, +>;END OF IMSSS + +BEND PSTIN + +>;END IFE PSTISW >;NOT20 + +>;END TNX + + END STRT diff --git a/src/sail/fail.loader b/src/sail/fail.loader new file mode 100644 index 00000000..962d848e --- /dev/null +++ b/src/sail/fail.loader @@ -0,0 +1,4 @@ +m sail;jobdat rell +m sail;stktrn rell +m sail;fail rell +m sail;fail biny diff --git a/src/sail/stktrn.39 b/src/sail/stktrn.39 index 2b6c11cd..ee3aafdf 100644 --- a/src/sail/stktrn.39 +++ b/src/sail/stktrn.39 @@ -2,26 +2,26 @@ TITLE STINK Translator -T_1 -STOBLK_2 -STNWD_4 -STOWD_5 -STBTYP_6 -STOSBC_7 -STNSBC_10 -STNBLK_11 -STCKS_12 -STCODE_13 -STNSBL__14 -BC_14 -STP_15 -P_17 +T=1 +STOBLK=2 +STNWD=4 +STOWD=5 +STBTYP=6 +STOSBC=7 +STNSBC=10 +STNBLK=11 +STCKS=12 +STCODE=13 +STNSBL==14 +BC=14 +STP=15 +P=17 -INTGLB__20 -STNBT__21 -STOSBL__22 -STNBL__40 -STGSTL__41 +INTGLB==20 +STNBT==21 +STOSBL==22 +STNBL==40 +STGSTL==41 INTERNAL STKTRN EXTERNAL GBOUT1 @@ -40,11 +40,11 @@ STKTRN: MOVEM P,STACS+17 ;141 MOVEI STOSBC,0 HLRZ STBTYP,(BC) STBINT: HRRZI STNBLK,STNBUF ;156 - MOVE STP,[-41,,STGSTU] + MOVE STP,[-STGSTL,,STGSTU] SETZB STCKS,STNBUF MOVE T,[STNBUF,,STNBUF+1] BLT T,STGPTR-1 - HRROI STNSBC,777777 + HRROI STNSBC,-1 SETZB STNWD,STGSTU CAILE STBTYP,STNBT HALT . @@ -56,11 +56,12 @@ STBINT: HRRZI STNBLK,STNBUF ;156 HRLS BC HRRI BC,STNBUF MOVEM BC,STACS+14 - SKIPGE STBDSP(6) -STSKRT: AOS (P) ;200 - MOVSI P,STACS - BLT P,P - POPJ P, + SKIPGE STBDSP(STBTYP) +STSKRT: AOS (P) ;200 + MOVSI P,STACS + BLT P,P + POPJ P, + STBDSP: 0,,STKBLK ;204 3,,STREL 10,,STSYM @@ -79,11 +80,12 @@ STBDSP: 0,,STKBLK ;204 25,,STLVAR 20,,STGLBS 16,,STENT -STBMPR: LDB T,[221106,,STBDSP] ;226 + +STBMPR: LDB T,[221100,,STBDSP(STBTYP)] ;226 DPB T,[310700,,STNWD] CAIE T,1 JRST STPUT - LDB T,[331006,,STBDSP] + LDB T,[331000,,STBDSP(STBTYP)] DPB T,[001000,,STNWD] STPUT: MOVEM STNWD,(STNBLK) ;234 ADD STNBLK,[1,,1] @@ -116,17 +118,17 @@ STCKIT: JCRY0 .+1 ;264 JRST STSQUZ+3] POPJ P, STOUT: PUSH P,STCODE ;270 - MOVE STCODE,STBTYP - HLRZ BC,STNBLK - MOVNS BC - HRLI BC,STNBUF - MOVSS BC - PUSHJ P,GBOUT1 - POP P,STCODE - POPJ P, -STGET: MOVE 5,(STOBLK) ;301 - SOJL 7,STGET0 - ILDB STCODE,STGPTR + MOVE STCODE,STBTYP + HLRZ BC,STNBLK + MOVNS BC + HRLI BC,STNBUF + MOVSS BC + PUSHJ P,GBOUT1 + POP P,STCODE + POPJ P, +STGET: MOVE 5,(STOBLK) ;301 + SOJL 7,STGET0 + ILDB STCODE,STGPTR AOBJN STOBLK,CPOPJ POPJ P, STGET0: HRLI T,440200 ;306 @@ -153,12 +155,12 @@ STSYM1: PUSHJ P,STGET ;327 PUSHJ P,STSQUZ PUSHJ P,@STSDSP(1) JUMPL STOBLK,STSYM1 - PUSHJ P,stputf + PUSHJ P,STPUTF SKIPN STOWD,STGSTU POPJ P, CAME STNBLK,[000002,,STNBUF+2] PUSHJ P,STOUT - MOVEI STBTYP,20 + MOVEI STBTYP,INTGLB PUSHJ P,STBINT POPJ P, STSQUZ: LDB T,[400400,,STNWD] ;346 @@ -167,24 +169,26 @@ STSQUZ: LDB T,[400400,,STNWD] ;346 CAMGE STNWD,[000606,,500000] JRST [IMULI STNWD,50 JRST STSQUZ+3] -STSYM2: DPB T,[400400,STNWD] +STSYM2: DPB T,[400400,,STNWD] POPJ P, + STSDSP: STOP ;355 STIGS STLCL STBN STOP - STIGS-1 + STGLHF STOP STOP STOP - STIGS-1 + STGLHF STLCL STOP STGRQ STIGS-1 STOP STOP + STOP: HALT . ;375 STBN: TLZ STNWD,100000 STLCL: DPB STCODE,[410200,,STNWD] ;377 @@ -193,7 +197,7 @@ STLCL: DPB STCODE,[410200,,STNWD] ;377 MOVEM STNWD,1(STNBLK) ADD STNBLK,[2,,2] POPJ P, - JFCL +STGLHF: JFCL STIGS: AOS STGSTU ;406 PUSH STP,STNWD PUSH STP,STSVAL @@ -209,7 +213,7 @@ STGLBS: MOVEI STCODE,0 ;414 ADD STP,[3,,3] JUMPGE STP,[HALT .] SOJG STOWD,STGLBS - PUSHJ P,stputf + PUSHJ P,STPUTF POPJ P, STGRQ: JUMPGE STOWD,STIGS ;427 TLNN STOWD,100000 @@ -227,10 +231,10 @@ STNAME: PUSHJ P,STGET ;441 MOVEM STNWD,STPRGN JUMPGE STOBLK,CPOPJ PUSHJ P,STGET - TRNE STOWD,777777 + TRNE STOWD,-1 HALT . POPJ P, -STEND: PUSHJ P,STGET ;452 +STEND: PUSHJ P,STGET ;452 HRLI STOWD,STGPTR-1 MOVEM STOWD,STNBUF SETZM STNBUF+1 @@ -260,7 +264,7 @@ STENT1: PUSHJ P,STGET MOVEM STNWD,(STNBLK) ADD STNBLK,[1,,1] JUMPL STOBLK,STENT1 - JRST stputf + JRST STPUTF STKBLK: MOVEI STNBLK,STNBUF ;511 ADD BC,[1,,1] MOVE STOWD,(BC)