--- /dev/null
+TITLE TSTINKING ODOR
+
+ITS==1 ; FLAG SAYING WHETHER FOR ITS OR 20
+
+IFE ITS,.INSRT MUDSYS;STENEX >
+
+ZR=0
+P=1
+A=2
+B=3
+C=4 ;FOR L.OP
+D=5
+T=6
+TT=7
+ADR=10
+BOT=11
+CKS=12
+LL=13
+RH=14
+MEMTOP=15
+NBLKS=16
+FF=17
+
+;I/O CHANNELS
+
+TPCHN==1
+TYOC==2
+TYIC==3
+ERCHN==4 ;CHANNEL FOR ERROR DEVICE
+
+;RIGHT HALF FLAGS
+
+ALTF==1
+LOSE==2
+ARG==4
+UNDEF==10 ;COMPLAIN ABOUT UNDEF
+INDEF==20 ;GLOBAL LOC
+GLOSYM==40 ;ENTER GLOBAL SYMS INTO DDT TABLE
+SEARCH==100 ;LIBRARY
+CODEF==200 ;SPECIAL WORD LOADED
+GPARAM==400 ;ENTER GPA LOCALS
+COND==1000 ;LOAD TIME CONDITIONAL
+NAME==2000 ;SET JOB NAME TO PROGRAM NAME
+LOCF=4000 ;LOCAL IN SYM PRT
+JBN==10000 ;JOB NAME SET BY JCOMMAND
+GOF==20000 ;LEAVING LDR BY G COMMAND
+GETTY==40000 ;GE CONSOLE
+MLAST==100000 ;LAST COMMAND WAS AN "M"
+NOTNUM==200000 ;USED FOR DUMMY SYMBOL LOGIC
+SETDEV==400000 ;DEVICE SET LAST TIME
+
+
+HSW==1
+
+;MISCELLANEOUS CONSTANTS
+
+LOWLOD==0 ;LOWEST LOCATION LOADED
+LPDL==20
+CBUFL==2000 ;COMMAND BUFFER LENGTH (MOBY LONG!)
+DOLL==44 ;REAL DOLLAR SIGN (NOT ALT MODE ETC.)
+INHASH==151. ; HASH TABLE LENGTH
+ICOMM==10000 ;INITIAL COMMON
+
+PPDL==60 ;POLISH PUSH DOWN LENGTH
+SATPDL==5 ;SATED PUSH DOWN LENGTH
+MNLNKS==20 ;MAXIMUM NUMBER OF LINKS
+STNBLN==200 ;STINK INPUT BUFFER SIZE
+
+;REFERECNE WORD FLAGS
+
+FIXRT==1
+FIXLT==2
+POLREQ==200000 ;MARKS GLOGAL REQUEST AS POLISH REQUEST
+DEFINT==400000 ;DEFERED INTERNAL
+
+
+MFOR==101000 ; FOR .CBLK
+MBLKS==301000
+
+BUCK==2 ; OFFSETS INTO SYMBOL BLOCKS
+LIST==3
+
+\f
+ LOC 41
+ JSR TYPR
+ 0 ;TSINT
+
+IF2,COMLOD=TPOK ;IS YOUR TAPE OK?
+
+DEFINE INFORM A,B
+IF1,[PRINTX / A = B
+/]
+TERMIN
+
+DEFINE CONC69 A,B,C,D,E,F,G,H
+A!B!C!D!E!F!G!H!TERMIN
+
+DMCGSW==0
+
+DEFINE DMCG
+IFN DMCGSW!TERMIN
+
+DEFINE NODMCG
+IFE DMCGSW!TERMIN
+\fLOC 200
+REL: ADDI@ T,FACTOR
+ABS: HRRZ ADR,T
+DATABK: HRRZS ADR
+ PUSHJ P,GETBIT
+ TRZE TT,4
+ JRST DATBK1
+ PUSHJ P,RRELOC
+COM1: ADDB T,AWORD
+ ADD T,RH
+ HLL T,AWORD
+ CLEARB RH,AWORD
+IFN LOWLOD,[CAIGE ADR,LOWLOD
+ AOJA ADR,DATABK
+]GCR2: CAMLE ADR,MEMTOP
+ JRST GCR1
+ TRNE FF,CODEF
+ MOVEM T,(ADR)
+ TRNN FF,CODEF
+ MOVEM T,@ADRPTR
+ AOJA ADR,DATABK
+ERR1:
+DATBK1: PUSHJ P,RLKUP
+ TRNE TT,2
+ JRST DECODE ;LINK OR EXTEND
+USE: ROTC T,3
+ HRL ADR,TT
+ SKIPE C,TIMES
+ CLEARM TIMES
+ DPB C,[(261200)ADR]
+ JUMPGE D,USE1A
+ TLNE B,200000
+ JRST USE2 ;PREV DEFINED
+ TRNE FF,UNDEF
+ JRST ERR2
+ PUSHJ P,DOWN
+ MOVEM ADR,(D)
+CDATABK: JRST DATABK
+
+GCR1: TRNE ADR,400000 ; PURE?
+ JRST HIGHSG ; YES, USE HIGH SEG
+ PUSHJ P,GETMEM
+ JRST GCR2
+
+HIGHSG: CAMLE ADR,HIGTOP ; WITHIN HIGH BOUND?
+ PUSHJ P,GETHI ; NO, GROW
+ MOVEM T,(ADR) ; STORE
+ AOJA ADR,DATABK
+\f
+; ROUTINE TO GROW HIGH SEGMENT
+
+GETHI:
+DMCG,[
+ PUSH P,A
+ SKIPE TT,USINDX ; DO WE KNOW USER INDEX
+ JRST GETHI1 ; YES, CONTINUE
+
+IFN ITS, .SUSET [.RUIND,,USINDX]
+ MOVE TT,USINDX
+
+GETHI1: MOVEI A,200001 ; FOR SEG #1 FROM CORE JOB
+ DPB TT,[MFOR,,A] ; STORE USER POINTER
+ MOVEI TT,(ADR) ; GET WHERE TO POINTER
+ SUBI TT,400000-2000 ; ROUND UP AND REMOVE HIGH BIT
+ ASH TT,-10. ; TO BLOCKS
+ DPB TT,[MBLKS,,A] ; STORE IT ALSO
+IFN ITS,[
+ .CBLK A, ; GOT TO SYSTEM
+ PUSHJ P,SCE
+]
+ MOVE A,HIBLK ; GET NO. OF HIGH BLOCKS
+ SUBM TT,A ; GET NEW BLOCKS
+ MOVEM TT,HIBLK ; AND STORE
+ ASH TT,10. ; NOW COMPUTE NEW HIGTOP
+ TRO TT,400000 ; WITH HIGH BIT
+ SUBI TT,1
+ MOVEM TT,HIGTOP
+ JRST POPAJ
+];DMCG
+
+NODMCG,[
+ PUSH P,A
+ MOVEI TT,(ADR)
+ SUBI TT,400000-2000
+ ASH TT,-10.
+ SUB TT,HIBLK ;NUMBER OF BLOCKS TO GET
+ ADDM TT,HIBLK ;NUMBER OF BLOCKS WE ARE GOING TO HAVE
+ SKIPG TT
+IFN ITS, .VALUE
+IFE ITS, HALTF
+ MOVE A,CWORD1
+ ADDI A,1000
+IFN ITS,[
+ .CBLK A,
+ PUSHJ P,SCE
+ SOJG TT,.-3
+]
+ MOVEM A,CWORD1
+ MOVE TT,HIBLK
+ ASH TT,10.
+ ADDI TT,400000-1
+ MOVEM TT,HIGTOP
+ JRST POPAJ
+];NODMCG
+\f
+USE2: MOVE T,1(D) ;FILL REQUEST
+ PUSHJ P,DECGEN
+ ADDM T,AWORD
+ ADDM TT,RH
+ JRST DATABK
+
+USE1A: MOVE T,ADR
+USE1: TLO A,400000
+ TRNN FF,UNDEF
+ JRST DEF1A ;ENTER DEF
+ERR2: (5000+SIXBIT /UGA/)
+ JRST DATABK
+
+
+DEF1: TLO A,600000
+ TRNN FF,INDEF+GPARAM ;DEFINE ALL SYMBOLS
+ TLNE A,40000 ;OTHERWISE, FLUSH LOCALS
+ JRST ENT
+ JRST DEF4
+\f
+RDEF: TRO TT,10 ;SET FLAG FOR REDEFINITION
+DEF: ROTC T,3
+ PUSHJ P,RRELOC
+DFSYM1: PUSH P,CDATABK
+DEFSYM: MOVEM T,T1
+DFSYM2: MOVEM A,CGLOB ;SAVE SQUOOZE IN CASE WE SATISFY POLISH
+ JUMPGE D,DEF1 ;NOT PREV SEEN
+ TLNN B,200000 ;PREVIOUSLY DEFINED
+ JRST PATCH5 ;PREVIOUSLY NEEDED
+
+DEF2: TRNE TT,100 ;REDEFINE NOT OK
+DEF3: MOVEM T,1(D)
+ CAME T,1(D)
+ (5000+SIXBIT /MDG/)
+DEF4: TRZ FF,GPARAM
+ POPJ P,
+
+PATCH3: PUSH P,PATCH6
+PATCH: PUSH P,A ; SAVE SYMBOL
+ HRRZ D,T2 ; DELETE REFERENCES FROM TABLE
+ MOVE A,(D) ; SQUOOZE
+ TLNE A,200000 ; CHECK FOR DEFINED SYMBOL
+ JRST PATCH2 ; DON'T DELETE REFERENCES
+ HRRZ A,1(D) ; FIRST REFERENCE
+ SETZM 1(D)
+ HRRZ D,(A)
+ PUSHJ P,PARRET
+ SKIPE A,D
+ JRST .-3
+PATCH2: HRRZ A,T2 ; POINT TO SYMBOL TO BE FLUSHED(REFS ARE GONE)
+ HRRZ B,LIST(A) ; GET LIST POINTER LEFT
+ HLRZ C,LIST(A) ; AND RIGHT
+ SKIPE B ; END?
+ HRLM C,LIST(B) ; NO, SPLICE
+ SKIPE C
+ HRRM B,LIST(C)
+ HRRZ C,BUCK(A) ; NOW GET BUCKET POINTERS
+ HLRZ B,BUCK(A)
+ CAMG B,HTOP ; SEE IF POINTS TO HASH TABLE
+ CAMGE B,HBOT
+ JRST .+3 ; NO, SKIP
+ HRRM C,(B) ; IT IS, CLOBBER IN
+ JRST .+2
+ HRRM C,BUCK(B) ; SPLICE BUCKET
+ SKIPE C
+ HRLM B,BUCK(C) ; SPLICE IT ALSO
+ CAIN A,(BOT) ; RESET BOT?
+ HRRZ BOT,LIST(BOT) ; YES
+ SETZM LIST(A) ; CLEAR FOR DEBUGGING
+ PUSHJ P,QUADRT ; RETURN BLOCK
+ POP P,A ; RESTORE SYMBOL
+ SKIPE SATED
+ JRST UNSATE ;DELETE THEM
+PATCH6: POPJ P,.+1
+\fPATCH7: PUSHJ P,LKUP1A
+ JUMPGE D,DEF1
+PATCH5: HRRZM D,T2
+
+ HRRZ B,1(D) ; POINT TO REF CHAIN
+ MOVEI D,(B)
+PATCH1: MOVE T,T1
+ JUMPE D,PATCH3
+ MOVE B,1(D) ; GET REF WORD
+ HRRZ D,(D)
+ HLL ADR,B
+ HRRZS B
+ TLZE ADR,DEFINT
+ JRST DEFIF ;DEFERED INTERNAL
+ TLZE ADR,POLREQ
+ JRST POLSAT ;POLISH REQUEST
+ CAIGE B,LOWLOD
+ JRST PATCH1
+ TLZN ADR,100000
+ JRST GEN ;GENERAL REQUEST
+ PUSH P,CPTCH1
+UNTHR: TRNN B,400000 ; HIGH SEG?
+ MOVEI B,@BPTR ; NO FUDGE
+ HRL T,(B)
+ HRRM T,(B)
+ HLRZ B,T
+ JUMPN B,UNTHR
+CPTCH1: POPJ P,PATCH1
+\fDEFIF: SKIPGE (B)
+ JRST DEFIF1 ;MUST SATISFY DEFERRED INTERNAL
+ TLNE ADR,FIXRT+FIXLT
+ JRST 4,.
+DEFIF6: EXCH A,B
+ PUSHJ P,PARRET
+ MOVE A,B ;GET THE SYMBOL BACK
+ JRST PATCH1
+
+DEFIF1: TLNN ADR,FIXRT+FIXLT
+ JRST 4,. ;SYMBOL FIXED UP BUT NOT EXPUNGED FROM TABLE
+ TLC ADR,FIXRT+FIXLT
+ TLCN ADR,FIXRT+FIXLT
+ JRST 4,. ;BOTH BITS TURNED ON!!
+ PUSH P,D
+ PUSH P,B ;POINTS TO VALUE PAIR
+ MOVE T,1(B) ;SQUOOZE FOR DEFERRED INTERNAL
+ PUSHJ P,LKUP
+ JUMPGE D,DEFIF4 ;PERHAPS ITS'S IN DDT TABLE
+ TLNE B,200000
+ JRST 4,. ;LOSER
+ PUSHJ P,GLOBS3 ;FIND THE VALUE
+ JUMPE B,[JRST 4,.]
+ TLNE ADR,FIXRT
+ JRST DEFIFR ;RIGHT HANDED
+ TLNN ADR,FIXLT
+ JRST DEFIF2 ;LEFT HANDED FIXUP
+ TLZN A,FIXLT
+ JRST 4,.
+ HLRE T,1(A)
+DEFIF2: ADD T,T1
+ TLZE ADR,FIXRT
+ HRRM T,1(A)
+ TLZE ADR,FIXLT
+ HRLM T,1(A)
+ MOVEM A,1(B) ;WRITE THE REFERENCE WORD BACK
+ MOVE T,1(A) ;SAVE VALUE OF THIS GLOBAL IN CASE
+ MOVE B,A
+ POP P,A ;POINTS TO VALUE PAIR
+ PUSHJ P,PARRET
+ TLNE B,FIXLT+FIXRT
+ JRST DEFIF3 ;STILL NOT COMPLETELY DEFINED
+ MOVE B,(D) ;SIMULATE CALL TO LKUP
+ MOVE A,B
+ TLZ A,700000
+ PUSH P,T1
+ PUSH P,T2
+ PUSH P,CGLOB
+ PUSHJ P,DEFSYM ;HOLD YOUR BREATH
+ POP P,CGLOB
+ POP P,T2
+ POP P,T1
+DEFIF3: POP P,D
+ MOVE A,CGLOB
+ JRST PATCH1
+
+DEFIFR: TLZN A,FIXRT
+ JRST 4,.
+ HRRE T,1(A)
+ JRST DEFIF2
+
+DEFIF4: POP P,B
+ POP P,D
+ PUSH P,B
+ PUSH P,T1 ;VALUE TO BE ADDED
+ PUSH P,[DEFIF5] ;WHERE TO RETURN
+ TLZ T,200000 ;ASSUME RIGHT HALF FIX
+ TLZE ADR,FIXLT
+ TLO T,200000 ;ITS LEFT HALF FIX
+ TLZ ADR,FIXRT
+ JRST GLST2
+DEFIF5: POP P,B
+ MOVE A,CGLOB
+ JRST DEFIF6
+\f
+GEN: PUSHJ P, DECGEN
+ TRNN B,400000 ; HIGH SEG
+ MOVEI B,@BPTR ; NO GET REAL LOC
+ ADD T,(B)
+ ADD TT,T
+ HRR T,TT
+ MOVEM T,(B)
+ JRST PATCH1
+
+DECGEN: MOVEI TT,0
+ TLNE ADR,10
+ MOVNS T
+ LDB C,[(261200)ADR]
+ SKIPE C
+ IMUL T,C
+ LDB C,[(220200)ADR]
+ TLNE ADR,4
+ MOVSS T
+ XCT WRDTAB(C)
+
+WRDTAB: POPJ P, ;FW
+ EXCH T,TT ;RH
+ HLLZS T ;LH
+ ROT T,5 ;AC
+
+
+DECODE: TRNN TT,1
+ JRST THRDR ;6 > LINK REQ
+ PUSHJ P,GETBIT
+ JRST @.+1(TT)
+ DEF ;DEFINE SYMBOL (70)
+ COMMON ;COMMON RELOCATION (71)
+ LOCGLO ;LOCAL TO GLOBAL RECOVERY (72)
+ LIBREQ ;LIBRARY REQUEST (73)
+ RDEF ;REDEFINITION (74)
+ REPT ;GLOBAL MULTIPLIED BY 1024>N>0 (75)
+ DEFPT ;DEFINE AS POINT (76)
+
+\f
+RLKUP: PUSHJ P,RPB
+
+LKUP: MOVE A,T
+LKUP1B: MOVE D,BOT
+LKUP3: MOVEI B,0(ADR) ;CONTAINS GLOBAL OFFSET
+ TRNN FF,CODEF
+ MOVEM B,CPOINT+1 ;$.
+ TLZ A,700000
+LKUP1A: PUSH P,A
+ MOVE B,HTOP
+ SUB B,HBOT ; COMP LENGTH
+ IDIVI A,(B) ; HASH THE SYMBOL
+ ADD B,HBOT ; POINT TO THE BUCKET
+ HRRZ D,(B) ; SKIP IF NOT EMPTY
+ MOVE A,(P) ; RESTORE SYMBOL
+ JRST LKUP7
+LKUP1: MOVE B,(D) ; GET A CANDIDATE
+ TLZ B,600000
+ CAMN A,B ; SKIP IF NOT FOUND
+ JRST LKUP5
+ HRRZ D,BUCK(D) ; GO TO NEXT IN BUCKET
+LKUP7: JUMPE D,LKUP6 ; FAIL, GO ON
+ HRROI D,(D)
+ JRST LKUP1
+
+LKUP6: TROA FF,LOSE
+LKUP5: MOVE B,(D) ; SYMBOL WITH ALL FLAGS TO B
+ JRST POPAJ
+
+RRELOC: PUSHJ P,RPB
+RELOC: HLRZ C,T
+ TRNE TT,1
+ ADD T,FACTOR
+ TRNE TT,2
+ ADD C,FACTOR
+ HRL T,C
+ POPJ P,
+
+DOWN: PUSH P,A
+ PUSHJ P,PAIR ; GET A REF PAIR
+ HRRZ ZR,1(D) ; SAVE OLD REF
+ MOVEM A,1(D) ; CLOBBER IT
+ MOVEM ZR,(A) ; AND PATCH
+ MOVEI D,1(A) ; POINT D TO DESTINATION OF REF WRD
+ JRST POPAJ
+\f
+;HERE TO CREATE NEW TABLE ENTRY
+;A/ SQUOZE
+;T/ VALUE
+
+DEF1A: PUSH P,CDATABK
+DEF2A: PUSH P,A ; SAVE SYMBOL
+ PUSHJ P,PAIR ; GET PAIR FOR REF CHAIN
+ MOVEM T,1(A) ; SAVE REF WORD
+ MOVEI T,(A) ; USE POINTER AS VALUE
+ SKIPA A,(P)
+ENT: PUSH P,A
+ PUSH P,C
+ TLZ A,700000
+ MOVEM A,GLBFS
+ PUSHJ P,QUAD ; GET A QUADRAD FOR SYMBOL
+ MOVE D,A ; POINT WITH C
+ MOVE A,-1(P) ; RESTORE SYMBOL FOR HASHING
+ MOVE B,HTOP ; -LNTH OF TABLE
+ SUB B,HBOT
+ TLZ A,600000 ; CLOBBER FLAGS
+ IDIVI A,(B) ; GET HASH
+ ADD B,HBOT ; POINT TO BUCKET
+ HRRZ C,(B) ; GET CONTENTS THEREOF
+ HRROM D,(B) ; PUT NEW ONE IN
+ HRRM C,BUCK(D) ; PUT OLD ONE IN
+ HRLM B,BUCK(D) ; POINT BACK TO TABLE
+ SKIPE C ; SKIP IF NO NEXT
+ HRLM D,BUCK(C)
+ SKIPE BOT
+ HRLM D,LIST(BOT)
+ HRRZM BOT,LIST(D) ; INTO LIST OF ALL SYMBOLS
+ MOVEI BOT,(D) ; AND RESET
+ MOVE A,-1(P)
+ MOVEM A,(D)
+ MOVEM T,1(D)
+ POP P,C
+ JRST POPAJ
+\fTHRDR: PUSHJ P,RPB
+ TLNE T,100000
+ ADD T,FACTOR
+ HRLI T,100000
+ JUMPGE D,USE1
+ MOVE B,(D)
+ TLNE B,200000
+ JRST THRD2 ;PREV DEFINED
+ PUSHJ P,DOWN ;ENTER LINK REQUEST
+ MOVEM T,(D)
+ JRST DATABK
+
+THRD2: HRRZ B,T
+ MOVE T,1(D)
+ PUSHJ P,UNTHR
+ JRST DATABK
+
+LOCGLO: JUMPGE T,LG2 ;JUMP FOR NORMAL LOCAL TO GLOBAL RECOVERY
+
+;HERE TO EXPUNGE OR RENAME LOCAL IN LOADER TABLE
+
+ JUMPGE D,[JRST 4,.] ;NO SYMBOL THERE
+ HRRZM D,T2 ;TABLE ENTRY TO DELETE
+ PUSHJ P,RPB ;SOAK UP ANOTHER WORD
+ JUMPGE T,LG1 ;JUMP TO RENAME LOCAL
+ TLNN B,200000 ;MAKE SURE THING IS DEFINED
+ JRST 4,. ;CANNOT HACK UNDEFINED SYMBOL
+ PUSHJ P,PATCH
+ JRST DATABK
+
+;HERE TO RENAME LOCAL IN LOADER TABLE
+
+LG1: PUSH P,(D) ;SQUOZE
+ PUSH P,1(D) ;VALUE
+ MOVSI B,200000 ;MARK AS DEFINED SO THAT . . .
+ IORM B,(D) ;PATCH WILL NOT HACK REFERENCES
+ PUSHJ P,PATCH
+ MOVE A,T ;NEW NAME
+ POP P,T ;VALUE
+ POP P,B ;OLD NAME
+ TDZ B,[37777,,-1] ;CLEAR SQUOZE
+ TLZ A,700000 ;CLEAR FLAGS OF NEW NAME
+ IOR A,B ;FOLD FLAGS, NEW NAME
+ MOVEI B,DATABK ;ASSUME IT WILL BE LOCAL
+ TLZE A,40000 ;SEE IF WE MUST RECOVER TO GLOBAL
+ MOVEI B,.+3 ;MUST RECOVER TO GLOBAL
+ PUSH P,B ;RETURN ADDRESS
+ JRST ENT ;ENTER IT
+ MOVE B,(D) ;SQUOZE AND FLAGS
+ MOVE A,B ;SQUOZE WITH . . .
+ TLZA A,740000 ;FLAGS CLEARED
+
+
+;HERE FOR NORMAL LOCAL TO GLOBAL RECOVERY
+
+LG2: JUMPGE D,DATABK ;LOCAL-GLOBAL RECOVERY
+ MOVE T,D ;D POINTS TO LOCAL
+ TLO A,40000 ;GLOBAL
+ PUSHJ P,LKUP1B ;FIND OCCURANCE OF GLOBAL
+ IORM A,(T) ;SMASH OLD LOCAL OCCURENCE
+ JUMPGE D,DATABK
+ TLNN B,200000
+ JRST DATABK
+ MOVE B,1(D) ;ALREADY DEFINED
+ MOVEM B,T1
+ HRRZM D,T2
+ ADDI D,2
+ PUSHJ P,PATCH ;CLOBBER DEFINITION
+ MOVE D,BOT
+ PUSH P,CDATABK
+ JRST PATCH7 ;FILL IN OLD LOCAL REQ
+
+LIBREQ: JUMPL D,DATABK ;ALREADY THERE
+ MOVEI T,0
+ JRST USE1
+
+REPT: MOVEM T,TIMES
+ JRST DATABK
+
+COMMON: ADD RH,COMLOC
+ JRST COM1
+
+DEFPT: MOVEI T,@LKUP3
+ TRO FF,GPARAM
+ JRST DFSYM1
+
+
+\f
+LDCND: TRO FF,COND
+ JRST LIB
+
+LIB6: CAIN A,12 ;END OF CONDITIONAL
+ JRST .OMIT1
+ HRRZS T
+ CAIN A,1
+ CAIE T,5 ;LOADER VALUE CONDITIONAL
+ CAIN A,11 ;COUNT MATCHING CONDITIONALS
+ AOS FLSH
+ JRST OMIT
+
+LIB2: TRNE FF,COND
+ JRST LIB6
+ CAIN A,5
+ JRST LIB7
+ PUSHJ P,RPB
+ CAIN A,4 ;PRGM NAME
+ TLNN T,40000 ;REAL END
+ JRST OMIT
+ JRST OMIT1 ;LEAVE LIB SEARCH MODE
+
+LIB1: TRO FF,SEARCH
+ PUSHJ P,RPB
+ JUMPGE T,.-1
+ TRZ FF,SEARCH
+LIB4: PUSHJ P,LKUP
+ JUMPGE D,LIB3 ;NOT ENTERED
+ TRNE FF,COND
+ JRST LIB5
+ TLNE B,200000 ;RQST NOT FILLED
+LIB3: TLC T,200000 ;"AND NOT" BIT
+LIB5: TLNE T,200000
+ JRST LIB1 ;THIS ONE LOSES
+LIB: CLEARM FLSH
+LIB7: PUSHJ P,RPB
+ JUMPGE T,LIB4
+.OMIT1: SOSGE FLSH
+OMIT1: TRZ FF,SEARCH+COND;END OF SEGMENT,LOAD THIS PROG
+OMIT: PUSH P,.
+
+\f
+RPB: SOSL TC
+ JRST GTWD
+ PUSHJ P,GTWD ;SOAK UP CKSUM
+ AOJN CKS,RCKS
+
+LOAD: JRST (LL) ;READ SWITCH
+LOAD2: PUSHJ P,GTWD
+ LDB A,[(220700)T]
+ MOVEM A,TC
+ MOVSI A,770000
+ ANDCAM A,BITPTR
+ LDB A,[(310700)T]
+LOAD1: MOVE P,SAVPDL
+ JUMPLE T,OUT
+ CAIL A,LOADTE-LOADTB
+ JRST TPOK
+ TRNE FF,SEARCH
+ JRST LIB2
+ TRZ FF,COND ;FUDGE FOR IMPROPER USE OF .LIBRA
+ JRST @.+1(A)
+LOADTB: TPOK
+ LDCMD ;LOADER COMMAND (1)
+ ABS ;ABSOLUTE (2)
+ REL ;RELOCATABLE (3)
+ PRGN ;PROGRAM NAME (4)
+ LIB ;LIBRARY (5)
+ COMLOD ;COMMON LOADING (6)
+ GPA ;GLOBAL PARAMETER ASSIGNMENT (7)
+SYMSW: DDSYMS ;LOCAL SYMBOLS (10)
+ LDCND ;LOAD TIME CONDITIONAL (11)
+SYMFLG: SETZ OMIT ;END LDCND (12)
+ HLFKIL ;HALF KILL A BLOCK OF SYMBOLS
+ OMIT ;OMIT BLOCK GENERATED BY LIBRARY CREATOR
+ OMIT ;LATER WILL BE .ENTRY
+ AEXTER ;BLOCK OF STUFF FOR SDAT OR USDAT
+ OMIT ;FOR .LIFND
+ GLOBS ;GLOBAL SYMBOLS BLOCK TYPE 20
+ FIXES ;FIXUPS BLOCK TYPE 21
+ POLFIX ;POLISH FIXUPS BLOCK TYPE 22
+ LINK ;LINK LIST HACK (23)
+ OMIT ;LOAD FILE (24)
+ OMIT ;LOAD LIBRARY (25)
+ OMIT ;LVAR (26) OBSOLETE
+ OMIT ;INDEX (27) NEW DEC STUFF
+ OMIT ;HIGH SEG(30)
+LOADTE:
+
+OUT: MOVE P,SAVPDL
+ADRM: POPJ P,
+\f
+;HERE TO PROCESS AN .EXTERN
+
+AEXTER: PUSHJ P,RPB ;READ AND LOOK UP SYMBOL
+ TLO T,40000 ;TURN ON GLOBAL BIT
+ PUSHJ P,LKUP ;NOW LOOK IT UP
+ JUMPGE D,.+3 ;NEVER APPEARED, MUST ENTER
+ TLNE B,200000 ;SKIP IF NOT DEFINED
+ JRST AEXTER ;THIS ONE EXISTS, GO AGAIN
+ MOVE B,USDATP ;GET POINTER TO USDAT
+ PUSH P,A ;SAVE SYMBOL
+ TLZ A,740000 ;KILL ALL FLAGS
+ MOVE T,B ;SAVE A COPY OF THIS
+ ADD T,[3,,3] ;ENOUGH ROOM?
+ JUMPGE T,TMX ;NO, BARF AT THE LOSER
+ MOVEM T,USDATP ;NOW SAVE
+ TRNN B,400000 ; HIGH SEG?
+ MOVEM A,@BPTR ; NO GET REAL LOC
+ TRNE B,400000 ; SKIP IF LOW SEG
+ MOVEM A,(B) ;STORE INTO CORE IMAGE BEING BUILT
+ POP P,A ;RESTORE SYMBOL
+ MOVEI T,1(B) ;ALSO COMPUTE 'VALUE' OF SYMBOL
+ PUSHJ P,DEFSYM
+ JRST AEXTER
+
+
+;USDAT HAS OVERFLOWN
+
+TMX: (3000+SIXBIT /TMX/)
+\fGPA: PUSHJ P,RPB
+ MOVEM T,T2
+ MOVEI T,0
+
+LDCMD: ADDI T,LDCMD2+1
+ HRRM T,LDCMD2
+ ROT T,4
+ DPB T,[(330300)LDCVAL]
+ TRO FF,UNDEF+CODEF
+ HRRM ADR,ADRM
+ MOVEI B,@LKUP3
+ MOVEM B,CPOINT+1
+ MOVEI ADR,T1
+ JSP LL,DATABK
+
+LDCMD1: TRZ FF,UNDEF+CODEF
+ HRRZ ADR,ADRM
+ CLEARB RH,AWORD
+ MOVE D,T1
+LDCMD2: JRST @.
+ GPA1
+ JMP ;JUMP BLOCK (1)
+ GLOBAL ;GLOBAL LOCATION ASSIGNMENT (2)
+ COMSET ;COMMON ORIGIN (3)
+ RESPNT ;RESET GLOBAL RELOCATION (4)
+ LDCVAL ;LOADER VALUE CONDITIONAL (5)
+ .OFFSET ;GLOBAL OFFSET (6)
+ L.OP ;LOADER EXECUTE (7)
+ .RESOF ;RESET GLOBAL OFFSET\f
+JMP: JUMPE D,JMP1
+ TRNN FF,JBN
+ TLO FF,NAME
+ MOVEM D,SA
+JMP1: MOVEI LL,LOAD2
+ JRST LOAD2
+
+GLOBAL: TRO FF,INDEF
+ HRRM D,RELADR
+ MOVE ADR,D
+ MOVEI D,RELADR
+GLOB1: HRRM D,REL
+ JRST JMP1
+
+RESPNT: TRZ FF,INDEF
+ MOVEI D,FACTOR
+ HRRZ ADR,FACTOR
+ JRST GLOB1
+
+LDCVAL: JUMP D,JMP1
+ TRO FF,SEARCH+COND
+ CLEARM FLSH
+ JRST JMP1
+
+.OFFSET: HRRM D,LKUP3
+ JRST JMP1
+
+L.OP: MOVE B,T1 ;B=3 C=4 D=5
+ MOVE 4,T1+1
+ MOVE 5,T1+2
+ TDNN B,[(757)777777]
+IFN 0,[ JRST L.OP2
+ HRRM ADR,ADRM
+ HRRZ ADR,ADRPTR
+ MOVEM 4,4(ADR)
+ MOVEM 5,5(ADR)
+ MOVEM B,20(ADR)
+ HRLZI B,(.RETUUO)
+ MOVEM B,21(ADR)
+ MOVEM B,22(ADR)
+ .XCTUUO NBLKS,
+ MOVE 4,4(ADR)
+ MOVE 5,5(ADR)
+ HRRZ ADR,ADRM
+ JRST .+2
+L.OP2:] IOR B,[0 4,5]
+ XCT B
+ MOVEM 4,.VAL1
+ MOVEM 5,.VAL2
+ JRST JMP1
+.RESOF: MOVEI D,0
+ JRST .OFFSET
+\f
+SETJNM: MOVEI A,SJNM1
+ HRRM A,SPTY
+ SETZM A
+ MOVE B,[(600)A-1]
+ PUSHJ P,SPT
+ MOVEM A,JOBNAM
+ MOVEI A,TYO
+ HRRM A,SPTY
+ MOVE A,PRGNAM
+ POPJ P,
+
+SJNM1: TRC T,40
+DDT4: IDPB T,B
+ POPJ P,
+
+
+GPA1: MOVE T,T2
+ PUSHJ P,LKUP
+ MOVE T,T1
+ MOVEI TT,100 ;DON'T GENERATE MDG
+ TRO FF,GPARAM
+ PUSHJ P,DEFSYM
+ JRST JMP1
+
+DDLUP:
+DDSYMS: PUSHJ P,RPB
+ LDB TT,[(410300)T]
+ TLNE T,40000
+ JRST DDLUP2
+ TLZ T,240000
+ TLO T,100000
+DDLUP1: MOVE A,T
+ PUSHJ P,RRELOC
+ PUSHJ P,ADDDDT
+ JRST DDLUP
+
+DDLUP2: TLZ T,740000 ;MARK AS BLOCK NAME
+ JRST DDLUP1
+\f;HERE TO HANDLE GLOBAL BLOCK -- BLOCK TYPE #20
+
+GLOBS: PUSHJ P,GETBIT ;CODE BITS
+ PUSHJ P,RPB ;SQOOZE
+ MOVEM T,CGLOB
+ PUSHJ P,GETBIT ;CODE BITS
+ PUSHJ P,RRELOC ;VALUE
+ MOVEM T,CGLOBV
+ MOVE T,CGLOB
+ TLO T,40000 ;GLOBAL FLAG
+ PUSHJ P,LKUP ;SYMBOL LKUP
+ LDB C,[400400,,CGLOB] ;FLAGS
+ CAIN C,60_-2
+ JRST GLOBRQ ;GLOBAL REQUEST
+
+;HERE TO HANDLE SYMBOL TABLE FIX UPS OR GLOBAL DEFINITION
+
+ TRNN C,10_-2 ;TEST FOR VALID FLAGS
+ TRNN C,4_-2 ;FORMAT IS XX01
+ JRST 4,.
+ LSH C,-2 ;SHIFT OUT GARBAGE
+ JUMPE C,GLBDEF ;FLAGS 04=> GLOBAL DEFINITION
+ CAIN C,40_-4 ;*****JUST A GUESS
+ JRST GLBDEF ;*****JUST A GUESS
+
+;DUMP A DEFERRED INTERNAL INTO LOADER TABLE
+
+ JUMPL D,GDFIT ;JUMP IF IN LOADER TABLE
+ PUSHJ P,PAIR ;GET VALUE PAIR
+ MOVSI T,DEFINT(C)
+ HRR T,A ;REFERENCE WORD POINTS TO PAIR
+ MOVE A,CGLOBV
+ SETZM (T) ;MARK AS VALUE
+ MOVEM A,1(T) ;SECOND WORD IS VALUE
+GLOBS0: MOVE A,CGLOB ;SQUOOZE
+ TLZ A,300000 ;FIX THE FLAGS
+ TLO A,440000
+ PUSHJ P,DEF2A ;PUT IT INTO LOADER TABLE
+ JRST GLOBS
+
+;HERE FOR DEFERRED INTERNAL ALREADY IN TABLE
+
+GDFIT: TLNE B,200000
+ JRST 4,. ;ALREADY DEFINED
+ PUSHJ P,GLOBS3 ;RETURNS REFERENCE WORD IN A
+ JUMPE B,GDFIT1 ;MUST ADD DEFERRED VALUE
+ HLRZ B,A
+ CAIE B,DEFINT(C)
+ JRST 4,. ;REFERENCE WORDS DON'T MATCH
+ MOVE B,CGLOBV
+ CAME B,1(A)
+ JRST 4,. ;VALUES DON'T MATCH
+ JRST GLOBS ;ALL'S WELL THAT ENDS WELL
+
+GDFIT1: PUSHJ P,DOWN
+ PUSHJ P,PAIR
+ MOVSI T,DEFINT(C)
+ HRR T,A
+ MOVEM T,(D)
+ SETZM (T) ;MARK AS VALUE
+ MOVE A,CGLOBV
+ MOVEM A,1(T) ;VALUE
+ JRST GLOBS
+\f;HERE TO HANDLE GLOBAL REQUEST -- FLAGS=60
+
+GLOBRQ: SKIPGE T,CGLOBV ;SKIP IF THREADED LIST
+ JRST GLOBR1 ;SINGLE WORD FIX UP MUST WORK HARDER
+
+;SIMPLE REQUEST
+
+ JUMPE T,GLOBS ;IGNORE NULL REQUEST
+ JUMPGE D,GLOBNT ;JUMP IF SYMBOL NOT IN TABLE
+ TLNE B,200000 ;TEST TO SEE IF DEFINED
+ JRST GLOBPD ;PREVIOUSLY DEFINED
+ PUSHJ P,DOWN ;NOT DEFINED, ENTER REQEST INTO TABLE
+ MOVE C,CGLOBV
+ HRLI C,100000 ;THIS IS A LINK LIST
+ MOVEM C,(D)
+ JRST GLOBS
+
+;HERE TO DEFINE GLOBAL SYMBOL, FLAGS=04
+
+GLBDEF: MOVE T,CGLOBV ;VALUE
+ MOVEI TT,0 ;REDEFINE NOT OKAY, SEE DEF2
+ PUSHJ P,DEFSYM ;SQUOOZE+FLAGS ALREADY IN B BECAUSE OF EARLIER LOOK UP
+ JRST GLOBS
+\f; HERE IF GLOBAL DEFINED, UNTHREAD THE CHAIN
+
+GLOBPD: MOVE T,1(D) ;VALUE
+ MOVE B,CGLOBV ;POINTER TO CHAIN
+ PUSHJ P,UNTHR
+ JRST GLOBS
+
+; ENTER NEW SYMBOL WITH LINK REQUEST
+
+GLOBNT: MOVEI C,44_-2 ;PROPER FLAGS, GLOBAL AND THIS HERE SQUOZ
+ DPB C,[400400,,A]
+ HRLI T,100000 ;SET LINK BIT IN REQUEST
+ PUSHJ P,DEF2A
+ JRST GLOBS
+
+; SINGLE WORD FIX UP -- FLAGS=60
+
+GLOBR1: TLNE T,100000 ;TEST FOR SYMBOL TABLE FIX
+ JRST GLOBST ;SYMBOL TABLE FIX
+ JUMPGE D,GLOBR2 ;JUMP IF NOT IN TABLE
+ TLNN B,200000
+ JRST GLOBR3 ;NOT PREVIOUSLY DEFINED
+ HRRZ B,T ;FIX UP LOCATION
+ PUSHJ P,MAPB ;DO THE RIGHT THING IF B IN HIGH SEGMENT
+ TLNE T,200000 ;LEFT OR RIGHT?
+ JRST HWAL ;LEFT
+HWAR: HRRE C,(B) ;HALF WORD ADD RIGHT
+ ADD C,1(D)
+ HRRM C,(B)
+ JRST GLOBS
+
+HWAL: HLRE C,(B) ;HALF WORD ADD LEFT
+ ADD C,1(D)
+ HRLM C,(B)
+ JRST GLOBS
+
+; HERE FOR SINGLE WORD FIX, SYMBOL UNDEFINED
+
+GLOBR3: PUSHJ P,DOWN ;MAKE ROOM IN TABLE
+ MOVE C,T
+ HRLI T,40001 ;ASSUME RIGHT HALF
+ TLNE C,200000 ;RIGHT OR LEFT?
+ HRLI T,40002 ;LEFT
+ MOVEM T,(D)
+ JRST GLOBS
+
+;HERE TO MAPPING ON AC B SO THAT SECOND SEGMENT LOADING WORKS
+
+MAPB: TRNN B,400000 ;SECOND SEGMENT
+ HRRI B,@BPTR ;NO, RELOCATE THE ADDRESS
+ POPJ P,
+\f; HERE FOR SINGLE WORD FIXUP, SYMBOL NOT IN TABLE
+
+GLOBR2: TLO A,400000 ;SYMBOL FLAG
+ MOVE C,T
+ HRLI T,1 ;ASSUME RIGHT HALF FIX
+ TLNE C,200000 ;LEFT OR RIGHT?
+ HRLI T,2 ;LEFT
+ PUSHJ P,DEF2A
+ JRST GLOBS
+
+; HERE FOR SYMBOL TABLE FIX
+
+GLOBST:
+; MOVE A,CGLOBV
+; TLZ A,700000 ;MAKE SURE WE ARE STILL FIXING SAME SYMBOL
+; CAME A,GLBFS
+; JRST 4,. ;DON'T AGREE
+ JUMPGE D,GLOBS5 ;JUMP IF FIXUP NOT SEEN
+ TLNN B,200000
+ JRST GLOBS6 ;FIXUP NOT EVEN DEFINED
+ PUSH P,1(D) ;SAVE POINTER TO OLD SYMBOL
+ PUSH P,T
+ MOVE T,CGLOBV
+ PUSHJ P,LKUP
+ JUMPGE D,GLST1
+ TLNE B,200000
+ JRST 4,.
+ PUSHJ P,GLOBS3 ;FIND THE GLOBAL VALUE
+ SKIPE B
+ SKIPN (A)
+ JRST 4,.
+ POP P,T
+ EXCH B,(P) ;GET BACK VALUE OF FIXUP SYMBOL
+ TLNE T,200000 ;LEFT OR RIGHT?
+ JRST GLOBS1 ;LEFT
+ HRRE C,1(A) ;RIGHT
+ ADD C,B
+ HRRM C,1(A)
+ TLZN A,FIXRT ;DID WE REALLY WANT TO DO THIS
+ JRST 4,. ;NO
+ JRST GLOBS2 ;YES
+
+GLOBS1: HLRE C,1(A) ;LEFT HALF FIX
+ ADD C,B
+ HRLM C,1(A)
+ TLZN A,FIXLT ;DID WE REALLY WANT TO DO THIS
+ JRST 4,. ;NOPE
+
+; HERE TO FINISH UP SYMBOL TABLE FIX
+
+GLOBS2: POP P,B
+ MOVEM A,1(B) ;STORE BACK REFERENCE WORD
+ TLNE A,FIXLT+FIXRT ;DO WE HAVE MORE FIXING
+ JRST GLOBS ;NO
+ MOVE T,1(A) ;FIXED VALUE
+ MOVEI TT,100 ;OKAY TO REDEFINE, TT USED AT DEF2
+ PUSHJ P,DEFSYM
+ JRST GLOBS
+
+;HERE TO FIND POINTER TO VALUE OF DEFERRED INTERNAL
+
+GLOBS3: MOVE B,1(D) ;FIRST REFERENCE WORD
+GLOBS4: SKIPGE A,1(B)
+ JRST GLOBS8
+GLOBS9: HRRZ B,(B)
+ JUMPN B,GLOBS4
+ POPJ P, ;REFERENCE WORD NOT FOUND
+GLOBS8: SKIPGE (A)
+ JRST GLOBS9 ;DEFERED INTERNAL FOR ANOTHER SYMBOL
+ POPJ P,
+
+GLOBS5: PUSHJ P,GLOBS7
+ JRST GLOBS0
+
+GLOBS6: PUSHJ P,GLOBS7
+ PUSHJ P,DOWN
+ MOVEM T,(D)
+CGLOBS: JRST GLOBS
+
+GLOBS7: PUSHJ P,PAIR
+ MOVE B,T
+ TLZ T,700000
+ MOVEM T,1(A)
+ MOVSI T,DEFINT+FIXRT
+ TLNE B,200000
+ TLC T,FIXRT+FIXLT
+ HRR T,A
+ MOVSI B,400000
+ MOVEM B,(T) ;MARK AS SQUOOZE
+ MOVE B,CGLOBV
+ MOVEM B,1(T) ;SQUOOZE
+ POPJ P,
+
+GLST1: POP P,(P) ;VALUE TO ADD ON TOP OF STACK
+ PUSH P,CGLOBS
+
+;HERE TO FIX UP DIFFERED INTERNAL
+;THAT MIGHT BE A LOCAL CALL WITH STACK
+; -1(P) VALUE TO ADD
+; (P) RETURN ADDRESS
+; T SQUOZE FOR FIXUP (20,XXX=>LEFT HALF FIX)
+
+GLST2: PUSH P,A
+ PUSH P,T
+ TLNE T,40000
+ JRST 4,. ;ITS GLOBAL, THERE'S NO HOPE
+ MOVEI B,0 ;BLOCK NAME
+ MOVE C,T ;SYMBOL TO FIX
+ TLZ C,740000
+ PUSHJ P,FSYMT2
+ JRST 4,. ;CROCK
+ MOVE B,1(T) ;VALUE TO FIX
+ HLRZ C,B ;THE LEFT HALF
+ POP P,A
+ TLNN A,200000
+ ADD B,-2(P)
+ TLNE A,200000
+ ADD C,-2(P)
+ HRL B,C
+ MOVEM B,1(T)
+ POP P,A
+ POP P,-1(P)
+ POPJ P,
+\f; HERE TO HANDLE FIXUPS -- BLOCK TYPE #21
+
+FIXES: SKIPE LFTFIX
+ JRST FIXESL ;LEFT HALF FIXUP LEFT OVER FROM PREVIOUS BLOCK
+ PUSHJ P,GETBIT ;CODE BITS
+ PUSHJ P,RRELOC ;FIX UP WORD
+ CAMN T,[-1] ;SKIPS ON RIGHT HALF FIX
+ JRST FIXESL ;LEFT HALF FIX
+ HLRZ B,T ;C(T) = POINTER,,VALUE C(B)=POINTER
+ PUSHJ P,UNTHR
+ JRST FIXES
+
+FIXESL: SETOM LFTFIX ;IN CASE RRELOC GETS US OUT OF BLOCK
+ PUSHJ P,GETBIT
+ PUSHJ P,RRELOC
+ SETZM LFTFIX ;OFF TO THE RACES
+ HLRZ B,T
+ PUSHJ P,UNTHL
+ JRST FIXES
+
+UNTHL: PUSHJ P,MAPB
+ HLL T,(B) ;CALL IS POINTER IN B
+ HRLM T,(B) ; VALUE IN T
+ HLRZ B,T
+ JUMPN B,UNTHL
+ POPJ P,
+
+UNTHF: PUSHJ P,MAPB
+ HRL B,(B)
+ MOVEM T,(B)
+ HLRZS B
+ JUMPN B,UNTHF
+ POPJ P,
+\f;POLISH FIXUPS <BLOCK TYPE 22>
+
+PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH?
+ JRST COMPOL ;YES
+ (3000+SIXBIT /POV/)
+COMPOL: (3000+SIXBIT /PTC/)
+LOAD4A: (3000+SIXBIT /IBF/)
+
+
+;READ A HALF WORD AT A TIME
+
+RDHLF: TLON FF,HSW ;WHICH HALF
+ JRST NORD
+ PUSHJ P,RWORD ;GET A NEW ONE
+ TLZ FF,HSW ;SET TO READ OTEHR HALF
+ MOVEM T,SVHWD ;SAVE IT
+ HLRZS T ;GET LEFT HALF
+ POPJ P, ;AND RETURN
+NORD: HRRZ T,SVHWD ;GET RIGHT HALF
+ POPJ P, ;AND RETURN
+
+RWORD: PUSH P,C
+ PUSHJ P,GETBIT
+ PUSHJ P,RRELOC
+ POP P,C
+ POPJ P,
+
+;HERE TO ENTER POLISH TOKEN INTO GLOBAL TABLE
+; C/ TOKEN TYPE
+; T/ VALUE (IGNORED IF OPERATOR)
+
+SYM3X2: PUSH P,A
+ PUSHJ P,PAIR ;GET TWO WORDS
+ MOVEM T,1(A) ;VALUE
+ EXCH T,POLPNT ;POINTER TO CHAIN
+ MOVEM T,(A) ;INTO NEW NODE
+ HRLM C,(A) ;TOKEN TYPE INTO LEFT HALF OF FIRST WORD
+ EXCH T,A
+ EXCH T,POLPNT ;RESTORE T, POINTER TO NEW NODE
+ JRST POPAJ
+\f;THIS ROUTINE SEARCHES TO SEE IF GLOBAL DEFINED (SKIPES IF UNDEFINED)
+;CALL WITH SQUOOZE IN C AND RETURNS WITH POINTER IN A IF DEFINED
+
+SDEF: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,T
+ MOVE T,C
+ PUSHJ P,LKUP
+ SKIPGE D
+ TLNN B,200000 ;SKIP IF DEFINED
+ AOS -5(P) ;INCREMENT ADDRESS
+ MOVEM D,-4(P) ;SET POINTER IN A
+ POP P,T
+ POP P,D
+ POP P,C
+POPBAJ: POP P,B
+POPAJ: POP P,A
+ POPJ P,
+
+;START READING THE POLISH
+
+POLFIX: MOVE D,PPDP ;SET UP THE POLISH PUSHDOWN LIST
+ MOVEI B,100 ;IN CASE OF ON OPERATORS
+ MOVEM B,SVSAT
+ SETOM POLSW ;WE ARE DOING POLISH
+ TLO FF,HSW ;FIX TO READ A WORD THE FIRST TIME
+ SETOM GLBCNT ;NUMBER OF GLOBALS IN THIS FIXUP
+ SETZM POLPNT ;NULL POINTER TO POLISH CHAIN
+ PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK
+
+RPOL: PUSHJ P,RDHLF ;GET A HALF WORD
+ TRNE T,400000 ;IS IT A STORE OP?
+ JRST STOROP ;YES, DO IT
+ CAIGE T,3 ;0,1,2 ARE OPERANDS
+ JRST OPND
+ CAILE T,14 ;14 IS HIGHEST OPERATOR
+ JRST LOAD4A ;ILL FORMAT
+ PUSH D,T ;SAVE OPERATOR IN STACK
+ MOVE B,DESTB-3(T) ;GET NUMBER OF OPERANDS NEEDED
+ MOVEM B,SVSAT ;ALSO SAVE IT
+ JRST RPOL ;BACK FOR MORE
+
+\f;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
+;GLOBAL REQUESTS
+
+OPND: MOVE A,T ;GET THE OPERAND TYPE HERE
+ PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND
+ MOVE C,T ;GET IT INTO C
+ JUMPE A,HLFOP1 ;0 IS HALF-WORD OPERAND
+ PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF
+ HRL C,T ;GET HALF IN RIGHT PLACE
+ MOVSS C ;WELL ALMOST RIGHT
+ SOJE A,HLFOP1 ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
+
+ LDB A,[400400,,C]
+ TLNE C,40000 ;CHECK FOR FUNNY LOCAL
+ PUSHJ P,SQZCON ;CONVERT TO STINKING SQUOOZE
+ DPB A,[400400,,C]
+ PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED
+ JRST OPND1 ;YES, WE WIN
+ AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
+ AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
+ PUSH P,C ;SAVE GLOBAL REQUESTS FOR LATER
+ MOVEI T,0 ;MARK AS SQUOOZE
+ EXCH C,T
+ PUSHJ P,SYM3X2 ;INTO THE LOADER TABLE
+ HRRZ C,POLPNT ;NEW "VALUE"
+ SKIPA A,[400000];SET UP GLOBAL FLAG
+HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG
+HLFOP1: SOJL B,CSAT ;ENOUGH OPERANDS SEEN?
+ PUSH D,C ;NO, SAVE VALUE(OR GLOBAL NAME)
+ HRLI A,400000 ;PUT IN A VALUE MARKER
+ PUSH D,A ;TO THE STACK
+ JRST RPOL ;GET MORE POLISH
+
+;HERE TO CONVERT TO STINKING SQUOOZE, CAVEAT: THE FLAG BITS ARE CLEARED
+
+SQZCON: TLZ C,740000
+ JUMPE C,CPOPJ
+SQZ1: CAML C,[50*50*50*50*50]
+ POPJ P,
+ IMULI C,50
+ JRST SQZ1
+
+; HERE IF GLOBAL SYMBOL DEFINED AT POLISH BLOCK READ TIME
+
+OPND1: MOVE C,1(A) ;SYMBOL VALUE
+ JRST HLFOP
+\f;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
+
+CSAT: HRRZS A ;KEEP ONLY THE GLOBAL-VALUE HALF
+ SKIPN SVSAT ;IS IT UNARY
+ JRST UNOP ;YES, NO NEED TO GET 2ND OPERAND
+ HRL A,(D) ;GET GLOBAL VALUE MARKER FOR 2ND OP
+ POP D,T
+ POP D,T ;VALUE OR GLOBAL NAME
+UNOP: POP D,B ;OPERATOR
+ JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
+ XCT OPTAB-3(B) ;IF BOTH VALUES JUST XCT
+ MOVE C,T ;GET THE CURRENT VALUE
+SETSAT: SKIPG B,(D) ;IS THERE A VALUE IN THE STACK
+ MOVE B,-2(D) ;YES, THIS MUST BE THE OPERATOR
+ MOVE B,DESTB-3(B) ;GET NUMBER OF OPERANDS NEEDED
+ MOVEM B,SVSAT ;SAVE IT HERE
+ SKIPG (D) ;WAS THERE AN OPERAND
+ SUBI B,1 ;HAVE 1 OPERAND ALREADY
+ JRST HLFOP1 ;GO SEE WHAT WE SHOULD DO NOW
+
+;HANDLE GLOBALS
+
+GLOB: TRNE A,-1 ;IS IT IN RIGHT HALF
+ JRST TLHG ;NO NEED TO SAVE THIS VALUE IF ITS GLOBAL
+ PUSH P,T ;SAVE FOR A WHILE
+ MOVE T,C ;THE VALUE
+ MOVEI C,1 ;MARK AS VALUE
+ PUSHJ P,SYM3X2
+ HRRZ C,POLPNT ;POINTER TO VALUE
+ POP P,T ;RETRIEVE THE OTHER VALUE
+TLHG: SKIPE SVSAT ;WAS THIS A UNARY OPERATOR
+ TLNE A,-1 ;WAS THERE A GLOBAL IN LEFT HALF
+ JRST GLSET
+ PUSH P,C
+ MOVEI C,1 ;SEE ABOVE
+ PUSHJ P,SYM3X2
+ HRRZ T,POLPNT ;POINTER TO VALUE
+ POP P,C
+
+GLSET: EXCH C,B ;OPERATOR INTO RIGHT AC
+ SKIPE SVSAT ;SKIP ON UNARY OPERATOR
+ HRL B,T ;SECOND,,FIRST
+ MOVE T,B ;SET UP FOR CALL TO SYM3X2
+ PUSHJ P,SYM3X2
+ MOVEI A,400000 ;SET UP AS A GLOBAL VALUE
+ HRRZ C,POLPNT ;POINTER TO "VALUE"
+ JRST SETSAT ;AND SET UP FOR NEXT OPERATOR
+\f;FINALLY WE GET TO STORE THIS MESS
+
+STOROP: MOVE B,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR
+ CAIE B,15 ;IS IT
+ JRST LOAD4A ;NO, ILL FORMAT
+ HRRZ B,(D) ;GET THE VALUE TYPE
+ JUMPN B,GLSTR ;AND TREAT GLOBALS SPECIAL
+ MOVE A,T ;THE TYPE OF STORE OPERATOR
+ CAIGE A,-3
+ PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP, MUST WORK HARDER
+ PUSHJ P,RDHLF ;GET THE ADDRESS
+ MOVE B,T ;SET UP FOR FIXUPS
+ POP D,T ;GET THE VALUE
+ POP D,T ;AFTER IGNORING THE FLAG
+ PUSHJ P,@STRTAB+6(A) ;CALL THE CORRECT FIXUP ROUTINE
+
+COMSTR: SETZM POLSW ;ALL DONE WITH POLISH
+ MOVE B,HEADNM
+ CAILE B,477777
+ JRST COMPOL ;TOO BIG, GIVE ERROR
+ PUSHJ P,RWORD ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
+ JRST LOAD4A ;IF NOT, SOMETHING IS WRONG
+
+GLSTR: MOVE A,T
+ CAIGE A,-3
+ JRST 4,. ;PUSHJ P,FSYMT ;SYMBOL TABLE FIXUP
+ PUSHJ P,RDHLF ;GET THE STORE LOCATION
+ SUB D,[2,,2] ;VALUE AND MARKER ON STACK MEANINGLESS
+ MOVE C,A ;STORE OP
+ PUSHJ P,SYM3X2 ;STORE LOC ALREADY IN T
+ AOS T,GLBCNT ;WE STARTED AT -1 REMEMBER?
+ HRRZ C,HEADNM ;GET HEADER #
+ TLO C,440000 ;MARK FIXUP AS GLOBAL BEASTIE
+ PUSHJ P,SYM3X2 ;LAST OF POLISH FIXUP
+ HRRZ T,POLPNT ;POINTER TO POLISH BODY
+ MOVE A,C ;FIXUP NAME
+ PUSHJ P,ENT
+GLSTR1: SOSGE GLBCNT ;MUST PUT GLOBAL REQUESTS IN TABLE
+ JRST COMSTR ;AND FINISH
+ POP P,T ;SQUOOZE
+ PUSHJ P,LKUP
+ MOVE A,HEADNM ;SETUP REQUEST WORD
+ TLO A,POLREQ ;MARK AS POLISH REQUEST
+ JUMPGE D,GLSTR2 ;JUMP IF NOT SEEN
+ PUSHJ P,DOWN
+ MOVEM A,(D)
+ JRST GLSTR1
+
+GLSTR2: EXCH A,T ;NOT PREVIOUSLY SEEN ENTER FULL REQUEST
+ TLO A,400000 ;MARK AS NEW TABLE ENTRY
+ PUSHJ P,DEF2A
+ JRST GLSTR1
+\fSTRTAB: ALSYM ;-6 FULL SYMBOL TABLE FIXUP
+ LFSYM ;-5 LEFT HALF SYMBOL FIX
+ RHSYM ;-4 RIGHT HALF SYMBOL FIX
+ UNTHF ;-3 FULL WORD FIXUP
+ UNTHL ;-2 LEFT HALF WORD FIXUP
+ UNTHR ;-1 RIGHT HALF WIRD FIXUP
+ CPOPJ ;0
+
+DESTB: 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 0
+ 0
+ 100
+
+OPTAB: ADD T,C
+ SUB T,C
+ IMUL T,C
+ IDIV T,C
+ AND T,C
+ IOR T,C
+ LSH T,(C)
+ XOR T,C
+ SETCM T,C
+ MOVN T,C
+
+;HERE TO LOOK UP LOCAL IN SYMBOL TABLE
+
+FSYMT: PUSHJ P,FSYMT1 ;BLOCK NAME
+ MOVE B,C ;SAVE SYMBOL
+ PUSHJ P,FSYMT1 ;SYMBOL NAME
+ EXCH B,C ;BLOCK NAME IN B, SYMBOL NAME IN C
+FSYMT2: PUSH P,A ;SAVE IT
+ MOVE T,DDPTR ;AOBJN POINTER TO LOCALS
+SLCL: MOVE A,(T) ;SQUOZE
+ TLZN A,740000 ;CLEAR FLAGS FOR COMPARE
+ JRST SLCL3 ;BLOCK NAME
+ CAMN A,C ;IS THIS THE SYMBOL WE SEEK
+ JRST SLCL1 ;YES, WE MUST STILL VERIFY THE BLOCK
+SLCL4: ADD T,[1,,1] ;NO KEEP LOOKING
+ AOBJN T,SLCL
+ JRST 4,. ;SYMBOL NOT FOUND
+
+SLCL1: JUMPE B,POPAJ1 ;SYMBOL IS IN THIS BLOCK
+ PUSH P,T ;THIS POINTER POSSIBLY A WINNER
+ ADD T,[2,,2] ;NEXT SYMBOL
+ JUMPGE T,[JRST 4,.] ;WE HAVE RUN OUT OF TABLE
+ MOVE A,(T) ;SQUOZE
+ TLNE A,740000 ;SKIP ON BLOCK NAME
+ JRST .-4
+
+; HERE WHEN WE FIND BLOCK NAME
+
+ CAME A,B ;DOES THE BLOCK NAME MATCH
+ JRST SLCL2 ;NO KEEP LOOKING
+ POP P,T ;WINNING SYMBOL TABLE ENTRY
+POPAJ1: POP P,A ;RESTORE A
+ AOS (P) ;SKIP THE PUSHJ P,RDHLF THAT FOLLOWS THIS CALL
+ POPJ P,
+
+SLCL3: JUMPN B,SLCL4
+ JRST 4,. ;SYMBOL SHOULD BE IN THIS BLOCK
+
+SLCL2: SUB P,[1,,1] ;FLUSH THE LOSING SYMBOL POINTER
+ JRST SLCL
+
+FSYMT1: PUSHJ P,RDHLF
+ HRL C,T
+ PUSHJ P,RDHLF
+ HRR C,T
+ JRST SQZCON
+\f;HERE TO SATISFY GLOBAL REQUEST FOR POLISH
+
+POLSAT: PUSH P,D ;POINTER TO CURRENTLY PROCESSED GLOBAL REQUEST
+ HRRZ T,B ;LOOK UP POLISH TO BE FIXED
+ TLO T,440000
+ PUSHJ P,LKUP
+ JUMPGE D,[JRST 4,.] ;CANNOT FIND POLISH
+ MOVE T,CGLOB ;SQUOOZE (SET UP AT DFSYM2)
+ MOVE B,1(D) ;COUNT
+ MOVE B,(B) ;STORE OP
+ MOVE B,(B) ;FIRST TOKEN
+ PUSHJ P,FIXPOL
+ MOVE B,1(D)
+ SOSG 1(B) ;UPDATE UNDEFINED GLOBAL COUNT
+ JRST PALSAT ;COUNTED OUT FINISH THIS FIXUP
+POLRET: MOVE A,CGLOB
+ POP P,D
+ JRST PATCH1
+
+;HERE TO FIXUP A SINGLE GLOBAL REQUEST IN POLISH
+
+FIXPOL: HLRZ A,(B) ;TOKEN TYPE
+ JUMPN A,FXP1 ;JUMP IF NOT SQUOZE
+ CAME T,1(B)
+ JRST FXP1 ;SQUOOZE DOES NOT MATCH
+ HRRI A,1 ;MARK AS VALUE
+ MOVE T,T1 ;VALUE
+ HRLM A,(B) ;NEW TOKEN TYPE
+ MOVEM T,1(B) ;NEW VALUE
+ POPJ P,
+
+FXP1: HRRZ B,(B) ;POINTER TO NEXT TOKEN
+ JUMPN B,FIXPOL
+ JRST 4,. ;DID NOT FIND SYMBOL
+\f;HERE TO FINISH THE POLISH AFTER ALL REQUESTS ARE SATISFIED
+
+PALSAT: AOS SATED ;NUMBER OF FIXUPS SATISFIED
+ PUSH P,(D) ;SAVE THE NAME OF THIS FIXUP FOR LATER DELETION
+ MOVE A,1(D) ;POINTS TO COUNT
+ MOVE A,(A) ;STORE OP
+ MOVE D,PPDP
+ HLLZ B,(A) ;STORE OP
+ HRRZ T,1(A) ;PLACE TO STORE
+ PUSH D,B ;STORE OP
+ PUSH D,T ;STORE ADDRESS
+ MOVEI T,-1(D) ;POINTER TO STORE OP
+ PUSH D,T
+ MOVE A,(A) ;POINTS TO FIRST TOKEN
+
+PSAT1: HLRE B,(A) ;OPERATOR
+ JUMPL B,ENDPOL ;FOUND STORE OP
+ CAIGE B,15
+ CAIGE B,3
+ JRST 4,. ;NOT OPERATOR
+ MOVE T,1(A) ;OPERANDS (SECOND,,FIRST)
+ HLRZ C,(T) ;FIRST OPERAND
+ JUMPE C,[JRST 4,.] ;SQUOZE NEVER DEFINED
+ CAIE C,1 ;SKIP IF DEFINED
+ JRST PSDOWN ;GO DOWN A LEVEL IN TREE
+ SKIPN DESTB-3(B)
+ JRST PSAT2 ;IF UNARY OP WE ARE DONE
+ MOVSS T
+ HLRZ C,(T) ;SECOND OPERAND
+ JUMPE C,[JRST 4,.]
+ CAIE C,1
+ JRST PSDOWN
+ MOVSS T
+
+;HERE TO PERFORM OPERATION
+
+PSAT2: MOVE C,1(T) ;VALUE FIRST OPERAND
+ MOVSS T
+ SKIPE DESTB-3(B)
+ MOVE T,1(T) ;GET SECOND OPERAND ONLY IF NECESSARY
+ XCT OPTAB-3(B) ;WOW!
+ MOVEM T,1(A) ;NEW VALUE
+ MOVEI C,1
+ HRLM C,(A) ;MARK AS VALUE
+ POP D,A ;GO UP A LEVEL IN TREE
+ JRST PSAT1
+
+;HERE TO GO DOWN LEVEL IN TREE
+
+PSDOWN: PUSH D,A ;SAVE THE OLD NODE
+ HRRZ A,T ;NEW NODE
+ JRST PSAT1
+\f;HERE TO END PROCESSING OF POLISH IN SYMBOL TABLE (VALUE IN T)
+
+ENDPOL: POP D,B ;STORE ADDRESS
+ MOVS A,(D) ;STORE OP
+ PUSHJ P,@STRTAB+6(A)
+ POP P,D ;NAME OF THIS FIXUP
+ EXCH P,SATPDP ;SAVE THIS NAME FOR LATER DELETION FROM TABLE
+ PUSH P,D
+ EXCH P,SATPDP
+ JRST POLRET
+
+; HERE TO DO SYMBOL TABLE FIXUPS
+; T/ VALUE
+; B/ SYMBOL TABLE POINTER
+
+RHSYM: HRRM T,1(B) ;RIGHT HALF FIX
+ POPJ P,
+
+LFSYM: HRLM T,1(B) ;LEFT HALF FIX
+ POPJ P,
+
+ALSYM: MOVEM T,1(B) ;FULL WORD FIX
+ POPJ P,
+
+
+;HERE TO REMOVE POLISH FIXUPS FROM SYMBOL TABLE
+
+UNSATE: PUSH P,T2
+ MOVE A,[-SATPDL,,SATPDB-1]
+ EXCH A,SATPDP ;SET UP PUSH DOWN POINTER
+ MOVE B,SATED ;# FIXUPS TO BE DELETED
+ SETZM SATED
+ CAILE B,SATPDP ;LIST LONG ENOUGH?
+ JRST 4,. ;TIME TO REASSEMBLE
+UNSAT1: SOJL B,UNSAT3
+ POP A,T ;FIXUP
+ PUSH P,A
+ PUSH P,B
+ PUSHJ P,LKUP ;LOOK IT UP
+ HRRZM D,T2
+UNSAT2: PUSHJ P,PATCH ;REMOVE IT FROM TABLE
+ POP P,B
+ POP P,A
+ JRST UNSAT1
+
+UNSAT3: POP P,T2 ;POINTS TO TABLE ENTRY
+ MOVE T,T1 ;SYMBOL VALUE
+ MOVE A,CGLOB ;SQUOOZE
+ POPJ P,
+\f; HERE TO HANDLE LINKS (BLOCK TYPE 23)
+
+LINK: SETOM LINKDB ;LINKS BEING HACKED
+ PUSHJ P,GETBIT ;RELOCATION BITS INTO TT
+ PUSHJ P,RRELOC ;LINK #
+ MOVE A,T
+ JUMPE A,LOAD4A ;ILLEGAL LINK #
+ PUSHJ P,GETBIT
+ PUSHJ P,RRELOC ;STORE ADDRESS
+ HRRZ B,T
+ JUMPL A,LNKEND ;JUMP ON LINK END
+ CAILE A,MNLNKS
+ JRST LOAD4A ;ILLEGAL LINK #
+
+ HRRZ C,LINKDB(A) ;LINK VALUE
+ PUSH P,B
+ PUSHJ P,MAPB
+ HRRM C,(B) ;VALUE INTO STORE ADDRESS
+ POP P,B
+ HRRM B,LINKDB(A) ;NEW VALUE
+ JRST LINK
+
+;END LINK
+
+LNKEND: MOVNS A ;LINK #
+ CAILE A,MNLNKS
+ JRST LOAD4A ;ILLEGAL LINK #
+ HRLM B,LINKDB(A) ;LINK END ADDRESS
+ JRST LINK
+
+;HERE AFTER ALL LOADING TO CLEAN UP LINKS
+
+LNKFIN: PUSH P,A
+ PUSH P,B
+ MOVEI A,MNLNKS
+
+LNKF1: MOVS B,LINKDB(A) ;VALUE,,STORE ADDRESS
+ TRNN B,-1 ;DON'T STORE FOR ZERO STORE ADDRESS
+ JRST .+3
+ PUSHJ P,MAPB
+ HLRM B,(B)
+ SOJG A,LNKF1
+ JRST POPBAJ
+\f;HERE TO HALF KILL LOCAL SYMBOLS DEFINED BY LOADER
+
+HLFKIL: MOVE D,DDPTR ;RESTORE POINTER TO LOCAL TABLE
+ ADD D,[2,,2] ;BUMP IT
+NXTKIL: MOVE B,D ;PUT POINTER ALSO IN B
+ PUSHJ P,RPB ;GET A WORD
+ TLZ T,740000 ;MAKE SURE NO FLAGS
+NXTSYK: MOVE A,(B) ;GET A SYMBOL
+ TLZN A,740000 ;IF PROG NAME HIT, TIME TO QUIT
+ JRST NXTKIL
+ CAME T,A ;IS THIS ONE
+ JRST NOKIL ;NO TRY AGAIN
+ TLO A,400000 ;TURN ON HALF KILL BIT IN DDT
+ IORM A,(B) ;RESTORE SYMBOL TO TABLE
+ JRST NXTKIL
+
+NOKIL: AOBJN B,.+1
+ AOBJN B,NXTSYK ;TRY ANOTHER
+ JRST NXTKIL ;TRY ANOTHER ONE
+
+
+
+\f
+PRGN: PUSHJ P,RPB
+ MOVE A,T
+ MOVEM A,PRGNAM
+ TLZE FF,NAME
+ PUSHJ P,SETJNM
+ MOVE T,FACTOR
+ HRL T,ADR
+ TLNE A,40000
+ PUSHJ P,PRGEND ;REAL PRGM END
+ TLO A,740000
+ PUSHJ P,ENT
+ PUSHJ P,SYMS
+ MOVE A,(BOT) ; GET CURRENT PRG NAME
+NODMCG, MOVSI T,1 ; WANT NON-ZERO, BUT POSITIVE LEFT HALF
+DMCG, MOVE T,1(BOT) ; POINTS TO TOP AND BOTTOM OF PROGRAM
+ TLZ A,740000 ; MARK AS PROGNAME
+ SKIPL SYMSW
+ PUSHJ P,ADDDDT ; TO DDT TABLE
+ SKIPL SYMSW
+ PUSHJ P,SHUFLE ;PUT THE SYMBOLS IN THE RIGHT ORDER
+ HLLZS LKUP3
+ PUSHJ P,RESETT
+ JRST OMIT
+
+PRGEND: HRRZM ADR,FACTOR
+ SETZM LFTFIX
+ POPJ P,
+
+
+;WE DO ALL OF THE FOLLOWING HACKING TO INSURE THAT THE
+;THE SYMBOLS ARE GIVEN TO DDT IN EXACTLY THE SAME ORDER
+;THAT THE TRANSLATOR GAVE THEM TO STINK
+
+SHUFLE: MOVE B,DDPTR
+ ADD B,[2,,2] ;IGNORE THIS PROGRAM NAME
+ JUMPGE B,CPOPJ ;NO LOCALS IN DDT'S TABLE
+
+SHUF1: MOVE A,(B) ;SQUOOZE
+ TLNN A,740000
+ JRST SHUF2 ;FOUND A BLOCK NAME
+SHUF3: ADD B,[1,,1]
+ AOBJN B,SHUF1
+
+SHUF4: HRRZ A,DDPTR ;EXTENT OF THE SYMBOLS IS KNOWN
+ ;A/POINTER TO BOTTOM SYMBOLS
+ ;B/POINTER TO TOP OF SYMBOLS
+SHUF5: ADDI A,2 ;SYMBOL AT BOTTOM
+ HRRZI B,-2(B) ;SYMBOL AT TOP
+ CAMG B,A
+ POPJ P, ;WE HAVE MET THE ENEMY AND THEY IS US!
+
+ MOVE C,(A) ;SWAP THESE TWO ENTRIES
+ EXCH C,(B)
+ MOVEM C,(A)
+
+ MOVE C,1(A) ;VALUE
+ EXCH C,1(B)
+ MOVEM C,1(A)
+ JRST SHUF5
+
+;HERE WHEN WE FIND A BLOCK NAME
+
+SHUF2: MOVE A,1(B) ;VALUE
+ TLNE A,-1 ;PROGRAM NAME?
+ JRST SHUF4 ;YES
+ JRST SHUF3 ;IGNORE BLOCK NAME
+\f
+GTWD: PUSHJ P,RDWRD ;GOBBLE A WORD FROM THE BUFFER
+ JFCL 4,.+1
+ ADD CKS,T
+ JFCL 4,[AOJA CKS,.+1]
+RELADR: POPJ P,
+
+GETBIT: ILDB TT,BITPTR
+ SKIPL BITPTR
+ POPJ P,
+ EXCH T,BITS
+ SOS BITPTR
+ PUSHJ P,RPB
+ EXCH T,BITS
+ LDB TT,BITPTR
+ POPJ P,
+
+;SUBROUTINE TO GET A WORD FROM BUFFER (GETS NEW ONE IF NEC.)
+
+RDWRD: PUSH P,TT ;SAVE TT
+ MOVE TT,INPTR ;GOBBLE POINTER
+ MOVE T,(TT) ;GOBBLE DATUM
+ AOBJN TT,RDRET ;BUFFER EMPTY?
+DOREAD: MOVE TT,[-STNBLN,,STNBUF] ;YES, READ A NEW ONE
+IFN ITS, .IOT TPCHN,TT ;GOBBLE IT
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+
+ MOVE 2,TT
+ HLRE 3,TT
+ HRLI 2,444400
+ MOVE 1,IJFN
+ SIN
+ SKIPE 3
+ CLOSF
+ JFCL
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+]
+ MOVE TT,[-STNBLN,,STNBUF] ;RE GOOBBLE
+RDRET: MOVEM TT,INPTR ;SAVE IT
+ POP P,TT
+ POPJ P,
+
+;HERE TO START FIRST READ
+
+RDFRST: PUSH P,TT
+ JRST DOREAD ;READ A NEW BUFFER
+
+RCKS: (3000+SIXBIT /CKS/)
+\f
+;LOADER INTERFACE
+
+TYPR: 0
+ PUSH P,C
+ PUSH P,T
+ PUSH P,TT
+ LDB C,[(330300)40]
+ MOVEI TT,LI3
+ TRON C,4
+ HRRM TT,TYPR
+ ORCMI C,7
+ HRLZ TT,40
+TYPR2: PUSHJ P,SIXTYO
+ AOJE C,TYPR1
+ PUSHJ P,SPC
+ HRRZ T,ADR
+ PUSHJ P,OPT
+ AOJE C,TYPR1
+ PUSHJ P,SPC
+ PUSHJ P,ASPT
+TYPR1: PUSHJ P,CRL
+ POP P,TT
+ POP P,T
+ POP P,C
+ JRST 2,@TYPR
+
+ASPT: MOVE T,A
+SPT: TLNN T,40000
+ TRO FF,LOCF
+SPT2: TLZ T,740000
+SPT1: IDIVI T,50
+ HRLM TT,(P)
+ JUMPE T,SPT3
+ PUSHJ P,SPT1
+SPT3: TRZE FF,LOCF
+ PUSH P,["*-"0+1,,.+1]
+ HLRE T,(P)
+ ADDI T,"0-1
+ CAILE T,"9
+ ADDI T,"A-"9-1
+ CAILE T,"Z
+ SUBI T,"Z-"#+1
+ CAIN T,"#
+ MOVEI T,".
+ CAIN T,"/
+SPC: MOVEI T,40
+SPTY: JRST TYO
+
+
+;0 1-12 13-44 45 46 47
+;NULL 0-9 A-Z . $ %
+\f
+LI4: CAMN A,[(10700)CBUF-1]
+ JRST LI3
+ LDB T,A
+ ADD A,[(70000)]
+ SKIPGE A
+ SUB A,[(430000)1]
+IFN ITS, .IOT TYOC,T
+IFE ITS,[
+IFN T-1,[
+ MOVEM 1,JSYS1
+ MOVE 1,T
+]
+ PBOUT
+IFN T-1, MOVE 1,JSYS1
+]
+ JRST LI1
+
+TYI:
+IFN ITS, .IOT TYIC,T
+IFE ITS,[
+IFN T-1,[
+ MOVEM 1,JSYS1
+]
+ PBIN
+IFN T-1,[
+ MOVE T,1
+ MOVE 1,JSYS1
+]
+]
+ CAIE T,15
+ CAIN T,12
+ JRST TYO
+ CAIN T,^R
+ JRST TYO
+ POPJ P,
+
+LIS: ANDI FF,GETTY
+LI3: MOVE A,[(10700)CBUF-1]
+ MOVEM A,CPTR
+ MOVE P,[(,-LPDL)PDL-1]
+ PUSHJ P,CRLS
+ TRZ FF,LOCF
+LI1: TRZ FF,ALTF
+LI2: PUSHJ P,TYI
+ CAIN T,33
+ MOVEI T,"\e
+ CAIN T,7
+ JRST LI3
+ CAIN T,177 ;RUBOUT
+ JRST LI4
+ IDPB T,A
+ CAMN A,[(10700)CBUF+CBUFL]
+ JRST LI4
+
+\f
+LIS1: CAIE T,"\e
+ JRST LI1
+ TRON FF,ALTF
+ JRST LI2
+ PUSHJ P,CRL
+CD: MOVEI D,0
+CD3: TRZ FF,ARG
+CD2: ILDB T,CPTR
+ CAIL T,"0
+ CAILE T,"9
+ JRST CD1
+ LSH D,3
+ ADDI D,-"0(T)
+VALRET: TRO FF,ARG
+ JRST CD2
+
+CD1: CAIE T,33
+ CAIN T,DOLL ;CHECK FOR A REAL DOLLAR SIGN
+ JRST LI3
+ CAIL T,"<
+ CAILE T,"[
+ JRST CD
+ IDIVI T,4
+ LDB T,DTAB(TT)
+ MOVEI A,SLIS(T) ;WHERE TO?
+ CAIE A,DUMPY ;IS IT A DUMP
+ TRZ FF,MLAST+SETDEV ;NO, KILL FUNNY FLAGS
+ CAIE A,HASHS ; HASH SET?
+ PUSHJ P,HASHS1 ; MAYBE DO IT
+ PUSHJ P,SLIS(T)
+ JRST CD
+ JRST VALRET
+
+
+\f
+SLIS: TDZA C,C
+MLIS: MOVEI C,2
+ TRNE FF,GETTY
+ PUSHJ P,FORMF
+ TRNE FF,ARG
+ JUMPL D,LISTER
+ MOVE D,BOT
+ JRST LISTER
+
+LISTER: MOVE A,(D)
+ LDB TT,[(410300)A]
+ ORCMI TT,7 ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
+ AOJN TT,LIST2 ; NOT PROG NAME
+LIST4: PUSHJ P,ASPT
+LIST5: PUSHJ P,VALPT
+ JRST LIST6
+
+LIST2: XOR TT,C ; TT/ -1 IF S AND DEF, OR ? AND UNDEF
+ AOJE TT,LIST7 ; PRINT VALUES
+LIST6: HRRZ D,LIST(D) ; NEXT SYMBOL
+ JUMPN D,LISTER ; MORE, GO ON
+ JRST CRL ; DONE
+
+LIST7: PUSHJ P,SPC ; PRINT UNDEFINED SYMBOL
+ PUSHJ P,ASPT ; PRINT SYMBOL
+ PUSH P,D
+ TRNE FF,ARG ; SKIP IF 1?
+ JUMPN C,LIST9 ; JUMP IF ?
+ PUSHJ P,VALPT
+ JRST LIST8
+LIST9: MOVE D,1(D) ; POINT TO CHAIN
+ PUSHJ P,VALPT
+ HRRZ D,(D)
+ JUMPN D,.-2
+LIST8: POP P,D
+ JRST LIST6
+
+VALPT: PUSHJ P,TAB
+ HRRZ T,1(D) ; SMALL VAL
+ TRNN FF,ARG ; ARG GIVEN?
+ SKIPN C ; OR SS COMM
+ MOVE T,1(D) ; USE FULL WORD
+ JRST OPTCR ; PRINT
+\f
+; INITIALIZES ALL AREAS OF CORE
+
+HASHS: MOVE A,D ; SIZE TO A
+ TRNN FF,ARG ; SKI IF ARG GIVEN
+HASHS1: MOVEI A,INHASH ; USE INITIAL
+ SKIPE HBOT ; SKIP IF NOT DONE
+ POPJ P,
+ PUSH P,A ; NOW SAVEE IT
+ PUSH P,T
+ PUSH P,B
+
+ MOVEI B,LOSYM ; CURRENT TOP
+ ADDI A,LOSYM
+ CAIG A,<INITCR*2000> ; MORE CORE NEEDED?
+ JRST HASHS3 ; NO, OK
+ SUBI A,<INITCR*2000>+1777
+ ASH A,-10.
+HASHS2: PUSHJ P,CORRUP ; UP THE CORE
+ SOJN A,.-1 ; FOR ALL BLOCKS
+
+HASHS3: MOVEM B,HBOT ; STORE AS BOTTOM OF HASH TABLE
+ ADD B,-2(P) ; ADD LENGTH
+ MOVEM B,HTOP ; INTOTOP
+
+ ADDI B,1 ; BUMP
+ MOVEM B,PARBOT ; SAVE AS BOTTOM OF LOADER TABLE AREA
+ MOVEM B,PARCUR ; ALSO AS CURRENT PLACE
+
+ MOVE B,LOBLKS ; CURRENT TOP OF CORE
+ PUSHJ P,CORRUP
+ ASH B,10. ; WORDS
+ SUBI B,1
+ MOVEM B,PARTOP
+ ADDI B,1 ; NOW DDT TABLE
+ MOVEM B,DDBOT
+ ADDI B,1777
+ MOVEM B,DDPTR
+ MOVEM B,DDTOP ; TOP OF DDT TABLE
+ ADDI B,1
+ HRRM B,ADRPTR ; INTO CORE SLOTS
+ HRRM B,BPTR
+ HRRM B,DPTR
+
+ PUSHJ P,CORRUP ; INITIAL CCORE BLOCK
+
+ PUSHJ P,GETMEM
+
+; SET UP INIT SYMBOLS
+
+ MOVE C,[EISYM-EISYME,,EISYM]
+
+SYMINT: MOVE A,(C)
+ TLZ A,600000
+ MOVE B,HTOP
+ SUB B,HBOT
+ IDIVI A,(B) ; HASH IT
+ ADD B,HBOT
+ HRRZ A,(B) ; GET CONTENTS
+ HRROM C,(B)
+ HRRM A,BUCK(C)
+ HRLM B,BUCK(C)
+ SKIPE A
+ HRLM C,(A)
+ ADD C,[3,,3]
+ JUMPL C,SYMINT
+
+
+ POP P,B
+ POP P,T
+ POP P,A
+ POPJ P,
+
+CORRUP: PUSHJ P,GETCOR
+IFN ITS,[
+ PUSHJ P,SCE
+ SKIPE KEEP
+ PUSHJ P,WINP ; WE HAVE THE CORE, TELL LOSER
+]
+ JFCL
+ AOS NBLKS
+ AOS LOBLKS
+CCRL: POPJ P,CRL
+
+IFN ITS,TMSERR: JRST SCE
+\f
+
+EQLS: MOVE T,D
+OPTCR: PUSH P,CCRL
+OPT: MOVEI TT,10
+ HRRM TT,OPT1
+OPT2: LSHC T,-43
+ LSH TT,-1
+OPT1: DIVI T,10
+ HRLM TT,(P)
+ JUMPE T,.+2
+ PUSHJ P,OPT2
+ HLRZ T,(P)
+ ADDI T,260
+TYOM: JRST TYO
+
+TAB: PUSHJ P,SPC
+ PUSHJ P,TYO
+ JRST TYO
+
+CRLS: TRNE FF,GETTY
+ PUSH P,[CRLS1]
+CRL: MOVEI T,15
+ PUSHJ P,TYO
+CRT: SKIPA T,C.12
+FORMF1: MOVEI T,"C
+TYO: IFN ITS, .IOT TYOC,T
+IFE ITS,[
+IFN T-1,[
+ MOVEM 1,JSYS1
+ MOVE 1,T
+]
+ PBOUT
+IFN T-1, MOVE 1,JSYS1
+]
+C.12: POPJ P,12
+
+CRLS1: MOVEI T,"*
+ JRST TYO
+
+FORMF: POPJ P,12
+\f
+TDDT: SKIPE LINKDB ;TEST FOR LINK HACKAGE
+ PUSHJ P,LNKFIN ;CLEAN UP LINKS
+ PUSH P,[TDDTEX] ;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE.
+ HRRZ D,BOT
+ TRO FF,GLOSYM
+
+SYMS: JUMPE D,SYMS5 ; DONE, QUIT
+ MOVE A,(D) ; GET SYMBOL
+ TLNN A,200000 ; SKIP IF DEFINED
+ JRST SYMS6
+ TLNE A,40000 ; SKIP IF LOCAL
+ TRNE FF,GLOSYM ; SKIP IF GLOBALS NOT ACCEPTABLE
+ TLNE A,100000 ; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME
+ JRST SYMS6 ; LOSER, OMIT
+ TRNN FF,GLOSYM ; SKIP IF GLOBAL
+ SKIPL SYMSW ; SKIP IF NO LOCALS
+ JRST SYMS3 ; WINNER!!!, MOVE IT OUT
+
+SYMS8: HRRZ A,LIST(D) ; POINT TO NEXT
+ PUSH P,A ; AND SAVE
+ MOVEM D,T2 ; SAVE FOR PATCH
+ PUSHJ P,PATCH ; FLUSH FROM TABLE
+ POP P,D ; POINT TO NEXT
+ JRST SYMS
+
+SYMS6: HRRZ D,LIST(D) ; POINT TO NEXT SYMBOL
+ JRST SYMS ; AND CONTINUE
+
+SYMS3: TRZ FF,NOTNUM ;ASSUME ALL NUMERIC
+ TLZ A,740000
+ MOVE T,A ;SEE IF IT IS A FUNNY SYMBOL
+ IDIVI T,50 ;GET LAST CHAR IN TT
+ JUMPE TT,OKSYM
+DIVSYM: CAIG TT,12 ;IS THE SYMBOL > 9
+ CAIGE TT,1 ;AND LESS THAN OR EQUAL TO 0
+ TRO FF,NOTNUM ;NO, SAY NOT A NUMBER
+ IDIVI T,50 ;CHECK NEXT
+ JUMPE TT,SYMS8 ;NULL IN THE MIDDLE LOSES
+ JUMPN T,DIVSYM ;DIVIDE UNTIL T IS 0
+ CAIN TT,21 ;IS THIS A "G"
+ TRNE FF,NOTNUM ;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT
+ JRST OKSYM ;WIN
+ JRST SYMS8 ;LOSE
+OKSYM: MOVE T,1(D)
+ HRRZ C,LIST(D) ; POINT TO NEXT
+ PUSH P,C
+ MOVEM D,T2
+ PUSHJ P,PATCH ; FLUSH IT
+ POP P,D
+ TLO A,40000
+ TRNN FF,GLOSYM
+ TLC A,140000 ;DDT LOCAL
+ TLNN A,37777 ;IF SQUOZE "NAME" < 1000000,
+ PUSHJ P,ADDDD2 ;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX)
+ TLNE A,37777
+ PUSHJ P,ADDDDT
+ JRST SYMS
+
+SYMS5: POPJ P,
+\fGO: TRNE FF,ARG
+ MOVEM D,SA
+ TRO FF,GOF
+ JRST DDT
+
+EXAM: CAMLE D,MEMTOP
+ JRST TRYHI ; COULD BE IN HIGH SEG
+ MOVE T,@DPTR
+ JRST OPTCR
+
+TRYHI: TRNE D,400000 ; SKIP IF NOT HIGH
+ CAMLE D,HIGTOP ; SKIP IF OK
+ (3000+SIXBIT /NEM/)
+ MOVE T,(D) ; GET CONTENTS
+ JRST OPTCR
+
+C.CD2: POPJ P,CD2
+
+GETCOM: MOVE A,[10700,,CBUF-1]
+ MOVEM A,CPTR
+ MOVE P,[(,-LPDL)PDL-1]
+ PUSH P,C.CD2
+ MOVEM P,SAVPDL
+IFN ITS,[
+ MOVEI T,0 ;REOPEN CHANNEL IN ASCII MODE
+ HLLM T,DEV
+ .OPEN TPCHN,DEV ;RE OPEN
+ JRST FNF2 ;LOSE
+]
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+ MOVSI 1,100001
+ HRROI 2,FILSTR
+ GTJFN
+ JRST .+3
+ MOVE 2,[070000,,200000]
+ OPENF
+ MOVEI 1,0
+ MOVEM 1,IJFN
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+ SKIPN IJFN
+ JRST FNF
+]
+GTCM1:
+IFN ITS, .IOT TPCHN,T
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+
+ MOVE 1,IJFN
+ MOVE 2,[070700,,T]
+ MOVNI 3,1
+ SIN
+
+ SKIPGE 3
+ MOVNI T,1
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+]
+ JUMPL T,FIXOPN ;JUMP IF EOF
+ CAIN T,3 ;CHECK FOR EOF
+ JRST FIXOPN ;IF SO QUIT
+ CAIL T,"a
+ CAILE T,"z
+ CAIA
+ SUBI T,40
+ IDPB T,A ;DEPOSIT CHARACTER
+ CAME A,[10700,,CBUF+CBUFL]
+ JRST GTCM1
+TPOK: SKIPA T,BELL
+ERR: MOVE T,"?
+IFN ITS, .IOT TYOC,T
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVE 1,T
+ PBOUT
+ MOVE 1,JSYS1
+]
+ PUSHJ P,FIXOPN ;FIX UP OPEN CODE
+ JRST LI3
+
+;HERE TO RESET OPEN
+
+FIXOPN: MOVEI T,6
+ HRLM T,DEV
+ POPJ P,
+
+FNF2: PUSHJ P,FIXOPN
+ JRST FNF
+
+\f
+PAPER: MOVEI A,(SIXBIT /PTR/)
+ HRRM A,DEV
+ POPJ P, ;REAL OPEN WILL OCCUR LATER
+
+UTAP: TRZN FF,ARG
+ JRST OPNTP
+ TRO FF,SETDEV ;SETTING DEVICE
+ MOVE A,DEVTBL(D)
+ HRRM A,DEV
+OPNTP: TRO FF,MLAST ;SET M LAST COMMAND
+ PUSHJ P,FRD
+IFN ITS, .SUSET [.SSNAM,,SNAME]
+ MOVEM B,NM1
+ MOVEM C,NM2
+ POPJ P, ;REAL OPEN WILL OCCUR LATER
+
+OPNPTR:
+IFN ITS,[
+ .OPEN TPCHN,DEV
+ JRST FNF
+ JRST RDFRST ;STAART UP THE READ ING
+]
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+ MOVSI 1,100001
+ HRROI 2,FILSTR
+ GTJFN
+ JRST .+3
+
+ MOVE 2,[440000,,200000]
+ OPENF
+ MOVEI 1,0
+ MOVEM 1,IJFN
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+ SKIPN IJFN
+ JRST FNF
+ JRST RDFRST
+]
+NTS: (3000+SIXBIT /NTS/)
+
+DEV: 6,,(SIXBIT /DSK/)
+NM1: SIXBIT /BIN/
+NM2: SIXBIT /BIN/
+0
+SNAME: 0 ;SYSTEM NAME
+JSYS1: 0
+JSYS2: 0
+JSYS3: 0
+IJFN: 0
+OUTJFN: 0
+
+SIXTYO: JUMPE TT,CPOPJ
+ MOVEI T,0
+ LSHC T,6
+ ADDI T,40
+ PUSHJ P,TYO
+ JRST SIXTYO
+
+JOB: PUSHJ P,FRD
+ MOVEM B,JOBNAM
+ TRO FF,JBN
+ POPJ P,
+
+JOBNAM: 0
+
+
+DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
+ (SIXBIT /DEV/)
+ TERMIN
+
+FNF: PUSHJ P,TYPFIL
+ REPEAT 2,PUSHJ P,SPC
+IFN ITS,[
+ .OPEN ERCHN,ERRBL ;OPEN ERROR DEVICE
+ JRST .-1 ;DON'T TAKE NO FOR AN ANSWER
+
+ERLP: .IOT ERCHN,A ;READ A CHAR
+ CAIE A,14 ;IF FORM FEED
+ CAIN A,3 ;OR ^C
+ JRST ERDON ;STOP
+
+ .IOT TYOC,A ;PRINT
+ JRST ERLP
+
+ERDON: .CLOSE ERCHN,
+]
+
+ JRST LI3
+
+
+ERRBL: (SIXBIT /ERR/) ;ERROR DEVICE
+ 2
+ TPCHN
+
+
+TYPFIL:
+IFN ITS,[
+ MOVSI A,-4
+ HRLZ TT,DEV
+ JRST .+3
+TYPF2: SKIPN TT,DEV(A)
+ AOJA A,.-1
+ PUSHJ P,SIXTYO
+ MOVE T,TYPFTB(A)
+ PUSHJ P,TYO
+ AOBJN A,TYPF2
+ POPJ P,
+
+TYPFTB: ":
+ 40
+ 40
+ 0
+ ";
+]
+IFE ITS,[
+ MOVE A,[440700,,FILSTR]
+
+ ILDB T,A
+ JUMPE T,.+3
+ PUSHJ P,TYO
+ JRST .-3
+ POPJ P,
+]
+
+
+
+\f
+LOADN: SKIPA C,SYMFLG
+LOADG: MOVEI C,DDSYMS
+ PUSHJ P,OPNPTR ;DO THE REAL OPEN (AND FIRST READ)
+
+ MOVEM C,SYMSW
+
+RESTAR: MOVEM P,SAVPDL
+ CLEARB CKS,TC
+ CLEARB RH,AWORD
+ PUSH P,CJMP1
+RESETT: MOVEI A,FACTOR ;LEAVE GLOBAL LOCATION MODE
+ HRRM A,REL
+ TRZA FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND
+SFACT: MOVEM D,FACTOR
+CJMP1: POPJ P,JMP1
+
+KILL: POPJ P,
+COMVAL: SKIPA COMLOC
+SADR: HRRZ D,SA
+POPJ1: AOSA (P)
+COMSET: MOVEM D,COMLOC
+BELL: POPJ P,7
+
+LBRAK: MOVEM D,T1
+ TRZ FF,LOSE
+ PUSHJ P,ISYM
+ MOVE T,T1
+ TRO FF,GPARAM
+ TRZE FF,ARG
+ JRST DFSYM2
+ TLNN B,200000
+ (3000+SIXBIT /UND/)
+ MOVE D,1(D)
+ TRZN FF,LOSE
+ JRST POPJ1
+ (2000+SIXBIT /UND/)
+
+SOFSET: HRRM D,LKUP3
+CPOPJ: POPJ P,
+\f
+
+BEG: MOVE D,FACTOR
+ JRST POPJ1
+
+DDT: SKIPN JOBNAM
+ JRST NJN
+ PUSHJ P,TDDT
+ MOVE A,JOBNAM
+ HRR B,BPTR
+ ADDI B,30
+ HRRM B,YPTR
+ HRLI B,440700
+ MOVEI D,^W
+ IDPB D,B
+ MOVE C,[(000600)A-1]
+ MOVEI T,6
+DDT2: ILDB D,C
+ JUMPE D,DDT1
+ ADDI D,40
+ IDPB D,B
+ SOJG T,DDT2
+\fDMCG,[
+DDT1: MOVEI C,[CONC69 ASCIZ \\e\eJ,\SA,[/\e9B!\eQ\r],\DDPTR,[/\eQ\e\19:VP \]]
+ HRLI C,440700
+DDT6: ILDB T,C
+ IDPB T,B
+ JUMPN T,DDT6 ;END OF STRING MARKED WITH ZERO BYTE
+ MOVE T,SA ;GET STARTING ADDRESS
+ TLNN T,777000 ;IF INSTRUCTION PART ZERO,
+ TLO T,(JRST) ;THEN TURN INTO JRST
+ MOVEM T,SA ;USE AS STARTING ADDRESS
+ TRNE FF,GOF ;IF G COMMAND,
+ MOVEM T,EXIT ;THEN USE AS LOADER EXIT
+ MOVE B,LOBLKS ;GET CURRENT CORE ALLOCATION+1
+ SUBI B,1(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
+ HRRM B,PALLOC ;SAVE IN EXIT ROUTINE
+ LSH B,10. ;SHIFT TO MEMORY LOCATION
+ SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
+ HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
+ HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
+ ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
+ MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER
+YPTR:
+IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING
+IFE ITS, HALTF
+ ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
+ BLT B,LEXEND ;BLT IN EXIT ROUTINE
+ BLT 17,17 ;BLT IN PROGRAM AC'S
+ EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
+IFN ITS,[
+ .CLOSE TYOC,
+ .CLOSE TYIC,
+ .CLOSE TPCHN,
+]
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVE 1,IJFN
+ CLOSF
+ JFCL
+ MOVE 1,JSYS1
+]
+ JRST LEXIT
+
+ ;EXIT ROUTINE FROM LOADER
+ ;BLT'ED INTO 30 - 30+N
+
+EXBLTP: .+1,,LEXIT ;BLT POINTER
+ OFST==30-. ;LEXIT=30
+LEXIT=.+OFST
+PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM
+ MOVE 17,SV17 ;GIVE USER HIS LOCATION 17
+PALLOC:
+IFN ITS, .CORE ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM
+IFE ITS, SKIPA
+PSV17: SV17=.+OFST
+ 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
+EXIT:
+IFN ITS, .VALUE LEXEND
+IFE ITS, HALTF
+LEXEND=.+OFST
+ 0 ;END OF EXIT ROUTINE
+];DMCG
+\fNODMCG,[
+DDT1: MOVE T,SA ;GET STARTING ADDRESS
+ TLNN T,777000 ;IF INSTRUCTION PART ZERO,
+ TLO T,(JRST) ;THEN TURN INTO JRST
+ MOVEM T,SA ;USE AS STARTING ADDRESS
+ TRNE FF,GOF ;IF G COMMAND,
+ MOVEM T,EXIT ;THEN USE AS LOADER EXIT
+ MOVEI T,DDT4 ;MAKE OPT GO TO DDT4
+ HRRM T,TYOM ;INSTEAD OF TYO
+ MOVEI C,[ASCIZ \\e\eJ\e9B/#0\r#1\e\19\eP\16\] ;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST
+ HRLI C,440700
+ PUSHJ P,DDTSG ;GENERATE REST OF STRING
+ MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION
+ SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
+ MOVE C,B ;SAVE OUR SIZE
+ LSH B,10. ;SHIFT TO MEMORY LOCATION
+ SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
+ HRRM B,PMEMT ;SAVE FOR MAIN PROGRAM BLT (DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
+ SUB C,LOWSIZ
+ MOVNM C,PALL0 ;NUMBER OF BLOCKS TO FLUSH
+ MOVE C,CWORD0
+ TRZ C,400000 ;DELETE PAGE
+ HRRZM C,PALL1
+ HRLZ 17,BPTR ;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
+ ADDM 17,PSV17 ;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
+ MOVE B,EXBLTP ;GET EXIT ROUTINE BLT POINTER
+YPTR:
+IFN ITS, .VALUE ;ADDRESS POINTS TO VALRET STRING
+IFE ITS, HALTF
+ ;DON'T TRY TO STOP THEN START STINK AFTER HERE (AFTER BREAKPOINT OR WITH $G)
+ BLT B,LEXEND ;BLT IN EXIT ROUTINE
+ BLT 17,17 ;BLT IN PROGRAM AC'S
+ EXCH 17,SV17 ;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
+IFN ITS,[
+ .CLOSE TYOC,
+ .CLOSE TYIC,
+ .CLOSE TPCHN,
+]
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVE 1,IJFN
+ CLOSF
+ JFCL
+ MOVE 1,JSYS1
+]
+ JRST LEXIT
+
+DDTST: MOVE T,SA ;#0
+ MOVE T,DDPTR ;#1
+
+DDTSN: ILDB T,C ;GET DIGIT AFTER NUMBER SIGN
+ XCT DDTST-"0(T) ;GET VALUE IN T
+ PUSHJ P,OPT ;"TYPE OUT" INTO VALRET STRING IN OCTAL
+DDTSG: ILDB T,C ;GET CHAR FROM INPUT STRING
+ CAIN T,"# ;NUMBER SIGN?
+ JRST DDTSN ;NUMBER SIGN, INTERPRET FOLLOWING DIGIT
+ IDPB T,B ;DEPOSIT IN OUTPUT STRING
+ JUMPN T,DDTSG ;LOOP ON NOT DONE YET
+ POPJ P,
+
+ ;EXIT ROUTINE FROM LOADER
+ ;BLT'ED INTO 20 - 20+N
+
+EXBLTP: .+1,,LEXIT ;BLT POINTER
+ OFST==20-. ;OFFSET, THIS CODE DESTINED FOR LEXIT
+LEXIT=.+OFST ;LEXIT=20
+
+PMEMT: BLT 17, ;BLT DOWN MAIN PROGRAM
+ MOVE 17,PALL1+OFST
+IFN ITS, .CBLK 17,
+IFE ITS, SKIPA
+PSV17: 40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
+ SUBI 17,1000
+ SOSLE PALL0+OFST
+ JRST .+OFST-4
+ MOVE 17,PSV17+OFST ;GIVE USER HIS LOCATION 17
+EXIT:
+IFN ITS, .VALUE .+OFST+1
+IFE ITS, HALTF
+PALL0: 0
+PALL1: 0
+
+LEXEND=.+OFST-1 ;END OF EXIT ROUTINE
+SV17=PSV17+OFST ;LOCATION TO SAVE 17
+];NODMCG
+\f
+NJN: TRZ FF,GOF
+ (3000+SIXBIT /NJN/)
+
+ZERO: MOVEI A,(NBLKS)
+ MOVEM A,LOBLKS
+ PUSHJ P,GETCOR
+IFN ITS,[
+ PUSHJ P,SCE ;GO TO ERROR
+ SKIPE KEEP
+ PUSHJ P,WINP
+]
+ JFCL
+ SETOM MEMTOP
+ MOVEI A,1(NBLKS)
+ MOVEM A,LOBLKS
+GETMEM: PUSHJ P,GETCOR
+IFN ITS,[
+ PUSHJ P,SCE
+ SKIPE KEEP
+ PUSHJ P,WINP
+]
+ JFCL
+
+ ADDI MEMTOP,2000
+ AOS LOBLKS
+ POPJ P,
+
+GETCOR:
+DMCG,[
+IFN ITS,[
+ .CORE @LOBLKS
+ POPJ P,
+]
+ JRST POPJ1
+];DMCG
+
+NODMCG,[
+ PUSH P,A
+ PUSH P,B
+ MOVE B,LOBLKS
+ SUB B,LOWSIZ ;NUMBER OF BLOCKS WE WANT
+ JUMPE B,GETC2
+ SKIPG B
+IFN ITS, .VALUE
+IFE ITS, HALTF
+ MOVE A,CWORD0
+GETC1: ADDI A,1000
+IFN ITS,[
+ .CBLK A,
+ JRST POPBAJ
+]
+ MOVEM A,CWORD0
+ AOS LOWSIZ
+ SOJG B,GETC1
+GETC2: AOS -2(P) ;SKIP RETURN
+ JRST POPBAJ
+];NODMCG
+
+IFN ITS,[
+SCE: SOS (P) ;MAKE POPJ BE A "JRST .-1"
+ SOS (P)
+ PUSHJ P,COREQ ;ASK LOSER
+ POPJ P, ;HE SAID YES
+ (2000+SIXBIT /SCE/)
+
+COREQ: PUSH P,A ;SAVE SOME ACS
+ SKIPE KEEP ; SKIP IF NOT LOOPING
+ JRST COREQ3
+COREQ0: MOVEI A,[ASCIZ /NO CORE:
+ TYPE C TO TRY INDEFINITELY
+ TYPE Y TO TRY ONCE
+ TYPE N TO LOSE/]
+
+ PUSHJ P,LINOUT
+ .IOT TYIC,A ;READ A CHARACTER
+ .RESET TYIC,
+ CAIN A,"N ; WANTS LOSSAGE?
+ JRST COREQ2
+ CAIN A,"Y
+ JRST POPAJ
+ CAIE A,"C
+ JRST COREQ0
+ AOSA KEEP
+COREQ2: AOS -1(P)
+ JRST POPAJ
+
+COREQ3: MOVEI A,1
+ .SLEEP A,
+ JRST POPAJ
+]
+;ROUTINE TO PRINT A LINE
+
+LINOUT: PUSH P,C
+ PUSH P,B
+ MOVSI B,440700+A ;BYTE POINTER TO INDEX OF A
+
+LINO1: ILDB C,B ;GET CHAR
+ JUMPE C,LINO2 ;ZERO, END
+IFN ITS, .IOT TYOC,C
+IFE ITS,[
+ EXCH C,1
+ PBOUT
+ EXCH C,1
+]
+ JRST LINO1
+
+LINO2: MOVEI A,15 ;PUT OUT CR
+IFN ITS, .IOT TYOC,A
+IFE ITS,[
+ EXCH A,1
+ PBOUT
+ EXCH A,1
+]
+ POP P,B
+ POP P,C
+ POPJ P,
+
+WINP: PUSH P,A
+ MOVEI A,[ASCIZ /WIN!!!/]
+ PUSHJ P,LINOUT
+ SETZM KEEP
+ JRST POPAJ
+\f
+DEFINE FOUR A,B,C,D
+ (<<A-SLIS>_9>+B-SLIS)<<C-SLIS>_9>+D-SLIS
+ TERMIN
+
+DTAB: (331100+T)DTB-74/4
+ (221100+T)DTB-74/4
+ (111100+T)DTB-74/4
+ (1100+T)DTB-74/4
+
+DTB: FOUR LBRAK,EQLS,ERR,MLIS, ;< = > ?
+ FOUR GETCOM,ERR,BEG,COMSET, ;@ A B C
+ FOUR DDT,NTS,NTS,GO, ;D E F G
+ FOUR HASHS,ERR,JOB,KILL, ;H I J K
+ FOUR LOADG,UTAP,LOADN,SOFSET, ;L M N O
+ FOUR PAPER,COMVAL,SFACT,SLIS, ;P Q R S
+ FOUR CPOPJ,ERR,ERR,ERR, ;T U V W
+ FOUR SADR,DUMPY,ZERO,EXAM, ;X Y Z [
+
+IFLE 1000-DDT+SLIS,[PRINTX /DISPATCH OVERFLOW
+/]
+INFORM [DISPATCH ROOM]\<1000-DDT+SLIS>
+
+\f
+;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
+;STINK TO KILL ITSELF.
+
+DUMPY:
+IFN ITS,[
+ TRZN FF,MLAST ;WAS "M" THE LAST COMMAND?
+ PUSHJ P,FIXFIL ;FIX UP THE FILE NAME
+ MOVEI A,(SIXBIT /DSK/)
+ TRZN FF,SETDEV ;WAS DEVICE SET?
+ HRRM A,DEV ;NO, SET IT
+
+ .OPEN TPCHN,DEV ;SEE IF IT EXISTS
+ JRST OPNOK ;NO, WIN
+
+ .CLOSE TPCHN, ;CLOSE IT
+ .FDELE DEV ;DELETE IT
+ JFCL ;IGNORE LOSSAGE
+
+OPNOK: MOVSI A,7 ;SET DEVICE SPEC TO BE WRITE/IMAGE/BLOCK
+ HLLM A,DEV
+ .OPEN TPCHN,DEV ;OPEN THE CHANNEL
+ JRST FNF
+]
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+ MOVSI 1,1
+ HRROI 2,FILSTR
+ GTJFN
+ JRST .+3
+ MOVE 2,[440000,,300000]
+ OPENF
+ MOVEI 1,0
+ MOVEM 1,OUTJFN
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+ SKIPN OUTJFN
+ JRST FNF
+]
+ PUSHJ P,TDDT ;MOVE ALL SYMBOLS TO DDT TABLE
+IFN ITS,[
+ MOVE B,[JRST 1] ;START FILE WITH "JRST 1"
+ PUSHJ P,OUTWRD ;PUT IT OUT
+]
+ MOVE B,LOWSIZ ;GET CURRENT CORE ALLOCATION
+ SUBI B,(NBLKS) ;REDUCE TO PROGRAM CORE ALLOCATION
+ LSH B,10. ;SHIFT TO MEMORY LOCATION
+ SUBI B,1 ;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
+ MOVEI ADR,20 ; GET TOP OF LOW SEG IN USER'S LOC 20
+ HRRZM B,@ADRPTR
+
+ MOVN ADR,MEMTOP ;GET -<LENGTH OF CORE IMAGE>
+ HRLZS ADR ;AOBJN POINTER
+
+DMP2: SKIPN B,@ADRPTR ;LOOK FOR THE FIRST NON-ZERO WORD
+ AOBJN ADR,.-1 ;UNTIL THE WORLD IS EXHAUSTED
+ JUMPGE ADR,CHKHI ;DROPPED THROUGH, JUMP IF CORE EMPTY
+
+ MOVEI C,(ADR) ;SAVE POINTER TO NON ZERO WORD
+ MOVEI A,(C) ;AND ANOTHER COPY
+
+DMP1: SKIPE B,@ADRPTR ;NOW LOOK FOR END OF NON ZERO BLOCK
+ AOBJN ADR,.-1 ;UNTIL WORLD EXHAUSTED
+ JUMPGE ADR,DMPLST ;IF WORLD EMPTY, QUIT
+
+ AOBJP ADR,DMPLST ;CHECK NEXT WORD
+ SKIPE B,@ADRPTR ;FOR BEING ZERO
+ JRST DMP1 ;ONE LONE ZERO, DON'T END BLOCK
+
+DMPLST: MOVEI D,(ADR) ;POINT TO END
+ SUB C,D ;C/ -<LENGTH OF BLOCK>
+ HRL A,C ;A/ AOBJN TO BLOCK
+ MOVE B,A ;COPY TO B FOR OUTWRD
+IFE ITS, SUBI B,1
+ PUSHJ P,OUTWRD ;PUT IT OUT
+IFE ITS, ADDI B,1
+ HRRI B,@BPTR ;NOW POINT TO REAL CORE
+IFN ITS, .IOT TPCHN,B ;BARF IT OUT
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+
+ MOVE 2,B
+ HLRE 3,B
+ HRLI 2,444400
+ MOVE 1,OUTJFN
+ SOUT
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+]
+
+IFN ITS,[
+ MOVE B,A ;GET POINTER BACK IN B
+ MOVE C,B ;FIRST WORD IN CHECK SUM
+ HRRI B,@BPTR ;POINT TO REAL CORE
+
+ ROT C,1 ;ROTATE CKS
+ ADD C,(B) ;ADD
+ AOBJN B,.-2 ;AND DO FOR ENTIRE BLOCK
+
+ MOVE B,C ;CKS TO B
+ PUSHJ P,OUTWRD ;AND PUT IT OUT
+]
+ JUMPL ADR,DMP2 ;IF MORE, GO DO IT
+
+CHKHI: SKIPN MEMTOP,HIGTOP ; ANY HIGH SEG
+ JRST DMPSYMS ; NO, GO ON TO SYMS
+ SETZM HIGTOP ; RESET IT
+ HLLZS ADRPTR ; FIX UP POINTERS
+ HLLZS BPTR
+ LDB ADR,[2100,,MEMTOP] ; GET NO. OF WORDS
+ MOVNS ADR ; NEGATE
+ MOVSI ADR,(ADR)
+ HRRI ADR,400000 ; START OF HIGH SEG
+ JRST DMP2
+
+
+;HERE TO DO START ADDRESS
+
+DMPSYMS: HRRZ B,SA ;GET START ADR
+IFN ITS, HRLI B,(JUMPA) ;USE "JUMPA" TO MAKE DDT HAPPY
+IFE ITS, HRLI B,1
+ PUSHJ P,OUTWRD
+
+;HERE TO DO SYMBOLS
+
+IFE ITS,[
+; ON TENEX/20 CLOSE FILE AND CREATE SEPARATE SYMBOL FILE
+
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+
+ MOVE 1,OUTJFN
+ CLOSF
+ JFCL
+
+ MOVE 1,[440700,,FILSTR]
+
+FNDNMX: ILDB 2,1
+ CAIE 2,"<
+ JRST FNDNM2
+
+ ILDB 2,1
+ CAIE 2,">
+ JRST .-2
+ ILDB 2,1
+
+FNDNM2: JUMPE 2,.+3
+ CAIE 2,".
+ JRST FNDNMX
+
+ MOVEI 2,".
+ DPB 2,1
+
+ MOVE 3,[440700,,[ASCIZ /SYMBOLS/]]
+ ILDB 2,3
+ IDPB 2,1
+ JUMPN 2,.-2
+
+ MOVSI 1,1
+ HRROI 2,FILSTR
+ GTJFN
+ JRST .+3
+ MOVE 2,[440000,,300000]
+ OPENF
+ MOVEI 1,0
+ MOVEM 1,OUTJFN
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+ SKIPN OUTJFN
+ JRST FNF
+]
+IFN ITS,[
+ HLLZ B,DDPTR ;GET NUMBER
+ PUSHJ P,OUTWRD ;PUT IT OUT
+
+ MOVE C,DDPTR ;FOR CKS
+ .IOT TPCHN,DDPTR ;OUT GOES THE WHOLE TABLE
+]
+
+IFE ITS,[
+ MOVE A,DDPTR
+ MOVEI B,0 ; WILL COUNT SYMS
+
+TWNTY1: MOVE T,(A)
+ TLZ T,740000 ; KILL SQUOZE BITS
+
+ MOVE D,T
+ IDIVI T,50 ; CONVERT TO 10X/20 SQUOZE
+ JUMPN TT,.+3
+ MOVE D,T
+ JRST .-3
+
+ HLLZ T,(A)
+ TLZ T,37777 ; JUST GET SQUOZE BITS
+ JUMPN T,TWNTY2 ; JUMP UNLESS PROG NAME
+ ADDI B,1
+TWNTY2: ADDI B,1
+ IOR D,T
+ MOVEM D,(A)
+ ADD A,[2,,2]
+ JUMPL A,TWNTY1
+
+; HAVE COUNTED SYMS AND FIXED UP SYMBOLS, START OUTPUTTING
+
+ ASH B,1
+ MOVNS B
+ MOVSS B
+ PUSHJ P,OUTWRD ; PUT OUT COUNT
+
+ MOVE A,DDPTR
+
+TWNTY3: MOVE D,A
+ MOVEI C,0
+TWNTY5: MOVE T,(A) ; SEARCH FOR A PROG NAME (OR END)
+ TLNN T,740000
+ JRST TWNTY4
+ ADD A,[2,,2]
+ ADDI C,2
+ JUMPL A,TWNTY5
+
+TWNTY6: JUMPE C,TWNTY7
+ MOVNS C
+ HRL D,C
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+
+ MOVE 1,OUTJFN
+ MOVE 2,D
+ HRLI 2,444400
+ HLRE 3,D
+ SOUT
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+TWNTY7: ADD A,[2,,2]
+ JUMPL A,TWNTY3
+]
+IFN ITS,[
+ ROT B,1
+ ADD B,(C) ;ADD IT
+ AOBJN C,.-2
+
+ PUSHJ P,OUTWRD ;PUT OUT THE CKS
+
+ MOVSI B,(JRST) ;FINISH WITH "JRST 0"
+ PUSHJ P,OUTWRD
+
+ MOVNI B,1 ;FINISH WITH NEGATIVE
+ PUSHJ P,OUTWRD
+
+ .CLOSE TPCHN, ;CLOSE THE FILE
+]
+IFE ITS,[
+ EXCH 1,OUTJFN
+ CLOSF
+ JFCL
+ EXCH 1,OUTJFN
+]
+
+IFN ITS, .VALUE [ASCIZ /:KILL /] ;KILL
+IFE ITS,[
+ HALTF
+
+TWNTY4: MOVE B,T
+ PUSHJ P,OUTWRD
+ MOVEI B,0
+ PUSHJ P,OUTWRD
+ MOVEI B,0
+ PUSHJ P,OUTWRD
+ MOVEI B,0
+ PUSHJ P,OUTWRD
+ JRST TWNTY6
+]
+
+;SUBROUTINE TO PUT OUT ONE WORD
+
+OUTWRD: HRROI T,B ;AOBJN POINTER TO B
+IFN ITS, .IOT TPCHN,T
+IFE ITS,[
+ MOVEM 1,JSYS1
+ MOVEM 2,JSYS2
+ MOVEM 3,JSYS3
+ MOVE 2,B
+ MOVE 1,OUTJFN
+ BOUT
+ MOVE 1,JSYS1
+ MOVE 2,JSYS2
+ MOVE 3,JSYS3
+]
+ POPJ P,
+
+
+
+\f
+;HERE TO BUILD DEFAULT OUTPUT FILE NAME
+
+FIXFIL: MOVE A,[SIXBIT /_STNK_/] ;DEFAULT NAME 1
+ MOVEM A,NM1
+ MOVE A,[SIXBIT /DUMP/] ;AND NAME 2
+ MOVEM A,NM2
+ POPJ P,
+\f
+; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK.
+
+PAIR: PUSH P,B
+ SKIPN A,PARLST ; ANY ON FREE LIST?
+ JRST PAIR1 ; NO, TRY FREE AREA
+ HRRZ B,(A) ; YES, CDR THE LIST
+ MOVEM B,PARLST
+PAIR3A: SETZM (A) ; CLEAR 1ST WORD
+PAIR3: POP P,B
+ POPJ P,
+
+PAIR1: MOVE A,PARCUR ; TRY FREE AREA
+ ADDI A,2 ; WORDS NEEDED
+ CAML A,PARTOP ; SKIP IF ROOM EXISTS
+ JRST PAIR2
+PAIR4: EXCH A,PARCUR ; RETURN POINTER AND RESET PARCUR
+ JRST PAIR3A
+
+QUAD: PUSH P,B
+ SKIPN A,QUADLS ; SKIP IF ANY THERE
+ JRST QUAD1
+ HRRZ B,(A) ; CDR THE QUAD LIST
+ MOVEM B,QUADLS
+ JRST PAIR3A
+
+QUAD1: MOVE A,PARCUR ; GET TOP
+ ADDI A,4
+ CAML A,PARTOP ; OVERFLOW?
+ JRST QUAD2 ; YES, GET MORE
+ JRST PAIR4 ; NO, WIN
+
+PAIR2: PUSHJ P,MORPAR ; GET MORE CORE
+ JRST PAIR1
+
+QUAD2: PUSHJ P,MORPAR
+ JRST QUAD1
+
+PARRET: PUSH P,B
+ HRRZ B,PARLST ; SPLICE IT INTO FREE LIST
+ HRRM B,(A)
+ MOVEM A,PARLST
+ JRST PAIR3 ; RETURN POPPING B
+
+QUADRT: PUSH P,B
+ HRRZ B,QUADLS
+ HRRM B,(A)
+ MOVEM A,QUADLS
+ JRST PAIR3
+\f
+; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF
+
+MORPAR: PUSHJ P,GETCOR ; TRY AND GET A BLOCK
+IFN ITS,[
+ PUSHJ P,TMSERR ; COMPLAIN
+ SKIPE KEEP
+ PUSHJ P,WINP
+]
+ JFCL
+ AOS NBLKS
+ PUSHJ P,MOVCOD ; TRY AND GET CODE OUT OF THE WAY
+ PUSHJ P,MOVDD ; ALSO GET DDT SYMBOLS OUT
+ MOVEI A,2000 ; INCREASE PARTOP
+ ADDM A,PARTOP
+ AOS LOBLKS
+ POPJ P,
+
+; HERE TO MOVE CODE
+
+MOVCOD: PUSH P,C
+ PUSH P,B
+ HRRZ A,ADRPTR ; POINT TO CURRENT START
+ ADDI A,2000 ; NEW START
+ MOVE C,A
+ HRRM A,ADRPTR ; FIX POINTERS
+ HRRM A,BPTR
+ HRRM A,DPTR
+ MOVE B,LOBLKS ; GEV(CURRENT TOP (IN BLOCKS)
+ ASH B,10. ; CONVERT TO WORDS
+
+MOVCO3: MOVEI A,-2000(B) ; A/ POINT TO LAST DESTINATION
+ CAIG B,(C) ; SKIP IF NOT DONE
+ JRST MOVCO2
+ HRLI A,-2000(A) ; B/ FIRST SOURCE,,FIRST DESTINATION
+ BLT A,-1(B)
+ SUBI B,2000
+ JRST MOVCO3
+
+MOVCO2: POP P,B
+ POP P,C
+ POPJ P,
+
+
+; HERE TO MOVE DDT SYMBOLS
+
+MOVDD: PUSH P,C
+ PUSH P,C
+ HRRZ A,DDPTR ; GET CURRENT POINTER
+ ADDI A,2000
+ HRRM A,DDPTR
+ HRRZ A,DDTOP ; TOP OF DDT TABLE
+ ADDI A,2000
+ MOVEM A,DDTOP
+
+ MOVEI B,1(A) ; SET UP FOR BLT LOOP
+ HRRZ C,DDBOT
+ ADDI C,2000 ; BUMP
+ MOVEM C,DDBOT
+ JRST MOVCO3 ; FALL INTO BLT LOOP
+
+
+;HAVE NAME W/ FLAGS IN A, VALUE IN T,
+;PUT SYM IN DDT SYMBOL TABLE.
+ADDDDT: PUSH P,A
+ PUSH P,B
+ADDDD1: MOVE A,DDPTR
+ SUB A,[2,,2]
+ HRRZ B,DDBOT
+ CAILE B,(A) ; SKIP IF OK
+ JRST GROWDD ; MUST GROW DDT TABLE
+ MOVEM A,DDPTR
+ MOVEM T,1(A) ; CLOBBER AWAY
+ POP P,B
+ POP P,(A)
+ MOVE A,(A) ; RESTORE A
+ POPJ P,
+
+GROWDD: PUSHJ P,GETCOR
+IFN ITS,[
+ PUSHJ P,TMSERR
+ SKIPE KEEP
+ PUSHJ P,WINP
+]
+ JFCL
+ AOS NBLKS
+ PUSHJ P,MOVCOD ; MOVE THE CODE
+ PUSHJ P,MOVDD
+ MOVNI A,2000
+ ADDM A,DDBOT
+ AOS LOBLKS
+ JRST ADDDD1
+
+ADDDD2: PUSH P,A ;CALL HERE FROM SYMS OR TDDT.
+ PUSH P,B
+ SKIPA B,DDPTR ;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME".
+ADDDD3: ADD B,[2,,2]
+ JUMPGE B,POPBAJ ;NO ENTRY, THROW AWAY SYM.
+ HLL A,(B)
+ CAME A,(B)
+ JRST ADDDD3 ;NOT THIS ONE.
+ MOVE A,1(B) ;SYM'S REAL NAME IS IN 2ND WD OF STE,
+ MOVEM A,(B)
+ MOVEM T,1(B) ;PUT IN THE VALUE.
+ JRST POPBAJ
+
+;TDDT EXITS THROUGH HERE.
+TDDTEX: PUSH P,A ;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME.
+ PUSH P,B
+ SKIPA A,DDPTR
+TDDTE1: ADD A,[2,,2]
+ JUMPGE A,POPBAJ ;NO PROGRAM NAMES AT ALL => NO PROBLEM.
+ MOVE B,(A)
+ TLNE B,740000
+ JRST TDDTE1 ;THIS NOT PROGRAM NAME.
+ CAMN A,DDPTR
+ JRST POPBAJ ;IF IT'S ALREADY 1ST, NO PROBLEM.
+ MOVE B,DDPTR
+REPEAT 2,[
+ EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE.
+ EXCH T,.RPCNT(B)
+ EXCH T,.RPCNT(A)]
+ JRST POPBAJ
+\fISYM: MOVSI C,(50*50*50*50*50*50)
+ MOVSI T,40000 ;GLOBAL BIT
+
+ISYM0: ILDB A,CPTR
+ CAIN A,"*
+ TLZ T,40000 ;LOCAL
+ CAIN A,"*
+ JRST ISYM0
+ CAIN A,">
+ JRST LKUP
+ SUBI A,"0-1
+ CAIL A,"A-"0+1
+ SUBI A,"A-"0+1-13
+ JUMPGE A,ISYM2
+ ADDI A,61
+ CAIN A,60
+ MOVEI A,45 ;.
+ISYM2: IDIVI C,50
+ IMUL A,C
+ ADDM A,T
+ JRST ISYM0
+
+\f
+IFN ITS,[
+FRD2: CAME B,[SIXBIT /@/]
+ JRST DEVNAM
+ SKIPA B,C
+FRD: MOVSI B,(SIXBIT /@/)
+ MOVSI C,(SIXBIT /@/)
+ MOVE A,[(600)C-1]
+FRD1: ILDB T,CPTR
+ CAIE T,33
+ CAIN T,DOLL
+ JRST CHBIN ;CHECK IF SHOULD CHANGE NAME 2 TO BIN
+ TRC T,40
+ JUMPE T,FRD2
+ CAIN T,32
+ JRST DEVSET
+ CAIN T,33
+ JRST USRSET
+ CAIN T,77
+ MOVEI T,0
+ CAME A,[(600)C]
+ IDPB T,A
+ JRST FRD1
+
+
+
+
+USRSET: MOVEM C,SNAME
+ JRST FRD+1
+
+DEVNAM: PUSH P,CDEVN1
+ MOVEM C,NM2
+ JRST FRD+1
+
+DEVNM1: TRO FF,SETDEV ;SAY DEVICE SET
+ HLRM C,DEV
+ MOVE C,NM2
+ JRST CHBIN ;CHECK FOR CHANGE TO BIN
+
+DEVSET: TRO FF,SETDEV ;DEVICE SET
+ HLRM C,DEV
+ JRST FRD+1
+
+CHBIN: CAME B,[SIXBIT /@/] ;WAS NO NAME2 SUPPLIED?
+ POPJ P, ;NAME2 SUPPLIED, GO AWAY
+ MOVE B,C ;MAKE NAME1 INTO NAME2
+NODMCG, MOVSI C,(SIXBIT /REL/) ;USE REL FOR NAME2
+DMCG, MOVSI C,(SIXBIT /BIN/)
+CDEVN1: POPJ P,DEVNM1
+]
+IFE ITS,[
+FRD:
+ MOVE B,[440700,,FILSTR]
+
+FRD2: ILDB T,CPTR
+ CAIE T,DOLL
+ CAIN T,33
+ JRST FRD1 ; FINISHED
+ IDPB T,B
+ JRST FRD2
+
+FRD1: MOVEI T,0
+ IDPB T,B ; ASCIZ
+ POPJ P,
+]
+CONSTANTS
+\f;IMPURE STORAGE
+
+EISYM: ;INITIAL SYMBOLS
+
+CRELPT: SQUOZE 64,$R.
+FACTOR: 100
+ 0
+CPOINT: SQUOZE 64,$.
+ 100
+ 0
+ SQUOZE 64,.LVAL1
+.VAL1: 0
+ 0
+ SQUOZE 64,.LVAL2
+.VAL2: 0
+ 0
+ SQUOZE 64,USDATL
+USDATP: 0
+ 0
+EISYME:
+
+POLSW: 0 ;-1=>WE ARE DOING POLISH
+PPDP: -PPDL,,PPDB-1 ;INITIAL POLISH PUSH DOWN POINTER
+PPDB: BLOCK PPDL+1 ;POLISH PUSH DOWN BLOCK
+SATED: 0 ;COUNT OF POLISH FIXUPS TO BE DELETED
+SATPDP: -SATPDL,,SATPDB-1 ;POINTER TO POLISH FIXUPS TO BE DELETED
+SATPDB: BLOCK SATPDL+1 ;LIST OF POLISH FIXUPS TO BE DELETED
+SVSAT: 0 ;# OF OPERANDS NEEDED
+POLPNT: 0 ;POINTER TO POLISH CHAIN
+CGLOB: 0 ;CURRENT GLOBAL IN SOME SENSE
+CGLOBV: 0 ;CURRENT GLOBAL VALUE IN SOME SENSE
+GLBFS: 0 ;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST
+SVHWD: 0 ;WORD CURRENTLY BEING READ BY POLISH
+GLBCNT: 0 ;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH
+HEADNM: 0 ;# POLISH FIXUPS SEEN
+LFTFIX: 0 ;-1=> LEFT HALF FIXUP IN PROGRESS
+LINKDB: BLOCK MNLNKS+1 ;LINK DATA BLOCK (END LINK,,CURRENT VALUE)
+HIBLK: 0 ; BLOCKS IN HIGH SEG
+KEEP: 0 ; FLAG SAYING WE ARE IN A CORE LOOP
+DMCG,[
+USINDX: 0 ; USER INDEX
+];DMCG
+HIGTOP: 0 ; TOP OF HIGH SEG
+INPTR: 0 ;HOLDS CURRENT IO POINTER
+STNBUF: BLOCK STNBLN ;BUFFER FOR BLOCK READS
+PAT: BLOCK 100
+PATEND==.+1
+CPTR: 0
+AWORD: 0
+ADRPTR: <INITCR*2000>(ADR)
+BPTR: <INITCR*2000>(B)
+DPTR: <INITCR*2000>(D)
+SA: 0
+TC: 0
+BITS: 0
+BITPTR: (300)BITS
+SAVPDL: 0
+LBOT: INITCR*2000
+TIMES: 0
+COMLOC: ICOMM
+T1: 0
+T2: 0
+FLSH: 0
+PRGNAM: 0
+
+; CORE MANAGEMENT VARIABLES
+
+NODMCG,[
+CWORD0: 4000,,400000+<<INITCR-1>_9.>
+CWORD1: 4000,,600000-1000
+LOWSIZ: INITCR ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
+];NODMCG
+LOBLKS: INITCR+1 ; NUMBER OF BLOCKS OF CORE WE WANT
+PARBOT: 0 ; POINT TO BOTTOM OF SYMBOL TABLES
+PARTOP: 0 ; POINT TO TOP OF SAME
+PARLST: 0 ; LIST OF AVAILABLE 2 WORD BLOCKS
+QUADLS: 0 ; LIST OF AVAILABLE 4 WORD BLOCKS
+PARCUR: 0 ; TOP CURRENTLY IN USE SYMBOL TABLE CORE
+
+DDPTR: 0 ; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE
+DDTOP: 0 ; HIGHEST ALLOCATED FOR DDT
+DDBOT: 0 ; LOWEST ALLOCATED FOR DDT
+
+HTOP: 0 ; TOP OF HASH TABLE
+HBOT: 0 ; BOTTOM OF HASH TABLE
+\fINIT:
+PDL: IFN ITS, .SUSET [.RSNAM,,SNAME] ;GET INITIAL SYSTEM NAME
+ MOVEI A,100
+ MOVEM A,FACTOR
+ MOVE NBLKS,[20,,INITCR]
+ MOVEI A,ICOMM
+ MOVEM A,COMLOC
+ HLLZS LKUP3
+ SETOM MEMTOP
+ MOVEI A,FACTOR
+ HRRM A,REL
+ MOVE P,[-100,,PDL]
+ PUSHJ P,KILL
+IFN ITS,[
+ .OPEN TYOC,TTYO
+ .VALUE 0
+ .OPEN TYIC,TTYI
+ .VALUE 0
+ .STATUS TYIC,T
+ ANDI T,77
+ CAIN T,2
+ TRO FF,GETTY
+]
+ MOVE TT,[SIXBIT /STINK./]
+ PUSHJ P,SIXTYO
+ MOVE TT,[.FNAM2]
+ PUSHJ P,SIXTYO
+IFN ITS, .SUSET [.RMEMT,,TT]
+IFE ITS,[
+ MOVEI TT,INITCR*2000
+]
+ LSH TT,-10.
+ MOVEM TT,LOWSIZ
+ SUBI TT,1
+ LSH TT,9.
+ TDO TT,[4000,,400000]
+ MOVEM TT,CWORD0
+ JRST LIS
+
+TTYO==.
+ 1,,(SIXBIT /TTY/)
+ SIXBIT /STINK/
+ SIXBIT /OUTPUT/
+
+TTYI==.
+ 30,,(SIXBIT /TTY/)
+ SIXBIT /STINK/
+ SIXBIT /INPUT/
+
+CONSTANTS
+
+LOC PDL+LPDL
+CBUF: BLOCK CBUFL
+FILSTR: BLOCK 10 ; GOOD FOR 40 CHARS
+LOSYM: ;LOWEST LOC AVAIL FOR SYM TBL
+INITCR==<LOSYM+3000>/2000 ;LDR LENGTH IN BLOCKS
+
+INFORM [HIGHEST USED]\LOSYM
+INFORM [LOWEST LOCATION LOADED ]\LOWLOD
+INFORM [COMMAND BUFFER LENGTH]\<CBUFL*5>
+INFORM [INITIAL CORE ALLOCATION]\INITCR
+
+END PDL
+\ 3\ 3
\ No newline at end of file
projects / pdp10-muddle.git / commitdiff