1
0
mirror of https://github.com/PDP-10/its.git synced 2026-02-17 05:07:20 +00:00
Files
PDP-10.its/src/sysen2/stink.201
2016-12-09 07:16:52 -08:00

3399 lines
70 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;
; 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: MOVEI 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
MOVEI C,[ASCIZ \J9B/#0<>#1P\]
;# 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