Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
midas/stink.mid
There are no other files named stink.mid in the archive.
;
; Somehow, in the dim past the source of this program became out of sync
; with the running binary. The binary was version 174 while the source
; was 177; moreover the source had several errors and did not assemble!
; By using SRCCOM (/$) to compare binaries, a working source was
; re-created and verified to assemble into exactly the same program as 174.
; This new source was installed and blessed with a new number of 200
; to commemorate the establishment of a New Regime on 11-Jun-85.
; --KLH
TITLE TSTINKING ODER
.MLLIT==1
ZR=0
P=1
A=2
B=3 ;SEE L.OP
C=B+1
D=C+1
T=6
TT=T+1 ;SEE CD1, SIXO, ASPT
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 ;ALT MODE READ FLAG(USED LOCALLY IN COMMMAND READER)
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
ADRREL==2000 ;ADR IS RELOCATABLE QUANTITY
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
;LEFT HALF FLAGS
HSW==1 ;HALF WORD TOGGLE USED TO READ POLISH
NAME==2000 ;SET JOB NAME TO PROGRAM NAME
;UUO'S FOR ERRORS
FATAL=3000,,0 ;FATAL ERROR WITH NO SYMBOL TYPE OUT
WARN=7000,,0 ;WARNING ERROR MESSAGE, NO SYMBOL OR OCTAL TYPE OUT
SYMERR=5000,,0 ;ILLEGAL GLOBAL ASSIGNMENT
FATADR==2000,,0 ;FATAL ERROR, TYPE ADR
;INSTRUCTIONS
DEFINE HALT
.VALUE
TERMIN
DEFINE OPEN CHANNEL,MODE
.CALL [SETZ
SIXBIT/OPEN/
3000,,ERRSTS
5000,,MODE
1000,,CHANNEL
DEV
NM1
NM2
SETZ SNAME]
TERMIN
;MISCELLANEOUS CONSTANTS
LOWLOD==0 ;LOWEST LOCATION LOADED
CBUFL==2000 ;COMMAND BUFFER LENGTH (MOBY LONG!)
FNBLEN==200 ;FILE NAME BUFFER LENGTH
ALTMOD==33 ;THE ALTMODE CHARACTER
INHASH==151. ; HASH TABLE LENGTH
ICOMM==10000 ;INITIAL COMMON
HIREL0==400000 ;RELOCATABLE VALUES GE THIS ARE HI SEG
LPDL==20 ;LENGTH OF PROCESS PUSH DOWN AREA
PPDL==60 ;POLISH PUSH DOWN LENGTH
SATPDL==5 ;SATED PUSH DOWN LENGTH
MNLNKS==20 ;MAXIMUM NUMBER OF LINKS
STNBLN==200 ;STINK INPUT BUFFER SIZE
;REFERENCE 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 CHECK A,B
IF1,[IFN .-A-<B>,[PRINTX \ A LOSES **************
\]]
TERMIN
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
LOC 100
REL: MOVEI TT,1 ;RELOCATE RIGHT HALF OF T
PUSHJ P,RELOCT
TROA FF,ADRREL ;FLAG TO SAVE ADR WHEN FINISHED LOADING BLOCK
ABS: TRZ FF,ADRREL
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: TRNE FF,CODEF
JRST GCR3
CAMLE ADR,MEMTOP
JRST GCR1
MOVEM T,@ADRPTR
SKIPA
GCR3: MOVEM T,(ADR)
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: CAML ADR,HIORG ; 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: PUSH P,A
MOVEI TT,(ADR)
SUB TT,HIORG ;SUBI TT,400000-2000
ADDI TT,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
FATAL [ASCIZ/High Segment Request is Negative/]
MOVE A,CWORD1
GETHI1: ADDI A,1000
.CBLK A,
PUSHJ P,SCE
SOJG TT,GETHI1
MOVEM A,CWORD1
MOVE TT,HIBLK
ASH TT,10.
ADD TT,HIORG ;ADDI TT,400000-1
SUBI TT,1
MOVEM TT,HIGTOP
JRST POPAJ
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: SYMERR [ASCIZ/Undefined Global Assignment/]
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)
SYMERR [ASCIZ/Multiply Defined Global/]
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)
; PTCH2A: ;;177
PTCH2B:
HRRZ D,(A)
PUSHJ P,PARRET
SKIPE A,D
; JRST PTCH2A ;;177
JRST PTCH2B ;;174
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 PTCH2A ; NO, SKIP
HRRM C,(B) ; IT IS, CLOBBER IN
; CAIA ;;177
JRST .+2 ;;174
PTCH2A: 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: PUSH P,D
HRRZ D,B ; VIRUTAL ADDRESS
PUSHJ P,MAPD ; GET REAL ADDRESS
HRL T,(D)
HRRM T,(D)
POP P,D
HLRZ B,T
JUMPN B,UNTHR
CPTCH1: POPJ P, PATCH1
DEFIF: SKIPGE (B)
JRST DEFIF1 ;MUST SATISFY DEFERRED INTERNAL
TLNE ADR,FIXRT+FIXLT
HALT
DEFIF6: EXCH A,B
PUSHJ P,PARRET
MOVE A,B ;GET THE SYMBOL BACK
JRST PATCH1
DEFIF1: TLNN ADR,FIXRT+FIXLT
HALT ;SYMBOL FIXED UP BUT NOT EXPUNGED FROM TABLE
TLC ADR,FIXRT+FIXLT
TLCN ADR,FIXRT+FIXLT
HALT ;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
HALT ;LOSER
PUSHJ P,GLOBS3 ;FIND THE VALUE
CAIN B,0
HALT
TLNE ADR,FIXRT
JRST DEFIFR ;RIGHT HANDED
TLNN ADR,FIXLT
JRST DEFIF2 ;LEFT HANDED FIXUP
TLZN A,FIXLT
HALT
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
HALT
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
PUSH P,D
HRRZ D,B ; VIRTUAL ADDRESS
PUSHJ P,MAPD ; REAL ADDRESS
ADD T,(D)
ADD TT,T
HRR T,TT
MOVEM T,(D)
POP P,D
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 ;RELOCATE RIGHT HALF?
PUSHJ P,RELOCT
EXCH C,T
TRNE TT,2
PUSHJ P,RELOCT ;PERHAPS RELOCATE THE LEFT HALF
EXCH C,T
HRL T,C
POPJ P,
RELOCT: PUSH P,T ;DON'T CLOBBER THE LEFT HALF OF T
HRRZS T
TRNN FF,INDEF ;GLOBAL RELOCATION?
JRST RT1 ;NO
ADDI T,@RELADR
JRST RT2
RT1: CAIGE T,HIREL0
ADD T,FACTOR ;LOW SEGMENT
CAIL T,HIREL0
ADD T,HIFACT ;HI SEGMENT
RT2: HRRM T,(P)
POP P,T
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
PUSHJ P,RELOCT ;RELOCATE RIGHT HALF OF T
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,[ ;NO SYMBOL THERE
WARN [ASCIZ/bad format: symbol missing/]
JRST DATABK]
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 [WARN [ASCIZ/bad format: symbol undefined/]
JRST DATABK ;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,LG1A ;MUST RECOVER TO GLOBAL
PUSH P,B ;RETURN ADDRESS
JRST ENT ;ENTER IT
LG1A: 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: TRZE FF,ADRREL
PUSHJ P,SETADR ;SAVE ADR FOR RELOCATION OF OTHER SEGEMT AT PRGEND
PUSHJ P,GTWD
AOS BLKCNT ;COUNT BLOCKS
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
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,AXTER1 ;NEVER APPEARED, MUST ENTER
TLNE B,200000 ;SKIP IF NOT DEFINED
JRST AEXTER ;THIS ONE EXISTS, GO AGAIN
AXTER1: 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
PUSH P,D
HRRZ D,B ; VIRTUAL ADDRESS
PUSHJ P,MAPD ; REAL ADDRESS
MOVEM A,(D) ; STORE INTO CORE IMAGE BEING BUILT
POP P,D
POP P,A ;RESTORE SYMBOL
MOVEI T,1(B) ;ALSO COMPUTE 'VALUE' OF SYMBOL
PUSHJ P,DEFSYM
JRST AEXTER
;USDAT HAS OVERFLOWN
TMX: FATAL [ASCIZ/Too Many External Symbols/]
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]
MOVEM ADR,ADRM ;SAVE ADR AND RELOCATION
HRLM FF,ADRM
TRO FF,UNDEF+CODEF
TRZ FF,ADRREL
MOVEI B,@LKUP3
MOVEM B,CPOINT+1
MOVEI ADR,T1
JSP LL,DATABK
LDCMD1: TRZ FF,UNDEF+CODEF
MOVE ADR,ADRM
TLNE ADR,ADRREL ;ADRREL WAS SAVED IN LEFT HALF
TRO FF,ADRREL
HRRZS ADR
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
;HRRM D,REL
JRST JMP1
RESPNT: TRZ FF,INDEF
;MOVEI D,FACTOR
HRRZ ADR,FACTOR
;HRRM D,REL
JRST JMP1
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
CAIA
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
HALT
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
HALT ;ALREADY DEFINED
PUSHJ P,GLOBS3 ;RETURNS REFERENCE WORD IN A
JUMPE B,GDFIT1 ;MUST ADD DEFERRED VALUE
HLRZ B,A
CAIE B,DEFINT(C)
HALT ;REFERENCE WORDS DON'T MATCH
MOVE B,CGLOBV
CAME B,1(A)
HALT ;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
MOVE C,CGLOBV
HRLI C,100000 ;THIS IS A LINK LIST
;BEGIN CROCK
;AVOID DUPLICATE ENTRIES
; HRRZ A,1(D)
; JUMPE A,GLBRQ2
;GLBRQ1: CAMN C,1(A)
; JRST GLOBS
; HRRZ A,(A)
; JUMPN A,GLBRQ1
;GLBRQ2:
;END CROCK
PUSHJ P,DOWN ;NOT DEFINED, ENTER REQEST INTO TABLE
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: PUSH P,D
HRRZ D,B
PUSHJ P,MAPD
HRR B,D
POP P,D
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
; HALT ;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
HALT
PUSHJ P,GLOBS3 ;FIND THE GLOBAL VALUE
SKIPE B
SKIPN (A)
HALT
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
HALT ;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
HALT ;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
HALT ;ITS GLOBAL, THERE'S NO HOPE
MOVEI B,0 ;BLOCK NAME
MOVE C,T ;SYMBOL TO FIX
TLZ C,740000
PUSHJ P,FSYMT2
HALT ;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
FATAL [ASCIZ/PDL Overflow/]
COMPOL: FATAL [ASCIZ/Polish Too Complex/]
LOAD4A: FATAL [ASCIZ/Illegal Block Format/]
;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
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
MOVEI T,MXPLOP ;STORE OPERATOR
RPOL0: PUSH D,T ;SAVE OPERATOR IN STACK
MOVE B,DESTB-3(T) ;GET NUMBER OF OPERANDS NEEDED
MOVEM B,SVSAT ;ALSO SAVE IT
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,MXPLOP-1 ;HIGHEST OPERATOR
JRST LOAD4A ;ILL FORMAT
JRST RPOL0 ;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,MXPLOP ;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
HALT ;CL 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 ;AND
1 ;OR
1 ;LSH
1 ;XOR
0 ;NOT
0 ;-
0 ;JFFO
1 ;REM
0 ;ABSOLUTE VALUE
100 ;STORE OPERAND
MXPLOP==.-DESTB+3
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
PUSHJ P,JFFOP
PUSHJ P,REMOP
MOVM T,C
HALT ;STORE OP
CHECK OPTAB,MXPLOP-3
JFFOP: PUSH P,D
JFFO C,.+2
MOVEI D,44
MOVE T,D
POPDJ: POP P,D
POPJ P,
REMOP: IDIV T,C
MOVE T,TT
POPJ P,
;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
HALT ;SYMBOL NOT FOUND
SLCL1: JUMPE B,POPAJ1 ;SYMBOL IS IN THIS BLOCK
PUSH P,T ;THIS POINTER POSSIBLY A WINNER
SLCL1A: ADD T,[2,,2] ;NEXT SYMBOL
CAIL T,0
HALT ;WE HAVE RUN OUT OF TABLE
MOVE A,(T) ;SQUOZE
TLNE A,740000 ;SKIP ON BLOCK NAME
JRST SLCL1A
; 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 CL RDHLF THAT FOLLOWS THIS CALL
POPJ P,
SLCL3: JUMPN B,SLCL4
HALT ;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
CAIL D,0
HALT ;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
HALT ;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,MXPLOP
CAIGE B,3
HALT ;NOT OPERATOR
MOVE T,1(A) ;OPERANDS (SECOND,,FIRST)
HLRZ C,(T) ;FIRST OPERAND
CAIN C,0
HALT ;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
CAIN C,0
HALT
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?
HALT ;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 LNKF1A
PUSHJ P,MAPB
HLRM B,(B)
LNKF1A: 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
PUSHJ P,SETADR ;SAVE THIS ADR IN CASE WE RESET RELOCATION CONSTANT
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
MOVSI T,1 ; WANT NON-ZERO, BUT POSITIVE LEFT HALF
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: PUSH P,A
MOVE A,HIADR
SUBI A,HIREL0
MOVEM A,HIFACT
MOVE A,LOWADR
MOVEM A,FACTOR
SETZM LFTFIX
HRRZ A,DPTR ; LOW SEGMENT OFFSET
ADD A,LOWADR ; LAST WORD OF LOW SEGMENT IN STINK
CAMGE A,HIORG ; OVERLAP WITH HIGH SEGMENT?
JRST PE1 ; NO
HRRZ ADR,LOWADR ; FOR ERROR MESSAGE
FATADR [ASCIZ/Low Segment Full/]
PE1: MOVE A,LOWADR ; LOW SEGMENT MAY END WITH BLOCKS
CAMG A,MEMTOP
JRST POPAJ
PUSHJ P,GETMEM
JRST PE1
SETADR: HRRZS ADR ;THIS ROUTINE SAVES ADR SO THAT RELOCATION FACTORS WIN
CAMGE ADR,HIORG
MOVEM ADR,LOWADR
CAML ADR,HIORG
MOVEM ADR,HIADR
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 STINK READ THEM
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
OPNPTR: OPEN TPCHN,6
PUSHJ P,FNF
RDFRST: PUSH P,TT
SETOM BLKCNT
JRST DOREAD ;READ A NEW BUFFER
RCKS: FATAL [ASCIZ/Checksum Error/]
;LOADER INTERFACE
;UUO HANDLER EFFECTIVE ADDRESS OF UUO IS ASCIZ ERROR MESSAGE
;IF 4.3 IS ZERO THEN ERROR IS FATAL AND LOADER IS RESTARTED
;UUO'S ARE DECODED AS FOLLOWS (ONLY 4.1-4.3 ARE RELEVANT)
; 7 (-1) NO SYMBOL OR VALUE IS TYPED
; 6 (-2) TYPE ADR IN OCTAL
; 5 (-3) TYPE SQUOZE IN A AND ADR
TYPR: 0
PUSH P,C
PUSH P,T
PUSH P,TT
LDB C,[330300,,40] ;PICKUP LOW ORDER 3 BITS OF UUO CODE
MOVEI TT,RESTRT
TRON C,4
HRRM TT,TYPR ;FATAL ERROR CLOBBER RETURN
ORCMI C,7 ;MAKE IT A SMALL NEGATIVE NUMBER
HRRZ TT,40 ;PICK UP ERROR MESSAGE
PUSHJ P,TYOS ;PRINT MESSAGE
AOJE C,TYPR1 ;PRINT SQUOZE AND VALUE?
PUSHJ P,SPC ;YES
HRRZ T,ADR
PUSHJ P,OCTPR ;PRINT OCTAL
AOJE C,TYPR1
PUSHJ P,SPC
PUSHJ P,ASPT ;AND SYMBOL
TYPR1: PUSHJ P,CRL ;GOOD BYE
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
;SQUOZE CHARACTER CODES
;0 1-12 13-44 45 46 47
;NULL 0-9 A-Z . $ %
;HERE TO BUFFER TTY INPUT
FILBUF: PUSH P,A ;CAN'T CLOBBER A
FILB0: SETZM CCNT
MOVE A,[10700,,CBUF-1]
MOVEM A,CPTR
PUSHJ P,CRLS ;PROMPT
TRZ FF,LOCF
FILB1: TRZ FF,ALTF
FILB2: PUSHJ P,TYI
CAIN T,7
JRST FILB0 ;BELL, RESET
CAIN T,177 ;RUBOUT
JRST RUBOUT
IDPB T,A
AOS CCNT ;CHARACTER COUNT
CAMN A,[10700,,CBUF+CBUFL]
JRST BUFFUL ;BUFFER FULL
CAIE T,ALTMOD
JRST FILB1
TRON FF,ALTF
JRST FILB2
PUSHJ P,CRL ;GIVE HIM CR AFTER TWO ALTS
JRST POPAJ
BUFFUL: MOVEI T,^G ;BUFFER FULL, DING TTY AND RUBOUT LAST CHARACTER
PUSHJ P,TYO
RUBOUT: LDB T,A ;THE CHARACTER TO RUBOUT
PUSHJ P,DECBP ;DECREMENT BYTE POINTER
SKIPGE CCNT
JRST FILB0 ;CCNT WENT NEGATIVE
TRNN FF,GETTY
JRST [ .IOT TYOC,T
JRST FILB1]
CAIE T,15 ;CARRIAGE RETURNS ARE A PAIN!!!
JRST [ .IOT TYOC,[^P] ;BACK UP CURSOR
.IOT TYOC,["X]
JRST FILB1]
PUSH P,CCNT
PUSH P,A
.IOT TYOC,[^P]
.IOT TYOC,["U] ;MOVE TO BEGINNING OF PREVIOUS LINE
RUBCR: PUSHJ P,DECBP ;DECREMENT BYTE POINTER
LDB T,A ;THE PRECEEDING CHARACTER
SKIPGE CCNT ;AT BEGINNING OF BUFFER?
JRST RUBCR1
.IOT TYOC,[^P]
.IOT TYOC,["F] ;MOVE FORWARD ONE
CAIE T,15 ;END OF LINE?
JRST RUBCR
RUBCR1: POP P,A
POP P,CCNT
JRST FILB1
DECBP: SOS CCNT
ADD A,[70000,,0] ;DECREMENT BYTE POINTER AND ECHO
SKIPGE A
SUB A,[430000,,1]
POPJ P,
TYI: .IOT TYIC,T
CAIN T,12
MOVEI T,15 ;NO LINE FEEDS IN BUFFER
CAIN T,15
JRST TYO
CAIE T,^L
POPJ P,
PUSH P,CCNT ;FORM FEED RETYPES BUFFER
PUSH P,A
MOVE A,[440700,,CBUF]
TRNE FF,GETTY
PUSHJ P,FORMF ;CLEAR DISPLAY SCREEN
PUSHJ P,CRL
TYI1: SOSGE CCNT
JRST [ POP P,A
POP P,CCNT
JRST TYI]
ILDB T,A
PUSHJ P,TYO
TRNN FF,GETTY
JRST TYI1 ;DON'T WORRY ABOUT ^P IF NOT DISPLAY
CAIN T,^P ;^P IS CONTROL CODE
PUSHJ P,TYO ;WHICH QUOTES ITSELF
JRST TYI1
LIS: ANDI FF,GETTY
SKIPA ;DON'T CLOBBER DDT STYLE COMMANDS
RESTRT: SETZM CCNT ;FLUSH STALE TYPE IN
MOVE P,[-LPDL,,PDL-1] ;RESTART AFTER VARIOUS ERRORS
RESTR1: SOSL UDEPTH
JRST [ .IOPOP TYIC, ;UNWIND THE IO PDL
JRST RESTR1]
SETZM UDEPTH ;FOR SAFETY SACK
CD: MOVEI D,0
CD3: TRZ FF,ARG
;THE MAIN READ LOOP
CD2: PUSHJ P,GETCC
CAIL T,"0
CAILE T,"9
JRST CD1
LSH D,3 ;ACCUMULATE NUMERIC ARGS
ADDI D,-"0(T)
VALRET: TRO FF,ARG
JRST CD2
CD1: CAIN T,ALTMOD ;STRAY ALTMODE?
JRST RESTRT
CAIL T,"< ;LEGAL COMMAND?
CAILE T,"[
JRST CD ;NO, FORGIVE AND FORGET
SUBI T,"<
IDIVI T,2
HLRZ A,DTB(T)
CAIE TT,0 ;GET ADDRESS OF ROUTINE INTO A
HRRZ A,DTB(T)
MOVE T,A
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,(T) ;DISPATCH TO ACTION ROUTINE
JRST CD
JRST VALRET
DEFINE FOUR A,B,C,D
A,,B ? C,,D
TERMIN
DTB: FOUR LBRAK,EQLS,ERR,MLIS, ;< = > ?
FOUR GETCOM,SHIORG,BEG,COMSET, ;@ A B C
FOUR DDT,NTS,NTS,GOCOM, ;D E F G
FOUR HASHS,ERR,JOB,KILL, ;H I J K
FOUR LOADG,MCOM,LOADN,SOFSET, ;L M N O
FOUR PAPER,COMVAL,SFACT,SLIS, ;P Q R S
FOUR CPOPJ,ERR,ERR,WASH, ;T U V W
FOUR SADR,DUMPY,ZERO,EXAM, ;X Y Z [
SLIS: TDZA C,C
MLIS: MOVEI C,2
TRNE FF,ARG
JUMPL D,LISTER
MOVE D,BOT
LISTER: MOVE A,(D)
TLZ A,740000
CAMGE A,[50*50*50*50*50]
JRST LIST6 ; IGNORE POLISH FIXUPS
MOVE A,(D)
LDB TT,[(410300)A]
ORCMI TT,7 ; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
AOJN TT,LIST2 ; NOT PROG NAME
LIST4: MOVEM D,CPROTE
SKIPN C
PUSHJ P,ASPT
LIST5: SKIPN C
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: SKIPN C
JRST LIST10
SKIPN CPROTE
JRST LIST10
EXCH D,CPROTE
MOVE A,(D)
PUSHJ P,ASPT
PUSHJ P,VALPT
EXCH D,CPROTE
SETZM CPROTE
MOVE A,(D)
LIST10: 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
WASH: SETOM PURE ;MAKE HIGH SEG PURE
POPJ P,
;WASH PURIFIES THE HIGH SEGMENT
DOWASH: SKIPG A,HIBLK
POPJ P, ; DON'T BOTHER IF NO HIGH SEG BLOCKS
HRRZ B,HIORG
LSH B,-10.
MOVE 0,B
LSH 0,9.
IOR B,0
IORI B,400000
WASH1: .CBLK B,
FATAL [ASCIZ/Purification Failure/]
ADDI B,1001
SOJG A,WASH1
POPJ P,
; 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
OCTPR: 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
TYOS: PUSH P,T
HRLI TT,440700
TYOS1: ILDB T,TT
CAIN T,0
JRST TYOS2
PUSHJ P,TYO
JRST TYOS1
TYOS2: POP P,T
POPJ P,
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: ANDI T,177 ;YET ANOTHER INCOMPATIBLE CHANGES TO ITS BY RMS
.IOT TYOC,T
C.12: POPJ P, 12
CRLS1: MOVEI T,"*
JRST TYO
FORMF: MOVEI T,^P
PUSHJ P,TYO
JRST FORMF1
; THIS CALLED BEFORE DUMPING OR RETURNING TO DDT
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,
GOCOM: TRNE FF,ARG
MOVEM D,SA
TRO FF,GOF
JRST DDT
MAPD: ; MAP VIRTUAL LOC IN D TO REAL LOC
CAMGE D,MEMTOP ; MUST BE IN HIGH SEGMENT
JRST MD1 ; IS IN LOW SEGMENT
CAML D,HIORG ; SKIP IF NOT IN HIGH SEGMENT
CAMLE D,HIGTOP ; SKIP IF IN HIGH SEGMENT
FATAL [ASCIZ/Non-existent Memory/]
POPJ P,
MD1: HRRZ 0,DPTR ; GET FUDGE FACTOR
ADD D,0 ; ACTUAL ADDRESS
SKIPN HIBLK ; ANY HIGH SEGMENT?
POPJ P, ; NO, NOTHING TO CHECK
CAMGE D,HIORG ; OVERLAP WITH HIGH SEGMENT
POPJ P, ; NO
SUB D,0 ; VIRTUAL ADDRESS
HRRZM D,ADR ; FOR ERROR MESSAGE
FATADR [ASCIZ/Low Segment Full/]
EXAM: ; GET CONTENTS SPEC BY VIRTUAL ADDR IN D
PUSHJ P,MAPD
MOVE T,(D)
JRST OPTCR
C.CD2: POPJ P, CD2
GETCOM: MOVE P,[-LPDL,,PDL-1]
PUSH P,C.CD2
MOVEM P,SAVPDL
.IOPUSH TYIC,
MOVE T,NM2 ;DON'T USE REL FOR COMMAND FILE
CAMN T,DEFFN2
MOVE T,[SIXBIT /LOADER/]
MOVEM T,NM2
OPEN TYIC,0
PUSHJ P,FNF ;LOSE
AOS UDEPTH
POPJ P,
TPOK: SKIPA T,BELL
ERR: MOVE T,"?
.IOT TYOC,T
JRST RESTRT
PAPER: MOVE A,[SIXBIT /PTR/]
MOVEM A,DEV
POPJ P, ;REAL OPEN WILL OCCUR LATER
MCOM: TRZN FF,ARG
JRST OPNTP
TRO FF,SETDEV ;SETTING DEVICE
MOVE A,DEVTBL(D)
MOVEM A,DEV
OPNTP: TRO FF,MLAST ;SET M LAST COMMAND
PUSHJ P,FRD
POPJ P, ;REAL OPEN WILL OCCUR LATER
NTS: FATAL [ASCIZ/Non-Time Sharing Command/]
SIXTYO: JUMPE TT,CPOPJ
MOVEI T,0
LSHC T,6
ADDI T,40
PUSHJ P,TYO
JRST SIXTYO
JOB: PUSH P,DEV
PUSH P,SNAME
PUSH P,NM1
PUSH P,NM2
PUSHJ P,FRD
MOVE B,NM1
MOVEM B,JOBNAM
TRO FF,JBN
POP P,NM2
POP P,NM1
POP P,SNAME
POP P,DEV
POPJ P,
FNF: PUSHJ P,TYPFIL
PUSHJ P,SPC
PUSHJ P,SPC
.CALL [SETZ
SIXBIT/OPEN/
5000,,0
1000,,ERCHN
[SIXBIT/ERR/]
1000,,4
SETZ ERRSTS]
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,
PUSH P,C
MOVEI TT,[ASCIZ/ Use What Filename Instead? /]
PUSHJ P,TYOS
PUSHJ P,GTYIP ;GET TYPEIN
PUSHJ P,RFD ;GET NEW FILE DESCRIPTION
POP P,C
POP P,A ;ADDRESS OF .CALL OPEN+2
JRST -2(A) ;RETRY .CALL OPEN
TYPFIL: MOVE A,[-4,,0] ; TYPE OUT CURRENT FILE NAME
TYPF2: SKIPN TT,DEV(A)
JRST TYPF3
PUSHJ P,SIXTYO
MOVE T,TYPFTB(A)
PUSHJ P,TYO
TYPF3: AOBJN A,TYPF2
POPJ P,
TYPFTB: ":
";
40
40
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: ;LEAVE GLOBAL LOCATION MODE
; MOVEI A,FACTOR
; HRRM A,REL
TRZ FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND+ADRREL
POPJ P,
SHIORG: SKIPE HIBLK
FATAL [ASCIZ/Too Late to Change High Segment Origin/]
HRRZ D,D
ADDI D,1777
ANDI D,776000
MOVEM D,HIORG
MOVEM D,HIADR
SUBI D,HIREL0
MOVEM D,HIFACT
MOVE D,HIORG
LSH D,-10.
SUBI D,1
LSH D,9.
IORI D,400000
HRRM D,CWORD1
JRST CJMP1
SFACT: HRRZS D
CAIL D,HIORG
JRST SF1
MOVEM D,FACTOR
JRST CJMP1
SF1: SUB D,HIORG
MOVEM D,HIFACT
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
FATAL [ASCIZ/Undefined Symbol/]
MOVE D,1(D)
TRZN FF,LOSE
JRST POPJ1
FATADR [ASCIZ/Undefined Symbol/] ;TYPES ADR, BUT I DON'T KNOW WHY
SOFSET: HRRM D,LKUP3
CPOPJ: POPJ P,
BEG: MOVE D,FACTOR
JRST POPJ1
DDT: SKIPN JOBNAM
JRST NJN
MOVE B,LOWSIZ ; PUT LOW-SEGMENT TOP IN LOCATION 20
SUBI B,(NBLKS)
LSH B,10.
SUBI B,1
MOVEM B,20
HRLZ B,HIORG ; PUT HIORG,,HIGTOP IN LOCATION 21
HRR B,HIGTOP
MOVEM B,21
PUSHJ P,TDDT
.IOPDL ;RESET THE I/O PUSH DOWN LIST
SKIPE PURE
PUSHJ P,DOWASH ;PURIFY HIGH SEGMENT
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
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 OCTPR GO TO DDT4
HRRM T,TYOM ;INSTEAD OF TYO
MOVEIC,[ASCIZ \J9B/#0
;# 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,LOWSIZ
SUBI C,1
LSH C,9.
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,OCTPR ;"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 22 - 22+N
EXBLTP: .+1,,LEXIT ;BLT POINTER
OFST==22-. ;OFFSET, THIS CODE DESTINED FOR LEXIT
LEXIT=.+OFST ;LEXIT=22
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
NJN: TRZ FF,GOF
FATAL [ASCIZ/No Job Name/]
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: PUSH P,A
PUSH P,B
MOVE B,LOWSIZ ; NUMBER OF BLOCKS WE HAVE
SUB B,LOBLKS ; NEGATIVE NUMBER OF BLOCKS TO GET
SKIPL B ; WANT TO GIVE SOME UP?
FATAL [ASCIZ/Low Segment Request is Negative/]
AOS -2(P) ; SET UP FOR SKIP RETURN (SUCCESSFUL)
JUMPE B,POPBAJ ; THAT WAS EASY
HRLZ B,B ; NOW IN LEFT HALF
HRR B,LOWSIZ ; FIRST PAGE TO GET IN RIGHT HALF
.CALL [SETZ
'CORBLK
1000,,300000 ; GET READ AND WRITE ACCESS
1000,,-1 ; PUT PAGES IN MY JOB
B ; CPTR
401000,,400001 ; GET FRESH PAGES
]
SOS -2(P) ; GUESS WE LOST AFTER ALL
HRRZM B,LOWSIZ ; NEW NUMBER OF LOW BLOCKS
JRST POPBAJ ; RETURN
SCE: SOS (P) ;MAKE POPJ BE A "GO .-1"
SOS (P)
PUSHJ P,COREQ ;ASK LOSER
POPJ P, ;HE SAID YES
FATADR [ASCIZ/Storage Capacity Exceeded/]
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 indefinately
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
;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
;STINK TO KILL ITSELF.
DUMPY: SKIPE PURE
WARN [ASCIZ/Must do PDUMP to Get Pure High Segment/]
TRZN FF,MLAST ;WAS "M" THE LAST COMMAND?
PUSHJ P,FIXFIL ;FIX UP THE FILE NAME
MOVE A,[SIXBIT /DSK/]
TRZN FF,SETDEV ;WAS DEVICE SET?
MOVEM A,DEV ;NO, SET IT
MOVSI A,'REL
CAME A,NM2 ;IS THAT ANY NAME FOR A BIN FILE
JRST DUMPY1
MOVSI A,'BIN
MOVEM A,NM2
DUMPY1: OPEN TPCHN,6
JRST OPNOK ;DOES NOT EXIST, WIN
.CLOSE TPCHN, ;CLOSE IT
.CALL [SETZ
SIXBIT/DELETE/
DEV
NM1
NM2
SETZ SNAME]
JFCL ;IGNORE LOSSAGE
OPNOK: OPEN TPCHN,7
PUSHJ P,FNF
PUSHJ P,TDDT ;MOVE ALL SYMBOLS TO DDT TABLE
MOVE B,[JRST 1] ;START FILE WITH "GO 1"
PUSHJ P,OUTWRD ;PUT IT OUT
MOVE B,LOWSIZ ; PUT LOW-SEGMENT TOP IN LOCATION 20
SUBI B,(NBLKS)
LSH B,10.
SUBI B,1
MOVEI ADR,20
MOVEM B,@ADRPTR
HRLZ B,HIORG ; PUT HIORG,,HIGTOP IN LOCATION 21
HRR B,HIGTOP
MOVEI ADR,21
MOVEM 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
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
HLLZS DPTR
HRRZ ADR,MEMTOP ; GET NO. OF WORDS
SUB ADR,HIORG
MOVNS ADR ; NEGATE
MOVSI ADR,(ADR)
HRR ADR,HIORG ; 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 "GO 0"
PUSHJ P,OUTWRD
MOVNI B,1 ;FINISH WITH NEGATIVE
PUSHJ P,OUTWRD
.CLOSE TPCHN, ;CLOSE THE FILE
.BREAK 16,60000 ; GOOD-BYE
;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: PUSH P,T
PUSHJ P,GETCC
MOVE A,T
POP P,T
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
;READ SINGLE FILE DESCRIPTION
;USES A,B,C,D,T
;REGISTER A USED TO CONTAIN INSTRUCTION TO GET NEXT CHARACTER
RFD: ; READ FROM FILE-NAME-BUFFER -- DEFAULT NM2 IS PREVIOUS
MOVE T,[440700,,FNBUF]
MOVEM T,FNPTR
MOVE A,[ILDB T,FNPTR]
JRST RFD8
FRD: ; READ FROM COMMAND STRING -- DEFAULT NM2 IS 'REL'
SETZM NM2
MOVE A,[PUSHJ P,GETCC]
RFD8: SETZ D, ;D COUNTS FILENAMES. 0 BEFORE 1ST.
RFD1: MOVEI C,0 ;INITIALIZE SIXBIT NAME.
MOVE B,[440600,,C] ;SET UP BP FOR INPUT
RFD2: XCT A ;GET CHARACTER IN T
CAIN T,": ;IF COLON...
JRST RFDCOL ;THEN PROCESS AS SUCH
CAIN T,"; ;SIMILARLY FOR SEMICOLON
JRST RFDSEM
CAIN T,^Q ;IF CONTROL Q...
JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL
CAILE T,40 ;LOGICAL SPACE? (INCLUDING CR)
JRST RFDC ;NO
RFD6: JUMPE C,RFD5 ;IGNORE NULL FILENAMES
XCT RFDTAB(D) ;STORE THE NAME (MAY SKIP)
ADDI D,1 ;NEXT NAME PUT ELSEWHERE
RFD5: CAIE T,ALTMOD
JRST RFD1 ;NEXT NAME
CAIL D,2 ;SECOND NAME SPECIFIED?
POPJ P, ;YES
SKIPE NM2 ;USE OLD SECOND NAME?
POPJ P, ;YES
MOVE T,DEFFN2 ;NO, USE DEFAULT
MOVEM T,NM2
POPJ P,
RFDCOL: JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN
MOVEM C,DEV ;MOVE TO DEVICE LOCATION
TRO FF,SETDEV
JRST RFD1 ;LOOP
RFDSEM: JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE
MOVEM C,SNAME ;MOVE TO SYSTEM NAME LOCATION
JRST RFD1 ;LOOP
RFDCQ: XCT A ;CONTROL Q EATS UP THE NEXT CHARACTER
CAIN T,15
JRST RFD6 ;BUT NOT IF CR
RFDC: CAIL T,140 ;CONVERT LOWER CASE TO UPPER.
SUBI T,40
SUBI T,40 ;CONVERT CHARACTER TO SIXBIT
TLNE B,770000 ;TOO MANY CHARACTERS?
IDPB T,B ;NO
JRST RFD2 ;LOOP
RFDTAB: MOVEM C,NM1 ;1ST NAME.
MOVEM C,NM2 ;2ND NAME.
CAIA ;3RD AND ON IGNORED, DON'T INCR. D.
;GET COMMAND CHARACTER
;RETURNS CHARACTER IN T
;DOES NOT MODIFY A, B, C, D
GETCC: SKIPN T,UDEPTH
JRST GETTTY ;GET GOODIES FROM TTY BUFFER
.IOT TYIC,T
JUMPG T,UPPER
JUMPE T,.-2 ;IGNORE NULLS
SOSGE UDEPTH ;FOUND EOF ON TYIC
HALT ;OVER POPPING IOPDL
.IOPOP TYIC,
JRST GETCC
;HERE TO GET COMMAND GOODIES FROM TTY
GETTY0: PUSHJ P,FILBUF ;GET BUFFER GOODIES FROM TTY
GETTTY: SOSGE CCNT
JRST GETTY0
ILDB T,CPTR
UPPER: ANDI T,177
CAIN T,"$
MOVEI T,"
CAIL T,"a ;IF LOWER CASE THEN CONVERT TO UPPER CASE
CAILE T,"z
POPJ P,
SUBI T,40
POPJ P,
; READ TTY LINE INTO FILE-NAME-BUFFER
GTYIP: MOVE A,[440700,,FNBUF]
.IOPUSH TYIC,
.OPEN TYIC,TTYI
.VALUE
GTYI1: PUSHJ P,TYI
CAIN T,15
JRST GTYICR
CAIN T,177 ;RUBOUT
JRST GTYRUB
IDPB T,A
JRST GTYI1
GTYICR: MOVEI T,33
IDPB T,A
.IOPOP TYIC,
POPJ P,
GTYRUB: CAMN A,[(10700)FNBUF-1]
JRST GTYI1
LDB T,A
ADD A,[(70000)]
SKIPGE A
SUB A,[(430000)1]
TRNN FF,GETTY
JRST [ .IOT TYOC,T
JRST GTYI1]
.IOT TYOC,[^P]
.IOT TYOC,["X]
JRST GTYI1
LITTER: CONSTANTS
VARS:: VARIABLES
;IMPURE STORAGE
EISYM: ;INITIAL SYMBOLS
CRELPT: SQUOZE 64,$R.
FACTOR: 100
0
HIFACT: SQUOZE 64,$R.H
0
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:
BLKCNT: 0 ;SEQUENTIAL BLOCK OF THIS FILE (FIRST ONE IS ZERO)
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
CPROTE: 0 ;SYMTAB ENTRY OF CURRENT PROGRM WHILE LISTING
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
PURE: 0 ;NON-ZERO IF HIGH SEG PURE
KEEP: 0 ; FLAG SAYING WE ARE IN A CORE LOOP
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 ;BYTE POINTER INTO COMMAND BUFFER
CCNT: 0 ;# CHARACTERS IN COMAND BUFFER
DEV: SIXBIT /DSK/ ;ARGS FOR OPEN AND DELETE
SNAME: 0
NM1: SIXBIT /BIN/
NM2: SIXBIT /BIN/
ERRSTS: 0 ;FOR OPEN ERROR CODE
DEFFN2: SIXBIT /REL/ ;DEFAULT FILE NAME 2
UDEPTH: 0 ;# TIMES TYIC PUSHED
DEVTBL: IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
SIXBIT /DEV/
TERMIN
JOBNAM: 0 ;NAME OF JOB
HIORG: 0 ;ORIGIN OF HIGH SEGMENT
LOWADR: 0 ;FIRST FREE LOCATION IN LOW SEGMENT
HIADR: 0 ;FIRST FREE IN HIGH SEGMENT
ADRM: 0 ;TEMPORY CELL TO SAVE ADR AND ADRREL
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
;CWORD0: 4000,,400000+<<INITCR-1>_9.>
CWORD1: 4000,,600000-1000
LOWSIZ: INITCR ; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
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
;INITITALIZATION CODE
OPTCMD==40000 ;IF .OPTIO HAS THIS TURNED ON THEN DDT HAS COMMAND
INIT:
PDL: .SUSET [.RSNAM,,SNAME] ;GET INITIAL SYSTEM NAME
MOVEI A,100
MOVEM A,FACTOR
SETZM HIFACT
MOVEI A,400000 ;ORIGIN OF HIGH SEGEMNT
MOVEM A,HIORG
MOVEM A,HIADR
SETZM LOWADR
MOVE NBLKS,[20,,INITCR]
MOVEI A,ICOMM
MOVEM A,COMLOC
HLLZS LKUP3
SETOM MEMTOP
; MOVEI A,FACTOR
; HRRM A,REL
MOVE P,[-10,,PDL]
PUSHJ P,KILL
.OPEN TYOC,TTYO
.VALUE [ASCIZ/: CAN'T OPEN TTY OUTPUT /]
.OPEN TYIC,TTYI
.VALUE [ASCIZ/: CAN'T OPEN TTY INPUT /]
.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
.IOT TYOC,[15]
.IOT TYOC,[12]
.SUSET [.RMEMT,,TT]
LSH TT,-10.
MOVEM TT,LOWSIZ
; SUBI TT,1
; LSH TT,9.
; TDO TT,[4000,,400000]
; MOVEM TT,CWORD0
.SUSET [.ROPTI,,TT]
TLNN TT,OPTCMD ;IS DDT TRYING TO GIVE US A COMMAND?
JRST LIS ;NO, READ TTY COMMAND
.BREAK 12,[5,,DDTBUF+1] ;ZAP
MOVE T,[440700,,DDTBUF+1]
INIT0: MOVEM T,B
ILDB TT,T
CAIE TT,40 ;IGNORE LEADING SPACES AND TABS
CAIN TT,11
JRST INIT0
CAIE TT,12
CAIN TT,15
JRST LIS ;NULL COMMAND LINE
CAIN TT,ALTMOD ;FLUSH LEADING ALTMODES
JRST INIT0
MOVE A,[440700,,DDTBUF]
MOVEM A,CPTR
MOVEI T,"M ;SET UP FILE OF FORM M<loader command file>$@$$
INIT1: CAIE T,12
CAIN T,15
JRST INIT2 ;END OF COMMAND
CAIN T,ALTMOD
JRST INIT2 ;ALTMODE STOPS ALL THIS NON-SENSE TOO
IDPB T,A
AOS CCNT
ILDB T,B
JRST INIT1
INIT2: MOVEI T,ALTMOD
MOVEI TT,"@
IDPB T,A
IDPB TT,A
IDPB T,A
IDPB T,A
MOVEI TT,4 ;WE TACKED ON 4 EXTRA CHARACTERS AT END
ADDM TT,CCNT
JRST LIS
TTYO==.
21,,(SIXBIT /TTY/)
SIXBIT /STINK/
SIXBIT /OUTPUT/
TTYI==.
30,,(SIXBIT /TTY/)
SIXBIT /STINK/
SIXBIT /INPUT/
CONSTANTS
DDTBUF: BLOCK 20 ; DDT COMMAND BUFFER GOES HERE
-1
LOC PDL+LPDL
CBUF: BLOCK CBUFL-1
0
FNBUF: BLOCK FNBLEN
FNPTR: BLOCK 1
LOSYM: ;LOWEST LOC AVAIL FOR SYM TBL
IFG DDTBUF+80.-LOSYM,INFORM [DDT BUFFER OVERFLOWS SYMBOLS]\DDTBUF+80.-LOSYM
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