Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
midas/stink.121t
There are no other files named stink.121t in the archive.
TITLE TSTINKING ODOR
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
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
LOC 100
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
; ROUTINE TO GROW HIGH SEGMENT
GETHI:
DMCG,[
PUSH P,A
SKIPE TT,USINDX ; DO WE KNOW USER INDEX
JRST GETHI1 ; YES, CONTINUE
.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
.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
.VALUE
MOVE A,CWORD1
ADDI A,1000
.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
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
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
PATCH7: 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
DEFIF: 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
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)
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
;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
THRDR: 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
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,.
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,
;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/)
GPA: 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
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
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
;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
;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
; 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,
; 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,
; 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,
;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
;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
;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
;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
;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
STRTAB: 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
;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
;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
;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,
; 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
;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
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,RESET
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
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
.IOT TPCHN,TT ;GOBBLE IT
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/)
;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 . $ %
LI4: CAMN A,[(10700)CBUF-1]
JRST LI3
LDB T,A
ADD A,[(70000)]
SKIPGE A
SUB A,[(430000)1]
.IOT TYOC,T
JRST LI1
TYI: .IOT TYIC,T
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,"
CAIN T,7
JRST LI3
CAIN T,177 ;RUBOUT
JRST LI4
IDPB T,A
CAMN A,[(10700)CBUF+CBUFL]
JRST LI4
LIS1: CAIE T,"
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
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
; 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
PUSHJ P,SCE
SKIPE KEEP
PUSHJ P,WINP ; WE HAVE THE CORE, TELL LOSER
AOS NBLKS
AOS LOBLKS
CCRL: POPJ P,CRL
TMSERR: JRST SCE
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
.IOT TYOC,T
JRST TYO
CRLS: TRNE FF,GETTY
PUSH P,[CRLS1]
CRL: MOVEI T,15
.IOT TYOC,T
CRT: SKIPA T,C.12
FORMF1: MOVEI T,"C
TYO: .IOT TYOC,T
C.12: POPJ P,12
CRLS1: MOVEI T,"*
JRST TYO
FORMF: POPJ P,12
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,
GO: 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
MOVEI T,0 ;REOPEN CHANNEL IN ASCII MODE
HLLM T,DEV
.OPEN TPCHN,DEV ;RE OPEN
JRST FNF2 ;LOSE
GTCM1: .IOT TPCHN,T
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,"?
.IOT TYOC,T
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
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
.SUSET [.SSNAM,,SNAME]
MOVEM B,NM1
MOVEM C,NM2
POPJ P, ;REAL OPEN WILL OCCUR LATER
OPNPTR: .OPEN TPCHN,DEV
JRST FNF
JRST RDFRST ;STAART UP THE READ ING
NTS: (3000+SIXBIT /NTS/)
DEV: 6,,(SIXBIT /DSK/)
NM1: SIXBIT /BIN/
NM2: SIXBIT /BIN/
0
SNAME: 0 ;SYSTEM NAME
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
.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: 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
";
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
RESET: 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,
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
DMCG,[
DDT1: MOVEIC,[CONC69]ASCIZ \J,\SA,[/9B!Q
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: .VALUE ;ADDRESS POINTS TO VALRET STRING
;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
.CLOSE TYOC,
.CLOSE TYIC,
.CLOSE TPCHN,
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: .CORE ;REDUCE CORE ALLOCATION TO WHAT REQUIRED BY PROGRAM
PSV17: SV17=.+OFST
40,,40 ;40 FIRST PROGRAM ADDRESS LOADED INTO
EXIT: .VALUE LEXEND
LEXEND=.+OFST
0 ;END OF EXIT ROUTINE
];DMCG
NODMCG,[
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
MOVEIC,[ASCIZU\J9B/#0ING 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: .VALUE ;ADDRESS POINTS TO VALRET STRING
;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
.CLOSE TYOC,
.CLOSE TYIC,
.CLOSE TPCHN,
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
.CBLK 17,
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: .VALUE .+OFST+1
PALL0: 0
PALL1: 0
LEXEND=.+OFST-1 ;END OF EXIT ROUTINE
SV17=PSV17+OFST ;LOCATION TO SAVE 17
];NODMCG
NJN: TRZ FF,GOF
(3000+SIXBIT /NJN/)
ZERO: MOVEI A,(NBLKS)
MOVEM A,LOBLKS
PUSHJ P,GETCOR
PUSHJ P,SCE ;GO TO ERROR
SKIPE KEEP
PUSHJ P,WINP
SETOM MEMTOP
MOVEI A,1(NBLKS)
MOVEM A,LOBLKS
GETMEM: PUSHJ P,GETCOR
PUSHJ P,SCE
SKIPE KEEP
PUSHJ P,WINP
ADDI MEMTOP,2000
AOS LOBLKS
POPJ P,
GETCOR:
DMCG,[
.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
.VALUE
MOVE A,CWORD0
GETC1: ADDI A,1000
.CBLK A,
JRST POPBAJ
MOVEM A,CWORD0
AOS LOWSIZ
SOJG B,GETC1
GETC2: AOS -2(P) ;SKIP RETURN
JRST POPBAJ
];NODMCG
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
.IOT TYOC,C
JRST LINO1
LINO2: MOVEI A,15 ;PUT OUT CR
.IOT TYOC,A
POP P,B
POP P,C
POPJ P,
WINP: PUSH P,A
MOVEI A,[ASCIZ /WIN!!!/]
PUSHJ P,LINOUT
SETZM KEEP
JRST POPAJ
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>
;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
;STINK TO KILL ITSELF.
DUMPY: 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
PUSHJ P,TDDT ;MOVE ALL SYMBOLS TO DDT TABLE
MOVE B,[JRST 1] ;START FILE WITH "JRST 1"
PUSHJ P,OUTWRD ;PUT IT OUT
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
PUSHJ P,OUTWRD ;PUT IT OUT
HRRI B,@BPTR ;NOW POINT TO REAL CORE
.IOT TPCHN,B ;BARF IT OUT
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
HRLI B,(JUMPA) ;USE "JUMPA" TO MAKE DDT HAPPY
PUSHJ P,OUTWRD
;HERE TO DO SYMBOLS
HLLZ B,DDPTR ;GET NUMBER
PUSHJ P,OUTWRD ;PUT IT OUT
MOVE C,DDPTR ;FOR CKS
.IOT TPCHN,DDPTR ;OUT GOES THE WHOLE TABLE
ROT B,1 ;ACCUMULATE IN B
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
.VALUE [ASCIZ /:KILL /] ;KILL
;SUBROUTINE TO PUT OUT ONE WORD
OUTWRD: HRROI T,B ;AOBJN POINTER TO B
.IOT TPCHN,T
POPJ P,
;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,
; 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
; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF
MORPAR: PUSHJ P,GETCOR ; TRY AND GET A BLOCK
PUSHJ P,TMSERR ; COMPLAIN
SKIPE KEEP
PUSHJ P,WINP
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
PUSHJ P,TMSERR
SKIPE KEEP
PUSHJ P,WINP
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
ISYM: 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
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
CONSTANTS
;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
INIT:
PDL: .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,[(,-1)PDL]
PUSHJ P,KILL
.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
.SUSET [.RMEMT,,TT]
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
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