From 8d9c981bb639eafd3dae5c34d862062fd7bf01a2 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Sun, 16 Aug 2020 23:45:00 +0100 Subject: [PATCH 01/10] Call Muddle objects BIN rather than REL. This matches names recorded in MUDSYS; from 1977. Using BIN rather than REL is a characteristic of early MIDAS. --- src/mudsys/assem.xfile | 68 +++++++++++++++++++++--------------------- src/mudsys/mud56.stink | 68 +++++++++++++++++++++--------------------- 2 files changed, 68 insertions(+), 68 deletions(-) diff --git a/src/mudsys/assem.xfile b/src/mudsys/assem.xfile index 06b8dccbd..bfb0b60a8 100644 --- a/src/mudsys/assem.xfile +++ b/src/mudsys/assem.xfile @@ -1,38 +1,38 @@ :Build TS MDL for ITS -:midas;324 pure -:midas;324 specs -:midas;324 const -:midas;324 ldgc -:midas;324 utilit -:midas;324 uuoh -:midas;324 mudits -:midas;324 mappur -:midas;324 core -:midas;324 atomhk -:midas;324 interr -:midas;324 nfree -:midas;324 gchack -:midas;324 readch -:midas;324 agcmrk -:midas;324 reader -:midas;324 print -:midas;324 bufmod -:midas;324 arith -:midas;324 maps -:midas;324 primit -:midas;324 stbuil -:midas;324 eval -:midas;324 decl -:midas;324 main -:midas;324 mudsqu -:midas;324 fopen -:midas;324 putget -:midas;324 create -:midas;324 save -:midas;324 ipc -:midas;324 agc -:midas;324 amsgc -:midas;324 initm +:midas;324 pure bin_pure +:midas;324 specs bin_specs +:midas;324 const bin_const +:midas;324 ldgc bin_ldgc +:midas;324 utilit bin_utilit +:midas;324 uuoh bin_uuoh +:midas;324 mudits bin_mudits +:midas;324 mappur bin_mappur +:midas;324 core bin_core +:midas;324 atomhk bin_atomhk +:midas;324 interr bin_interr +:midas;324 nfree bin_nfree +:midas;324 gchack bin_gchack +:midas;324 readch bin_readch +:midas;324 agcmrk bin_agcmrk +:midas;324 reader bin_reader +:midas;324 print bin_print +:midas;324 bufmod bin_bufmod +:midas;324 arith bin_arith +:midas;324 maps bin_maps +:midas;324 primit bin_primit +:midas;324 stbuil bin_stbuil +:midas;324 eval bin_eval +:midas;324 decl bin_decl +:midas;324 main bin_main +:midas;324 mudsqu bin_mudsqu +:midas;324 fopen bin_fopen +:midas;324 putget bin_putget +:midas;324 create bin_create +:midas;324 save bin_save +:midas;324 ipc bin_ipc +:midas;324 agc bin_agc +:midas;324 amsgc bin_amsgc +:midas;324 initm bin_initm : To link and initialize: :stinkm diff --git a/src/mudsys/mud56.stink b/src/mudsys/mud56.stink index f94b02461..5a6168e64 100644 --- a/src/mudsys/mud56.stink +++ b/src/mudsys/mud56.stink @@ -1,36 +1,36 @@ -MPUREL -MSPECSL -MCONSTL -MLDGCL -MUTILITL -MUUOHL -MMUDITSL -MMAPPURL -MCOREL -MATOMHKL -MINTERRL -MNFREEL -MGCHACKL -MREADCHL -MAGCMRKL -MREADERN -MPRINTN -MBUFMODN -MARITHN -MMAPSN -MPRIMITN -MSTBUILL -MEVALL -MDECLL -MMAINL -MMUDSQUL -MFOPENL -MPUTGETL -MCREATEL -MSAVEL -MIPCL -MAGCN -MAMSGCN -MINITML +MPURE BINL +MSPECS BINL +MCONST BINL +MLDGC BINL +MUTILIT BINL +MUUOH BINL +MMUDITS BINL +MMAPPUR BINL +MCORE BINL +MATOMHK BINL +MINTERR BINL +MNFREE BINL +MGCHACK BINL +MREADCH BINL +MAGCMRK BINL +MREADER BINN +MPRINT BINN +MBUFMOD BINN +MARITH BINN +MMAPS BINN +MPRIMIT BINN +MSTBUIL BINL +MEVAL BINL +MDECL BINL +MMAIN BINL +MMUDSQU BINL +MFOPEN BINL +MPUTGET BINL +MCREATE BINL +MSAVE BINL +MIPC BINL +MAGC BINN +MAMSGC BINN +MINITM BINL ? From 1a483f1a8383a8d4e20084628efb7bbe22efb940 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Sun, 16 Aug 2020 23:46:21 +0100 Subject: [PATCH 02/10] Tell STINK to keep symbols for all objects. This matches TS MUD54 from 1977, and makes debugging easier. --- src/mudsys/mud56.stink | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/mudsys/mud56.stink b/src/mudsys/mud56.stink index 5a6168e64..a50585cbf 100644 --- a/src/mudsys/mud56.stink +++ b/src/mudsys/mud56.stink @@ -13,12 +13,12 @@ MNFREE BINL MGCHACK BINL MREADCH BINL MAGCMRK BINL -MREADER BINN -MPRINT BINN -MBUFMOD BINN -MARITH BINN -MMAPS BINN -MPRIMIT BINN +MREADER BINL +MPRINT BINL +MBUFMOD BINL +MARITH BINL +MMAPS BINL +MPRIMIT BINL MSTBUIL BINL MEVAL BINL MDECL BINL @@ -29,8 +29,8 @@ MPUTGET BINL MCREATE BINL MSAVE BINL MIPC BINL -MAGC BINN -MAMSGC BINN +MAGC BINL +MAMSGC BINL MINITM BINL ? From f375c28a81ddee14a3e4fcdbaab4a90321e71693 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Sun, 16 Aug 2020 23:51:25 +0100 Subject: [PATCH 03/10] Adjust link order. This matches a TS MUD from 1977, and is the same as TS MUD54 with the addition of SGC. It's nearly the same as the Tenex order we had already. There are a few differences between 54 and 56: - CONST is new in 56; - Three source files in 54 were merged into others in 56: TENTAB into READER, FLOATB into PRINT, and CHAN into FOPEN; - DISPLA, which went between CREATE and SAVE in 54, is missing in 56. --- src/mudsys/assem.xfile | 4 ++-- src/mudsys/mud56.stink | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/mudsys/assem.xfile b/src/mudsys/assem.xfile index bfb0b60a8..0a1a11e1d 100644 --- a/src/mudsys/assem.xfile +++ b/src/mudsys/assem.xfile @@ -12,7 +12,7 @@ :midas;324 interr bin_interr :midas;324 nfree bin_nfree :midas;324 gchack bin_gchack -:midas;324 readch bin_readch +:midas;324 ipc bin_ipc :midas;324 agcmrk bin_agcmrk :midas;324 reader bin_reader :midas;324 print bin_print @@ -27,9 +27,9 @@ :midas;324 mudsqu bin_mudsqu :midas;324 fopen bin_fopen :midas;324 putget bin_putget +:midas;324 readch bin_readch :midas;324 create bin_create :midas;324 save bin_save -:midas;324 ipc bin_ipc :midas;324 agc bin_agc :midas;324 amsgc bin_amsgc :midas;324 initm bin_initm diff --git a/src/mudsys/mud56.stink b/src/mudsys/mud56.stink index a50585cbf..80fa5eb54 100644 --- a/src/mudsys/mud56.stink +++ b/src/mudsys/mud56.stink @@ -11,7 +11,7 @@ MATOMHK BINL MINTERR BINL MNFREE BINL MGCHACK BINL -MREADCH BINL +MIPC BINL MAGCMRK BINL MREADER BINL MPRINT BINL @@ -26,9 +26,9 @@ MMAIN BINL MMUDSQU BINL MFOPEN BINL MPUTGET BINL +MREADCH BINL MCREATE BINL MSAVE BINL -MIPC BINL MAGC BINL MAMSGC BINL MINITM BINL From 7de51e45b2b6b601248150d91c9da8d8cd908065 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Aug 2020 01:32:32 +0100 Subject: [PATCH 04/10] Add reconstruction of MIDAS 73. This was edited from later versions of the source to match MUDDLE; TS MIDAS circa 1973, which was built with MOBY==0. The program itself dates from no later than 1971. Comments, and results when built with other options, are probably not historically accurate. MIDAS 73 is useful because 74 and all later versions have completely rewritten code for relocatable output (and for IO), and they don't support some of STINK's features correctly (or at all). A ported version of MIDAS 73 was still being used to build Muddle in the 1980s, going by midas.exe.5. --- build/misc.tcl | 6 + src/midas/midas.73 | 8242 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 8248 insertions(+) create mode 100644 src/midas/midas.73 diff --git a/build/misc.tcl b/build/misc.tcl index f14f434ae..c13dc8a64 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -24,6 +24,12 @@ expect "PURIFIED" respond "*" ":pdump midas; ts 77\r" respond "*" ":kill\r" +# MIDAS 73, bootstrapped from 77. +respond "*" ":midas;77\r" +respond "MIDAS.77" "MIDAS; TS 73_MIDAS; MIDAS 73\r" +respond "*" ":midas;73\r" +respond "MIDAS.73" "MIDAS; TS 73_MIDAS; MIDAS 73\r" + # MACTAP respond "*" ":midas;324 sysbin;_sysen2; mactap\r" expect ":KILL" diff --git a/src/midas/midas.73 b/src/midas/midas.73 new file mode 100644 index 000000000..134f5790e --- /dev/null +++ b/src/midas/midas.73 @@ -0,0 +1,8242 @@ +; Reconstructed 2020 from a MIDAS 73 binary and later source. +; Notes from the reconstruction are marked with XXX below. + +TITLE MIDAS 6 + + ;CONDITIONALS IN FOLLOWING FOR COMPATIBILITY WITH OLD AND NTS VERSIONS OF MIDAS +IFE <17-.TYPE IFNDEF >,[DEFINE IFNDEF NAME +IFE <17-.TYPE NAME >*<3-.TYPE NAME >,TERMIN ;ASSEMBLE IF NAME NOT DEFINED +] +IFNDEF IFDEF,[DEFINE IFDEF NAME +IFN <17-.TYPE NAME >*<3*.TYPE NAME >,TERMIN ;ASSEMBLE IF NAME DEFINED +] + +IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING +IFNDEF MOBY,MOBY==1 ;NON-ZERO TO ASSEMBLE MOBY SYMBOL TABLE, ETC. +IFE TS,1PASS +.YSTGW +FOO==. + +LOC 41 + JSR ERROR +IF2,IFN TS,JSR TSINT ;PDL OVERFLOW AND/OR OTHER TS PROBLEMS + +LOC FOO +.NSTGW + +IFNDEF A1PSW,A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF TSSYMS,TSSYMS==1 ;.UAI, .UAO, .BAI, .BAO, .UII, .UIO, .BII, .BIO - EVER USE THEM? +IFNDEF LISTSW,LISTSW==0 ;LISTING FEATURE FOR MAINT PROGS + +;AC DEFS + +FF"=0 ;FLAGS +P=1 +I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +AA=3 +A=4 +B=5 +C=6 +D=7 +T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T +TT=11 +SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=13 +F=14 +CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=16 ;" " " +TM=17 ;SUPER TEMPORARY + +;FF FLAGS NOT PUSHED +;LEFT HALF +PPSS=400000 ;ONE IF PUNCHING PASS MUST BE SIGN +INDEFF==200000 ;SET IF LOC OR OFFSET IS INDEF +SKILF==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +VOT=40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +PTPF==20000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP + +OUTF==10000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) + +;FF RIGHT HALF FLAGS + +FIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +IPSYMS==200000 ;ONE IF SYM PUNCH DESIRED +LOCF==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +NPSS=40000 ;ONE IF TWO PASS ASSEMBLY +PSS=20000 ;ONE ON PASS 2 +MACRCH=10000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN + +INVTF==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +NLIKF==2000 ;TEMPORARILY SUPPRESS ADR LINKING +GLOLOC==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +BITF==400 ;SET IF CURRENT SPEC IS 111 +MRSW=200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) +TTYRCH==100 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +GLOFFS==40 + + ;INDICATOR REGISTER + +;LEFT HALF +GLI==1 ;SET ON " CLEARED EACH SYL +VAR==2 ;SET ON ' " " " +FLO==4 ;SET ON . " " " +DECP==10 ;DECIMAL PREFER +UARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +LSRET==40 ;RETURN FROM < +MNSFLG==100 ;SET IF LAST OP WAS MINUS +WRDF==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +NPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +UNRCHF==2000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +MWRD==4000 ;SET ON MULTIPLE WORD +MWRD1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT + + ;PCNTB STUFF + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +;RIGHT HALF + +FLD==1 ;SET IF FLD NOT NULL +SYL==2 ;SET IF L-N SEEN IN CURRENT SYL +LET==4 ;SET IF LET SEEN IN CURRENT SYL +DEF==10 ;SET IF CURRENT EXPR DEFINED +LLET==20 + +COM==40 ;SET IF CURRENT QUAN IS COMMON +PERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +EQLF==200 ;ONE DURING READING WORD TO RIGHT OF = +AIOWD==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +CONT==1000 ;SET IF NOT OK TO END BLOCK +PSEUDF==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +GMINF==20000 ;SET IF UARI OR BAKARI HAS GOBBLED MINUS +OPFLD==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +IFE TS,[.LIFS .NMAC" +MACL==.NMAC" +.ELDC +.LIFS -.NMAC" +MACL==2000*2 ;LENGTH OF MACTBL +.ELDC +]IFN TS,IFNDEF MACL,MACL==6000 +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==20 ;MAX NO OF DMY ARGS IN DEFINE + +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MAC PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF MIDVRS,MIDVRS"=.FNAM2 +.GLOBAL MIDVRS ;IN CASE USER HAS TYPED IT IN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC Á!B!C!D!E!F +Ý +TERMIN + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + + ;RANDOM MACRO DEFINITIONS + + ;ASSEMBLE BYTE INSTRUCTION POINTING TO CERTAIN BIT + +DEFINE BYB A,B,C +ZZZ=C +ZZ=43 +REPEAT 35.,[IFGE ZZZ,[ ZZZ=ZZZ_1 + ZZ=ZZ-1 +]] +A,[ZZ*10000+100,,B] +TERMIN + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIGE A,ST +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B +IRPS %ADR,,[B] +A,%ADR +TERMIN +TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + HRRZ TM,B + ROT TM,-2 + HLLZ A,3RDWRD(TM) + SKIPGE TM + HRLZ A,3RDWRD(TM) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVEI TM,-ST(B) + ROT TM,-2 + HLLZ A,3RDWRD(TM) + SKIPGE TM + HRLZ A,3RDWRD(TM) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + HRRZ TM,B + ROT TM,-2 + SKIPGE TM + HLRM A,3RDWRD(TM) + SKIPL TM + HLLM A,3RDWRD(TM) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEI TM,-ST(B) + ROT TM,-2 + SKIPGE TM + HLRM A,3RDWRD(TM) + SKIPL TM + HLLM A,3RDWRD(TM) + TERMIN + +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFNDEF LPDL,LPDL"=500 ;LENGTH OF PDL +IFNDEF LCONTB,IFN MOBY,LCONTB==500*5 ;LENGTH OF CONSTANTS TABLE +IFNDEF LCONTB,IFE MOBY,LCONTB==500 +IFNDEF LCNGLO,LCNGLO==200*3 ;LENGTH OF CONST GLO TAB +IFNDEF NCONS,NCONS==10 ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==10 ;MAX # VARIABLES AREAS + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " + +IFNDEF SMK,[ ;SMK MAX # ENTRIES IN SYMBOL TABLE +IFE TS,[.LIFS .NSYMS" +SMK=.NSYMS" +.ELDC +.LIFS -.NSYMS" +SMK=3177*2 ;MAX NO ENTRIES IN SYM TAB +.ELDC +]IFN MOBY,IFN TS,SMK=6177*2 +IFE MOBY,IFN TS,SMK==2177*2 +] +TYPR=(77000) ;UUO, TYPE OUT ASCIZ STRING + +;3RDWRD SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLR==200000 ;R(RH) +3RLL==400000 ;R(LH) +3RLNK==100000 ;R(LINK) +3INI==40000 ;INITIAL SYM +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VP==20000 ;VALUE PUNCHED +3VCNT==1000 ;USED IN CONSTANT +3SKILL==10000 ;SEMI KILL IN DDT +3VAS2==2000 ;VAR SEEN ON PSS TWO WITH ' +3MAS==400 ;MULTIPLE SYMS SAME NAME AT DIFFERENT LEVELS (I.E. KEEP LOOKING + ;AT SYMBOL LOOKUP) + +;CONTROL FLAGS +;LEFT HALF +TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE) +;RIGHT HALF +ARIM==2 ;IF ONE OUT FOR IS RIM +ARIM1==4 +SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS +ARIM10==20 ;PDP-10 RIM + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON +PSUDO==40000 ;PSEUDO OR MACRO +SYMC==100000 ;SYM +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR +UDEFLV==240000 ;UNDEF LOC VAR +DEFGVR==300000 ;DEF GLO VAR +UDEFGV==340000 ;UNDEF GLO VAR +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT + +;LOADER BLOCK TYPES LINK + +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPTRMN==14 +LENTRY==15 +LEXTERN==16 +LTCN==17 + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP +LDROFS==10 + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;VARIABLE STORAGE + +FUNPDL: 0 +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD +T1: 0 ;TEMP +T2: 0 ;TEMP +LSYL: 0 ;VALUE OF LAST SYL BEFORE OPEN (LSSTH, LEFTP, LBRAK) +LSYLR: 0 ;RELOCATION BITS OF " +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +LIMBO: 0 +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +OPT1: 0 ;POINTER TO BKBUF TAB +OPTT1: 0 +OPTT2: 0 +ESL1: 0 ;LEVEL OF CURRENT SYM,,0 +ESL2: 0 ;3RD WORD CURRENT SYM +SADR: 0 ;SYM TAB ADR (INDEX INTO ST) +CONTRL": 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +LEV: 0 ;CURRENT BEGIN END LEVEL,,0 +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +NGCS: 3 +IFN A1PSW,[ +PRGC": -1 ;ONE LESS THAN # TIMES END HAS BEEN INCOUNTERED +OUTN1": -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC": -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LIMBO1: 0 ;UNRCH TEMP; SAVES LAST CHARACTER READ IN +SCONT1: 0 +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PLIM: 0 ;POINTER TO TOP OF CONTAB, HAS ADR OF FIRST UNUSED WORD +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CSQZ: 0 ;SQUOZE COUNTER +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONGLO +NREPC: 0 +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +GETCNR: 105 ;PRIORITY OF UNARY OPS (AOS'D TO CAUSE RIGHT TO LEFT EVALUATION) +ISYMF": -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +PRGNM: 0 ;PROG NAME +GLOBT: 0 ;GLSP1 PUSHED DOWN ONE LEVEL AT GETFLD +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +SCINST: 0 ;STRING CONDITIONAL INSTRUCTION +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +BLOCKF: 0 +AIRPT2: 0 ; " , IRP ONLY, BRACKET COUNT (FOR FLUSHING LIST BRACKETS) +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +VCLOC: 0 ;TEM FOR VARIAB +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM +BYTM: 0 ;-1 FOR IN BYTE MODE +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +CPGN": 0 ; 1 LESS THAN CURRENT PAGE # IN INPUT FILE +CLNN": 0 ; 1 LESS THAN CURRENT LINE # IN INPUT FILE + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +ISAV: 0 ;I FROM FLD AT AGETFLD + +IFN LISTSW,[ +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LISTON": 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF +LISTBF: BLOCK 50. +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +] + +TOPP: 0 ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +BBASE: 0 ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY + +PTAB: (341000+CH1)MACTAB ;BYTE TABLE + (241000+CH1)MACTAB + (141000+CH1)MACTAB + (41000+CH1)MACTAB + (341000+CH1)MACTAB+1 + +PTAB1: (341000)MACTAB + (241000)MACTAB + (141000)MACTAB + (41000)MACTAB + +MACP: 0 ;MAC PDL POINTER +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +GENSM: 0 ;GENERATED SYM COUNT +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +CPTRB: -1 +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +MACNM: 0 ;NAME OF MACRO BEING DEFINED +DCNT: 0 ;USED BY WRQOTE CURRENT DEPTH IN DEFINE-IRP-TERMIN LEVEL +PRCALP: PRCAL ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY +DMYTOP: 0 ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADDR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER + +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS + +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +REDPTB: 0 ;REDPT IN BYTE POINTER FORM +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM + +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +A.QOT2: 0 ;DELIMITER FOR .QUOTE +AIRPT1: 0 ;IRP EXPANSION TEMP, IRPS OR IRPW => (0 => CURRENT DUMMY NOT NULL, -1 => NULL) +CRPTCT: 0 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) + + ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO2 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;ARCH (GET CHAR) SEMIC, RRL1, RREOF, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +HFWDAD: HRRM A,.+1 + HRRI A,(B) + MOVSS B + HLRM A,.+1 + HRLI A,(B) + POPJ P, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + PUSHJ P,(LINK) +PERIOD: +SGTSY1: + TLO I,10 + TROE I,100 + TRO I,4 + ADD SYM,%.SQ(D) + TRO I,2 + SOJGE D,RRL2 + AOJA D,RRL2 + +GETFLD: PUSH P,GLSP2 + PUSH P,GLSP2 + PUSH P,PPRIME + PUSH P,GLOBT + MOVE A,GLSP1 + MOVEM A,GLOBT + MOVEM P,PPRIME + TRZ I,FLD+OPFLD +GETFD1: TLNE I,MWRD + JRST .+3 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,LET + PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: MOVE C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS +GETFD: MOVEI TT,0 ;NO DISP MEANS FD TERMINATOR + TRNE I,SYL + TRO I,FLD + JSP LINK,GETFD2 ;EVALUATE WHATEVER HASN'T BEEN + SUB P,[4,,4] ;NOW POP OFF CRUFT FROM PDL + POP P,GLOBT + POP P,PPRIME + SUB P,[2,,2] + POPJ P, + + ;JSP LINK,GETFDA ;STORE SPECIFICATIONS OF OPERATOR, OPERAND; + ;MAYBE EVALUATE CRUFT ON LEFT + ;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, + ;C ADR OF ROUTINE TO PERFORM OPERATION, TT HAS PRECEDANCE OF OPERATOR + +GETFDA: TRO I,FLD+OPFLD + TRNN I,SYL + AOS TT,GETCNR ;UNARY +GETFD2: CAMN P,PPRIME + JRST GETFD3 ;TOP OF LIST + HLRZ T,(P) ;GET PREC + CAMLE TT,T ;COMPARE TO CURRENT + JRST GETFD3 ;WAIT UNTIL LATER + HRRZ T,(P) + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + ;PDL AS SEEN BY OPERATOR ROUTINES: +GETFD3: PUSH P,GLSP1 ;-3(P) POINTS TO HIGHEST GLOTB ENTRY OF LEFT OPERAND (ALSO JUST BEFORE RIGHT) + PUSH P,B ;-2(P) HAS RELOCATION BITS OF LEFT OPERAND + PUSH P,A ;-1(P) HAS VALUE OF LEFT OPERAND + HRL C,TT + PUSH P,C ;(P) HAS OF OPERATOR + JRST (LINK) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION + MOVEI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JSP LINK,GETFDA + JRST GETFD1 + +MINUS1: MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + EQVI B,0 + ADD B,[1,,0] + HRRI B,1(B) + MOVE T,-3(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,-1(P) ;ADD VALUES + PUSH P,A + MOVE A,-3(P) + PUSHJ P,HFWDAD + MOVE B,A + POP P,A + JRST GETFD4 + +MINUS: MOVEI C,MINUS1 + JRST PLS+1 + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION + MOVEI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION +CBAK2: JSP LINK,GETFDA + JRST GETFD1 + +MULTP1: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE -2(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,-1(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST .+3 +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,-2(P) ;RELOCATION BITS OF LEFT OPERAND + MOVE D,-3(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,-7(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: HRLZ D,B ;MULTIPLY VALUES + IMUL D,T + HLRM D,B + HLLZ D,B + IMUL D,T + HLLM D,B + IMUL A,-1(P) + JRST GETFD4 +MULTP4: (1000+SIXBIT /IRL/) ;ILLEGAL RELOCATION * / + JRST GETFD4 + +DIVID: MOVEI C,DIVID1 + JRST MULTP+1 + +GMUL1: TLNE FF,PPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + (1000+SIXBIT /IMY/) ;ILLEGAL MPY (BOTH OPERANDS GLOBAL DURING PUNCHING PASS) + SKIPA D,-7(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,-1(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE -2(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,-1(P) + IDIV A,-1(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,-7(P) + CAME D,GLSP1 + (1000+SIXBIT /IDV/) ;AT LEAST ONE OF DIVISION OPERANDS GLOBAL DURING PUNCHING PASS + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +IORF: MOVEI C,IORF1 ;\ +LOGIC3: MOVEI TT,30 +LOGIC: JRST CBAK2 + +XORF: MOVEI C,XORF1 ;# + TRNN I,SYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JRST LOGIC3 + +ANDF: MOVEI C,ANDF1 ;& + MOVEI TT,40 + JRST LOGIC + +XORF1: MOVEI D,(XOR A,(P)) + JRST LOGIC1 +IORF1: MOVEI D,(IOR A,(P)) + JRST LOGIC1 +ANDF1: MOVEI D,(AND A,(P)) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: HRLM D,LOGIC2 + JUMPN B,MULTP4 + SKIPE -2(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 +LOGIC2: 777777 + JRST GETFD4 + +CBAKAR: MOVEI C,CBAK1 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + MOVEI TT,100 + JRST CBAK2 + +CBAK1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + MOVE T,A + MOVE A,-1(P) + LSH A,(T) + JRST GETFD4 + + ;SEMICOLON (GET HERE FROM RR8) + +SEMIC": PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + CAIE A,15 ;CAIG A,15 ;SEE IF SPECIAL + JRST SEMIC ;XCT RPATAB(A) ;SPECIAL => DO SOMETHING +RRU3: PUSH P,[RRL2A] + JRST RRU1 + +RBRAK: SKIPN CONDEP ;RIGHT BRACKET + JRST RRL2 ;NOT IN CONSTANT => IGNORE + JRST RR10 ;IN CONSTANT => TERMINATE WORD + +BCOMP: SKIPE CH1,CPTR + SOS CH1 + IDIVI CH1,A + MOVE CH2,PTAB1(CH2) + ADD CH2,CH1 + MOVEM CH2,CPTRB + POPJ P, + +RRU: SKIPA A,LIMBO1 ;GET HERE WHEN UNRCHF SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 +RRLM2: PUSHJ P,MRCH2C +RRU1: XCT RRR1 + JRST RRL1B + SKIPG CPTRB + PUSHJ P,BCOMP + JRST RRLM4 + +RR4A: AOS CPGN + SETZM CLNN + AOS CLNN + JRST RR4 + +GETSYL: TDZA I,[UARI+NPRC+DECP,,PERI] +GTSL1: TDZ I,[DECP,,PERI] ;RECURSION POINT FROM UA3 TO GET RIGHT OPERAND TO ^ OR _ + CLEARB SYM,NUMTAB + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + TDZ I,[FLO+VAR+GLI+LSRET,,LET+SYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +RRL2A: MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + TRNE FF,MACRCH + JRST RR4 + CAIN A,12 + AOS CLNN + CAIN A,14 + JRST RR4A + +RR4: HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNN I,SYL ;NOT SET => SYLLABLE TERMINATOR: SYL? + JRST CABPOP ;NO SYL + TRNE I,LET + POPJ P, ;SYL HAS LETTERS + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,NPRC + PUSHJ P,NUMSL +RR6: TLNN I,FLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + (2000+SIXBIT /EPO/) ;EXPONENT OVERFLOW +RR9: TLZ I,GLI+VAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL + JRST CLBPOP ;CLEAR OUT B (RELOCATION BITS OF VALUE) + +LOWRCS: CAIG A,"z ;MAKE A LOWER CASE + CAIG A,"a-1 + POPJ P, + SUBI A,"a-"A + POPJ P, + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,SYL ;SET FLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + JRST RRL2 ;FALL BACK IN + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER + +RRL1: PUSHJ P,RCH +RRL1B: PUSHJ P,LOWRCS + XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,LLET\LET\SYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,LLET\SYL ;NUMBERS RETURN, SET FEWER FLAGS +RRL1A: SOJGE D,RRL1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RRL1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP +RR: TLZE I,UNRCHF ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES (SOMETIMES RETURN HERE FROM RREOF) +RRR1: TRNN FF,MACRCH + JRST RRL1 + +RRLM1A: SKIPG CPTRB + PUSHJ P,BCOMP +RRLM1: ILDB A,CPTRB + AOS CPTR + TRZE A,200 + JRST RRLM2 +RRLM4: PUSHJ P,LOWRCS + XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,LLET\LET\SYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,LLET\SYL ;NUMBERS RETURN, SET FEWER FLAGS +RRLM4A: SOJGE D,RRLM1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RRLM1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP +UT141: PUSHJ P,INCHR3 + JRST RRU1 + +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES + SKIPGE HIGHPT(AA) + JRST MAKNM3 + MOVE T,LOWPT(AA) + MUL T,ARADIX(AA) + MOVEM TT,CH1 ;SAVE UPDATED LOWPT LESS NEW DIGIT + MOVE TT,HIGHPT(AA) + ADD CH1,A ;ADD DIGIT TO LOW PART + TLZE CH1,400000 + AOS T ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL TT,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD TT,T ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD + TLNE I,FLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM TT,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM CH1,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNUM+2 ;NOW DO ALL THIS FOR NEXT RADIX + POPJ P, + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,FLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: 0 + + ;DECIPHER A VALUE FROM NUMTABS + ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B + +NUMSL: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + PUSHJ P,RDXSEL ;SELECT RADIX, LEAVE INDEX IN D + MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + TLNN I,FLO + JRST FIX ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX-1 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MUL B,ARADIX(D) ;MULTIPLY LOW PART BY RADIX + MUL AA,ARADIX(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,LET + POPJ P, + + TLZ I,FLO +FIX: LSHC A,45 + LSHC AA,-1 + JUMPE AA,.+2 + (2000+SIXBIT /XSG/) ;SIG CHECK + POPJ P, + +RDXS1: MOVEI D,0 ;ENTRY FOR D NOT ALREADY CLEAR OR STRANGE DEFAULT +RDXSEL: TLNE I,DECP ;SELECT A RADIX, LEAVE IN D THE INDEX INTO NUMTABS + MOVEI D,1 ;. => PREFER DECIMAL + TLNE I,VAR + MOVEI D,2 ;' => PREFER OCTAL, WINS OVER . SO FLOATING POINT NUMBER MAY BE OCTAL + TLNE I,GLI + MOVEI D,0 ;" => PREFER CURRENT RADIX, WINS OVER ALL ELSE + POPJ P, + +NUMSL8: LSH B,1 ;EXPONENT NEGATIVE: NORMALIZE NOW + ASH AA,1 + TLZE B,400000 + TRO AA,1 +NUMSL1: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + IDIV AA,ARADIX(D) ;DIVIDE HIGH PART BY APPROPRIATE RADIX + ADD B,A + MOVEI A,0 ;NOW TURN A/B INTO DOUBLE PRECISION POSITIVE VERSION OF C(B) + TLZE B,400000 + MOVEI A,1 + DIV A,ARADIX(D) + MOVE B,A + AOJL T,NUMSL1 + JRST NUMSL7+1 + +UPARR: TRON I,SYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,LET + (2000+SIXBIT /ILF/) ;ILF, LETTERS IN LEFT OPERAND TO UPARROW + PUSHJ P,NUMSL ;DECIPHER NUMTABS + TLO I,UARI ;SET INDICATOR (USED BY BACKARROW) + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + TLZ I,UARI + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,RDXS1 ;SELECT RADIX (I WAS SAVED & RESTORED BY UA3) + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + TLNE I,FLO + JRST RR7 ;FLOATING, ALREADY SET UP OK + ASHC AA,(B) ;FIXED, FIX IT NOW + JUMPE AA,.+2 + (2000+SIXBIT /XSG/) ;SIG CHECK + MOVEI B,0 +RR7: MOVE C,CDISP + TLO I,NPRC + JRST RR8 + +UA3: JSP LINK,SGTSY ;PUSH I,AA,A,B + PUSHJ P,RCH + CAIN A,"- + TROA I,GMINF + TLO I,UNRCHF + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO I,UNRCHF + PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNN I,LET + TLNE I,FLO + (2000+SIXBIT /ILF/) ;ILF +UAR2: TRZN I,GMINF + SKIPA T,A + MOVN T,A + MOVEI TT,SGTSY1 + JSP LINK,POPLIS + POPJ P, + +UAR1: TLO I,LSRET + PUSHJ P,LSSTH + PUSH P,A + PUSHJ P,RCH + CAIN A,"! + JRST .-2 + HLRZ T,GDTAB(A) + CAIE A,". + CAIE T,(POPJ P,) + (2000+SIXBIT /ILF/) + HRRZ A,GDTAB(A) + MOVE A,DTB-40(A) + MOVEM A,CDISP + POP P,A + JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +BAKAR: TLNE I,UARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,SYL + TRNE I,LET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,NPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,FLO + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +DQUOTE: TRON I,SYL + JRST DQ1A + TLO I,GLI + JRST RRL2 + +UPCTRC: PUSHJ P,RCH + TRZA A,100 +DQ1A: PUSHJ P,RCH +DQ1: PUSH P,A + PUSHJ P,GETSYL + TROE I,SYL + (2000+SIXBIT /ILF/) + JRST POPAJ + +SQUOTE: TRON I,SYL + JRST .+3 + TLO I,VAR + JRST RRL2 + PUSHJ P,RCH + SUBI A,40 + TRNN A,100 + JUMPGE A,DQ1 + 2000,,(SIXBIT /N6B/) ;NOT SIXBIT + JRST DQ1 + + ;JSP CH2,RR2 => DIGIT (FROM GDTAB) + +RR2: SUBI A,60 ;CONVERT TO VALUE + TRNE I,LET + JRST RR2A ;NAME + TRZE I,PERI + TLO I,FLO ;FLOATING POINT + PUSHJ P,MAKNUM ;UPDATE NUMTABS +RR2A: XCT NSQTB(A) ;UPDATE SYM + JRST 1(CH2) ;SKIP-RETURN + +NSQTB: IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + + ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SAVWD1: PUSH P,LSYL + PUSH P,LSYLR + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSHJ P,(LINK) +SAVL1=. + + ;(ALMOST) GENERALIZED POP ROUTINE + +POPLIS: POP P,F ;FIRST ENTRY ON PDL PC STORED BY PUSHJ AT END OF PUSH ROUTINE + CAIE TT,(F) ;TT SHOULD BE INDEPENDENTLY SET UP BY CALLING ROUTINE W/ SAME VALUE + (SIXBIT /IAE/) ;ROUTINE VERIFIES THIS AND KILLS ASSEMBLY IF DISAGREE + +POPLS1: HLRZ F,-2(TT) ;NOW FOR THE ACTUAL POPPING: GET NEXT PREV. INSTRUCTION IN PUSH ROUTINE + CAIE F,(PUSH P,) ;IF NOT PUSH + JRST (LINK) ;THEN DONE, RETURN + POP P,@-2(TT) ;PUSH, POP OFF WORD PUSHED + SOJA TT,POPLS1 + + ;POP OFF WHAT PUSHED BY SAVWLD (FOR WHICH POPLIS DOESN'T WORK) + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + (SIXBIT /IAE/) + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(WRDF)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + HRR A,CPTR + HRL A,BBASE + PUSH F,A + HRL B,LIMBO1 + TLZE I,UNRCHF + TLO B,400000 + TROE FF,MACRCH + TLO B,200000 + TRZE FF,TTYRCH + TLO B,100000 + PUSH F,B + MOVE A,[254000,,MRCH] + MOVEM A,GETCHR + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + POP F,A + TLZ I,UNRCHF + TLZE A,400000 + TLO I,2000 + TRZ FF,MACRCH+TTYRCH + TLZE A,200000 + TRO FF,MACRCH + TLZE A,100000 + TRO FF,TTYRCH + HLRZM A,LIMBO1 + TRNN FF,TTYRCH + JRST POPEM2 + MOVE A,[PUSHJ P,RCHA] + MOVEM A,GETCHR + JRST POPEM1 +POPEM2: MOVE A,[PUSHJ P,INCHR] + TRNN FF,MACRCH + MOVEM A,GETCHR +POPEM1: POP F,B + HRRM B,CPTR +PSHM1: SETOM CPTRB + MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + + ;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) + +ARCH": +RCH: TLZE I,UNRCHF + JRST RCH1 ;RE-INPUT LAST ONE MAYBE GET HERE FROM GETCHR+2 +GETCHR: PUSHJ P,INCHR + CAIN A,12 + AOS CLNN + CAIN A,14 + JRST RCH3 +RCH2: +RCH4: MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFN LISTSW,[ + AOSN PNTSW + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +] +TYPCTL": POPJ P, ;OR JRST SOMEWHERE + +IFN LISTSW,[ +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL +] + +RCH3: SETZM CLNN + AOS CLNN + AOS CPGN + JRST RCH4 + +RCH1: MOVE A,LIMBO1 +IFN LISTSW,CAILE A,15 + POPJ P, +IFN LISTSW,[CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +] + +MRCHR: POP P,B +MRCH: SKIPG CPTRB + PUSHJ P,BCOMP +MRCH2B: ILDB A,CPTRB + AOS CPTR + TRZN A,200 + JRST RCH4 +MRCH2C: PUSH P,B + CAIN A,176 + JRST MRCHR + CAIE A,177 + CAIN A,175 + JRST MRCH1 + MOVE B,A + ADD B,BBASE + MOVE A,(B) + MOVEI B,RCHSAV + PUSHJ P,PUSHEM + HRRM A,CPTR + MOVE A,TOPP + MOVEM A,BBASE + JRST MRCHR + +MRCH1: MOVE B,MACP + POPJ B, ;RETURN AT END OF STRING EXPANSION + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS + PUSH P,A + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + MOVEM A,FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,MRSW + POPJ P, ;RETURN TO .GO + POP P,B + JRST RCH + + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +;MACRO PROC FLAGS (IN LH(LINK)) + +SCEND==200 ;SCAN END +GENF==400 ;GENERATED ARGS +LNSCN==1000 ;ACTIVATE LINE SCAN ON LAST LINE +ALNSCN==2000 ;LINE SCAN ACTIVE +;400000 SAYS COMMAS DO NOT BREAK ARG +RDRPTF==4000 ;REPEAT +LCRIND=10000 ;CR SEEN AFTER RIGHT BRACKET + +RDWRDA: PUSHJ P,ADDTR1 + PUSHJ P,RCH ;ENTRY FROM STRING COND, AREPEAT ETC + TLNE LINK,ALNSCN + JRST RDWR3 ;DONT QUIT UNTIL CR OR LF + CAIN A,LBRKT + JRST RDWR1 ;IF FIRST CHAR LBRACK, READ UNTIL MATCHING RBRACK + CAIN A,"\ ;IF FIRST CHAR \ + JUMPGE LINK,RDWR6 ;AND NORM ARG READ, THEN PROCESS FIELD +RDWR3: CAIE A,15 ;ON CR + CAIN A,12 ;OR LF + JRST RDWR2C ;EXIT + CAIN A,"; ;ON SEMI + JUMPGE LINK,RDWR2D ;ON NORMAL SCAN CAUSE SEMI TO BE REINPUT AND RET +REPT5: CAIN A,", ;IF COMMA + JUMPGE LINK,RDWR2 ;END THIS ARG +RDWR5: PUSHJ P,PUTREL ;NOTA, DEPOSIT THIS CHR + PUSHJ P,RCH ;GET NEXT CHR + JRST RDWR3 ;AND LOOP BACK,NOT CHECKING FOR LBRKT OR \ + +RDWR2D: TLO I,UNRCHF + JRST RDWR2C + +RDWR7: MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 +RDWR2C: TLO LINK,SCEND ;SCAN ENDED +RDWR2: MOVE T,A ;RET LAST CHR IN T + TLNE LINK,RDRPTF ;ON REPEAT, + POPJ P, ;THATS ALL RETURN +RDWR2A: HRL A,PUTCNT ;SAVE COUNT OF LENGTH THIS ARG IN CHRS + HRR A,RDWRDP + HLLM A,-1(A) +STPWR: MOVEI A,375 ;WRITE STOP CODE +PUTREL: MOVE CH1,FREEPT + IDIVI CH1,4 + DPB A,PTAB(CH2) + AOS A,FREEPT + AOS PUTCNT + CAMGE A,MMAXMC + POPJ P, + MOVEM A,GCHI + + ;GARBAGE COLLECT THE MACRO TABLE + +GC: MOVEM 17,GCSV+15 + MOVE 17,[2,,GCSV] + BLT 17,GCSV+14 + SOSE NGCS + JRST NOCORM + .SUSET [.RMEMT,,A] + ASH A,-10. + .CORE 1(A) + JRST NOCORM + MOVEI A,3 + MOVEM A,NGCS + MOVEI A,TEXT8 + ADDM A,MAXMAC + ADDM A,MMAXMC +NOCORM: SETZB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + SETOM CPTRB + MOVE A,[141000,,MACTAB] ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB +SYMMG: MOVSI A,-SMK ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION + ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: AOS A + AOBJN A,.-4 ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG +MSTG1B: PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + (SIXBIT /TMA/) +CRDWR7: POPJ P,RDWR7 + + ;PROCESS FIELD + +RDWR6: SOS RDWRDP ;BACK UP RDWRDP, MAY BE USED BY MACRO IN FIELD + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + (1000+SIXBIT/USM/) + POP P,LINK + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSHJ P,ADDTR1 ;RE-GENERATE DUMMY + PUSH P,CRDWR7 ;RETURN TO RDWR7 +RDWR6A: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,RDWR6A + HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +RDWR1: TDZA C,C ;READ UNTIL RIGHT BRACKET +RDWR1A: PUSHJ P,PUTREL + PUSHJ P,RCHCNT + JRST RDWR1A + + TLNE LINK,RDRPTF + JRST RDWR2 ;REPEAT, SKIP FOLLOWING + +RDWR2B: PUSHJ P,RCH + TLO I,UNRCHF + CAIE A,15 + CAIN A,12 + TLO LINK,SCEND+LCRIND ;CR OR LF + JRST RDWR2 + +PUT1: IDIVI CH1,4 + DPB A,PTAB(CH2) + POPJ P, + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + CAMG A,MAXMAC + POPJ P, + PUSH P,A +MACCUP: PUSHJ P,EXTCOR + MOVEI A,TEXT8 + ADDM A,MAXMAC + ADDM A,MMAXMC + POP P,A + POPJ P, + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + JRST SYMMG2 + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED +MSTG13: SKIPGE GCENDF + JRST GCEND1 ;EXIT + MOVE TT,FREPTS + SKIPL SVF + MOVEM TT,FREEPT + MOVE TT,FRPTBS + SKIPL SVF + MOVEM TT,FREPTB + JRST MSTG + + ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: +USYMG: MOVE T,SYMSTR + MOVEI A,MACCL + JUMPE T,USYMG1 + HRRZ TT,(T) ;GET ADR ON LIST + HRRM A,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + MOVE T,LDRB + JRST GCEND1+2 + +USYMG1: MOVS 17,[2,,GCSV] + BLT 17,17 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +MACCL: MOVSI 17,-14 ;MACRO EXPANSION TIME + PUSH P,2(17) + AOBJN 17,.-1 + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + (SIXBIT /IAE/) + PUSHJ P,REDINC + SKIPN B + TLO I,UNRCHF ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS + MOVEM A,@PRCALP + MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST MAC2A ;NO ARGS SUPPLIED + JUMPE B,MAC4 ;JUMP IF NO DUMMIES IN DEF + TRZE B,200 + TLO LINK,LNSCN +MAC3: PUSH P,B + TLNE LINK,LNSCN + SOJE B,MAC3A +MAC3B: PUSHJ P,RDWRDA + POP P,B + TLNE LINK,SCEND + SOJA B,MAC2 + SOJG B,MAC3 +MAC4: MOVE A,@PRCALP +MAC1: PUSHJ P,REDINC + MOVEM A,@PRCALP + JUMPE B,MAC1A +MAC5: PUSH P,B + TLNE LINK,SCEND + PUSHJ P,GENSYM + TLNN LINK,SCEND + PUSHJ P,RDWRDA + POP P,B + SOJG B,MAC5 +MAC1A: MOVEI B,RCHSV1 ;RETURN TO RCHSV1 ON END OF MACRO + PUSHJ P,PUSHEM ;ENTRY FROM .TTYMAC + MOVE A,@PRCALP + MOVEM A,CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP +MACC2: MOVSI 17,-13(P) + HRRI 17,2 + BLT 17,15 +MACC1: SUB P,[14,,14] +MACCR: POP P,A + HRRZS A + CAIE A,GETFD6 + (SIXBIT /IAE/) + JRST GETFD1 + +MAC2A: TLO LINK,SCEND ;NO ARGS SUPPLIED TO MACRO + TRZ B,200 +MAC2: SOJL B,MAC4 ;DONE SCANNING ARGS + MOVEI A,0 ;MORE DUMMIES IN DEF, + PUSHJ P,ADDTR2 ;GENERATE NULL DUMMY + JRST MAC2 + +MAC3A: TLO LINK,ALNSCN+400000 + JRST MAC3B + +GENSYM: PUSHJ P,ADDTR1 + MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,[RDWR2A] + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + HLRZ A,(P) + ADDI A,60 + JRST PUTREL + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + (SIXBIT /TMD/) + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + TDZA SYM,SYM +GSYL: CLEARB SYM,STRCNT + MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST GSYL2 + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +GSYL2A: PUSHJ P,LOWRCS + CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL2: ILDB A,A.GST3 + TRZN A,200 + JRST GSYL2A + CAIG A,100 + JRST GSYL2 + HRROI T,(A) + POPJ P, + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO" ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + +WRTSS: MOVE T,[440700,,STRSTO] ;COPY STRING STORAGE (INCL DELIMITER) INTO MACTAB: GET INPUT POINTER + MOVE B,STRCNT ;GET COUNT + SOJL B,CPOPJ ;DECREMENT COUNT, RETURN IF DONE + ILDB A,T ;GET CHAR FROM STRING + PUSHJ P,PUTREL ;COPY OUT + JRST .-3 + +ADEFINE: MOVEI A,DMYDEF + MOVEM A,DMYTOP + PUSHJ P,GETSYL + JUMPE SYM,.-1 ;KEEP TRYING UNTIL MACRO NAME THERE + MOVEM SYM,MACNM + MOVE A,FREEPT + MOVEM A,PRDEF + CLEARB LINK,B ;B COUNT + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO + MOVE T,LIMBO1 +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIN T,"\ + JRST DEFNB + CAIN T,"/ + JRST DEFNE +DEFND: PUSHJ P,PDEF + JUMPE SYM,DEFNC ;JUMP IF NO DUMMY DEFINED + AOJA B,DEFNC ;DUMMY NAME THERE, INCREMENT COUNT + +DEFNE: TRO B,200 ;LAST DELIMITER WAS SLASH, SET FLAG +DEFNB: MOVE A,B ;ENTRY FOR LAST DELIM WAS BACKSLASH + PUSHJ P,PUTREL + MOVEI B,0 + TRO LINK,GENF + JRST DEFND + +DEFNA: MOVE A,B ;END OF DEFINE LINE, GET COUNT + PUSHJ P,PUTREL ;DEPOSIT REMAINING COUNT + MOVEI A,0 + TRNN LINK,GENF + PUSHJ P,PUTREL ;DEPOSIT + PUSHJ P,RCH + CAIE A,12 + TLO I,UNRCHF ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + PUSHJ P,STPWR ;WRITE STOP + MOVE SYM,MACNM ;GET MACRO NAME + PUSHJ P,ES ;FIND SLOT IN SYMBOL TABLE FOR IT + JFCL + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI C,77 ;LEV = INFINITE + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + PUSHJ P,VSM2 + JRST ASSEM1 + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN + MOVEM SYM,@DMYTOP ;STORE SYM + AOS A,DMYTOP ;INCR PNTR + CAIL A,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + (SIXBIT /TMD/) ;YES + POPJ P, + + ;READ IN BODY OF MACRO OR WHATEVER + +WRQOTE: CLEARM DCNT ;CLEAR DEFINE/TERMIN LEVEL COUNT + PUSHJ P,GSYL + PUSHJ P,ES + MOVEI A,0 ;NOT SEEN + MOVE TT,A + CAIE A,PSUDO/40000 + JRST WRQOT4 ;NOT PSEUDO + HRRZS B + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE +WRQOT4: JUMPE SYM,WRQOT1 ;JUMP ON NO SYM + MOVEI A,DMYDEF ;NOW CHECK FOR DUMMYS + CAML A,DMYTOP + JRST WRQOT2 ;NO MORE DUMMY NAMES TO COMPARE WITH + CAME SYM,(A) + AOJA A,.-3 + SUBI A,DMYDEF ;DUMMY + PUSH P,A + MOVE A,FREEPT + SOS A + PUSHJ P,REDINC + CAIE B,"! ;IF CHAR JUST BEFORE DUMMY NOT EXCLAMATION POINT, + JRST WRQOT5 + SOS FREEPT + SOS PUTCNT +WRQOT5: POP P,A + TRO A,200 + PUSHJ P,PUTREL ;THEN DEPOSIT DUMMY+200 AS NEXT CHAR + MOVE A,T + CAIE A,"! + PUSHJ P,PUTREL ;STORE SYL TERMINATOR + JRST WRQOTE+1 + +WRQOT2: CAIE TT,PSUDO/40000 ;NOT DUMMY, PSEUDO? + JRST WRQOT1 ;NO, COPY INTO MACRO BODY AND LOOP + CAIE B,ADEFINE ;YES, DEFINE? + CAIN B,AIRP ;IRP? + AOS DCNT ;YES + CAIN B,ATERMIN ;TERMIN? + SOSL DCNT ;TERMIN, SKIP IF MATCHING ONE + JRST WRQOT1 ;NOT MATCHING TERMIN, LOOP + POPJ P, + +WRQOT1: PUSHJ P,WRTSS ;COPY STRING + JRST WRQOTE+1 + +A.QOT1: MOVE A,LIMBO1 ;.QUOTE DURING READIN, TAKES ARG LIKE ASCII + CAIN A,40 + PUSHJ P,RCH + MOVEM A,A.QOT2 +A.QOT3: PUSHJ P,RCH + CAMN A,A.QOT2 + JRST WRQOTE+1 + PUSHJ P,PUTREL + JRST A.QOT3 + + ;PDL STRUCTURE FOR REPEAT + ;TWO TWO WORD ENTRIES + ;BBASE,,CPTR + ;LIMBO1 STATUS,,# TIMES LEFT + ;OLD .RPCNT,,BEG OF BODY + ;GARBAGE,,REPT1 + +AREPEAT: + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + PUSHJ P,AGETFD + (1000+SIXBIT /USR/) + JUMPLE A,COND4 ;NO REPEAT PLAY LIKE STRING COND FALSE + CAIN A,1 + JRST COND2 + PUSH P,A + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + MOVSI LINK,404000 + PUSHJ P,RDWRDA+1 + MOVEI A,15 + CAIE T,RBRKT + PUSHJ P,PUTREL +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVEI B,REPT1 + PUSHJ P,PUSHEM + MOVE A,PRREPT + SETZM PRREPT + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + HRRM A,-1(B) + HRRZ A,CRPTCT + HRLM A,-1(B) + SETOM CRPTCT + SETZM CPTR + JRST MACCR + +A.IRPC: SKIPA A,CIRPCT +A.RPCN: MOVE A,CRPTCT + JRST CLBPOP + +AFNM1: SKIPA A,AFNAM1 +AFNM2: MOVE A,AFNAM2 + JRST CLBPOP + +AFN1: SKIPA A,RFNAM1 +AFN2: MOVE A,RFNAM2 + JRST CLBPOP + +AIFN1: SKIPA A,INFN1 +AIFN2: MOVE A,INFN2 + JRST CLBPOP + + ;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + MOVEM A,REPTTM + PUSHJ P,REDINC + CAIE B,373 + (SIXBIT /IAE/) ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + MOVEM A,CPTR + SETOM CPTRB + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,AIRP4 + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: SETZM CPTR + SETOM CPTRB + JRST ASSEM1 + +REPTTM: 0 + +REPT2: MOVE B,REPTTM + MOVE A,CPTR + SKIPL CRPTCT + CAMN A,FREEPT + MOVEM B,FREEPT + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,LDRGO(A) + MOVEM A,CRPTCT +REPT4: PUSHJ P,POPEM + JRST REPT3 + + ;GET FIELD FOR PSEUDO + ;FOLLOW PUSHJ WITH INSTR EXECUTED IF SYM NOT FOUND + +BGETFD: SETOM FLDCNT +AGETFD: MOVE CH1,@(P) ;GET ERROR INSTRUCTION + MOVEM CH1,GTVER ;STORE APPROPRIATELY + PUSH P,I ;SAVE I + TRO I,PSEUDF ;SET FLAG TO GETVAL TO EXTCUTE GTVER ON UNDEFINED SYM ON EITHER PASS +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,LIMBO1 + CAIE CH1,12 + CAIN CH1,15 + JRST .+3 + TRNN I,FLD + JRST AGTFD3 + TLNE I,MWRD + JRST AGTFD1 +AGTFD2: MOVEM I,ISAV ;SAVE FLAGS FOR FLD GOTTEN + POP P,I + AOS (P) + POPJ P, +AGTFD1: PUSH P,A ;SOAK UP MULTI-WORD FIELD + PUSHJ P,GETFLD + TLNE I,MWRD + JRST .-2 + POP P,A + JRST AGTFD2 + + ;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: HRRI B,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF + (1000+SIXBIT /UCD/) ;UNDEFINED SYMBOL IN CONDITIONAL + POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: PUSHJ P,RCH ;CONDITION FALSE, EAT UP STRING + CAIN A,LBRKT + JRST COND3 +ANULL: TLO I,UNRCHF + PUSHJ P,RCH + CAIE A,15 + JRST .-2 + JRST ANULL1 + +COND3: MOVEI C,0 ;LEFT BRACKET ENCOUNTERED + PUSHJ P,RCHCNT ;READ UNTIL MATCHING RIGHT BRACKET + JRST .-1 + JRST MACCR + +COND5: JUMPGE COND4 + + ;IF1, IF2 + +COND2: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT ;FLUSH ONLY IF LEFT BRACKET +ANULL1: TLO I,UNRCHF + JRST MACCR +COND1: HRRI B,PSS + XCT B + JRST COND4 ;NO + JRST COND2 ;CONDITION TRUE, ASSEMBLE STRING + + + ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + MOVEM A,FREEPT + JRST MACCR + + ;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + HRRI B,SCONDF + MOVEM B,SCINST ;STORE TEST INSTRUCTION + MOVEI LINK,0 + PUSHJ P,RDWRDA+1 ;READ IN FIRST STRING + SETOB C,SCONDF + PUSHJ P,RCH ;GET FIRST CHARACTER OF SECOND STRING + CAIN A,LBRKT + MOVEI C,0 ;BRACKETED STRING + SKIPN C +SCND2A: PUSHJ P,RCH +SCOND2: JUMPGE C,SCOND1 ;JUMP IF PROCESSING BRACKETED STRING + CAIN A,", ;NOT BRACKETED, CHECK FOR COMMA + JRST SCOND3 ;END OF SECOND STRING +SCOND6: EXCH A,PRSCND + PUSHJ P,REDINC ;GET COMPARISON CHARACTER + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST SCND2A +SCOND4: CLEARM SCONDF ;STRINGS DIFFER +SCOND5: PUSHJ P,RCH + JUMPGE C,SCOND7 + CAIE A,", + JRST SCOND5 +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + XCT SCINST + JRST COND4 + JRST COND2 + +SCOND1: PUSHJ P,QSCNT ;SECOND STRING ARG BRACKETED, CHECK CHAR + JRST SCOND6 ;NOT END + JRST SCOND3 ;RIGHT BRACKET + +SCOND7: PUSHJ P,QSCNT + JRST SCOND5 + JRST SCOND3 + +RCHCNT: PUSHJ P,RCH ;GET CHARACTER +QSCNT: CAIN A,LBRKT ;SKIP IF CHAR IS MATCHING RBRAK + AOJA C,CPOPJ + CAIN A,RBRKT + SOJL C,POPJ1 + POPJ P, + + ;NOW IRP + ;IRP PDL STRUCTURE: + ;TWO TWO WORD ENTRIES + + ;BBASE,,CPTR + ;LIMBO1 STATUS,,OLD .IRPCNT + ;SPEC BITS\# A,B,[LIST] GROUPS,,CHAR ADR BEGINNING OF BODY + ;OLD TOPP,,AIRP4 + +AIRP: MOVSI 17,-14 + PUSH P,2(17) + AOBJN 17,.-1 + PUSH P,RDWRDP + HLLZM B,AIRPT ;SAVE TYPE OF IRP + CLEARB LINK,IRPCR + MOVEI A,DMYDEF + MOVEM A,DMYTOP + ;DROPS THROUGH + + ;DROPS THROUGH + + +AIRP1: PUSHJ P,PDEF + CAIE T,", + JUMPE SYM,AIRP2 ;NO DUMMY SPECIFIED (EXIT FROM LOOP) + PUSHJ P,PDEF ;READ OTHER NAME OF PAIR + MOVEI A,377 + MOVSI TT,200000 + TDNE TT,AIRPT + PUSHJ P,PUTREL +AIRPS6: PUSHJ P,ADDTRN + MOVEI A,377 + PUSHJ P,PUTREL + PUSHJ P,RDWRDA + MOVE A,RDWRDP + SOS -1(A) + MOVSI TT,200000 + TDNE TT,AIRPT + SOS -1(A) ;IRPS, BACK UP CHAR ADR TO POINT TO CHAR FOR SECOND DUMMY'S EXCLUSIVE USE + AOS IRPCR ;ANOTHER GROUP + TLNN LINK,SCEND + JRST AIRP1 + TLNE LINK,LCRIND + TLZ I,UNRCHF ;FLUSH CR +AIRP2: MOVE A,FREEPT + MOVEM A,PRIRP + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO I,UNRCHF + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + IOR A,AIRPT ;IOR IN SPECIFICATION BITS + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRP4 ;RETURN TO AIRP4 ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + SETZM CPTR + JRST MACC2 + + ;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRP4: PUSH P,A ;A GETS CHAR ADR LOOKING AT DUMMY + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP 4.9 => IRPC, 4.8 IRPS, 4.7 IRPW, NONE IRP + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + MOVEM A,CPTR + SETOM CPTRB + SETOM AIRPT + TRNE FF,MRSW + JRST AIRP9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRP9 ;JUMP IF NO GROUPS + SKIPGE TT,(B) + JRST AAIRPC ;4.9 => IRPC +AIRP6: SETOM AIRPT1 + HRRZ A,(T) ;GET ADR OF FIRST ARG +AIRP6A: PUSHJ P,REDINC ;GET CHARACTER FROM ARG + CAIN B,375 + JRST AIRP10 ;END OF STRING + CAIE B,377 + JRST AIRP6A ;WAIT FOR 377 (=> END OF PREV) + SETOM AIRPT2 +AIRP7E: MOVEM A,(T) ;STORE NEW CHAR ADR +AIRP7: PUSHJ P,REDINC + CAIN B,375 + JRST AIRP5 + TLNE TT,200000 + JRST AIRPS2 ;IRPS + CLEARM AIRPT + CAIN B,LBRKT + AOSE AIRPT2 + JRST AIRP7A ;NOT NEW LIST +AIRP7C: MOVEI B,376 ;CLOBBER BRACKET IN STRING STORAGE + DPB B,PTAB(CH2) + JRST AIRP7 + +AIRP7A: SKIPL AIRPT2 ;RIGHT BRACKET IN LIST + CAIE B,RBRKT + JRST AIRP7B + SOSGE AIRPT2 ;RIGHT BRACKET IN LIST + JRST AIRP7C ;END OF LIST +AIRP7B: CAIN B,15 + JRST AIRP7D + CAIE B,12 + CAIN B,", + SKIPL AIRPT2 + JRST AIRP7 ;NOT END OF ENTRY + ;DROPS THROUGH + + ;DROPS THROUGH +AIRPS1: MOVEI CH1,-1(A) ;END OF GROUP (ENTRY FROM IRPS, IRPW) + IDIVI CH1,4 + MOVEI B,377 + DPB B,PTAB(CH2) + TLNN TT,200000 + MOVEM A,1(T) ;IRP, STORE CHAR ADR OF REST OF STRING +AIRP8: ADDI T,2 + SOJG C,AIRP6 +AIRP9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVE A,[-3,,-2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +AIRPS2: CAIL B,"A + CAILE B,"Z + JRST AIRPS3 + +AIRPS4: CLEARM AIRPT ;SQUOZE + CLEARM AIRPT1 + JRST AIRP7 + +AIRPS3: CAIG B,"9 + CAIGE B,"0 + CAIN B,"$ + JRST AIRPS4 + CAIE B,"% + CAIN B,". + JRST AIRPS4 + CAIN B,"! ;BUT ALLOW EXCLAMATION POINT + JRST AIRPS4 ;SQUOZE OR ! + SKIPGE AIRPT1 + JRST AIRP7E ;IGNORE NULL SYLLABLES + HRRZ CH1,1(T) + IDIVI CH1,4 + DPB B,PTAB(CH2) ;DEPOSIT DELIMITER AS SECOND ARG + JRST AIRPS1 + +AIRP7D: SKIPL AIRPT2 + JRST AIRP7 + JRST AIRP7C + +AIRP10: CLEARM (T) ;END OF STRING +AIRP5: CLEARM 1(T) + JRST AIRP8 + +AAIRPC: MOVE A,(T) + PUSHJ P,REDINC + CAIN B,375 + JRST AIRPC3 + CAIE B,377 + JRST AAIRPC+1 ;WAIT FOR 377 (END OF PREV) + MOVEM A,1(T) ;CHAR ADR OF STRING VALUE OF DUMMY + PUSHJ P,REDINC + CAIN B,375 + JRST AIRPC3 + CLEARM AIRPT + MOVEI CH1,-2(A) + MOVEM CH1,(T) + IDIVI CH1,4 + DPB B,PTAB(CH2) + MOVEI B,377 + DPB B,PTAB+1(CH2) + AOS 1(T) + ADDI T,2 +AIRPC2: SOJG C,AAIRPC + JRST AIRP9 +AIRPC3: CLEARM (T) +AIRPC1: CLEARM 1(T) + JRST .-5 + +COLON: TLNN I,WRDF + TRNN I,SYL + (5000+SIXBIT /ILF/) ;COLON WITHIN STORAGE WORD OR NOT PRECEDED BY SYL + TRNN I,OPFLD+PSEUDF + TRNN I,LET + (5000+SIXBIT /ILT/) ;COLON WITHIN FIELD OR PSEUDO, OR SYL NOT NAME + TLNE FF,INDEFF + (5000+SIXBIT /CLI/) ;COLON WHEN LOCATION INDEFINITE + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + HRRZM A,WRDRLC + CLEARM PARBIT ;SET FLAG SAYING COLON + SKIPN LDCCC + TRNE FF,GLOLOC+GLOFFS + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ES ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED + PUSH P,C ;SAVE 3RDWRD + TLZ C,777700 ;MASK TO LEVEL + JUMPE C,COLON5 ;JUMP ON LEVEL = 0, INITIAL SYM + CAME C,[(77)] ;NOW CHECK LEVEL + CAMN C,LEV + JRST COLON1 ;SAME AS CURRENT, OR GLOBAL + JRST COLON2 ;DIFFERENT => WIN + +COLON1: POP P,C ;LEV SAME AS CURRENT, RESTORE 3RDWRD + JRST .+1(A) + (5000+SIXBIT /MDT/) ;COMMON + (5000+SIXBIT /RES/) ;MACRO OR PSEUDO + JRST COLON4 ;SYM + JRST EQL1C ;LOCAL UNDEF + (5000+SIXBIT /MDT/) + (5000+SIXBIT /MDT/) + (5000+SIXBIT /MDT/) + (5000+SIXBIT /MDT/) + JRST EQL1E ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +COLON4: CAME B,WRD + JRST COL4E + PUSHJ P,RCHK + JUMPN C,.+2 + CAME B,WRDRLC +COL4E: (5000+SIXBIT /MDT/) ;MDGS +CASSM1: JRST ASSEM1 + +COLON5: CAIE A,2 ;LEV OF SYM IS ZERO, IS IT SYM? + JRST COLON1 ;NOT SYM + JRST COLON2 ;SYM => WIN (ALLOW OVERDEFINITION) + + ;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: PUSHJ P,ES ;FIND ITS SLOT IN ST + JRST GCOL2 ;NOT ALREADY DEFINED + PUSH P,A ;FOUND, SAVE FLAGS OF SQUOZE + CAIE A,11 + TLNE I,GLI + TLO SYM,40000 ;GLOBAL EXIT, OR DOUBLE QUOTE TYPED, SET GLOBAL BIT IN SQUOZE + PUSHJ P,LKPNRO ;MAYBE PUNCH OUT LINK REQUEST + TLZ SYM,40000 ;NOW CLEAR OUT GLOBAL BIT SGAIN + POP P,A ;GET BACK CURRENT SQUOZE FLAGS + CAIE A,GLOETY_-14. + CAIN A,GLOEXT_-14. + JRST GCOL3 ;GLOBAL ENTRY OR GLOBAL EXIT + TLNN I,GLI + JRST GCOL4 ;SOMETHING ELSE, AND DOUBLE QUOTE NOT TYPED + PUSHJ P,PLOGLO ;DOUBLE QUOTE TYPED, TELL LOADER SYM IS GLOBAL +GCOL3: MOVSI T,GLOETY ;GLOBAL ENTRY + TLOA SYM,40000 ;GLOBAL BIT IN SQUOZE +GCOL4: MOVSI T,LCUDF ;LOCAL UNDEFINED +GCOL5: PUSHJ P,VSM2LV ;PUT SYM IN ST, WITH 3LLV SET + PUSH P,C1ASSEM1 ;CAUSE RETURN TO ASSEM1 + ;DROPS THROUGH + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: PUSHJ P,PBITS7 ;OUTPUT 7 THEN PDEFPT + MOVEI A,CDEFPT + PUSHJ P,PBITS + JRST OUTSM ;OUTPUT SYM, WITHOUT BITS + +C1ASSEM1: +GCOL2: SETZI B,ASSEM1 ;COLON WITH LOCATION GLOBAL AND SYM NOT ALREADY DEFINED + MOVE C,LEV + TLNN I,GLI + JRST GCOL4 ;SYM NOT FOLLOWED BY " + MOVSI C,77 ;FOLLOWED BY ", SET TO GLOBAL LEVEL + JRST GCOL3 + + ;CONSTA + +CNSTNT: PUSH P,CASSM1 ;CAUSE RETURN TO ASSEM1 + SOSGE CONCNT ;ENTRY FROM AEND + (SIXBIT /TCA/) ;TOO MANY CONSTANTS AREAS + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNE FF,PSS + JRST CNST2 + HRRM B,1(T) + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,777777 + TLO D,200000 + TRNE FF,GLOLOC + TLO D,100000 + IORM D,2(T) + +CNST1: MOVE SYM,(T) ;GET NAME OF AREA + TRNE FF,GLOLOC + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA +CNST1B: MOVEI A,CONTAB +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVEI C,CONGLO +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONGLO + CAME A,1(C) ;POINTS TO THIS CONSTANT? + JRST .+4 ;NO + AOS D ;YES, STORE ENTRY IN GLOTB + MOVE B,(C) + MOVEM B,(D) + AOS C + AOJA C,CNSTC + +CNSTB: MOVEM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + POP P,A ;RESTORE POINTER INTO CONTAB + AOJA A,CNSTH + +CNST2: MOVSI A,100000 + TDZ A,2(T) + TRNE FF,GLOLOC + TLC A,100000 + SKIPN A + (SIXBIT /CVD/) + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + (SIXBIT /CLD/) + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + (SIXBIT /CRD/) + JRST CNST1 + +CNSTA: HRRZ T,PBCON + TRNE FF,GLOLOC + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,NPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,CONT ;1PASS AND NOT DEFINED + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,OUTPUT + HRRZ A,1(T) + PUSHJ P,OUTPUT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,CONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,PSS + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVEI A,CONTAB + MOVEM A,PLIM + MOVEI A,CONGLO + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +CNST3: PUSHJ P,EBLK ;END CURRENT BLOCK + HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + JRST CNSTE + + ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONGLO TABLE + +CONBUG: MOVEI A,CONGLO ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONGLO ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONGLO ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONTAB + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + (5000+SIXBIT /CRI/) ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONGLO FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONGLO ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVEI A,CONGLO + PUSH P,B + MOVEI B,CONGLO +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + (5000+SIXBIT /CRI/) + ANDCB B,CH1 + JRST CONB8A + +OPEN: MOVEM A,LSYL ;VALUE OF LAST SYL + MOVEM B,LSYLR ;RELOCATION BITS OF " + PUSH P,D ;ALT ENTRY - CLOSE DELIMITER, SET UP BY CALLING ROUTINE + PUSHJ P,GETWRD ;GET WORD + POP P,D ;RESTORE DELIMITER + CAME D,LIMBO1 ;IF AGREES WITH LAST CHAR READ, + TLNE I,MWRD ;OR IF READING MULTIPLE WORD + POPJ P, ;THEN OK + MOVE D,LIMBO1 ;NEITHER, GET LAST CHAR + CAIE D,15 + CAIN D,12 + POPJ P, ;CR OR LF => OK + (2000+SIXBIT /ILC/) ;ILLEGAL CLOSE + POPJ P, + +LSSTH: MOVEI D,"> + JSP LINK,SAVWD1 + PUSHJ P,OPEN + TLNE I,MWRD + PUSHJ P,IGTXT ;NOT INTERESTED IN MULTI-WORD CRUD +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUT LSYL AND LSYLR + TLZE I,LSRET + JRST LSSTHR ;RETURN TO ^ OR _ + +LSSTH2: ADDM A,LSYL + MOVE A,LSYLR + PUSHJ P,HFWDAD + MOVEM A,LSYLR +LSSTH5: MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO I,UNRCHF ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE A,"_ + CAIN A,"] + JRST LSSTH7 + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;NEXT CHAR NOT BREAK CHAR + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) + CAIN A,"; + JRST LSSTH7 + TLNE CH1,DSYL + JRST LSSTH4 ;SYLLABLE OPERATOR +LSSTH7: PUSHJ P,GETSYL ;CLOBBER CDISP +LSSTH6: TRO I,SYL + MOVE A,LSYL + MOVE B,LSYLR + POP P,LSYLR + POP P,LSYL + JRST GETFD6 + +LSSTH1: ADDM A,WRD + MOVE A,WRDRLC + PUSHJ P,HFWDAD + MOVEM A,WRDRLC + JRST LSSTH5 + +LSSTH4: SKIPN LSYL + SKIPE LSYLR + (2000+SIXBIT /NOS/) ;IMPROPER +( ... ) + POP P,LSYLR + POP P,LSYL + JRST GETFD1 + + +LSSTHR: POP P,LSYLR + POP P,LSYL + POPJ P, + + ;VARIAB + +AVARIAB: PUSH P,CASSM1 ;RETURN TO ASSEM1 + SOSG VARCNR ;ENTRY FROM AEND + (SIXBIT /TVA/) ;TOO MANY VARIABLE AREAS + MOVSI D,-SMK ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,PSS + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,-1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + +AVAR2: 3GET C,D + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: AOS D + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB + HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + + ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,GLOLOC + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG + PUSHJ P,VSM2 +AVAR4B: PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + (SIXBIT /VLD/) + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,-1 + (SIXBIT /VRD/) + SKIPE VARCNT + (SIXBIT /VND/) + JRST AVAR2 + +AVAR4: TLNN C,3VAS2 + JRST AVAR2A + TLOE C,3VP + JRST AVAR2B + CAIN LINK,DEFGVR_-14. + TLO SYM,40000 + PUSHJ P,LKPNRO + TRNN FF,GLOLOC + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + PUSHJ P,PDEFPT + PUSHJ P,PBITSZ + PUSHJ P,OUTPUT +AVAR2B: TRNE FF,GLOLOC + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. + JRST AVAR4B + 3PUT C,D + JRST AVAR2A + +LEFTP: MOVEI D,") + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,OPFLD + TRNE I,SYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,OPEN + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + MOVSM B,T2 + MOVSI B,200000 + PUSHJ P,LNKTC1 + TLNE I,MWRD + PUSHJ P,IGTXT + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + + ;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD + +LBRAK: TRO I,FLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT +LBRAK1: AOS CONDEP ;ONE DEEPER IN CONSTANTS + MOVEI D,"] + PUSHJ P,OPEN ;READ A WORD +LBRAK3: SOS CONDEP ;POPPED UP ONE LEVEL IN CONSTANT NESTING +LBRAK2: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 + MOVE A,1(T) + CAML A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT+2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + + ;DROPS THROUGH +SCON: PUSHJ P,RCHKMV ;SET UP RELOCATION BITS + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,MWRD+MWRD1 + JRST NOCON ;MULTIPLE WORD, DON'T TRY TO FIND MATCH + MOVEI A,CONTAB +SCON1: CAML A,PLIM ;SEARCH CONTAB TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONBIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVEI B,CONGLO ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 + AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,.-4 ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH +NOCON4: MOVE C,GLSP2 ;RESET C TO POINT TO BEGINNING OF THIS PART OF GLOTB + MOVE B,PBCON ;BY GOD,THEY MATCH, GET POINTER TO CURRENT CONSTANTS AREA SPEC + SKIPL 2(B) + AOJA C,SCON4 ;CONST AREA UNDEF + MOVEM C,GLSP1 ;DEF, WIPE OUT GLOTB ENTRIES + MOVE C,1(B) + ADDI A,(C) + LDB B,[420100,,2(B)] + JRST SCON6 + +SCON4: TLNE I,MWRD + TLNN I,MWRD1 + JRST .+2 + JRST SCON6A ;BOTH SET + MOVEM C,GLSP1 ;AT LEAST ONE WAS CLEAR + MOVEM B,(C) +SCON6A: MOVEI B,0 +SCON6: SUBI A,CONTAB + TLZE I,MWRD1 + JRST SCOM1 + TLNN I,MWRD + JRST LSSTH3 + PUSH P,A + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + PUSHJ P,.+1 +SCOM2: TLO I,MWRD1 + MOVEI D,"] + AOS CONDEP + PUSHJ P,OPEN+2 + JRST LBRAK3 +SCOM1: TLNE I,MWRD + JRST SCOM2 + MOVEI TT,SCOM2 + JSP LINK,POPLIS + JRST LSSTH3 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAIL A,CONTAB+LCONTB+1 + (SIXBIT /TMC/) +NOCON2: MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + MOVE C,1(B) + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + CAIL C,CONTAB + AOJA B,NOCON3 + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +CONST3: PUSHJ P,EBLK + HLRZ A,1(T) + MOVEM A,CLOC + JRST CNSTE + +NOCON5: AOS AA,CONGOL + CAIL AA,CONGLO+LCNGLO + (SIXBIT /TMC/) ;TOO MANY CONSTANT GLOBAL REFERENCES + POPJ P, + + ;SET UP BYTE POINTER TO CONBIT TABLE + ;A SHOULD HAVE ADR OF CONTAB ENTRY + ;LEAVES ANSWER IN C + +CPTMK: PUSH P,A + SUBI A,CONTAB + PUSH P,B + IDIVI A,18. + MOVEI C,CONBIT(A) ;SET UP ADDRESS PART + DPB B,[370500,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD + POP P,B + JRST POPAJ + +INIT": HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVSI A,-SMK ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TLNN C,3INI ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: AOS A + AOBJN A,INIT4 + MOVSI A,<-+1> ;clear CONBIT, CONTAB, PCNTB + SETZM CONBIT(A) + AOBJN A,.-1 + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + CLEARM BKBUF + SETZM STGSW + TDZ FF,[-1-VOT-PTPF,,-1] ;INITIALIZE MOST FF FLAGS + CLEARM ISYMF ;ISYMS HAVE BEEN SPREAD + SETZM MDEPTH + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + MOVEI A,CONGLO + MOVEM A,CONGOL + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVSI A,2 + MOVEM A,LEV + MOVE A,[SQUOZE 0,.MAIN] + MOVEM A,PRGNM + MOVE A,[PUSHJ P,INCHR] + MOVEM A,GETCHR + +P2INI: MOVEI A,1 + MOVEM A,CPGN + MOVEM A,CLNN + TLZ FF,INDEFF + CLEARM GENSM + MOVEI A,NCONS + MOVEM A,CONCNT + MOVEI A,VARTAB + MOVEM A,VARPNT + MOVEI A,NVARS + MOVEM A,VARCNR + CLEARM OFLOC + CLEARM OFRLOC + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,CONTAB + MOVEM A,PLIM + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[34773600001] + ;XXX Later source has this, which doesn't produce the same result: + ;MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + AOS A + MOVEM A,CSQZ + MOVEI A,10 + MOVEM A,ARADIX + MOVEI A,100 + MOVEM A,CLOC + CLEARM CRLOC + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + TRO FF,IPSYMS+FIRWD + CLEARM CRPTCT + CLEARM SYLOC + CLEARM SYSYM + CLEARM BYTW ;CLEAR BYTE MODE WORD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC +] +CRETN: POPJ P,RETURN + +A.QOTE: +ASSEM1: TRZ I,FLD+SYL+LET+PSEUDF+COM+CONT+GMINF+OPFLD + TLZ I,GLI+VAR+FLO+DECP+UARI+MNSFLG+WRDF+NPRC + TRO I,DEF + TLZ FF,SKILF + MOVE P,[-LPDL,,PDL"] + HRRZM P,GETCNR ;MAKE SURE PREC OF UNARY OPS FITS IN A HALFWORD DURING LONG ASSEMBLIES + MOVEI A,GLOTB + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 + TLNE I,MWRD + JRST ASSEM2 ;ASSEMBLING MULTIPLE WORD + PUSHJ P,RCH + CAIG A,40 + JRST .-2 ;FLUSH LEADING GARBAGE + CLEARM PARBIT + TLO I,UNRCHF ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT + CLEARM CONDEP ;DEPTH IN CONSTANTS := 0 +ASSEM2: PUSHJ P,GETWRD + TLZN I,WRDF + JRST ASSEM1 ;NO WORD ASSEMBLED,TRY AGAIN + SKIPE STGSW + (1000+SIXBIT /SWD/) ;STORAGE WORD ASSEMBLED + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD +ASSEM3: PUSHJ P,PWRD ;NORMAL MODE, OUTPUT WORD + AOS CLOC ;INCREMENT LOCATION COUNTER + HRRZS CLOC ;MAKE SURE LOCATION DOESN'T INCREMENT TO BITS IN LEFT HALF + JRST ASSEM1 + +PSYMS": HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + TRNN FF,IPSYMS + JRST APSYM1 ;NOSYMS, JUST PUNCH PROGRAM NAME + PUSHJ P,SYMDMP ;YESSYMS, PUNCH SYMTAB +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) + +APSYM1: SKIPN CONTRL + PUSHJ P,SYMDA ;PUNCH PROG NAME + JRST RETURN + +EQUAL: CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST ALOC + TRNN I,OPFLD+PSEUDF + TRNN I,LET + (5000+SIXBIT /IPA/) ;ILLEG ARG EQ + PUSH P,SYM + PUSH P,I + MOVE A,[(1000+SIXBIT /USP/)] + MOVEM A,GTVER + TRO I,PSEUDF+DEF+EQLF + PUSHJ P,RCH + CAIE A,"= + TLOA I,UNRCHF + TLO FF,SKILF + PUSHJ P,GETWRD + MOVEI CH1,CRDF + MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION + TRNN I,DEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +] + TDZ I,[-1-(MWRD)] + IOR I,(P) + POP P,(P) + POP P,SYM + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +EQG1: PUSHJ P,ES ;GLOBALS TO RIGHT + JRST EQL2 ;NOT FOUND + JRST .+1(A) + (5000+SIXBIT /IPA/) ;COMMON + (5000+SIXBIT /IPA/) ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQL2 ;LOCAL UNDEF + (5000+SIXBIT /IPA/) ;DEF LOC VAR + (5000+SIXBIT /IPA/) ;UNDEF LOC VAR + (5000+SIXBIT /IPA/) ;DEF GLO VAR + (5000+SIXBIT /IPA/) ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + ;NOT DONE WITH TABLE YET! + +EQL8: JUMPE B,EQL7 ;GLO EXIT REACHED BY DISP + PUSHJ P,GLKPNR +EQL7: PUSH P,CASM1A +GLOPRA: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVSI C,3LLV+77 ;VAL MUST BE PUT IN BYLOADER FLAG + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSHJ P,VSM2 + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM + PUSHJ P,PWRDA + JRST EBLK + + ;MAYBE PUNCH OUT LINK REQUEST + ;SYM HAS NAME OF SYM TO REQUEST, C 3RDWRD, B ADR OF REQUEST + ;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,CONT + POPJ P, ;DON'T PUNCH REQUEST + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,CONT ;OK TO END BLOCK NOW + JRST OUTPUT ;PUNCH OUT A AND RETURN + + +EQL2: TLNE I,GLI + JRST EQL7 ;MAKE IT GLOBAL + PUSHJ P,LOPRA +CASM1A: JRST ASEM1A + +LOPRA: MOVSI T,LCUDF ;LOCAL UNDEFINED + TLZ C,77 + IOR C,LEV + TLO C,3LLV ;LOADER MUST SUPPLY VALUE + TLNE FF,SKILF + TLO C,3SKILL + JRST LOPRA1 + + + ;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ES + JRST EQL1A ;NOT FOUND + JRST .+1(A) + (5000+SIXBIT /IPA/) ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + (5000+SIXBIT /IPA/) ;DEF LOC VAR + (5000+SIXBIT /IPA/) ;UNDEF LOC VAR + (5000+SIXBIT /IPA/) ;DEF GLO VAR + (5000+SIXBIT /IPA/) ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY +EQL1E: PUSHJ P,GLKPNR ;GLO EXIT REACHED BY DISP DUMP LINKING POINTER +EQL1D: PUSHJ P,RCHK ;GLO ENTRY +EQLB2: PUSHJ P,RMOVE + TLO C,77 + MOVE B,WRD + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2 ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,MWRD + PUSHJ P,IGTXT +ATERMIN: JRST ASSEM1 + +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,PPSS +OUTD1: TLO C,3VP ;VALUE PUNCHED + 3PUT C,D +OUTDEF: TRO I,CONT + PUSHJ P,P70 ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE +EQL1CC: PUSHJ P,OUTSM + TRZ I,CONT + JRST OUTWD ;OUTPUT VALUE + +EQL1C: MOVE T,LEV + CAME T,ESL1 + JRST EQL1CD ;LEVELS DIFFER + TLNE I,GLI + JRST EQL1CA ;MAKE GLOBAL +EQL1CB: PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKMV ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 +PBITSZ: SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CD: TLNN I,GLI + JRST EQL1BA + JRST EQL1E ;MAKE GLOBAL + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: IOR C,LEV + TLNE FF,SKILF + TLO C,3SKILL + JRST VSM2W + +EQL1B2: (2000+SIXBIT /QPA/) +EQL1B: PUSHJ P,RCHK + TLNE I,GLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL +EQL1B1: MOVE T,LEV + CAME T,ESL1 + JRST EQL1BA ;SYM LEVEL .NE. CURRENT + PUSHJ P,RMOVE ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + MOVE C,ESL2 + JRST EQA2 + +COLON2: POP P,C +EQL1BA: MOVNI TT,SMK + PUSHJ P,HASH + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,EQL1BB + CAMN B,SYM + JRST EQL1SM +EQL1SR: ADDI C,2 + CAIL C,2*SMK + MOVEI C,0 + AOJN TT,EQL1BA+2 + (SIXBIT /SCE/) ;SCE +EQL1BB: MOVE D,C +EQL1A1: PUSHJ P,RCHKMV + HRLZI T,SYMC + TLO C,3MAS + JRST EQA2 + +EQL1SM: 3GET D,C + TLO D,3MAS + 3PUT D,C + JRST EQL1SR + + +EQL1A: TLNN I,GLI + JRST EQL1A1 +EQ12: MOVEI C,0 + JRST EQL1D + + ;START SETTING UP 3RDWRD IN C (ALSO T) + +RCHKMV: PUSHJ P,RCHK ;CHECK RELOCATION BITS FOR VALIDITY + JRST RMOVE ;NOW COPY INTO 4.9 (R(LH)) AND 4.8 (R(RH)) OF C AND T + + ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +GETVAL: HLR AA,I + ANDI AA,3 ;MICRO DISP ON GLI+VAR + PUSHJ P,ES + JRST GTVL2 ;NOT FOUND + JRST .+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + JRST GTVL1 ;COMMON + JRST GTVPM ;PSEUDO OR MACRO + JRST GTVL3 ;SYM + JRST GTVLE ;LOCAL UNDEF + JRST GTVL6A ;DEF LOC VAR + JRST GTVL6 ;UNDEF LOC VAR + JRST GTVLB ;DEF GLO VAR + JRST GTVLE4 ;UNDEF GLO VAR + JRST GTVL5 ;GLO ENTRY +GTVLD: TLNE I,VAR ;GLO EXIT REACHED BY DISP + JRST GTVLD1 ;MAKE UNDEF GLO VAR + +GTVLD4: +GTVLD2: AOS GLSP1 + MOVEI T,ST(D) +GTVD2A: HRRZM T,@GLSP1 +GTVLZ: JRST CABPOP + +GTVLD1: MOVSI T,UDEFGV ;MAKE UNDEF GLO VAR +GTVL1A: AOS VARCNT + HRR B,VARCNT +GTV2C1: TLO C,77 +GTVLD3: JRST GTVL2D + +GTVL2: MOVE C,LEV ;NOT FOUND + JRST .+1(AA) + JRST GTVL2P ;NEITHER MAKE UNDEF LOCAL + JRST GTVL2C ;GLI MAKE GLO EXIT + SKIPA T,[(UDEFLV)] ;VAR MAKE UNDEF LOC VAR + MOVSI T,UDEFGV ;VAR+GLI MAKE UNDEF GLO VAR + AOS B,VARCNT +GTVL2D: PUSHJ P,VSM2 + JRST GTVLD2 + +GTVL2C: MOVSI T,GLOEXT ;GLO EXIT + JRST GTV2C1 +GTVL2P: PUSHJ P,GETVUN +MLCUDF: MOVSI T,LCUDF ;LOCAL UNDEF + MOVEI B,0 + JRST GTVL2D + + ;PSEUDO OR MACRO + +GTVPM: TLZE I,VAR+GLI + (1000+SIXBIT /ILV/) ;TRYING TO MAKE PSEUDO OR MACRO GLOBAL OR VARIABLE + JRST (B) ;TRANSFER TO PSEUDO ROUTINE (MACRO => MACCL), LEAVE LH(VALUE) IN LH(B) + +GTVL1: TRO I,COM ;COMMON + HRRZ A,B + JRST CLBPOP + +GTVL3: TLZE I,VAR ;SYM + (1000+SIXBIT /MDV/) ;TRYING TO DEFINE SYM AS VARIABLE + TLNE I,GLI + JRST GTVL7 ;MAKE GLO ENTRY +GTVL8: MOVE A,B ;USED IN LBRAK + BYB LDB B,C,\3RLR_18. + TLNE C,3RLL + TLO B,1 + POPJ P, + +GTVL7: HRLZI T,GLOETY ;GLO ENTRY + TLO C,77 + PUSHJ P,VSM2 +GTVL5A: JUMPGE FF,GTVL8G + TLNN C,3LLV + TRNE I,PSEUDF+EQLF + JRST GTVL8G + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GTVL8G: TRNN I,EQLF + TRNN I,PSEUDF + TLNN C,3REL +GTVL8L: TLNE C,3LLV +GTVD2: JRST GTVLD4 + JRST GTVL8 + +GTVL6A: PUSHJ P,GTVB1 ;DEFINED LOCAL VARIABLE + TLZN I,GLI + JRST GTVL8L +GTVL6B: PUSHJ P,PLOGLO + HRLZI T,DEFGVR ;DEF GLO VAR + PUSHJ P,VSM2 +GTVLB: PUSH P,GTVD2 ;DEF GLO VAR +GTVB1: TRNE FF,PSS + TLNN I,VAR + POPJ P, + TLO C,3VAS2 + JRST VSM3A + +GTVL6: TLNN I,GLI ;UNDEF LOC VAR + JRST GTVLE4 + PUSHJ P,PLOGLO + HRLZI T,UDEFGV ;UNDEF GLO VAR + JRST GTVL2D + +GTVL5: TLZE I,VAR ;GLOBAL ENTRY + (1000+SIXBIT /MDV/) ;MDGV + TLNE I,GLI + TLNE C,3VP + JRST GTVL8G ;VALUE PUNCHED OR DOUBLE-QUOTE NOT TYPED + JRST GTVL5A ;DOUBLE-QUOTE TYPED AND VALUE NOT PUNCHED + +GTVL7A: TLO SYM,40000 +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TLNE FF,INDEFF + JRST GTVLP1 ;LOCATION INDEFINITE + TRNE FF,GLOLOC+GLOFFS + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,FLO+DECP+PERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + +GTVLP1: TLNE FF,PPSS ;LOCATION INDEFINITE + (1000+SIXBIT /PNI/) + JRST GTVLZ + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + TRNE FF,GLOFFS + JRST CABPOP + MOVEI A,0 + SKIPGE BYTM ;IN BYTE MODE? + HLL A,BYTWP ;YES, USE LH(BP) AS ABS PART + ADD A,OFLOC + MOVE B,OFRLOC + POPJ P, + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER + +GTVLE: TLNE C,3LLV ;LOCAL UNDEFINED, SKIP IF PROBLEM HASN'T BEEN GIVEN TO LOADER + JRST GTVLD4 ;GTVD2 -> GTVLD2 FOR PUSH + JRST .+1(AA) ;NOT LOADER'S PROBLEM, SEE IF BEING "DEFINED" RIGHT NOW + JRST GTVLE4 ;NEITHER CONT AS LOCAL UNDEF + JRST GTVLE1 ;GLI + JRST GTVLE2 ;MAKE LOCAL UNDEF VAR + PUSHJ P,PLOGLO + JRST GTVLD1 ;MAKE UNDEF GLO VAR + +GTVLE2: PUSHJ P,GETVUN + HRLZI T,UDEFLV + JRST GTVL1A +GTVLE1: PUSHJ P,PLOGLO + JRST GTVL2C + +GTVLE4: PUSHJ P,GETVUN ;UNDEFINED GLOBAL VARIABLE + JRST GTVLD2 + +GETVUN: TRZ I,DEF ;UNDEFINED (CALLED W/ PUSHJ FROM VARIOUS PLACES), COMPLAIN OR RETURN + TRNE I,PSEUDF + JRST GTVER ;PSEUDO + TRNN FF,PSS + POPJ P, ;PASS 1 + SKIPN CONDEP + (1000+SIXBIT /USW/) + SKIPE CONDEP + (1000+SIXBIT /USC/) +GTVER1: POP P,1(P) + JRST GTVLZ + +GTVER: 0 ;ERROR UUO (OR WHATEVER) TO EXECUTE ON UNDEFINED SYMBOL IN PSEUDO + JRST GTVER1 + + ;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM + ;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL + +PLOGLO: PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + PUSHJ P,OUTSM + JRST POPAJ + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP + DSYL,,RRL2 ;EXCLAIM + DSYL,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + 0 ;DOLLARS + 0 ;PERCNT + DFLD,,ANDF ;AMPERSAND + DSYL,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + 0 ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL,,PERIOD ;PERIOD + DFLD,,DIVID ;/ + DSYL,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL,,EQUAL ;= + 0 ;> + 0 ;? + DSYL,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL,,UPARR ;^ + DSYL,,BAKAR ;BACKARR + 0 ;CR + DWRD,,SPACE ;TAB + 0 ;ALL OTHER + + ;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM + ;RETURNS CRUD AS DOCUMENTED IN COMMENTS, SKIPS IF FOUND + +ES: SETOB D,ESL1 ;LH(ESL1) GETS LEVEL OF SYM + MOVNI TT,SMK + MOVE B,SYM ;HASH AWAY + TLZ B,740000 + TSC B,B + MOVMS B + IDIVI B,SMK + ASH C,1 +ES4: SKIPN B,ST(C) ;GET SQUOZE IN THIS ST SLOT + JRST ES2 ;NOTHING WHERE SYM BELONGS, TERM SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ES3 ;NO MATCH BUT MAYBE KEEP GOING + 3GET A,C ;FOUND SYM, GET 3RDWRD + MOVE TM,A ;SAVE 3RDWRD + TLZ A,777700 ;MASK TO BEGIN/END LEVEL + SKIPN FLDCNT + JUMPE A,ES3B1 + CAMG A,ESL1 + JRST ES3 ;.LE. LEVEL OF LAST ONE FOUND +ES3B: MOVEM TM,ESL2 ;3RDWRD + MOVEM A,ESL1 ;BEGIN/END LEVEL + MOVEM C,SADR + TLNN TM,3MAS + JRST ES2A ;NO MORE SYMS AT DIFFERENT LEVELS, USE HIGHEST-NUMBERED-LEVEL ONE +ES3: JUMPN B,ES5 + SKIPGE D ;EXPUNGED + MOVE D,C ;SAVE SADR OF THIS (IN CASE DEFINING RATHER THAN USING VALUE OF SYM) AND TRY AGAIN +ES5: ADDI C,2 + CAIL C,2*SMK + MOVEI C,0 ;AT END OF ST, RING BACK TO BEGINNING + AOJN TT,ES4 + SKIPL ESL1 ;OOPS! SEARCHED THROUGH ENTIRE SYMTAB + JRST ES2A + JUMPGE D,ES6A + (SIXBIT /SCE/) ;SYMBOL TABLE FULL (STORAGE CAPACITY EXCEEDED) + +ES2: SKIPGE ESL1 + JRST ES6 +ES2A: MOVE D,SADR ;INDEX INTO SYMTAB + MOVE A,ST(D) ;SQUOZE W/ FLAGS + ROT A,4 + ANDI A,17 ;A := SQUOZE FLAGS + MOVE B,ST+1(D) ;B := VALUE OF SYM + MOVE C,ESL2 ;C := 3RDWRD (HALFWORD IN LEFT HALF) + ;D HAS INDEX INTO SYMBOL TABLE +POPJ1: AOS (P) + POPJ P, + +ES3B1: MOVSI A,100 ;TAKE 0 LEVEL SYM IN LEFT MOST FIELD + JRST ES3B + +EXTCOR: .SUSET [.RMEMT,,A] + PUSH P,A + IDIVI A,2000 +RECORE: .CORE 1(A) + JRST MEMERR + POP P,A + POPJ P, +MEMERR: PUSH P,A + TYPR [ASCIZ /NO CORE, TYPE ANY CHARACTER TO RETRY +!/] + PUSHJ P,TYI + POP P,A + JRST RECORE + +ES6: SKIPGE D + MOVE D,C +ES6A: MOVEM D,SADR + POPJ P, + + ;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR T,CH1 ;T := SQUOZE WITH FLAGS + MOVEM T,ST(D) ;STORE SQUOZE +VSM3: MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + + +HASH: MOVE B,SYM ;HASH ALGORITHM AS SUBROUTINE (ALSO EXECUTED IN-LINE AT ES) + TLZ B,740000 + TSC B,B + MOVMS B + IDIVI B,SMK + ASH C,1 + POPJ P, + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FORTAB: BLOCK .-IFORTB ;ACTUAL FORMAT TABLE +FRTBE=.-1 + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + (1000+SIXBIT /UF1/) + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + (1000+SIXBIT /UF2/) + POP P,B + MOVEM A,FORTAB-13(B) + JRST ASSEM1 + + ;GETWORD + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[WRDF,,AIOWD] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD + MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + MOVE C,CDISP + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,FLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,WRDF ;NON-NULL WORD +GTWD4: MOVE TT,FORMAT + SKIPN TT,FORTAB-13(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + (2000+SIXBIT /UFM/) ;UNDEFINED FORMAT + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,AIOWD + POPJ P, + +SPACE2: POP P,A +COMMA: TRNN I,FLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 +POPFD1: AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIN T,FORMAT + JRST GTWD1 + +GTWD6: HRLZI T,440000 + HLLM T,FORPNR + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + POPJ P, ;ENTIRE WORD NULL, RETURN FROM GETWD + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: IBP FORPNR ;COMMA TERMINATED NULL FIELD, MARK NULL FIELD IN FORMAT + JRST COMMA4 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: PUSH P,A + PUSHJ P,RCH ;FLUSH OTHER SPACES, TABS + CAIE A,11 + CAIN A,40 + JRST .-3 + CAIN A,", ;FIRST NON-SPACE CHAR COMMA? + JRST SPACE2 ;YES + POP P,A ;NO, RESTORE A + TLO I,UNRCHF ;CAUSE CHAR TO BE RE-READ NEXT TIME + TRNN I,FLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + + ;T HAS DESC BYTE, PUT FIELD IN ITS PLACE + +INTFLD: TRNE I,AIOWD + JRST .+4 ;FIRST FIELD HAS IO INSTRUCTION + MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + (2000+SIXBIT /IRL/) ;RELOCATION ATTEMPTED IN IRRELOCATABLE FIELD + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + (2000+SIXBIT /IGS/) ;GLOB SYM APPEARS IN ILLEGAL FIELD +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + MOVE A,C + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM A,WRD ;ALLOW CARRY +INTFD3: MOVE A,WRDRLC + PUSHJ P,HFWDAD + MOVEM A,WRDRLC + POPJ P, + +INTFD2: ADD A,WRD ;ADD RIGHT HALVES + HRRM A,WRD + JRST INTFD3 + +INTL: HRLZ D,B ;LH + HRLZI B,SWAPF +INTR1: PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS + POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + + +INTR: HRRZ D,B ;RH + MOVEI B,0 + JRST INTR1 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH +INTAC1: TRNE I,AIOWD ;IO DEVICE DIDDLE + LSH A,1 + TRNE I,AIOWD + ADDI T,6 + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL+1 + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF BITF SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,BITF + SOSA A + TRO FF,INVTF + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + TRZ FF,BITF + CAIN A,7 + TRO FF,BITF + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + ;GO TO EBLK IF BKBUF NON-EMPTY OR IF RELOCATABLE ASSEMBLY AND LOADER DOESN'T KNOW $. + +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +OUTPUT: SKIPE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,INVTF ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,CONT + POPJ P, + ;MAY DROP THROUGH + + ;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPE T,EBLK3 ;JUMP IF NOT RELOCATABLE ASSEMBLY + TRNN T,SBLKS + TRNE T,ARIM10 + JRST ESBLK + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRNE FF,FIRWD + JUMPLE B,EBLK4 ;IGNORE NULL BLOCK IF FIRWD HASN'T BEEN CLEARED + TRZ FF,LOCF + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,OUTF ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FIRWD + POP P,B + POP P,A + POP P,TT + POP P,T + POPJ P, + +ALOC3A: SKIPN FF,CONTRL + TRZN FF,LOCF + POPJ P, + TRZ FF,FIRWD + JRST EBLK + + ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,NLIKF ;SUPPRESS ADR LINKING +PWRD: TRZ FF,NLIKF ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +] + SKIPE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,RCHK ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + MOVEI T,0 +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNN FF,NLIKF+GLOLOC + TRNE TT,1777 + JRST PWRD3 + SKIPN LDCCC + TRNE TT,MINF + JRST PWRD3 + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOS T + AOJA A,PWRD4 + +PWRD5: SOJN T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + CAIL T,3RDWRD + JRST PWRD3 + PUSH P,T +PWRD5E: CAMLE D,GLSP1 + JRST PWRD5B + MOVE A,1(D) + MOVEM A,(D) + AOJA D,PWRD5E +PWRD5B: SOS GLSP1 + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + BYB LDB A,A,\3RLNK_18. + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,OUTPUT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + MOVE A,CRLOC + 3GET1 B,D + TLZ B,100000 + JUMPE A,.+2 + TLO B,100000 + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: BYB LDB A,B,\MINF_18. + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLO A,40000 ;SYM IS GLO +PWRD3D: TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,OUTPUT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,OUTPUT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHK + HRRZ A,B + DPB C,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + + ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD + ;LEAVE RELOC (RH) IN B, RELOC (LH) IN C + +RCHK: HRRZ B,WRDRLC ;RELOCATION OF RIGHT HALF + HLRZ C,WRDRLC ;RELOCATION OF LEFT HALF (ASSUMING RIGHT HALF OK) + CAIE B,1 ;CHECK RIGHT HALF + JUMPN B,RLCERR + CAIE C,1 ;NOW LEFT HALF + JUMPN C,RLCERR + POPJ P, ;LOOKS OK +RLCERR: (1000+SIXBIT /IRC/) ;RELOCATION OTHER THAN 0 OR 1 ENCOUNTERED WHERE ONLY 0 OR 1 ALLOWED + POPJ P, + +RMOVE: MOVEI T,0 + DPB C,[430100,,T] ;R(LH) + DPB B,[420100,,T] ;R(RH) + MOVE C,T + POPJ P, + + ;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: MOVE A,GLSP1 + CAME A,GLSP2 + (2000+SIXBIT /ILA/) ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + (2000+SIXBIT /IRA/) ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,ARIM1 + JRST PRIM1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +PRIM1: MOVSI A,(HRRI TM,) + HRR A,WRD + PUSHJ P,PPB + MOVSI A,(HRRM TM,) + HRR A,CLOC + PUSHJ P,PPB + MOVSI A,(HRRI TM,) + HLR A,WRD + PUSHJ P,PPB + MOVSI A,(HRLM TM,) + HRR A,CLOC + JRST PPB + + ;.LIBRA, .LIFS, ETC. + +A.LIFN: MOVEI A,LTCN + JRST LIB9 + +A.LIFS: SKIPA A,[LTCP] +A.LIB: MOVEI A,LLIB +LIB9: HRRM A,LIB3 +LIB4: CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,SYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,LIMBO1 + CAIE B,12 + CAIN B,15 + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP + JRST LIB1 + +LIB3: MOVEI A,LLIB ;RH OVERWRITTEN ABOVE + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +LIBOP: 0 ;TEMP AT A.LIB, HAS SQUOZE BITS + +A.ELDC: PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRZ FF,FIRWD + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: LSH B,-27. + PUSH P,B + PUSHJ P,EBLK + MOVE A,[1000,,(SIXBIT /ULC/)] ;UNDEFINED IN LOADER CONDITIONAL + MOVEM A,GTVER + TRO I,PSEUDF + PUSHJ P,GETWRD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +AEND: +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARIA+1 + PUSHJ P,CNSTNT+1 + SKIPN A,CONTRL + PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT +AEND5D: TRNN FF,PSS ;IF PASS 2, + TRNN FF,NPSS ;OR IF 1PASS ASSEMBLY, + JRST AEND1 ;THEN MUCH HAIR, (IF RELOCATABLE THEN EVENTUALLY GOES TO AEND3) +AEND4: PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + TRZ FF,FIRWD + PUSHJ P,EBLK + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + +PS2": HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[PPSS,,PSS] ;SET PUNCHING PASS AND PASS 2 FLAGS + TRZ FF,GLOLOC ;RE-INITIALIZINT CURRENT LOCATION, CLEAR GLOBAL LOCATION FLAG + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVSI A,-SMK ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + (1000+SIXBIT /USW/) ;NO, JUST PLAIN UNDEFINED +PA2B: AOS A ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: TRZ FF,FIRWD + HRRM A,BKBUF + MOVEI A,LLDCM + DPB A,[310700,,BKBUF] + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + JRST EBLK + +PLOD": HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + + ;.SLDR + ;PUNCH OUT SBLK LOADER NOW AND SELECT SBLK FORMAT + +A.SLDR: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER + JRST SIMBLK ;SELECT SBLK FORMAT AND JRST ASSEM1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + TRO I,PSEUDF+DEF + MOVE A,[1000,,(SIXBIT /USE/)] ;UNDEFINED SYM IN END + MOVEM A,GTVER + PUSHJ P,GETWRD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + PUSHJ P,PNTR + PUSHJ P,LPTCLS" ;DONE LISTING +] + SKIPN CONTRL + JRST AEND3 ;RELOCATABLE + TLNN A,777000 ;CHECK INSTRUCTION PART + ADD A,[JRST] ;INSTRUCTION PART 0; HE WANTS JRST + PUSHJ P,PPB + JUMPG A,.+3 + 2000,,(SIXBIT /EWN/) ;END WORD NEGATIVE + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSHJ P,CNARTP + JRST RETURN + +A.LNKOT: PUSH P,CCASM1 + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVSI D,-SMK +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: AOS D + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS FF,ST+1(D) + TLZ C,3RLNK + 3PUT C,D + JRST AEND5C + + ;LOC, BLOCK, .= + +ALOC: SETZM BLOCKF + TLZ FF,INDEFF + TRO I,PSEUDF+DEF + PUSHJ P,EBLK + MOVE A,[1000,,(SIXBIT /USL/)] ;IF UNDEFINED SYM IN LOC +ABLK1: MOVEM A,GTVER + MOVEI A,", + MOVEM A,LIMBO1 + TLO I,UNRCHF + PUSHJ P,GETWRD + SKIPE BLOCKF + JRST ABLK2 + SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +ABLK3: TRNN I,DEF + JRST ALOC1 + MOVE T,GLSP2 + CAME T,GLSP1 + JRST ALOC3 + TRZE FF,GLOLOC + JRST ALOC5 +ALOC2: TRO FF,LOCF ;INDICATE ABS LOC ASSGT + HRRZM A,CLOC + HRRZM A,BKBUF + TDNE B,[-2] ;NO BITS ALLOWED EXCEPT LOW ORDER + 2000,,(SIXBIT /LAI/) ;ILLEGAL RELOCATION ATTEMPTED IN LOCATION ASSIGNMENT + HRRZM B,CRLOC ;STORE NEW RELOCATION + MOVEI A,2(B) ;LABS OR LREL +ALOC4: DPB A,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM A,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE + JRST ASSEM1 + +ALOC1: TLO FF,INDEFF ;LOCATION := INDEFINITE + MOVE A,[SQUOZE 0,INDEFF] + MOVEM A,SYSYM + MOVE A,CLOC + MOVEM A,SYLOC + TLNE FF,PPSS + 1000,,(SIXBIT /USL/) ;IF UNDEFINED SYM IN LOC + JRST ASSEM1 + +AXWORD: PUSHJ P,GETFLD ;XWD + MOVE C,CDISP + CAIN C,COMMA + JRST .+3 ;FIELD TERMINATOR WAS COMMA + TRNN I,FLD + JRST AXWORD ;NOT COMMA AND NO FIELD, TRY AGAIN + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + PUSHJ P,GETFLD ;NOW THE SECOND FIELD + TRNN I,FLD ;KEEP TRYING UNTIL A FIELD THERE + JRST .-2 + HRRM A,WRD + HRRM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +ALOC3: PUSHJ P,ALOC3A + MOVEI A,LCGLO + PUSHJ P,PLDCM + SETZM CLOC + MOVEI T,1 + MOVEM T,CRLOC + TRO FF,GLOLOC +AREL1: MOVEI A,LREL + JRST ALOC4 + +ALOC5: PUSH P,A + TRZ FF,FIRWD + MOVEI A,LCEGLO + PUSHJ P,PLDCM + POP P,A + JRST ALOC2 + +A.LENGTH: MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH + MOVEM A,A.LN1 + MOVEI B,0 + PUSHJ P,RCH + CAME A,A.LN1 + AOJA B,.-2 + MOVE A,B + JRST VALRET +A.LN1: 0 + +ABLOCK: TRO I,PSEUDF+DEF + PUSHJ P,EBLK + MOVE A,[1000,,(SIXBIT /USB/)] ;UNDEFINED SYM IN BLOCK + SETOM BLOCKF + JRST ABLK1 + +ABLK2: TRNE FF,GLOLOC + JRST ABLK4 +ABLK5B: MOVE A,CLOC + ADDB A,WRD + MOVE B,CRLOC + ADDB B,WRDRLC + JRST ABLK3 + +ABLK4: MOVEI T,$.H + AOS GLSP1 + HRRZM T,@GLSP1 + JRST ABLK3 + +ANOSYMS: TRZ FF,IPSYMS + JRST ASSEM1 + +AEXPUNG: + PUSHJ P,GETSYL ;GET NAME + PUSHJ P,ES + JRST .+3 + HRLZI A,400000 ;EXPUNGED ZERO SYM + MOVEM A,ST(D) + MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST ASSEM1 + JRST AEXPUNG + + ;UUO HANDLING ROUTINE + ;41 HAS JSR ERROR + +ERROR: 0 + PUSH P,T + LDB T,[331100,,40] ;PICK UP OP CODE + ORCMI T,77 + AOJE T,TYPR1 ;TYPR? + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + HRRZ T,40 + CAIE T,(SIXBIT /MDT/) ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,(SIXBIT /RES/) + SKIPA T,SYSYM1 + JRST .+4 ;NOT COLON LOSSAGE, SKIP UN-MUNGATUDE + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,.+4 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYO ;TYPE OUT PLUS SIGN, + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TAB" ;NOW SEPARATE WITH TAB + PUSH P,ERROR ;SAVE RETURN, MAYBE ABOUT TO EXECUTE ANOTHER UUO + PUSH P,40 ;ALSO SAVE UUO, NEED IT LATER + TRNE FF,GLOLOC ;LOCATION GLOBAL? + TYPR [ASCIZ /GLOBAL+!/] ;YES, TYPE OUT SAME + POP P,40 ;NOW RESTORE CRUFT + POP P,ERROR + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL + PUSHJ P,TAB ;SEPARATE FROM FOLLOWING WITH TAB + MOVE B,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + PUSHJ P,OCTPNT + PUSHJ P,TAB + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,DPNT ;TYPE IT OUT IN DECIMAL + PUSHJ P,TAB + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,DPNT + PUSHJ P,TAB + ;DROPS THROUGH + + ;DROPS THROUGH + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,7 ;ERROR UUO MAX + JRST .+1(A) + JRST IAE ;0 => NO RECV + JRST ERR2 ;1000 SYM+MESS + JRST ERR3 ;2000 MESS + JRST 4,. ;3000 RH(40) HAS JUMP ADR + JRST ERR4 ;4000 IGNORE LINE RET TO ASSEM1 + JRST ERR5 ;5000 RET TO ASSEM1 + JUMPL ERR2 ;6000 SYM ON PPSS + JRST ERRRET+1 + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: IDIVI A,50 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,SYMTYP + HLRZ A,(P) + JUMPE A,CPOPJ + CAIL A,"% + JRST SYMTP1 + CAIL A,13 + ADDI A,7 + ADDI A,257 + JRST TYO +SYMTP1: MOVE A,SYTB-45(A) + JRST TYO + +SYTB: ". + "$ + "% + +DPNT: IDIVI A,10. + HRLM B,(P) + SKIPE A + PUSHJ P,DPNT + JRST DPNT1 + +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 +DPNT1: HLRZ A,(P) + ADDI A,200+"0 + JRST TYO + + +ERR4: PUSHJ P,RCH ;4000,, => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 + +ERR5: MOVEI A,ASSEM1 ;5000,, => RETURN TO ASSEM1 + MOVEM A,ERROR +ERR2: MOVE A,SYM ;1000,, OR 6000,, ON PPSS; TYPE OUT SYM THEN MESSAGE + PUSHJ P,SYMTYP + PUSHJ P,TAB +ERR3: HRLZ B,40 ;2000,, JUST TYPE OUT MESSAGE + PUSHJ P,SIXTYO +ERRRET: PUSHJ P,CRR + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B +TYPR1A: POP P,T + JRST 2,@ERROR + + ;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYO + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +IAE: HRLZ B,40 ;OP CODE 0 => NO RECOVERY RETURN TO GO2 + PUSHJ P,SIXTYO + PUSHJ P,TAB + SOS B,ERROR ;MAKE OUTPUT POINT TO ERROR INSTRUCTION + PUSHJ P,OCTPNT + JRST GO2" + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: HRLZI B,440700 ;CONVERT TO BYTE POINTER + HRR B,40 ;GET ADR OF BEGINNING OF STRING + ILDB A,B ;GET NEXT CHAR + CAIN A,"! + JRST TYPR1A + PUSHJ P,TYO ;NON-ZERO, TYPE IT OUT + JRST .-4 + +PS1": HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN +SIMBLK: SKIPA A,[SBLKS] ;ENTRY FROM PS1, A.SLDR SELECT SBLK +SRIM1: MOVEI A,ARIM1 + TRO FF,NPSS + TLO A,TRIV + MOVEM A,CONTRL ;STORE NEW CONTRL +IFN A1PSW,PUSHJ P,OUTUPD + JRST ASSEM1 + +SRIM10: SKIPA A,[ARIM10] +SRIM: MOVEI A,ARIM + JRST SRIM1+1 + +AEXP: TRZ I,SYL+LET ;OLD EXP, OCT ROUTINE +CABPOP: CLEARB A,B + POPJ P, + +ATITLE: MOVEI A,15 + TRNN FF,PSS ;PRECEDE W/ CR ON PASS 1 + PUSHJ P,TYO + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: SOSGE STRCNT + JRST ATIT1 + ILDB A,T + PUSHJ P,TYO + JRST ATIT2 +ATIT1: CAIN A,12 + JRST ASSEM1 + PUSHJ P,RCH + PUSHJ P,TYO + JRST ATIT1 + +ASBEG: HRLZI A,1 ;.BEGIN + ADDM A,LEV + JRST ASSEM1 + +ASEND: MOVSI TT,400000 ;.END, PREPARE TO EXPUNGE ALL SYMS ON THIS LEVEL + HRLZI T,-SMK +ASEND2: SKIPE B,ST(T) + TDNN B,[37777,,-1] + JRST ASEND1 ;NAME NULL + 3GET B,T ;NOT NULL, GET 3RDWRD + TLZ B,777700 + CAIN B,77 + JRST ASEND1 + CAMN B,LEV + MOVEM TT,ST(T) +ASEND1: AOS T + AOBJN T,ASEND2 + HRLZI A,-1 + ADDM A,LEV + JRST ASSEM1 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,AIOWD ;YES +CLBPOP: MOVEI B,0 +CPOPJ: POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: MOVEI A,FRSTDS + MOVEI B,LDDSYM +RESYM: HRRM A,DISPT + TRZ I,CONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVSI AA,-SMK +SYMD5: CLEARM CLOC + CLEARM BKBUF + JUMPN T,SYMD4 ;JUMP IF NOT RELOCATABLE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC +SYMD4: SKIPE B,ST(AA) ;GET SYMTAB ENTRY + TDNN B,[37777,,-1] ;IF SQUOZE IS NULL, + JRST SYMD1 ;THEN TRY AGAIN + MOVEI C,0 + ROTC B,4 ;SHIFT FLAGS INTO C + MOVE D,ST+1(AA) + 3GET CH1,AA + JRST @DISPT + +FRSTDS: JRST SYMD1 + JRST SYMD1 + JRST SYMD6 + JRST SYMD1 + JRST SYMD3 + JRST SYMD1 + JRST SYMD3A + JRST SYMD1 + JRST SYMD2A + JRST SYMD1 + +SYMD3A: JUMPE T,SYMD1 +SYMD3: HRRZS FF,D +SYMD2: TLNE CH1,3LLV ;IF LINKING LOADER MUST INSERT VALUE, + JRST SYMD1 ;THEN IGNORE + ROT B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + JUMPE T,SYMD2B + TLO B,40000 + TLNE CH1,3SKILL + TLO B,400000 ;HALF-KILL + MOVEM B,WRD + PUSHJ P,PWRD + MOVEM D,WRD + PUSHJ P,PWRD +SYMD1: AOS AA + AOBJN AA,SYMD4 + PUSHJ P,EBLK + JUMPE T,SYMDA + MOVE A,STARTA + JRST PPB + +SYMD2A: JUMPN T,SYMD2 + JRST SYMD1 + + ;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +SYMD2B: TLNE CH1,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH1,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH1,3SKILL + TLO B,400000 ;HALF-KILL + MOVE A,B + PUSHJ P,OUTPUT ;OUTPUT SYM + MOVE A,D + PUSHJ P,OUTPUT ;OUTPUT VALUE + JRST SYMD1 + +IFN A1PSW,[ + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS OTHER THAN 1PASS AND .LIBRA + +OUTUPD: TRNN FF,PSS ;IF PASS 1, + TLZ FF,PPSS ;THEN INDICATE NOT PUNCHING PASS + TROE FF,NPSS + TLNN FF,OUTF + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,OUTF + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY + POPJ P, +] + +SYMD6: TLNN CH1,"? + JRST SYMD1 + JRST SYMD2 + +CNARTP: MOVNI D,1 +CNTP1: MOVEI TT,PCNTB + CAML TT,PBCONL + POPJ P, + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /CONSTANTS AREA INCLUSIVE +FROM TO +!/] + BYB LDB B,2(TT),\CGBAL_18. + SKIPE B + TYPR [ASCIZ /GLOBAL+!/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TAB + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRR +CNTP2: ADDI TT,3 + JRST CNTP1+1 + +SYMDA: MOVE B,CDATBC + CAIN B,13 + JRST PTERMN + MOVEI A,LPRGN + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,OUTPUT + PUSHJ P,OUTPUT + PUSHJ P,EBLK + MOVEI B,13 + MOVEI A,DISP2 + JRST RESYM + +DISP2: JRST SYMD1 + JRST SYMD1 + JRST CHKLL + JRST HLFKL1 + JRST CHKLL + JRST SYMD1 + JRST SYMD1 + JRST SYMD1 + JRST SYMD1 + JRST SYMD1 + +CHKLL: TLNN CH1,3VP+3LLV + JRST SYMD1 + +HLFKL1: ROT B,-4 + TLZ B,740000 + MOVE A,B + TLNE CH1,3SKILL + PUSHJ P,OUTPUT + JRST SYMD1 + +DISPT: (C) + +PTERMN: MOVEI A,LPTRMN + DPB A,[310700,,BKBUF] + PUSHJ P,OUTPUT + PUSHJ P,OUTPUT + JRST EBLK + +A.OP: PUSHJ P,AGETFD + (1000+SIXBIT /U.0/) ;UNDEFINED SYMBOL IN FIELD 0 + PUSH P,A + PUSHJ P,AGETFD + (1000+SIXBIT /U.1/) ;UNDEFINED SYMBOL IN FIELD 1 + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + (1000+SIXBIT /U.2/) ;UNDEFINED SYMBOL IN FIELD 2 + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TDNN T,[757,,-1] ;DO NOT SUPPLY AC AND ADR FIELDS IF ANY BITS ON + ;IN INTRUCTION'S AC,X,OR ADR FIELDS + IOR T,[0 A,B] + XCT T + JFCL ;DON'T CARE IF IT SKIPS + JRST VALRET + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + JRST AASC1 + +ASIXBIT: SKIPA D,[440600,,T] +AASCII: MOVE D,[440700,,T] + SETOM AASCF1 ;INDICATE REGULAR +AASC1: MOVEI T,0 + TLZE I,MWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH ;SPACE, GET NEXT CHAR FOR USE AS DELIMITER + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + PUSHJ P,LOWRCS + SUBI A,40 + CAIG A,77 + JUMPGE A,.+2 + (2000+SIXBIT /N6B/) +AASC3: IDPB A,D + TRO I,SYL + JRST TEXT7 + + ;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST TEXT5 ;REGULAR OR NOT END OF WORD + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + MOVE D,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TRNN FF,PSS + TRNN FF,NPSS + MOVE D,[(2000+SIXBIT /USA/)] ;PUNCHING PASS, UNDEFINED => REAL ERROR + MOVEM D,AASM1 + CLEARM ASUDS1 + PUSHJ P,AGETFD +AASM1: . ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: MOVE A,LIMBO1 + JRST AASC8 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + TLO I,MWRD + MOVE A,T + JRST CLBPOP + +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,LIMBO1 + CAIE B,15 + CAIN B,12 + JRST VALR1 ;WORD TERMINATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,SYL + 2000,,(SIXBIT /NOS/) ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,SYL +TEXT10: JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + TRO I,FLD + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A + JRST TEXT5 ;ASCIZ + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 3 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 + +IGTXT: PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 + TLZ I,MWRD + JRST POPAJ + +ARDIX: PUSHJ P,GETWRD ;GET WORD ARG + MOVEM A,ARADIX + JRST ASSEM1 + +AEQUAL: PUSHJ P,GETSYL + PUSHJ P,ES + MOVEM SYM,ST(D) + PUSH P,SADR + PUSHJ P,GETSYL + PUSHJ P,ES + (5000+SIXBIT /IEQ/) + POP P,T + DPB A,[(400400) ST(T)] + MOVEM B,ST+1(T) + 3GET B,T + TLNE B,3MAS + TLO C,3MAS + 3PUT C,T + JRST ASSEM1 + +AWORD: PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +A1PASS: IFN A1PSW,PUSHJ P,OUTUPD + TLO FF,PPSS +IFE A1PSW,[ TRZ FF,NPSS +ARELOC:] +IFN A1PSW,[ TRZA FF,NPSS +ARELOC: PUSHJ P,OUTUPD +] +ARELC1: CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + JRST AREL1 + +AOFFSET: TRO I,PSEUDF+DEF ;OFFSET + PUSHJ P,EBLK + MOVE A,[1000,,(SIXBIT /USO/)] ;UNDEFINED SYMBOL IN OFFSET + MOVEM A,GTVER + PUSHJ P,GETWRD ;GET ARG + TRNN I,DEF + JRST ALOC1 + MOVE T,GLSP2 + CAME T,GLSP1 + JRST AOFFS1 + TRZE FF,GLOFFS + JRST AOFFS3 +AOFFS2: MOVEM A,OFLOC + MOVEM B,OFRLOC + JRST ASSEM1 + +AOFFS1: PUSHJ P,ALOC3A + MOVEI A,LDOFS + PUSHJ P,PLDCM + TRO FF,GLOFFS + SETZB A,B + JRST AOFFS2 + +AOFFS3: PUSH P,A + TRZ FF,FIRWD + MOVEI A,LDROFS + PUSHJ P,PLDCM + POP P,A + JRST AOFFS2 + +APRNTC: +APRNTX: MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH +APRTX1: MOVE T,A + PUSHJ P,RCH + CAIN A,"! + JUMPGE B,.-2 + CAMN A,T + JRST ASSEM1 + PUSHJ P,TYO + JRST APRTX1+1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP=. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO=. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD=. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW=. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB=. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1=. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2=. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA=. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10=. + +ASQOZ: PUSHJ P,AGETFD + (2000+SIXBIT /USS/) + LSH A,36 + PUSH P,A +ASQOZ3: PUSHJ P,GETSYL + TRNN I,SYL + JRST ASQOZ2 +ASQOZ4: TLZ SYM,740000 + POP P,A + ADD A,SYM + TLO I,UNRCHF + JRST VALRET +ASQOZ2: CAIE A,15 + CAIN A,12 + JRST ASQOZ4 + JRST ASQOZ3 + + ;.LOP + +A.LOP: SKIPE CONTRL + 5000,,(SIXBIT /ILO/) ;.LOP WHEN NOT IN RELOCATABLE OUTPUT FORMAT + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK +REPEAT 2,[PUSHJ P,GETFLD ;GET THE FIELDS + MOVEM A,WRD + MOVEM B,WRDRLC + PUSHJ P,PWRDA + MOVEI A,GLOTB + MOVEM A,GLSP1 + MOVEM A,GLSP2 +] PUSHJ P,GETFLD + MOVEM A,WRD + MOVEM B,WRDRLC + MOVEI A,LD.OP + PUSHJ P,PLDCM + JRST ASSEM1 + + ;YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLLZM B,STGSW + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: PUSHJ P,GETSYL + TRNN I,SYL + JRST ASSEM1 + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LIBRQ + + ;.GLOBAL + +A.GLOB: TRO I,PSEUDF +AGLOB1: MOVEI A,GLOTB + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSYL ;GET NAME + TRNN I,SYL + JRST ASSEM1 ;NO NAME => DONE + TLO I,GLI ;SET DOUBLEQUOTE FLAG + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + JRST AGLOB1 ;LOOP FOR NEXT SYM + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: PUSHJ P,AGETFD + 1000,,(SIXBIT /USG/) + MOVEM A,GENSM + JRST ASSEM1 + + ;.TYPE + +A.TYPE: PUSHJ P,GETSYL ;GET NAME + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN + JRST VALRET + + ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) + ;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY + ;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: PUSHJ P,BCOMPA + MOVEM CH2,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE CH2,A.GST3 + PUSHJ P,CCOMP + JRST POPJ1 + +A.ENTRY: + MOVEI A,LENTRY +ENTRY3: PUSH P,A + PUSHJ P,EBLK + TRO I,PSEUDF +ENTRY1: SETOM FLDCNT + PUSHJ P,GETSYL + TRNN I,SYL + JRST ENTRY2 + PUSHJ P,OUTSM + TLO I,GLI + PUSHJ P,GETVAL + MOVEI A,GLOTB + MOVEM A,GLSP1 + JRST ENTRY1 +ENTRY2: POP P,A + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + JRST ASSEM1 + +A.EXTERN: + MOVEI A,LEXTERN + JRST ENTRY3 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: LSHC A,-2 + LDB CH1,[420200,,B] ;PICK UP HIGH ORDER BITS OF POSITION FIELD + MOVE B,MACTAB(A) ;GET WORD FROM MACTAB + IMULI CH1,-2 + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + JRST AG.SP2(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,MACTAB(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF +AG.SP2: TLNN B,300_10. + JSP CH1,AG.SF +AG.SP1: SOJA A,AG.SP3 + +AG.SF: MOVNI CH1,(CH1) + ADDI CH1,AG.SP1 + LSH CH1,-1 + LSH A,I + ADDI A,(CH1) + HRRZS A + POPJ P, + +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR + +CCOMP: TDZA A,4 +CCOMP1: IBP CH2 + TLNE CH2,700000 + SOJA A,CCOMP1 + SUBI CH2,MACTAB + LSH CH2,2 + ADDI A,4(CH2) + POPJ P, + +BCOMPA: SKIPE CH1,A + SOS CH1 + IDIVI CH1,4 + MOVE CH2,PTAB(CH2) + ADD CH2,CH1 + TLZ CH2,17 + POPJ P, + +A.TAG: PUSHJ P,GSYL + JRST ASSEM1 + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TRNN FF,MACRCH + JRST ASSEM1 ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + PUSHJ P,REDINC + CAIN B,374 + ADDI A,2 + PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + SETOM CPTRB + JRST ASSEM1 + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] + CAIN A,AIRP4 + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + (SIXBIT /UCP/) ;DON'T HAVE RETURN, + +A.GO4: HRRZS -2(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,MRSW ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + +A.BYTE: CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + (1000+SIXBIT /UBS/) + MOVE C,ISAV + TRNN C,FLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: CAIE CH1,15 + CAIN CH1,12 + JRST .+2 + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + PUSHJ P,BYSET + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + +A.WALGN: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE A,BYTW + MOVEM A,WRD + CLEARM BYTW + MOVEI A,44 + DPB A,[360600,,BYTWP] + PUSHJ P,PWRD + AOS CLOC +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST ASSEM1 + MOVEI A,0 ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS + MOVE A,WRD +PBY2: IDPB A,BYTWP + JUMPGE FF,BYTINC + SKIPE WRDRLC + (1000+SIXBIT /RIB/) + MOVE A,GLSP1 + CAME A,GLSP2 + (1000+SIXBIT /GIB/) + JRST BYTINC + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BYBYT: BLOCK LBYBYT ;BYTE DESC TABLE, 7 BITS PER DESC + +A.BYTC: MOVE A,NBYTS + JRST CLBPOP + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +ACSAV: BLOCK 7 + +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE GET + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 +TERMIN + +DEFINE GETT + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 + IDPB A,TPN +TERMIN + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER + MOVE TM,[P,,ACSAV] + BLT TM,ACSAV+6 + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: GET ;CONTINUE STATEMENT RC + GET ;LF + GET ;. + CAIE A,". ;DOT + JRST BDCONT + GET ;F OR I + GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,PSS ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + + +UP: SKIPN STRING ;FOR (NUMBER)^N + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: .VALUE ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: .VALUE + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: GET + CAIE A,12 ;LF + JRST GETLF + MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWRET ;GO BACK + +MVOI: MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] + PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + + ;.INSRT FILEDESCRIPTION + ;INSERT FILE HERE + ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE + ;PUSHES MACRO EXPANSION, OTHER .INSRT'S + ;IN FILEDESCRIPTION,  => RESET FILE NAME COUNTER + +;IO CHANNELS +AICF"==13 + +A.INSR: SETOM FFFLG + PUSH P,B + MOVE A,[37,,AFNAM2+41-3] ;Length of AFNAM2 +BLKPSH: MOVE B,(A) + MOVEM B,2(A) + SUB A,[1,,1] + JUMPGE A,BLKPSH + POP P,B + MOVE A,[DNAM,,TDNM] + BLT A,TSNM + SETZM INDDF + SETZM INFNFG +A.IN1: PUSHJ P,GETSBS + CAIN B,": + JRST INCOL + CAIN B,"; + JRST INSEMC + CAIE B,15 + JUMPE SYM,A.IN1 + CAIN B,15 + JUMPE SYM,A.IN2 + SKIPGE FFFLG + MOVEM SYM,TF2 + AOSG FFFLG + JRST A.IN5 + EXCH SYM,TF2 + MOVEM SYM,TF1 +A.IN5: CAIE B,15 + JRST A.IN1 + +A.IN2: SKIPE INDDF + JRST A.IN4 + HRRZ A,TDNM + CAIN A,400000 + JRST INDDV + MOVEI B,0 +A.IN3: MOVE A,TSNM(B) + .SUSET [.SSNAM,,A] + .IOPUSH UTYIC, + MOVE A,TF1(B) + MOVEM A,AFNAM1 + MOVE A,TF2(B) + MOVEM A,AFNAM2 + .OPEN UTYIC,TDNM(B) + JRST INFNF + MOVE A,[UTYIC,,TEMFNM] + .RCHST A, + SKIPN A,TEMFNM+1 + JRST A.IN10 + MOVEM A,INFN1 + MOVE A,TEMFNM+2 + MOVEM A,INFN2 +A.IN10: MOVE B,INPDLP + PUSH B,UTIBED + PUSH B,UREDP + PUSH B,IBUFOF + PUSH B,EOFCH + MOVEM B,INPDLP + MOVEI A,40 ;XXX What constant? + ADDM A,IBUFOF + ADDB A,UTIBED + SOS A + HRLI A,700 + MOVEM A,UREDP + MOVE A,IBUFOF + MOVE B,EOFCH + LSH B,35 + MOVEM B,UTIBE(A) + AOS A,ILEVEL + CAIL A,5 + (SIXBIT /IOV/) + JRST ASSEM1 + +INCOL: JUMPE SYM,A.IN1 + HLRM SYM,TDNM + JRST A.IN1 + +INSEMC: JUMPE SYM,A.IN1 + MOVEM SYM,TSNM + JRST A.IN1 + +GETSBS: MOVEI SYM,0 + PUSHJ P,RCH + PUSHJ P,LOWRCS + SKIPA B,[440600,,SYM] +GTSBS: PUSHJ P,RCH + PUSHJ P,LOWRCS + CAIG A,40 + JRST GTSBS1 + CAIE A,"; + CAIN A,": + JRST GTSBS1 + SUBI A,40 + TLNE B,770000 + IDPB A,B + JRST GTSBS +GTSBS1: MOVE B,A + POPJ P, + +A.IN4: MOVE B,INDDP + SUBI B,4 + MOVE A,[TDNM,,TDNM] + ADD A,B + BLT A,TSNM(B) + PUSHJ P,POPTT + JRST A.IN3 + +INDDV: SETOM INDDF + MOVE B,INDDP +INDVL2: MOVE A,TF1 +INDVL1: CAIG B,4 + JRST INDV1 + SUBI B,10 + CAME A,TF1(B) + JRST INDVL1 + MOVE A,TF2 + CAME A,TF2(B) + JRST INDVL2 + MOVE A,TSNM + CAME A,TSNM(B) + JRST INDVL2 + MOVE A,TDNM + CAME A,TDNM(B) + JRST INDVL2 + ADDI B,4 + JRST A.IN3 + +INDV1: MOVE B,INDDP + CAILE B,BYTM + (SIXBIT /TM@/) + ADDI B,10 + EXCH B,INDDP + SETOM FFFLG + MOVE A,[TDNM,,TDNM] + ADD A,B + BLT A,TSNM(B) + PUSHJ P,GTYIP + AOSN INFNFG + POPJ P, + MOVE A,DNAM + MOVEM A,TDNM + JRST A.IN1 + +INFNF: SETOM FFFLG + .IOPOP UTYIC, + SKIPN INDDF + JRST INFNF2 + PUSHJ P,TYPFIL + TYPR [ASCIZ / NOT FOUND. TRY AGAIN. +!/] + MOVS B,INDDP + SUB B,[7,,0] + PUSHJ P,GTYIP + JRST A.IN1 + +GTYIP: MOVE A,[PUSHJ P,RCHA] + PUSHJ P,PUSHTT + TRO FF,TTYRCH + POPJ P, + +INFNF2: SETOM INFNFG + PUSHJ P,INDDV + (2000+SIXBIT /FNF/) + PUSHJ P,TYPFIL + TYPR [ASCIZ / CORRECTION PLEASE. +!/] + JRST A.IN1 + + + ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION + +TYPFIL: SKIPA SYM,[-4,,] +TYPF2: SKIPA B,TDNM(SYM) + HRLZ B,TDNM(SYM) ;DEVICE NAME + PUSHJ P,SIXTYO ;TYPE OUT NAME + MOVE A,FILSPC(SYM) ;NOW GET DELIMITING CHARACTER + PUSHJ P,TYO ;TYPE OUT + AOBJN SYM,TYPF2 ;LOOP FOR ALL NAMES + POPJ P, + +FILSPC: ": + 40 ;SPACE + 40 + "; + + ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +PUSHTT: PUSH P,F + MOVE F,ITTYP ;GET RELEVANT PDL POINTER + PUSH F,GETCHR + MOVEM A,GETCHR + MOVE A,LIMBO1 + TLZE I,UNRCHF + TLO A,1 + TRZE FF,MACRCH + TLO A,2 + TRZE FF,TTYRCH + TLO A,4 + PUSH F,A +POPTT1: MOVEM F,ITTYP + POP P,F + POPJ P, + +POPTT: PUSH P,F + MOVE F,ITTYP + POP F,A + POP F,GETCHR + HRRZM A,LIMBO1 + TRZ FF,MACRCH+TTYRCH + TLNE A,4 + TRO FF,TTYRCH + TLNE A,2 + TRO FF,MACRCH + TLZ I,UNRCHF + TLNE A,1 + TLO I,UNRCHF + JRST POPTT1 + +IFN TS,[ ;BEGIN TS ROUTINES + +IFNDEF MAXIND,MAXIND==20 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT + +TYIC==1 ;TTY INPUT CHANNEL +TYOC==2 ;TTY OUTPUT CHANNEL +UTYIC==3 ;INPUT FILE +UTYOC==4 ;OUTPUT FILE +LPTC==5 ;LISTING (LPT) + + ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE + ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED) + +IFNDEF LTYPDL,LTYPDL==12 +ITTYP: -LTYPDL,,TTYPDL-1 ;PDL POINTER +TTYPDL: BLOCK LTYPDL + + ;INPUT FILE AND BUFFER VARIABLES + +TDNM: 0 +TF1: 0 +TF2: 0 +TSNM: BLOCK 201 + + ;PDL + +INPDLP: INPDL-1 ;IO PDL POINTER +INPDL: BLOCK 30 ;I(O) PDL + +ILEVEL: 0 +FFFLG: 0 +INDDF: 0 +INDDP: 0 +INFNFG: 0 +TEMFNM: BLOCK 5 +INFN1: 0 +INFN2: 0 + +HINIT: MOVEI A,(SIXBIT \DSK\) + MOVEM A,DNAM + MOVEM A,ONAM + MOVE A,[50,,FNAM1] + BLT A,FNAM2 + MOVE A,50 + MOVEM A,ONAM+1 + MOVEI A,(SIXBIT \BIN\) + MOVSM A,ONAM+2 + JRST GO21 + +TSINT: 0 ;ALL INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS + 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS + + MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING + MOVE A,TSINT ;GET INTERRUPT REQUEST WORD + MOVEI B,(SIXBIT /INT/) ;DEFAULT + SOS TSINT+1 ;MAKE IT POINT TO PLACE INTERRUPT CAME FROM + TRNN A,200000 ;PDL OVERFLOW? + JRST TSINT7 ;NO + LDB A,[270400,,@TSINT+1] ;GET AC FIELD OF GUILTY INSTRUCTION + CAIN A,P ;IF P, + MOVE P,[-LPDL,,PDL] ;RESET PDL POINTER + AOSN FUNPDL + JRST BTBHAC + MOVEI B,(SIXBIT /PDL/) +TSINT7: TRNE A,20000 ;MEMORY PROTECTION VIOLATION? + MOVEI B,(SIXBIT /ILM/) ;YES + MOVEM B,40 + AOS A,TSINT+1 ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY + JSA A,ERROR + +INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING + +BTBHAC: POP P,TSINT+1 + .DISMIS TSINT+1 + +.IOT=40000,, ;LEAVE HERE SO THAT IT WILL ASSEMBLE OUT OF TS +.OPEN=41000,, +.OPER=42000,, +.CALL=43000,, +.VALUE=.CALL 4, +.CORE=.CALL 6, +.SUSET=.CALL 13, +.CLOSE=.OPER 7 +.IOPUSH=.OPER 13 +.IOPOP=.OPER 14 +.IOPDL=.OPER 57 +.FEED=.OPER 72 +.SMASK==400006 +.RSNAM==16 +.SSNAM==400016 +.SPICL==400017 + +BEG: .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME + .SUSET [.SMASK,,[220000]] ;PDL OVERFLOW,MEMORY PROTECTION VIOLATION + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT) + .SUSET [.RJNAM,,JNAME] + SKIPN 51 + JRST .+3 + MOVEM A,ISYSNM + MOVEM A,OSYSNM + MOVE P,[-LPDL,,PDL] + .CORE /2000 + JRST .-1 + .OPEN TYIC,[30,,SIXBIT / TTYMIDAS INPUT/] + .VALUE + .OPEN TYOC,[1,,SIXBIT / TTYMIDAS OUTPUT/] + .VALUE + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + HRRM A,SP1 ;MARK END OF SYMS + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM + DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST .-3 + MOVE A,INCHR + MOVEM A,RRL1 + SKIPE 51 + JRST HINIT ;RETURNS TO GO21 + MOVE B,[SIXBIT /MIDAS./] + PUSHJ P,SIXTYO + MOVE B,JNAME ;if invoked as MIDASD, print E&S before version + CAME B,[SIXBIT /MIDASD/] + JRST .+3 + MOVSI B,(SIXBIT/E&S/) + PUSHJ P,SIXTYO + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO +GO2: SETOM PRGC + SETOM OUTC + PUSHJ P,CMD ;GET TYPED IN COMMAND +GO21: PUSHJ P,WINIT ;OPEN OUTPUT FILE + PUSHJ P,OPNRD ;OPEN INPUT FILE + MOVE A,[UTYIC,,A] + .RCHST A, + JUMPN B,GO22 + MOVE B,FNAM1 + MOVE C,FNAM2 +GO22: MOVEM B,RFNAM1 + MOVEM B,INFN1 + MOVEM C,RFNAM2 + MOVEM C,INFN2 +GO3: JSP A,INIT + JSP A,PS1 +IFN A1PSW,[ + AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED + SETOM OUTC ;" " " +] + TRNE FF,NPSS ;IF 2 PASS ASSEMBLY, + PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE + JSP A,PLOD + JSP A,PS2 + JSP A,PSYMS +IFN A1PSW,[ + TRNN FF,NPSS ;IF 1 PASS ASSEMBLY, + JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM +] +RETN2: PUSHJ P,.FILE + .VALUE [ASCIZ /:KILL /] + JRST BEG + + ;GET (JUST TYPED IN) CHAR IN A + +TYI: .IOT TYIC,A + CAIN A,32 + .VALUE + CAIN A,^R + JRST TYO + CAIE A,15 + CAIN A,12 + JRST TYO + POPJ P, + +TAB: MOVEI A,11 +TYO: .IOT TYOC,A ;TYPE OUT CHAR IN A + POPJ P, + + ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR + +INCHR: +RPA: ILDB A,UREDP +RPAE: CAME A,EOFCH + POPJ P, +INCHR3: HRRZ A,UREDP ;GET BYTE POINTER + CAMN A,UTIBED ;END OF COMPLETELY READ BLOCK? + JRST UTRLD ;YES + SOSL ILEVEL + JRST IFPOP + PUSHJ P,OUTCHK + MOVSI A,-4 + XCT NEDT(A) + AOBJN A,.-1 + JUMPGE A,RETN2 + MOVE A,[70700,,EOFCH] + MOVEM A,UREDP + (SIXBIT /NED/) + +UTRLD: MOVE A,[-,,UTIBUF] + ADD A,IBUFOF + .IOT UTYIC,A + JUMPGE A,UTRLD1 + HRRZM A,RPAT1 + HRLZ A,EOFCH + LSH A,13 + HLLM A,@RPAT1 +UTRLD1: MOVE A,[700,,UTIBUF-1] + ADD A,IBUFOF + MOVEM A,UREDP + JRST INCHR + +IFPOP: PUSH P,B + PUSH P,A + MOVE A,[AFNAM2+1,,AFNAM1] + BLT A,AFNAM2+41-3 ;Length of AFNAM2 + POP P,A + MOVE B,INPDLP + POP B,EOFCH + POP B,IBUFOF + POP B,UREDP + POP B,UTIBED + MOVEM B,INPDLP + MOVE A,IBUFOF + MOVE B,EOFCH + LSH B,35 + MOVEM B,UTIBE(A) + POP P,B + .IOPOP UTYIC, + JRST INCHR + +IFN A1PSW,[ ;HOLLAR "NED" IF ANY OF THE FOLLOWING: +NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED + SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT + SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE + TRNN FF,PSS ;CURRENTLY IN PASS 2 +LNEDT==.-NEDT ;LENGTH OF TABLE +] + + ;TS OUTPUT ROUTINES + +TPPB: IDPB A,UTYOP ;OUTPUT WORD + AOSGE UTYOCT ;SKIP IF BUFFER FULL + POPJ P, +TPPBF: MOVEM A,UTYOP + MOVE A,[UTOBUF,,-200] ;Length of UTOBUF + SUB A,UTYOCT + MOVSS A + .IOT UTYOC,A + MOVNI A,200 + MOVEM A,UTYOCT + MOVE A,[4400,,UTOBUF-1] + EXCH A,UTYOP + POPJ P, + +.FILE: MOVNI A,1 + PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF + PUSHJ P,TPPBF ;OUTPUT THE BUFFER + .CLOSE UTYIC, + .CLOSE UTYOC, + POPJ P, + +WINIT: MOVEI A,7 + HRLM A,ONAM + .SUSET [.SSNAM,,OSYSNM] ;SET SYSTEM NAME + .OPEN UTYOC,ONAM + (SIXBIT /TSL/) + TLZ FF,PTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH + .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL + ANDI A,77 ;MASK TO DEVICE CODE + CAIN A,7 ;IF PAPER TAPE PUNCH, + TLO FF,PTPF ;THEN SET PTPF + MOVE A,[4400,,UTOBUF-1] + MOVEM A,UTYOP + MOVNI A,200 + MOVEM A,UTYOCT + MOVEI A,4 + MOVEM A,INDDP + POPJ P, + +TFEED: TLNN FF,PTPF ;IF OUTPUT DEVICE NOT PTP, + POPJ P, ;THEN DO NOTHING + PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER, +TFEED1: .FEED UTYOC, ;FEED A LINE, + TLZA FF,PTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL + SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES, + POPJ P, ;AND RETURN + + ;TS INPUT ROUTINES + + ;OPEN MAIN INPUT FILE FOR READING + +OPNRD: .IOPDL ;RE-INITIALIZE IO PDL + MOVEI A,2 ;BLOCK ASCII INPUT + HRLM A,DNAM ;SET UP LH(DNAM) FOR MODE SPECIFICATION FOR .OPEN + MOVE A,FNAM1 + MOVEM A,AFNAM1 + MOVE A,FNAM2 + MOVEM A,AFNAM2 + .SUSET [.SSNAM,,ISYSNM] ;SET SYSTEM NAME FOR .OPEN + .OPEN UTYIC,DNAM ;TRY IT + (SIXBIT /FNF/) + MOVEI A,UTYIC + .EOFC A, + MOVEM A,EOFCH + LSH A,35 + MOVEM A,UTIBE + MOVE A,[700,,UTIBE-1] + MOVEM A,UREDP + MOVEI A,UTIBE + MOVEM A,UTIBED + SETZM ILEVEL + SETZM IBUFOF + MOVEI A,INPDLP + MOVEM A,INPDLP + MOVE A,[-LTYPDL,,TTYPDL-1] + MOVEM A,ITTYP + POPJ P, + +EOFCH: 0 +RPAT1: 0 +IBUFOF: 0 +UTIBED: UTIBE + + ;TTY ROUTINES + + ;GET CHARACTER IN A, READ NEW STRING IF OLD EXHAUSTED (USED BY CMD) + +RCHA: ILDB A,CMPTR ;GET CHARACTER + JUMPN A,CPOPJ ;RETURN IF VALID +RCHA1: MOVE B,[10700,,CMBUF-1] + MOVEM B,CMPTR +RCHA2: PUSHJ P,TYI + CAIN A,177 + JRST RCHA3 + IDPB A,B + CAIE A,15 + JRST RCHA2 + MOVEI A,0 + IDPB A,B + JRST RCHA + +RCHA3: CAMN B,[10700,,CMBUF-1] + JRST RCHA4 + LDB A,B + ADD B,[70000,,] + SKIPGE B + SUB B,[430000,,1] + PUSHJ P,TYO + JRST RCHA2 + +RCHA4: PUSHJ P,CRR + JRST RCHA1 + + + ;GET COMMAND + +;FLAGS (IN FF) (LH => INPUT, RH => OUTPUT) +;OTHER AC'S: C HAS COMPLETE NAME, D NAME BEING BUILT UP, TT BYTE POINTER TO C + +SIF==400000 +COLF==200000 +NAMF==100000 +NAM2F==40000 +DEVF==20000 +SCOLF==10000 +SYSNF==4000 + +CMD: PUSHJ P,CRR + MOVSI A,(SIXBIT/>/) + MOVEM A,FNAM2 + SETZB FF,CMPTR +CMDB: SETZM SUBNM ;CLEAR OUT NAME + MOVE TT,[10600,,SUBNM-1] +CMDL: PUSHJ P,RCHA ;READ CHARACTER FROM TTY + CAIN A,^Q + JRST CMDQ + CAIGE A,40 + JRST CMDE + CAIN A,": + JRST CMDCOL + CAIN A,"; + JRST CMDSC + CAIN A,"_ + JRST CMDLA + CAIN A,40 + JRST CMDS +IFN LISTSW,[ + CAIN A,"( + JRST CMDSW +] +CMDL1: SUBI A,40 + PUSHJ P,SYLEND + TLNE TT,770000 + IDPB A,TT + JRST CMDL + +CMDQ: PUSHJ P,RCHA ;CONTROL Q, GET NEXT CHARACTER + JRST CMDL1 ;NOT CR, JUST DEPOSIT IN WORD (DON'T CHECK FOR :, ;, SPACE, ETC.) + +CMDSC: TLOA FF,SCOLF +CMDCOL: TLO FF,COLF +CMDS: CAMN TT,[10600,,SUBNM-1] + JRST CMDL + TLO FF,SIF + MOVE C,SUBNM + JRST CMDB + +SYLEND: TLZN FF,SIF + POPJ P, +SYLE2: TLZE FF,COLF + JRST SYLDV + TLZE FF,SCOLF + JRST SYLSN + TLOE FF,NAMF + JRST NAM2 + MOVEM C,FNAM1 + POPJ P, +NAM2: TLON FF,NAM2F ;NAMES AFTER SECOND GET IGNORED + MOVEM C,FNAM2 + POPJ P, + +SYLSN: TLO FF,SYSNF + MOVEM C,ISYSNM + POPJ P, +SYLDV: TLO FF,DEVF + LDB T,[360600,,C] + CAIG T,'9 + CAIGE T,'0 + JRST SYLDV1 + TLNN C,7777 + MOVSI C,(SIXBIT /UT/+T) +SYLDV1: HLRZM C,DNAM + POPJ P, + +CMDLA: PUSHJ P,SYLE1 + HLRZS FF + MOVE T,[DNAM,,ONAM] + BLT T,ONAM+3 + JRST CMDB + +IFN LISTSW,[ ;IF SWITCHES NEEDED FOR OTHER THAN LISTING, DELETE THIS CONDITIONAL +CMDSW: PUSHJ P,RCHA + CAIN A,") + JRST CMDL +IFN LISTSW,[CAIN A,"L + JRST CMDLST +] JRST CMDSW +] + +IFN LISTSW,[ + + ;PRINTING ROUTINES + + ;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING + +CMDLST: SETOM LISTON + PUSHJ P,MDSSET ;SET UP INSTRUCTIONS TO GO TO RCH +CMDSW1: .OPEN LPTC,[SIXBIT / !LPTWALL PAPER /] + SKIPA A,[30.] + JRST CMDSW + .SLEEP A, + JRST CMDSW1 + + ;PRINT CHARACTER IN A + +PILPT: .IOT LPTC,A + POPJ P, + + ;DONE PRINTING + +LPTCLS: SKIPL LISTON + POPJ P, ;WASN'T PRINTING TO BEGIN WITH + SETZM LISTON ;CLEAR OUT FLAG + MOVEI A,15 ;NOW TO END WITH FOR FEED + PUSHJ P,PILPT + MOVEI A,14 + PUSHJ P,PILPT + .CLOSE LPTC, ;RELEASE PRINTER + POPJ P, +] + + ;CARRIAGE RETURN TYPED + +CMDE: PUSHJ P,SYLE1 + TLNN FF,NAMF + JRST CMDB ;JUST RANDOM CR, TRY AGAIN + ;NOW FILL IN MISSING NAMES + ;DEVICE +CMDE1: MOVEI T,(SIXBIT /DSK/) + TLNN FF,DEVF + MOVEM T,DNAM + ;SYSTEM NAME + MOVE T,RSYSNM + TLNN FF,SYSNF + MOVEM T,ISYSNM ;DEFAULT INPUT SYSTEM NAME IS INITIAL SYSTEM NAME + TRNN FF,SYSNF + MOVEM T,OSYSNM ;DEFAULT OUTPUT SYSTEM NAME IS ALSO INITIAL SYSTEM NAME + ;INPUT FILE NAMES + MOVE T,DNAM + TRNN FF,DEVF + MOVEM T,ONAM + ;OUTPUT FILE NAMES + TRNE FF,NAM2F + POPJ P, ;BOTH OUTPUT FILE NAMES TYPED, RETURN + MOVE T,FNAM1 ;NOT BOTH, + EXCH T,ONAM+1 ;SET FIRST OUTPUT NAME FROM FIRST INPUT NAME + TRNN FF,NAMF ;IF ONE OUTPUT NAME TYPED THEN IT IS THE SECOND + MOVSI T,(SIXBIT/BIN/) + MOVEM T,ONAM+2 + POPJ P, + +SYLE1: CAMN TT,[10600,,SUBNM-1] + JRST SYLEND + MOVE C,SUBNM + JRST SYLE2 + + ;TS VARIABLES + +AFNAM1: 0 +AFNAM2: BLOCK 41 ;XXX Length used in IFPOP and A.INSR +RSYSNM: -1 ;INITIAL SYSTEM NAME +CMBUF: BLOCK 50 ;TYPEIN BUFFER +DNAM: 0 ;DEVICE NAME +FNAM1: 0 ;FILE NAME 1 +FNAM2: 0 ;" " 2 +ISYSNM: -1 +ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED +OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME +SUBNM: 0 +CMPTR: 0 ;BYTE POINTER TO CMBUF +UTIBUF: BLOCK 40 ;INPUT BUFFER +UTIBE: BLOCK 241 ;END OF " +UTOBUF: BLOCK 200 ;OUTPUT BUFFER - XXX Length used in TPPBF +UTOBE: ;END OF " +UREDP: 0 ;INPUT BYTE POINTER +UTYOP: 0 ;OUTPUT (36. BIT) BYTE POINTER +UTYOCT: 0 ; - # WORDS LEFT IN UTOBUF +RFNAM1: 0 ;.FNAM1 +RFNAM2: 0 +JNAME: 0 +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED" +PPB: JUMPGE FF,CPOPJ +PPBA: JRST TPPB" + +] ;END TS CONDITIONAL + +CONSTANTS + +PATCH": BLOCK 42 ;XXX CONSTANTS emits two extra 0s + + ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS + ;EXCEPT FOR EOFCH + +GDTAB": REPEAT 3,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFE TS,[POPJ P,76] IFN TS,[JRST UT141] + REPEAT 5,POPJ P,76 + POPJ P,75 ;TAB + POPJ P,74 ;LF + POPJ P,76 ;VERT TAB + POPJ P,76 ;FORM FEED + POPJ P,74 ;CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ;SPACE + POPJ P,41 ;! + POPJ P,42 ;" + POPJ P,43 ;# + ADD SYM,%$SQ(D) ;$ + ADD SYM,%%SQ(D) ;% + POPJ P,46 ;& + POPJ P,47 ;' + POPJ P,50 ;( + POPJ P,51 ;) + POPJ P,52 ;* + POPJ P,53 ;+ + POPJ P,54 ;, + POPJ P,55 ;- + POPJ P,56 ;. + POPJ P,57 ;/ + REPEAT 10.,JSP CH2,RR2 ;DIGITS + POPJ P,60 ;: + POPJ P,61 ;; + POPJ P,62 ;< + POPJ P,63 ;= + POPJ P,64 ;> + POPJ P,65 ;? + POPJ P,66 ;@ +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ;[ + POPJ P,70 ;\ + POPJ P,71 ;] + POPJ P,72 ;^ + POPJ P,73 ;_ + + ;NOW LOWER CASE + + POPJ P,76 ;GRAVE ACCENT + JRST UT141 ;A + REPEAT 25.,POPJ P,76 ;B-Z + REPEAT 4,POPJ P,76 ;BRACES, VERT BAR, TILDE + POPJ P,76 ;RUBOUT, LIKE SPACE + IFN .-GDTAB-200,[PRINTX /GDTAB LOSES +/] + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q + +TERMIN + +IFN TS,[DEFINE .LOP A +.LVAL1=.OP A +TERMIN] + +;MAC PROC TABLES +INIT1: HRLZI A, 2*-SMK-LCONTB-LCONTB/18.-.LVAL1-NCONS*3-LCNGLO + SETZM ST(A) + AOBJN A,.-1 +SPREAD: MOVEI AA,ISYMTB + MOVS F,ISMTBB ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1 + JRST SP1.1 ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2 + PUSHJ P,ES ;WON'T SKIP + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3INI + PUSHJ P,VSM2 +SP2: ADDI F,1000 + AOJA AA,SP3 +SP1.1: MOVE B,[SIXBIT /MIDASD/] + CAME B,JNAME + MOVEI AA,AFTES +SP1: CAIL AA,EISYMT + JRST SP4 + MOVE SYM,(AA) + LDB T,[400400,,SYM] + ROT T,-4 + PUSHJ P,ES + MOVE B,1(AA) + MOVSI C,3INI + CAMN T,[GLOEXT,,] ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + TLO C,3LLV + PUSHJ P,VSM2 + AOS AA + AOJA AA,SP1 + +CONSTANTS + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +PDL": BLOCK LPDL+1 + +ST: BLOCK 2*SMK ;SYMBOL TABLE 2 WORDS/SYM FIRST SQUOZE, SECOND "VALUE" (THIRD EXISTS, SEE 3RDWRD) +.LOP IDIV SMK 2 ;NOTE: ST MUST BE ABOVE CONSTANTS TABLES OR NOCON3 WILL LOSE +3RDWRD: BLOCK .LVAL1 ;THIRD WORD OF SYM LIVES HERE, REALLY A HALFWORD, CONTAINS FLAGS AND LEV + +CONBIT: BLOCK LCONTB/18.+1 ;RELOCATION BITS (SEE CPTMK) +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE + ;EACH ENTRY TWO WORDS + ;FIRST WORD GLOTB ENTRY + ;SECOND ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +VARTAB: BLOCK NVARS +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS + +DMYDEF: BLOCK DMDEFL ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED + +DSTG: BLOCK DSSIZ ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION + +DMYAGT: BLOCK DMYAGL ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN + +TOPPP: + +MACPDL: BLOCK MPDLL ;MACRO PDL +GCSV: BLOCK 16 ;AC SAVE AREA FOR GC + +MAXMAC: 27760 ;XXX Calculate? +MMAXMC: 27770 ;XXX Calculate? +MACTAB: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) + +UFA=FSC-(2000) ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: UFA ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +SQUOZE 10,UFA ;PDP10 INSTRUCTION +SQUOZE 10,DFN ;PDP10 INSTRUCTION +SQUOZE 10,FSC +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB +SQUOZE 10,FAD +SQUOZE 10,FADL +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRL +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRL +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR + SQUOZE 10,FMPRL +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRL +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +0 ;CIRC +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +0 + SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG + +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE + SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI + SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB + +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR + SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS + +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE + +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN + +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: +SQUOZE 10,LIS +20000,,0 +SQUOZE 10,RJMP +20100,,0 +SQUOZE 10,RAR +0 +SQUOZE 10,WAR +1 +SQUOZE 10,PC +2 +SQUOZE 10,SP +3 +SQUOZE 10,P1 +4 +SQUOZE 10,P2 +5 +SQUOZE 10,DSP +6 +SQUOZE 10,UR +7 +SQUOZE 10,RCR +10 +SQUOZE 10,WCR +11 +SQUOZE 10,DIR +12 +SQUOZE 10,RSR +13 +SQUOZE 10,SR +14 +SQUOZE 10,NEXT +17 +SQUOZE 10,XQTM +10 +SQUOZE 10,RPTM +4 +SQUOZE 10,PEELM +2 +SQUOZE 10,PROGM +1 +SQUOZE 10,PF0 +0 +SQUOZE 10,PF1 +1 +SQUOZE 10,PF2 +2 +SQUOZE 10,PF3 +3 +SQUOZE 10,PF4 +4 +SQUOZE 10,PF5 +5 +SQUOZE 10,PF6 +6 +SQUOZE 10,PF7 +7 +SQUOZE 10,RCRN +10 +SQUOZE 10,WCRN +11 +SQUOZE 10,HITF +12 +SQUOZE 10,AICF +13 +SQUOZE 10,PF14 +14 +SQUOZE 10,PF15 +15 +SQUOZE 10,PF16 +16 +SQUOZE 10,STOPF +17 +SQUOZE 10,SAVELB +0 +SQUOZE 10,SAVERT +1 +SQUOZE 10,VIEWLB +2 +SQUOZE 10,VIEWRT +3 +SQUOZE 10,WINDLB +4 +SQUOZE 10,WINDRT +5 +SQUOZE 10,INSTLB +6 +SQUOZE 10,INSTRT +7 +SQUOZE 10,NAME +10 +SQUOZE 10,NAMELB +10 +SQUOZE 10,CDIR +11 +SQUOZE 10,HITANG +12 +SQUOZE 10,SELINT +13 +SQUOZE 10,SAVE +14 +SQUOZE 10,VIEW +15 +SQUOZE 10,WIND +16 +SQUOZE 10,INST +17 +SQUOZE 10,FONT +1 +SQUOZE 10,CHAR +0 +SQUOZE 10,LITS +6 +SQUOZE 10,SWCH +4 +SQUOZE 10,JMMA +100000 +SQUOZE 10,KMMA +40000 +SQUOZE 10,JNO +20000 +SQUOZE 10,KNO +10000 +SQUOZE 10,J3D +4000 +SQUOZE 10,K3D +2000 +SQUOZE 10,JDT +1000 +SQUOZE 10,KDT +400 +SQUOZE 10,JSOH +10 +SQUOZE 10,KSOH +4 +SQUOZE 10,JSOWCR +2 +SQUOZE 10,KSOWCR +1 +SQUOZE 10,STOS +100000,,0 +SQUOZE 10,STOM +40000,,0 +SQUOZE 10,ZTOS +20000,,0 +SQUOZE 10,PTOM +10000,,0 +SQUOZE 10,NTOM +4000,,0 +SQUOZE 10,TTO +2000,,0 +SQUOZE 10,JCURVE +1000,,0 +SQUOZE 10,KCURVE +400,,0 +SQUOZE 10,JMEF +200,,0 +SQUOZE 10,KMEF +100,,0 +SQUOZE 10,JDL +40,,0 +SQUOZE 10,KDL +20,,0 +SQUOZE 10,SELFX +4,,0 +SQUOZE 10,SELFY +2,,0 +SQUOZE 10,TSELF +1,,0 +SQUOZE 10,JMOC +1000,,0 +SQUOZE 10,KMOC +400,,0 +SQUOZE 10,JMOM +200,,0 +SQUOZE 10,KMOM +100,,0 +SQUOZE 10,TM3 +70,,0 +SQUOZE 10,TM2 +60,,0 +SQUOZE 10,TM1 +50,,0 +SQUOZE 10,TM0 +40,,0 +SQUOZE 10,JMCUR +4,,0 +SQUOZE 10,KMCUR +2,,0 +SQUOZE 10,TAKEQ +1,,0 +SQUOZE 10,LI +0,,0 +SQUOZE 10,LIPSH +40000,,0 +SQUOZE 10,LIPSHM +60000,,0 +SQUOZE 10,PSH +40020,,0 +SQUOZE 10,PSHM +60020,,0 +SQUOZE 10,NOP +20,,0 +SQUOZE 10,JMP +100,,0 +SQUOZE 10,JMPPSH +60100,,0 +SQUOZE 10,NWSTK +40140,,0 +SQUOZE 10,NWSTKM +60140,,0 +SQUOZE 10,XQTA +10,,0 +SQUOZE 10,XQT +30,,0 +SQUOZE 10,RPT +24,,0 +SQUOZE 10,PEEL +22,,0 +SQUOZE 10,PROG +21,,0 +SQUOZE 10,LIF +200000,,0 +SQUOZE 10,LIFCL +210000,,0 +SQUOZE 10,LIFST +220000,,0 +SQUOZE 10,LIFCM +230000,,0 +SQUOZE 10,LAL +240000,,0 +SQUOZE 10,LALCL +250000,,0 +SQUOZE 10,LALST +260000,,0 +SQUOZE 10,LALCM +270000,,0 +SQUOZE 10,JIF +200100,,0 +SQUOZE 10,JIFCL +210100,,0 +SQUOZE 10,JIFST +220100,,0 +SQUOZE 10,JIFCM +230100,,0 +SQUOZE 10,JAL +240100,,0 +SQUOZE 10,JALCL +250100,,0 +SQUOZE 10,JALST +260100,,0 +SQUOZE 10,JALCM +270100,,0 +SQUOZE 10,JIFDED +200117,,0 +SQUOZE 10,IJNRCR +220110,,0 +SQUOZE 10,IJNWCR +220111,,0 +SQUOZE 10,IJPRCR +220130,,0 +SQUOZE 10,IJPWCR +220131,,0 +SQUOZE 10,CL +250020,,0 +SQUOZE 10,ST +260020,,0 +SQUOZE 10,CM +270020,,0 +SQUOZE 10,STOP +260037,,0 +SQUOZE 10,LOCLA +300000,,0 +SQUOZE 10,LOCLR +301000,,0 +SQUOZE 10,LOCLSA +302000,,0 +SQUOZE 10,LOCLSR +303000,,0 +SQUOZE 10,STCL +320000,,0 +SQUOZE 10,RTCLA +340020,,0 +SQUOZE 10,RTCLR +341020,,0 +SQUOZE 10,RTCLSA +342020,,0 +SQUOZE 10,RTCLSR +343020,,0 +SQUOZE 10,SKCL +360020,,0 +SQUOZE 10,LOMM +304000,,0 +SQUOZE 10,LOMMR +305000,,0 +SQUOZE 10,LOMMP +306000,,0 +SQUOZE 10,LOMDIR +307001,,0 +SQUOZE 10,STMM +324000,,0 +SQUOZE 10,NOMM +325020,,0 +SQUOZE 10,POPMM +326020,,0 +SQUOZE 10,STMDIR +327001,,0 +SQUOZE 10,RTMM +344020,,0 +SQUOZE 10,RTMMS +345020,,0 +SQUOZE 10,RTMDIR +347021,,0 +SQUOZE 10,SKMM +364020,,0 +SQUOZE 10,SKMMS +365020,,0 +SQUOZE 10,PUSHMM +366020,,0 +SQUOZE 10,SKMDIR +367021,,0 +SQUOZE 10,LOCB +315000,,0 +SQUOZE 10,STCB +335000,,0 +SQUOZE 10,RTCB +355020,,0 +SQUOZE 10,SKCB +375020,,0 +SQUOZE 10,LOSBKL +317000,,0 +SQUOZE 10,STSBKL +337000,,0 +SQUOZE 10,RTSBKL +357020,,0 +SQUOZE 10,SKSBKL +377020,,0 +SQUOZE 10,LOLITS +317301,,0 +SQUOZE 10,STSWCH +337201,,0 +SQUOZE 10,DD +400000,,0 +SQUOZE 10,DI +500000,,0 +SQUOZE 10,DN +600000,,0 +SQUOZE 10,LS +60000,,0 +SQUOZE 10,LT +70000,,0 +SQUOZE 10,PO +30000,,0 +SQUOZE 10,TO +20000,,0 +SQUOZE 10,SS +40000,,0 +SQUOZE 10,FR +50000,,0 +SQUOZE 10,DT +10000,,0 +SQUOZE 10,BX +0,,0 +SQUOZE 10,RX +7000,,0 +SQUOZE 10,AX +6000,,0 +SQUOZE 10,RA +3000,,0 +SQUOZE 10,AB +2000,,0 +SQUOZE 10,AR +4000,,0 +SQUOZE 10,RE +5000,,0 +SQUOZE 10,SL +1000,,0 +SQUOZE 10,SA +0 +SQUOZE 10,SETPTA +462000,,0 +SQUOZE 10,SETPTR +465000,,0 +SQUOZE 10,DRAWTA +422000,,0 +SQUOZE 10,DRAWTR +425000,,0 +SQUOZE 10,DRAWFA +452000,,0 +SQUOZE 10,DRAWFR +455000,,0 +SQUOZE 10,LINAA +462000,,0 +SQUOZE 10,LINAR +466000,,0 +SQUOZE 10,LINRA +467000,,0 +SQUOZE 10,LINRR +465000,,0 +SQUOZE 10,LINIAA +562000,,0 +SQUOZE 10,LINIAR +566000,,0 +SQUOZE 10,LINIRA +567000,,0 +SQUOZE 10,LINIRR +565000,,0 +SQUOZE 10,POLAA +432000,,0 +SQUOZE 10,POLAR +434000,,0 +SQUOZE 10,POLRR +435000,,0 +SQUOZE 10,POLRA +433000,,0 +SQUOZE 10,POLIAA +532000,,0 +SQUOZE 10,POLIAR +534000,,0 +SQUOZE 10,POLIRR +535000,,0 +SQUOZE 10,POLIRA +533000,,0 +SQUOZE 10,STARAA +442000,,0 +SQUOZE 10,STARAR +444000,,0 +SQUOZE 10,STARRR +445000,,0 +SQUOZE 10,STARRA +443000,,0 +SQUOZE 10,DOTSAA +412000,,0 +SQUOZE 10,DOTSAR +414000,,0 +SQUOZE 10,DOTSRR +415000,,0 +SQUOZE 10,DOTSRA +413000,,0 +SQUOZE 10,BOXA +402000,,0 +SQUOZE 10,BOXR +405000,,0 +SQUOZE 10,BOXSA +400000,,0 +SQUOZE 10,BOXSR +401000,,0 +SQUOZE 10,SETCRV +662000,,0 +SQUOZE 10,DRACRV +622000,,0 +SQUOZE 10,POLCRV +632000,,0 +SQUOZE 10,DOTCRV +612000,,0 +SQUOZE 10,NEWCRV +602000,,0 +SQUOZE 10,FRMCRV +642000,,0 +SQUOZE 10,DOCHAR +700000,,0 + +AFTES": +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +SQUOZE 10,APR +0 +SQUOZE 10,PI +4 +SQUOZE 10,PTP +100 +SQUOZE 10,PTR +104 +SQUOZE 10,TTY +120 +SQUOZE 10,LPT +124 +SQUOZE 10,DIS +130 +SQUOZE 10,DC +200 +SQUOZE 10,UTC +210 +SQUOZE 10,UTS +214 +SQUOZE 10,IBM ;2311 CONTROL +704 + +SQUOZE 10,LDBI ;REALLY ILDB, +LDBI +SQUOZE 10,DPBI ;AND IDPB +DPBI +SQUOZE 10,CLEAR +CLEAR +SQUOZE 10,CLEARI +CLEARI +SQUOZE 10,CLEARM +CLEARM +SQUOZE 10,CLEARB +CLEARB +IRPS INST,,FAD FSB FMP FDV +SQUOZE 10,INST!SI +INST!RL +TERMIN + +SQUOZE 4,END +AEND +SQUOZE 4,LOC +ALOC +SQUOZE 4,XWORD +AXWORD +SQUOZE 4,RIM1 +SRIM1 +SQUOZE 4,RIM10 +SRIM10 +SQUOZE 4,SBLK +SIMBLK +SQUOZE 4,RIM +SRIM +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,EXP +AEXP +SQUOZE 4,XWD +AXWORD +SQUOZE 4,.BEGIN +ASBEG +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,.END +ASEND +SQUOZE 4,OCT +AEXP +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,RADIX +ARDIX +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNG +SQUOZE 4,NULL +ANULL +SQUOZE 4,EQUALS +AEQUAL + +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +AIRP +SQUOZE 4,IRPC +AIRP(400000) +SQUOZE 4,IRPS +(200000)AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE + +SQUOZE 4,WORD +AWORD +SQUOZE 4,RELOCA +ARELOC +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,OFFSET +AOFFSET + + ;CONDITIONALS +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFP +COND5 +SQUOZE 4,IFL +JUMPL A,COND + +SQUOZE 4,PRINTX +APRNTX +SQUOZE 4,PRINTC +(400000)APRNTC +SQUOZE 4,VARIAB +AVARIAB + +SQUOZE 4,.LIBRA +A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +A.LIFS +SQUOZE 4,.LIFND +A.LIFND +SQUOZE 4,.ENTRY +A.ENTRY +SQUOZE 4,.EXTERN +A.EXTERN +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,.OP +A.OP +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +A.RPCN +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 44,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 44,.LVAL1 +0 +SQUOZE 44,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +(1)STGWS +SQUOZE 4,.YSTGW +STGWS +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +A.GLOB +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,ASCIZ +AASCIZ + +SQUOZE 4,.BYTC +A.BYTC +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN +SQUOZE 4,.IRPCNT +A.IRPC + +IFN TS,[ +SQUOZE 4,.FNAM1 +AFN1 +SQUOZE 4,.FNAM2 +AFN2 +SQUOZE 4,.AFNM1 +AFNM1 +SQUOZE 4,.AFNM2 +AFNM2 +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.IFNM1 +AIFN1 +SQUOZE 4,.IFNM2 +AIFN2 +] +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +IFN TSSYMS,[ +SQUOZE 10,.UAI +0 +SQUOZE 10,.UAO +1 +SQUOZE 10,.UII +4 +SQUOZE 10,.UIO +5 +SQUOZE 10,.BAI +2 +SQUOZE 10,.BAO +3 +SQUOZE 10,.BII +6 +SQUOZE 10,.BIO +7 +] + +TSSYMB": +EISYMT": PRINTA \.-MACTAB-1, WORDS INITIALIZATION CODING. + +LOC MACTAB+MACL + +LSTLOC: -1 ;MAKE SURE CORE THERE + +IFN TS,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT, + ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE. + ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER + ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION + +END 100 From d84df6c1d0be36d186bb29b118151ee39eec2c6e Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Aug 2020 01:39:09 +0100 Subject: [PATCH 05/10] Patch MIDAS 73 to accept JCL. Older versions of MIDAS expect you to type a command at them, which makes them hard to automate with :x or XFILEs. This patch backports the JCLINI code from later versions of MIDAS, which pre-stuffs the command buffer with the JCL string if available. --- build/misc.tcl | 2 ++ src/midas/patch.73 | 26 ++++++++++++++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 src/midas/patch.73 diff --git a/build/misc.tcl b/build/misc.tcl index c13dc8a64..3522abc23 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -29,6 +29,8 @@ respond "*" ":midas;77\r" respond "MIDAS.77" "MIDAS; TS 73_MIDAS; MIDAS 73\r" respond "*" ":midas;73\r" respond "MIDAS.73" "MIDAS; TS 73_MIDAS; MIDAS 73\r" +respond "*" ":xfile midas; patch 73\r" +expect ":kill" # MACTAP respond "*" ":midas;324 sysbin;_sysen2; mactap\r" diff --git a/src/midas/patch.73 b/src/midas/patch.73 new file mode 100644 index 000000000..0e91d40d1 --- /dev/null +++ b/src/midas/patch.73 @@ -0,0 +1,26 @@ +:job midas +:load midas;ts 73 +:Get first command from JCL (based on JCLINI) +cmd+3/pushj p,patch +patch/setzb ff,cmptr +patch+1/.suset patch+20 +patch+2/tlnn a,%opcmd +patch+3/popj p, +patch+4/setom cmbuf+50-1 +patch+5/.break 12,patch+21 +patch+6/.break 12,patch+22 +patch+7/skipn cmbuf +patch+10/popj p, +patch+11/move a,patch+23 +patch+12/movem a,cmptr +patch+13/ildb tt,a +patch+14/caie tt,15 +patch+15/jrst .-2 +patch+16/idpb ff,a +patch+17/popj p, +patch+20/.roptio,,a +patch+21/..rjcl,,cmbuf +patch+22/..sjcl,, +patch+23/10700,,cmbuf-1 +:pdump midas;ts 73 +:kill From 2858a877b0460bf491c638bc70e52f131a1b6388 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Aug 2020 17:49:47 +0100 Subject: [PATCH 06/10] Patch MIDAS 73 to provide FADRI etc. The 1973 MUDDLE; TS MIDAS binary has these four instruction aliases with SI at the end (and they weren't used in the 1973 Muddle at all). All later versions of MIDAS use RI names, as does more recent Muddle source, so this must have been patched in later. --- src/midas/patch.73 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/midas/patch.73 b/src/midas/patch.73 index 0e91d40d1..24b745fcc 100644 --- a/src/midas/patch.73 +++ b/src/midas/patch.73 @@ -22,5 +22,11 @@ patch+20/.roptio,,a patch+21/..rjcl,,cmbuf patch+22/..sjcl,, patch+23/10700,,cmbuf-1 +:Replace FADSI symbol with FADRI, etc. +aftes,eisymt,10&FADSIw +./10&FADRI +.+2/10&FSBRI +.+4/10&FMPRI +.+6/10&FDVRI :pdump midas;ts 73 :kill From 8115197724bfda44337282bf309f25be9c06d8bf Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Aug 2020 01:44:49 +0100 Subject: [PATCH 07/10] Build Muddle with MIDAS 73. This is the version of MIDAS that was being used at the time of Muddle 106 in 1980. --- src/mudsys/assem.xfile | 68 +++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/src/mudsys/assem.xfile b/src/mudsys/assem.xfile index 0a1a11e1d..aa86b5aa5 100644 --- a/src/mudsys/assem.xfile +++ b/src/mudsys/assem.xfile @@ -1,38 +1,38 @@ :Build TS MDL for ITS -:midas;324 pure bin_pure -:midas;324 specs bin_specs -:midas;324 const bin_const -:midas;324 ldgc bin_ldgc -:midas;324 utilit bin_utilit -:midas;324 uuoh bin_uuoh -:midas;324 mudits bin_mudits -:midas;324 mappur bin_mappur -:midas;324 core bin_core -:midas;324 atomhk bin_atomhk -:midas;324 interr bin_interr -:midas;324 nfree bin_nfree -:midas;324 gchack bin_gchack -:midas;324 ipc bin_ipc -:midas;324 agcmrk bin_agcmrk -:midas;324 reader bin_reader -:midas;324 print bin_print -:midas;324 bufmod bin_bufmod -:midas;324 arith bin_arith -:midas;324 maps bin_maps -:midas;324 primit bin_primit -:midas;324 stbuil bin_stbuil -:midas;324 eval bin_eval -:midas;324 decl bin_decl -:midas;324 main bin_main -:midas;324 mudsqu bin_mudsqu -:midas;324 fopen bin_fopen -:midas;324 putget bin_putget -:midas;324 readch bin_readch -:midas;324 create bin_create -:midas;324 save bin_save -:midas;324 agc bin_agc -:midas;324 amsgc bin_amsgc -:midas;324 initm bin_initm +:midas;73 PURE +:midas;73 SPECS +:midas;73 CONST +:midas;73 LDGC +:midas;73 UTILIT +:midas;73 UUOH +:midas;73 MUDITS +:midas;73 MAPPUR +:midas;73 CORE +:midas;73 ATOMHK +:midas;73 INTERR +:midas;73 NFREE +:midas;73 GCHACK +:midas;73 IPC +:midas;73 AGCMRK +:midas;73 READER +:midas;73 PRINT +:midas;73 BUFMOD +:midas;73 ARITH +:midas;73 MAPS +:midas;73 PRIMIT +:midas;73 STBUIL +:midas;73 EVAL +:midas;73 DECL +:midas;73 MAIN +:midas;73 MUDSQU +:midas;73 FOPEN +:midas;73 PUTGET +:midas;73 READCH +:midas;73 CREATE +:midas;73 SAVE +:midas;73 AGC +:midas;73 AMSGC +:midas;73 INITM : To link and initialize: :stinkm From 4d3123d7f7a59fe820388ad3a2600765afb12ec1 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Aug 2020 01:46:29 +0100 Subject: [PATCH 08/10] Revert MUDSYS to match Muddle 106 source files. Looking at the backup dates for files in , mdl106.exe is from 20th January 1981, whereas some of the source files are from a couple of years later. Revert to the last version prior to 20th January 1981 -- in every case, this was the earliest revision that was kept in . This undoes the changes that we'd previously made to these files, many of which are no longer necessary now that we're using MIDAS 73. --- src/mudsys/{agc.142 => agc.131} | 71 ++----- src/mudsys/{amsgc.111 => amsgc.107} | 28 +-- src/mudsys/{atomhk.151 => atomhk.144} | 24 +-- src/mudsys/{const.6 => const.5} | 4 +- src/mudsys/{decl.103 => decl.102} | 29 +-- src/mudsys/{eval.126 => eval.122} | 50 +---- src/mudsys/{fopen.63 => fopen.35} | 292 +++++--------------------- src/mudsys/{gchack.46 => gchack.45} | 6 +- src/mudsys/{initm.374 => initm.371} | 22 +- src/mudsys/{interr.426 => interr.419} | 29 +-- src/mudsys/{ldgc.101 => ldgc.100} | 2 - src/mudsys/{main.353 => main.350} | 16 +- src/mudsys/{mappur.163 => mappur.146} | 122 +++-------- src/mudsys/{muddle.347 => muddle.346} | 6 +- src/mudsys/{mudex.183 => mudex.177} | 34 +-- src/mudsys/{mudsqu.29 => mudsqu.28} | 1 - src/mudsys/{nfree.54 => nfree.53} | 3 +- src/mudsys/{primit.316 => primit.315} | 10 +- src/mudsys/{print.346 => print.340} | 33 +-- src/mudsys/{pure.16 => pure.15} | 2 +- src/mudsys/{readch.215 => readch.206} | 123 +++++++---- src/mudsys/{reader.357 => reader.353} | 12 +- src/mudsys/{save.176 => save.169} | 65 ++---- src/mudsys/{secagc.82 => secagc.80} | 7 +- src/mudsys/{specs.112 => specs.110} | 10 +- src/mudsys/{stbuil.20 => stbuil.15} | 23 +- src/mudsys/{utilit.106 => utilit.103} | 9 +- src/mudsys/{uuoh.184 => uuoh.179} | 61 ++---- 28 files changed, 301 insertions(+), 793 deletions(-) rename src/mudsys/{agc.142 => agc.131} (98%) rename src/mudsys/{amsgc.111 => amsgc.107} (97%) rename src/mudsys/{atomhk.151 => atomhk.144} (98%) rename src/mudsys/{const.6 => const.5} (94%) rename src/mudsys/{decl.103 => decl.102} (97%) rename src/mudsys/{eval.126 => eval.122} (98%) rename src/mudsys/{fopen.63 => fopen.35} (95%) rename src/mudsys/{gchack.46 => gchack.45} (99%) rename src/mudsys/{initm.374 => initm.371} (98%) rename src/mudsys/{interr.426 => interr.419} (99%) rename src/mudsys/{ldgc.101 => ldgc.100} (99%) rename src/mudsys/{main.353 => main.350} (99%) rename src/mudsys/{mappur.163 => mappur.146} (96%) rename src/mudsys/{muddle.347 => muddle.346} (99%) rename src/mudsys/{mudex.183 => mudex.177} (96%) rename src/mudsys/{mudsqu.29 => mudsqu.28} (99%) rename src/mudsys/{nfree.54 => nfree.53} (99%) rename src/mudsys/{primit.316 => primit.315} (99%) rename src/mudsys/{print.346 => print.340} (99%) rename src/mudsys/{pure.16 => pure.15} (93%) rename src/mudsys/{readch.215 => readch.206} (95%) rename src/mudsys/{reader.357 => reader.353} (99%) rename src/mudsys/{save.176 => save.169} (95%) rename src/mudsys/{secagc.82 => secagc.80} (99%) rename src/mudsys/{specs.112 => specs.110} (94%) rename src/mudsys/{stbuil.20 => stbuil.15} (99%) rename src/mudsys/{utilit.106 => utilit.103} (99%) rename src/mudsys/{uuoh.184 => uuoh.179} (97%) diff --git a/src/mudsys/agc.142 b/src/mudsys/agc.131 similarity index 98% rename from src/mudsys/agc.142 rename to src/mudsys/agc.131 index e0d8cdfea..e44c5e7f6 100644 --- a/src/mudsys/agc.142 +++ b/src/mudsys/agc.131 @@ -24,7 +24,7 @@ GCST==$. .GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10 .GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK -.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG,%PURMD +.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG .GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET .GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK @@ -344,7 +344,7 @@ PURIT1: MOVE PVP,PVSTOR+1 MOVE P,A ; GET NEW PDL PTR PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX MOVE C,SAVRS1 ; SET UP FOR MARKING - MOVE A,(C) ; GET TYPE WORD + MOVE A,(C) ; GET TYPE WORD MOVEM A,SAVRE2 PURIT3: PUSH P,C PUSHJ P,MARK2 @@ -489,7 +489,6 @@ PURCLS: MOVE P,[-2000,,MRKPDL] MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE SKIPN NPRFLG PUSHJ P,%PURIF ; PURIFY -IFE ITS, PUSHJ P,%PURMD SETZM GPURFL JRST EPURIF ; FINISH UP @@ -503,14 +502,12 @@ NPRFIX: PUSH P,A SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE CAIE A,SLOCR ; DONT HACK TLOCRS CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD - JRST LSTFXP - CAIN A,SCHSTR - JRST STRFXP + JRST LSTFXP CAIN A,SATOM - JRST ATMFXP + JRST ATMFXP CAIN A,SOFFS JRST OFFFXP ; FIXUP OFFSETS -STRFXQ: HRRZ D,1(B) + HRRZ D,1(B) JUMPE D,LSTFXP ; SKIP IF NIL CAMG D,PURTOP ; SEE IF ALREADY PURE ADDM C,1(B) @@ -535,20 +532,10 @@ OFFFXP: HLRZ 0,D ; POINT TO LIST HRLM 0,1(B) ; STUFF IT OUT JRST LSTFXP ; DONE -STRFXP: TLZN D,STATM ; SKIP IF REALLY ATOM - JRST STRFXQ - MOVEM D,1(B) - PUSH P,C - MOVE C,B ; GET ARG FOR BYTDOP - PUSHJ P,BYTDOP - POP P,C - MOVEI D,-1(A) - JRST ATMFXQ - ATMFXP: HLRE 0,D ; GET LENGTH SUB D,0 ; POINT TO FIRST DOPE WORD HRRZS D -ATMFXQ: CAML D,OGCSTP + CAML D,OGCSTP CAIL D,HIBOT ; SKIP IF IMPURE JRST LSTFXP HRRZ 0,1(D) ; GET RELOCATION @@ -559,36 +546,25 @@ ATMFXQ: CAML D,OGCSTP ; FIXUP OF PURE ATOM POINTERS PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER - JRST PURSFX + POPJ P, HLRE E,D ; GET TO DOPE WORD SUBM D,E -PURSF1: SKIPL 1(E) ; SKIP IF MARKED - POPJ P, + SKIPL 1(E) ; SKIP IF MARKED + POPJ P, HRRZ 0,1(E) ; RELATAVIZE PTR SUBI 0,1(E) ADD D,0 ; FIX UP PASSED POINTER SKIPE B ; AND IF APPROPRIATE MUNG POINTER ADDM 0,1(B) ; FIX UP POINTER POPJ P, - -PURSFX: CAIE C,TCHSTR - POPJ P, - MOVE C,B ; GET ARG FOR BYTDOP - PUSHJ P,BYTDOP - GETYP 0,-1(A) - MOVEI E,-1(A) - MOVE A,[PUSHJ P,PURTFX] - CAIE 0,SATOM - POPJ P, - JRST PURSF1 - + PURFIX: PUSH P,D PUSH P,A PUSH P,B PUSH P,C ; SAVE AC'S FOR GCHACK EXCH A,C ; GET TYPE IN A CAIN A,TATOM ; CHECK FOR ATOM - JRST ATPFX + JRST ATPFX PUSHJ P,SAT CAILE A,NUMSAT ; SKIP IF TEMPLATE @@ -640,12 +616,7 @@ LVPUR: POP P,C STRFX: MOVE C,B ; GET ARG FOR BYTDOP PUSHJ P,BYTDOP SKIPL (A) ; SKIP IF MARKED - JRST TLFX - GETYP 0,-1(A) - MOVE D,1(B) - MOVEI C,-1(A) - CAIN 0,SATOM ; REALLY ATOM? - JRST ATPFX1 + JRST TLFX HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE SUBI 0,(A) ; RELATAVIZE ADD 0,MAPUP ; ADJUST @@ -657,7 +628,7 @@ ATPFX: HLRE C,D SUBM D,C SKIPL 1(C) ; SKIP IF MARKED JRST TLFX -ATPFX1: HRRZS C ; SEE IF PURE + HRRZS C ; SEE IF PURE CAIL C,HIBOT ; SKIP IF NOT PURE JRST TLFX HRRZ 0,1(C) ; GET PTR TO NEW ATOM @@ -1399,9 +1370,7 @@ NOMONO: MOVE PVP,PVSTOR+1 PUSHJ P,CTIME FSBR B,GCTIM ; GET TIME ELAPSED - SKIPN INBLOT ; STORE TIME ONLY IF NO RETRY - SKIPN GCDANG - MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER SKIPN GCMONF ; SEE IF MONITORING JRST GCCONT PUSHJ P,FIXSEN ; OUTPUT TIME @@ -1446,9 +1415,9 @@ AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL SETOM INTFLG ; AND REQUEST AN INTERRUPT SETZM GCDOWN PUSHJ P,RBLDM -; JUMPE R,FINAGC -; JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT -; SKIPE PLODR ; LOADING ONE, M = 0 IS OK + JUMPE R,FINAGC + JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT + SKIPE PLODR ; LOADING ONE, M = 0 IS OK JRST FINAGC FATAL AGC--RUNNING RSUBR WENT AWAY @@ -2417,13 +2386,11 @@ ATMSET: PUSH P,A ; SAVE A MOVEI B,TATOM ; TYPE PUSHJ P,MARK POP P,A ; RESTORE A - SKIPN GCDFLG + SKIPN DUMFLG JRST BYTREL + HRRM A,(P) MOVSI E,STATM ; GET "STRING IS ATOM BIT" IORM E,(P) - SKIPN DUMFLG - JRST GCRET - HRRM A,(P) JRST BYTREL ; TO BYTREL diff --git a/src/mudsys/amsgc.111 b/src/mudsys/amsgc.107 similarity index 97% rename from src/mudsys/amsgc.111 rename to src/mudsys/amsgc.107 index 301e8250f..2d66f2015 100644 --- a/src/mudsys/amsgc.111 +++ b/src/mudsys/amsgc.107 @@ -113,7 +113,6 @@ CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL MOVE A,MAINPR PUSHJ P,MARK ; MARK PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING - PUSHJ P,CHFIX PUSHJ P,STOGC ; FIX UP FROZEN WORLD PUSHJ P,SWEEP ; SWEEP WORLD @@ -204,7 +203,7 @@ IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] [TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] [TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] [TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] -[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK] +[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ASMK] [TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] [TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] [TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] @@ -641,7 +640,6 @@ GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE SUB A,B SKIPGE 1(A) ; SKIP IF NOT MARKED JRST GCRET - IORM D,1(A) ; MARK THE CHOMPER!!! SUBI A,2 MOVE B,ABOTN ; GET TOP OF ATOM TABLE ADD B,0 ; GET BOTTOM OF ATOM TABLE @@ -668,13 +666,12 @@ GCRD3: SUBI A,(C) ; TO NEXT ATOM ; ROUTINE TO FIX UP CHANNELS CHNFLS: MOVEI 0,N.CHNS-1 - MOVEI A,CHNL1 ; SET UP POINTER + MOVE A,[TCHAN,,CHNL1] ; SET UP POINTER CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL JRST CHFL2 ; NO CHANNEL LOOP TO NEXT HLRE C,B ; POINT TO DOPE WORD OF CHANNEL SUBI B,(C) - MOVEI F,TCHAN - HRLM F,(A) ; PUT TYPE BACK + HLLM A,(A) ; PUT TYPE BACK SKIPL 1(B) ; SKIP IF MARKED JRST FLSCH ; FLUSH THE CHANNEL MOVEI F,1 ; MARK THE CHANNEL AS GOOD @@ -686,25 +683,6 @@ FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE JRST CHFL2 -; THIS ROUTINE MARKS ALL THE CHANNELS - -CHFIX: MOVEI 0,N.CHNS-1 - MOVEI A,CHNL1 ; SLOTS - -DHNFL2: SKIPN 1(A) - JRST DHNFL1 - PUSH P,0 ; SAVE 0 - PUSH P,A ; SAVE A - MOVEI C,(A) - MOVE A,1(A) - MOVEI B,TCHAN - PUSHJ P,MARK - POP P,A ; RESTORE A - POP P,0 ; RESTORE -DHNFL1: ADDI A,2 - SOJG 0,DHNFL2 - POPJ P, - ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL diff --git a/src/mudsys/atomhk.151 b/src/mudsys/atomhk.144 similarity index 98% rename from src/mudsys/atomhk.151 rename to src/mudsys/atomhk.144 index 069ad4a25..1d1855cf1 100644 --- a/src/mudsys/atomhk.151 +++ b/src/mudsys/atomhk.144 @@ -8,7 +8,6 @@ RELOCATABLE .GLOBAL .BLOCK,IDVAL,NXTDCL,CHRWRD,CSTACK,CSTAK,ILOOKC,IGVAL,BYTDOP,HASHTB .GLOBAL ICONS,INCONS,IBLOCK,INSRTX,GCHACK,IMPURIFY,BSETG,TYPVEC,IGET,IPUT .GLOBAL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,MPOPJ,CSETG,CSPNAM,GPURFL,IMPURX -.GLOBAL NOATMS LPVP==SP TYPNT==AB @@ -296,12 +295,7 @@ CHECK5: HRRZ A,-1(TP) ; SEE IF FIRST SHOT AT THIS GUY? JRST NEXT CHECK2: MOVE B,E ; RETURN ATOM - HLRE A,B - SUBM B,A - MOVE A,(A) - TRNE A,LNKBIT - SKIPA A,$TLINK - MOVSI A,TATOM + MOVSI A,TATOM JRST CPOPJT CHECK1: MOVE D,-2(TP) ; ANY LEFT? @@ -683,9 +677,7 @@ RLOOK1: MOVE B,(TP) SKIPN D,-2(TP) ; RESTORE FOR INSERT JRST BADDEF ; NO DEFAULT, USER LOST ON SPECIFICATION SUB TP,[6,,6] ; FLUSH CRAP - SKIPN NOATMS - JRST INSRT1 - JRST INSRT1 + JRST INSRT1 DEFFLG==1 ;SPECIAL FLAG USED TO INDICATE THAT A DEFAULT HAS ALREADY BEEN ; SPECIFIED @@ -1008,8 +1000,8 @@ IMPURIFY: ; ROUTINE PASSED TO GCHACK ATFIX: CAME D,(TP) - CAMN D,-2(TP) - JRST .+2 + CAMN D,-2(TP) + JRST .+2 POPJ P, ASH C,1 @@ -1097,9 +1089,7 @@ IMPUR0: MOVE C,(TP) ; GET ATOM ADD C,[3,,3] ; POINT TO PNAME HLRE A,C ; GET LNTH IN WORDS OF PNAME MOVNS A -; PUSH P,[SETZ IMPUR2] ; FAKE OUT ILOOKC - XMOVEI 0,IMPUR2 - PUSH P,0 + PUSH P,[IMPUR2] ; FAKE OUT ILOOKC PUSH P,(C) ; PUSH UP THE PNAME AOBJN C,.-1 PUSH P,A ; NOW THE COUNT @@ -1114,10 +1104,6 @@ IMPUR2: JUMPE B,IMPUR1 MOVE B,0 PUSH P,GPURFL ; PRERTEND OUT OF PURIFY - HLRE C,B - SUBM B,C - HRRZ C,(C) ; ARE WE ON PURIFY LIST - CAIG C,HIBOT ; IF SO, WE ARE STILL PURIFY SETZM GPURFL PUSHJ P,IMPURIF ; RECURSE POP P,GPURFL diff --git a/src/mudsys/const.6 b/src/mudsys/const.5 similarity index 94% rename from src/mudsys/const.6 rename to src/mudsys/const.5 index 3776d6090..32a0ea41c 100644 --- a/src/mudsys/const.6 +++ b/src/mudsys/const.5 @@ -8,7 +8,8 @@ DEFINE C%MAKE A,B IRP LH,RH,[B] A==[LH,,RH] .ISTOP - TERMIN + TERMIM +TERMIN TERMIN IRP X,,[[C%11,1,1],[C%22,2,2],[C%33,3,3],[C%44,4,4],[C%55,5,5],[C%66,6,6] @@ -20,5 +21,6 @@ IRP X,,[[C%11,1,1],[C%22,2,2],[C%33,3,3],[C%44,4,4],[C%55,5,5],[C%66,6,6] .ISTOP TERMIN +TERMIN TERMIN END diff --git a/src/mudsys/decl.103 b/src/mudsys/decl.102 similarity index 97% rename from src/mudsys/decl.103 rename to src/mudsys/decl.102 index 1fce52b16..0cede3c92 100644 --- a/src/mudsys/decl.103 +++ b/src/mudsys/decl.102 @@ -8,7 +8,7 @@ RELOCA .GLOBAL STBL,TYPFND,TYPSGR,CHKDCL,TESTR,VALG,INCR1,TYPG,ISTRUC,TMATCH,SAT .GLOBAL TYPMIS,CHKAB,CHKARG,IGDECL,LOCQQ,APLQ,CALER,IEQUAL,IIGLOC,IGLOC .GLOBAL CHLOCI,INCONS,SPCCHK,OUTRNG,WTYP1,FLGSET,IGET,PVSTOR,SPSTOR,DSTORE -.GLOBAL NOATMS,NOSET,NOSETG + ; Subr to allow user to access the DECL checking code MFUNCTION CHECKD,SUBR,[DECL?] @@ -40,33 +40,6 @@ MFUNCTION %DECL,SUBR,[DECL-CHECK] HRROI E,IGDECL JRST FLGSET -; Subr to turn on and off allowing new atoms - -MFUNCTION %NEWAT,SUBR,[ALLOW-NEW-ATOMS] - - ENTRY - - MOVEI E,NOATMS - JRST FLGSET - -; Subr to turn on and off allowing new GVALS - -MFUNCTION %NEWGV,SUBR,[ALLOW-NEW-GVALS] - - ENTRY - - MOVEI E,NOSETG - JRST FLGSET - -; Subr to turn on and off allowing new LVALs - -MFUNCTION %NEWLV,SUBR,[ALLOW-NEW-LVALS] - - ENTRY - - MOVEI E,NOSET - JRST FLGSET - ; Change special unspecial normal mode MFUNCTION SPECM%,SUBR,[SPECIAL-MODE] diff --git a/src/mudsys/eval.126 b/src/mudsys/eval.122 similarity index 98% rename from src/mudsys/eval.126 rename to src/mudsys/eval.122 index e7983b2b2..bf171810d 100644 --- a/src/mudsys/eval.126 +++ b/src/mudsys/eval.122 @@ -2,8 +2,6 @@ TITLE EVAL -- MUDDLE EVALUATOR RELOCATABLE -.SYMTAB 3337. - ; GERALD JAY SUSSMAN, 1971. REWRITTEN MANY TIMES SINCE C. REEVE (1972--1974) @@ -19,7 +17,6 @@ RELOCATABLE .GLOBAL IIGLOC,CHUNW,IUNWIN,UNWIN2,SPCCHK,CURFCN,TMPLNT,TD.LNT,TBINIT .GLOBAL SPECBE,BSETG,GLOTOP,CANDP,CORP,TFA,TMA,DSTORE,PVSTOR,SPSTOR .GLOBAL AGC,GVLINC,LVLINC,CGBOUN,IEVECT,MAKTU2,STOSTR,HIBOT,POPUNW,ISTRUC -.GLOBAL NOSET,NOSETG .INSRT MUDDLE > @@ -1125,9 +1122,9 @@ AUXB1: HRRZ C,RE.ARG+1(TB) ; POINT TO ARGLIST SKIPN (P) ; SKIP IF QUOTED OK JRST MPD.11 AUXB2: PUSHJ P,PSHBND ; SET UP BINDING - PUSH TP,$TATOM ; SAVE HEWITT ATOM + PUSH TP,$TDECL ; SAVE HEWITT ATOM PUSH TP,-1(P) - PUSH TP,$TDECL ; AND DECLS + PUSH TP,$TATOM ; AND DECLS PUSH TP,-2(P) TRNN A,2 ; SKIP IF INIT VAL EXISTS JRST AUXB3 ; NO, USE UNBOUND @@ -2202,8 +2199,6 @@ CHSKIP: CAIN C,TSKIP ; ENTRY FOR FUNNY COMPILER UNBIND (1) SSPECS: PUSH P,E - PUSH P,PVP - PUSH P,SP MOVEI E,(TP) PUSHJ P,STLOOP SSPEC2: SUBI E,(SP) ; MAKE SP BE AOBJN @@ -2211,16 +2206,12 @@ SSPEC2: SUBI E,(SP) ; MAKE SP BE AOBJN HLL SP,TP SUB SP,E MOVEM SP,SPSTOR+1 - POP P,SP - POP P,PVP POP P,E POPJ P, ; ENTRY FOR FUNNY COMPILER UNBIND (2) SSPEC1: PUSH P,E - PUSH P,PVP - PUSH P,SP SUBI E,1 ; MAKE SURE GET CURRENT BINDING PUSHJ P,STLOOP ; UNBIND MOVEI E,(TP) ; NOW RESET SP @@ -3628,22 +3619,9 @@ IMFUNCTION SETG,SUBR CAIL 0,HIBOT ; PURE ATOM? PUSHJ P,IMPURIFY ; YES IMPURIFY PUSHJ P,IGLOC ;GET LOCATIVE TO VALUE - CAME A,$TUNBOUND ;IF BOUND - JRST GOOST1 - SKIPN NOSETG ; ALLOWED? - JRST GOOSTG ; YES - PUSH TP,$TATOM - PUSH TP,EQUOTE CREATING-NEW-GVAL - PUSH TP,$TATOM - PUSH TP,1(AB) - PUSH TP,$TATOM - PUSH TP,EQUOTE NON-FALSE-TO-ALLOW - MCALL 3,ERROR - GETYP 0,A - CAIN 0,TFALSE - JRST FINIS -GOOSTG: PUSHJ P,BSETG ;IF NOT -- BIND IT -GOOST1: MOVE C,2(AB) ; GET PROPOSED VVAL + CAMN A,$TUNBOUND ;IF BOUND + PUSHJ P,BSETG ;IF NOT -- BIND IT + MOVE C,2(AB) ; GET PROPOSED VVAL MOVE D,3(AB) MOVSI A,TLOCD ; MAKE SURE MONCH WINS PUSHJ P,MONCH0 ; WOULD YOU BELIEVE MONITORS!!!! @@ -3891,22 +3869,8 @@ SET1: PUSH TP,$TPVP ; SAVE PROCESS PUSHJ P,IMPURIFY MOVE C,(TP) PUSHJ P,AILOC ;GET LOCATIVE TO VALUE -GOTLOC: CAME A,$TUNBOUND ;IF BOUND - JRST GOOSE1 - SKIPN NOSET ; ALLOWED? - JRST GOOSET ; YES - PUSH TP,$TATOM - PUSH TP,EQUOTE CREATING-NEW-LVAL - PUSH TP,$TATOM - PUSH TP,1(AB) - PUSH TP,$TATOM - PUSH TP,EQUOTE NON-FALSE-TO-ALLOW - MCALL 3,ERROR - GETYP 0,A - CAIN 0,TFALSE - JRST FINIS -GOOSET: PUSHJ P,BSET ;IF NOT -- BIND IT -GOOSE1: MOVE C,2(AB) ; GET PROPOSED VVAL +GOTLOC: CAMN A,$TUNBOUND ;BOUND? + PUSHJ P, BSET ;BIND IT MOVE C,2(AB) ; GET NEW VAL MOVE D,3(AB) MOVSI A,TLOCD ; FOR MONCH diff --git a/src/mudsys/fopen.63 b/src/mudsys/fopen.35 similarity index 95% rename from src/mudsys/fopen.63 rename to src/mudsys/fopen.35 index 48fa1692e..5c9c32a2d 100644 --- a/src/mudsys/fopen.63 +++ b/src/mudsys/fopen.35 @@ -312,7 +312,6 @@ IFN ITS,[ PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS ADD AB,[2,,2] ; BUMP PAST DIRECTION - MOVEM AB,ABSAV(TB) MOVEI A,0 JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE @@ -359,7 +358,7 @@ ARGSOK: MOVEI A,CHANLNT ; GET LENGTH HRRI C,(B) ; AND NEW ONE BLT C,CHANLN-5(B) ; CLOBBER MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS - HLLM C,SCRPTO-1(B) + MOVEM C,SCRPTO-1(B) ; NOW BLT IN STUFF FROM THE STACK @@ -369,20 +368,6 @@ ARGSOK: MOVEI A,CHANLNT ; GET LENGTH MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS HRLI C,T.NM1(TB) BLT C,RSNAME(B) - MOVE B,IMQUOTE MODE - PUSHJ P,IDVAL1 - GETYP 0,A - CAIN 0,TFIX - JRST .+3 - MOVE B,(TP) - POPJ P, - - MOVE C,(TP) -IFE ITS,[ - ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS -] - HRRM B,-4(C) ; HIDE BITS - MOVE B,C POPJ P, ; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN @@ -559,7 +544,6 @@ CPOPJ: POPJ P, ; RETURN, ALL DONE SUB TP,[2,,2] ; FLUSH OLD STRING ADD E,[1,,1] ADD AB,[2,,2] ; BUMP ARG - MOVEM AB,ABSAV(TB) JUMPL AB,RPARGL ; AND GO ON CPOPJ1: AOS A,(P) ; PREPARE TO WIN HLRZS A @@ -601,7 +585,6 @@ ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END JRST NAPT ; NO, LOSE PMOVEM (AB),T.XT(TB) ADD AB,[2,,2] ; MUST BE LAST ARG - MOVEM AB,ABSAV(TB) JUMPL AB,TMA JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX @@ -657,10 +640,9 @@ IFE ITS,[ ; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) +RGPRS: MOVSI 0,NOSTOR -RGPRS: MOVEI 0,NOSTOR - -RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING +RGPARS: IORM 0,(P) ; SAVE FOR STORE CHECKING CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? JRST TN.MLT ; YES, GO PROCESS RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE @@ -671,13 +653,11 @@ RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE PUSHJ P,FLSSP ; FLUSH LEADING SPACES PUSHJ P,RGPRS1 ADD AB,[2,,2] - MOVEM AB,ABSAV(TB) CHKLST: JUMPGE AB,CPOPJ1 SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE POPJ P, PMOVEM (AB),T.XT(TB) ADD AB,[2,,2] - MOVEM AB,ABSAV(TB) JUMPL AB,TMA CPOPJ1: AOS (P) POPJ P, @@ -712,7 +692,6 @@ TN.SN2: HRRZ B,-3(TP) TN.SN3: CAIE A,"> ; SKIP IF WINS JRST ILLNAM PUSHJ P,TN.CPS ; COPY TO NEW STRING - HLLOS T.SPDL(TB) MOVEM A,T.SNM(TB) MOVEM B,T.SNM+1(TB) @@ -822,7 +801,6 @@ TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE HRLI 0,(AB) BLT 0,(A) ; BLT 'EM IN ADD AB,[10,,10] ; SKIP THESE GUYS - MOVEM AB,ABSAV(TB) JRST CHKLST ] @@ -948,14 +926,12 @@ ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED MOVE B,T.CHAN+1(TB) ; GET CHANNEL - HRRZ 0,-4(B) ; FUNNY MODE BITS HRRZM A,CHANNO(B) ; SAVE IT ANDI A,-1 ; READ Y TO DO OPEN MOVSI B,440000 ; USE 36. BIT BYES HRRI B,200000 ; ASSUME READ -; CAMN C,[SIXBIT /READB/] -; TRO B,2000 ; TURN ON THAWED IF READB - IOR B,0 + CAMN C,[SIXBIT /READB/] + TRO B,2000 ; TURN ON THAWED IF READB TRNE D,1 ; SKIP IF READ HRRI B,300000 ; WRITE BIT HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK @@ -1042,9 +1018,6 @@ STSTK: PUSH TP,$TCHAN MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT MOVEI A,RDEVIC-1(B) PUSHJ P,MOVSTR ; FLUSH IT ON - HRRZ A,T.SPDL(TB) - JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON - ; A BEING NON ZERO) PUSH P,B PUSH P,C MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. @@ -1054,7 +1027,7 @@ STSTK: PUSH TP,$TCHAN MOVNI A,1 ; NOT A LOGICAL NAME POP P,C POP P,B -NLNMS: MOVEI 0,": + MOVEI 0,": IDPB 0,D JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? @@ -1479,20 +1452,7 @@ ONET2: MOVEI A,". CAIE 0,TFIX JRST WRONGT MOVE 0,RSNAME(B) - CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? - JRST ONET2A -;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS - MOVEI A,0 - LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> - DPB B,[201000,,A] ; 2.8-3.6 - LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> - DPB B,[001000,,A] ; 1.1-1.8 - LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> - DPB B,[101000,,A] ; 1.9-2.7 - LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> - DPB B,[301000,,A] ; 3.7-4.5 - MOVE 0,A -ONET2A: PUSHJ P,FIXSTK + PUSHJ P,FIXSTK JRST ONET4 MOVE B,T.CHAN+1(TB) MOVEI A,"- @@ -1590,17 +1550,8 @@ ONET6: MOVSI A,1 MOVEM C,BUFRIN(B) MOVSI 0,TUVEC HLLM 0,BUFRIN-1(B) - MOVE B,CHANNO(B) ; GET JFN - MOVEI A,4 ; CODE FOR GTNCP - MOVEI C,1(P) - ADJSP P,4 ; ROOM FOR DATA - MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC - GTNCP - FATAL NET LOSSAGE ; GET STATE - MOVE B,(P) - MOVE D,-1(P) - MOVE C,-3(P) - ADJSP P,-4 + MOVE A,CHANNO(B) ; GET JFN + GDSTS ; GET STATE MOVE E,T.CHAN+1(TB) MOVEM D,RNAME2(E) MOVEM C,RSNAME(E) @@ -1676,17 +1627,9 @@ ONETCH: IDPB A,C JRST (D) INSTAT: MOVE E,B - MOVE B,CHANNO(B) ; GET JFN - MOVEI A,4 ; CODE FOR GTNCP - MOVEI C,1(P) - ADJSP P,4 ; ROOM FOR DATA - MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC - GTNCP - FATAL NET LOSSAGE ; GET STATE - MOVE B,(P) - MOVE D,-1(P) - MOVE C,-3(P) - ADJSP P,-4 + MOVE A,CHANNO(E) + GDSTS + LSH B,-32. MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET MOVEM C,RSNAME(E) ; AND HOST MOVE C,BUFRIN(E) @@ -1933,13 +1876,7 @@ IFE ITS,[ HLLM A,BUFRIN-1(D) MOVEI A,177 ;SET ERASER TO RUBOUT MOVEM A,ERASCH(B) -IFE ITS,[ - MOVEI A,25 - MOVEM A,KILLCH(B) -] -IFN ITS,[ SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED -] MOVEI A,33 ;BREAKCHR TO C.R. MOVEM A,BRKCH(B) MOVEI A,"\ ;ESCAPER TO \ @@ -2281,9 +2218,9 @@ IFE ITS, MOVE B,@FETBL(E) IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT IFE ITS,[ -; PUSH P,E -; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA -; POP P,E + PUSH P,E + PUSHJ P,ADDNUL + POP P,E PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 ] @@ -2416,7 +2353,6 @@ IFE ITS,[ GTJFN ; GET A JFN JRST TDLLOS ; LOST ADD AB,[2,,2] ; PAST ARG - MOVEM AB,ABSAV(TB) JUMPL AB,RNM1 ; GO TRY FOR RENAME MOVE P,(TP) ; RESTORE P STACK MOVEI C,(A) ; FOR RELEASE @@ -2474,7 +2410,6 @@ RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING CAME C,IMQUOTE TO JRST WRONGT ; NO, LOSE ADD AB,[2,,2] ; BUMP PAST "TO" - MOVEM AB,ABSAV(TB) JUMPGE AB,TFA IFN ITS,[ MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE @@ -2504,7 +2439,6 @@ IFN ITS,[ ; HERE FOR RENAME WHILE OPEN FOR WRITING CHNRNM: ADD AB,[2,,2] ; NEXT ARG - MOVEM AB,ABSAV(TB) JUMPGE AB,TFA MOVE B,-1(AB) ; GET CHANNEL SKIPN CHANNO(B) ; SKIP IF OPEN @@ -2517,7 +2451,7 @@ CHNRNM: ADD AB,[2,,2] ; NEXT ARG CAMN A,[SIXBIT /PRINTB/] JRST CHNRN1 CAMN A,[SIXBIT /PRINAO/] - JRST CHNRN1 + JRST CHNRM1 CAME A,[SIXBIT /PRINTO/] JRST WRONGD @@ -3280,10 +3214,9 @@ WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE MFUNCTION PRINTB,SUBR - ENTRY + ENTRY 2 PBFL: PUSH P,. ; PUSH NON-ZERONESS - MOVEI A,-7 JRST BINI1 MFUNCTION READB,SUBR @@ -3291,31 +3224,26 @@ MFUNCTION READB,SUBR ENTRY PUSH P,[0] - MOVEI A,-11 -BINI1: HLRZ 0,AB - CAILE 0,-3 - JRST TFA - CAIG 0,(A) - JRST TMA - - GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + HLRZ 0,AB + CAIG 0,-3 + CAIG 0,-7 + JRST WNA + +BINI1: GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIN 0,TUVEC + JRST BINI2 CAIE 0,TSTORAGE - CAIN 0,TUVEC - JRST BINI2 - CAIE 0,TCHSTR - CAIN 0,TBYTE - JRST BYTOK - JRST WTYP1 ; ELSE LOSE + JRST WTYP1 ; ELSE LOSE BINI2: MOVE B,1(AB) ; GET IT HLRE C,B SUBI B,(C) ; POINT TO DOPE GETYP A,(B) PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE CAIE A,S1WORD - JRST WTYP1 -BYTOK: GETYP 0,2(AB) + JRST WTYP1 + GETYP 0,2(AB) CAIE 0,TCHAN ; BETTER BE A CHANNEL - JRST WTYP2 + JRST WTYP2 MOVE B,3(AB) ; GET IT ; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF ; PUSHJ P,CHRWRD ; INTO 1 WORD @@ -3332,36 +3260,25 @@ BYTOK: GETYP 0,2(AB) MOVE E,PBFL ; JUMPL E,WRONGD ; LOSER CAME E,(P) ; CHECK WINNGE - JRST WRONGD + JRST WRONGD MOVE B,3(AB) ; GET CHANNEL BACK SKIPN A,IOINS(B) ; OPEN? - PUSHJ P,OPENIT ; LOSE + PUSHJ P,OPENIT ; LOSE CAMN A,[JRST CHNCLS] - JRST CHNCLS ; LOSE, CLOSED + JRST CHNCLS ; LOSE, CLOSED JUMPN E,BUFOU1 ; JUMP FOR OUTPUT - MOVEI C,0 CAML AB,[-5,,] ; SKIP IF EOF GIVEN - JRST BINI5 + JRST BINI5 MOVE 0,4(AB) MOVEM 0,EOFCND-1(B) MOVE 0,5(AB) MOVEM 0,EOFCND(B) - CAML AB,[-7,,] - JRST BINI5 - GETYP 0,6(AB) - CAIE 0,TFIX - JRST WTYP - MOVE C,7(AB) BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT - JRST BINEOF - GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE - CAIE 0,TCHSTR - CAIN 0,TBYTE - JRST BYTI + JRST BINEOF MOVE A,1(AB) ; GET VECTOR PUSHJ P,PGBIOI ; READ IT HLRE C,A ; GET COUNT DONE - HLRE D,1(AB) ; AND FULL COUNT + HLRE D,1(AB) ; AND FULL COUNT SUB C,D ; C=> TOTAL READ ADDM C,ACCESS(B) JUMPGE A,BINIOK ; NOT EOF YET @@ -3370,99 +3287,17 @@ BINIOK: MOVE B,C MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ JRST FINIS -BYTI: -IFE ITS,[ - MOVE A,1(B) - RFBSZ - FATAL RFBSZ-LOST - PUSH P,B - LDB B,[300600,,1(AB)] - SFBSZ - FATAL SFBSZ-LOST - MOVE B,3(AB) - HRRZ A,(AB) ; GET BYTE STRING LENGTH - MOVNS A - MOVSS A ; MAKE FUNNY BYTE POINTER - HRR A,1(AB) - ADDI A,1 - PUSH P,C - HLL C,1(AB) ; GET START OF BPTR - MOVE D,[SIN] - PUSHJ P,PGBIOT - HLRE C,A ; GET COUNT DONE - POP P,D - SKIPN D - HRRZ D,(AB) ; AND FULL COUNT - ADD D,C ; C=> TOTAL READ - LDB E,[300600,,1(AB)] - MOVEI A,36. - IDIVM A,E - IDIVM D,E - ADDM E,ACCESS(B) - SKIPGE C ; NOT EOF YET - SETOM LSTCH(B) - MOVE A,1(B) - POP P,B - SFBSZ - FATAL SFBSZ-LOST - MOVE C,D - JRST BINIOK -] BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? - PUSHJ P,BFCLS1 ; GET RID OF SAME - MOVEI C,0 - CAML AB,[-5,,] - JRST BINO5 - GETYP 0,4(AB) - CAIE 0,TFIX - JRST WTYP - MOVE C,5(AB) -BINO5: MOVE A,1(AB) - GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE - CAIE 0,TCHSTR - CAIN 0,TBYTE - JRST BYTO - PUSH P,C + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVE A,1(AB) PUSHJ P,PGBIOO - POP P,C - JUMPE C,.+3 HLRE C,1(AB) MOVNS C - ADDM C,ACCESS(B) -BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + addm c,ACCESS(B) + MOVE A,(AB) ; RET VECTOR ETC. MOVE B,1(AB) JRST FINIS -BYTO: -IFE ITS,[ - MOVE A,1(B) - RFBSZ - FATAL RFBSZ-FAILURE - PUSH P,B - LDB B,[300600,,1(AB)] - SFBSZ - FATAL SFBSZ-FAILURE - MOVE B,3(AB) - HRRZ A,(AB) ; GET BYTE SIZE - MOVNS A - MOVSS A ; MAKE FUNNY BYTE POINTER - HRR A,1(AB) - ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING - HLL C,1(AB) ; GET START OF BPTR - MOVE D,[SOUT] - PUSHJ P,PGBIOT - LDB D,[300600,,1(AB)] - MOVEI C,36. - IDIVM C,D - HRRZ C,(AB) - IDIVI C,(D) - ADDM C,ACCESS(B) - MOVE A,1(B) - POP P,B - SFBSZ - FATAL SFBSZ-FAILURE - JRST BYTO1 -] BINEOF: PUSH TP,EOFCND-1(B) PUSH TP,EOFCND(B) @@ -4010,10 +3845,8 @@ IFE ITS,[ IFE ITS, MOVEI C,-1 JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL -IFN ITS,[ MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT ANDCAM C,-1(A) -] MOVSI C,014000 ; GET A ^C MOVEM C,(A) ;FAKE AN EOF @@ -4021,11 +3854,6 @@ IFE ITS,[ HLRE C,A ; HOW MUCH LEFT ADDI C,BUFLNT ; # OF WORDS TO C IMULI C,5 ; TO CHARS - PUSH P,0 - MOVEI 0,1 - SKIPE C - ANDCAM 0,-1(1) - POP P,0 MOVE A,-2(B) ; GET BITS TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL JRST BUFGOO @@ -4108,7 +3936,6 @@ PGBUFI: MOVE D,[SIN] SUBI A,1 ; FOR 440700 AND 010700 START SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A - MOVSI C,004400 IFN ITS,[ PGBIOO: PGBIOI: MOVE D,A ; COPY FOR LATER @@ -4139,9 +3966,8 @@ IFE ITS,[ PGBIOT: PUSH P,D PUSH TP,$TCHAN PUSH TP,B - PUSH P,C - HRRZS (P) - HRRI C,-1(A) ; POINT TO BUFFER + MOVEI C,-1(A) ; POINT TO BUFFER + HRLI C,004400 HLRE D,A ; XTRA POINTER MOVNS D HRLI D,TCHSTR @@ -4155,9 +3981,6 @@ PGBIOT: PUSH P,D MOVE A,CHANNO(B) ; FILE JFN MOVE B,C HLRE C,D ; - COUNT TO C - SKIPE (P) - MOVN C,(P) ; REAL DESIRED COUNT - SUB P,[1,,1] ENABLE XCT (P) ; DO IT TO IT DISABLE @@ -4183,24 +4006,17 @@ FIXACS: PUSH P,PVP PGBIOO: SKIPA D,[SOUT] PGBIOI: MOVE D,[SIN] - HRLI C,004400 JRST PGBIOT -DOIOTO: PUSH P,[SOUT] -DOIOTC: PUSH P,B +DOIOTO: PUSH P,D PUSH P,C - EXCH A,B - MOVE A,CHANNO(A) - HLRE C,B - HRLI B,444400 - XCT -2(P) - HRL B,C - MOVE A,B + PUSHJ P,PGBIOO DOIOTE: POP P,C - POP P,B - SUB P,[1,,1] + POP P,D POPJ P, -DOIOTI: PUSH P,[SIN] - JRST DOIOTC +DOIOTI: PUSH P,D + PUSH P,C + PUSHJ P,PGBIOI + JRST DOIOTE ] ; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE @@ -4473,9 +4289,9 @@ GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B PUSH P,D PUSH P,E PUSH P,0 - PUSH TP,$TCHAN - PUSH TP,B - .MCALL 1,INTFCN-1(B) + PUSH TP,INTFCN-1(B) + PUSH TP,INTFCN(B) + MCALL 1,APPLY GETYP A,A CAIE A,TCHRS JRST BADRET @@ -4502,11 +4318,11 @@ PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B PUSH P,D PUSH P,E PUSH P,0 + PUSH TP,INTFCN-1(B) ;PUSH TYPE OF GIVEN OBJ + PUSH TP,INTFCN(B) ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.) PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" PUSH TP,A ;PUSH THE CHAR - PUSH TP,$TCHAN ;PUSH THE CHANNEL - PUSH TP,B - .MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + MCALL 2,APPLY ;APPLY THE FUNCTION TO THE CHAR JRST INTRET diff --git a/src/mudsys/gchack.46 b/src/mudsys/gchack.45 similarity index 99% rename from src/mudsys/gchack.46 rename to src/mudsys/gchack.45 index b2b86f639..804b86579 100644 --- a/src/mudsys/gchack.46 +++ b/src/mudsys/gchack.45 @@ -113,10 +113,8 @@ UHACK: CAMN A,[PUSHJ P,SBSTIS] ADD C,TYPVEC+1 HRRZ C,(C) ANDI C,SATMSK ; GOT ITS SAT - CAIE C,SCHSTR ; COULD BE SPNAME - JRST .+3 CAIE C,SATOM ; DON'T BOTHER IF NOT ALL ATOMS - JRST VHACK1 + JRST VHACK1 MOVEI C,(D) UHACKX: PUSH P,C ; ATFIX CLOBBERS C SUBI B,1 ; BACK OFF @@ -537,4 +535,4 @@ PURE END - \ No newline at end of file +  \ No newline at end of file diff --git a/src/mudsys/initm.374 b/src/mudsys/initm.371 similarity index 98% rename from src/mudsys/initm.374 rename to src/mudsys/initm.371 index 6eb9c86b9..1134e5958 100644 --- a/src/mudsys/initm.374 +++ b/src/mudsys/initm.371 @@ -12,7 +12,6 @@ SYSQ XBLT==123000,, GCHN==0 IFE ITS,[ -EXPUNGE .FATAL FATINS==.FATAL" SEVEC==104000,,204 .INSRT STENEX > @@ -22,7 +21,7 @@ IMPURE OBSIZE==151. ;DEFAULT OBLIST SIZE -.LIFL +.LIFG .LOP .VALUE .ELDC @@ -462,14 +461,7 @@ PURIMP: MOVE A,FRETOP HRL B,A DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] FATAL INITM -- CAN'T FLUSH MIDDLE CORE - MOVE B,RHITOP - SUBI B,1 - ASH B,-10. - MOVEI A,PHIBOT - SUB A,B - SUBI A,1 - HRLS A - HRRI A,PHIBOT + MOVE A,[-<400-PHIBOT>,,PHIBOT] DOTCAL CORBLK,[[1000,,210000],[1000,,-1],A] FATAL INITM -- CAN'T PURIFY HIGH CORE ] @@ -873,7 +865,7 @@ PVALM: HLRZ 0,(B) VECTGO DUMMY1 IRP A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW -ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER +ILOC,IGLOC,IDVAL,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ @@ -891,16 +883,10 @@ CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG -NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,VECBOT] +NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR] .GLOBAL A ADDSQU A TERMIN -IFE ITS,[ -IRP A,,[NTTYPE,CLRSTR] - .GLOBAL A - ADDSQU A -TERMIN -] VECRET diff --git a/src/mudsys/interr.426 b/src/mudsys/interr.419 similarity index 99% rename from src/mudsys/interr.426 rename to src/mudsys/interr.419 index 32f1bc2cf..5473cabf6 100644 --- a/src/mudsys/interr.426 +++ b/src/mudsys/interr.419 @@ -3,8 +3,6 @@ TITLE INTERRUPT HANDLER FOR MUDDLE RELOCATABLE -.SYMTAB 3337. - ;C. REEVE APRIL 1971 .INSRT MUDDLE > @@ -77,7 +75,7 @@ MONITOR .GLOBAL MSGTYP,MTYI,UPLO,IFLUSH,OCLOS,ERRET,MASK1,MASK2 ;SUBROUTINES USED .GLOBAL ERROR,LISTEN,ECHO,RRESET,MTYO,GCHAPN,P.CORE,P.TOP,QUEUES,NOTTY,TTYOP2,TTICHN -.GLOBAL INTHLD,BNDV,SPECBE,DEMFLG,PLODR +.GLOBAL INTHLD,BNDV,SPECBE,DEMFLG ; GLOBALS FOR PRE-AGC INTERRUPT @@ -192,7 +190,7 @@ REPEAT NCHRS,SETZ HCHAR BLOCK NINT-NNETS-NCHRS-UINTS-36.-1 REPEAT NNETS,SETZ HNET REPEAT UINTS,SETZ USRINT -LOC EXTINT+NINT-11. +LOC EXTINT+NINT-12. REPEAT 3,SETZ HIOC LOC EXTINT+NINT-RLCHN-1 SETZ HREAL @@ -402,12 +400,7 @@ TNXIOC: MOVEM A,TSAVA JRST TNXCHN TNXFUL: MOVEM A,TSAVA - SKIPN PLODR - JRST TNXFU1 - FATAL DISK FULL IN PURE FIXUP, CONTINUE TO RETRY - JRST INTDON - -TNXFU1: MOVSI A,(1_<35.-12.>) + MOVSI A,(1_<35.-12.>) TNXCHN: IORM A,PIRQ2 MOVEM B,TSAVB @@ -424,8 +417,6 @@ DOINT: SKIPE INTHLD ; GLOBAL LOCK ON INTS PUSH P,INTFLG DOINTE: SKIPE ONINT ; ANY FUDGE? XCT ONINT ; YEAH, TRY ONE - PUSH P,ONINT - SETZM ONINT EXCH 0,LCKINT ; RELATIVIZE PC IF FROM RSUBR IFE ITS, TLZ 0,777740 ; KILL EXCESS BITS PUSH P,0 ; AND SAVE @@ -445,14 +436,14 @@ IFE ITS,[ EXCH 0,(P) ; AND RESTORE TO STACK DONREL: EXCH 0,LCKINT ; GET BACK SAVED 0 SETZM INTFLG ;DISABLE - AOS -2(P) ;INCR SAVED FLAG + AOS -1(P) ;INCR SAVED FLAG ;NOW SAVE WORKING ACS PUSHJ P,SAVACS - HLRZ A,-2(P) ; HACK FUNNYNESS FOR MPV/ILOPR + HLRZ A,-1(P) ; HACK FUNNYNESS FOR MPV/ILOPR SKIPE A - SETZM -2(P) ; REALLY DISABLED + SETZM -1(P) ; REALLY DISABLED DIRQ: MOVE A,PIRQ ;NOW SATRT PROCESSING JFFO A,FIRQ ;COUNT BITS AND GO @@ -470,7 +461,6 @@ IFN ITS,[ .SUSET [.SPICLR,,[0]] ; DISABLE INTS ] POP P,LCKINT - POP P,ONINT POP P,INTFLG SETZM INTHLD ; RE-ENABLE THE WORLD IFN ITS,[ @@ -1030,7 +1020,6 @@ RETRLT: MOVE A,(AB) TIMERR: MOVNI A,1 PUSHJ P,TGFALS JRST FINIS -] RLTPER: SKIPGE B,RLTSAV JRST IFALSE @@ -1586,7 +1575,7 @@ IFE ITS, PUSHJ P,TGFALS DIRQ1: SUB TP,[6,,6] JRST DIRQ - +] ; HANDLE INFERIOR KNOCKING AT THE DOOR HINF: @@ -1708,7 +1697,7 @@ HCHAR: HRRZ A,CHRS-36.(B) MCALL 3,INTERRUPT JRST DIRQ -HNET: SKIPLE A,NETJFN-NINT+NNETS+UINTS+1(B) +HNET: SKIPLE A,NETJFN-NINT+NNETS+UINTS(B) JRST HNET1 SUBI B,36.-NNETS-UINTS-NCHRS JUMPE A,DIRQ @@ -2742,7 +2731,7 @@ ITTIL1: LSH 0,-1 DOSIR: MOVE B,[-36.,,CHNTAB] - MOVSI 0,<1_12.>+FSEG + MOVSI 0,1_12. HLLM 0,(B) AOBJN B,.-1 diff --git a/src/mudsys/ldgc.101 b/src/mudsys/ldgc.100 similarity index 99% rename from src/mudsys/ldgc.101 rename to src/mudsys/ldgc.100 index a0cc596a9..d2f1c6a50 100644 --- a/src/mudsys/ldgc.101 +++ b/src/mudsys/ldgc.100 @@ -481,7 +481,6 @@ ILDBLK: SIXBIT / &DSK/ ] -IFE ITS,[ NDEBUG: SETZM GCDEBU CAIA DEBUGC: SETOM GCDEBU @@ -490,7 +489,6 @@ DEBUGC: SETOM GCDEBU CLOSF JFCL POPJ P, -] IMPURE GCDEBU: 0 diff --git a/src/mudsys/main.353 b/src/mudsys/main.350 similarity index 99% rename from src/mudsys/main.353 rename to src/mudsys/main.350 index 3c529250a..16369e5d7 100644 --- a/src/mudsys/main.353 +++ b/src/mudsys/main.350 @@ -2,8 +2,6 @@ TITLE MAIN LOOP AND GLOBALLY REFERENCED SUBROUTINES RELOCA -.SYMTAB 3337. - .GLOBAL TBINIT,PIDSTO,PROCID,PTIME,GCPDL,PBASE,TYPTOP,RERR,FRMSTK,EMERGE .GLOBAL PDLBUF,INTINT,START,SWAP,ICR,SPBASE,TPBASE,TPBAS,CURPRI,CHFINI,MKTBS .GLOBAL TOPLEVEL,INTOBL,INITIA,ERROBL,MAINPR,RESFUN,STATUS,TYPVEC,ROOT,TTICHN,TTOCHN @@ -64,10 +62,10 @@ STP: MOVEI C,0 MOVE PVP,PVSTOR+1 MOVE B,TBINIT+1(PVP) ;POINT INTO STACK AT START PUSHJ P,CHUNW ; LEAVE WHILE DOING UNWIND CHECK - XMOVEI E,TOPLEV + MOVEI E,TOPLEV MOVEI A,TFALSE ; IN CASE FALLS OFF PROCESS MOVEI B,0 - MOVEM E,-1(TB) + HRRM E,-1(TB) JRST CONTIN IMQUOTE TOPLEVEL @@ -696,11 +694,10 @@ MFUNCTION HANG,SUBR JUMPGE AB,HANG1 ; NO PREDICATE CAMGE AB,[-3,,] JRST TMA - PUSH TP,(AB) - PUSH TP,1(AB) - PUSHJ P,CHKPRD REHANG: MOVE A,[PUSHJ P,CHKPRH] MOVEM A,ONINT ; CHECK PREDICATE AFTER ANY INTERRUPT + PUSH TP,(AB) + PUSH TP,1(AB) HANG1: ENABLE ;LET OURSELVES BE INTERRUPTED OUT PUSHJ P,%HANG DISABLE ;PREVENT INTERRUPTS AT RANDOM TIMES @@ -724,7 +721,6 @@ MFUNCTION SLEEP,SUBR JRST TMA PUSH TP,2(AB) PUSH TP,3(AB) - PUSHJ P,CHKPRD SLEEP1: GETYP 0,(AB) CAIE 0,TFIX JRST .+5 @@ -767,7 +763,7 @@ CHKPRS: PUSH P,B HANGP: SKIPA B,[REHANG] SLEEPP: MOVEI B,RESLEE PUSH P,B -CHKPRD: PUSH P,A + PUSH P,A DISABLE PUSH TP,(TB) PUSH TP,1(TB) @@ -2027,7 +2023,7 @@ GCPDL: -GCPLNT,,GCPDL PURE -MUDSTR: ASCII /MUDDLE ‡¯ +MUDSTR: ASCII /MUDDLE / STRNG: -1 -1 -1 diff --git a/src/mudsys/mappur.163 b/src/mudsys/mappur.146 similarity index 96% rename from src/mudsys/mappur.163 rename to src/mudsys/mappur.146 index 28ccc9c09..3d0015ed8 100644 --- a/src/mudsys/mappur.163 +++ b/src/mudsys/mappur.146 @@ -12,7 +12,6 @@ XJRST==JRST 5, .GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 .GLOBAL C%M20,C%M30,C%M40,C%M60 -.GLOBAL MAPJFN,DIRCHN .INSRT MUDDLE > SPCFXU==1 @@ -246,7 +245,6 @@ SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy PLOADD: AOS -NSLOTS(P) ; skip return - MOVE B,FB.PTR(C) MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap SUB TP,C%22 @@ -337,7 +335,6 @@ FXUPGO: MOVE A,(TP) ; pointer to them IFE ITS,[ SKIPN MULTSG JRST FIXMLT -] HRRZ D,B ; this codes gets us running in the correct ; segment ASH D,PGSHFT @@ -560,11 +557,8 @@ IFE ITS,[ MOVEM 0,P.TOP POPJ P, -EPOPJ: -IFE ITS,[ - SKIPE MULTSG +EPOPJ: SKIPE MULTSG POP P,E -] POPJ P, IFE ITS,[ GETPAX: TDZA B,B ; here if other segs ok @@ -587,7 +581,7 @@ IFE ITS,[ MOVN A,NSEGS ; aobjn pntr to table HRLZS A MOVE B,P.TOP -GETPA8: CAMLE B,PURBTB(A) ; if this one is larger (or the same) +GETPA8: CAML B,PURBTB(A) ; if this one is larger JRST GETPA7 MOVE B,PURBTB(A) ; use it MOVEI E,FSEG(A) ; and the segment # @@ -634,8 +628,7 @@ IFE ITS,[ JRST GETPAX -LPGL1: PUSH P,A - PUSH P,[FSEG-1] +LPGL1: PUSH P,[FSEG-1] LPGL2: AOS E,(P) ; count segments MOVE B,NSEGS @@ -666,7 +659,6 @@ LPGL4: POP P,C JRST LPGL2 LPGL3: SUB P,C%11 - POP P,A SKIPE MULTSG PUSHJ P,PURTBU ; update PURBOT in multi case @@ -859,7 +851,7 @@ PURTBU: PUSH P,A HRLZS B MOVE A,PURTOP -PURTB2: CAMGE A,PURBTB(B) +PURTB2: CAMG A,PURBTB(B) JRST PURTB1 MOVE A,PURBTB(B) MOVEM A,PURBOT @@ -961,12 +953,7 @@ IFN ITS,.IOPUSH MAPCH, ; gc uses same channel POP P,C IFN ITS,.IOPOP MAPCH, EXCH C,A -IFE ITS,[ - JUMPL C,.+3 - JUMPL E,GETPAG - JRST GETPAX -] -IFN ITS, JUMPGE C,GETPAG + JUMPGE C,GETPAG ERRUUO EQUOTE NO-MORE-PAGES ; Here to clean up pure space by flushing all shared stuff @@ -975,23 +962,12 @@ PURCLN: SKIPE NOSHUF POPJ P, MOVEI B,EOC HRRM B,PURVEC ; flush chain pointer - MOVE D,PURVEC+1 ; get pointer to table -CLN1: -IFE ITS,[ - SKIPN A,FB.PTR(D) - JRST NOCL - ASH A,-PGSHFT - HRLI A,.FHSLF - RMAP - HLRZS A - CLOSF - JFCL -] -NOCL: SETZM FB.PTR(D) ; zero pointer entry - SETZM FB.AGE(D) ; zero link and age slots - SETZM FB.PGS(D) - ADD D,[ELN,,ELN] ; go to next slot - JUMPL D,CLN1 ; do til exhausted + MOVE B,PURVEC+1 ; get pointer to table +CLN1: SETZM FB.PTR(B) ; zero pointer entry + SETZM FB.AGE(B) ; zero link and age slots + SETZM FB.PGS(B) + ADD B,[ELN,,ELN] ; go to next slot + JUMPL B,CLN1 ; do til exhausted MOVE B,PURBOT ; now return pages SUB B,PURTOP ; compute page AOBJN pointer IFE ITS, SETZM MAPJFN ; make sure zero mapjfn @@ -1101,7 +1077,7 @@ IFE ITS,[ MOVEI F,0 ; seg info SKIPN MULTSG JRST XPLS3 - MOVEI F,FSEG-1 + MOVEI F,FSEG ADD F,NSEGS ASH F,9. XPLS3: MOVE G,E @@ -1793,39 +1769,32 @@ SFIX5: AOBJP C,SFIX4 IORM B,(C) ; fix it JRST SFIX5 -OBLFIX: PUSH P,[-TLN,,TPTR] +OBLFIX: MOVSI B,-OLN ; for checking more ins PUSH P,C - MOVE B,-1(P) - -OBLFXY: PUSH P,1(B) - PUSH P,(B) OBLFI1: AOBJP C,OBLFXX MOVE A,(C) - AOS B,(P) - AND A,(B) - MOVE B,-1(P) - CAME A,(B) + AND A,OMSK(B) + CAME A,OINS(B) JRST OBLFXX - AOBJP B,DOOBFX - MOVEM B,-1(P) - JRST OBLFI1 - -OBLFXX: SUB P,C%22 ; for checking more ins - MOVE B,-1(P) - ADD B,C%22 - JUMPGE B,OBLFX1 - MOVEM B,-1(P) + AOBJN B,OBLFI1 + JRST DOOBFX + +OBLFXX: MOVSI B,-OLN2 ; for checking more ins MOVE C,(P) - JRST OBLFXY +OBLFX1: AOBJP C,OBLFI2 + MOVE A,(C) + AND A,OMSK2(B) + CAME A,OINS2(B) + JRST OBLFI2 + AOBJN B,OBLFX1 INSBP==331100 ; byte pointer for ins field ACBP==270400 ; also for ac INDXBP==220400 -DOOBFX: MOVE C,-2(P) - SUB P,C%44 +DOOBFX: POP P,C MOVEI B,<<(HRRZ)>_<-9>> ; change em DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ LDB A,[ACBP,,(C)] ; get AC field @@ -1844,25 +1813,14 @@ DOOBFX: MOVE C,-2(P) MOVEM A,3(C) ADD C,C%11 NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) - HRRZ A,4(C) ; see if moves in type - CAIE A,$TOBLS - SUB C,[1,,1] ; fudge it HLLOM B,5(C) ; in goes HRLI -1 - CAIE A,$TOBLS ; do we need a skip? - JRST NOOB$ MOVSI B,(CAIA) ; skipper EXCH B,6(C) MOVEM B,7(C) ADD C,[7,,7] JRST SFIX3 -NOOB$: MOVSI B,(JFCL) - MOVEM B,6(C) - ADD C,C%66 - JRST SFIX3 - -OBLFX1: MOVE C,(P) - SUB P,C%22 +OBLFI2: POP P,C JRST SFIX3 ; Here to fixup compiled LENGTH @@ -1870,11 +1828,11 @@ OBLFX1: MOVE C,(P) LFIX: MOVSI B,-LLN ; for checking other LENGTH ins PUSH P,C -LFIX1: AOBJP C,LFIXY +LFIX1: AOBJP C,OBLFI2 MOVE A,(C) AND A,LMSK(B) CAME A,LINS(B) - JRST LFIXY + JRST OBLFI2 AOBJN B,LFIX1 POP P,C ; restore code pointer @@ -1897,9 +1855,6 @@ LFIX1: AOBJP C,LFIXY ADD C,C%44 JRST SFIX3 -LFIXY: POP P,C - JRST SFIX3 - ; Fixup a CASE dispatch CFIX: LDB A,[ACBP,,(C)] @@ -1918,8 +1873,7 @@ LFIXY: POP P,C ADD B,(P) ; point to code to change CFIXLP: HLRZ A,(B) ; check one out - TRZ A,400000 ; kill bit - CAIE A,M ; check for just index (or index with SETZ) + CAIE A,M ; check for just index JRST SFIX3 MOVEI A,(JRST (M)) HRLM A,(B) @@ -1950,26 +1904,10 @@ FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] [,AIMSK],[,IMSK] [,AIMSK],[MOVEI,AIMSK]] -FOO OINS3,OLN3,OMSK3,[[,IMSK],[,IMSK],[MOVE,AIMSK] - [,IMSK],[MOVEI,AIMSK]] - FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] [MOVE,AIMSK],[,AIMSK],[,IMSK] [,AIMSK],[MOVEI,AIMSK]] -FOO OINS4,OLN4,OMSK4,[[,IMSK],[,IMSK],[,AIMSK] - [MOVE,AIMSK],[,IMSK],[MOVEI,AIMSK]] - -TPTR: -OLN,,OINS - OMSK-1 - -OLN2,,OINS2 - OMSK2-1 - -OLN3,,OINS3 - OMSK3-1 - -OLN4,,OINS4 - OMSK4-1 -TLN==.-TPTR - FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] [,<-1,,777760>]] diff --git a/src/mudsys/muddle.347 b/src/mudsys/muddle.346 similarity index 99% rename from src/mudsys/muddle.347 rename to src/mudsys/muddle.346 index a7504a559..b52d7f626 100644 --- a/src/mudsys/muddle.347 +++ b/src/mudsys/muddle.346 @@ -335,7 +335,7 @@ NIL"=0 ;END OF LIST MARKER IF1 [ DEFINE SYSQ - ITS==1 + ITS==0 ; IFE <<<.AFNM1>_-24.>->,ITS==0 IFN ITS,[PRINTC /ITS VERSION /] @@ -460,7 +460,7 @@ TERMIN ] -RMT [EXPUNGE GENERAL,NUMSAT +RMT [EXPUNGE GENERAL,NUMSTA ] DEFINE XPUNGR A @@ -578,7 +578,7 @@ TYPMAK SOFFS,[[OFFS,OFFSET]] IFN MAIN,[RMT [LOC SAVE ] ] -IF2,EXPUNGE TYPMAK +IF2,EXPUNGE TYPMAK,DOTYPS RMT [EQUALS XP EXPUNGE IF2,XP STMPLT diff --git a/src/mudsys/mudex.183 b/src/mudsys/mudex.177 similarity index 96% rename from src/mudsys/mudex.183 rename to src/mudsys/mudex.177 index e763624c6..0284d992a 100644 --- a/src/mudsys/mudex.183 +++ b/src/mudsys/mudex.177 @@ -19,7 +19,7 @@ XJRST==JRST 5, .GLOBAL CERR1,CERR2,CERR3,COMPERR,CALER1,%LDRDO,%MPRDO,SQBLK,SQLOD,SQKIL,GETSQU .GLOBAL SQUPNT,SFRK,IJFNS,GETJS,OPBLK,SJFNS,OPSYS,GCLDBK,ILDBLK,IJFNS1,TILDBL .GLOBAL TBINIT,PVSTOR,SECBLK,PURCLN,NSEGS,INTINT,PURBTB,%CLNCO,OUTRNG -.GLOBAL MULTI,NOMULT,THIBOT,%PURMD +.GLOBAL MULTI,NOMULT,THIBOT .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 .GLOBAL C%M20,C%M30,C%M40,C%M60 @@ -99,18 +99,6 @@ CPOPJ: %PURIF: %GETIP: POPJ P, -%PURMD: MOVE A,[MFORK,,THIBOT] - MOVEI 0,777-THIBOT -%PURMX: RPACS - TLNN B,CTWRIT+CTCW ; SKIP IF NOT READ ONLY - TLNN B,CTEXST ; SKIP IF EXISTS (OTHERWISE WE'LL CREATE IT) - JRST .+3 ; SKIP IF NOT READ ONLY - MOVSI B,CTREAD+CTEXEC - SPACS - ADDI A,1 - SOJGE 0,%PURMX - POPJ P, - GETSQU: HRRZ 0,SQUPNT JUMPN 0,CPOPJ JRST SQLOD @@ -699,16 +687,6 @@ MPIN: PUSH P,C ; SAVE B MOVEM A,GCFK1 ; SAVE FORK HANDLE POP P,B ; RESTORE AOBJN PUSHJ P,PROTCT ; PROTECT IMAGE - MOVE A,[MFORK,,THIBOT] - MOVEI 0,777-THIBOT -%SAVLP: RPACS - TLNN B,CTWRIT+CTCW ; SKIP IF NOT READ ONLY - TLNN B,CTEXST ; SKIP IF EXISTS (OTHERWISE WE'LL CREATE IT) - JRST .+3 ; SKIP IF NOT READ ONLY - MOVSI B,CTREAD+CTCW+CTEXEC - SPACS - ADDI A,1 - SOJGE 0,%SAVLP POP P,B ; RESTORE AC POPJ P, @@ -819,7 +797,7 @@ MPINT1: MOVSI A,MFORK ; SET UP ARGS TO RMAP GBINT1: MOVE A,RMPTAB(E) ; GET FILE HANDLE MOVSI B,MFORK ; SET UP INTERPRETER ARG HRRI B,(D) - MOVSI C,CTREAD+CTEXEC + MOVSI C,CTREAD+CTEXEC+CTCW PMAP ; IN IT COMES ADDI E,1 ; INC INDEX AOBJN D,GBINT1 @@ -871,8 +849,6 @@ TWENTY: HRROI A,C ; RESULTS KEPT HERE ADDI C,777 ASH C,-9. ASH E,-9. - SKIPE MULSEC - JRST @[.+1] ; RUN IN SECT 0 CAIG E,1(C) JRST %CLN1 PUSH P,A @@ -892,12 +868,8 @@ TWENTY: HRROI A,C ; RESULTS KEPT HERE %CLN1: POP P,E POP P,C - SKIPN MULSEC - POPJ P, + POPJ P, - XJRST .+1 ; BACK TO SECT 1 - 0 - FSEG,,CPOPJ ; MULTI -- ENTER MULTI SEGMENT MODE ; THIS ROUTINE MAPS EVERYTHING UP AND THEN GOES UP THERE diff --git a/src/mudsys/mudsqu.29 b/src/mudsys/mudsqu.28 similarity index 99% rename from src/mudsys/mudsqu.29 rename to src/mudsys/mudsqu.28 index 92e15ad11..17253f615 100644 --- a/src/mudsys/mudsqu.29 +++ b/src/mudsys/mudsqu.28 @@ -78,7 +78,6 @@ ATOSQ: PUSH P,B IFE ITS,[ SKIPE MULTSG PUSHJ P,@[.+1] ; RUN IN 0 -] MOVE A,SQUPNT ; GET TABLE POINTER MOVE B,[2,,2] CAMN E,1(A) diff --git a/src/mudsys/nfree.54 b/src/mudsys/nfree.53 similarity index 99% rename from src/mudsys/nfree.54 rename to src/mudsys/nfree.53 index dc7546852..be431d4f8 100644 --- a/src/mudsys/nfree.54 +++ b/src/mudsys/nfree.53 @@ -4,7 +4,6 @@ TITLE MODIFIED AFREE FOR MUDDLE RELOCATABLE .INSRT MUDDLE > -SYSQ .GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1 .GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP @@ -140,7 +139,7 @@ CLOOP: CAMG A,(C) ; skip if not big enough CHAVIT: MOVE C,CODTOP MOVE E,PARBOT -IFE ITS, PUSHJ P,%CLNCO ; flush extra pages + PUSHJ P,%CLNCO ; flush extra pages MOVE E,PARBOT ; find amount obtained SUBI E,1 ; dont use a real pair MOVEI C,(E) ; for reset of CODTOP diff --git a/src/mudsys/primit.316 b/src/mudsys/primit.315 similarity index 99% rename from src/mudsys/primit.316 rename to src/mudsys/primit.315 index 4147a23d9..5e79bdebc 100644 --- a/src/mudsys/primit.316 +++ b/src/mudsys/primit.315 @@ -1783,15 +1783,7 @@ LSTUF: PUSHJ P,MONCH0 ; CHECK OUT MONITOR BITS MOVEM D,1(B) ; AND VAL POPJ P, -DEFRCY: MOVE E,1(B) ; RECYCLE THIS HANDY DEFER - MOVEM C,(E) - MOVEM D,1(E) - POPJ P, - -DEFSTU: GETYP A,(B) - CAIN A,TDEFER - JRST DEFRCY - PUSH TP,$TLIST +DEFSTU: PUSH TP,$TLIST PUSH TP,B PUSH TP,C PUSH TP,D diff --git a/src/mudsys/print.346 b/src/mudsys/print.340 similarity index 99% rename from src/mudsys/print.346 rename to src/mudsys/print.340 index 4e295bd8f..770b48f7a 100644 --- a/src/mudsys/print.346 +++ b/src/mudsys/print.340 @@ -421,27 +421,13 @@ CPATOM: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE PUSH TP,B PUSH P,0 ; ATOM CALLER ROUTINE PUSH P,C - SKIPN C,PRNTYP+1 - JRST PATOM - ADDI C,TATOM+TATOM - SKIPE (C) ; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH - JRST PRDIS1 - SKIPN C,1(C) - JRST PATOM - JRST (C) + JRST PATOM CPCHST: PUSH TP,A ; COPY ARGS FOR INTERNAL SAKE PUSH TP,B - PUSH P,C ; STRING CALLER ROUTINE - PUSH P,FLAGS - SKIPN C,PRNTYP+1 - JRST PATOM - ADDI C,TCHSTR+TCHSTR - SKIPE (C) ; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH - JRST PRDIS1 - SKIPN C,1(C) - JRST PCHSTR - JRST (C) + PUSH P,0 ; STRING CALLER ROUTINE + PUSH P,C + JRST PCHSTR @@ -868,8 +854,7 @@ PENT4: PUSHJ P,SPACEQ MOVE A,2(B) ; THE NAME OF THE ENTRY MOVE B,3(B) PUSHJ P,IPRINT ; OUT IT GOES - HLRZ B,-2(TP) - CAIL B,-4 ; SEE IF DONE + CAMLE B,[-4,,-1] ; SEE IF DONE JRST EXPEN MOVE B,-4(TP) ; PRINT SPACE PUSHJ P,SPACEQ @@ -877,8 +862,8 @@ PENT4: PUSHJ P,SPACEQ MOVE A,4(B) ; DECL MOVE B,5(B) PUSHJ P,IPRINT -EXPEN: MOVE B,-4(TP) ; GET CHANNEL INTO B - MOVEI A,"] ; CLOSE SQUARE BRAKET + MOVE B,-4(TP) ; GET CHANNEL INTO B +EXPEN: MOVEI A,"] ; CLOSE SQUARE BRAKET PUSHJ P,PRETIF MOVE B,-4(TP) ; GET CHANNEL INTO B PUSHJ P,SPACEQ @@ -1112,12 +1097,10 @@ PADS: ASCII /#####/ PFIXU4: HRRZ E,(C) ; GET CURRENT VAL MOVE E,1(E) - MOVEM C,-2(TP) PUSHJ P,ATOSQ ; GET SQUOZE JRST BADFXU TLO E,400000 ; USE TO DIFFERENTIATE BETWEEN STRING PUSHJ P,EOUT - MOVE C,-2(TP) ; HERE TO WRITE OUT LISTS @@ -1125,7 +1108,6 @@ PFIXU5: HRRZ C,(C) ; POINT TO CURRENT VALUE HRLZ E,1(C) HRRZ C,(C) ; POINT TO USES LIST HRRZ D,1(C) ; GET IT - MOVEM C,-2(TP) PFIXU6: TLCE D,400000 ; SKIP FOR RH HRLZ E,1(D) ; SETUP LH @@ -1139,7 +1121,6 @@ PFIXU6: TLCE D,400000 ; SKIP FOR RH TRNE E,-1 ; SKIP IF ZERO BYTE EXISTS MOVEI E,0 PUSHJ P,EOUT - MOVE C,-2(TP) JRST PFIXU2 ; DO NEXT PFIXU3: HLRE C,(TP) ; -AMNT LEFT IN BUFFER diff --git a/src/mudsys/pure.16 b/src/mudsys/pure.15 similarity index 93% rename from src/mudsys/pure.16 rename to src/mudsys/pure.15 index c57b1f2b0..0a263b512 100644 --- a/src/mudsys/pure.16 +++ b/src/mudsys/pure.15 @@ -3,7 +3,7 @@ TITLE SETPUR 1PASS -BOT==600000 +BOT==700000 .GLOBAL .LPUR,.LIMPU,HIBOT,PHIBOT,REALGC,THIBOT REALGC==200000 diff --git a/src/mudsys/readch.215 b/src/mudsys/readch.206 similarity index 95% rename from src/mudsys/readch.215 rename to src/mudsys/readch.206 index 615a6a8c6..cbbaef52d 100644 --- a/src/mudsys/readch.215 +++ b/src/mudsys/readch.206 @@ -29,7 +29,6 @@ N.CNTL==2 ; NO RUBOUT ^L ^D ECHO N.IMED==4 ; ALL CHARS WAKE UP N.IME1==10 ; SOON WILL BE N.IMED CNTLPC==20 ; USE ^P CODE MODE IOT -N.ESC==40 ; OPEN BLOCK MODE BITS OUT==1 @@ -71,9 +70,10 @@ INCHAR: IRP A,,[0,C,D,E] ;SAVE ACS INCHR1: TRNE C,N.IMED+N.CNTL ; SKIP IF NOT IMMEDIATE JRST DONE - LDB C,D ; GET PREV CHAR - CAMN C,ESCAP(E) ; SKIP IF NOT ESCAPED + TLZE D,40 ; SKIP IF NOT ESCAPED JRST INCHR2 ; ESCAPED + CAMN A,ESCAP(E) ; IF ESCAPE + TLO D,40 ; REMEMBER CAMN A,BRFCH2(E) JRST BRF CAMN A,BRFCHR(E) ;BUFFER PRINT CHAR @@ -856,26 +856,26 @@ MFUNCTION ECHOPAIR,SUBR MOVE A,1(AB) ;GET CHANNEL PUSHJ P,TCHANC ; VERIFY TTY IN MOVE D,3(AB) ;GET OTHER CHANNEL - HRRZ 0,-2(D) ; GET BITS - TRC 0,C.OPN+C.PRIN - TRNE 0,C.OPN+C.PRIN + MOVEI B,DIRECT-1(D) ;AND ITS DIRECTION + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCII /PRINT/] JRST WRONGD MOVE B,BUFRIN(A) ;GET A'S AUX BUFFER -IFN ITS,[ - HRLZ C,CHANNO(D) ; GET CHANNEL + HRLZ C,CHANNO(D) ; GET CHANNEL LSH C,5 IOR C,[.IOT A] ; BUILD AN IOT MOVEM C,ECHO(B) ;CLOBBER -] CHANRT: MOVE A,(AB) MOVE B,1(AB) ;RETURN 1ST ARG JRST FINIS -TCHANC: HRRZ 0,-2(A) ; GET BITS - TRC 0,C.OPN+C.READ - TRNE 0,C.OPN+C.READ - JRST BADCHN +TCHANC: MOVEI B,DIRECT-1(A) ;GET DIRECTION + PUSHJ P,CHRWRD ; CONVERT + JFCL + CAME B,[ASCII /READ/] + JRST WRONGD IFN ITS,[ LDB C,[600,,STATUS(A)] ;GET A CODE CAILE C,2 ;MAKE SURE A TTY FLAVOR DEVICE @@ -903,6 +903,7 @@ TTYOP2: SKIPE DEMFLG POPJ P, MOVE C,TTOCHN+1 HLLZS IOINS-1(C) + SETZM IMAGFL ; UNFORTUNATELY SFMOD CLOBBERS IMAGENESS MOVEI A,-1 ; TERMINAL; STAYS HERE THROUGHOUT ROUTINE MOVEI 2,175100 ; MAGIC BITS (SEE TENEX MANUAL) SFMOD ; ZAP @@ -945,7 +946,7 @@ TTYOP2: .SUSET [.RTTY,,C] TTYOPEN: SKIPE NOTTY POPJ P, - DOTCAL OPEN,[[1000,,TTYIN],[[SIXBIT /TTY /]],[5000,,0]] + DOTCAL OPEN,[[1000,,TTYIN],[[SIXBIT /TTY /]]] JRST TTYNO DOTCAL OPEN,[[1000,,TTYOUT],[[SIXBIT /TTY /]],[5000,,1]] FATAL CANT OPEN TTY @@ -1009,7 +1010,11 @@ IFN ITS,[ JFCL ] IFE ITS,[ - + SKIPN IMAGFL + JRST MTYI1 + PUSH P,B + PUSHJ P,MTYO1 + POP P,B MTYI1: PBIN ] POPJ P, @@ -1023,7 +1028,10 @@ MTYO: ENABLE ; NON-INTERRUPTABLE VERSION, FOR ECHO INSTRUCTION AND SUCHLIKE IMTYO: SKIPE NOTTY POPJ P, ; IGNORE, DONT HAVE TTY - +IFE ITS,[ + SKIPE IMAGFL ;SKIP RE-OPENING IF ALREADY IN ASCII + PUSHJ P,MTYO1 ;WAS IN IMAGE...RE-OPEN +] IFN ITS,[ CAIN A,177 ;DONT OUTPUT A DELETE POPJ P, @@ -1038,8 +1046,14 @@ IFN ITS,[ IFE ITS, PBOUT POPJ P, +MTYO1: MOVE B,TTOCHN+1 + PUSH P,0 + PUSHJ P,REASCI + POP P,0 + POPJ P, + ; HERE FOR TYO TO ANY TTY FLAVOR DEVICE -IFN ITS,[ + GMTYO: PUSH P,0 IFE ITS,[ HRRZ 0,IOINS-1(B) ; GET FLAG @@ -1071,10 +1085,10 @@ IFE ITS,[ CAMN B,TTOCHN+1 SETZM IMAGFL POPJ P, -] -WRONGC: FATAL TTYECHO--NOT ON A TTY-TYPE CHANNEL + +WRONGC: ERRUUO EQUOTE NOT-A-TTY-TYPE-CHANNEL @@ -1132,7 +1146,7 @@ REBLK1: DISABLE ; FALL THROUG=> UNBLOCKED MOVE B,(TP) SUB TP,[2,,2] POPJ P, -IFN ITS,[ + CHRSNR: SKIPN DEMFLG ; SKIP IF DEMON SKIPE NOTTY ; TTY? JRST REBLK ; NO, JUST RESET AND BLOCK @@ -1144,7 +1158,7 @@ TTYIOT: SETZ 1000,,TTYIN 0 405000,,20000 -] + ; HERE TO UNBLOCK TTY TTYUNB: MOVE A,WAITNS(B) ; GET INS @@ -1167,9 +1181,7 @@ IFE ITS,[ ; TENEX BASIC TTY I/O ROUTINE TNXIN: PUSHJ P,MTYI - DISABLE PUSHJ P,INCHAR - ENABLE POPJ P, ] MFUNCTION TTYECHO,SUBR @@ -1341,24 +1353,21 @@ IFN ITS,[ MOVE B,A ] IFE ITS,[ - SKIPE IMAGFL - JRST IMGOK - - PUSH P,A - PUSH P,B - MOVSI A,1 - HRROI B,[ASCIZ /TTY:/] - GTJFN - HALTF - MOVE B,[074000,,102000] - OPENF - HALTF - HRRZM A,IMAGFL - POP P,B - POP P,A -IMGOK: MOVE B,IMAGFL + MOVE B,CHANNO(B) EXCH A,B + MOVE 0,B + RFMOD + PUSH P,B + TRZ B,300 + SFMOD + STPAR +IMGIOT: + MOVE B,0 BOUT + POP P,B + SFMOD + STPAR + MOVE B,0 ] IMGEXT: MOVSI A,TFIX @@ -1391,11 +1400,43 @@ USEOTC: MOVSI A,TATOM MOVE A,1(B) JRST IMAGE1 -IFN ITS,[ + +IFE ITS,[ +OPNIMG: MOVE E,A ; SAVE CHAR + MOVE D,B + MOVE A,1(B) ;GET JFN OUT OF CHANNEL + RFMOD ;GET THE MAGIC BITS + TRZ B,302 + SFMOD ; MAKE IMAGE AND PUT BITS IN CHANNEL + STPAR + MOVE B,E + HLLOS IOINS-1(D) + CAMN D,TTOCHN+1 + SETOM IMAGFL + JRST IMGIOT ] + +DEVTOC: PUSH P,D + PUSH P,E + PUSH P,0 + PUSH P,A + MOVE D,RDEVIC(B) + MOVE E,[220600,,C] + MOVEI A,3 + MOVEI C,0 + ILDB 0,D + SUBI 0,40 + IDPB 0,E + SOJG A,.-3 + POP P,A + POP P,0 + POP P,E + POP P,D + POPJ P, + IMGBLK: OUT+IMAGEM+UNIT,,(SIXBIT /TTY/) 0 0 -] + IMPURE diff --git a/src/mudsys/reader.357 b/src/mudsys/reader.353 similarity index 99% rename from src/mudsys/reader.357 rename to src/mudsys/reader.353 index b813edbf6..2e9afa595 100644 --- a/src/mudsys/reader.357 +++ b/src/mudsys/reader.353 @@ -139,7 +139,7 @@ MFUNCTION FLOAD,SUBR PUSH TP,$TAB ;SLOT FOR SAVED AB PUSH TP,C%0 ; [0] ;EMPTY FOR NOW PUSH TP,$TCHSTR ;PUT IN FIRST ARG - PUSH TP,CHQUOTE READ + PUSH TP,CHQUOTE READB MOVE A,AB ;COPY OF ARGUMENT POINTER FARGS: JUMPGE A,CALOPN ;DONE? IF SO CALL OPEN @@ -805,9 +805,8 @@ NUMCH7: MOVE E,ENUM(TP) TRO FF,EPOS ; FLUSH IF SIGN COMES NOW JRST ATLP1 -NUMC10: TRNN FF,EFLG ; IF NOT IN EXPONENT, LOSE - TRNE FF,ENEG+EPOS ; SIGN FOR EXPONENT SEEN? - JRST NUMCH3 ; NOT A NUMBER +NUMC10: TRNE FF,ENEG+EPOS ; SIGN FOR EXPONENT SEEN? + JRST NUMCH3 ; NOT A NUMBER CAIN B,PLUCOD TRO FF,EPOS CAIN B,NEGCOD @@ -947,7 +946,7 @@ MACCAL: PUSHJ P,NXTCH1 ;READ ONE MORE CHARACTER PUSHJ P,MACAL1 ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE JRST IREAD2 -MACAL2: PUSH P,[RET12] +MACAL2: PUSH P,CRET MACAL1: PUSHJ P,IREAD1 ;READ FUNCTION NAME PUSHJ P,RETERR PUSH TP,C @@ -1889,13 +1888,12 @@ COMNT2: SKIPL A,5(TB) ; RESTORE CHANNEL ;HERE TO SET UP FOR .FOO ..FOO OR. DOTSTR: PUSHJ P,NXTCH1 ; GOBBLE A NEW CHARACTER - MOVEI FF,FRSDOT+DOTSEN+NUMWIN ; SET FLAG IN CASE + MOVEI FF,FRSDOT+DOTSEN ; SET FLAG IN CASE CAIN B,NUMCOD ; SKIP IF NOT NUMERIC JRST DOTST1 ; NUMERIC, COULD BE FLONUM ; CODE TO HANDLE ALL IMPLICIT CALLS I.E. QUOTE, LVAL, GVAL - TRZ FF,NUMWIN ; WE ARE NOT A NUMBER MOVSI B,TFORM ; LVAL MOVE A,IMQUOTE LVAL JRST IMPCA1 diff --git a/src/mudsys/save.176 b/src/mudsys/save.169 similarity index 95% rename from src/mudsys/save.176 rename to src/mudsys/save.169 index 7a70df5cb..57ddaa6f5 100644 --- a/src/mudsys/save.176 +++ b/src/mudsys/save.169 @@ -6,7 +6,6 @@ RELOCATABLE SYSQ - UNTAST==0 IFE ITS,[ IF1,[ @@ -18,8 +17,7 @@ EXPUNGE SAVE .GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS .GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI .GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN -.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT,THIBOT -.GLOBAL MAPJFN,DIRCHN +.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT FME==1000,,-1 FLS==1000,, @@ -248,33 +246,27 @@ IFE ITS,[ MOVEI A,400000 ; DISABLE INTS DIR ; INTS OFF -; LOOP TO CLOSE ALL RANDOM JFNS - - MOVE E,[-JFNLNT,,JFNTBL] + HLRZ A,IJFNS ; CLOSE AGC + CLOSF + JFCL + HRRZ A,IJFNS ; CLOSE INTERPRETER + CLOSF + JFCL + HLRZ A,IJFNS1 ; CLOSE SGC + CLOSF + JFCL -JFNLP: HRRZ A,@(E) - SKIPE A - CLOSF - JFCL - HLRZ A,@(E) - SKIPE A - CLOSF - JFCL - SETZM @(E) - AOBJN E,JFNLP + HRRZ A,IJFNS1 + CLOSF + JFCL + SETZM IJFNS + SETZM IJFNS1 ] PUSHJ P,PURCLN ; DONT KEEP PURE SHAREDNESS POP P,E IFE ITS,[ - MOVEI C,0 - MOVNI A,1 - MOVE B,[MFORK,,1] - MOVEI D,THIBOT-1 - PMAP - ADDI B,1 - SOJG D,.-2 SKIPLE A,SFRK ; IF WE HAVE AN INFERIOR, KILL IT KFORK ] @@ -324,8 +316,8 @@ IFN ITS,[ PUSH TP,C PUSH P,[N.CHNS] -CHNLP: HRRE A,(C) ; SEE IF NEW VALUE - JUMPL A,NXTCHN +CHNLP: HRRZ A,(C) ; SEE IF NEW VALUE + JUMPN A,NXTCHN SKIPN B,1(C) ; GET CHANNEL JRST NXTCHN PUSHJ P,REOPN @@ -377,13 +369,6 @@ IFE ITS,[ ] PUSHJ P,%RUNAM PUSHJ P,%RJNAM - -IFE ITS,[ - MOVEI A,400000 - MOVE B,[1,,ILLUUO] - MOVE C,[40,,UUOH] - SCVEC -] MOVE A,$TCHSTR MOVE B,CHQUOTE RESTORED JRST FINIS @@ -578,15 +563,13 @@ CHNLO1: MOVE C,(TP) JRST CHNLO2 CHNLOS: MOVE C,(TP) - MOVE B,1(C) - SETZM 1(B) ; CLOBBER CHANNEL # - SETZM 1(C) + SETZM (C)-1 CHNLO2: MOVEI B,[ASCIZ / CHANNEL-NOT-RESTORED /] JRST MSGTYP" -IFN ITS,[ + NOCORE: PUSH P,A PUSH P,B MOVEI B,[ASCIZ / @@ -605,7 +588,7 @@ CORE ARRIVED POP P,B POP P,A POPJ P, -] + IFN UNTAST,[ PUCHK: MOVEI E,HIBOT ; COMPUTE REAL START OF INTERPRETER ASH E,-10. ; TO PAGES @@ -786,14 +769,6 @@ CKVRS: PUSH P,-1(P) SUB P,[1,,1] ; POP OFF CHANNEL # POPJ P, -IFE ITS,[ -JFNTBL: SETZ IJFNS - SETZ IJFNS1 - SETZ MAPJFN - SETZ DIRCHN -JFNLNT==.-JFNTBL -] END - \ No newline at end of file diff --git a/src/mudsys/secagc.82 b/src/mudsys/secagc.80 similarity index 99% rename from src/mudsys/secagc.82 rename to src/mudsys/secagc.80 index 092cf9f1a..cc0d98b5b 100644 --- a/src/mudsys/secagc.82 +++ b/src/mudsys/secagc.80 @@ -4,9 +4,6 @@ TITLE SECAGC MUDDLE GARBAGE COLLECTOR FOR MULTI SECTIONS ;SYSTEM WIDE DEFINITIONS GO HERE RELOCATABLE - -.SYMTAB 3337. - GCST==$. TOPGRO==111100 BOTGRO==001100 @@ -338,9 +335,7 @@ NOMONO: MOVE PVP,PVSTOR+1 PUSHJ P,CTIME FSBR B,GCTIM ; GET TIME ELAPSED - SKIPN INBLOT ; STORE TIME ONLY IF NO RETRY - SKIPN GCDANG - MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER SKIPN GCMONF ; SEE IF MONITORING JRST GCCONT PUSHJ P,FIXSEN ; OUTPUT TIME diff --git a/src/mudsys/specs.112 b/src/mudsys/specs.110 similarity index 94% rename from src/mudsys/specs.112 rename to src/mudsys/specs.110 index 000c161c4..9e0d177b3 100644 --- a/src/mudsys/specs.112 +++ b/src/mudsys/specs.110 @@ -4,9 +4,9 @@ RELOCA MAIN==1 .GLOBAL TYPVLC,PBASE,TYPBOT,MAINPR,PTIME,IDPROC,ROOT,TTICHN,TTOCHN,TYPVEC -.GLOBAL %UNAM,%JNAM,%XUNA,%XJNA,NOTTY,GCHAPN,INTHLD,PURBOT,PURTOP,N.CHNS,SPCCHK,CURFCN +.GLOBAL %UNAM,%JNAM,NOTTY,GCHAPN,INTHLD,PURBOT,PURTOP,N.CHNS,SPCCHK,CURFCN .GLOBAL TD.GET,TD.PUT,TD.LNT,NOSHUF,GLOTOP,RSTACK,RCYCHN,START,TVSTRT,REALTV -.GLOBAL IJFNS,IJFNS1,SJFNS,OPSYS,HASHTB,MULTSG,PURBTB,NSEGS,NOATMS,NOSETG,NOSET +.GLOBAL IJFNS,IJFNS1,SJFNS,OPSYS,HASHTB,MULTSG,PURBTB,NSEGS .INSRT MUDDLE > @@ -27,9 +27,7 @@ IMPURE LOC100: JRST START IFN ITS,[ %UNAM: 0 ; HOLDS UNAME -%XUNA: 0 ; HOLDS XUNAME %JNAM: 0 ; HOLDS JNAME -%XJNA: 0 ; HOLDS XJNAME OPSYS: -1 ; MINUS ONE (-1) IF ITS RLTSAV: -1 ; SAVED ARG TO REALTIMER ] @@ -67,9 +65,7 @@ PURBOT: HIBOT ; BOTTOM OF DYNAMICALLY ALLOCATED PURE PURTOP: HIBOT ; TOP OF DYNAMICALLY ALLOCATED PURE SPCCHK: SETZ ; SPECIAL/UNSPECIAL CHECKING? NOSHUF: 0 ; FLAG TO BUILD A NON MOVING HI SEG -NOATMS: 0 ; FLAG DISALLOWING CREATION OF NEW ATOMS -NOSETG: 0 ; FLAG DISALLOWING AUTO-CREATE OF GBINDS -NOSET: 0 ; FLAG DISALLOWING AUTO-CREATE OF BINDINGS + ;PAGE MAP USAGE TABLE FOR MUDDLE ;EACH PAGE IS REPRESENTED BY ONE BIT IN THE TABLE ;IF BIT = 0 THEN PAGE IS FREE OTHERWISE BUSY diff --git a/src/mudsys/stbuil.20 b/src/mudsys/stbuil.15 similarity index 99% rename from src/mudsys/stbuil.20 rename to src/mudsys/stbuil.15 index 6381714c8..0579fbbfe 100644 --- a/src/mudsys/stbuil.20 +++ b/src/mudsys/stbuil.15 @@ -136,10 +136,9 @@ IFE ITS,[ ADD A,GCSTOP CAMG A,FRETOP ; SEE IF GC IS NESESSARY JRST RDGC1 - MOVE C,(P) ADDM C,GETNUM ; MOVE IN REQUEST MOVE C,[0,,1] ; ARGS TO GC - PUSHJ P,AGC ; GC + PUSHJ P,INQAGC ; GC RDGC1: MOVE C,GCSTOP ; GET CURRENT TOP OF THE WORLD MOVEM C,OGCSTP ; SAVE IT ADD C,(P) ; CALCULATE NEW GCSTOP @@ -443,13 +442,11 @@ RDFIX: PUSH P,C ; SAVE C JRST TYPCFX CAIN B,TTYPEW JRST TYPWFX - CAMLE B,NNPRI - JRST TYPGFX + CAML B,NNPRI + JRST TYPGFX ELEFX: EXCH B,A ; EXCHANGE FOR SAT PUSHJ P,SAT EXCH B,A ; REFIX - CAIE B,SOFFS - JRST OFSFIX CAIE B,SLOCR ; REL GLOC'S ARE STORED AS ATOMS CAIN B,SATOM JRST ATFX @@ -476,16 +473,6 @@ RDL1: POP P,B ; RESTORE B POP P,C POPJ P, -; FIXUP OFSSETS - -OFSFIX: HLRZ B,1(C) ; SEE IF PNTR TO FIXUP - JUMPE B,RDL1 - MOVE 0,GCSBOT ; GET UPDATE AMOUNT - SUBI 0,FPAG+5 - HRLZS 0 - ADDM 0,1(C) ; FIX POINTER - JRST RDL1 - ; ROUTINE TO FIX UP PNAMES STFX: TLZN D,STATM @@ -1566,8 +1553,8 @@ NORCL: MOVE B,GCSTOP ; POINT TO BOTTOM OF SPACE HRRZS USEFRE HRLZM A,-1(B) ; STORE LENGTH IN DOPE WORD HLLZM A,-2(B) ; AND BIT - HRRM B,-1(B) ; SMASH IN RELOCATION - SOS -1(B) + HRLI A,-1(B) ; SMASH IN RELOCATION + HLRM A,-1(B) POP P,B ; RESTORE PTR TO BOTTOM OF VECTOR HRROS B ; POINT TO START OF VECTOR TLC B,-3(A) ; SETUP COUNT diff --git a/src/mudsys/utilit.106 b/src/mudsys/utilit.103 similarity index 99% rename from src/mudsys/utilit.106 rename to src/mudsys/utilit.103 index 8a1e94efb..43c3e0bf4 100644 --- a/src/mudsys/utilit.106 +++ b/src/mudsys/utilit.103 @@ -372,7 +372,6 @@ IFE ITS, ANDCMI D,1777 ; MAKE LIKE AN ITS PAGE ADDI 0,1 HRRZ A,FRETOP BLT 0,-1(A) - PUSHJ P,RBLDM POP P,A DONE1: POP P,E POP P,D @@ -416,11 +415,9 @@ AGC1: SKIPE NPWRIT EXCH P,GCPDL SKIPE SWAPGC JRST IAMSGC -IFE ITS,[ - SKIPE MULTSG - JRST ISECGC -] + SKIPN MULTSG JRST IAGC + JRST ISECGC AAGC: SETZM SWAPGC EXCH P,GCPDL @@ -676,7 +673,7 @@ NRSB2: HLRZ B,1(A) ; GET SLOT INDICATION ADD B,PURVEC+1 ; POINT TO SLOT HRROS 2(B) ; MUNG AGE HLRE A,1(B) ; - LENGTH TO A - TRZ A,1777 + TRZ A,777 MOVNM A,CURPLN ; AND STORE JRST (E) NPRSUB: SKIPGE B,1(R) ; SEE IF PURE RSUBR diff --git a/src/mudsys/uuoh.184 b/src/mudsys/uuoh.179 similarity index 97% rename from src/mudsys/uuoh.184 rename to src/mudsys/uuoh.179 index 5d0c08d06..93617034d 100644 --- a/src/mudsys/uuoh.184 +++ b/src/mudsys/uuoh.179 @@ -26,11 +26,9 @@ G==F+1 UUOTBL: ILLUUO -EXPUNG .FATAL - IRP UUOS,,[[DP,DODP],[.MCALL,DMCALL],[.ACALL,DACALL],[.ECALL,DECALL],[.SAVAC,DSAVAC] [.FATAL,DFATAL],[.ERRUU,DOERR],[.POPUN,DPOPUN],[.LSAVA,DLSAVA] -[SHRRM,DHRRM],[SHRLM,DHRLM],[SXBLT,DXBLT],[SMOVEM,DMOVMX],[SHLRZ,DHLRZ],[SSETZM,DSETZM],[SMOVE,DMOVEX]] +[SHRRM,DHRRM],[SHRLM,DHRLM],[SXBLT,DXBLT],[SMOVEM,DMOVEM],[SHLRZ,DHLRZ],[SSETZM,DSETZM],[SMOVE,DMOVE]] UUFOO==.IRPCNT+1 IRP UUO,DISP,[UUOS] .GLOBAL UUO @@ -194,21 +192,18 @@ STUPM1: MOVEI D,(M) ; GET OFFSET INTO CODE SKIPN M,1(M) ; POINT TO CORE IF LOADED AOJA TB,STUPM2 ; GO LOAD IT STUPM3: ADDI M,(D) ; POINT TO REAL THING -IFN ITS,[ - HRLI C,M - AOBJP TB,MCHK7 - INTGO -MCHK7: JRST @C -] +IFN ITS, HRLI C,M IFE ITS,[ - AOBJP TB,MCHK7 -MCHK8: INTGO ADD C,M ; POINT TO START PC SKIPE MULTSG TLZ C,777400 ; KILL COUNT - - SKIPN MULTSG - JRST (C) +] + AOBJP TB,MCHK7 + INTGO +IFN ITS, JRST @C ; GO TO IT +IFE ITS,[ +MCHK8: SKIPN MULTSG + JRST (C) MOVEI B,0 ; AVOID FLAG MUNG XJRST B ; EXTENDED JRST HACK @@ -614,9 +609,6 @@ IFE ITS,[ HRRO A,UUOLOC ESOUT HALTF - MOVE A,20 - MOVE C,SAVEC - JRST @UUOH ] REPEAT 0,[ ; QUICK CALL HANDLER @@ -929,7 +921,6 @@ IFE ITS,[ MOVE 0,UUOH SKIPE MULTSG MOVE 0,MLTPC -] PUSH P,0 ANDI 0,-1 PUSH P,UUOLOC ; SAVE UUO @@ -939,7 +930,9 @@ IFE ITS,[ SUBI 0,(M) ; M IS BASE REG IFN ITS, TLO 0,M ; INDEX IT OFF M IFE ITS,[ - HRLI 0,400000+M + HRLI 0,M + SKIPE MULTSG + HRLI 0,<_12.> ; MAKE GLOBAL INDEX ] MOVEM 0,-1(P) ; AND RESTORE TO STACK ; MOVE 0,UUOLOC ; GET REL POINTER TO TBL - REDUNDANT @@ -954,9 +947,9 @@ IFN ITS,[ HRLI A,440640 ; OR IN THE BYTE POINTER ] IFE ITS,[ - MOVSI A,440600+B ; OR IN THE BYTE POINTER + MOVSI A,440640 ; OR IN THE BYTE POINTER SKIPN MULTSG - HRRZ B,UUOLOC + HRR A,UUOLOC SKIPE MULTSG MOVE B,MLTEA ] @@ -989,25 +982,17 @@ LPSVDN: ADDI C,1 MOVE 0,[ACSAV,,A] BLT 0,NOACS JSR LCKINT ; GO INTERRUPT +; MOVE 0,[A,,ACSAV] +; BLT 0,ACSAV+NOACS-1 ; UNNECESSARY SINCE WILL BE MUNGED ANYWAY HRRZ B,-3(P) ; NUMBER OF ACS +; MOVE B,0 LOPPOP: POP TP,ACSAV-1(B) LOPBAR: SUB TP,C%11 +; SUBI B,1 LOPFOO: SOJG B,LOPPOP - JUMPE R,LOPBLT ; OK, NOT RSUBR -IFE ITS,[ - SKIPL 1(R) ; NOT PURE RSUBR - SKIPN MULTSG -] -IFN ITS, SKIPN 1(R) ; NOT PURE RSUBR - JRST LOPBLT - - MOVE B,M - TLZ B,77740 - MOVEI A,0 - HRRI B,LOPBLT - XJRST A - -LOPBLT: MOVE 0,[ACSAV,,A] +; MOVEI 0,ACSAV-1 ; THIS CAUSES BLT TO GO TOO FAR +; ADDM 0,-3(P) + MOVE 0,[ACSAV,,A] BLT 0,@-3(P) ; RESTORE AC'S MOVE 0,-1(P) SUB P,C%44 ; RETURN ADDRESS, (M) @@ -1057,13 +1042,13 @@ DPOPUN: PUSHJ P,POPUNW ; HERE FOR MULTI SEG SIMULATION STUFF -DMOVEX: MOVSI C,(MOVE) +DMOVE: MOVSI C,(MOVE) JRST MEX DHRRM: MOVSI C,(HRRM) JRST MEX DHRLM: MOVSI C,(HRLM) JRST MEX -DMOVMX: MOVSI C,(MOVEM) +DMOVEM: MOVSI C,(MOVEM) JRST MEX DHLRZ: MOVSI C,(HLRZ) JRST MEX From 9c2d5684a9997093133359a4150c01d3e28c41f7 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Aug 2020 02:54:01 +0100 Subject: [PATCH 09/10] Re-apply a subset of the ITS Muddle 56 fixes. Most of these are the same as before. For UUOH, I've taken the fixed ITS conditionals from uuoh.mid.181 (16th March 1981). For MAPPUR, I've put the Tenex conditional around the whole of the segment-switching code since none of it is needed on ITS. Note in particular that the BOT patch is no longer needed -- this version of Muddle works happily with the pure region at 700000. --- src/mudsys/{fopen.35 => fopen.36} | 2 +- src/mudsys/{initm.371 => initm.372} | 8 +++++++- src/mudsys/{interr.419 => interr.420} | 3 ++- src/mudsys/{ldgc.100 => ldgc.101} | 2 ++ src/mudsys/{main.350 => main.351} | 2 +- src/mudsys/{mappur.146 => mappur.147} | 6 +++++- src/mudsys/{muddle.346 => muddle.347} | 2 +- src/mudsys/{mudsqu.28 => mudsqu.29} | 1 + src/mudsys/{nfree.53 => nfree.54} | 5 +++-- src/mudsys/{specs.110 => specs.111} | 4 +++- src/mudsys/{utilit.103 => utilit.104} | 4 +++- src/mudsys/{uuoh.179 => uuoh.180} | 20 ++++++++++++-------- 12 files changed, 41 insertions(+), 18 deletions(-) rename src/mudsys/{fopen.35 => fopen.36} (99%) rename src/mudsys/{initm.371 => initm.372} (99%) rename src/mudsys/{interr.419 => interr.420} (99%) rename src/mudsys/{ldgc.100 => ldgc.101} (99%) rename src/mudsys/{main.350 => main.351} (99%) rename src/mudsys/{mappur.146 => mappur.147} (99%) rename src/mudsys/{muddle.346 => muddle.347} (99%) rename src/mudsys/{mudsqu.28 => mudsqu.29} (99%) rename src/mudsys/{nfree.53 => nfree.54} (98%) rename src/mudsys/{specs.110 => specs.111} (97%) rename src/mudsys/{utilit.103 => utilit.104} (99%) rename src/mudsys/{uuoh.179 => uuoh.180} (99%) diff --git a/src/mudsys/fopen.35 b/src/mudsys/fopen.36 similarity index 99% rename from src/mudsys/fopen.35 rename to src/mudsys/fopen.36 index 5c9c32a2d..ffbee311b 100644 --- a/src/mudsys/fopen.35 +++ b/src/mudsys/fopen.36 @@ -2451,7 +2451,7 @@ CHNRNM: ADD AB,[2,,2] ; NEXT ARG CAMN A,[SIXBIT /PRINTB/] JRST CHNRN1 CAMN A,[SIXBIT /PRINAO/] - JRST CHNRM1 + JRST CHNRN1 CAME A,[SIXBIT /PRINTO/] JRST WRONGD diff --git a/src/mudsys/initm.371 b/src/mudsys/initm.372 similarity index 99% rename from src/mudsys/initm.371 rename to src/mudsys/initm.372 index 1134e5958..bd8c5293f 100644 --- a/src/mudsys/initm.371 +++ b/src/mudsys/initm.372 @@ -883,10 +883,16 @@ CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG -NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR] +NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC] .GLOBAL A ADDSQU A TERMIN +IFE ITS,[ +IRP A,,[NTTYPE,CLRSTR] + .GLOBAL A + ADDSQU A +TERMIN +] VECRET diff --git a/src/mudsys/interr.419 b/src/mudsys/interr.420 similarity index 99% rename from src/mudsys/interr.419 rename to src/mudsys/interr.420 index 5473cabf6..1635a4334 100644 --- a/src/mudsys/interr.419 +++ b/src/mudsys/interr.420 @@ -1020,6 +1020,7 @@ RETRLT: MOVE A,(AB) TIMERR: MOVNI A,1 PUSHJ P,TGFALS JRST FINIS +] RLTPER: SKIPGE B,RLTSAV JRST IFALSE @@ -1575,7 +1576,7 @@ IFE ITS, PUSHJ P,TGFALS DIRQ1: SUB TP,[6,,6] JRST DIRQ -] + ; HANDLE INFERIOR KNOCKING AT THE DOOR HINF: diff --git a/src/mudsys/ldgc.100 b/src/mudsys/ldgc.101 similarity index 99% rename from src/mudsys/ldgc.100 rename to src/mudsys/ldgc.101 index d2f1c6a50..a0cc596a9 100644 --- a/src/mudsys/ldgc.100 +++ b/src/mudsys/ldgc.101 @@ -481,6 +481,7 @@ ILDBLK: SIXBIT / &DSK/ ] +IFE ITS,[ NDEBUG: SETZM GCDEBU CAIA DEBUGC: SETOM GCDEBU @@ -489,6 +490,7 @@ DEBUGC: SETOM GCDEBU CLOSF JFCL POPJ P, +] IMPURE GCDEBU: 0 diff --git a/src/mudsys/main.350 b/src/mudsys/main.351 similarity index 99% rename from src/mudsys/main.350 rename to src/mudsys/main.351 index 16369e5d7..88b7b019c 100644 --- a/src/mudsys/main.350 +++ b/src/mudsys/main.351 @@ -2023,7 +2023,7 @@ GCPDL: -GCPLNT,,GCPDL PURE -MUDSTR: ASCII /MUDDLE / +MUDSTR: ASCII /MUDDLE ‡¯ STRNG: -1 -1 -1 diff --git a/src/mudsys/mappur.146 b/src/mudsys/mappur.147 similarity index 99% rename from src/mudsys/mappur.146 rename to src/mudsys/mappur.147 index 3d0015ed8..0cd8c0f78 100644 --- a/src/mudsys/mappur.146 +++ b/src/mudsys/mappur.147 @@ -342,6 +342,7 @@ IFE ITS,[ MOVEI C,0 XJRST C ; good bye cruel segment (will work if we fell ; into segment 0) +] FIXMLT: ASH B,PGSHFT ; aobjn to program FIX1: SKIPL E,(A) ; read one hopefully squoze @@ -557,8 +558,11 @@ IFE ITS,[ MOVEM 0,P.TOP POPJ P, -EPOPJ: SKIPE MULTSG +EPOPJ: +IFE ITS,[ + SKIPE MULTSG POP P,E +] POPJ P, IFE ITS,[ GETPAX: TDZA B,B ; here if other segs ok diff --git a/src/mudsys/muddle.346 b/src/mudsys/muddle.347 similarity index 99% rename from src/mudsys/muddle.346 rename to src/mudsys/muddle.347 index b52d7f626..cb732d570 100644 --- a/src/mudsys/muddle.346 +++ b/src/mudsys/muddle.347 @@ -335,7 +335,7 @@ NIL"=0 ;END OF LIST MARKER IF1 [ DEFINE SYSQ - ITS==0 + ITS==1 ; IFE <<<.AFNM1>_-24.>->,ITS==0 IFN ITS,[PRINTC /ITS VERSION /] diff --git a/src/mudsys/mudsqu.28 b/src/mudsys/mudsqu.29 similarity index 99% rename from src/mudsys/mudsqu.28 rename to src/mudsys/mudsqu.29 index 17253f615..92e15ad11 100644 --- a/src/mudsys/mudsqu.28 +++ b/src/mudsys/mudsqu.29 @@ -78,6 +78,7 @@ ATOSQ: PUSH P,B IFE ITS,[ SKIPE MULTSG PUSHJ P,@[.+1] ; RUN IN 0 +] MOVE A,SQUPNT ; GET TABLE POINTER MOVE B,[2,,2] CAMN E,1(A) diff --git a/src/mudsys/nfree.53 b/src/mudsys/nfree.54 similarity index 98% rename from src/mudsys/nfree.53 rename to src/mudsys/nfree.54 index be431d4f8..ce3101579 100644 --- a/src/mudsys/nfree.53 +++ b/src/mudsys/nfree.54 @@ -4,11 +4,12 @@ TITLE MODIFIED AFREE FOR MUDDLE RELOCATABLE .INSRT MUDDLE > +SYSQ .GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1 .GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP .GLOBAL FLIST,STORIC,GPURFL,GCDANG,PVSTOR,SPSTOR -.GLOBAL %CLNCO +IFE ITS,.GLOBAL %CLNCO MFUNCTION FREEZE,SUBR @@ -139,7 +140,7 @@ CLOOP: CAMG A,(C) ; skip if not big enough CHAVIT: MOVE C,CODTOP MOVE E,PARBOT - PUSHJ P,%CLNCO ; flush extra pages +IFE ITS,PUSHJ P,%CLNCO ; flush extra pages MOVE E,PARBOT ; find amount obtained SUBI E,1 ; dont use a real pair MOVEI C,(E) ; for reset of CODTOP diff --git a/src/mudsys/specs.110 b/src/mudsys/specs.111 similarity index 97% rename from src/mudsys/specs.110 rename to src/mudsys/specs.111 index 9e0d177b3..838608b87 100644 --- a/src/mudsys/specs.110 +++ b/src/mudsys/specs.111 @@ -4,7 +4,7 @@ RELOCA MAIN==1 .GLOBAL TYPVLC,PBASE,TYPBOT,MAINPR,PTIME,IDPROC,ROOT,TTICHN,TTOCHN,TYPVEC -.GLOBAL %UNAM,%JNAM,NOTTY,GCHAPN,INTHLD,PURBOT,PURTOP,N.CHNS,SPCCHK,CURFCN +.GLOBAL %UNAM,%JNAM,%XUNA,%XJNA,NOTTY,GCHAPN,INTHLD,PURBOT,PURTOP,N.CHNS,SPCCHK,CURFCN .GLOBAL TD.GET,TD.PUT,TD.LNT,NOSHUF,GLOTOP,RSTACK,RCYCHN,START,TVSTRT,REALTV .GLOBAL IJFNS,IJFNS1,SJFNS,OPSYS,HASHTB,MULTSG,PURBTB,NSEGS @@ -28,6 +28,8 @@ LOC100: JRST START IFN ITS,[ %UNAM: 0 ; HOLDS UNAME %JNAM: 0 ; HOLDS JNAME +%XUNA: 0 ; HOLDS XUNAME +%XJNA: 0 ; HOLDS XJNAME OPSYS: -1 ; MINUS ONE (-1) IF ITS RLTSAV: -1 ; SAVED ARG TO REALTIMER ] diff --git a/src/mudsys/utilit.103 b/src/mudsys/utilit.104 similarity index 99% rename from src/mudsys/utilit.103 rename to src/mudsys/utilit.104 index 43c3e0bf4..45874ec3d 100644 --- a/src/mudsys/utilit.103 +++ b/src/mudsys/utilit.104 @@ -415,9 +415,11 @@ AGC1: SKIPE NPWRIT EXCH P,GCPDL SKIPE SWAPGC JRST IAMSGC +IFE ITS,[ SKIPN MULTSG - JRST IAGC JRST ISECGC +] + JRST IAGC AAGC: SETZM SWAPGC EXCH P,GCPDL diff --git a/src/mudsys/uuoh.179 b/src/mudsys/uuoh.180 similarity index 99% rename from src/mudsys/uuoh.179 rename to src/mudsys/uuoh.180 index 93617034d..d87d3338e 100644 --- a/src/mudsys/uuoh.179 +++ b/src/mudsys/uuoh.180 @@ -192,18 +192,21 @@ STUPM1: MOVEI D,(M) ; GET OFFSET INTO CODE SKIPN M,1(M) ; POINT TO CORE IF LOADED AOJA TB,STUPM2 ; GO LOAD IT STUPM3: ADDI M,(D) ; POINT TO REAL THING -IFN ITS, HRLI C,M +IFN ITS,[ + HRLI C,M + AOBJP TB,MCHK7 + INTGO +MCHK7: JRST @C +] IFE ITS,[ + AOBJP TB,MCHK7 +MCHK8: INTGO ADD C,M ; POINT TO START PC SKIPE MULTSG TLZ C,777400 ; KILL COUNT -] - AOBJP TB,MCHK7 - INTGO -IFN ITS, JRST @C ; GO TO IT -IFE ITS,[ -MCHK8: SKIPN MULTSG - JRST (C) + + SKIPN MULTSG + JRST (C) MOVEI B,0 ; AVOID FLAG MUNG XJRST B ; EXTENDED JRST HACK @@ -921,6 +924,7 @@ IFE ITS,[ MOVE 0,UUOH SKIPE MULTSG MOVE 0,MLTPC +] PUSH P,0 ANDI 0,-1 PUSH P,UUOLOC ; SAVE UUO From 85ef3f96d27e1815b6ec92304ce476d69a3fb834 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Wed, 26 Aug 2020 18:18:54 +0100 Subject: [PATCH 10/10] Match just ..PERM/ after the Muddle build. DDT might choose to output -1 as a symbol instead -- matching just ..PERM/ should still catch broken Muddle initialisation. --- build/muddle.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build/muddle.tcl b/build/muddle.tcl index 588a4c2db..60421c58f 100644 --- a/build/muddle.tcl +++ b/build/muddle.tcl @@ -16,7 +16,7 @@ respond "\n" "D\033\033" respond "\n" "strng/\0331\"56^?^?^?\033\r" respond "\n" ":pdump mudsav; ts mud56\r" respond "*" ":start\r" -respond "..PERM/ -1" ":pdump mudsav; ts mdl56\r" +respond "..PERM/" ":pdump mudsav; ts mdl56\r" respond "*" ":kill\r" respond "*" ":midas sys3; ts mudinq_sysen2; mudinq\r"