Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50073/loader.mac
There are 9 other files named loader.mac in the archive. Click here to see a list.
SUBTTL DICK GRUEN: V25 3 AUG 68
L==1 ;L=1 MEANS THE LISP LOADER
IFNDEF L,<L=0>
IFNDEF HE,<HE=0>
IFE HE-1,<K=1> ;HE=1 IS HAND EYE 1K LOADER
IFE HE-2,<K=0> ;HE=2 IS HAND-EYE FORTRAN LOADER
;K=1 ;K=1 MEANS 1KLOADER
IFNDEF K,<K=0> ;K=0 MEANS F4 LOADER
STANSW=1 ;GIVES STANFORD FEATURES
IFNDEF STANSW,<STANSW=0>
IFN STANSW,< LDAC=1
EXPAND=1
BLTSYM=1
PP=1
RPGSW=1
FAILSW=1>
IFN L,< RPGSW=0
BLTSYM=0
LDAC=0>
UTAHSW=1 ;NUMERIC PPN'S, BUT OTHERWISE = STANSW=1.
IFNDEF UTAHSW,<UTAHSW=0>
;FAILSW=1 ;MEANS INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS
IFNDEF FAILSW,<FAILSW=0>
;RPGSW=1 ;MEANS RPG FEATURE
IFNDEF RPGSW,<RPGSW=0>
;LDAC=1 ;MEANS LOAD CODE INTO ACS
IFNDEF LDAC,<LDAC=0>
;BLTSYM=1 ;MOVE SYMBOL TABLE DOWN TO END OF PROG
IFNDEF BLTSYM,<BLTSYM=0>
;EXPAND=1 ;FOR AUTOMATIC CORE EXPANSION
IFNDEF EXPAND,< IFN K,<EXPAND=0>
IFE K,<EXPAND=1>>
;PP=1 ;ALLOW PROJ-PROG #
IFNDEF PP,<PP=0>
IFN HE,<RPGSW=0
PP=0
LDAC=0
EXPAND=1
>
;CHN5=0 ;IF CHAIN WHICH DOESN'T SAVES JOB41
IFNDEF CHN5,<CHN5=1>
IFE K,< TITLE LOADER - LOADS MACROX AND SIXTRAN FOUR>
IFN K,< TITLE 1KLOAD - LOADS MACROX>
;ACCUMULATOR ASSIGNMENTS
F=0 ;FLAGS IN LH, SA IN RH
N=1 ;PROGRAM NAME POINTER
X=2 ;LOADER OFFSET
H=3 ;HIGHEST LOC LOADED
S=4 ;UNDEFINED POINTER
R=5 ;RELOCATION CONSTANT
B=6 ;SYMBOL TABLE POINTER
D=7
T=10
V=T+1
W=12 ;VALUE
C=W+1 ;SYMBOL
E=C+1 ;DATA WORD COUNTER
Q=15 ;RELOCATION BITS
A=Q+1 ;SYMBOL SEARCH POINTER
P=17 ;PUSHDOWN POINTER
;FLAGS F(0 - 17)
CSW==1 ;ON - COLON SEEN
ESW==2 ;ON - EXPLICIT EXTENSION IDENT.
SKIPSW==4 ;ON - DO NOT LOAD THIS PROGRAM
FSW==10 ;ON - SCAN FORCED TO COMPLETION
FCONSW==20 ;ON - FORCE CONSOLE OUTPUT
ASW==100 ;ON - LEFT ARROW ILLEGAL
FULLSW==200 ;ON - STORAGE EXCEEDED
SLIBSW==400 ;ON - LIB SEARCH IN THIS PROG
DSYMSW==1000 ;ON - LOAD WITH SYMBOLS FOR DDT
REWSW==2000 ;ON - REWIND AFTER INIT
LIBSW==4000 ;ON - LIBRARY SEARCH MODE
F4LIB==10000 ;ON - F4 LIBRARY SEARCH LOOKUP
ISW==20000 ;ON - DO NOT PERFORM INIT
SYMSW==40000 ;ON - LOAD LOCAL SYMBOLS
DSW==100000 ;ON - CHAR IN IDENTIFIER
NSW==200000 ;ON - SUPPRESS LIBRARY SEARCH
SSW==400000 ;ON - SWITCH MODE
;FLAGS N(0 - 17)
ALLFLG==1 ;ON - LIST ALL GLOBALS
ISAFLG==2 ;ON - IGNORE STARTING ADDRESSES
COMFLG==4 ;ON - SIZE OF COMMON SET
IFE K,< F4SW==10 ;F4 IN PROGRESS
RCF==20 ;READ DATA COUNT
SYDAT==40 ;SYMBOL IN DATA>
SLASH==100 ;SLASH SEEN
IFE K,< BLKD1==200 ;ON- FIRST BLOCK DATA SEEN
PGM1==400 ;ON FIRST F4 PROG SEEN
DZER==1000 ;ON - ZERO SECOND DATA WORD>
EXEQSW==2000 ;IMMEDIATE EXECUTION
DDSW==4000 ;GO TO DDT
IFN RPGSW,<RPGF==10000 ;IN RPG MODE>
AUXSWI==20000 ;ON - AUX. DEVICE INITIALIZED
AUXSWE==40000 ;ON - AUX. DEVICE ENTERED
IFN PP,<PPSW==100000 ;ON - READING PROJ-PROG #
PPCSW==200000 ;ON - READING PROJ #>
IFN FAILSW,<HSW==400000 ;USED IN BLOCK 11 POLISH FIXUPS>
LOC 137
OCT 25 ;VERSION #
RELOC
MLON
SALL
;MONITOR LOCATIONS IN THE USER AREA
JOBPRO==140 ;PROGRAM ORIGIN
JOBBLT==134 ;BLT ORIGIN
JOBCHN==131 ;RH = PROG BREAK OF FIRST BLOCK DATA
;LH = PROG BREAK OF FIRST F4 PROG
;CALLI DEFINITIONS
CDDTOUT==3 ;CALLI DDTOUT
CEXIT==12 ;CALLI EXIT
CDDTGT==5 ;CALLI DDTGT
CSETDDT==2 ;CALLI SETDDT
;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS
PPDL==60
IFN RPGSW,<
RPGSET: CALLI 0
INIT 17,1 ;SET UP DSK
SIXBIT /DSK/
XWD 0,CTLIN
JRST NUTS
MOVE [SIXBIT /QQLOAD/] ;NAME OF COMMAND FILE
MOVEM CTLNAM
MOVSI (SIXBIT /RPG/) ;AND EXT
MOVEM CTLNAM+1
SETZM CTLNAM+3
LOOKUP 17,CTLNAM ;THERE?
JRST NUTS ;NO
INIT 16,16 ;GET SET TO DELETE QQLOAD.RPG
SIXBIT /DSK/
0
JRST LD ;GIVE UP COMPLETELY
SETZM CTLNAM+3
HLLZS CTLNAM+1 ;CLEAR OUT EXTRA JUNK
LOOKUP 16,CTLNAM
JRST LD
RENAME 16,ZEROS ;DELETE IT
JFCL ;IGNORE IF IT WILL NOT GO
RELEASE 16,0 ;GET RID OF THIS DEVICE
SETZM NONLOD ;THIS IS NOT A CONTINUATION
RPGS3: MOVEI CTLBUF
MOVEM JOBFF ;SET UP BUFFER
INBUF 17,1
MOVEI [ASCIZ /
LOADING
/] ;PRINT MESSAGE THAT WE ARE STARTING
CALLI CDDTOUT
SKIPE NONLOD ;CONTINUATION?
JRST RPGS2 ;YES, SPECIAL SETUP
MOVSI R,F.I ;NOW SO WE CAN SET FLAG
BLT R,R
TLO N,RPGF
JRST CTLSET ;SET UP TTY
RPGS1: PUSHJ P,[TLNE F,ESW ;HERE FROM FOO* COMMAND, STORE NAME
JRST LDDT3 ;SAVE EXTENSION
TLZE F,CSW!DSW ;OR AS NAME
MOVEM W,DTIN
POPJ P,]
MOVEM 0,SVRPG# ;SAVE 0 JUST IN CASE
SETZM NONLOD# ;DETERMINE IF CONTINUATION
MOVEI 0,2(B) ;BY SEEING IF ANY SYMBOLS LOADED
CAME 0,JOBREL
SETOM NONLOD ;SET TO -1 AND SKIP CALLI
MOVE 0,ILD1
MOVEM 0,RPG1
INIT 17,1
RPG1: 0
XWD 0,CTLIN
JSP A,ILD5
LOOKUP 17,DTIN ;THE FILE NAME
JRST ILD9
JRST RPGS3
RPGS2: MOVSI 0,RPGF ;SET FLAG
IORM 0,F.C+N
TLO N,RPGF
MOVE 0,SVRPG
JRST LD2Q ;BACK TO INPUT SCANNING
>
IFN HE, <
.LOAD: SETZM ERRFLG; HAND-EYE LOADER INITIALIZATION
SETZM RESET
MOVSI R,F.I+1; INITIALIZE ACS
AOS R
BLT R,R
OR F,F.I
MOVE B,JOBSYM; SET UP SYMBOL TABLE POINTER
HLRZ H,JOBSA
HLR R,JOBSA; LOAD STARTING AT PROGRAM BREAK
MOVS E,R; CLEAR CORE
HRRI E,1(R)
SETZM (R)
BLT E,(B)
PUSHJ P,FIXNAM
MOVE S,JOBUSY
SKIPN S
HRRZ S,B
SOS S
SOS B
MOVEM P,SAVP#; SAVE SUBR POINTER
JRST BEG; FINISH INIT
F.I: XWD SYMSW,0; INITIAL F
XWD ALLFLG+ISAFLG+COMFLG,0; INITIAL N
XWD V,0; INITIAL X - LOAD IN PLACE
Z
Z
XWD W,0; INITIAL R
Z
.AC: BLOCK 17
LNKSAV: BLOCK 21
LD5B1: HALT
>
IFN HE,<
.PRMAP: MOVEM 16,.AC+16; PRINT STORAGE MAP
HRRZI 16,.AC; SAVE ACS
BLT 16,.AC+15
MOVE F,F.I+F; SET UP ACS AS NEEDED
MOVE N,F.I+N
HLRZ R,JOBSA
MOVE S,JOBUSY
SOS S
MOVE B,JOBSYM
SOS B
INIT 2,1; INITIALIZE LPT
SIXBIT /LPT/
XWD ABUF,0
JSP A,ILD5
MOVEI E,AUX
MOVEM E,JOBFF
OUTBUF 2,1
TLO N,AUXSWI
PUSHJ P,PRMAP; PRINT MAP
RELEASE 2,
HRLZI 16,.AC
BLT 16,16
POPJ P,
>
IFN HE,<
ILD: MOVEI W,BUF1; INITIALIZE FILE LOADING
MOVEM W,JOBFF
TLOE F,ISW
JRST ILD6
INIT 1,14
SIXBIT /DSK/
Z BUFR
JSP A,ILD5; ERROR RETURN
ILD6: LOOKUP 1,DTIN; LOOKUP FILE
JRST ILD3
INBUF 1,2
MOVE 15,..NAME
MOVEI 12,-2(S)
SUBI S,2
POP B,2(12)
POP B,1(12)
MOVE 12,.NAME; RIGHT HALF VALUE IS LINK
HRL 12,R; LEFT HALF IS RELOCATION
MOVEM 12,2(B)
MOVEM 15,1(B)
HRRZM B,.NAME
POPJ P,
ILD3: PUSHJ P,ILDX; LOOKUP FAILURE
JRST ILD9; NO HOPE
JRST ILD6; TRY AGAIN
ILDX: MOVE W,DTIN2
CAMN W,[SIXBIT / H HE/]
POPJ P,; IF H,HE THERE IS NO HOPE
CAMN W,[SIXBIT / 1 3/]
JRST [ MOVE W,DTIN; CHECK IF HELIB[1,3]
CAME W,[SIXBIT /HELIB/]
POPJ P,; YES - TRY BACKUP FILE
JRST IX]
IX: MOVE W,[SIXBIT / H HE/]
MOVEM W,DTIN2; NOT H,HE - TRY LIBRARY AREA
AOS (P); TRY AGAIN
POPJ P,
>
IFN HE,<
FIXNAM: HLRE T,B; GET END OF PROGRAM NAME LIST
MOVMS T
ADDI T,(B)
SUBI T,3
HLRZ D,2(T)
JUMPE D,.+3
ADD T,D
JRST .-3
HRRI N,2(T)
POPJ P,
LD2: SKIPN RESET
JRST LD2Q-2
CAMN B,F.C+B
CAME S,F.C+S
CAIA
JRST .+4
MOVEI T,[ASCIZ /
CANNOT RECOVER/]
CALLI T,CDDTOUT
CALLI CEXIT
MOVE T,.NAME; REMOVE NAME
HRRZ T,2(T)
MOVEM T,.NAME
MOVEI T,1(S)
ADDI S,2
PUSH B,1(T)
PUSH B,2(T)
AOSA ERRFLG#
PUSHJ P,LDF
LD2Q: MOVSI T,F.C
BLT T,B
>
IFN HE,<
GETF: MOVE P,SAVP; RESTORE SUBR POINTER
SKIPN RESET
JRST GETF4
SETZM RESET; RECOVERABLE ERROR
PUSHJ P,ILDX; CHECK FOR ANOTHER COPY
JRST GETF4; NO
MOVEI T,[ASCIZ /_
/]
CALLI T,CDDTOUT
JRST LD2Q-1
GETF4: TLNE F,LIBSW
JRST GETFY+1; LIBRARY MODE - CONTINUE
PUSHJ P,.GETF; GET NEXT FILE
SETZM 13
LSHC 13,6
CAIE 13,"/"
JRST GETF1
ROT 14,6; FIRST CHAR SLASH - DECODE SWITCH
CAIN 14,"D"
JRST .DDT
CAIN 14,"S"
JRST [ TLO F,SYMSW
JRST GETF4+2]
CAIN 14,"W"
JRST [ TLZ F,SYMSW+DSYMSW
JRST GETF4+2]
CAIN 14,'C'
JRST GETF4+2; SAVE /C DECODING FOR LATER
JSP A,ERRPT8; UNKNOWN SWITCH - ERROR
SIXBIT /SYNTAX%/
JRST LD2
.DDT: MOVSI W,444464; LOAD DDT
MOVEM W,DTIN
MOVE W,[SIXBIT / 1 3/]
MOVEM W,DTIN2
JRST LD2Q-1
>
IFN HE,<
GETF1: LSHC 13,-6
JUMPE 14,GETF2; FILE NAME ZERO - FINISHED
OR 15,[XWD 600000,0]
SKIPN 13,.NAME#
JRST GETF3; NO FILES LOADED
CAMN 15,2(13); SEARCH FOR FILE NAME
JRST GETF4+1; FOUND - DO NOT LOAD
HRRZ 13,1(13)
JUMPN 13,.-3
GETF3: MOVEM 15,..NAME#
MOVEM 14,DTIN; SET UP ENTER BLOCK
MOVEM 16,DTIN2
JRST LD2Q-1
GETF2: MOVEI W,3; END OF FILES - SEARCH LIBRARIES
MOVEM W,CNT#
SKIPA
GETFY: TLZ F,SYMSW+DSYMSW; TURN OFF LOCAL SYMBOLS AFTER HELIB
JUMPGE S,GETF11
TLO F,LIBSW+SKIPSW
MOVE W,[SIXBIT / 1 3/]
MOVEM W,DTIN2
SOSGE W,CNT
JRST GETF11
MOVE W,.TAB(W)
MOVEM W,DTIN
JRST LD2Q-1
.TAB: SIXBIT /JOBDAT/
SIXBIT /LIB40/
SIXBIT /HELIB/
GETF11: PUSHJ P,SAS1; TERMINATE LOADING
RELEASE 1,
PUSHJ P,BLTSET
IFN FAILSW,<
MOVE R,[XWD LINKTB,LNKSAV]
BLT R,LNKSAV+20>; SAVE LINK TABLE
MOVE R,JOBDDT
CALLI R,CSETDDT
HLRE 16,S
MOVMS 16
LSH 16,-1; RIGHT HALF AC16 IS # UNDEF SYMBS
HRL 16,ERRFLG
POPJ P,
>
IFE HE,<
;MONITOR LOADER CONTROL
BEG:
IFE L,<
LD: IFN RPGSW,<SKIPA ;NORMAL INITIALIZE
JRST RPGSET ;SPECIAL INIT>
HLLZS 42 ;GET RID OF ERROR COUNT IF NOT IN RPG MODE
CALLI 0 ;INITIALIZE THIS JOB
NUTS: MOVSI R,F.I ;SET UP INITIAL ACCUMULATORS
BLT R,R
>
IFN L,<
LD: HRRZM 0,LSPXIT# ;RETURN ADDRESS FOR LISP
MOVEI 0,0
HRRZM R,RINITL#
CALLI 0
>
CTLSET: INIT 3,1 ;INITIALIZE CONSOLE
SIXBIT /TTY/
XWD BUFO,BUFI
CALLEX: CALLI CEXIT ;DEVICE ERROR, FATAL TO JOB
MOVEI E,TTY1
MOVEM E,JOBFF
INBUF 3,1
OUTBUF 3,1 ;INITIALIZE OUTPUT BUFFERS
OUTPUT 3, ;DO INITIAL REDUNDANT OUTPUT
IFE L,< HRRZ B,JOBREL ;PICK UP CORE BOUND
SKIPE JOBDDT ;DOES DDT EXIST?
HRRZ B,JOBSYM ;USED BOTTOM OF SYMBOL TABLE INSTEAD
>
IFN L,< MOVE B,JOBSYM>
SUB B,SE3 ;INITIALIZE SYMBOL TABLE POINTER
CAILE H,1(B) ;TEST CORE ALLOCATION
CALLI CEXIT ;INSUFFICIENT CORE, FATAL TO JOB
IFE L,< MOVS E,X ;SET UP BLT POINTER
HRRI E,1(X)>
IFN L,< MOVS E,H
HRRI E,1(H)>
SETZM -1(E) ;ZERO FIRST WORD
BLT E,(B) ;ZERO CORE UP TO THE SYMBOL AREA
HRRZ S,B ;INITIALIZE UNDEF. POINTER
HRR N,B ;INITIALIZE PROGRAM NAME POINTER
IFE L,<HRRI R,JOBPRO ;INITIALIZE THE LOAD ORIGIN>
MOVE E,COMM ;SET .COMM. AS THE FIRST PROGRAM
MOVEM E,1(B) ;STORE IN SYMBOL TABLE
HRRZM R,2(B) ;STORE COMMON ORIGIN
>
IFN HE,<BEG:>
MOVEI E,F.C ;INITIALIZE STATE OF THE LOADER
BLT E,B.C
SETZM MDG ;MULTIPLY DEFINED GLOBAL COUNT
IFE HE,<
IFN FAILSW,< SETZM LINKTB ;ZERO OUT TE LINK TABLE
MOVE W,[XWD LINKTB,LINKTB+1]
BLT W,LINKTB+20 ;BEFORE STARTING>
IFE L,< MOVSI W,254200 ;STORE HALT IN JOB41
MOVEM W,JOB41(X)> ;...
IFN L,< MOVE W,JOBREL
HRRZM W,OLDJR#>>
IFN HE,<IFN FAILSW,<
MOVE W,[XWD LNKSAV,LINKTB]
BLT W,LINKTB+20
>>
IFN STANSW,<SETZM CURNAM#>
IFN FAILSW,< MOVEI W,440000 ;SET UP THE SPECIAL BITS OF HEADNUM (ADD+POLISH)
MOVEM W,HEADNM#
SETZM POLSW# ;SWITCH SAYS WE ARE DOING POLISH
MOVEI W,PDLOV ;ENABLE FOR PDL OV
MOVEM W,JOBAPR
MOVEI W,200000
CALLI W,16
EXTERNAL JOBAPR >
IFN LDAC!BLTSYM,<MOVEI W,20 ;SET UP SPACE TO SAVE FOR ACS AND
MOVEM W,KORSP# ;USER DEFINITIONS WITH DDT>
IFN HE,<JRST LD2Q>
IFE HE,<
IFN RPGSW,<JRST LD2Q>
LD2: IFN RPGSW,<MOVSI B,RPGF ;HERE ON ERRORS, TURN OFF RPG
ANDCAM B,F.C+N ;IN CORE>
;LOADER SCAN FOR FILE NAMES
LD2Q: MOVSI B,F.C ;RESTORE ACCUMULATORS
BLT B,B
MOVE P,PDLPT ;INITIALIZE PUSHDOWN LIST
SETZM BUFI2 ;CLEAR INPUT BUFFER POINTER
IFE PP,< SETZM ILD1 ;CLEAR INPUT DEVICE NAME>
IFN PP,< MOVSI T,(SIXBIT /DSK/) ;ASSUME DSK
MOVEM T,ILD1
SETZM OLDDEV# ;TO MAKE IT GO BACK AFTER /D FOR LIBSR>
SETZM DTIN ;CLEAR INPUT FILE NAME
IFN PP,<SETZM PPN# ;CLEAR INPUT PROJ-PROG #>
LD2B: RELEAS 1, ;RELEASE BINARY INPUT DEVICE
IFN RPGSW,< TLNE N,RPGF ;NOT IF DOING RPG
JRST LD2BA>
MOVEI T,"*"
IDPB T,BUFO1 ;OUTPUT ASTERISK TO START INPUT
OUTPUT 3,
LD2BA: TLZ F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW
TLNE F,LIBSW ;WAS LIBRARY MODE ON?
TLO F,SKIPSW ;YES, NORMAL MODE IS SKIPPING
LD2D: IFN PP,<SETZM PPN ;DO NOT REMEMBER PPNS FOR NOW
LD2DB: SKIPE W,OLDDEV ;RESET DEVICE IF NEEDED
CAMN W,ILD1 ;IS IT SAME?
JRST LD2DA ;YES, FORGET IT
TLZ F,ISW+DSW+FSW+REWSW
MOVEM W,ILD1>
LD2DA:
IFN RPGSW,< SETZM DTIN1 ;CLEAR EXTENSION>
MOVEI W,0 ;INITIALIZE IDENTIFIER SCAN
MOVEI E,6 ;INITIALIZE CHARACTER COUNTER
MOVE V,LSTPT ;INITIALIZE BYTE POINTER TO W
TLZ F,SSW+DSW+FSW ;LEAVE SWITCH MODE
LD3: IFN RPGSW,<TLNE N,RPGF ;CHECK RPG FEATURE
JRST RPGRD>
SOSG BUFI2 ;DECREMENT CHARACTER COUNT
INPUT 3, ;FILL TTY BUFFER
ILDB T,BUFI1 ;LOAD T WITH NEXT CHARACTER
LD3AA: MOVE Q,T
IDIVI Q,11 ;TRANSLATE TO 4 BIT CODE
LDB Q,LD8(A) ;LOAD CLASSIFICATION CODE
CAIGE Q,4 ;MODIFY CODE IF .GE. 4
TLNN F,SSW ;MODIFY CODE IF SWITCH MODE OFF
ADDI Q,4 ;MODIFY CLASS. CODE FOR DISPATCH
HRRZ A,LD3A(Q) ;LOAD RH DISPATCH ENTRY
CAIL Q,10 ;SKIP IF CORRECT DISPATCH ENTRY
HLRZ A,LD3A-10(Q) ;LOAD LH DISPATCH ENTRY
JRST @A ;JUMP TO INDICATED LOCATION
;COMMAND DISPATCH TABLE
LD3A: XWD LD3,LD7B ;IGNORED CHAR, BAD CHAR (SWITCH)
XWD LD6A,LD6 ;</> OR <(>, LETTER (SWITCH)
XWD LD5,LD6C ;<:>, DIGIT (SWITCH ARG.)
XWD LD5A,LD6D ;<.>, ESCAPE SWITCH MODE <)>
XWD LD5C,LD7 ;<=> OR <L. ARROW>, BAD CHAR.
XWD LD5B,LD4 ;<,>, ALPHABETIC CHAR.
XWD LD5D,LD4 ;<CR.>, NUMERIC CHAR.
XWD LD5E1,LD7 ;<ALT MODE>, BAD CHAR. <)>
IFN RPGSW,<RPGRD: SOSG CTLIN+2 ;CHECK CHARACTER COUNT
JRST [IN 17,0
JRST .+1 ;OK
STATO 17,740000
JRST LD2
JSP A,ERRPT
SIXBIT /ERROR WHILE READING COMMAND FILE%/
JRST LD2]
IBP CTLIN+1 ;ADVANCE POINTER
MOVE T,@CTLIN+1 ;AND CHECK FOR LINE #
TRNE T,1
JRST [MOVNI T,5
ADDM T,CTLIN+2
AOS CTLIN+1
JRST RPGRD ];GO READ AGAIN
LDB T,CTLIN+1 ;GET CHR
JRST LD3AA ;PASS IT ON>
>
;ALPHANUMERIC CHARACTER, NORMAL MODE
IFE HE,<
LD4: SOJL E,LD3 ;JUMP IF NO SPACE FOR CHAR IN W
SUBI T,40 ;CONVERT FROM ASCII TO SIXBIT
IDPB T,V ;DEPOSIT CHAR OF IDENTIFIER IN W
TLO F,DSW ;SET IDENTIFIER FLAG
JRST LD3 ;RETURN FOR NEXT CHARACTER
;DEVICE IDENTIFIER DELIMITER <:>
LD5: PUSH P,W ;SAVE W
TLOE F,CSW ;TEST AND SET COLON FLAG
PUSHJ P,LDF ;FORCE LOADING
POP P,W ;RESTORE W
TLNE F,ESW ;TEST SYNTAX
JRST LD7A ;ERROR, MISSING COMMA ASSUMED
JUMPE W,LD2D ;JUMP IF NULL DEVICE IDENTIFIER
MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER
IFN PP,<MOVEM W,OLDDEV ;WE HAVE A NEW ONE SO IGNORE OLD>
TLZ F,ISW+DSW+FSW+REWSW ;CLEAR OLD DEVICE FLAGS
IFN PP,<SETZM PPN ;CLEAR OLD PP #>
JRST LD2D ;RETURN FOR NEXT IDENTIFIER
;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>
LD5A: TLOE F,ESW ;TEST AND SET EXTENSION FLAG
JRST LD7A ;ERROR, TOO MANY PERIODS
TLZE F,CSW+DSW ;SKIP IF NULL IDENT AND NO COLON
MOVEM W,DTIN ;STORE FILE IDENTIFIER
JRST LD2D ;RETURN FOR NEXT IDENTIFIER
;INPUT SPECIFICATION DELIMITER <,>
LD5B:
IFN PP,<TLZE N,PPCSW ;READING PP #?
JRST [
IFLE STANSW-UTAHSW,< HRLM D,PPN ;STORE PROJ #
JRST LD6A1] ;GET PROG #>
IFG STANSW-UTAHSW,< PUSHJ P,RJUST ;RIGHT JUSTIFY W
HRLM W,PPN ;STORE PROJ NAME
JRST LD2DB ];GET PROG NAME>
PUSHJ P,RBRA ;CHECK FOR MISSING RBRA>
TLZN F,FSW ;SKIP IF PREV. FORCED LOADING
PUSHJ P,FSCN2 ;LOAD (FSW NOT SET)
JRST LD2D ;RETURN FOR NEXT IDENTIFIER
LD5B1: TLNE F,ESW ;TEST EXTENSION FLAG
JRST LDDT3 ;EXPLICIT EXTENSION IDENTIFIER
TLZN F,CSW+DSW ;SKIP IF IDENT. OR COLON
POPJ P,
MOVEM W,DTIN ;STORE FILE IDENTIFIER
JRST LDDT2 ;ASSUME <.REL> IN DEFAULT CASE
>
;OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>
;OR PROJ-PROG # BRACKETS <[> AND <]>
IFE HE,<
LD5C:
IFN RPGSW,<CAIN T,"@" ;CHECK FOR * COMMAND
JRST RPGS1>
IFN PP,<CAIN T,"[" ;PROJ-PROG #?
JRST [TLO N,PPSW+PPCSW ;SET FLAGS
MOVEM W,PPNW# ;SAVE W
MOVEM E,PPNE# ;SAVE E
MOVEM V,PPNV# ;SAVE V
IFLE STANSW-UTAHSW,<JRST LD6A1-1] ;READ NUMBERS AS SWITCHES >
IFG STANSW-UTAHSW,< JRST LD2DB]>
CAIN T,"]" ;END OF PP #?
JRST [PUSHJ P,RBRA ;PROCESS RIGHT BRACKET
JRST LD3 ];READ NEXT IDENT>
TLOE F,ASW ;TEST AND SET LEFT ARROW FLAG
JRST LD7A ;ERROR, MISPLACED LEFT ARROW
PUSHJ P,LD5B1 ;STORE IDENTIFIER
TLZN F,ESW ;TEST EXTENSION FLAG
MOVSI W,554160 ;ASSUME <.MAP> IN DEFAULT CASE
MOVEM W,DTOUT1 ;STORE FILE EXTENSION IDENTIFIER
MOVE W,DTIN ;LOAD INPUT FILE IDENTIFIER
MOVEM W,DTOUT ;USE AS OUTPUT FILE IDENTIFIER
IFN PP,<MOVE W,PPN ;PROJ-PROG #
MOVEM W,DTOUT+3 ;...>
MOVE W,ILD1 ;LOAD INPUT DEVICE IDENTIFIER
MOVEM W,LD5C1 ;USE AS OUTPUT DEVICE IDENTIFIER
IFN PP,< SKIPE W,OLDDEV ;RESTORE OLD
MOVEM W,ILD1>
;INITIALIZE AUXILIARY OUTPUT DEVICE
TLZE N,AUXSWI+AUXSWE ;FLUSH CURRENT DEVICE
RELEASE 2, ;...
CALL W,[SIXBIT ?DEVCHR?] ;IS DEVICE A TTY?
TLNE W,10 ;...
JRST LD2D ;YES, SKIP INIT
INIT 2,1 ;INIT THE AUXILIARY DEVICE
LD5C1: 0 ;AUXILIARY OUTPUT DEVICE NAME
XWD ABUF,0 ;BUFFER HEADER
JSP A,ILD5 ;ERROR RETURN
TLNE F,REWSW ;REWIND REQUESTED?
CALL 2,[SIXBIT /UTPCLR/] ;DECTAPE REWIND
TLZE F,REWSW ;SKIP IF NO REWIND REQUESTED
MTAPE 2,1 ;REWIND THE AUX DEV
MOVEI E,AUX ;SET BUFFER ORIGIN
MOVEM E,JOBFF
OUTBUF 2,1 ;INITIALIZE SINGLE BUFFER
TLO N,AUXSWI ;SET INITIALIZED FLAG
JRST LD2D ;RETURN TO CONTINUE SCAN
>
IFE HE,<
;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
IFN PP,<
RBRA: TLZN N,PPSW ;READING PP #?
POPJ P, ;NOPE, RETURN
TLZE N,PPCSW ;COMMA SEEN?
JRST LD7A ;NOPE, INDICATE ERROR
IFLE STANSW-UTAHSW,<HRRM D,PPN ;STASH PROG NUMBER>
IFG STANSW-UTAHSW,<PUSHJ P,RJUST ;RIGHT JUSTIFY W
HRRM W,PPN ;STASH PROG NAME>
MOVE W,PPNW# ;PICKUP OLD IDENT
MOVE E,PPNE# ;RESTORE CHAR COUNT
MOVE V,PPNV# ;RESTORE BYTE PNTR
POPJ P, ;TRA 1,4
;RIGHT JUSTIFY W
RJUST: JUMPE W,LD7A ;NOTHING TO RIGHT JUSTIFY
TRNE W,77 ;IS W RJUSTED YET?
POPJ P, ;YES, TRA 1,4
LSH W,-6 ;NOPE, TRY AGAIN
JRST .-3 ;...>
>
IFE HE,<
;LINE TERMINATION <CARRIAGE RETURN>
LD5D:
IFN PP,<PUSHJ P,RBRA ;CHECK FOR UNTERMINATED PP #>
PUSHJ P,FSCN ;FORCE SCAN TO COMPLETION
JRST LD2B ;RETURN FOR NEXT LINE
;TERMINATE LOADING <ALT MODE>
LD5E: SKIPE D ;ENTER FROM G COMMAND
HRR F,D ;USE NUMERIC STARTING ADDRESS
LD5E1:
PUSHJ P,CRLF ;START A NEW LINE
PUSHJ P,SASYM ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
IFN LDAC!BLTSYM,<HRRZ A,R ;SET UP BLT OF ACS
ADDI A,(X) ;END
ADD A,KORSP ;ADD IN SPACE RESERVED
CAIL A,(S)
IFN EXPAND,<JRST [PUSHJ P,XPAND>
PUSHJ P,[
IFE EXPAND,< JSP A,ERRPT
SIXBIT /MORE CORE NEEDED#/>
CALLI CEXIT]
IFN EXPAND,< JRST .-1]>
HRRM R,BOTACS# ;SAVE FOR LATER
HRRZ A,R ;SET BLT
ADD A,X
HRL A,X
MOVE Q,A
BLT A,17(Q)>
IFN BLTSYM,<HRRZ A,R ;PLACE TO BLT TO
ADD A,KORSP
MOVE W,A ;SAVE DEST
ADDI A,(X) ;AFTER ADJUSTMENT
MOVE Q,S ;UDEF PNTR
ADD Q,B ;TOTAL UNDEFS AND DEFS IN LEFT
HLROS Q ;NOW NEG IN RIGHT
MOVNS Q ;POSITIVE
ADDI Q,-1(A) ;END OF BLT
HRLI A,1(S) ;AND GET PLACE TO BLT FROM
SUBI W,1(S) ;PREST LOC OF SYMBOL TABLE
ADDM W,JOBSYM(X)
ADDM W,JOBUSY(X) ;ADJUST POINTERS
BLT A,(Q) ;MOVE IT
SKIPN JOBDDT(X) ;IS DDT THERE?
JRST NODDT
SUBI Q,-1(X)
HRRM Q,JOBFF(X) ;RESTET JOBFF IF DDT IS IN
HRLM Q,JOBSA(X)
NODDT:>
MOVE W,[SIXBIT ?LOADER?] ;FINAL MESSAGE
PUSHJ P,BLTSET ;SETUP FOR FINAL BLT
RELEASE 2, ;RELEASE AUX. DEV.
IFN RPGSW,<RELEASE 17,0 ;RELEASE COMMAND DEVICE>
IFE L,<
IFN STANSW,<MOVE W,JOBREL ;IN CASE NO NAME SET
MOVE W,-1(W) ;USE FIRRST LOADED
SKIPN CURNAM
PUSHJ P,LDNAM
MOVE W,CURNAM
JRST LD5E4>>
IFN L,< JRST @LSPXIT>
LD5E5: MOVE W,[BLT Q,(A)] ;BLT OF ALL CODE
MOVEM W,JOBBLT ;STASH IN JOB DATA AREA
MOVEM W,JOBBLT(X) ;STASH IN RELOCATED JOBDATA AREA
LD5E2: MOVE W,CALLEX ;EXIT AFTER BLT
TLZN N,EXEQSW ;IMMEDIATE EXECUTION REQUESTED?
JRST LD5E3 ;NOPE, LET USER TYPE START HIMSELF
HRRZ W,JOBSA(X) ;PICKUP USUAL STARTING ADDRESS
TLNE N,DDSW ;DDT EXECUTION?
HRRZ W,JOBDDT(X) ;USE DDT SA INSTEAD
JUMPE W,LD5E2 ;IF SA=0, DON'T EXECUTE
HRLI W,(JRST) ;INSTRUCTION TO EXECUTE
LD5E3:
IFE LDAC,<MOVEM W,JOBBLT+1(X) ;STASH FOR EXECUTION>
IFN LDAC,<MOVEM W,JOBBLT+2(X) ;STASH FOR EXECUTION
HRLZ 17,JOBFF(X) ;BUT FIRST BLT ACS
MOVE W,[BLT 17,17] ;...
MOVEM W,JOBBLT+1(X) ;...>
JRST JOBBLT ;IF IT WERE DONE, 'TWERE BEST DONE QUICKLY
IFE L,<
IFN STANSW,<LSH W,6 ;LEFT JUSTIFY
LD5E4: TLNN W,770000 ;IS IT LEFT JUSTIFIED?
JRST .-2
CALL W,[SIXBIT /SETNAM/]
JRST LD5E5>>
>
IFE HE, <
;SEARCH LIBRARY, PRINT UNDEFS, SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
SASYM: TLNN F,NSW ;SKIP IF NO SEARCH FLAG ON
PUSHJ P,LIBF ;SEARCH LIBRARY FILE
PUSHJ P,FSCN ;FORCE SCAN TO COMPLETION
PUSHJ P,PMS ;PRINT UNDEFINEDS
IFE L,< HRRZM F,JOBSA(X) ;RH OF JOBSA :=STARTING ADDRESS>
>
SAS1: HRRZ A,H ;COMPUTE PROG BREAK
SUBI A,(X) ;...
CAIGE A,(R) ;BUT NO HIGHER THAN RELOC
HRRZ A,R ;...
IFE L,< HRLM A,JOBSA(X) ;LH OR JOBSA IS PROG BREAK
HRRZM A,JOBFF(X) ;RH OF JOBFF CONTAINS PROG BREAK>
MOVE A,B ;SET JOBSYM W/ SYMBOL TABLE POINTER
AOS A ;...
IFE L,< MOVEM A,JOBSYM(X) ;...>
IFN L,< MOVEM A,JOBSYM>
MOVE A,S ;SET JOBUSY W/ UNDEFINED SYMBOL POINTER
AOS A ;...
IFE L,< MOVEM A,JOBUSY(X) ;...>
IFN L,< MOVEM A,JOBUSY>
POPJ P, ;RETURN
IFE HE,<
;PRINT FINAL MESSAGE, SET UP BLT AC'S, SETDDT, RELEAS
BLTSET: PUSHJ P,FCRLF ;START FINAL MESSAGE
PUSHJ P,PWORD ;PRINT W
PUSHJ P,SPACE
>
IFN HE,<
BLTSET:>
IFN FAILSW< MOVSI Q,-20 ;SET TO FIX UP LINKS
FXEND: HLRZ V,LINKTB+1(Q) ;GET END LINK INFO
JUMPE V,NOEND ;DO NOT LINK THIS ONE
HRRZ A,LINKTB+1(Q) ;GET THE THING TO PUT THERE
IFN L,< CAML V,RINITL>
HRRM A,@X ;PUT IT IN
NOEND: AOBJN Q,FXEND ;FINISH UP>
IFN HE,<POPJ P,>
IFE HE,<
HRRZ Q,JOBREL ;PUBLISH HOW MUCH CORE USED
IFN L,< SUB Q,OLDJR ;OLD JOBREL>
LSH Q,-12 ;...
ADDI Q,1 ;...
PUSHJ P,RCNUM ;PUBLISH THE NUMBER
MOVE W,[SIXBIT /K CORE/] ;PUBLISH THE UNITS
PUSHJ P,PWORD ;...
PUSHJ P,CRLF ;...
IFE L,< MOVSI Q,20(X) ;HOW MUCH CODE TO BLT
HRRI Q,20 ;...
HRRZ A,42 ;CHECK ON ERRORS
JUMPE A,NOEX ;NONE, GO AHEAD
TLZN N,EXEQSW ;DID HE WANT TO START EXECUTION?
JRST NOEX ;NO
JSP A ,ERRPT ;PRINT AN ERROR MESSAGE
SIXBIT /EXECUTION DELETED@/
NOEX: HRRZ A,JOBREL ;WHEN TO STOP BLT
HRRZM A,JOBREL(X) ;SETUP FOR POSSIBLE IMMED. XEQ
SUBI A,(X) ;...
IFE BLTSYM,<CAIL A,(S) ;DON'T BLT OVER SYMBOL TABLE
MOVEI A,(S) ;OR UNDEFINED TABLE>
>
RELEAS 1, ;RELEASE DEVICES
RELEAS 3, ;...
IFE L,< MOVE R,JOBDDT(X) ;SET NEW DDT
CALLI R,CSETDDT ;...>
POPJ P, ;RETURN
>
IFE HE,<
;WRITE CHAIN FILES
CHNC: SKIPA A,JOBCHN(X) ;CHAIN FROM BREAK OF FIRST BLOCK DATA
CHNR: HLR A,JOBCHN(X) ;CHAIN FROM BREAK OF FIRST F4 PROG
HRRZS A ;ONLY RIGHT HALF IS SIGNIFICANT
JUMPE A,LD7C ;DON'T CHAIN IF ZERO
TLNN N,AUXSWI ;IS THERE AN AUX DEV?
JRST LD7D ;NO, DON'T CHAIN
PUSH P,A ;SAVE WHEREFROM TO CHAIN
SKIPE D ;STARTING ADDR SPECIFIED?
HRR F,D ;USE IT
PUSHJ P,SASYM ;DO LIB SEARCH, SETUP JOBSA, ETC.
POP P,A ;GET WHEREFROM
MOVN W,JOBREL ;CALCULATE IOWD FOR DUMP
ADDI W,-1-3-CHN5(A) ;...
HRLI W,-4-CHN5(A) ;...
MOVSM W,IOWDPP ;...
ADDI A,-4-CHN5(X) ;ADD IN OFFSET
IFN CHN5,<PUSH A,JOBSYM(X) ;SETUP FOUR WORD TABLE
PUSH A,JOB41(X) ;...>
PUSH A,JOBDDT(X) ;JOBDDT IN ALL CASES
IFE CHN5,<PUSH A,JOBSYM(X) ;JOBDDT, JOBSYM, JOBSA>
PUSH A,JOBSA(X) ;JOBRYM ALWAYS LAST
CLOSE 2, ;INSURE END OF MAP FILE
SETSTS 2,17 ;SET AUX DEV TO DUMP MODE
MOVSI W,435056 ;USE .CHN AS EXTENSION
MOVEM W,DTOUT1 ;...
PUSHJ P,IAD2 ;DO THE ENTER
TLZ N,AUXSWI+AUXSWE ;INSURE NO PRINTED OUTPUT
MOVE W,[SIXBIT ?CHAIN?] ;FINAL MESSAGE
PUSHJ P,BLTSET ;SETUP BLT PNTR, SETDDT, RELEAS
IFE STANSW,<CALLI CDDTGT ;START DDT MODE OUTPUT>
MOVSI CHNBLT,CHAIN3 ;BLT CHAIN3 INTO ACS
BLT CHNBLT,CHNBLT ;...
MOVEI P,CHNERR ;POINTER TO ERR MESS
JRST 0 ;GO DO CHAIN
>
IFE HE, <
;THE AC SECTION OF CHAIN
CHAIN3:
PHASE 0
BLT Q,(A) ;USUAL LDRBLT
OUTPUT 2,IOWDP ;WRITE THE CHAIN FILE
STATZ 2,IOBAD!IODEND ;CHECK FOR ERROR OR EOF
JRST LOSEBIG ;FOUND SAME, GO GRIPE
CLOSE 2, ;FINISH OUTPUT
STATZ 2,IOBAD!IODEND ;CHECK FOR FINAL ERROR
LOSEBI: CALLI CDDTOUT ;GRIPE ABOUT ERROR
CALLI CEXIT ;EXIT
CHNERR: ASCIZ ?DEVICE ERROR? ;ERROR MESSAGE
IOWDP: Z ;STORE IOWD FOR DUMP HERE
CHNBLT: ;LAST WORD OF AC CHAIN (ZERO OF I/O POINTER)
DEPHASE
IOWDPP=.-1 ;MEMORY LOC OF AC IOWDP
Z ;TERMINATOR OF DUMP MODE LIST
>
;EXPAND CORE
IFN EXPAND,<
XPAND: PUSH P,H ;GET SOME REGISTERS TO USE
PUSH P,X
PUSH P,N
IFE HE,<HRRZ X,JOBREL ;WHAT WE WANT
ADDI X,2000
CALLI X,11>
IFN HE,<JRST XPAND4; HAND - EYE CORE FIXUP LATER
JRST XPAND3
XPAND2: >; CORE ALLOCATOR CALLS THIS
JRST XPAND6
IFE K,< HRRZ H,MLTP ;GET LOWEST LOCATION
TLNN N,F4SW ;IS FORTRAN LOADING>
HRRZ H,S ;NO, USE S
IFE HE,<
HRRZ X,JOBREL ;NOW MOVE
SUBI X,2000
XPAND2: MOVE N,(X)
MOVEM N,2000(X)
CAMLE X,H ;TEST FOR END
SOJA X,XPAND2>; HAND EYE SYSTEM MOVES TABLE
HRLI H,-2000
SETZM (H) ;ZERO NEW CORE
AOBJN H,.-1
MOVEI H,2000
ADDM H,S
ADDM H,B
ADDM H,JOBSYM
POP P,N
ADDI N,2000
IFE K,< TLNN N,F4SW ;F4?
JRST XPAND3
ADDM H,PLTP
ADDM H,BITP
ADDM H,SDSTP
ADDM H,MLTP
TLNE N,SYDAT
ADDM H,V>
IFN HE,<POPJ P,>
XPAND3:
POP P,X
POP P,H
AOS (P)
POPJ P,
XPAND6: JUMPE X,XPAND4
JSP A,ERRPT
IFE STANSW,<SIXBIT /CORE AVAILABLE, BUT NOT TO YOU#/>
IFN STANSW,<SIXBIT /YOU HAVE BEEN FUCKED BY THE SHIT-EATING SYSTEM#/
JRST XPAND5>
XPAND4: JSP A,ERRPT
SIXBIT /MORE CORE NEEDED#/
XPAND5: POP P,N
POP P,X
POP P,H
POPJ P,
XPAND7: PUSHJ P,XPAND
JRST SFULLC
JRST POPJM2
POPJM3: SOS (P) ;POPJ TO CALL-2
POPJM2: SOS (P) ;POPJ TO CALL-1
SOS (P) ;SAME AS POPJ TO
POPJ P, ;NORMAL POPJ MINUS TWO
>
IFE HE,<
;ENTER SWITCH MODE
LD6A: CAIN T,57 ;WAS CHAR A SLASH?
TLO N,SLASH ;REMEBER THAT
TLO F,SSW ;ENTER SWITCH MODE
LD6A1: MOVEI D,0 ;ZERO THE NUBER REGISTER
JRST LD3 ;EAT A SWITCH
;ALPHABETIC CHARACTER, SWITCH MODE
LD6: XCT LD6B-101(T) ;EXECUTE SWITCH FUNCTION
TLZE N,SLASH ;SWITCH MODE ENTERED W/ SLASH?
JRST LD6D ;LEAVE SWITCH MODE
JRST LD6A1 ;STAY IN SWITCH MODE
;DISPATCH TABLE FOR SWITCHES
; THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED
LD6B: TLO N,ALLFLG ;A - LIST ALL GLOBALS
JRST LD7B ;B - ERROR
PUSHJ P,CHNC ;C - CHAIN, START W/ COMMON
PUSHJ P,LDDT ;D - DEBUG OPTION, LOAD DDT
TLO N,EXEQSW ;E - LOAD AND GO
PUSHJ P,LIBF ;F - LIBRARY SEARCH
PUSHJ P,LD5E ;G - GO INTO EXECUTION
PUSHJ P,LRAIDX ;H - LOAD AN START RAID
TLO N,ISAFLG ;I - IGNORE STARTING ADDRESSES
TLZ N,ISAFLG ;J - USE STARTING ADDRESSES
IFE BLTSYM,<JRST LD7B ;K - ERROR>
IFN BLTSYM,<PUSHJ P,KORADJ ;K - RESERVE SPACE FOR SYM DEFS>
TLO F,LIBSW+SKIPSW ;L - ENTER LIBRARY SEARCH
PUSHJ P,PRMAP ;M - PRINT STORAGE MAP
TLZ F,LIBSW+SKIPSW ;N - LEAVE LIBRARY SEARCH
HRR R,D ;O - NEW PROGRAM ORIGIN
TLO F,NSW ;P - PREVENT AUTO. LIB. SEARCH
TLZ F,NSW ;Q - ALLOW AUTO. LIB. SEARCH
PUSHJ P,CHNR ;R - CHAIN, START W/ RESIDENT
TLO F,SYMSW ;S - LOAD WITH SYMBOLS
PUSHJ P,LDDTX ;T - LOAD AND GO TO DDT
PUSHJ P,PMS ;U - PRINT UNDEFINED LIST
PUSHJ P,LRAID ;V - LOAD RAID
TLZ F,SYMSW+DSYMSW ;W - LOAD WITHOUT SYMBOLS
TLZ N,ALLFLG ;X - DO NOT LIST ALL GLOBALS
TLO F,REWSW ;Y - REWIND BEFORE USE
JRST LD ;Z - RESTART LOADER
>
IFE HE, <
;SWITCH MODE NUMERIC ARGUMENT
LD6C: LSH D,3 ;BUILD OCTAL NUMERIC ARGUMENT
ADDI D,-60(T)
JRST LD3
;EXIT FROM SWITCH MODE
LD6D: TLZ F,SSW ;CLEAR SWITCH MODE FLAG
TLNE F,FSW ;TEST FORCED SCAN FLAG
JRST LD2D ;SCAN FORCED, START NEW IDENT.
JRST LD3 ;SCAN NOT FORCED, USE PREV IDENT
;ILLEGAL CHARACTER, NORMAL MODE
LD7: JSP A,ERRPT8
SIXBIT /CHAR.%/
JRST LD2
;SYNTAX ERROR, NORMAL MODE
LD7A: JSP A,ERRPT8
SIXBIT /SYNTAX%/
JRST LD2
;ILLEGAL CHARACTER, SWITCH MODE
LD7B: JSP A,ERRPT8
SIXBIT /SWITCH%/
JRST LD2
;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0
LD7C: JSP A,ERRPT ;GRIPE
SIXBIT ?UNCHAINABLE AS LOADED@?
JRST LD2
;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE
LD7D: JSP A,ERRPT ;GRIPE
SIXBIT ?NO CHAIN DEVICE@?
JRST LD2
>
IFN BLTSYM,<KORADJ: CAMLE D,KORSP ;IF SMALLER IGNORE
MOVEM D,KORSP
POPJ P,>
IFE HE, <
;CHARACTER CLASSIFICATION TABLE DESCRIPTION:
; EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE
; PACKED IN THE CHARACTER CLASSIFICATION TABLE. THE CHARACTER
; CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE
; DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS.
; CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND
; THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS. FOUR CODES
; ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS
; IN EFFECT.
;CLASSIFICATION BYTE CODES:
; BYTE DISP CLASSIFICATION
; 00 - 00 ILLEGAL CHARACTER, SWITCH MODE
; 01 - 01 ALPHABETIC CHARACTER, SWITCH MODE
; 02 - 02 NUMERIC CHARACTER, SWITCH MODE
; 03 - 03 SWITCH MODE ESCAPE, SWITCH MODE
; 00 - 04 ILLEGAL CHARACTER, NORMAL MODE
; 01 - 05 ALPHABETIC CHARACTER, NORMAL MODE
; 02 - 06 NUMERIC CHARACTER, NORMAL MODE
; 03 - 07 SWITCH MODE ESCAPE, NORMAL MODE
; 04 - 10 IGNORED CHARACTER
; 05 - 11 ENTER SWITCH MODE CHARACTER
; 06 - 12 DEVICE IDENTIFIER DELIMITER
; 07 - 13 FILE EXTENSION DELIMITER
; 10 - 14 OUTPUT SPECIFICATION DELIMITER
; 11 - 15 INPUT SPECIFICATION DELIMITER
; 12 - 16 LINE TERMINATION
; 13 - 17 JOB TERMINATION
>
IFE HE, <
;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE
LD8: POINT 4,LD9(Q),3
POINT 4,LD9(Q),7
POINT 4,LD9(Q),11
POINT 4,LD9(Q),15
POINT 4,LD9(Q),19
POINT 4,LD9(Q),23
POINT 4,LD9(Q),27
POINT 4,LD9(Q),31
POINT 4,LD9(Q),35
;CHARACTER CLASSIFIACTION TABLE
LD9: BYTE (4)4,0,0,0,0,0,0,0,0
BYTE (4)4,4,4,4,12,0,0,0,0
BYTE (4)0,0,0,0,0,0,0,0,0
BYTE (4)13,0,0,0,0,4,0,4,0
BYTE (4)0,0,0,0,5,3,0,0,11
BYTE (4)0,7,5,2,2,2,2,2,2
BYTE (4)2,2,2,2,6,0,0,10,0
IFE RPGSW,< BYTE (4)0,0,1,1,1,1,1,1,1>
IFN RPGSW,< BYTE (4) 0,10,1,1,1,1,1,1,1>
BYTE (4)1,1,1,1,1,1,1,1,1
BYTE (4)1,1,1,1,1,1,1,1,1
IFE PP,<BYTE (4)1,0,0,0,0,10,0,0,0>
IFN PP,<BYTE (4)1,10,0,10,0,10,0,0,0>
BYTE (4)0,0,0,0,0,0,0,0,0
BYTE (4)0,0,0,0,0,0,0,0,0
BYTE (4)0,0,0,0,0,0,0,0,13
BYTE (4)13,4
>
IFE HE, <
;INITIALIZE LOADING OF A FILE
ILD: MOVEI W,BUF1 ;LOAD BUFFER ORIGIN
MOVEM W,JOBFF
TLOE F,ISW ;SKIP IF INIT REQUIRED
JRST ILD6 ;DONT DO INIT
INIT 1,14
ILD1: 0 ;LOADER INPUT DEVICE
XWD 0,BUFR
JSP A,ILD5 ;ERROR RETURN
ILD6: TLZE F,REWSW ;SKIP IF NO REWIND
MTAPE 1,1 ;REWIND
ILD2: LOOKUP 1,DTIN ;LOOK UP FILE FROM DIRECTORY
JRST ILD3 ;FILE NOT IN DIRECTORY
IFE K,< INBUF 1,2 ;SET UP BUFFERS>
IFN K,< INBUF 1,1 ;SET UP BUFFER>
TLO F,ASW ;SET LEFT ARROW ILLEGAL FLAG
TLZ F,ESW+F4LIB ;CLEAR EXTENSION FLAG
POPJ P,
; LOOKUP FAILURE
ILD3: TLOE F,ESW ;SKIP IF .REL WAS ASSUMED
JRST ILD4 ;FATAL LOOKUP FAILURE
SETZM DTIN1 ;ZERO FILE EXTENSION
JRST ILD2 ;TRY AGAIN WITH NULL EXTENSION
ILD4: TLZE F,F4LIB ;WAS THIS A TRY FOR F40 LIBRARY?
JRST [MOVE W,[SIXBIT /LIB4/]; YES, TRY LIB4
MOVEM W,DTIN ;...
PUSHJ P,LDDT2 ;USE .REL EXTENSION
TLZ F,ESW ;...
JRST ILD2 ];GO TRY AGAIN
>
ILD9: JSP A,ERRPT
SIXBIT /CANNOT FIND#/
JRST LD2
; DEVICE SELECTION ERROR
ILD5: MOVE W,-3(A) ;LOAD DEVICE NAME FROM INIT
TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,PRQ ;START W/ ?
PUSHJ P,PWORD ;PRINT DEVICE NAME
JSP A,ERRPT7
SIXBIT /UNAVAILABLE@/
JRST LD2
IFE HE, <
;LIBRARY SEARCH CONTROL AND LOADER CONTROL
;LIBF ENABLES A LIBRARY SEARCH OF <SYS:LIB4.REL>
LIBF: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
PUSHJ P,LIBF1 ;LOAD SYS:JOBDAT.REL
TLO F,F4LIB ;INDICATE FORTRAN LIBRARY SEARCH
MOVE W,[SIXBIT /LIB40/] ;FIRST TRY AT NAME
PUSHJ P,LIBF2 ;LOAD SYS:LIB40.REL
LIBF1: MOVE W,[SIXBIT /JOBDAT/] ;LOAD SYS:JOBDAT.REL
LIBF2: PUSHJ P,LDDT1
JUMPGE S,EOF2 ;JUMP IF NO UNDEFINED GLOBALS
TLO F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH
TLZ F,SYMSW+DSYMSW ;DISABLE LOADING WITH SYMBOLS
JRST LDF ;INITIALIZE LOADING LIB4
>; HAND - EYE DOES OWN LIB SETUP
; LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE
LIB: JUMPGE S,EOF1 ;JUMP IF NO UNDEFINED GLOBALS
TLO F,SKIPSW ;SET SKIPSW TO IGNORE MODE
JRST LOAD ;CONTINUE LIB. SEARCH
LIB1: CAIE A,4 ;TEST FOR ENTRY BLOCK
JRST LIB3 ;NOT AN ENTRY BLOCK, IGNORE IT
LIB2: PUSHJ P,RWORD ;READ ONE DATA WORD
MOVE C,W
TLO C,040000 ;SET CODE BITS FOR SEARCH
PUSHJ P,SREQ
TLZA F,SKIPSW ;REQUEST MATCHES ENTRY, LOAD
JRST LIB2 ;NOT FOUND
LIB3: PUSHJ P,RWORD ;READ AND IGNORE ONE DATA WORD
JRST LIB3 ;LOOP TO IGNORE INPUT
IFE HE,<
;LDDT LOADS <SYS:DDT.REL> AND SETS DSYMSW
LRAIDX: TLO N,DDSW!EXEQSW ;H - LOAD AND START RAID
LRAID: PUSHJ P,FSCN1 ;FORCE END OF SCAN
MOVE W,[SIXBIT /RAID/]
JRST LDDT0
LDDTX: TLO N,DDSW+EXEQSW ;T - LOAD AND GO TO DDT
LDDT: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
MOVSI W,444464 ;FILE IDENTIFIER <DDT>
LDDT0: PUSHJ P,LDDT1
PUSHJ P,LDF ;LOAD <SYS:DDT.REL>
TLO F,DSYMSW ;ENABLE LOADING WITH SYMBOLS
POPJ P,
LDDT1: MOVEM W,DTIN ;STORE FILE IDENTIFIER
IFN PP,<MOVE W,ILD1 ;SAVE OLD DEV
MOVEM W,OLDDEV>
MOVSI W,637163 ;DEVICE IDENTIFIER <SYS>
MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER
TLZ F,ISW+LIBSW+SKIPSW+REWSW ;CLEAR OLD FLAGS
LDDT2: MOVSI W,624554 ;EXTENSION IDENTIFIER <.REL>
LDDT3: MOVEM W,DTIN1 ;STORE EXTENSION IDENTIFIER
IFN PP,<MOVE W,PPN ;GET PROJ-PROG #
MOVEM W,DTIN+3>
POPJ P,
>; HAND - EYE DOES OWN DDT LOAD
;EOF TERMINATES LOADING OF A FILE
EOF: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER
EOF1: TLZ F,SLIBSW+SKIPSW ;CLEAR ONE FILE LIB. SEARCH FLAG
EOF2: POPJ P,
; FORCE SCAN TO COMPLETION, LOAD IF NECESSARY
FSCN: PUSHJ P,FSCN1 ;FORCED LOAD BEFORE TEST
TLNN F,FULLSW ;TEST FOR OVERLAP
POPJ P, ;NO OVERLAP, RETURN
MOVE W,H ;FETCH CORE SIZE REQUIRED
SUBI W,1(S) ; COMPUT DEFICIENCY
JUMPL W,EOF2 ;JUMP IF NO OVERLAP
TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,PRQ ;START WITH ?
PUSHJ P,PRNUM0 ;INFORM USER
JSP A,ERRPT7
SIXBIT /WORDS OF OVERLAP#/
JRST LD2 ;ERROR RETURN
FSCN1: IFE HE,<TLON F,FSW ;SKIP IF NOT FIRST CALL TO FSCN
TLNN F,CSW+DSW+ESW ;TEST SCAN FOR COMPLETION
>; HAND EYE DOES NOT WANT FORCED SCAN
POPJ P,
FSCN2: PUSHJ P,LD5B1 ;STORE FILE OR EXTENSION IDENT.
; LOADER CONTROL, NORMAL MODE
LDF: PUSHJ P,ILD ;INITIALIZE LOADING
;LOAD SUBROUTINE
LOAD: MOVEM P,PDSAV ;SAVE PUSHDOWN POINTER
IFN FAILSW,< SETZM LFTHSW ;RESET LOAD LEFT HALF FIXUP SW>
LOAD1: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER
LOAD1A: PUSHJ P,WORD ;INPUT BLOCK HEADER WORD
MOVNI E,400000(W) ;WORD COUNT - FROM RH OF HEADER
HLRZ A,W ;BLOCK TYPE - FROM LH OF HEADER
IFN FAILSW,< SKIPN POLSW ;ERROR IF STILL DOING POLISH>
CAILE A,DISPL*2+1 ;TEST BLOCK TYPE NUMBER
JRST LOAD4 ;ERROR, ILLEGAL BLOCK TYPE
TLNE F,SKIPSW ;BLOCK OK - TEST LOAD STATUS
JRST LIB1 ;RETURN TO LIB. SEARCH CONTROL
HRRZ T,LOAD2(A) ;LOAD RH DISPATCH ENTRY
CAILE A,DISPL ;SKIP IF CORRECT
HLRZ T,LOAD2-DISPL-1(A) ;LOAD LH DISPATCH ENTRY
TLNE F,FULLSW ;TEST CORE OVERLAP INDICATOR
SOJG A,HIGH0 ;IGNORE BLOCK IF NOT TYPE 1
JRST @T ;DISPATCH TO BLOCK SUBROUTINE
;DISPATCH TABLE - BLOCK TYPES
LOAD2: XWD NAME,LOAD1A
XWD START,PROG
XWD LOCD,SYM
IFE FAILSW,< XWD LOAD4A,LOAD4A
XWD LOAD4A,LIB3>
IFN FAILSW,< XWD POLFIX,LOAD4A
XWD LINK,LIB3>
LOAD3: XWD LOAD4A,HIGH
DISPL=LOAD3-LOAD2
;ERROR EXIT FOR BAD HEADER WORDS
LOAD4: IFE K,<
CAIN A,400 ;FORTRAN FOUR BLOCK
JRST F4LD>
IFN HE,<CAIE A,400
JRST LOAD4A
JSP 1,ERRPT
SIXBIT /FORTRAN#/
SETOM RESET
JRST LD2>
LOAD4A: JSP A,ERRPT ;INCORRECT HEADER WORD
SIXBIT /ILL. FORMAT#/
IFN HE,<SETOM RESET#>
JRST LD2
;LOAD PROGRAMS AND DATA (BLOCK TYPE 1)
PROG: HRRZ V,W ;LOAD BLOCK LENGTH
PUSHJ P,RWORD ;READ BLOCK ORIGIN
IFN HE,<SETZM SFLAG
CAIG W,140
CAIN W,JOBDDT
JRST PROG2
SETOM SFLAG
JSP A,ERRPT
SIXBIT /ADDRESS CONFLICT#/
PROG2:
>; HAND-EYE CANNOT HANDLE CODE BELOW 140
ADD V,W ;COMPUTE NEW PROG. BREAK
CAIG H,@X ;COMPARE WITH PREV. PROG. BREAK
MOVEI H,@X ;UPDATE PROGRAM BREAK
TLNE F,FULLSW
JRST FULLC ;NO ERROR MESSAGE
CAILE H,1(S) ; SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,< JRST [PUSHJ P,XPAND>
JRST FULLC
IFN EXPAND,< JRST .-1]>
MOVE V,W
PROG1: PUSHJ P,RWORD ;READ DATA WORD
IFN HE,<SKIPN SFLAG#>
IFN L,< CAML V,RINITL ;ABSOLUTE >
MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC
AOJA V,PROG1 ;ADD ONE TO LOADER LOC. COUNTER
;LOAD SYMBOLS (BLOCK TYPE 2)
SYM: PUSHJ P,PRWORD ;READ TWO DATA WORDS
PUSHJ P,SYMPT; PUT INTO TABLE
JRST SYM
; WFW SYMPT: JUMPL C,SYM3; JUMP IF GLOBAL REQUEST
SYMPT: TLNE C,200000 ;GLOBAL REQUEST? WFW
JUMPL C,SYM3 ;CHECK FOR 60 NOT JUST HIGH BIT WFW
TLNE C,100000
JRST SYM1A ;LOCAL SYMBOL
PUSHJ P,SREQ ;GLOBAL DEF., SEARCH FOR REQUEST
JRST SYM2 ;REQUEST MATCHES
PUSHJ P,SDEF ;SEARCH FOR MULTIPLE DEFINITIONS
JRST SYM1 ;MULTIPLY DEFINED GLOBAL
JRST SYM1B
; PROCESS MULTIPLY DEFINED GLOBAL
SYM1: CAMN W,2(A) ;COMPARE NEW AND OLD VALUE
POPJ P,;
AOS MDG ;COUNT MULTIPLY DEFINED GLOBALS
PUSHJ P,PRQ ;START W/ ?
PUSHJ P,PRNAM ;PRINT SYMBOL AND VALUE
MOVE W,2(A) ;LOAD OLD VALUE
PUSHJ P,PRNUM ;PRINT OLD VALUE
JSP A,ERRPT7 ;PRINT MESSAGE
SIXBIT /MUL. DEF. GLOBAL#/
POPJ P,; IGNORE MUL. DEF. GLOBAL SYM
; LOCAL SYMBOL
SYM1A: TLNN F,SYMSW+DSYMSW ;SKIP IF LOAD LOCALS SWITCH ON
POPJ P,; IGNORE LOCAL SYMBOLS
SYM1B: CAIL H,(S) ;STORE DEFINED SYMBOL
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
SYM1C: IFE K,<
TLNE N,F4SW; FORTRAN FOUR REQUIRES A BLT
PUSHJ P,MVDWN; OF THE TABLES>
MOVEI A,-2(S) ;LOAD A TO SAVE INST. AT SYM2
SYM1D: SUBI S,2; UPDATE UNDEFINED POINTER
POP B,2(A) ;MOVE UNDEFINED VALUE POINTER
POP B,1(A) ;MOVE UNDEFINED SYMBOL
MOVEM W,2(B) ;STORE VALUE
MOVEM C,1(B) ;STORE SYMBOL
POPJ P,;
; GLOBAL DEFINITION MATCHES REQUEST
SYM2: PUSH P,SYM2C ;NEXT MUST BE A SUBROUTINE FOR LATER. SET RETURN
SYM2B: MOVE V,2(A) ;LOAD REQUEST POINTER
PUSHJ P,REMSYM
JUMPL V,SYM2W ;ADDITIVE REQUEST? WFW
PUSHJ P,SYM4A ;REPLACE CHAIN WITH DEFINITION
;WFW PATCH TO LOOK FOR MORE THAN ONE REQUEST
SYM2W1: PUSHJ P,SREQ ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
JRST SYM2B ;FOUND MORE
MOVE A,SVA ;RESTORE A
;END OF PATCH WFW
SYM2C: POPJ P,SYM1D ;RETURN, SEE SYM2 FOR USE OF ADDRESS
SVA: 0 ;A TEMP CELL WFW
; REQUEST MATCHES GLOBAL DEFINITION
SYM2A: MOVE V,W ;LOAD POINTER TO CHAIN
MOVE W,2(A) ;LOAD VALUE
JUMPL V,FIXWP ;HANDLE ATTITIVE REQUEST WFW
JRST SYM4A; REPLACE CHAIN WITH DEFINITION
; PROCESS GLOBAL REQUEST
SYM3: TLNE C,040000; COMMON NAME
JRST SYM1B
TLC C,640000; PERMUTE BITS FROM 60 TO 04
PUSHJ P,SDEF ;SEARCH FOR GLOBAL DEFINITION
JRST SYM2A ;MATCHING GLOBAL DEFINITION
JUMPL W,SYM3X1 ;ADDITIVE FIXUP WFW
PUSHJ P,SREQ ;SEARCH FOR EXISTING REQUEST WFW
JRST SYM3A ;EXISTING REQUEST FOUND WFW
SYM3X1: TLNN W,100000 ;CHECK SYMBOL TABLE FIXUP
JRST SYM3X2 ;NO
MOVE V,1(B) ;MUST BE LAST SYMBOL DEFINED. GET SYMBOL
XOR V,W ;CHECK FOR IDENTITY
TDNE V,[XWD 77777,-1] ;BUT IGNORE HIGH 3 BITS
POPJ P, ;NOT SAME, ASSUME NOT LOADED LOCAL
HRRI W,2(B) ;GET LOCATION IN RIGHT HALF
TLO W,1
SUB W,JOBREL ;AND MAKE RELATIVE
IFN FAILSW,< TLZ W,40000>
SYM3X2: CAIL H,(S) ;STORE REQUEST IN UNDEF. TABLE WFW
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
SYM3X: IFE K,<
TLNE N,F4SW; FORTRAN FOUR
PUSHJ P,MVDWN; ADJUST TABLES IF F4>
SUB S,SE3 ;ADVANCE UNDEFINED POINTER
MOVEM W,2(S) ;STORE UNDEFINED VALUE POINTER
MOVEM C,1(S) ;STORE UNDEFINED SYMBOL
POPJ P,;
; COMBINE TWO REQUEST CHAINS
SYM3A: SKIPL 2(A) ;IS IT ADDITIVE WFW
JRST SYM3A1 ;NO, PROCESS WFW
PUSHJ P,SDEF2 ;YES, CONTINUE WFW
JRST SYM3A ;FOUND ANOTHER WFW
JRST SYM3X2 ;REALLY NO CHAIN THERE WFW
SYM3A1: SUBI A,-2(X) ;A=A-(-2+X(18-35)); A RELATIVE TO X WFW
SYM3B: HRRZ V,A ; SAVE CHAIN ADDRESS FOR HRRM W,@X
IFN L,< CAMGE V,RINITL
HALT ;LOSE LOSE LOSE>
HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
JUMPN A,SYM3B ; JUMP IF NOT THE LAST ADDR. IN CHAIN
HRRM W,@X ;COMBINE CHAINS
POPJ P,;
;LHQ PATCH FOR LISP ABSOLUTE FIXUP PREVENTION
IFN L,<
VTST: 0
MOVEM V,VSVV#
HRRZS V
CAMGE V,RINITL
POPJ P,
MOVE V,VSVV
JRST @VTST>
;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS
FIXWP: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP
JRST FIXW
MOVE T,1(B) ;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED
XOR T,V ;CHECK FOR SAME
TDNE T,[XWD 77777,-1] ;EXCEPT FOR HEGH CODE BITS
POPJ P, ;ASSUME NON-LOADED LOCAL
HRRI V,2(B) ;GET LOCATION
SUBI V,(X) ;SO WE CAN USE @X
FIXW: TLNE V,200000 ;IS IT LEFT HALF
JRST FIXWL
IFN L,< JSR VTST>
MOVE T,@X ;GET WORD
ADD T,W ;VALUE OF GLOBAL
HRRM T,@X ;FIX WITHOUT CARRY
MOVSI D,200000 ;SET UP TO REMOVE DEFERED INTERNAL IF THERE
JRST SYMFIX
FIXWL: HRLZ T,W ;UPDATE VALUE OF LEFT HALF
IFN L,< JSR VTST>
ADDM T,@X ;BY VALUE OF GLOBAL
MOVSI D,400000 ;LEFT DEFERED INTERNAL
SYMFIX: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP
POPJ P, ;NO, RETURN
ADDI V,(X) ;GET THE LOCATION
MOVE T,-1(V) ;GET THE SYMBOL NAME
TLNN T,40000 ;CHECK TO SEE IF INTERNAL
POPJ P, ;NO, LEAVE
ANDCAB D,-1(V) ;REMOVE PROPER BIT
TLNE D,600000 ;IS IT STILL DEFERED?
POPJ P, ;YES, ALL DONE
EXCH C,D ;NO, CHECK FOR A REQUEST FOR IT
PUSHJ P,SREQ
JRST CHNSYM ;YES, WILL HAVE TO CALL THE FIXUP ROUTINE
MOVE C,D ;GET C BACK
POPJ P,
CHNSYM: PUSH P,D ;HAS THE OLD C IN IT
PUSH P,W ;WE MAY NEED IT LATER
MOVE W,(V) ;GET VALUE
PUSHJ P,SYM2B ;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE
POP P,W
POP P,C ;RESTORE FOR CALLER
POPJ P, ;AND GO AWAY
SYM2W: IFN FAILSW,< TLNE V,40000 ;CHECK FOR POLISH
JRST POLSAT>
TLNN V,100000 ;SYMBOL TABLE?
JRST SYM2WA
ADD V,JOBREL ;MAKE ABSOLUTE
SUBI V,(X) ;GET READY TO ADD X
SYM2WA: PUSHJ P,FIXW ;DO FIXUP
JRST SYM2W1 ;AND LOOK FOR MORE REQUESTS
;END WFW PATCH
;PATCH VALUES INTO CHAINED REQUEST
SYM4:
IFN L,< CAMGE V,RINITL
POPJ P,>
HRRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN
HRRM W,@X ;INSERT VALUE INTO PROGRAM
MOVE V,T
SYM4A: JUMPN V,SYM4 ;JUMP IF NOT LAST ADDR. IN CHAIN
POPJ P,
IFE K,<
MVDWN: HRRZ T,MLTP
IFN EXPAND,< SUBI T,2>
CAIG T,@X; ANY ROOM LEFT?
IFN EXPAND,< JRST [PUSHJ P,XPAND>
TLOA F,FULLSW
IFN EXPAND,< JRST MVDWN
JRST .+2]>
TLNE F,SKIPSW+FULLSW
JRST MVABRT; ABORT BLT
HRREI T,-2
ADDM T,PLTP; ADJUST PROGRAMMER LABEL POINTER
ADDM T,BITP; AND BIT TABLE POINTER
ADDM T,SDSTP; FIRST DATA STATEMENT
ADDM T,LTC
ADDM T,ITC
TLNE N,SYDAT
ADDM T,V
ADDB T,MLTP; AND FINALLY TO MADE LABEL TABLE
HRLS T; SET UP BLT POINTER
ADD T,[XWD 2,0]
BLT T,(S)
MVABRT: POPJ P,;
>
;HIGHEST RELOCATABLE POINT (BLOCK TYPE 4)
SFULLC: TLOE F,FULLSW ;PREVIOUS OVERFLOW?
JRST FULLC ;YES, DON'T PRINT MESSAGE
JSP A,ERRPT ;NO, COMPLAIN ABT OVERFLO
SIXBIT ?SYMBOL TABLE OVERLAP#?
FULLC: TLO F,FULLSW ;CORE OVERLAP ERROR RETURN
IFE K,< TLNE N,F4SW
POPJ P,>
JRST LIB3 ;LOOK FOR MORE
HIGH0: CAIE A,4 ; TEST FOR END BLOCK (OVERLAP)
JRST LIB3
HIGH: PUSHJ P,PRWORD ;READ TWO DATA WORDS
HRR R,C ;SET NEW PROGRAM BREAK
ADDI C,X; BE SURE TO RELOCATE
CAILE C,1(S) ;TEST PROGRAM BREAK
IFN EXPAND,<PUSHJ P,[ PUSHJ P,XPAND
TLOA F,FULLSW
JRST POPJM2
POPJ P,]>
IFE EXPAND,<TLO F,FULLSW>
HIGH3: MOVEI A,F.C ;SAVE CURRENT STATE OF LOADER
BLT A,B.C
TLNE F,SLIBSW+LIBSW ;NORMAL MODE EXIT THROUGH LOAD1
JRST LIB ;LIBRARY SEARCH EXIT
JRST LOAD1
;STARTING ADDRESS (BLOCK TYPE 7)
START: PUSHJ P,PRWORD ;READ TWO DATA WORDS
TLNN N,ISAFLG ;SKIP IF IGNORE SA FLAG ON
HRR F,C ;SET STARTING ADDRESS
IFN STANSW,<MOVE W,1(N) ;SET UP NAME OF THIS PROGRAM
PUSHJ P,LDNAM>
;PROGRAM NAME (BLOCK TYPE 6)
NAME: PUSHJ P,PRWORD ;READ TWO DATA WORDS
TLOE N,COMFLG ;SKIP IF COMMON NOT PREV. SET
JRST NAME1 ;SIZE OF COMMON PREV. SET
MOVEM W,COMSAV ;STORE LENGTH OF COMMON
JUMPE W,NAME2 ;JUMP IF NO COMMON IN THIS JOB
HRRI R,@R ;FIRST PROGRAM SET LOAD ORIGIN
NAME1: CAILE H,-1(S) ;TEST FOR AVAIL. SYMBOL SPACE
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
SUBI S,2 ;UPDATE UNDEF. TABLE POINTER
POP B,2(S)
POP B,1(S)
HRRZ V,N ;POINTER TO PREVIOUS NAME
SUBM B,V ;COMPUTE RELATIVE POSITIONS
HRLM V,2(N) ;STORE FORWARD POINTER
HRR N,B ;UPDATE NAME POINTER
NAME2: MOVEM C,1(B) ;STORE PROGRAM NAME
HRRZM R,2(B) ;STORE PROGRAM ORIGIN
CAMG W,COMSAV ;CHECK COMMON SIZE
JRST LIB3 ;COMMON OK
ILC: JSP A,ERRPT
SIXBIT /ILL. COMMON#/
IFN HE,<SETOM RESET>
JRST LD2
IFN FAILSW,<
LINK: PUSHJ P,PRWORD ;GET TWO WORDS
JUMPLE C,ENDLNK ;THIS IS AN END OF LINK WORD
CAILE C,20 ;IS IT IN RANGE?
JRST LOAD4A
HRRZ V,W ;GET THE ADDRESS
HRRZ W,LINKTB(C) ;GET CURRENT LINK
IFN L,< CAML V,RINITL ;LOSE>
HRRM W,@X ;PUT INTO CORE
HRRM V,LINKTB(C) ;SAVE LINK FOR NEXT ONE
JRST LINK ;GO BACK FOR MORE
ENDLNK: MOVNS C ;GET ENTRY NUMBER
JUMPE C,LOAD4A ;0 IS A LOSER
CAILE C,20 ;CHECK RANGE
JRST LOAD4A
HRLM W,LINKTB(C) ;SAVE END OF LINK INFO
JRST LINK ;MORE>
;ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)
;PMP PATCH FOR LEFT HALF FIXUPS
IFN FAILSW,<
LOCDLH:
IFN L,< CAMGE V,RINITL
JRST .+3>
HLRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN
HRLM W,@X ;INSERT VALUE INTO PROGRAM
MOVE V,T
LOCDLF: JUMPN V,LOCDLH ;JUMP IF NOT LAST ADDR. IN CHAIN
POPJ P,
LOCDLI: PUSHJ P,LOCDLF
AOSA LFTHSW ;TURN OFF LEFT HALF FIX SW (WAS -1) AND SKIP
LOCDLG: SETOM LFTHSW ;TURN ON LEFT HALF FIX SW>
;END PMP PATCH
LOCD: PUSHJ P,RWORD ;READ ONE DATA WORD
HLRZ V,W ;STORAGE POINTER IN LEFT HALF
IFN FAILSW,< SKIPE LFTHSW# ;LEFT HALF CHAINED? PMP
JRST LOCDLI ;YES PMP
CAMN W,[-1] ;LEFT HALF NEXT? PMP
JRST LOCDLG ;YES, SET SWITCH PMP>
PUSHJ P,SYM4A ;LINK BACK REFERENCES
JRST LOCD
IFN STANSW,<
LDNAM: MOVE T,[POINT 6,CURNAM] ;POINTER
MOVNI D,6 ;SET COUNT
TLZ W,740000 ;REMOVE CODE BITS
SETNAM: IDIVI W,50 ;CONVERT FROM RAD 50
HRLM C,(P)
AOSGE D
PUSHJ P,SETNAM
HLRZ C,(P)
JUMPE C,INAM
ADDI C,17
CAILE C,31
ADDI C,7
CAILE C,72
SUBI C,70
CAIN C,3
MOVEI C,16
INAM: IDPB C,T
POPJ P, >
IFN FAILSW,<
;POLISH FIXUPS <BLOCK TYPE 11>
PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH?
JRST COMPOL ;YES
JSP A,ERRPT
SIXBIT /PUSHDOWN OVERFLOW#/
IFN HE,<SETOM RESET>
JRST LD2
COMPOL: JSP A,ERRPT
SIXBIT /POLISH TOO COMPLEX#/
IFN HE,<SETOM RESET>
JRST LD2
;READ A HALF WORD AT A TIME
RDHLF: TLON N,HSW ;WHICH HALF
JRST NORD
PUSHJ P,RWORD ;GET A NEW ONE
TLZ N,HSW ;SET TO READ OTEHR HALF
MOVEM W,SVHWD# ;SAVE IT
HLRZS W ;GET LEFT HALF
POPJ P, ;AND RETURN
NORD: HRRZ W,SVHWD ;GET RIGHT HALF
POPJ P, ;AND RETURN
POLFIX: MOVE D,[IOWD PPDL,PPDB] ;SET UP THE POLISH PUSHDOWN LIST
MOVEI V,100 ;IN CASE OF ON OPERATORS
MOVEM V,SVSAT
SETOM POLSW ;WE ARE DOING POLISH
TLO N,HSW ;FIX TO READ A WORD THE FIRST TIME
SETOM GLBCNT# ;NUMBER OF GLOBALS IN THIS FIXUP
SETOM OPNUM# ;NUMBER OF OPERANDS AND OPERATORS THIS FIXUP
PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK
RPOL: PUSHJ P,RDHLF ;GET A HLAF WORD
TRNE W,400000 ;IS IT A STORE OP?
JRST STOROP ;YES, DO IT
CAIGE W,3 ;0,1,2 ARE OPERANDS
JRST OPND
CAILE W,14 ;14 IS HIGHEST OPERATOR
JRST LOAD4A ;ILL FORMAT
PUSH D,W ;SAVE OPERATOR IN STACK
MOVE V,DESTB-3(W) ;GET NUMBER OF OPERANDS NEEDED
MOVEM V,SVSAT# ;ALSO SAVE IT
JRST RPOL ;BACK FOR MORE
;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
;GLOBAL REQUESTS
OPND: MOVE A,W ;GET THE OPERAND TYPE HERE
PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND
MOVE C,W ;GET IT INTO C
JUMPE A,HLFOP ;0 IS HALF-WORD OPERAND
PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF
HRL C,W ;GET HALF IN RIGHT PLACE
MOVSS C ;WELL ALMOST RIGHT
SOJE A,HLFOP ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED
JRST [MOVE C,2(A) ;YES, WE WIN
JRST HLFOP]
AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
AOS W,OPNUM ;GET AN OPERAND NUMBER
LSH W,4 ;SPACE FOR TYPE
IORI W,2 ;TYPE 2 IS GLOBAL
HRL W,HEADNM ;GET FIXUP NUMBER
PUSHJ P,SYM3X2 ;AND PUT INTO UDEFINED AREA ALONG WITH NAME
MOVE C,W ;ALSO PUT THAT PART OF THE FIXUP IN
PUSHJ P,SYM3X2
SKIPA A,[400000] ;SET UP GLOBAL FLAG
HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG
HLFOP1: SOJL V,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
;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,W
POP D,W ;VALUE OR GLOBAL NAME
UNOP: POP D,V ;OPERATOR
JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
XCT OPTAB-3(V) ;IF BOTH VALUES JUST XCT
MOVE C,W ;GET THE CURRENT VALUE
SETSAT: SKIPG V,(D) ;IS THERE A VALUE IN THE STACK
MOVE V,-2(D) ;YES, THIS MUST BE THE OPERATOR
MOVE V,DESTB-3(V) ;GET NUMBER OF OPERANDS NEEDED
MOVEM V,SVSAT ;SAVE IT HERE
SKIPG (D) ;WAS THERE AN OPERAND
SUBI V,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 PUT THIS VALUE INTO THE FIXUP LIST
PUSH P,W ;SAVE FOR A WHILE
MOVE W,C ;THE VALUE
AOS C,OPNUM ;GET AN OPERAND NUMBER
LSH C,4 ;AND PUT IN TYPE
IORI C,2 ;VALUE TYPE
HRL C,HEADNM ;THE FIXUP NUMBER
PUSHJ P,SYM3X2
POP P,W ;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 ;SAVE THE FIRST OPERAND
AOS C,OPNUM ;SEE ABOVE
LSH C,4
IORI C,2
HRL C,HEADNM
PUSHJ P,SYM3X2
MOVE W,C
POP P,C
GLSET: EXCH C,W ;GET THEM IN THE OTHER ORDER
HRL W,C ;SET UP THE OPERATOR LINK
AOS C,OPNUM
LSH C,4 ;SPACE FOR THYPE
IOR C,V ;THE OPERATOR
HRL C,HEADNM
PUSHJ P,SYM3X2 ;INTO THE UNDEF LIST
MOVEI A,400000 ;SET UP AS A GLOBAL VALUE
JRST SETSAT ;AND SET UP FOR NEXT OPERATOR
;FINALLY WE GET TO STORE THIS MESS
STOROP: MOVE T,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR
CAIE T,15 ;IS IT
JRST LOAD4A ;NO, ILL FORMAT
HRRZ T,(D) ;GET THE VALUE TYPE
JUMPN T,GLSTR ;AND TREAT GLOBALS SPECIAL
MOVE A,W ;THE TYPE OF STORE OPERATOR
PUSHJ P,RDHLF ;GET THE ADDRESS
MOVE V,W ;SET UP FOR FIXUPS
POP D,W ;GET THE VALUE
POP D,W ;AFTER IGNORING THE FLAG
PUSHJ P,@STRTAB+3(A) ;CALL THE CORRECT FIXUP ROUTINE
COMSTR: SETZM POLSW ;ALL DONE WITH POLISH
MOVE T,OPNUM ;CHECK ON SIZES
MOVE V,HEADNM
CAIG V,477777
CAILE T,37777
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
STRTAB: EXP ALSTR,LOCDLF,SYM4A
GLSTR: MOVEI A,20(W) ;CONVERT TO OPERATOR 15-17
PUSHJ P,RDHLF ;GET THE STORE LOCATION
POP D,V ;GET VALUE
POP D,V
HRLM V,W ;SET UP STORAGE ELEMENT
AOS C,OPNUM
LSH C,4
IOR C,A
HRL C,HEADNM
PUSHJ P,SYM3X2
MOVE W,C ;NOW SET UP THE HEADER
AOS V,GLBCNT ;WHICH HAS NUMBER OF GLOBALS
HRLM V,W
HRRZ C,HEADNM
PUSHJ P,SYM3X2
JRST COMSTR ;AND FINISH
ALSTR1:
IFN L,< CAMGE V,RINITL
POPJ P,>
HRRZ T,@X
MOVEM W,@X ;FULL WORD FIXUPS
MOVE V,T
ALSTR: JUMPN V,ALSTR1
POPJ P,
DESTB: EXP 1,1,1,1,1,1,1,1,0,0,100
OPTAB: ADD W,C
SUB W,C
IMUL W,C
IDIV W,C
AND W,C
IOR W,C
LSH W,(C)
XOR W,C
SETCM W,C
MOVN W,C
REPEAT 3,<JRST STRSAT>
POLSAT: PUSH P,C ;SAVE SYMBOL
MOVE C,V ;POINTER
PUSHJ P,SREQ ;GO FIND IT
SKIPA
JRST LOAD4A ;SOMETHING IS ROTTEN IN DENMARK
MOVEM W,2(A) ;STORE VALUE
HLRZS C ;NOW FIND HEADER
PUSHJ P,SREQ
SKIPA
JRST LOAD4A
HRLZI V,-1 ;AND DECREMENT COUNT
ADDB V,2(A)
TLNN V,-1 ;IS IT NOW 0
JRST PALSAT ;YES, GO DO POLISH
POP P,C ;RESTORE SYMBOL
JRST SYM2W1 ;AND RETURN
PALSAT: PUSH P,W ;SAVE VALUE
MOVEM C,HDSAV# ;SAVE THE HEADER NUMBER
MOVE D,[IOWD PPDL,PPDB] ;SET UP A PDL
MOVE C,V ;GET THE POINTER
HRL C,HDSAV ;AND THE FIXUP NUMBER
PUSHJ P,REMSYM ;REMOVE THE HEADER FORM EXISTANCE
PUSHJ P,SREQ ;GO FINE THE NEXT LINK
SKIPA
JRST LOAD4A ;LOSE
ANDI C,17 ;GET OPERATOR TYPE
HRRZ V,2(A) ;PLACE TO STORE
PUSH D,V
PUSH D,[XWD 400000,0]
PUSH D,C ;THIS HAD BETTER BE A STORE OR WE ARE IN TROUBLE
HLRZ C,2(A) ;GET POINTER TO POLISH CHAIN
PSAT1: PUSHJ P,REMSYM ;REMOVE SYMBOL
PSAT2: HRL C,HDSAV ;GET FIXUP NUMBER
PUSHJ P,SREQ ;LOOK FOR IT
SKIPA
JRST LOAD4A
ANDI C,17 ;THE OPERATOR NUMBER
CAIN C,2 ;IS IT AN OPERAND?
JRST PSOPD ;YES, GO PROCESS
PUSH D,C ;YES STORE IT
SKIPN DESTB-3(C) ;IS IT UNARY
JRST PSUNOP ;YES
HLRZ C,2(A) ;GET FIRST OPERAND
HRLI C,600000 ;AND MARK AS VALUE
PUSH D,C
PSUNOP: HRRZ C,2(A) ;OTHER OPERAND
JRST PSAT1 ;AND AWAY WE GO
PSOPD: MOVE C,2(A) ;THIS IS A VALUE
PUSHJ P,REMSYM ;GET RID OF THAT PART OF THE CHAIN
PSOPD1: SKIPG V,(D) ;IS THERE A VALUE IN THE STACK
JRST PSOPD2 ;YES, TAKE GOOD CARE OF IT
COMOP: POP D,V ;NO, GET THAT OPERATOR OUT OF THERE
XCT OPTAB-3(V) ;AND DO IT
MOVE C,W ;GET RESULT IN RIGHT PLACE
JRST PSOPD1 ;AND TRY FOR MORE
PSOPD2: TLNE V,200000 ;IS IT A POINTER
JRST DBLOP ;YES, NEEDS MORE WORK
MOVE W,C ;NO, ONE WE HAVE IS FIRST OPND, GET IT INTO W
POP D,C ;VALUE POINTER
POP D,C ;2ND OPERAND INTO C
JRST COMOP ;GO PROCESS OPERATOR
DBLOP: EXCH C,(D) ;PUT VALUE IN STACK AND RETRIEV POINTER
PUSH D,[XWD 400000,0] ;MARK AS VALUE
JRST PSAT2 ;AND GO LOOK FOR MORE TROUBLE
STRSAT: MOVE W,C ;GET VALUE TO STORE IN W
MOVE C,V ;GET OPERATOR HERE
POP D,V
POP D,V ;GET ADDRESS TO STORE
PUSHJ P,@STRTAB-15(C)
POP P,W ;RESTORE THINGS
POP P,C
JRST SYM2W1
PPDB: BLOCK PPDL+1>
REMSYM: MOVE T,1(S)
MOVEM T,1(A)
MOVE T,2(S)
MOVEM T,2(A)
ADD S,SE3
MOVEM A,SVA
POPJ P,
;SYMBOL TABLE SEARCH SUBROUTINES
; ENTERED WITH SYMBOL IN C
; RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND
; OTHERWISE, A SKIP ON RETURN OCCURS
SREQ: JUMPGE S,CPOPJ1 ;JUMP IF NO UNDEF. SYMBOLS
SKIPA A,S ;LOAD REQUEST SEARCH POINTER
SDEF: MOVE A,B ;LOAD DEF. SYMBOL SEARCH POINTER
SDEF1: CAMN C,1(A)
POPJ P, ;SYMBOLS MATCH, RETURN
SDEF2: ADD A,SE3
JUMPL A,SDEF1
IFE K,< JRST CPOPJ1 ;SYMBOL NOT FOUND SKIPS ON RETURN>
IFN K,<
CPOPJ1: AOS (P) ;TRA 2,4
POPJ P, ;...>
;RELOCATION AND BLOCK INPUT
PRWORD: PUSHJ P,RWORD ;READ A WORD PAIR
MOVE C,W ;LOAD C WITH FIRST DATA WORD
TRNE E,377777 ;TEST FOR END OF BLOCK
JRST RWORD1 ;INPUT SECOND WORD OF PAIR
MOVEI W,0 ;NO SECOND WORD, ASSUME ZERO
POPJ P,
RWORD: TRNN E,377777 ;TEST FOR END OF BLOCK
JRST LOAD1 ;RETURN TO LOAD THE NEXT BLOCK
RWORD1: AOBJN E,RWORD2 ;JUMP IF DATA WORD NEXT
PUSHJ P,WORD ;READ CONTROL WORD
MOVE Q,W ;DON'T COUNT RELOCATION WORDS
HRLI E,-22 ;SET RELOCATION WORD BYTE COUNT
RWORD2: PUSHJ P,WORD ;READ INPUT WORD
JUMPGE Q,RWORD3 ;TEST LH RELOCATION BIT
HRLZ T,R
ADD W,T ;LH RELOCATION
RWORD3: TLNE Q,200000 ;TEST RH RELOCATION BIT
HRRI W,@R ;RH RELOCATION
LSH Q,2
POPJ P,
;PRINT STORAGE MAP SUBROUTINE
PRMAP: PUSHJ P,FSCN1 ;LOAD OTHER FILES FIRST
PUSHJ P,CRLFLF ;START NEW PAGE
HRRZ W,R
PUSHJ P,PRNUM0
JSP A,ERRPT7
SIXBIT ?IS THE PROGRAM BREAK@?
PUSHJ P,CRLF ;START STORAGE MAP
JSP A,ERRPT0 ;PRINT HEADER
SIXBIT ?STORAGE MAP@?
HLRE A,B
MOVNS A
ADDI A,(B)
PRMAP1: SUBI A,2
SKIPL C,1(A) ;LOAD SYMBOL, SKIP IF DELETED
TLNE C,300000 ;TEST FOR LOCAL SYMBOL
JRST PRMAP4 ;IGNORE LOCAL SYMBOLS
TLNN C,040000
PUSHJ P,CRLF ;PROGRAM NAME
PUSHJ P,PRNAM1 ;PRINT SYMBOL AND VALUE
TLNE C,040000
JRST PRMAP3 ;GLOBAL SYMBOL
HLRE C,W ;POINTER TO NEXT PROG. NAME
JUMPGE C,PRMAP2 ;JUMP IF LAST PROGRAM NAME
ADDI C,2(A) ;COMPUTE LOC. OF FOLLOWING NAME
SKIPA T,@C ;LOAD ORIGIN OF FOLLOWING PROG.
PRMAP2: HRRZ T,R ;LOAD PROGRAM BREAK
SUBM T,W ;SUBTRACT ORIGIN TO GET LENGTH
PUSHJ P,PRNUM ;PRINT PROGRAM LENGTH
PUSHJ P,CRLF
TLNN N,ALLFLG ;SKIP IF LIST ALL MODE IS ON
TRNE W,777777 ;SKIP IF ZERO LENGTH PROGRAM
JRST PRMAP3
JUMPE C,PRMAP5 ;JUMP IF LAST PROGRAM
SKIPA A,C ;SKIP GLOBALS, ZERO LENGTH PROG.
PRMAP3: PUSHJ P,CRLF
PRMAP4: CAILE A,(B) ;TEST FOR END OF SYMBOL TABLE
JRST PRMAP1
PRMAP5:
;LIST UNDEFINED GLOBALS
PMS: PUSHJ P,FSCN1 ;LOAD FILES FIRST
JUMPGE S,PMS3 ;JUMP IF NO UNDEFINED GLOBALS
HLLOS 42 ;SET SOME ERROR TO ABORT EXECUTION
PUSHJ P,FCRLF ;START THE MESSAGE
PUSHJ P,PRQ ;PRINT ?
HLRE W,S ;COMPUTE NO. OF UNDEF. GLOBALS
MOVMS W
LSH W,-1 ;<LENGTH OF LIST>/2
PUSHJ P,PRNUM0
JSP A,ERRPT7
SIXBIT /UNDEFINED GLOBALS@/
MOVE A,S ;LOAD UNDEF. POINTER
PMS2: PUSHJ P,CRLF
PUSHJ P,PRQ ;PRINT ?
PUSHJ P,PRNAM0 ;PRINT SYMBOL AND POINTER
ADD A,SE3
JUMPL A,PMS2
PUSHJ P,CRLF ;SPACE AFTER LISTING
;LIST NUMBER OF MULTIPLY DEFINED GLOBALS
PMS3: SKIPN W,MDG ;ANY MULTIPLY DEFINED GLOBALS
JRST PMS4 ;NO, EXCELSIOR
HLLOS 42 ;ANOTHER WAY TO LOSE
PUSHJ P,FCRLF ;ROOM AT THE TOP
PUSHJ P,PRQ ;PRINT ?
PUSHJ P,PRNUM0 ;NUMBER OF MULTIPLES
JSP A,ERRPT7 ;REST OF MESSAGE
SIXBIT ?MULTIPLY DEFINED GLOBALS@?
PMS4: TLNE N,AUXSWE ;AUXILIARY OUTPUT DEVICE?
OUTPUT 2, ;INSURE A COMPLETE BUFFER
POPJ P, ;RETURN
;ENTER FILE ON AUXILIARY OUTPUT DEVICE
IAD2: ENTER 2,DTOUT ;WRITE FILE NAME IN DIRECTORY
JRST IMD3 ;NO MORE DIRECTORY SPACE
POPJ P,
IMD3: JSP A,ERRPT ;DIRECTORY FULL ERROR
SIXBIT /DIR. FULL@/
JRST LD2
;PRINT THE 6 DIGIT OCTAL ADDRESS IN W
; ACCUMULATORS USED: D,T,V
PRNAM0: MOVE C,1(A) ;LOAD SYMBOL
PRNAM1: MOVE W,2(A) ;LOAD VALUE
PRNAM: PUSHJ P,PRNAME
PRNUM: PUSHJ P,SPACES
PRNUM0: MOVE V,PRNUM2 ;LOAD BYTE POINTER TO RH. OF W
MOVNI D,6 ;LOAD CHAR. COUNT
PRNUM1: ILDB T,V ;LOAD DIGIT TO BE OUTPUT
ADDI T,60 ;CONVERT FROM BINARY TO ASCII
PUSHJ P,TYPE2
AOJL D,PRNUM1 ;JUMP IF MORE DIGITS REMAIN
POPJ P,
PRNUM2: XWD 220300,W
;YE OLDE RECURSIVE NUMBER PRINTER
;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T
RCNUM: IDIVI Q,12 ;RADIX DECIMAL
ADDI A,"0"
HRLM A,(P)
SKIPE Q
PUSHJ P,RCNUM
HLRZ T,(P)
JRST TYPE2
;PRINT FOUR SPACES
SPACES: PUSHJ P,SP1
SP1: PUSHJ P,SPACE
SPACE: MOVEI T,40
JRST TYPE2
;SYMBOL PRINT - RADIX 50
; ACCUMULATORS USED: D,T
PRNAME: MOVE T,C ;LOAD SYMBOL
TLZ T,740000 ;ZERO CODE BITS
MOVNI D,6 ;LOAD CHAR. COUNT
SPT: IDIVI T,50 ;THE REMAINDER IS THE NEXT CHAR.
HRLM V,(P) ;STORE IN LH. OF PUSHDOWN LIST
AOSGE D ;SKIP IF NO CHARS. REMAIN
PUSHJ P,SPT ;RECURSIVE CALL FOR NEXT CHAR.
HLRZ T,(P) ;LOAD FROM LH. OF PUSHDOWN LIST
JUMPE T,TYPE ;BLANK
ADDI T,60-1
CAILE T,71
ADDI T,101-72
CAILE T,132
SUBI T,134-44
CAIN T,43
MOVEI T,56
JRST TYPE2
;PRINT A WORD OF SIXBIT CHARACTERS IN AC W
; ACCUMULATORS USED: Q,T,D
PWORD: MOVNI Q,6 ;SET CHARACTER COUNT TO SIX
PWORD1: MOVE D,LSTPT ;ENTER HERE WITH Q PRESET
PWORD2: ILDB T,D ;LOAD NEXT CHAR. TO BE OUTPUT
PUSHJ P,TYPE ;OUTPUT CHARACTER
AOJL Q,PWORD2
POPJ P,
;ERROR MESSAGE PRINT SUBROUTINE
; FORM OF CALL:
; JSP A,ERRPT
; SIXBIT /<MESSAGE>/
; ACCUMULATORS USED: T,V,C,W
ERRPT: TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,CRLF ;ROOM AT THE TOP
PUSHJ P,PRQ ;START OFF WITH ?
ERRPT0: PUSH P,Q ;SAVE Q
SKIPA V,ERRPT5
ERRPT1: PUSHJ P,TYPE
ILDB T,V
CAIN T,40
JRST ERRPT4
CAIN T,5
JRST ERRPT9
CAIE T,3
JRST ERRPT1
SKIPN C,DTIN
JRST ERRPT4
MOVNI Q,14
MOVEI W,77
ERRPT2: TDNE C,W
JRST ERRPT3
LSH W,6
AOJL Q,ERRPT2
ERRPT3: MOVE W,ERRPT6
PUSHJ P,PWORD1
SKIPN W,DTIN1
JRST ERRPT4
LSH W,-6
TLO W,160000
MOVNI Q,4
PUSHJ P,PWORD1
ERRPT4: PUSHJ P,CRLF
ERRP41: POP P,Q
TLZ F,FCONSW ;ONE ERROR PER CONSOLE
AOS V ;PROGRAM BUMMERS BEWARE:
JRST @V ;V HAS AN INDEX OF A
ERRPT5: POINT 6,0(A)
ERRPT6: SIXBIT / FILE /
ERRPT8: TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,PRQ ;START WITH ?
CAIGE T,140 ;IS IT A NON-PRINTING CHAR?
CAIL T,40
JRST ERRP8
PUSH P,T
MOVEI T,136 ;UP ARROW
PUSHJ P,TYPE2
POP P,T
ADDI T,100 ;CONVERT TO PRINTING CHAR.
ERRP8: PUSHJ P,TYPE2
ERRPT7: PUSHJ P,SPACE
JRST ERRPT0
ERRPT9: MOVEI V,@V
PUSH P,V
JSP A,ERRPT7
SIXBIT ?ILLEGAL -LOADER@?
POP P,V
JRST ERRP41
;PRINT QUESTION MARK
PRQ: PUSH P,T ;SAVE
MOVEI T,"?" ;PRINT ?
PUSHJ P,TYPE2 ;...
POP P,T ;RESTORE
POPJ P, ;RETURN
;INPUT - OUTPUT INTERFACE
;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W
IFE K,<
WORDPR: PUSHJ P,WORD ;GET FIRST WORD OF PAIR
MOVE C,W ;KEEP IT HANDY>
WORD: SOSG BUFR2 ;SKIP IF BUFFER NOT EMPTY
JRST WORD2
WORD1: ILDB W,BUFR1 ;PICK UP 36 BIT WORD
POPJ P,
WORD2: INPUT 1, ;GET NEXT BUFFER LOAD
STATUS 1,W ;GET DEVICE STATUS FROM MONITOR
TRNE W,IODEND ;TEST FOR EOF
JRST EOF ;END OF FILE EXIT
TRNN W,IOBAD ;TEST FOR DATA ERROR
JRST WORD1 ;DATA OK - CONTINUE LOADING
JSP A,ERRPT ;DATA ERROR - PRINT MESSAGE
SIXBIT /INPUT ERROR#/
IFN HE,<SETOM RESET>
JRST LD2 ;GO TO ERROR RETURN
;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII
;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT
;DEVICE
CRLFLF: PUSHJ P,CRLF
FCRLF: TLO F,FCONSW ;INSURE TTY OUTPUT
CRLF: MOVEI T,15 ;CARRIAGE RETURN LINE FEED
PUSHJ P,TYPE2
MOVEI T,12-40 ;LINE FEED IN PSEUDO SIXBIT
TYPE: MOVEI T,40(T) ;CONVERT SIXBIT TO ASCII
TYPE2: TLNN N,AUXSWI ;IS THER AN AUXILIARY DEVICE?
JRST TYPE3 ;NO, DONT OUTPUT TO IT
TLON N,AUXSWE ;IS AUX. DEV. ENTERED?
PUSHJ P,IAD2 ;NOPE, DO SO!
SOSG ABUF2 ;SPACE LEFT IN BUFFER?
OUTPUT 2, ;CREATE A NEW BUFFER
IDPB T,ABUF1 ;DEPOSIT CHARACTER
TLNN F,FCONSW ;FORCE OUTPUT TO CONSOLE TOO?
POPJ P, ;NOPE
IFE HE,<
TYPE3: SKIPN BUFO2 ;END OF BUFFER
OUTPUT 3, ;FORCE OUTPUT NOW
IDPB T,BUFO1 ;DEPOSIT CHARACTER
CAIN T,12 ;END OF LINE
OUTPUT 3, ;FORCE AN OUTPUT
>
IFN HE, <
TYPE3: ROT T,-7
MOVEM T,FOO1#
MOVEI T,FOO1
CALLI T,CDDTOUT>
POPJ P,
SE3: XWD 2,2 ;SYMBOL POINTER INCREMENT
LSTPT: POINT 6,W ;CHARACTER POINTER TO W
PDLPT: XWD -41,PDLST-1; INITIAL PUSHDOWN POINTER
COMM: SQUOZE 0,.COMM.
PDSAV: 0 ;SAVED PUSHDOWN POINTER
COMSAV: 0 ;LENGTH OF COMMON
MDG: 0 ;COUNTER FOR MUL DEF GLOBALS
PDLST: IFE HE,<BLOCK 40>
IFN FAILSW,<LINKTB: BLOCK 21>
F.C: 0
0 ;STORE N HERE
0 ;STORE X HERE
0 ;STORE H HERE
0 ;STORE S HERE
0 ;STORE R HERE
B.C: 0
IFE HE,<
F.I: 0 ;INITIAL F - FLAGS
0 ;INITIAL N
XWD V,LDEND ;INITIAL X - LOAD PROGRAM AFTER LOADER
EXP LDEND+JOBPRO ;INITIAL H - INITIAL PROG BREAK
0 ;INITIAL S
XWD W,JOBPRO ;INITIAL R - INITIAL RELOC
0 ;INITIAL B
>
;BUFFER HEADERS AND HEADER HEADERS
IFE HE,<
BUFO: 0 ;CONSOLE INPUT HEADER HEADER
BUFO1: 0
BUFO2: 0
BUFI: 0 ;CONSOLE OUTPUT HEADER HEADER
BUFI1: 0
BUFI2: 0
>
ABUF: 0 ;AUXILIARY OUTPUT HEADER HEADER
ABUF1: 0
ABUF2: 0
BUFR: 0 ;BINARY INPUT HEADER HEADER
BUFR1: 0
BUFR2: 0
DTIN: 0 ;DECTAPE INPUT BLOCK
IFE HE,<DTIN1: 0>
IFN HE,<DTIN1: SIXBIT /REL />
0
DTIN2: 0
DTOUT: 0 ;DECTAPE OUTPUT BLOCK
DTOUT1: 0
0
0
TTYL=52 ;TWO TTY BUFFERS
IFE K,< BUFL=406 ;TWO DTA BUFFERS FOR LOAD>
IFN K,< BUFL=203 ;ONE DTA BUFFER FOR LOAD>
ABUFL=203 ;ONE DTA BUFFER FOR AUX DEV
IFN HE,<BUFL=406>
IFE HE,<
TTY1: BLOCK TTYL ;TTY BUFFER AREA
>
BUF1: BLOCK BUFL ;LOAD BUFFER AREA
AUX: BLOCK ABUFL ;AUX BUFFER AREA
ZEROS: REPEAT 4,<0>
IFN RPGSW,<CTLIN: BLOCK 3
CTLNAM: BLOCK 3
CTLBUF: BLOCK 203+1
>
IOBKTL=40000
IOIMPM=400000
IODERR=200000
IODTER=100000
IODEND=20000
IOBAD=IODERR+IODTER+IOBKTL+IOIMPM
IFE HE,<
INTERN PWORD,DTIN,DTOUT,LDEND
INTERN WORD,LD,BEG,PDLST,LOAD
INTERN CRLF,TYPE,PMS,PRMAP
INTERN F,P,X,H,S,R,B,N,T,V,W,C,E,Q,A,D
>
IFN HE,<
INTERNAL .LOAD, .PRMAP, PMS, .NAME, ERRPT8
EXTERNAL .GETF
>
EXTERN JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41
IFE HE,<
IFN STANSW,<PATCH: BLOCK 20 ;STANFORD HAS SEMI-INFINITE CORE>
>
;END HERE IF 1K LOADER REQUESTED.
IFN K, <LITS: LIT
VAR
IFE HE, <
LDEND: END LD>
IFN HE, <
LDEND: END >>
;HERE BEGINS FORTRAN FOUR LOADER
F4LD:
HRRZ V,R; SET PROG BREAK INTO V
MOVEM V,LLC; SAVE FIRST WORD ADDRESS
MOVEI W,-2(S); GENERATE TABLES
TLO N,F4SW
HRRZM W,MLTP; MADE LABELS
HRRZM W,PLTP; PROGRAMMER LABELS
ADD W,[POINT 1,1]; GENERATE BIT-BYTE POINTER
MOVEM W,BITP
MOVEM W,SDSTP; FIRST DATA STATEMENT
AOS SDSTP;
MOVE W,[JRST ALLOVE] ;LAST DATA STATEMENT
MOVEM W,(S)
HRREI W,-^D36; BITS PER WORDUM
MOVEM W,BITC; BIT COUNT
PUSHJ P,BITWX+1 ;MAKE SURE OF ENOUGH SPACE
TEXTR: PUSHJ P,WORD; TEXT BY DEFAULT
HLRZ C,W
CAIN C,-1
JRST HEADER; HEADER
MOVEI C,1; RELOCATABLE
PUSHJ P,BITW; SHOVE AND STORE
JRST TEXTR; LOOP FOR NEXT WORD
ABS: SOSG BLKSIZ; MORE TO GET
JRST TEXTR; NOPE
ABSI: PUSHJ P,WORD;
MOVEI C,0; NON-RELOCATABLE
PUSHJ P,BITW; TYPE 0
JRST ABS
;PROCESS TABLE ENTRIES
MDLB: TLNE F,FULLSW+SKIPSW; MADE LABEL PROC
JRST GLOBDF; NO ROOM AT THE IN
HLRZ C,MLTP; GET PRESENT SIZE
CAMGE C,BLKSIZ; IF NEW SIZE BIGGER, STR-R-RETCH
PUSHJ P,SMLT
HRRZ C,MLTP; GET BASE
MLPLC: ADD C,BLKSIZ; MAKE INDEX
TLNN F,FULLSW+SKIPSW; DONT LOAD
HRRZM V,(C); PUT AWAY DEFINITION
GLOBDF: PUSHJ P,WORD
TLNE F,FULLSW+SKIPSW ;SKIPPING THIS PROG?
JRST TEXTR ;YES, DON'T DEFINE
MOVEI C,(V); AND LOC
EXCH W,C
PUSHJ P,SYMXX; PUT IN DDT-SYMBOL TABLE
PUSHJ P,BITWX+1
JRST TEXTR
PLB: TLNE F,FULLSW+SKIPSW
JRST GLOBDF
HLRZ C,PLTP; PRESENT SIZE
CAMGE C,BLKSIZ
PUSHJ P,SPLT
HRRZ C,PLTP
JRST MLPLC
;STORE WORD AND SET BIT TABLE
BITW: TLNE F,FULLSW+SKIPSW; WE DONT LOAD THIS
POPJ P,;
MOVEM W,@X; STORE AWAY OFFSET
IDPB C,BITP; STORE BIT
AOSGE BITC; STEP BIT COUNT
JRST BITWX; SOME MORE ROOM LEFT
HRREI C,-^D36; RESET COUNT
MOVEM C,BITC
SOS PLTP
SOS BITP; ALL UPDATED
IFE EXPAND,<HRL C,MLTP
SOS MLTP
HRR C,MLTP>
IFN EXPAND,<HRRZ C,MLTP; TO ADDRESS
SUBI C,1
CAIG C,@X
PUSHJ P,[PUSHJ P,XPAND
POPJ P,
ADDI C,2000
JRST POPJM2]
SOS MLTP
HRLI C,1(C)>
HRRZ T,SDSTP; GET DATA POINTER
BLT C,-1(T); MOVE DOWN LISTS
BITWX: AOS V; STEP LOADER LOCATION
HRRZ T,MLTP
CAIG T,@X; OVERFLOW CHECK
IFE EXPAND,<TLO F,FULLSW>
IFN EXPAND,<PUSHJ P, [PUSHJ P,XPAND
TLOA F,FULLSW
JRST POPJM3
POPJ P,]>
POPJ P,;
SMLT: SUB C,BLKSIZ; STRETCH
MOVS W,MLTP ;LEFT HALF HAS OLD BASE
ADD C,MLTP ;RIGHT HALF HAS NEW BASE
IFN EXPAND,< HRRZS C ;GET RID OF COUNT
CAIG C,@X
PUSHJ P,[PUSHJ P,XPAND
POPJ P,
ADD W,[XWD 2000,0]
ADDI C,2000
JRST POPJM2]>
HRRM C,MLTP ;PUT IN NEW MLTP
HLL C,W ;FORM BLT POINTER
ADDI W,(C) ;LAST ENTRY OF MLTP
HRL W,BLKSIZ ;NEW SIZE OF MLTP
HLLM W,MLTP ;...
SLTC: BLT C,0(W); MOVE DOWN (UP?)
POPJ P,;
SPLT: SUB C,BLKSIZ
MOVS W,MLTP;
ADDM C,PLTP
ADD C,MLTP
IFN EXPAND,< HRRZS C
CAIG C,@X
PUSHJ P,[PUSHJ P,XPAND
POPJ P,
ADD W,[XWD 2000,0]
ADDI C,2000
JRST POPJM2]>
HRRM C,MLTP ;PUT IN NEW MLTP
HLL C,W
HLRZ W,PLTP ;OLD SIZE OF PL TABLE
ADD W,PLTP ;NEW BASE OF PL TABLE
HRL W,BLKSIZ ;NEW SIZE OF PL TABLE
HLLM W,PLTP ;INTO POINTER
JRST SLTC
PT1: 0
;PROCESS END CODE WORD
ENDS: PUSHJ P,WORD; GET STARTING ADDRESS
TLNE F,SKIPSW
JRST ENDS1 ;FOOBAZ!!!!!!!!
JUMPE W,ENDS1; NOT MAIN
ADDI W,(R); RELOCATION OFFSET
TLNN N,ISAFLG; IGNORE STARTING ADDRESS
HRR F,W; SET SA
IFN STANSW,<MOVE W,1(N) ;SET UP NAME
PUSHJ P,LDNAM>
ENDS1: PUSHJ P,WORDPR ;DATA STORE SIZE
HRRZM C,PTEMP ;NUMBER OF PERMANENT TEMPS
MOVEM V,CCON; START OF CONSTANTS AREA
JUMPE W,E1; NULL
MOVEM W,BLKSIZ ;SAVE COUNT
MOVEI W,0(V) ;DEFINE CONST.
MOVE C,CNR50 ;...
TLNN F,SKIPSW!FULLSW
PUSHJ P,SYMPT ;...
PUSHJ P,GSWD ;STORE CONSTANT TABLE
E1: MOVEI W,0(V); GET LOADER LOC
EXCH W,PTEMP; STORE INTO PERM TEMP POINTER
ADD W,PTEMP; FORM TEMP TEMP ADDRESS
MOVEM W,TTEMP; POINTER
MOVEM V,GSTAB; STORE LOADER LOC IN GLOBSUB
MOVE C,TTR50 ;DEFINE %TEMP.
TLNE F,SKIPSW!FULLSW
JRST E1A
PUSHJ P,SYMPT ;...
MOVE C,PTR50 ;DEFINE (IF EXTANT) TEMP.
MOVEI W,0(V) ;...
CAME W,TTEMP ;ANY PERM TEMPS?
PUSHJ P,SYMPT ;YES, DEFINE
E1A: PUSHJ P,WORD; NUMBER OF GLOBSUBS
JUMPE W,E11
MOVEM W,BLKSIZ ;SIZE OF GLOBSUB
PUSHJ P,GSWD ;STORE GLOBSUB TABLE
E11: MOVEM V,STAB; SCALARS
PUSHJ P,WORD; HOW MANY?
JUMPE W,E21; NONE
PUSHJ P,GSWDPR ;STORE SCALAR TABLE
E21: MOVEM V,ATAB; ARRAY POINTER
PUSHJ P,WORD; COMMENTS FOR SCALARS APPLY
JUMPE W,E31
PUSHJ P,GSWDPR ;STORE ARRAY TABLE
E31: MOVEM V,AOTAB; ARRAYS OFFSET
PUSHJ P,WORD; SAME COMMENTS AS ABOVE
JUMPE W,E41
PUSHJ P,GSWDPR ;STORE ARRAY OFFSET TABLE
E41: PUSHJ P,WORD; TEMP, SCALAR, ARRAY SIZE
TLNE F,FULLSW!SKIPSW ;SKIPPING THIS PROG?
MOVEI W,0 ;DON'T ACCEPT GLOB SUBPROG REQUESTS
MOVEM V,CTAB; SETUP COMMON TABLE POINTER
ADD W,GSTAB; GLOBAL SUBPROG BASE
MOVEM W,COMBAS; START OF COMMON
PUSHJ P,WORD; COMMON BLOCK SIZE
HRRZM W,BLKSIZ
JUMPE W,PASS2; NO COMMON
COMTOP: PUSHJ P,WORDPR ;GET A COMMON PAIR
PUSHJ P,SDEF; SEARCH
JRST COMYES; ALREADY THERE
HRLS W
HRR W,COMBAS; PICK UP THIS COMMON LOC
TLNN F,SKIPSW!FULLSW
PUSHJ P,SYMXX; DEFINE IT
MOVS W,W; SWAP HALFS
ADD W,COMBAS; UPDATE COMMON LOC
HRRM W,COMBAS; OLD BASE PLUS NEW SIZE
HLRZS W; RETURN ADDRESS
TLZ C,400000
TLNN F,SKIPSW!FULLSW
PUSHJ P,SYMXX
COMCOM: PUSHJ P,CWSTWX ;STORE A WORD PAIR
SOS BLKSIZ
SOSLE BLKSIZ
JRST COMTOP
JRST PASS2
COMYES: TLNE F,SKIPSW
JRST COMCOM ;NO ERRORS IF SKIPPING
HLRZ C,2(A); PICK UP DEFINITION
CAMLE W,C; CHECK SIZE
JRST ILC; ILLEGAL COMMON
MOVE C,1(A); NAME
HRRZ W,2(A); BASE
JRST COMCOM
PRSTWX: PUSHJ P,WORDPR ;GET A WORD PAIR
CWSTWX: EXCH C,W ;SPACE TO STORE FIRST WORD OF PAIR?
PUSHJ P,WSTWX ;...
EXCH C,W ;THERE WAS; IT'S STORED
WSTWX: TLNE F,FULLSW!SKIPSW ;SPACE FOR ANOTHER WORD?
POPJ P, ;NOPE, RETURN
MOVEM W,@X ;YES, STORE IT.
JRST BITWX ;TELL THE TABLES ABOUT IT; THEN RETURN
GSWD: PUSHJ P,WORD ;GET WORD FROM TABLE
PUSHJ P,WSTWX ;STASH IT
SOSE BLKSIZ ;FINISHED?
JRST GSWD ;NOPE, LOOP
POPJ P, ;TRA 1,4
GSWDPR: MOVEM W,BLKSIZ ;KEEP COUNT
GSWDP1: PUSHJ P,PRSTWX ;GET AND STASH A PAIR
SOS BLKSIZ ;FINISHED?
SOSLE BLKSIZ ;...
JRST GSWDP1 ;NOPE, LOOP
POPJ P, ;TRA 1,4
;BEGIN HERE PASS2 TEXT PROCESSING
PASS2: ADDI V,(X)
MOVEM V,TOPTAB ;SAVE FOR OVERLAP CHECKING
TLNE F,FULLSW+SKIPSW; ABORT?
JRST ALLOVE; YES
MOVE V,LLC ;PICK UP PROGRAM ORIGIN
CAML V,CCON ;IS THIS A PROGRAM?
JRST FBLKD ;NO, GO LOOK FOR FIRST BLK DATA
TLOE N,PGM1 ;YES, IS THIS FIRST F4 PROG?
JRST NOPRG ;NO
HRR W,COMBAS ;YES, PLACE PROG BREAK IN LH
IFE L,< HRLM W,JOBCHN(X) ;FOR CHAIN>
NOPRG: HRRZ W,PLTP; GET PROG TABLE BASE
HLRZ C,PLTP; AND SIZE
ADD W,C; COMPUTE END OF PROG TABLE
ADD W,[POINT 1,1]; AND BEGINNING OF BIT TABLE
EXCH W,BITP; SWAP POINTERS
PASS2B: ILDB C,BITP; GET A BIT
JUMPE C,PASS2C; NO PASS2 PROCESSING
PUSHJ P,PROC; PROCESS A TAG
JRST PASS2B; MORE TO COME
JRST ENDTP;
PROC: LDB C,[POINT 6,@X,23]; TAG
SETZM MODIF; ZERO TO ADDRESS MODIFIER
TRZE C,40;
AOS MODIF
HRLM C,ENDTAB; ERROR SETUP
MOVEI W,TABDIS; HEAD OF TABLE
HLRZ T,(W); GET ENTRY
CAME T,C; CHECK
AOJA W,.-2
HRRZ W,(W); GET DISPATCH
LDB C,[POINT 12,@X,35]
JRST (W); DISPATCH
TABDIS: XWD 11,PCONS; CONSTANTS
XWD 06,PGS; GLOBAL SUBPROGRAMS
XWD 20,PST; SCALARS
XWD 22,PAT; ARRAYS
XWD 01,PATO; ARRAYS OFFSET
XWD 00,PPLT; PROGRAMMER LABELS
XWD 31,PMLT; MADE LABESL
XWD 26,PPT; PERMANENT TEMPORARYS
XWD 27,PTT; TEMPORARY TEMPORARYS
ENDTAB: XWD 00,LOAD4A; ERRORS
PASS2C: PUSHJ P,PASS2A
JRST PASS2B
JRST ENDTP
;DISPATCH ON A HEADER
HEADER: CAMN W,[EXP -2]; END OF PASS ONE
JRST ENDS
LDB C,[POINT 12,W,35]; GET SIZE
MOVEM C,BLKSIZ
ANDI W,770000
JUMPE W,PLB; PROGRAMMER LABEL
CAIN W,500000; ABSOLUTE BLOCK
JRST ABSI;
CAIN W,310000; MADE LABEL
JRST MDLB; MADE LABEL
CAIN W,600000
JRST GLOBDF
CAIN W,700000; DATA STATEMENT
JRST DATAS
JRST LOAD4A; DATA STATEMENTS WILL GO HERE
TOPTAB: 0 ;TOP OF TABLES
CTAB: 0; COMMON
ATAB: 0; ARRAYS
STAB: 0; SCALARS
GSTAB: 0; GLOBAL SUBPROGS
AOTAB: 0; OFFSET ARRAYS
CCON: 0; CONSTANTS
PTEMP: 0; PERMANENT TEMPS
TTEMP: 0; TEMPORARY TEMPS
COMBAS: 0; BASE OF COMMON
LLC: 0; PROGRAM ORIGIN
BITP: 0; BIT POINTER
BITC: 0; BIT COUNT
PLTP: 0; PROGRAMMER LABEL TABLE
MLTP: 0; MADE LABEL TABLE
SDS: 0 ;START OF DATA STATEMENTS
SDSTP: 0 ;START OF DATA STATEMENTS POINTER
BLKSIZ: 0; BLOCK SIZE
MODIF: 0; ADDRESS MODIFICATION +1
TTR50: XWD 136253,114765 ;RADIX 50 %TEMP.
PTR50: XWD 100450,614765 ;RADIX 50 TEMP.
CNR50: XWD 112320,235025 ;RADIX 50 CONST.
;ROUTINES TO PROCESS POINTERS
PCONS: ADD C,CCON; GENERATE CONSTANT ADDRESS
SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY
PSTA: PUSHJ P,SWAPSY ;NON-COMMON SCALARS AND ARRAYS
ADDI C,(R); RELOCATE
PCOM1: PUSHJ P,SYDEF ;...
PCOMX: ADD C,MODIF ;ADDR RELOC FOR DP
HRRM C,@X; REPLACE ADDRESS
PASS2A: AOS V; STEP READOUT POINTER
CAML V,CCON ;END OF PROCESSABLES?
CPOPJ1: AOS (P); SKIP
POPJ P,;
PAT: SKIPA W,ATAB ;ARRAY TABLE BASE
PST: MOVE W,STAB ;SCALAR TABLE BASE
ROT C,1 ;SCALE BY 2
ADD C,W ;ADD IN TABLE BASE
ADDI C,-2(X); TABLE ENTRY
HLRZ W,(C); CHECK FOR COMMON
JUMPE W,PSTA; NO COMMON
PUSHJ P,COMDID ;PROCESS COMMON
JRST PCOM1
COMDID: LSH W,1 ;PROCESS COMMON TABLE ENTRIES
ADD W,CTAB; COMMON TAG
ADDI W,-2(X); OFFSET
PUSHJ P,SWAPSY; GET SYMBOL AND SET TO DEFINED
ADD C,1(W); BASE OF COMMON
POPJ P, ;RETURN
PATO: ROT C,1
ADD C,AOTAB; ARRAY OFFSET
ADDI C,-2(X); LOADER OFFSET
MOVEM C,CT1; SAVE CURRENT POINTER
HRRZ C,1(C); PICK UP REFERENCE POINTER
ANDI C,7777; MASK TO ADDRESS
ROT C,1; ALWAYS A ARRAY
ADDI C,-2(X)
ADD C,ATAB
HLRZ W,(C); COMMON CHECK
JUMPE W,NCO
PUSHJ P,COMDID ;PROCESS COMMON
PUSHJ P,SYDEF
MOVE C,CT1
HRRE C,(C)
ADD C,1(W)
JRST PCOMX
NCO: PUSHJ P,SWAPSY;
ADDI C,(R) ;DEFINE SYMBOL IN TRUE LOC
PUSHJ P,SYDEF ;...
MOVE C,CT1
HRRZ C,(C) ;OFFSET ADDRESS PICKUP
ADDI C,(R) ;WHERE IT WILL BE
JRST PCOMX ;STASH ADDR AWAY
PTT: ADD C,TTEMP; TEMPORARY TEMPS
SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY
PPT: ADD C,PTEMP; PERMANENT TEMPS
SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY
PGS: ADD C,GSTAB; GLOBSUBS
ADDI C,-1(X); OFFSET
MOVE C,(C)
TLC C,640000; MAKE A REQUEST
PUSHJ P,TBLCHK ;CHECK FOR OVERLAP
MOVEI W,(V); THIS LOC
HLRM W,@X; ZERO RIGHT HALF
PUSHJ P,SYMXX
JRST PASS2A
SYDEF: TLNE N,SYDAT ;SYMBOL WANTS DEFININITION?
POPJ P, ;NO, GO AWAY
PUSH P,C ;SAVE THE WORLD
PUSH P,W
PUSHJ P,TBLCHK ;CHECK FOR OVERLAP
MOVE W,C
SKIPE C,T ;PICKUP VALUE
PUSHJ P,SYMXX
POP P,W
POP P,C
POPJ P,;
PMLT: ADD C,MLTP
SKIPA
PPLT: ADD C,PLTP
HRRZ C,(C)
JRST PCOMX
SYMXX: PUSH P,V
PUSHJ P,SYMPT
POP P,V
POPJ P,;
SWAPSY: MOVEI T,0; SET TO EXCHANGE DEFS
EXCH T,1(C); GET NAME
HRRZ C,(C) ;GET VALUE
POPJ P,
TBLCHK: HRRZ W,MLTP ;GETT TOP OV TABLES
SUBI W,2
CAMG W,TOPTAB ;WILL IT OVERLAP
IFE EXPAND,<TLO F,FULLSW>
IFN EXPAND,< JRST [PUSHJ P,XPAND
TLOA F,FULLSW
JRST TBLCHK
JRST .+1]>
POPJ P,
;END OF PASS2
ALLOVE: TLZ N,F4SW ;END OF F4 PROG
TLNE F,FULLSW!SKIPSW
JRST HIGH3
HRR R,COMBAS ;TOP OF THE DATA
HRR V,R ;IS THIS THE HIGHEST LOC YET?
CAIG H,@X ;...
MOVEI H,@X ;YES, TELL THE WORLD
CAMG H,SDS ;HIGHEST LOC GREATER THAN DATA STATEMENTS?
JRST HIGH3 ;NO, RETURN
ADDI H,1(S) ;YES, SET UP MEANINGFUL ERROR COMMENT
SUB H,SDS ;...
TLO F,FULLSW ;INDICATE OVERFLO
JRST HIGH3 ;RETURN
DATAS: TLNE F,FULLSW+SKIPSW
JRST DAX
MOVEI C,(S) ;ADDR OF WORD UNDER SYMBOL TABLE
MOVN W,BLKSIZ ;HOW FAR DOWN TO BLT
ADDM W,PLTP ;UPDATE TABLE POINTERS
ADDM W,BITP ;...
ADDM W,SDSTP ;...
ADD C,W ;RH(C):= WHEN TO STOP BLT
HRL C,MLTP ;SOURCE OF BLTED DATA
ADD W,MLTP ;UPDATE, GET DESTINATION OF BLT DATA
IFN EXPAND,< HRRZS W ;GET RID OF LEFT HALF
CAIG W,@X
PUSHJ P,[PUSHJ P,XPAND
POPJ P,
ADDI W,2000
ADD C,[XWD 2000,2000]
JRST POPJM2]>
HRRM W,MLTP ;NO SET THIS SO EXTRA CORE NOT ZEROED
HLL W,C ;FORM BLT POINTER
BLT W,-1(C) ;MOVE TABLES DOWN (BUT NOT JRST ALLOVE)
PUSHJ P,BITWX+1
DAX: PUSHJ P,WORD; READ ONE WORD
TLNN F,FULLSW+SKIPSW
MOVEM W,(C)
SOSLE BLKSIZ ;COUNT OF DATA SEQUENCE SIZE
AOJA C,DAX ;INCREMENT DATA SEQUENCE DEPOSIT LOC
JRST TEXTR; DONE
FBLKD: TLOE N,BLKD1 ;IS THIS FIRST BLOCK DATA?
JRST ENDTP ;NO
HRR V,COMBAS ;PLACE PROG BREAK IN RH FOR
IFE L,< HRRM V,JOBCHN(X) ;CHAIN>
ENDTP: TLNE F,FULLSW+SKIPSW
JRST ALLOVE
HRR V,GSTAB
ENDTP0: CAML V,STAB; ANY MORE GLOBSUBS
JRST ENDTP2; NO
MOVE C,@X; GET SUBPROG NAME
PUSHJ P,SREQ; IS IT ALLREADY REQUESTED
AOJA V,ENDTP0; YES
PUSHJ P,SDEF; OR DEFINED
AOJA V,ENDTP0; YES
PUSHJ P,TBLCHK
MOVEI W,0 ;PREPARE DUMMY LINK
TLNN F,FULLSW+SKIPSW; ABORT
PUSHJ P,SYM3X; PUT IN DUMMY REQUEST
PUSHJ P,BITWX+1; OVERLAP CHECK
AOJA V,ENDTP0
ENDTP2: SETZM PT1
HRR V,SDSTP
IFN EXPAND,< SUBI V,(X)
CAMG V,COMBAS
JRST [PUSHJ P,XPAND
TLOA F,FULLSW
JRST .-3
JRST .+1]
HRR V,SDSTP>
HRRZM V,SDS ;DATA STATEMENT LOC
ENDTP1: SUBI V,(X); COMPENSATE FOR OFFSET
MOVE W,@X; GET WORD
TLNE W,-1; NO LEFT HALF IMPLIES COUNT
JRST DODON; DATA DONE
ADD W,[MOVEI W,3]
ADDI W,@X
EXCH W,@X
AOS V
ADD W,@X; ITEMS COUNT
MOVEM W,ITC
MOVE W,[MOVEM W,LTC]
MOVEM W,@X; SETUP FOR DATA EXECUTION
AOS V
MOVE W,[MOVEI W,0]
EXCH W,@X
MOVEM W,ENC; END COUNT
AOS V
MOVEI W,@X
ADDM W,ITC
LOOP: MOVE W,@X
HLRZ T,W; LEFT HALF INST.
ANDI T,777000
CAIN T,254000 ;JRST?
JRST WRAP ;END OF DATA
CAIN T,260000 ;PUSHJ?
JRST PJTABL(W) ;DISPATCH VIA TABLE
CAIN T,200000; MOVE?
AOJA V,INNER
CAIN T,270000; ADD?
JRST ADDOP
CAIN T,221000; IMULI?
AOJA V,LOOP
CAIE T,220000; IMUL?
JRST LOAD4A; NOTA
INNER: HRRZ T,@X; GET ADDRESS
TRZE T,770000; ZERO TAG?
SOJA T,CONPOL; NO, CONSTANT POOL
SUB T,PT1; SUBTRACT INDUCTION NUMBER
ASH T,1
SOS T; FORM INDUCTION POINTER
HRRM T,@X
HLRZ T,@X
ADDI T,P
HRLM T,@X
AOJA V,LOOP
CONPOL: ADD T,ITC; CONSTANT BASE
HRRM T,@X
AOJA V,LOOP
ADDOP: HRRZ T,@X
TRZE T,770000
SOJA T,CONPOL
SKIPIN: AOJA V,LOOP
PJTABL: JRST DWFS ;PUSHJ 17,0
AOSA PT1 ;INCREMENT DO COUNT
SOSA PT1; DECREMENT DO COUNT
SKIPA W,[EXP DOINT.]
MOVEI W,DOEND.
HRRM W,@X
AOJA V,SKIPIN ;SKIP A WORD
DWFS: MOVEI W,DWFS.
HRRM W,@X
AOS V
TLO N,SYDAT
PUSHJ P,PROC; PROCESS THE TAG
JRST LOAD4A ;DATA STATEMENT BELOW CODE TOP
JRST LOOP ;PROPER RETURN
DOINT.: POP P,V; GET ADDRESS OF INITIAL VALUE
PUSH P,(V); STORE INDUCTION VARIABLE
AOS V
PUSH P,V; INITIAL ADDRESS
JRST (V)
DOEND.: HLRZ T,@(P)
ADDM T,-2(P); INCREMENT
HRRZ T,@(P); GET FINAL VALUE
CAMGE T,-2(P); END CHECK
JRST DODONE; WRAP IT UP
POP P,(P); BACK UP POINTER
JRST @(P)
DODONE: POP P,-1(P); BACK UP ADDRESS
POP P,-1(P)
JRST CPOPJ1 ;RETURN
WRAP: MOVE W,ENC; NUMBER OF CONSTANTS
ADD W,ITC; CONSTANT BASE
MOVEI C,(W); CHAIN
HRRM C,@X
MOVEI V,(W); READY TO GO
JRST ENDTP1
DODON: TLZ N,RCF!SYDAT!DZER ;DATA STATEMENT FLAGS
MOVE W,PTEMP ;TOP OF PROG
ADDI W,(X) ;+OFFSET
MOVE C,COMBAS ;TOP OF DATA
ADDI C,(X) ;+OFFSET
SECZER: CAML W,C ;ANY DATA TO ZERO?
JRST @SDS ;NO, DO DATA STATEMENTS
CAML W,SDS ;IS DATA BELOW DATA STATEMENTS?
TLO F,FULLSW ;NO, INDICATE OVERFLO
TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO?
SETZM (W) ;YES, DO SO
TLON N,DZER ;GO BACK FOR MORE?
AOJA W,SECZER ;YES, PLEASE
CAMLE C,SDS ;ALL DATA BELOW DATA STATEMENTS?
MOVE C,SDS ;ALL ZEROED DATA MUST BE
HRLI W,-1(W) ;SET UP BLT POINTER TO ZERO DATA
TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO?
BLT W,-1(C) ;YES, DO SO
JRST @SDS ;GO DO DATA STATEMENTS
DREAD: TLNE N,RCF; NEW REPEAT COUNT NEEDED
JRST FETCH; NO
MOVE W,LTC
MOVEM W,LTCTEM
MOVE W,@LTC; GET A WORD
HLRZM W,RCNT; SET REPEAT COUNT
HRRZM W,WCNT; SET WORD COUNT
POP W,(W); SUBTRACT ONE FROM BOTH HALFS
HLLM W,@LTC; DECREMENT REPEAT COUNT
AOS W,LTC; STEP READOUT
TLO N,RCF
FETCH: MOVE W,@LTC
AOS LTC
SOSE WCNT
POPJ P,;
SOSN RCNT
JRST DOFF.
MOVE V,LTCTEM; RESTORE READOUT
MOVEM V,LTC
DOFF.: TLZ N,RCF; RESET DATA REPEAT FLAG
POPJ P,;
DWFS.: MOVE T,(P)
AOS (P)
MOVE T,(T); GET ADDRESS
HLRZM T,DWCT; DATA WORD COUNT
HRRES T
ADD T,W; OFFSET
ADDI T,(X); LOADER OFFSET
DWFS.1: PUSHJ P,DREAD ;GET A DATA WORD
CAML T,SDS ;BELOW BEGINNING OF DATA STATEMENTS
TLO F,FULLSW ;YES, INDICATE OVERFLO
TLNN F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM?
MOVEM W,(T) ;YES, STORE IT
AOS T
SOSE W,DWCT; STEP DOWN AND TEST
JRST DWFS.1 ;ONE MORE TIME, MOZART BABY!
POPJ P,;
;LITERAL TABLE
LITS: LIT
VAR
CT1: 0 ;TEMP FOR C
LTC: 0
ITC: 0
ENC: 0
WCNT: 0 ;DATA WORD COUNT
RCNT: 0 ;DATA REPEAT COUNT
LTCTEM: 0 ;TEMP FOR LTC
DWCT: 0 ;DATA WORD COUNT
IFE L,<
IFE HE,<
LDEND: END LD
>>
IFN HE,<
LDEND: END>
IFN L,<
LDEND:
LODMAK: MOVEI A,LODMAK
MOVEM A,137
INIT 17
SIXBIT /DSK/
0
HALT
ENTER LMFILE
HALT
OUTPUT [IOWD 1,LMLST ;OUTPUT LENGTH OF FILE
0]
OUTPUT LMLST
STATZ 740000
HALT
RELEASE
CALL [SIXBIT /EXIT/]
LMFILE: SIXBIT /LISP/
SIXBIT /LOD/
0
0
LMLST: IOWD LODMAK+1-LD,137
0
END LODMAK>