Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
loader.mac
There are 9 other files named loader.mac in the archive. Click here to see a list.
TITLE LOADER V.057
SUBTTL RP GRUEN/NGP/WFW/DMN 1-JUNE-73
;COPYRIGHT 1968,1969,1970,1971,1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
VLOADER==57
VUPDATE==0 ;DEC UPDATE LEVEL
VEDIT==151 ;EDIT LEVEL
VCUSTOM==0 ;NON-DEC UPDATE LEVEL
LOC <.JBVER==137>
<VCUSTOM>B2+<VLOADER>B11+<VUPDATE>B17+VEDIT
RELOC
COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)
SWITCHES ON (NON-ZERO) IN DEC VERSION
PURESW GIVES PURE CODE (VARIABLES IN LOW SEG)
REENT GIVES REENTRANT CAPABILITY PDP-10
(REENT=0 FOR PDP-10/30 OR PDP-6 OR EARLY PDP-10)
RPGSW INCLUDE CCL FEATURE
TEMP INCLUDE TMPCOR FEATURE
DMNSW SYMBOL TABLE WILL BE MOVED DOWN FROM TOP OF CORE
KUTSW GIVES CORE CUTBACK ON /K
EXPAND FOR AUTOMATIC CORE EXPANSION
PP ALLOW PROJ-PROG #
NAMESW USE SETNAM UUO TO CHANGE PROGRAM NAME
DIDAL GIVES DIRECT ACCESS LIBRARY SEARCH MODE
ALGSW WILL LOAD ALGOL OWN BLOCK (TYPE 15)
COBSW WILL LOAD COBAL LOCAL SYMBOLS (BLOCK TYPE 37)
SFDSW NUMBER OF SFDS ALLOWED IF NON-ZERO
CPUSW LOADER WILL TEST FOR KI/KA-10 AND LOAD CORRECT LIB40
FORSW DEFAULT VALUE OF FORSE/FOROTS FORTRAN OTS
B11SW INCLUDE POLISH FIXUP BLOCK (TYPE 11)
SWITCHES OFF (ZERO) IN DEC VERSION
K GIVES SMALLER LOADER - NO F4
L FOR LISP LOADER
SPMON GIVES SPMON LOADER (MONITOR LOADER)
MONLOD GIVES MONITOR LOADER WHICH USES DISK AS CORE IMAGE
TEN30 FOR 10/30 LOADER
STANSW GIVES STANFORD FEATURES
LNSSW GIVES LNS VERSION
FAILSW INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS.
LDAC MEANS LOAD CODE INTO ACS
(LDAC DOES NOT WORK WITH KUTSW=1.CORE UUO CLEARS JOBBLT)
WFWSW GIVES BLOCK TYPE 13 (VARIABLS INTO LOW SEG)
SYMARG ACCEPT SYMBOLIC (GLOBAL) ARGUMENTS FOR SWITCHES
SPCHN WILL DO SPECIAL OVERLAYING
NELSW FOR NELIAC COMPILER
SAILSW GIVES BLOCK TYPE 16 (FORCE LOAD OF REL FILES)
AND 17 (FORCE SEARCH OF LIBRARIES) FOR SAIL
MANTIS WILL LOAD BLOCK 401 FOR F4 MANTIS DEBUGGER
SYMDSW LOADER WILL STORE SYMBOLS ON DSK
TENEX SPECIAL CODE IF RUNING UNDER TENEX
*
SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS
IFNDEF SPMON,<SPMON=0>
IFN SPMON,< TEN30==1
K==1>
IFNDEF L,<L=0>
IFNDEF TEN30,<TEN30=0>
IFN TEN30!L,< RPGSW=0
PP=0
IFNDEF DMNSW,< DMNSW=0>
ALGSW=0
COBSW=0
PURESW=0
REENT=0
LDAC=0
KUTSW=0
NAMESW=0>
IFN TEN30,< EXPAND=0
IFNDEF DIDAL,< DIDAL=0>
>
IFNDEF MONLOD,<MONLOD=0>
IFN MONLOD,<K==1
ALGSW=0
COBSW=0
DIDAL=0
REENT=0
B11SW==0
SYMDSW==0
EXPAND==1>
IFNDEF K,<K=0>
IFNDEF STANSW,<STANSW=0>
IFN STANSW,< TEMP==0
REENT==0
FAILSW=1>
IFNDEF LNSSW,<LNSSW=0>
IFN LNSSW,<LDAC=1
PP=0>
IFNDEF FAILSW,<FAILSW==0>
IFN FAILSW,<B11SW==1>
IFNDEF B11SW,<B11SW==1>
IFNDEF RPGSW,<RPGSW==1>
IFN RPGSW,<PP==1> ;REQUIRE DISK FOR CCL
IFE RPGSW,<TEMP=0>
IFN L,<PP==1>
IFNDEF PP,<PP==1>
IFNDEF TEMP,<TEMP==1>
IFNDEF NAMESW,<NAMESW==1>
IFNDEF LDAC,<LDAC=0>
IFN LDAC,<KUTSW=0>
IFNDEF KUTSW,<KUTSW==1>
IFNDEF EXPAND,< IFN K,<EXPAND==0>
IFE K,<EXPAND==1>>
IFNDEF DMNSW,<DMNSW==1>
IFN DMNSW!LDAC,<IFNDEF SYMPAT,<SYMPAT==100>
IFN LDAC,<IFG 20-SYMPAT,<SYMPAT==20>>>
IFNDEF REENT,<REENT==1>
IFNDEF PURESW,<PURESW==1>
IFNDEF WFWSW,<WFWSW==0>
IFN K,<SYMARG=0
SPCHN=0>
IFNDEF SYMARG,<SYMARG==0>
IFNDEF SPCHN,<SPCHN==0>
IFNDEF DIDAL,<DIDAL==1>
IFNDEF ALGSW,<ALGSW==1>
IFNDEF COBSW,<COBSW==1>
IFNDEF SAILSW,<SAILSW==0>
IFNDEF NELSW,<NELSW==0>
IFN K,<MANTIS==0>
IFNDEF MANTIS,<MANTIS==0>
IFE PP,<SFDSW==0>
IFNDEF SFDSW,<SFDSW==5>
IFNDEF CPUSW,<CPUSW==1>
IFNDEF FORSW,<FORSW==2> ;1=FORSE, 2=FOROTS
IFNDEF SYMDSW,<SYMDSW==0>
IFN SYMDSW,<DIDAL==0> ;BOTH USE AUX BUFFER
IFNDEF TENEX,<TENEX==0>
SUBTTL ACCUMULATOR ASSIGNMENTS
F=0 ;FLAGS IN BOTH HALVES OF F
N=1 ;FLAGS IN BOTH HALVES OF N
X=2 ;LOADER OFFSET
H=3 ;HIGHEST LOC LOADED
S=4 ;UNDEFINED POINTER
R=5 ;RELOCATION CONSTANT
B=6 ;SYMBOL TABLE POINTER
D=7 ;COMMAND ARGUMENT (OCTAL) AND WORKSPACE
T=10
V=T+1
W=12 ;VALUE
C=W+1 ;SYMBOL, DECIMAL COMMAND ARGUMENT
E=C+1 ;DATA WORD COUNTER
Q=15 ;RELOCATION BITS
A=Q+1 ;SYMBOL SEARCH POINTER
P=17 ;PUSHDOWN POINTER
;MONITOR LOCATIONS IN THE USER AREA
.JBHDA==10
.JBSDD==114 ;SAVE POINTER TO JOBDDT
.JBS41==122 ;SAVE POINTER TO JOB41
INTERN .JBVER,.JBHDA,.JBSDD,.JBS41
EXTERN .JBDDT,.JBFF,.JBSA,.JBREL,.JBSYM,.JBUSY,.JB41,.JBHRL,.JBCOR
EXTERN .JBCHN,.JBERR,.JBBLT,.JBAPR,.JBDA,.JBHSM
NEGOFF==400 ;NEGATIVE OFFSET OF HIGH SEGMENT
PDLSIZ==40 ;LENGTH OF PUSHDOWN STACK
PPDL==60 ;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS
;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
HIPROG==40 ;LOADING HI PROGRAM, SET BY HISEG. CLEARED BY EOF
ASW==100 ;ON - LEFT ARROW ILLEGAL
FULLSW==200 ;ON - STORAGE EXCEEDED
SLIBSW==400 ;ON - LIB SEARCH IN THIS PROG
RMSMSW==1000 ;REMEMBER IF LOADING WITH SYMBOLS DURING LIB SEARCH
REWSW==2000 ;ON - REWIND AFTER INIT
LIBSW==4000 ;ON - LIBRARY SEARCH MODE
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
;MORE FLAGS IN F (18-35)
SEENHI==1 ;HAVE SEEN HI STUFF
NOHI==2 ;LOAD AS NON-REENTRANT
NOTTTY==4 ;DEV "TTY" IS NOT A TTY
NOHI6==10 ;PDP-6 TYPE SYSTEM
HISYM==20 ;BLT SYMBOLS INTO HIGH SEGMENT
SEGFL==40 ;LOAD INTO HI-SEG
XFLG==100 ;INDEX IN CORE (BLOCK TYPE 14)
LSTLOD==200 ;LAST PROG WAS LOADED
DTAFLG==400 ;LIBRARY DEVICE IS A DTA (NEEDED FOR INDEXING)
DMNFLG==1000 ;SYMBOL TABLE TO BE MOVED DOWN
SFULSW==2000 ;PRINTED SYMBOL OVERLAP ONCE ALREADY
ARGFL==4000 ;TREAT $%. AS RADIX-50 CHAR.
TWOFL==10000 ;TWO SEGMENTS IN THIS BINARY FILE
LOCAFL==20000 ;PRINT LOCAL SYMBOLS IN MAP
TTYFL==40000 ;AUX. DEV. IS TTY
TRMFL==100000 ;END OF LOADING SEEN ($ OR /G)
KICPFL==200000 ;HOST CPU IS A KI-10
LSYMFL==400000 ;STORE LOCAL SYMBOLS ON DSK
;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>
IFN MONLOD,<DISW==10 ;DISK IMAGE LOAD IN PROGRESS
WOSW==20 ;WRITE OUT SWITCH, DATA IN WINDOW HAS CHANGED>
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
RPGF==10000 ;IN RPG MODE
AUXSWI==20000 ;ON - AUX. DEVICE INITIALIZED
AUXSWE==40000 ;ON - AUX. DEVICE ENTERED
PPSW==100000 ;ON - READING PROJ-PROG #
PPCSW==200000 ;ON - READING PROJ #
HSW==400000 ;USED IN BLOCK 11 POLISH FIXUPS
;MORE FLAGS IN N (18-35)
F4FL==400000 ;FORTRAN (F40) SEEN
COBFL==200000 ;COBOL SEEN
ALGFL==100000 ;ALGOL SEEN
NELFL==40000 ;NELIAC SEEN
PL1FL==20000 ;PL/1 SEEN
BLIFL==10000 ;BLISS-10
SAIFL==4000 ;SAIL
FORFL==2000 ;FORTRAN-10
F10TFL==1000 ;FORTRAN-10 CODE FOR THIS FILE SET NOHI (TEMP)
KI10FL==400 ;KI-10 ONLY CODE
KA10FL==200 ;KA-10 ONLY CODE
MANTFL==100 ;MANTIS SEEN, LOAD SPECIAL DATA
SYMFOR==40 ;SYMSW FORCED SET
MAPSUP==20 ;SUPRESS SYBOL TABLE OUTPUT
CHNMAP==10 ;MAP FOR SPCHN ROOT SEGMENT PRINTED
ATSIGN==4 ;AT SIGN - INDIRECT COMMAND
ENDMAP==2 ;DELAY MAP TO END
VFLG==1 ;DEFAULT LOAD REENTRANT OPERATION SYSTEM
COMFLS==F4FL!COBFL!ALGFL!NELFL!PL1FL!BLIFL!SAIFL!FORFL
DEFINE ERROR (X,Y)<
JSP A,ERRPT'X
XLIST
SIXBIT Y
LIST>
IFN TENEX,<
OPDEF JSYS [104B8]
OPDEF SEVEC [JSYS 204]
OPDEF GEVEC [JSYS 205]
OPDEF GET [JSYS 200]
OPDEF GTJFN [JSYS 20]
OPDEF CIS [JSYS 141]
OPDEF DIR [JSYS 130]
>
IFN PURESW,<TWOSEGMENTS
RELOC 400000>
DSKBIT==200000 ;FOR USE WITH DEVCHR
DTABIT==100 ;DITTO
DISIZE=2000 ;CORE WINDOW SIZE
.RBEST==10 ;ESTIMATED SIZE OF BLOCK (SYMBOL)
.RBALC==11 ;ALLOCATED SIZE OF BLOCK (SYMBOL)
DALLOC==^D500 ;PREALLOCATE SOME SPACE
DSKBLK==200 ;LENGTH OF DISK BLOCKS
DTABLK==177 ;LENGTH OF DECTAPE BLOCKS (EXCLUDING LINK WORD)
VECLEN==^D25 ;LENGTH OF VECTOR TABLE FOR OVERLAYS
RELLEN==^D5 ;#NUMBER OF REL FILES OR LIBRARIES (MUST BE SAME)
;BUFFER SIZES
TTYL==52 ;TWO TTY BUFFERS
IFNDEF BUFN,<BUFN==2 ;TWO DATA BUFFERS FOR LOAD>
IFE LNSSW,<
BUFL==BUFN*203 ;'BUFN' DTA BUFFERS FOR LOAD
ABUFL==203 ;ONE DTA BUFFER FOR AUX DEV>
IFN LNSSW,<
IFE K,<BUFL==4*203+1>
IFN K,<BUFL==203+1>
ABUFL==2*203+1>
;CALLI DEFINITIONS
OPDEF RESET [CALLI 0]
OPDEF SETDDT [CALLI 2]
OPDEF DDTOUT [CALLI 3]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF UTPCLR [CALLI 13]
OPDEF DATE [CALLI 14]
OPDEF MSTIME [CALLI 23]
OPDEF PJOB [CALLI 30]
OPDEF SETUWP [CALLI 36]
OPDEF REMAP [CALLI 37]
OPDEF GETSEG [CALLI 40]
OPDEF SETNAM [CALLI 43]
OPDEF TMPCOR [CALLI 44]
ASUPPRESS
MLON
SALL
SUBTTL INITIALIZATION
BEG: IFE L,< IFN RPGSW,<
TDZA F,F ;NORMAL START
SETO F, ;CCL START>
SETZM DATBEG ;ZERO FIRST WORD OF DATA STORAGE
MOVE N,[DATBEG,,DATBEG+1]
BLT N,DATEND-1 ;ZERO ENTIRE DATA AREA
IFN RPGSW,< ;IF NO CCL FALL THROUGH TO LD:
JUMPE F,LD ;CCL: IF NORMAL START GO TO LD
RESET ;RESET UUO.
IFN TEMP,<MOVEI F,CTLBUF-1 ;USE CCL BUFFER FOR COMMANDS
HRRM F,CTLIN+1 ;DUMMY UP BYTE POINTER
HRLI F,-200 ;MAKE IT AN IOWD
MOVEM F,TMPFIL+1
MOVSI F,'LOA'
MOVEM F,TMPFIL
MOVE N,[XWD 2,TMPFIL] ;POINTER FOR TMPCOR READ
TMPCOR N, ;READ AND DELETE LOA FILE
JRST RPGTMP ;NO SUCH FILE IN CORE, TRY DISK
IMULI N,5 ;GET CHAR COUNT
ADDI N,1
MOVEM N,CTLIN+2 ;STORE IN BUFFER HEADER
MOVEI N,700 ;BYTE POINTER FOR LOA FILE
HRLM N,CTLIN+1 ;BYTE POINTER NOW COMPLETE
SETOM TMPFLG ;MARK THAT A TMPCOR READ WAS DONE
JRST RPGS3C ;GET BACK IN MAIN STREAM
RPGTMP: ; NOT TMP>
INIT 17,1 ;SET UP DSK FOR COMMAND FILE INPUT.
SIXBIT /DSK/
XWD 0,CTLIN
JRST NUTS ;CAN'T INIT, GET INPUT FROM TTY.
MOVEI F,3
PJOB N, ;GET JOB NUMBER
LUP: IDIVI N,12 ;STRIP OFF LAST DIGIT
ADDI N+1,"0"-40 ;CONVERT TO SIXBIT
LSHC N+1,-6 ;SAVE
SOJG F,LUP ;3 DIGITS YET?
HRRI N+2,'LOA' ;LOADER NAME PART OF FILE NAME.
MOVEM N+2,CTLNAM
MOVSI 'TMP' ;AND EXTENSION.
MOVEM CTLNAM+1
LOOKUP 17,CTLNAM ;FILE THERE?
JRST NUTS ;NO.
INIT 16,1 ;GET SET TO DELETE FILE
SIXBIT /DSK/
0
JRST RPGS3A ;GIVE UP
SETZM CTLNAM+3 ;PUT STUFF BACK AS IT WAS
LOOKUP 16,CTLNAM
JRST RPGS3B
SETZM CTLNAM ;SET FOR RENAME
RENAME 16,CTLNAM
JFCL ;IGNORE FAILURE
RPGS3B: RELEASE 16, ;GET RID OF DEVICE
RPGS3A: ;WE HAVE NOT YET STARTED TO SCAN
;COMMAND IN FILE.
RPGS3: MOVEI CTLBUF
MOVEM .JBFF
INBUF 17,1 ;SET UP BUFFER.
RPGS3C: TTCALL 3,[ASCIZ /LOADING/] ;PRINT MESSAGE THAT WE ARE STARTING.
SKIPE NONLOD ;CONTIUATION OF COMMAND?
JRST RPGS2 ;YES, SPECIAL SETUP.
CCLCHN: MOVSI N,RPGF ;@ CHAIN FILES CYCLE FROM HERE
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 ;AS NAME
MOVEM W,DTIN ;STORE AS NAME
SETZM W,DTIN1 ;TRY BLANK EXTENSION FIRST.
JRST LDDT4]
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,.JBREL
SETOM NONLOD ;SET TO -1 AND SKIP CALLI
IFN TEMP,<SETZM TMPFLG>
MOVE 0,ILD1
MOVEM 0,RPG1
OPEN 17,OPEN1 ;KEEP IT PURE
JRST [MOVE W,RPG1
JRST ILD5]
LOOKUP 17,DTIN ;THE FILE NAME.
JRST [MOVE 0,SVRPG ;RESTORE AC0=F
TLOE F,ESW ;WAS EXT EXPLICIT?
JRST ILD9 ;YES, DON'T TRY AGAIN.
MOVEM 0,SVRPG ;SAVE AC0 AGAIN
MOVSI 0,(SIXBIT /TMP/) ;TRY TMP INSTEAD
MOVEM 0,DTIN1
PUSHJ P,LDDT4 ;SET UP PPN
JRST .-1] ;TRY AGAIN
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.
NUTS: TTCALL 3,[ASCIZ /?LOADER command file not found/]
EXIT
>;END OF IFN RPGSW
>;END OF IFE L
LD: ;HERE AFTER INITIALIZATION IF NO CCL
IFN L,< HRRZM 0,LSPXIT
MOVEI 0,0
HRRZM R,RINITL
RESET>
IFE L,<IFN RPGSW,<
HLLZS .JBERR ;MAKE SURE ITS CLEAR.>
RESET ;INITIALIZE THIS JOB
SETZ N, ;CLEAR N
CTLSET: SETZB F,S ;CLEAR THESE AS WELL
IFN TENEX,<TLO F,SYMSW!RMSMSW ;ASSUME /S
TRO F,DMNFLG ;ASSUME /B
SETZM NLSTGL ;PERMIT LST OF UNDEF. GLOBALS>
HLRZ X,.JBSA ;TOP OF LOADER
HRLI X,V ;PUT IN INDEX
HRRZI H,.JBDA(X) ;PROGRAM BREAK
MOVE R,[XWD W,.JBDA] ;INITIAL RELOCATION>
MOVSI E,'TTY'
DEVCHR E,
TLNN E,10 ;IS IT A REAL TTY?
IFN RPGSW,<JRST [TLNN N,RPGF ;IN CCL MODE?>
EXIT ;NO, EXIT IF NOT TTY
IFN RPGSW,< TRO F,NOTTTY ;SET FLAG
JRST LD1] ;SKIP INIT>
INIT 3,1 ;INITIALIZE CONSOLE
SIXBIT /TTY/
XWD BUFO,BUFI
CALLEX: EXIT ;DEVICE ERROR, FATAL TO JOB
MOVEI E,TTY1
MOVEM E,.JBFF
INBUF 3,1
OUTBUF 3,1 ;INITIALIZE OUTPUT BUFFERS
OUTPUT 3, ;DO INITIAL REDUNDANT OUTPUT
LD1:
IFE L,< HRRZ B,.JBREL ;MUST BE JOBREL FOR LOADING REENTRANT>
IFN L,< MOVE B,.JBSYM ;USED INSTEAD OF JOBREL FOR SYMBOL TABLE FIXUPS>
HRRZM B,HISTRT
SUB B,SE3 ;INITIALIZE SYMBOL TABLE POINTER
CAILE H,1(B) ;TEST CORE ALLOCATION
JRST [HRRZ B,.JBREL;TOP OF CORE
ADDI B,2000 ;1K MORE
CORE B, ;TRY TO GET IT
EXIT ;INSUFFICIENT CORE, FATAL TO JOB
JRST LD1] ;TRY AGAIN
IFN EXPAND,<MOVE S,[10,,12] ;CORMAX IN NSWTBL
GETTAB S, ;GET MAX CORE ALLOWED TO A JOB
MOVSI S,1 ;SET TO VERY LARGE
IFN REENT,<HLRZ E,.JBHRL ;BUT DON'T INCLUDE HIGH SEGMENT
SUBI S,1(E) ;IN LOW SEGMENT MAX>
IFE REENT,<SUBI S,1 ;ONE LESS FOR K BOUND>
MOVEM S,ALWCOR ;SAVE IT FOR XPAND TEST>
IFN PURESW,<MOVE S,[XWD HICODE,LOWCOD]
BLT S,LOWCOD+CODLN-1>
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
MOVEM S,NAMPTR ;INITIALIZE PROGRAM NAME POINTER
IFE L,< HRRI R,.JBDA ;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>
MOVEI E,F.C ;INITIALIZE STATE OF THE LOADER
BLT E,B.C
MOVE W,[ZBEG,,ZBEG+1]
SETZM ZBEG ;CLEAR START OF INITIALIZED DATA
BLT W,ZEND ;AND THE REST
IFN CPUSW,<
MOVNI W,1 ;-1
AOBJN W,.+1 ;STANDARD TEST
JUMPN W,.+2 ;KA-10 (OR PDP-6)
TRO F,KICPFL ;KI-10>
IFN REENT,<MOVSI W,1
MOVEM W,HVAL1
MOVEM W,HVAL
MOVEM X,LOWX
MOVEM R,LOWR
HRRZI W,1
SETUWP W, ;SETUWP UUO.
TRO F,NOHI6 ;PDP-6 COMES HERE.>
IFN REENT!CPUSW,<
MOVEM F,F.C ;PDP-10 COMES HERE.>
IFN SAILSW,<MOVE W,[XWD -RELLEN-1,LIBFLS-1] ;SET UP POINTERS
MOVEM W,LIBPNT# ;IN THE FORM OF AOBJN WORDS
MOVE W,[XWD -RELLEN-1,PRGFLS-1]
MOVEM W,PRGPNT#>
IFE L,< MOVSI W,254200 ;STORE HALT IN .JB41
MOVEM W,.JB41(X) ;...>
IFN L,< MOVE W,.JBREL
HRRZM W,OLDJR>
IFN B11SW,<MOVEI W,440000 ;SET UP THE SPECIAL BITS OF HEADNUM(ADD+POLISH)
MOVEM W,HEADNM
MOVEI W,PDLOV ;ENABLE FOR PDL OV
MOVEM W,.JBAPR
MOVEI W,200000
CALLI W,16
>
IFN DMNSW,<MOVEI W,SYMPAT
MOVEM W,KORSP>
IFN MONLOD,<IFN PURESW,<
MOVEI W,.RBALC ;NUMBER OF WORDS FOR ENTER
MOVEM W,DIOUT
MOVEI W,DALLOC ;NUMBER OF BLOCKS TO ALLOCATE
MOVEM W,DIOUT+.RBEST>>
IFN SFDSW,<GETPPN W, ;GET USER'S PPN
MOVEM W,MYPPN ;SAVE IT FOR [,,] ETC>
IFN FORSW,<MOVEI W,FORSW-1 ;GET DEFAULT
MOVEM W,FORLIB ;INCASE USER DOESN'T SET IT>
;LOADER SCAN FOR FILE NAMES
LD2Q: XOR N,F.C+N ;HERE WE STORE THE TWO BITS FOR
AND N,[AUXSWI!AUXSWE,,ENDMAP] ;THE AUX FILE INTO THE
XORM N,F.C+N ;SAVED REGISTER 'N'
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,'DSK' ;ASSUME DSK.
MOVEM T,ILD1>
SETZM OLDDEV ;TO MAKE IT GO BACK AFTER /D FOR LIBSR
LD2B: RELEAS 1, ;RELEASE BINARY INPUT DEVICE
IFN PP,<SETZM PPPN ;CLEAR PERMANENT PPN ON EACH NEW LINE>
IFN RPGSW,< TLNE N,RPGF ;NOT IF DOING CCL STUFF
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
LD2BP: TLNE F,LIBSW ;WAS LIBRARY MODE ON?
TLO F,SKIPSW ;YES, NORMAL MODE IS SKIPPING
LD2DD: SETZM DTIN ;CLEAR FILE NAME AFTER , CR-LF, ETC
LD2D: SKIPE W,OLDDEV ;RESET DEVICE IF NEEDED.
CAMN W,ILD1 ;IS IT SAME?
JRST LD2DC ;YES, FORGET IT.
MOVEM W,ILD1
LD2DB: TLZ F,ISW+DSW+FSW+REWSW
LD2DC: IFN PP,<SETZM PPN ;DON'T REMEMBER PPN FROM ONE FILE TO NEXT.>
LD2DA: SETZB W,OLDDEV ;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>
SOSGE BUFI2 ;DECREMENT CHARACTER COUNTER
JRST [INPUT 3, ;FILL TTY BUFFER
JRST .-1] ;MAKE SURE NOT A NULL BUFFER
ILDB T,BUFI1 ;LOAD T WITH NEXT CHARACTER
LD3AA: CAIE T,175 ;OLD ALTMOD
CAIN T,176 ;EVEN OLDER ONE
MOVEI T,33 ;NEW ONE
CAIL T,140 ;LOWER CASE?
TRZ T,40 ;CONVERT TO UPPER CASE
MOVE Q,T
HRLM Q,LIMBO ;SAVE THIS CHAR.
MOVSS LIMBO ;AND LAST ONE
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
IFN SYMARG,<CAIL Q,20 ;SKIP UNLESS SECOND FORM OF DISPATCH
JRST LD3AB ;DIFFERENT 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
;HERE ON ERRORS
LD2C: POP P,(P) ;BACKUP ONE LEVEL
LD2: SETZM SBRNAM ;CLEAR BLOCK TYPE 6 SEEN
IFN RPGSW,<TLNE N,RPGF ;IN CCL MODE
TRNN F,TRMFL ;YES, /G SEEN?>
JRST LD2Q ;NO, START A NEW LINE
IFN RPGSW,<POPJ P, ;AND RETURN>
;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 SYMARG,<XWD LD7,LD10 ;BAD CHAR,&>
IFN SYMARG,<
LD3AB: ROT Q,-1 ;CUT Q IN HALF
HRRZ A,LD3A(Q) ;PULL OFF RIGHT HALF OF TABLE ENTRY
JUMPGE Q,@A ;WHICH IS CORRECT FOR EVEN ENTRIES
HLRZ A,LD3A(Q) ;BUT USE LEFT HALF FOR ODD ENTRIES
JRST @A>
IFN RPGSW,<
RPGRD1: MOVNI T,5
ADDM T,CTLIN+2
AOS CTLIN+1
RPGRD: SOSG CTLIN+2 ;CHECK CHARACTER COUNT.
JRST RPGRD2
IBP CTLIN+1 ;ADVANCE POINTER
MOVE T,@CTLIN+1 ;AND CHECK FOR LINE #
TRNE T,1
JRST RPGRD1
LDB T,CTLIN+1 ;GET CHR
JRST LD3AA ;PASS IT ON
RPGRD2:
IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO READ DONE?
JRST RPGRD3 ;YES, SO SHOULD NEVER GET HERE>
IN 17,0
JRST RPGRD+2
STATO 17,740000
JRST RPGRD3 ;END OF FILE
ERROR ,</ERROR WHILE READING COMMAND FILE!/>
EXIT ;AND GIVE UP
RPGRD3: ERROR ,</END-OF-FILE ON COMMAND FILE!/>
EXIT
>
SUBTTL CHARACTER HANDLING
;ALPHANUMERIC CHARACTER, NORMAL MODE
LD4: SOJL E,LD3 ;JUMP IF NO SPACE FOR CHAR IN W
CAIGE T,141 ;WORRY ABOUT LOWER CASE LETTERS
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,LD2DC ;JUMP IF NULL DEVICE IDENTIFIER
EXCH W,ILD1 ;STORE DEVICE IDENTIFIER
MOVEM W,LSTDEV ;SAVE LAST DEVICE SO WE CAN RESTORE IT
JRST LD2DB ;RETURN FOR NEXT IDENTIFIER
;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>
LD5A: IFN SYMARG,<
TRNE F,ARGFL ;IS "." SPECIAL
JRST LD4 ;YES,RADIX-50>
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 LD2DC ;RETURN FOR NEXT IDENTIFIER
;INPUT SPECIFICATION DELIMITER <,>
LD5B:
IFN PP,<TLZE N,PPCSW ;READING PP #?
JRST [
IFN SFDSW,< SKIPN D ;JUST A COMMA SEEN?
HLRZ D,MYPPN ;YES, USE OWN PROJ #>
IFE STANSW,< HRLM D,PPN ;STORE PROJ #
JRST LD6A1 ];GET PROG #>
IFN STANSW,< PUSHJ P,RJUST ;RIGHT JUSTIFY W
HRLM W,PPN ;STORE PROJ NAME
JRST LD2D ];GET PROG NAME>
PUSHJ P,SFDCK ;CHECK FOR SFD DIRECTORY>
SETOM LIMBO ;USED TO INDICATE COMMA SEEN
TLZN F,FSW ;SKIP IF PREV. FORCED LOADING
PUSHJ P,FSCN2 ;LOAD (FSW NOT SET)
JRST LD2BP ;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 <]>
LD5C:
IFN SPCHN,<CAIN T,"=" ;DO A /= AS SWITCH
TLNN F,SSW
SKIPA
JRST LD6>
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
IFN SFDSW,< SETZM SFD ;USED AS A FLAG>
IFE STANSW,< JRST LD6A2]> ;READ NUMBERS AS SWITCHES
IFN STANSW,< JRST LD2D]>
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,'MAP' ;ASSUME <.MAP> IN DEFAULT CASE
HRRI W,0 ;CLEAR RIGHT HALF OF EXTENSION
CAMN W,['CHN '] ;TEST FOR <.CHN> EXTENSION
MOVSI W,'MAP' ;AND TURN IT BACK TO MAP
IFN MONLOD,<CAMN W,['XPN '] ;IS EXTENSION 'XPN'?
JRST DIOPEN ;YES, OPEN DISK IMAGE FILE>
IFN SYMDSW,<CAMN W,['SYM '] ;IF EXT IS SYM
JRST SYOPEN ;OPEN AUX FOR SYMBOL FILE>
MOVEM W,DTOUT1 ;STORE FILE EXTENSION IDENTIFIER
MOVE W,DTIN ;LOAD INPUT FILE IDENTIFIER
MOVEM W,DTOUT ;USE AS OUTPUT FILE IDENTIFIER
IFN SPCHN,<MOVEM W,CHNENT ;AND FOR SPECAIL CHAINING>
IFN PP,<SKIPN W,PPN ;PROJ-PROG #
MOVE W,PPPN ;TRY PERMANENT ONE
MOVEM W,DTOUT+3 ;...>
MOVE W,ILD1 ;LOAD INPUT DEVICE IDENTIFIER
MOVEM W,LD5C1 ;USE AS OUTPUT DEVICE IDENTIFIER
IFN SPCHN,<SKIPN CHNACB ;ARE WE DOING A SPECIAL CHAIN?
MOVEM W,CHNOUT+1 ;ALLOW HIM TO CHOOSE SP CHAIN DEV>
SKIPN W,LSTDEV ;RESTORE LAST
IFN PP,<MOVSI W,'DSK' ;RESET DEVICE TO DSK>
SETZM LSTDEV ;BUT ONLY ONCE
MOVEM W,ILD1
;INITIALIZE AUXILIARY OUTPUT DEVICE
IFN SYMDSW,<
TLNN F,LSYMFL ;IGNORE IF ALREADY IN USE
PUSHJ P,AUXINI
JRST LD2DD
AUXINI:>
TRZ F,TTYFL
IFE SYMDSW,<TLZE N,AUXSWI+AUXSWE ;FLUSH CURRENT DEVICE
RELEASE 2, ;...>
MOVE W,LD5C1 ;GET AUX DEVICE
DEVCHR W, ;IS DEVICE A TTY?
TLNE W,10 ;...
TRO F,TTYFL ;YES SET FLAG
TLNE W,(1B4) ;IS IT CONTROLING TTY?
IFE SYMDSW,<JRST LD2DD ;YES, SKIP INIT>
IFN SYMDSW,<POPJ P,>
OPEN 2,OPEN2 ;KEEP IT PURE
JRST ILD5A
TLNE F,REWSW ;REWIND REQUESTED?
UTPCLR 2, ;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,.JBFF
OUTBUF 2,1 ;INITIALIZE SINGLE BUFFER
TLO N,AUXSWI ;SET INITIALIZED FLAG
IFN LNSSW,<EXCH E,.JBFF
SUBI E,AUX
IDIV C,E
OUTBUF 2,(C)>
IFE SYMDSW,<JRST LD2DD ;RETURN TO CONTINUE SCAN>
IFN SYMDSW,<POPJ P,>
;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
IFN PP,<
SFDCK: IFN SFDSW,<
TLNN N,PPSW ;READING PP #?
POPJ P, ;NO
SKIPE SFD ;READING SFD YET?
JRST SFDCK1 ;YES
SKIPN D ;NUMBER SEEN?
HRRZ D,MYPPN ;NO, USE MINE
HRRM D,PPN ;STORE IT
MOVEM X,SFD ;NEED AN AC, SETS SFD NON-ZERO
MOVE X,[-SFDSW,,SFD] ;INITIALIZE POINTER
JRST LD2DA ;GET FIRST SFD
SFDCK1: AOBJP X,SFDER ;ERROR IF TOO MANY SFDS
MOVEM W,(X) ;STORE IN SLOT
JRST LD2DA ;GET NEXT SFD
SFDER: MOVE X,SFD ;RESTORE X
ERROR ,</?TOO MANY SFDS SPECIFIED@/>
JRST LD2
>
RBRA: TLZN N,PPSW ;READING PP #?
POPJ P, ;NOPE, RETURN
TLZE N,PPCSW ;COMMA SEEN?
JRST LD7A ;NOPE, INDICATE ERROR
IFN SFDSW,<SKIPN SFD ;A FULL PATH SPECIFIED?
JRST RBRA1 ;NO
AOBJP X,SFDER ;MUST STORE LAST SFD
MOVEM W,(X)
SETZM 1(X) ;END WITH A ZERO
MOVE X,SFD ;RESTORE X
MOVEI W,SFDADD ;POINT TO SFD PATH
EXCH W,PPN
MOVEM W,SFD ;STORE IN BLOCK
JRST RBRA2 ;CONTINUE
RBRA1:>
IFE STANSW,<HRRM D,PPN ;STASH PROG NUMBER
TLZ F,SSW ;AND TURN OFF SWITCH MODE>
IFN STANSW,<PUSHJ P,RJUST ;RIGHT JUSTIFY W
HRRM W,PPN ;STASH PROG NAME>
MOVE W,PPN ;GET PPN
RBRA2: SKIPN DTIN ;FILE NAME SEEN IN THIS SPEC?
SKIPE PPNW ;OR SOMETHING WAITING IN W?
JRST RBRA3 ;YES, SO WE'VE GOT A FILE NAME SOMEWHERE
MOVEM W,PPPN ;NO , SO MAKE PERMANENT PPN
IFN SFDSW,<MOVE W,[SFD,,PSFD]
BLT W,PSFD+SFDSW ;MOVE FULL PATH
MOVEI W,PSFDAD ;POINT TO IT
SKIPE SFD ;BUT NOT IF IT'S ZERO
MOVEM W,PPPN ;AND STORE>
RBRA3: 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
IFN STANSW,<
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 ;...>>
IFN SYMARG,<
;& SELECTS A SYMBOL RATHER THAN ANUMBER FOR A SWITCH ARGUMENT
;& MUST ALSO FOLLOW THW SYMBOL; THE FORM IS /&SYMBOL&SWITHCH
LD10: TRC F,ARGFL ;SET OR CLEAR SPECIAL CHARS.
TLCE F,SSW ;IF IN SWITCH MODE, EXIT TO GET IDENTIFIER
JRST LD10B
PUSHJ P,ASCR50 ;IF NOT, REENTER IT, CONVERT IDENTIFIER TO R50
PUSHJ P,SDEF ;AND SEE IF IT EXISTS
JRST LD10A ;YES IT DOES
PUSHJ P,PRQ ;NO, COMPLAIN. OUTPUT ?
PUSHJ P,SPACE ;FOLLOWED BY A SPACE
PUSHJ P,PRNAME ;FOLLOWED BY THIS SYMBOL
ERROR 0,</ DOESN'T EXIST@/>
JRST LD2
LD10A: MOVE D,2(A) ;SET D=VALUE OF SYMBOL AS NUMERIC ARG
TLZ F,DSW!FSW
MOVEI E,6 ;INITIALIZE NEW IDENTIFIER SCAN
MOVE V,LSTPT ;(W IS ALREADY 0)
JRST LD3 ;NOW EAT SWITCH AND CONTINUE PROCESSING COMMAND
LD10B: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION TO MAKE SURE FILE IS LOADED
JRST LD2DA>
SUBTTL CONVERT SYMBOL IN W TO RADIX-50 IN C
IFN SYMARG,<
;ALSO USES A
ASCR50: MOVEI A,0
R50A: MOVEI C,0
ROTC W,6 ;C IS NEXT SIXBIT CHAR
CAIGE C,20
JRST R50B ;UNDER 20, MAY BE ., $, OR %
CAILE C,31
JRST R50C ;OVER 31
SUBI C,20-1 ;IS NUMBER
R50D: IMULI A,50
ADD A,C
JUMPN W,R50A ;LOOP FOR ALL CHARS
MOVE C,A ;WIND UP WITH CHAR IN C
TLO C,040000 ;MAKE IT GLOBAL DEFINITION
POPJ P,
R50B: JUMPE C,R50D ;OK IF SPACE
CAIE C,16 ;TEST IF .
JRST .+3 ;NO
MOVEI C,45 ;YES
JRST R50D
CAIE C,4 ;SKIP IF $
R50E: MOVEI C,5 ;ASSUME % IF NOTHING ELSE
ADDI C,42
JRST R50D
R50C: CAIGE C,41
JRST R50E ;BETWEEN 31 AND 41
CAILE C,72
JRST R50E ;OVER 72
SUBI C,41-13 ;IS LETTER
JRST R50D>
;DEFINE PUTS A SYMBOL IN THE UNDEFINED SYMBOL TABLE
;SO LOADER CAN SCAN LIBRARY AND LOAD PROGRAMS BEFORE THEY ARE REQUESTED
;THE FORM IS /&SYMBOL# WHERE SYMBOL IS CONVERTED TO RADIX-50
IFN SYMARG,<
DEFINE: PUSHJ P,ASCR50 ;CONVRT TO R-50
MOVEI W,-2(S) ;WHERE SYMBOL WILL GO
CAIG W,(H) ;ENOUGH ROOM
IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
TLOA F,FULLSW
JRST POPJM3
POPJ P,]>
IFE EXPAND,<TLO F,FULLSW>
SUB S,SE3 ;ADJUST POINTER
MOVEM C,1(S) ;R-50 SYMBOL
SETZM 2(S) ;VALUE
TLZ F,DSW!SSW ;TURN OFF SWITCHES
TRZ F,ARGFL ; DITTO
TLZN N,SLASH ;IF NOT /&NAME#
JRST LD6A2 ;MUST BE (&NAME#), GET )
JRST LD2D ;CONTINUE TO SCAN
>
SUBTTL TERMINATION
;LINE TERMINATION <CARRIAGE RETURN>
LD5D:
IFN PP,<PUSHJ P,RBRA ;CHECK FOR UNTERMINATED PP #>
SKIPGE LIMBO ;WAS LAST CHAR. BEFORE CR A COMMA?
TLO F,DSW ;YES ,SO LOAD ONE MORE FILE
PUSHJ P,FSCN ;FORCE SCAN TO COMPLETION
JRST LD2B ;RETURN FOR NEXT LINE
;TERMINATE LOADING <ALT MODE>
LD5E: JUMPE D,LD5E1 ;ENTER FROM G COMMAND
TLO N,ISAFLG ;AND IGNORE ANY STARTING ADDRESS TO COME
HRRZM D,STADDR ;USE NUMERIC STARTING ADDRESS
LD5E1: PUSHJ P,CRLF ;START A NEW LINE
IFN RPGSW,<TRO F,TRMFL ;INDICATE TERMINATION STAGE
RELEASE 17,0 ;RELEASE COMMAND DEVICE>
IFN MANTIS,<TRNN N,MANTFL ;LOADING MANTIS?
JRST LD5E2 ;NO
IFN KUTSW,<SETOM CORSZ ;DON'T KUT BACK CORE>
IFN DMNSW,<TRZ F,DMNFLG ;OR MOVE SYMBOLS>
LD5E2: >
PUSHJ P,SASYM ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
IFE NAMESW,<MOVE W,['LOADER'] ;FINAL MESSAGE>
JUMPL S,.+2 ;UNDEFINED SYMBOLS
SKIPE MDG ;OR MULTIPLY DEFINED
PUSHJ P,PRQ ;PRINT "?" FOR BATCH
IFN NAMESW,<HRRZ W,HISTRT ;IN CASE NO NAME SET, USE FIRST LOADED
MOVE W,-1(W)
SKIPN CURNAM
PUSHJ P,LDNAM
MOVE W,CURNAM
CAME W,[SIXBIT /MAIN/] ;FORTRAN MAIN PROG, OR MACRO NO TITLE
JUMPN W,.+3 ;A USEFUL NAME SEEN
SKIPE PRGNAM ;NO, SO TRY BINARY FILE NAME
MOVE W,PRGNAM ;USE BINARY FILE NAME IN EITHER CASE
IFE L,<MOVEM W,CURNAM ;SAVE NAME FOR LATER>
IFN L,<SETNAM W, ;SETNAM>>
IFN MONLOD,<TLNN N,DISW ;SKIP IF LOADING TO DISK?>
PUSHJ P,BLTSET ;SETUP FOR FINAL BLT
RELEASE 2, ;RELEASE AUX. DEV.
RELEASE 1,0 ;INPUT DEVICE
RELEASE 3,0 ;TTY
IFN SPCHN,<RELEASE 4,0 ;SPECIAL CHAINING CHANEL>
IFN L,<JRST @LSPXIT>
IFE L,< ;NONE OF THIS NEEDED FOR LISP
IFN PURESW,<
MOVE V,[XWD HHIGO,HIGO]
BLT V,HIGONE ;MOVE DOWN CODE TO EXIT>
TLNN N,EXEQSW ;DO WE WANT TO START
JRST LD5E3
IFN RPGSW,<HRRZ C,.JBERR ;CHECK FOR ERRORS
IFE MANTIS,<TLNN N,DDSW ;ALLOW EXECUTION IF TO DDT>
IFN MANTIS,<TDNN N,[DDSW,,MANTFL] ;OR MANTIS>
JUMPN C,EXDLTD ;ERRORS AND NOT TO DDT>
IFN MONLOD,<TLNE N,DISW ;DISK IMAGE LOAD IN PROGRESS?
MOVE X,XRES ;YES, GET RESIDENT X>
HRRZ W,.JBSA(X)
IFN MANTIS,<TRNN N,MANTFL ;NO MESSAGE IF STARTING SPECIAL DEBUGGER>
TLNN N,DDSW ;SHOULD WE START DDT??
IFE TENEX,<JRST LD5E2 ;NO>
IFN TENEX,<JRST LD5E2 ;NO
PUSH P,1
MOVEI 1,400000 ;THIS FORK
DIR
CIS
JSYS 147 ;TENEX RESET, NOT CALLI 0. FLUSH PA1050
MOVE 1,.JBSYM(X)
MOVEM 1,@770001 ;GIVE SYMS TO DDT
MOVE 1,.JBUSY(X)
MOVEM 1,@770002 ;AND UNDEF SYMS
POP P,1>
HRRZ W,.JBDDT(X)
TTCALL 3,[ASCIZ /DDT /]
LD5E2: IFN MANTIS,<
SKIPE V,MNTSYM ;SHOULD WE START SPECIAL DEBUGGER?
TRNN N,MANTFL
JRST .+3 ;NO
HRRZ W,.JBREN##(X) ;YES
MOVEM V,.JBCN6##(X) ;SETUP AUXILARY SYMBOL POINTER>
IFN RPGSW,< TLNE N,RPGF ;IF IN RPG MODE
JUMPE W,NOSTAD ;ERROR IF NO STARTING ADDRESS>
JUMPE W,LD5E3 ;ANYTHING THERE?
TLOA W,(JRST) ;SET UP A JRST
LD5E3: SKIPA W,CALLEX ;NO OR NO EXECUTE, SET CALLI 12
IFN MANTIS,<TRNE N,MANTFL ;NO MESSAGE IF STARTING SPECIAL DEBUGGER
CAIA>
TTCALL 3,[ASCIZ /EXECUTION
/]
IFN TENEX,<MOVEM X,V ;SAVE AWAY RELOCATION
MOVE X,.JBSA(X) ;NEW START ADDRESS
HRLI X,<JRST>B53 ;JRST IN LH
MOVEI N,400000 ;THIS FORK
SEVEC ;SET ENTRY VECTOR
MOVE X,V ;UNSAVE RELOCATION>
IFN LDAC,< HRLZ P,BOTACS ;SET UP FOR ACBLT
MOVEM W,.JBBLT+1(X) ;SET JOBBLT
MOVE W,[BLT P,P]
MOVEM W,.JBBLT(X)>
MOVE V,.JBVER(X) ;GET VERSION NUMBER
MOVEM V,.JBVER ;SET IT UP BEFORE SETNAM UUO
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
JRST DIOVER ;YES, CLEAN UP THE XPN FILE>
TLNE F,FULLSW ;DID WE RUN OUT OF CORE?
HRRZ A,Q ;YES, NULIFY BLT
MOVSI LSTAC,LODACS ;SET UP TO BLT BLT CODE INTO ACS
BLT LSTAC,LSTAC
IFN KUTSW,<SKIPGE E,CORSZ ;DO WE WANT CORE ADJUST
MOVE CORAC,JFCLAC ;NO, CLEAR COREUUO>
IFE LDAC,<MOVE LSTAC,W ;SET END CONDITION>
IFN PURESW,<
MOVSI V,LD ;DOES IT HAVE HISEG
JUMPG V,HINOGO ;NO,DON'T DO CORE UUO
MOVSI V,1 ;SET HISEG CORE NONE ZERO
JRST HIGO ;AND GO>
IFE PURESW,<
IFN NAMESW,<MOVE W,CURNAM ;GET PROGRAM NAME
SETNAM W, ;SET IT FOR VERSION WATCHING>
JRST 0>
LODACS: PHASE 0
BLT Q,(A) ;BLT CODE DOWN
IFN KUTSW,<CORAC:! CORE E, ;CUT BACK CORE
JFCLAC:! JFCL ;SHOULD NEVER HAVE AN ERROR SINCE REDUCING CORE>
SETZB 0,7 ;CLEAR ACCS OTHERWISE USER
SETZB 11,17 ;MIGHT BELIEVE GARBAGE THERE
LSTAC:! IFN LDAC,<JRST .JBBLT>
IFE LDAC,<EXIT>
DEPHASE
IFN RPGSW,<
NOSTAD: TTCALL 3,[ASCIZ /NO STARTING ADDRESS
/]
EXDLTD: TTCALL 3,[ASCIZ /?EXECUTION DELETED
/]
JRST LD5E3>
> ;END OF IFE L AT BEGINNING OF THIS PAGE
SUBTTL PRINT FINAL MESSAGE
; SET UP BLT AC'S, SETDDT, RELEAS
BLTSET: IFN RPGSW,<IFE K,<
JUMPE W,BLTST3 ;NO MESSAGE FROM CHAIN IN CCL@>>
IFN MANTIS,<TRNE N,MANTFL ;NO MESSAGES IF SPECIAL DEBUGGER
JRST NOMAX>
PUSHJ P,FCRLF ;A RETURN
MOVNI Q,6 ;SET CHARACTER COUNT TO 6
MOVEI D,77 ;CHARACTER MASK
BLTST1: TDNE W,D ;TEST FOR SIXBIT BLANK
JRST BLTST2 ;NO, SO PRINT THE NAME
LSH D,6 ;SHIFT MASK LEFT ONE CHAR
AOJL Q,BLTST1 ;INCR COUNTER & REPEAT
BLTST2: PUSHJ P,PWORD1 ;OUTPUT PROGRAM NAME
PUSHJ P,SPACE
BLTST3:
IFN FAILSW,<MOVSI Q,-20 ;FINISH UP LINK STUFF
FREND: HLRZ V,LINKTB+1(Q)
JUMPE V,NOEND
HRRZ A,LINKTB+1(Q)
IFN REENT,<CAMGE V,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
IFN L,<CAML V,RINITL>
HRRM A,@X ;PUT END OF LINK CHAIN IN PROPER PLACE
NOEND: AOBJN Q,FREND
IFN REENT,<MOVE X,LOWX ;RESET THINGS>>
IFN KUTSW,<
SKIPGE C,CORSZ ;NEG MEANS DO NOT KUT BACK CORE
JRST NOCUT
JUMPE C,MINCUT ;0 IS KUT TO MIN. POSSIBLE
LSH C,12 ;GET AS A NUMBER OF WORDS
SUBI C,1
CAMG C,.JBREL ;DO WE NEED MORE THAN WE HAVE??
JRST TRYSML ;NO, SEE IF NUMBER REQUESTED IS TOO SMALL
MOVEI Q,0
CORE Q,
JFCL ;WE JUST WANT TO KNOW HOW MUCH
HRRZS Q
CAMGE Q,CORSZ
JRST CORERR
JRST NOCUT1 ;SET FOR DO NOT CHANGE SIZE
TRYSML: CAIG C,-1(R) ;IS DESIRED AMOUNT BIGGER THAN NEEDED
IFE TENEX,<MINCUT:>
MOVEI C,-1(R) ;GET MIN AMOUNT
IORI C,1777 ;CONVERT TO A 1K MULTIPLE
IFN DMNSW,< TRNN F,DMNFLG ;DID WE MOVE SYMBOLS??
SKIPN .JBDDT(X) ;IF NOT IS DDT THERE??
JRST .+2>
IFE DMNSW,<SKIPE .JBDDT(X) ;IF NO SYMBOL MOVING JUST CHECK DDT>
JRST NOCUT ;DO NOT CUT IF SYMBOLS AT TOP AND DDT
NOCUT1: MOVEM C,.JBREL(X) ;SAVE FOR CORE UUO
MOVEM C,CORSZ ;SAVE AWAY FOR LATER
JRST .+2
NOCUT: SETOM CORSZ ;SET FOR NO CUT BACK>
IFN RPGSW,<IFE K,<
JUMPE W,NOMAX ;NO MESSAGE IF CHAIN IN CCL@>>
IFN L,<HRRZ Q,.JBREL
SUB Q,OLDJR ;PROPER SIZE>
IFE L,<HRRZ Q,.JBREL(X)>
LSH Q,-12 ;GET CORE SIZE TO PRINT
ADDI Q,1
PUSHJ P,RCNUM
IFN REENT,<MOVE Q,HVAL
SUB Q,HVAL1
HRREI Q,-1(Q) ;SIZE IS ONE TOO BIG
CAIG Q,.JBHDA ;IS THERE ANY CODE LOADED THERE?
SETZB Q,HVAL ;NO , CLEAR ALL INDICATIONS OF IT
JUMPE Q,NOHY ;NO HIGH SEGMENT
MOVEI T,"+"-40 ;THERE IS A HISEG
PUSHJ P,TYPE
LSH Q,-12
ADDI Q,1
PUSHJ P,RCNUM
NOHY:>
MOVE W,[SIXBIT /K CORE/]
PUSHJ P,PWORD
IFE L,<
IFN RPGSW,<TLNN N,RPGF
JRST .+4 ;NOT IN CCL MODE SO GIVE ALL INFO
TLZ F,FCONSW ;ONLY PUT ON MAP IF IN CCL MODE
TLNN N,AUXSWI ;IS THERE AN AUX DEV?
JRST NOMESS ;NO, SO SKIP REST OF THIS STUFF>
MOVSI W,', ' ;SET DELIMITER CHARACTERS
MOVNI Q,2 ;SET COUNT TO 2
PUSHJ P,PWORD1 ;OUTPUT THEM
IFN DMNSW,<TRNN F,DMNFLG>
SKIPN .JBDDT(X)
SKIPA Q,.JBREL(X)
MOVEI Q,1(S) ;FIND THE AMOUNT OF SPACE LEFT OVER
SUB Q,.JBFF(X)
ADDI Q,1 ;ONE TWO SMALL
PUSHJ P,RCNUM
IFN REENT,<
SKIPN HVAL ;CREATING A HIGH SEGMENT?
JRST NOHIFR ;NO
MOVEI T,'+' ;YES, TYPE +
PUSHJ P,TYPE
HLRZ Q,.JBHRL(X) ;GET HISEG BREAK
SUBI Q,1 ;1 TOO HIGH (R=NEXT TO LOAD INTO)
ANDI Q,1777 ;CUT TO WORDS FREE
XORI Q,1777
PUSHJ P,RCNUM ;TYPE
NOHIFR:>
MOVE W,[SIXBIT / WORDS/]
PUSHJ P,PWORD
MOVE W,[SIXBIT / FREE/]
PUSHJ P,PWORD
PUSHJ P,CRLF
ERROR 0,</LOADER USED !/> ;GIVE EXPLANATION
MOVE Q,.JBREL
LSH Q,-12
ADDI Q,1
PUSHJ P,RCNUM ;PRINT MAX LOW CORE SIZE
IFN REENT,< SKIPE Q,.JBHRL ;GET SIZE OF HIGH SEGMENT
PUSHJ P,[MOVEI Q,400001(Q) ;CLEAR HIGH ORDER BIT
MOVEI T,"+"-40 ;PRINT A HIGH CORE PART
PUSHJ P,TYPE
LSH Q,-12
JRST RCNUM]>
MOVE W,[SIXBIT /K CORE/]
PUSHJ P,PWORD
NOMESS: TLO F,FCONSW ;FORCE PRINTING OF CRLF>
PUSHJ P,CRLF
IFE L,<
IFN REENT,<HLRZ A,.JBCOR(X) ;GET HIGHEST ACTUAL DATA
CAIL A,.JBDA ;SEE IF GREATER THAN JOBDAT
JRST NOMAX ;YES, SKIP MESSAGE
ERROR 0,</[NULL LOW SEGMENT]!/>
PUSHJ P,CRLF>
NOMAX:
IFE TENEX,<MOVE W,.JBDDT(X)
SETDDT W,
JUMPN W,DDTSET ;DON'T BOTHER IF DDT SET
HLRE Q,.JBSYM(X) ;GET LENGTH OF SYMBOL TABLE
MOVNS Q ;AS POSITIVE NUMBER
HRRZ W,.JBSYM(X) ;GET START
ADD W,Q ;ADDRESS OF HIGHEST LOCATION
HLRZ Q,.JBSA(X) ;HIGHEST LOCATION SAVED BY MONITOR
IFN MANTIS,<TRNN N,MANTFL ;DONT CHECK ADR IF SPECIAL DEBUGGER>
CAIG W,(Q) ;IN BOUNDS?
JRST DDTSET ;YES, ALL OK
IFN REENT,<TRNE F,SEENHI ;ANY HIGH SEGMENT STUFF?
CAMGE W,HVAL1 ;YES, IN HI-SEG THEN?
JRST .+2 ;NO
JRST DDTSET ;YES, ALL IS WELL>
SETZM .JBSYM(X) ;JOBSYM IS OUT OF BOUNDS
CAIA ;JOBUSY ALSO, SO CLEAR THEM>
DDTSET: SKIPLE .JBUSY(X) ;IF ITS NOT A POINTER
SETZM .JBUSY(X) ;DON'T KEEP ADDRESS
IFE TEN30,<HRLI Q,20(X) ;SET UP BLT FOR CODE
HRRI Q,20>
IFN TEN30,<HRLI Q,.JBDDT(X)
HRRI Q,.JBDDT>
>;END OF IFE L
HRRZ A,R
POPJ P, ;WE HAVE SET R UP BY CLEVER CODE IN SASYM
IFN KUTSW,<CORERR: TTCALL 3,[ASCIZ /?NOT ENOUGH CORE
/]
EXIT>
IFN TENEX,<
;SETUP TO CUT BACK CORE TO MINIMUM
;THIS IS MIN OF R AND TOP OF SYMTAB
MINCUT: HLRE C,.JBSYM(X)
MOVNS C
ADD C,.JBSYM(X)
HRRZS C
JRST TRYSML ;GO COMPARE WITH R
>
SUBTTL SET UP JOBDAT
SASYM: TLNN F,NSW
PUSHJ P,LIBF ;SEARCH LIBRARY IF REQUIRED
PUSHJ P,FSCN ;FORCE END OF SCAN
IFN ALGSW,<MOVE C,[RADIX50 44,%OWN]
MOVE W,%OWN ;GET VALUE
TRNE N,ALGFL ;IF ALGOL PROG LOADED
PUSHJ P,SYMPT ;DEFINE %OWN
IFN REENT,<MOVE X,LOWX ;MAKE SURE X IS CORRECT>>
IFN RPGSW,<HLRE A,S
MOVNS A
LSH A,-1
ADD A,.JBERR
HRRM A,.JBERR>
IFN SYMDSW,<PUSHJ P,READSYM ;READ BACK LOCAL SYMBOLS>
IFN SPCHN,<
SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
TRNN N,CHNMAP ;TEST FOR ROOT SEGMENT PRINTED
JRST NOCHMP ;JUMP IF NO TO EITHER CONDITION
SETZM LINKNR ;CLEAR OVERLAY LINK NUMBER
MOVE A,BEGOV ;GET START OF OVERLAY POINT
IFN REENT,<ADDI A,(X) ;PLUS LOADER CORE BASE
HRRZS A ;CLEAR LEFT HALF OF REGISTER
HRRZ W,HILOW ;GET CURRENT SPOT IN LOW SEGMENT>
IFE REENT,<HRRZ W,R ;GET CURRENT SPOT IN LOW SEGMENT>
CAMN W,R ;TEST FOR ADDED MODULES
TRZ N,ENDMAP ;NO, THEN SUPRESS MAP AT END
NOCHMP: > ;END OF IFN SPCHN
TRNE N,ENDMAP ;WANT MAP AT END?
PUSHJ P,PRTMAP ;YES
TLNN N,AUXSWE ;TEST FOR MAP PRINTED YET
TLZ N,AUXSWI ; NO, THEN DON'T START NOW
TRNN N,ENDMAP ;DON'T PRINT UNDEFS TWICE
PUSHJ P,PMS ;PRINT UNDEFS
HRRZ A,H ;DO NOT CLOBBER H IF STILL INSERTING SYMBOLS
IFN MONLOD,<TLNN N,DISW ;SKIP IF LOADING TO DISK>
SUBI A,(X) ;HIGHEST LOC LOADED INCLUDES LOC STMTS
CAILE A,(R) ;CHECK AGAINST R
HRR R,A ;AND USE LARGER
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
MOVE X,XRES ;YES, GET RESIDENT OFFSET>
IFE L,< HRRZ A,STADDR ;GET STARTING ADDRESS
HRRM A,.JBSA(X) ;STORE STARTING ADDRESS
HRRZM R,.JBFF(X) ;AND CURRENT END OF PROG
HRLM R,.JBSA(X)>
IFN DMNSW,<MOVE C,[RADIX50 44,PAT..] ;MARK PATCH SPACE FOR RPG
MOVEI W,(R)
PUSHJ P,SYMPT
IFN REENT,<TRNE F,HISYM ;SHOULD SYMBOLS GO IN HISEG?
JRST BLTSYM ;YES>>
IFN DMNSW!LDAC,< ;ONLY ASSEMBLE IF EITHER SET
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
JRST SASYM1 ;YES, NO NEED TO EXPAND CORE>
IFE LDAC,< TRNN F,DMNFLG ;GET EXTRA SPACE IF SYMBOLS
JRST NODDT ;MOVED OR IF LOADING ACS>
IFE DMNSW,< MOVEI A,20 ;FOR LOADING ACS>
IFN DMNSW,< MOVE A,KORSP
IFN LDAC,< TRNN F,DMNFLG ;ONLY 20 IF SYMBOLS NOT MOVED
MOVEI A,20>>
ADDI A,(R) ;GET ACTUAL PLACE TO PUT END OF SPACE
ADDI A,(X)
CAIL A,(S) ;DO NOT OVERWRITE SYMBOLS
IFN EXPAND,<JRST [PUSHJ P,XPAND>
PUSHJ P,MORCOR
IFN EXPAND,< JRST .-1]>
IFN LDAC,<HRRM R,BOTACS ;SAVE BOTTOM OF WHERE WE PUT ACS
HRRZ A,R
ADDI A,(X)
HRL A,X ;SET UP BLT FROM (X) TO R(X)
MOVEI Q,17(A)
BLT A,(Q)>>
IFN DMNSW,<TRNN F,DMNFLG ;NOW THE CODE TO MOVE SYMBOLS
JRST NODDT
IFN MONLOD,<SASYM1:>
HRRZ A,R
ADD A,KORSP
MOVE W,A ;SAVE POINTER TO FINAL LOC OF UNDEFS
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
PUSHJ P,DISYM ;YES, GET BREAK ADDRESS INTO CORE>
ADDI A,(X)
HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
ADD Q,B
HLROS Q
MOVNS Q
ADDI Q,-1(A) ;GET PLACE TO STOP BLT
HRLI A,1(S) ;WHERE TO BLT FROM
SUBI W,1(S) ;GET AMOUNT TO CHANGE S AND B BY
BLT A,(Q) ;MOVE SYMBOL TABLE
ADD S,W
ADD B,W ;CORRECT S AND B FOR MOVE
HRRI R,1(Q) ;SET R TO POINT TO END OF SYMBOLS
IFN REENT,<HRRM R,HILOW ;SAVE THIS AS HIGHEST LOC IN LOW SEG TO SAVE>
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
MOVE X,XCUR ;GET CURRENT BUFFER OFFSET>
SUBI R,(X)
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
MOVE X,XRES ;SET UP OFFSET FOR RESIDENT PORTION>
HRRM R,.JBFF(X)
HRLM R,.JBSA(X) ;AND SAVE AWAY NEW JOBFF
IFE REENT,<HRRM R,.JBCOR(X) ;DON'T LOSE LOW SEGMENT DATA>
IFN LDAC,<SKIPA> ;SKIP THE ADD TO R
NODDT:>
IFN LDAC,<ADDI R,20> ;MAKE SURE R IS CORRECT FOR BLT
MOVE A,B
ADDI A,1 ;SET UP JOBSYM, JOBUSY
IFE L,<MOVEM A,.JBSYM(X)
IFN REENT,<TRNN A,(1B0) ;SYMBOL TABLE IN HIGH SEGMENT?
JRST NOHYSM ;NO
EXCH X,HIGHX ;RELOCATE TO HIGH SEG.
ADD X,HVAL1 ;ADD IN BASE OF HIGH SEGMENT
MOVEM A,.JBHSM(X) ;SINCE MAY NOT START AT 400000
SUB X,HVAL1 ;BACK AS IT WAS
EXCH X,HIGHX
NOHYSM: >>
IFN L,<MOVEM A,.JBSYM>
MOVE A,S
ADDI A,1
IFE L,<MOVEM A,.JBUSY(X)
MOVE A,HISTRT ;TAKE POSSIBLE REMAP INTO ACCOUNT
IFN MANTIS,<TRNE N,MANTFL ;SPECIAL DEBUGGER?
MOVE A,.JBREL ;YES, USE OUR SEGTOP>
MOVEM A,.JBREL(X) ;SET UP FOR IMEDIATE EXECUTION>
IFN L,<MOVEM A,.JBUSY>
IFN MONLOD,<TLNN N,DISW ;LOADING TO DSK?
JRST NOTDSK ;NO
MOVE A,.JBDDT(X) ;GET DDT STARTING ADDRESS
MOVEM A,.JBSDD(X) ;SO GET WILL RESTORE IT
MOVE A,.JB41(X) ;MAY AS WELL SET UP JOB41
MOVEM A,.JBS41(X) ;ALSO
NOTDSK:>
IFN REENT,<
SKIPE A,HILOW ;SET UP TOP LOC OF LOW CORE EXCLUDING BLOCKS
SUBI A,1(X) ;IF NON-ZERO THEN IT NEEDS RELOCATION
HRLM A,.JBCOR(X)
TRNN F,SEENHI
POPJ P,
HRRZ A,HVAL
HRRM A,.JBHRL(X)
SUB A,HVAL1
IFN DMNSW,<TRNE F,HISYM ;SYMBOLS IN HISEG?
ADDI A,1 ;YES, AT TOP OF CORE ALREADY
;BUT HVAL ONE TOO SMALL>
HRLM A,.JBHRL(X)>
POPJ P,
SUBTTL BLT SYMBOL TABLE INTO HIGH SEGMENT
IFN DMNSW&REENT,<
BLTSYM: MOVE Q,HVAL ;GET ORIGIN OF HISEG
CAMN Q,HVAL1 ;HAS IT CHANGED?
JRST NOBLT ;NO
HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
HLRS S ;PUT NEG COUNT IN BOTH HALVES
JUMPE S,.+2 ;SKIP IF S IS ZERO
HRLI S,-1(S) ;SUB 1 FROM LEFT TO FIX CARRY PROBLEM
ADD Q,B
HLROS Q
MOVNS Q
ADD Q,HVAL ;ADD LENGTH OF HISEG
SUB Q,HVAL1 ;BUT REMOVE ORIGIN
ADD Q,HISTRT ;START OF HISEG IN CORE
HRRZS Q ;CLEAR INDEX FROM Q
ADD Q,KORSP ;SAVE SPACE FOR SYMBOL PATCHES
CORE Q, ;EXPAND IF NEEDED
PUSHJ P,MORCOR
PUSH P,B ;SAVE B
SOJ B, ;REMOVE CARRY FROM ADD TO FOLLOW
MOVSS B ;SWAP SYMBOL POINTER
ADD B,.JBREL
HRRM B,(P) ;SAVE NEW B
MOVE Q,.JBREL
ADD B,S ;INCASE ANY UNDEFS.
BLT B,(Q) ;MOVE SYMBOLS
POP P,B ;GET NEW B
SUB B,HISTRT
ADD B,HVAL1
SOJ B, ;REMOVE CARRY
ADDI S,(B) ;SET UP .JBUSY
BLTSY1: MOVE Q,.JBREL
SUB Q,HISTRT
ADD Q,HVAL1
SUBI Q,1 ;ONE TOO HIGH
MOVEM Q,HVAL
JRST NODDT
NOBLT: HRRZ Q,H ;GET HIGHEST LOC LOADED
IORI Q,1777 ;MAKE INTO A K BOUND
MOVEI A,-.JBHDA(S) ;GET BOTTOM OF UNDF SYMBOLS
SUB A,KORSP ;DON'T FORGET PATCH SPACE
CAIG A,(Q) ;ARE THEY IN SAME K
IFN EXPAND,<JRST [PUSHJ P,XPAND>
PUSHJ P,MORCOR
IFN EXPAND,< JRST NOBLT]>
MOVEM Q,HISTRT ;SAVE AS START OF HIGH
MOVEI A,400000 ;HISEG ORIGIN
MOVEM A,HVAL1 ;SAVE AS ORIGIN
SUB S,HISTRT ;GET POSITION OF UNDF POINTER
ADDI S,377777 ;RELATIVE TO ORG
SUB B,HISTRT ;SAME FOR SYM POINTER
ADDI B,377777
SUBI Q,377777
MOVEM Q,HIGHX ;SO WE CAN SET HIGH JOB DATA AREA
TRO F,SEENHI ;SO JOBHRL WILL BE SET UP
JRST BLTSY1 ;AND USE COMMON CODE
>
IFN DMNSW!LDAC!MANTIS!SYMDSW,<
MORCOR: ERROR ,</MORE CORE NEEDED#/>
EXIT>
SUBTTL READ BACK LOCAL SYMBOLS
IFN SYMDSW,<
READSYM:
TRZN F,LSYMFL ;DID WE WRITE A SYMBOL FILE?
POPJ P, ;NO
RELEASE 2, ;CLOSE IT OUT
MOVE W,SYMNAM ;GET NAME
MOVEM W,DTIN
TRNE N,ENDMAP ;MAP STILL REQUIRED?
PUSHJ P,AUXINI ;YES, RE-INIT AUX DEV
MOVE W,SYMEXT ;SEE IF EXTENSION SPECIFIED
HRLZM W,DTIN1
TLZ F,ISW
TLO F,ESW
MOVSI W,'DSK'
MOVEM W,ILD1
PUSHJ P,ILD
PUSH P,S ;SAVE NUMBER OF UNDEFINED SYMBOLS FOR LATER
HLRE V,S ;GET COUNT
MOVMS V ;AND CONVERT TO POSITIVE
HRLI B,V ;PUT V IN INDEX FIELD
HRRZ S,HISTRT ;TOP OF CORE
SUB S,V ;MINUS SIZE
HRLI S,V ;V IN INDEX FIELD
;MOW MOVE FROM S TO B
MOVE W,@B
MOVEM W,@S
SOJG V,.-2 ;FOR ALL ITEMS
HRRM S,(P) ;S IS NOW BOTTOM OF UNDEFINED
POP P,S ;SO PUT COUNT BACK INTO S
HRRZ B,HISTRT ;POINT B TO TOP OF CORE FOR EXPAND
MOVE V,SYMCNT# ;GET NUMBER OF SYMBOLS
LSH V,1 ;2 WORDS PER SYMBOL
SUBI V,(S) ;BOTTOM OF SYMBOL TABLE
ADDI V,(H) ;-TOP OF CODE
JUMPL V,.+3
PUSHJ P,XPAND9
JRST MORCOR
MOVE V,SYMCNT ;GET COUNT AGAIN
LSH V,1
MOVNS V ;NEGATE
HRRZ C,S
ADD C,V ;TO
HRL C,S ;FROM
HLRE W,S ;LENGTH
MOVMS W ;POSITIVE
ADDI W,(C) ;END OF BLT
BLT C,(W) ;MOVE UNDEFS AGAIN
ADD S,V ;FIXUP POINTER
SETZM NAMPTR ;HAVE NOT SEEN A PROG YET
MOVE T,SYMCNT ;NUMBER OF SYMBOL PAIRS TO READ
READS1: PUSHJ P,WORDPR
MOVEM W,(B)
MOVEM C,-1(B)
SUB B,SE3
TLNN C,740000 ;NAME HAS NO CODE BITS SET
JRST READS2 ;YES, HANDLE IT
SOJG T,READS1 ;READ NEXT SYMBOL
JRST READS4 ;ALL DONE
READS2: MOVE W,NAMPTR ;POINT TO PREVIOUS NAME
HRRZM B,NAMPTR ;POINT TO THIS ONE
JUMPE W,READS3 ;FIRST TIME?
MOVE C,W ;GET COPY
SUBM B,W ;COMPUTE RELATIVE POSITION
HRLM W,2(C) ;STORE BACK
READS3: SOJG T,READS1
READS4: MOVEI T,'SYM'
CAMN T,SYMEXT ;IF EXT IS SYM
JRST READS5 ;DON'T DELETE FILE
SETZM DTIN
SETZM DTIN+3
RENAME 1,DTIN
JFCL
READS5: SETOM SYMEXT ;SIGNAL NOT TO INIT SYMBOL FILE AGAIN
POPJ P,
>
SUBTTL WRITE CHAIN FILES
IFE K,< ;DONT INCLUDE IN 1KLOAD
CHNC: SKIPA A,.JBCHN(X) ;CHAIN FROM BREAK OF FIRST BLOCK DATA
CHNR: HLR A,.JBCHN(X) ;CHAIN FROM BREAK OF FIRST F4 PROG
HRRZS A ;ONLY RIGHT HALF IS SIGNIFICANT
JUMPE A,LD7C ;DON'T CHAIN IF ZERO
TLZN N,AUXSWI!AUXSWE ;IS THERE AN AUX DEV?
JRST LD7D ;NO, DON'T CHAIN
PUSH P,A ;SAVE WHEREFROM TO CHAIN
JUMPE D,.+2 ;STARTING ADDR SPECIFIED?
HRRZM D,STADDR ;USE IT
CLOSE 2, ;INSURE END OF MAP FILE
PUSHJ P,SASYM ;DO LIB SEARCH, SETUP JOBSA, ETC.
IFN RPGSW,<TLNE N,RPGF ;IF IN CCL MODE
TDZA W,W ;NO MESSAGES>
MOVE W,[SIXBIT ?CHAIN?] ;FINAL MESSAGE
PUSHJ P,BLTSET ;SETUP BLT PNTR, SETDDT, RELEAS
POP P,A ;GET WHEREFROM
HRRZ W,R ;CALCULATE MIN IOWD NECESSARY
SKIPE .JBDDT(X) ;IF JOBDDT KEEP SYMBOLS
CAILE W,1(S)
JRST CHNLW1
HRRZ W,.JBREL ;NEED SYMBOLS AND THEY HAVE NOT MOVED DOWN
SUBI W,(X) ;BECAUSE WE WILL NOT HAVE BLITTED
SUBI B,-1(X) ;SYMBOL TABLE WILL COME OUT IN A
MOVEM B,.JBSYM(X) ;DIFFERENT PLACE
CHNLW1: MOVNS W
ADDI W,-7(A)
ADDI A,-7(X)
PUSH A,W ;SAVE LENGTH
HRLI W,-1(A)
MOVSM W,IOWDPP ;...
SETZM IOWDPP+1 ;JUST IN CASE
PUSH A,.JBCHN(X)
PUSH A,.JBSA(X) ;SETUP SIX WORD TABLE
PUSH A,.JBSYM(X) ;...
PUSH A,.JB41(X)
PUSH A,.JBDDT(X)
SETSTS 2,17 ;SET AUX DEV TO DUMP MODE
MOVSI W,'CHN' ;USE .CHN AS EXTENSION
MOVEM W,DTOUT1 ;...
PUSHJ P,IAD2 ;DO THE ENTER
JRST LD2 ;ENTER FAILURE
OUTPUT 2,IOWDPP ;WRITE THE CHAIN FILE
STATZ 2,IOBAD!IODEND
JRST LOSEBIG
CLOSE 2,
STATZ 2,IOBAD!IODEND
IFN RPGSW,<JRST LOSEBIG
TLNE N,RPGF ;IF IN CCL MODE
JRST CCLCHN ;LOAD NEXT LINK
EXIT>
LOSEBI: TTCALL 3,[ASCIZ /?DEVICE ERROR/]
EXIT>
SUBTTL SPECIAL CHAINB
IFN SPCHN,<
CHNBG: PUSHJ P,FSCN1A ;FORCE SCAN TO COMPLETION FOR CURRENT FILE
TLNN N,AUXSWI ;IS THERE AN AUX DEV??
JRST CHNBG1 ;NO, SKIP THIS CODE
PUSH P,W ;PRESERVE W
MOVE W,CHNOUT+1 ;GET AUX DEV
DEVCHR W, ;GET ITS CHARACTERISTICS
TLNN W,DSKBIT ;IS IT A REAL DSK?
TLZA N,AUXSWI!AUXSWE ;NO, RELEASE MAP DEVICE
TLNN N,AUXSWE!AUXSWI ;SHOULD AUX DEVICE BE RELEASED?
RELEAS 2, ;YES, RELEAS IT SO ENTER WILL NOT FAIL
POP P,W ;RESTORE W
CHNBG1: ;LABEL TO SKIP AUX DEV. CHECKING
IFN REENT,<TRO N,VFLG ;GIVE HIM REENTRANT FORSE UNLESS /-V SEEN>
HRLZI W,-1(R) ;CHNTAB-L = ADDRESS OF VECTOR TABLE
HRRI W,1 ;CHNTAB-R = NEXT DISK BLOCK TO RITE INTO
MOVEM W,CHNTAB
MOVE C,[RADIX50 4,OVTAB] ;DEFINE GLOBAL SYMBOL OVTAB
MOVEI W,(R) ;TO HAVE VALUE THE BEGINNING OF THE VECTOR TABLE
PUSHJ P,SYMPT
ADDI R,VECLEN ;RESERVE SPACE FOR VECTOR TABLE
MOVE C,[RADIX50 4,OVBEG] ;OVBEG IS BEGINNING OF OVERLAY AREA
MOVEI W,(R)
PUSHJ P,SYMPT
HRRZM R,BEGOV ;AND SAVE IN OVBEG
SETZM LINKNR ;SET CURRENT LINK # TO ZERO
TRZ N,CHNMAP ;SHOW ROOT NOT PRINTED
OPEN 4,CHNOUT ;OPEN FILE FOR CHAIN
JRST ILD5 ;CANT OPEN CHAIN FILE
SKIPE CHNENT ;TEST FOR DEFINED CHAIN-FILE NAME
JRST CHNBG2 ;YES, SKIP
PUSH P,W ;SAVE W
IFN NAMESW,<
SKIPN W,CURNAM ;GET CURRENT NAME & TEST FOR DEFINED >
MOVE W,['CHAIN '] ;SET NAME = 'CHAIN'
MOVEM W,CHNENT ;AND STORE AS FILE NAME
POP P,W ;RESTORE W
CHNBG2: ENTER 4,CHNENT ;ENTER CHAIN FILE
JRST CHNBG3 ;ERROR
HRRZ W,NAMPTR
SUB W,HISTRT ;KEEP N RIGHT HALF AS RELATIVE TO HISTRT
HRRZM W,CHNACN ;SAVE FOR RESTORING
MOVEM B,CHNACB ;ALSO B R IS SAVED IN BEGOV
TRNE N,ENDMAP ;TEST FOR DEFERED MAP REQUEST
PUSHJ P,PRTMAP ;YES, PRINT IT NOW
AOS LINKNR ;SET LINE NUMBER TO 1
POPJ P,
CHNBG3: ERROR ,</ERROR WRITING CHAIN@/>
POPJ P,
CHNENS: TLOA N,PPCSW ;THIS FLAG UNUSED AT THIS POINT
CHNEN: TLZ N,PPCSW ;ON TO NOT DELETE NEW SYMBOLS
SKIPN CHNACB ;WILL BE NON-ZERO IF WE SAW A /< (> TO KEEP MACRO HAPPY)
JRST LD7D ;ERROR MESSAGE
PUSHJ P,FSCN1A ;LOAD LIB (IF DESIRED) AND FORCE SCAN
TRNE N,ENDMAP ;TEST FOR DEFERED MAP REQUEST
PUSHJ P,PRTMAP ;YES, PRINT IT
AOS LINKNR ;INCR TO NEXT LINK NUMBER
SKIPL Q,S ;CHECK SYMBOL TABLE FOR MISSED UNDEFS
JRST NOER ;NONE THERE
MOVEI E,0 ;COUNT OF ERRORS
ONCK:
IFN FAILSW,<SKIPL V,1(Q) ;IF HIGH ORDER BIT IS ON
TLNN V,740000 ;OR IF ALL CODE BITS 0
JRST NXTCK ;THEN NOT TO BE CHECKED>
MOVE V,2(Q) ;GET FIXUP WORD
TLNE V,100000 ;BIT INDICATES SYMBOL TABLE FIXUP
JRST SMTBFX
IFN FAILSW,<TLNE V,40000 ;BIT INDICATES POLISH FIXUP
JRST POLCK>
TLZE V,740000 ;THESE BITS WOULD MEAN ADDITIVE
JRST [JSP A,CORCKL
JRST NXTCK] ;ONLY TRY FIRST LOCATION
CORCK: JSP A,CORCKL
HRRZ V,@X ;THE WAY TO LINK
CORCKL: IFN REENT,<CAMGE V,HVAL1>
CAMGE V,BEGOV
SKIPA ;NOT IN BAD RANGE
JRST ERCK ;BAD, GIVE ERROR
JUMPE V,NXTCK ;CHAIN HAS RUN OUT
IFN REENT,<CAMGE V,HVAL1 ;GET CORRECT LINK
SKIPA X,LOWX
MOVE X,HIGHX>
XCT (A) ;TELLS US WHAT TO DO
JRST CORCKL ;GO ON WITH NEXT LINK
SMTBFX: TLNE N,PPCSW ;IF NOT CUTTING BACK SYMBOL TABLE
JRST NXTCK ;THE ALL OK
ADD V,HISTRT ;GET PLACE TO POINT TO
HRRZS V
HLRE D,CHNACB ;OLD LENGTH OF TABLE (NEGATIVE)
HLRE T,B ;NEW LENGTH
SUB D,T ;-OLD LEN+NEW LEN
ADDI D,(B) ;OLD BOTTOM=NEW BOTTOM+NEW LEN-OLD LEN
CAIG V,(D) ;IS IT IN THE PART WE ARE KEEPING
JRST ERCK
JRST NXTCK ;YES
IFN FAILSW,<POLCK: HLRZ C,V ;FIND HEADER
PUSHJ P,SREQ
SKIPA
JRST LOAD4A ;SHOULD BE THERE
HRL C,2(A) ;NOW FIRST OPERATOR (STORE)
MOVSS C
PUSHJ P,SREQ
SKIPA
JRST LOAD4A
ANDI C,37 ;GET OPERATION
HRRZ V,2(A) ;DESTINATION
JRST @CKSMTB-15(C) ;DISPATCH
CKSMTB: EXP SMTBFX,SMTBFX,SMTBFX,CORCK,LCORCK,CORCK,NXTCK
LCORCK: JSP A,CORCKL
HLRZ V,@X>
ERCK: MOVE C,1(Q) ;GET SYMBOL NAME
PUSHJ P,FCRLF ;FORCE CRLF AND OUTPUT ON TTY
PUSHJ P,PRNAME ;PRINT IT
ADDI E,1 ;MARK ERROR
NXTCK: ADD Q,SE3 ;TRY ANOTHER
JUMPL Q,ONCK
IFN REENT,<PUSHJ P,RESTRX ;GET PROPER X BACK>
JUMPE E,NOER ;DID ANYTHING GO WRONG??
ERROR ,</UNDEFINED GLOBAL(S) IN LINK@/>
TRZE N,ENDMAP ;DELAYED MAP IN PIPELINE
PUSHJ P,PRTMAP ;YES, GO DO IT
JRST LD2 ;GIVE UP
NOER: TRZE N,ENDMAP ;DELAYED MAP IN PIPELINE
PUSHJ P,PRTMAP ;YES, GO DO IT
MOVE A,BEGOV ;GET START OF OVERLAY
ADDI A,(X) ;GET ACTUAL CURRENT LOCATION
IFN REENT,<HRRZ W,HILOW ;AND END OF OVERLAY+1
HRRZM A,HILOW ;RESET>
IFE REENT,<HRRZ W,R
ADDI W,(X) ;A BETTER GUESS>
SUBM A,W ;W=-LENGTH
SUBI A,1 ;SET TO BASE-1 (FOR IOWD)
HRL A,W ;GET COUNT
MOVEM A,IOWDPP
SETZM IOWDPP+1
HRR A,CHNTAB ;BLOCK WE ARE WRITING ON
HLRZ V,CHNTAB ;POINTER TO SEGMENT TABLE
ADDI V,1 ;NEXT LOCATION
HRLM V,CHNTAB ;REMEMBER IT
CAML V,BEGOV ;CHECK FOR OVERRUN
JRST [ERROR ,</?TOO MANY LINKS@/>
JRST LD2];GIVE UP
MOVEM A,@X ;PUT INTO TABLE
MOVN W,W ;GET POSITIVE LENGTH
MOVE C,CHNOUT+1 ;GET CHAIN DEV.
DEVCHR C, ;WHAT IS IT?
MOVEI A,DSKBLK ;ASSUME DSK
TRNE C,DTABIT ;BUT IF DTA
MOVEI A,DTABLK ;BLOCK IS 177
ADDI W,-1(A)
IDIV W,A ;GET NUMBER OF BLOCKS
ADDM W,CHNTAB ;AND UPDATE
TLZE N,PPCSW
JRST NOMVB ;DO NOT ADJUST SYMBOLS
HLRE W,CHNACB ;GET OLD LENGTH OF DEF SYMBOLS
HLRE C,B ;AND NEW LENGTH
SUB W,C ;-OLD LEN+NEW LEN
HRRZ C,B ;SAVE POINTER TO CURRENT S
ADD S,W
HRL W,W
ADD B,W ;UPDATE B (COUNT AND LOC)
JUMPGE S,UNLNKD ;JUST IN CASE NOTHING TO MOVE
HRRZ A,B ;PLACE TO PUT UNDEFS
UNLNK: MOVE W,(C)
MOVEM W,(A) ;TRANSFER
SUBI A,1
CAIE A,(S) ;HAVE WE MOVED LAST WORD??
SOJA C,UNLNK ;NO, CONTINUE
UNLNKD: HRRZ W,CHNACN ;GET SAVED N
ADD W,HISTRT
HRRZM W,NAMPTR ;AND RESET IT
NOMVB: HRR R,BEGOV ;PICK UP BASE OF AREA
SETSTS 4,16 ;SET DUMP MODE IN CASE OF INTERACTION WITH OTHER CHANNELS
OUTPUT 4,IOWDPP ;DUMP IT
STATZ 4,IOBAD!IODEND ;AND ERROR CHECK
JRST LOSEBI
HRRZ V,R ;GET AREA TO ZERO
MOVEI W,@X
CAIL W,1(S) ;MUST MAKE SURE SOME THERE
POPJ P, ;DONE
SETZM (W)
CAIL W,(S)
POPJ P,
HRLS W
ADDI W,1
BLT W,(S) ;ZERO WORLD
POPJ P,
>
SUBTTL EXPAND CORE
IFN EXPAND,<
XPAND: TLNE F,FULLSW ;IF CORE EXCEEDED
POPJ P, ;DON'T WASTE TIME ON CORE UUO
PUSH P,Q
HRRZ Q,.JBREL
ADDI Q,2000
XPAND1: PUSH P,H ;GET SOME REGISTERS TO USE
PUSH P,X
PUSH P,N
PUSH P,.JBREL ;SAVE PREVIOUS SIZE
CAMG Q,ALWCOR ;CHECK TO SEE IF RUNNING OVER
CORE Q,
JRST XPANDE
IFE K,< HRRZ H,MLTP ;GET LOWEST LOCATION
TLNN N,F4SW ;IS FORTRAN LOADING>
MOVEI H,1(S) ;NO, USE S
POP P,X ;LAST .JBREL
HRRZ Q,.JBREL;NEW JOBREL
SUBI Q,(X) ;GET DIFFERENCE
HRLI Q,X ;PUT X IN INDEX FIELD
XPAND2: MOVE N,(X)
MOVEM N,@Q
CAMLE X,H ;TEST FOR END
SOJA X,XPAND2
HRLI H,-1(Q)
TLC H,-1 ;MAKE IT NEGATIVE
SETZM (H) ;ZERO NEW CORE
AOBJN H,.-1
MOVEI H,(Q)
XPAND8: ADD S,H
ADD B,H
ADDM H,HISTRT ;UPDATE START OF HISEG
IFN REENT,<ADDM H,HIGHX ;AND STORE LOCATION
TLNE F,HIPROG
ADDM H,-1(P) ;X IS CURRENTLY IN THE STACK>
POP P,N
ADDM H,NAMPTR
IFE K,<
IFN MANTIS,<SKIPE MNTSYM ;DEBUGGER DATA PRESENT?
ADDM H,MNTSYM>
TLNN N,F4SW ;F4?
JRST XPAND3
ADDM H,PLTP
ADDM H,BITP
ADDM H,SDSTP
ADDM H,MLTP
TLNE N,SYDAT
ADDM H,V>
XPAND3: AOSA -3(P)
XPAND5: POP P,N
POP P,X
POP P,H
POP P,Q
POPJ P,
XPANDE: POP P,A ;CLEAR JOBREL OUT OF STACK
XPAND6: ERROR ,</MORE CORE NEEDED#/>
TLO F,FULLSW ;ONLY ONCE
JRST XPAND5
XPAND7: PUSHJ P,XPAND
JRST SFULLC
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
JRST POPJM3 ;YES, RETURN TO CALL-2>
JRST POPJM2
XPAND9: PUSH P,Q ;SAVE Q
HRRZ Q,.JBREL ;GET CORE SIZE
ADDI Q,(V) ;ADD XTRA NEEDED
JRST XPAND1 ;AND JOIN COMMON CODE
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
>
SUBTTL SWITCH HANDLING
;ENTER SWITCH MODE
LD6A: CAIN T,57 ;WAS CHAR A SLASH?
TLO N,SLASH ;REMEBER THAT
LD6A2: TLO F,SSW ;ENTER SWITCH MODE
LD6A1: SETZB D,C ;ZERO TWO REGS FOR DECIMAL AND OCTAL
IFN SYMARG,<TRZ F,ARGFL ;CLEAR SPECIAL SYMBOL SWITCH >
JRST LD3 ;EAT A SWITCH
;ALPHABETIC CHARACTER, SWITCH MODE
LD6:
CAIL T,141 ;ACCEPT LOWER CASE SWITCHES
SUBI T,40
IFN SPCHN,<XCT LD6B-74(T) ;EXECUTE SWITCH FUNCTION>
IFE SPCHN,<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:
IFN SPCHN,<PUSHJ P,CHNBG ;LESS THAN - BEGINNING OF OVERLAY
PUSHJ P,CHNENS ;= - PUT OUT CHAIN RETAINING SYMBOLS
PUSHJ P,CHNEN ;GREATER THAN - END OF OVERLAY
JRST LD7B ;? - ERROR
JRST LD7B ;@ - ERROR>
PUSHJ P,ASWTCH ;A - LIST ALL GLOBALS
IFN DMNSW,<PUSHJ P,DMN2 ;B - BLOCKS DOWN SYMBOL TABLE >
IFE DMNSW,<JRST LD7B ;B - ERROR>
IFE K,< PUSHJ P,CHNC ;C - CHAIN, START W/ COMMON>
IFN K,< JRST LD7B ;C - ILLEGAL IN 1KLOAD>
PUSHJ P,LDDT ;D - DEBUG OPTION, LOAD DDT
TLO N,EXEQSW ;E - LOAD AND GO
PUSHJ P,LIBF0 ;F - LIBRARY SEARCH
PUSHJ P,LD5E ;G - GO INTO EXECUTION
IFN REENT,<PUSHJ P,HSET ;H - REENTRANT. PROGRAM>
IFE REENT,<JFCL ;JUST IGNORE /H>
PUSHJ P,ISWTCH ;I - IGNORE STARTING ADDRESSES
TLZ N,ISAFLG ;J - USE STARTING ADDRESSES
IFE KUTSW,<JRST LD7B ;K - ERROR>
IFN KUTSW,<MOVEM C,CORSZ ;K - SET DESIRED CORE SIZE>
PUSHJ P,LSWTCH ;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
PUSHJ P,PSWTCH ;P - PREVENT AUTO. LIB. SEARCH
TLZ F,NSW ;Q - ALLOW AUTO. LIB. SEARCH
IFE K,< PUSHJ P,CHNR ;R - CHAIN, START W/ RESIDENT>
IFN K,< JRST LD7B ;R - ILLEGAL IN 1KLOAD>
PUSHJ P,SSWTCH ;S - LOAD WITH SYMBOLS
PUSHJ P,LDDTX ;T - LOAD AND GO TO DDT
PUSHJ P,PMSQ ;U - PRINT UNDEFINED LIST
IFN REENT,<PUSHJ P,VSWTCH ;V - LOAD REENTRANT LIB40>
IFE REENT,<JRST LD7B ;V - ERROR>
TLZ F,SYMSW+RMSMSW ;W - LOAD WITHOUT SYMBOLS
TLZ N,ALLFLG ;X - DO NOT LIST ALL GLOBALS
IFE TENEX,<TLO F,REWSW ;Y - REWIND BEFORE USE>
IFN TENEX,<PUSHJ P,NEWPAG ;Y - ORIGIN TO NEXT PAGE BOUNDARY>
JRST LDRSTR ;Z - RESTART LOADER
; PAIRED SWITCHES ( +,-)
ASWTCH: JUMPL D,.+2 ;SKIP IF /-A
TLOA N,ALLFLG ;LIST ALL GLOBALS
TLZ N,ALLFLG ;DON'T
POPJ P,
ISWTCH: JUMPL D,.+2 ;SKIP IF /-I
TLOA N,ISAFLG ;IGNORE STARTING ADDRESSES
TLZ N,ISAFLG ;DON'T
POPJ P,
LSWTCH: JUMPL D,.+2 ;SKIP IF /-L
TLOA F,LIBSW!SKIPSW ;ENTER LIBRARY SEARCH
TLZ F,LIBSW!SKIPSW ;DON'T
POPJ P,
PSWTCH: JUMPL D,.+2 ;SKIP IF /-P
TLOA F,NSW ;PREVENT AUTO. LIB SEARCH
TLZ F,NSW ;ALLOW
POPJ P,
SSWTCH: JUMPL D,.+2 ;SKIP IF /-S
TLOA F,SYMSW!RMSMSW ;LOAD WITH SYMBOLS
IFE MANTIS,<TLZ F,SYMSW!RMSMSW ;DON'T>
IFN MANTIS,<TLZA F,SYMSW!RMSMSW ;DON'T
TRZ N,SYMFOR ;SYMBOLS LOAD EXPLICITLY SPECIFIED>
POPJ P,
IFN REENT,<
VSWTCH: JUMPL D,.+2 ;SKIP IF /-V
MOVEI D,1 ;SET VSW = +1 FOR /V
MOVEM D,VSW ; = -1 FOR /-V
POPJ P,>
IFN TENEX,<
;Y SWITCH - START LOADING AT NEXT PAGE BOUNDARY
NEWPAG: JUMPL C,NEWLPG ;/-Y BUMPS LOWSEG LOC
ADDI R,777 ;/Y BUMPS HISEG LOC
ANDCMI R,777
POPJ P,0
NEWLPG: MOVE D,LOWR
ADDI D,777
ANDCMI D,777
MOVEM D,LOWR
POPJ P,0
>
IFN REENT,<
; H SWITCH --- EITHER /H OR /NH
HSET: JUMPE D,SETNUM ;/H ALWAYS LEGAL
CAIGE D,2 ;WANT TO CHANGE SEGMENTS
JRST SETSEG ;YES,GO DO IT
TRNN F,SEENHI ;STARTED TO LOAD YET?
JRST HCONT ;NO, CONTINUE.
IFE TENEX,<ERROR ,<?/H ILLEGAL AFTER FIRST HISEG FILE IS LOADED@?>>
IFN TENEX,<HRRZ C,HVAL
CAIGE D,0(C)
JRST HSET69
HRRM D,HIGHR ;MOVE UP HIGH BREAK
POPJ P,0
HSET69: ERROR ,<?/H ILLEGAL: ATTEMPT TO LOWER HISEG BREAK@?>
POPJ P,0>
>
LDRSTR: ERROR 0,</LOADER RESTARTED@/>
JRST BEG ;START AGAIN (NO CCL)
IFN REENT,<
HCONT: HRRZ C,D
IFE TENEX,<ANDCMI C,1777
CAIL C,400000>
CAIG C,(H)
JRST COROVL ;BEING SET LOWER THAN 400000 OR MORE THAN TOP OF LOW SEG
HRRZM C,HVAL1 ;WE HAVE REMOVED THE ODD BITS TO MAKE A 1K MULT
ADDI C,.JBHDA
CAILE C,(D) ;MAKE SURE OF ENOUGH ROOM
MOVE D,C
HRLI D,W ;SET UP W IN LEFT HALF
MOVEM D,HVAL
POPJ P, ;RETURN.
COROVL: ERROR ,</HISEG STARTING ADDRESS TOO LOW@/>
JRST LDRSTR
SETNUM: TRO F,NOHI ;SET NO-HIGH-SEG SWITCH.
POPJ P,>
;SWITCH MODE NUMERIC ARGUMENT
LD6C: LSH D,3 ;BUILD OCTAL NUMERIC ARGUMENT
ADDI D,-60(T)
IMULI C,^D10
ADDI C,-"0"(T) ;ACCUMULATE DEC AND OCTAL
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: IFN SYMARG,<
CAIN T,"#" ;DEFINING THIS SYMBOL
JRST DEFINE ;YES
TRNN F,ARGFL ;TREAT AS SPECIAL
JRST .+4 ;NO
CAIE T,"$"
CAIN T,"%"
JRST LD4 ;YES>
CAIN T,"Z"-100 ;TEST FOR ^Z
JRST LD5E1 ;TREAT AS ALTMODE FOR BATCH
ERROR 8,</CHAR.%/>
JRST LD2 ;TRY TO CONTINUE
;SYNTAX ERROR, NORMAL MODE
LD7A: ERROR 8,</SYNTAX%/>
JRST LD2
;ILLEGAL CHARACTER, SWITCH MODE
LD7B: CAIN T,"-" ;SPECIAL CHECK FOR -
JRST [SETOB C,D
JRST LD3]
CAIN T,"Z"-100 ;CHECK FOR /^Z
JRST LD5E1 ;SAME AS ^Z
ERROR 8,</SWITCH%/>
JRST LD2
;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0
IFE K,<
LD7C: ERROR ,<?UNCHAINABLE AS LOADED@?>
JRST LD2
;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE
LD7D: ERROR ,<?NO CHAIN DEVICE@?>
JRST LD2>
IFN DMNSW,<
DMN2:
IFN REENT,<CAIN D,1 ;SPECIAL CASE
TROA F,HISYM ;YES ,BLT SYMBOLS INTO HISEG>
JUMPL D,.+2
TROA F,DMNFLG ;TURN ON /B
TRZ F,DMNFLG ;TURN OFF IF /-B
CAMLE D,KORSP
MOVEM D,KORSP
POPJ P, ;RETURN>
SUBTTL 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
;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 CLASSIFICATION 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
IFE SYMARG,< BYTE (4)0,0,0,0,5,3,0,0,11>
IFN SYMARG,< BYTE (4)0,0,14,0,5,3,0,0,11>
BYTE (4)0,7,5,2,2,2,2,2,2
IFE SPCHN,< BYTE (4)2,2,2,2,6,0,0,10,0>
IFN SPCHN,< BYTE (4)2,2,2,2,6,0,1,10,1>
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,1,1>
IFN PP,<BYTE (4)1,10,0,10,0,10,0,1,1>
BYTE (4)1,1,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,0,0,13
BYTE (4)13,4
SUBTTL INITIALIZE LOADING OF A FILE
ILD: MOVEI W,BUF1 ;LOAD BUFFER ORIGIN
MOVEM W,.JBFF
TLOE F,ISW ;SKIP IF INIT REQUIRED
JRST ILD6 ;DONT DO INIT
ILD7: OPEN 1,OPEN3 ;KEEP IT PURE
JRST ILD5B
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 LNSSW,<
INBUF 1,BUFN ;SET UP BUFFERS>
IFN LNSSW,<INBUF 1,1
MOVEI W,BUF1
EXCH W,.JBFF
SUBI W,BUF1
IFE K,<MOVEI C,4*203+1>
IFN K,<MOVEI C,203+1>
IDIV C,W
INBUF 1,(C)>
TLO F,ASW ;SET LEFT ARROW ILLEGAL FLAG
TLZ F,ESW ;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:
IFN CPUSW,< ;ALLOW LIB40I OR LIB40A TO FIND LIB40
MOVE W,DTIN ;GET NAME WE TRIED FOR
TRZN W,77 ;DELETE 6TH CHARACTER
JRST ILD4B ;TRIED ALL CASES IF NULL
IFN REENT,<CAME W,['IMP40 '] ;IMP40? REQUESTED?>
CAMN W,['LIB40 '] ;WAS IT SOME FLAVOUR OF LIB40?
JRST [MOVEM W,DTIN ;YES, SALT NEW NAME
PUSHJ P,LDDT2 ;SET .REL AGAIN
TLZ F,ESW
JRST ILD2]
ILD4B:>
IFE REENT,<IFE TEN30,< ;PDP-6 ONLY
MOVE W,[SIXBIT /LIB40/]
CAME W,DTIN ;WAS THIS A TRY FOR LIB40?
JRST ILD4A ;NO
TRZ W,(SIXBIT / 0/) ;YES
MOVEM W,DTIN ;TRY LIB4
PUSHJ P,LDDT2 ;USE .REL EXTENSION
TLZ F,ESW ;...
JRST ILD2 ;GO TRY AGAIN
ILD4A:>>
ILD9: ERROR ,</CANNOT FIND#/>
JRST LD2C
; DEVICE SELECTION ERROR
ILD5A: SKIPA W,LD5C1
ILD5B: MOVE W,ILD1
ILD5: PUSHJ P,PRQ ;START W/ ?
PUSHJ P,PWORD ;PRINT DEVICE NAME
ERROR 7,</UNAVAILABLE@/>
JRST LD2
SUBTTL LIBRARY SEARCH CONTROL AND LOADER CONTROL
LIBF0: IFN FORSW,<
JUMPE D,LIBF ;MAKE /F WORK SAME WAY
SOSGE D ;USER SUPPLIED VALUE?
MOVEI D,FORSW-1 ;NO, SUPPLY DEFAULT
MOVEM D,FORLIB ;STORE VALUE
POPJ P, ;RETURN HAVING SETUP FOR /0F>
LIBF: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
PUSH P,ILD1 ;SAVE DEVICE NAME
IFN PP,<SETZM PPN ;CLEAR LOCAL PPN
SETZM PPPN ;AND GLOBAL PPN>
PUSHJ P,LIBF1 ;LOAD SYS:JOBDAT.REL
IFN SAILSW,<LIBAGN: PUSHJ P,SALOAD ;LOAD RELS AND SEARCH LIBS>
IFN REENT,<SKIPGE W,VSW ;WAS /-V SEEN
TRZ N,VFLG ;YES, DOES NOT WANT REENTRANT SYSTEM
CAILE W,0 ;SKIP IF HE DOESN'T KNOW OR CARE
TRO N,VFLG ;DEFINITELY WANTS REENTRANT SYSTEM
TRNE F,SEENHI!HISYM ;IF ANY HISEG LOADED NO RE-ENT OP SYSTEM
TRZ N,VFLG!MANTFL ;YES, SO FORCE /-V SWITCH
TRNN N,VFLG
JRST LIBF3
IFN ALGSW,<TRNE N,ALGFL ;SPECIAL ACTION IF LOADING ALGOL
PUSHJ P,SHARE>
IFN FORSW,<TRNN N,FORFL ;FORTRAN-10 ALWAYS WANTS FOROTS
TRNE N,F4FL ;IF F40
SKIPG FORLIB ;AND WANTING FORLIB
JRST LIBF3 ;NOT BOTH TRUE
MOVE C,[RADIX50 04,FOROT%] ;SYMBOL
MOVEI W,400000+.JBHDA ;VALUE
PUSHJ P,SYMPT ;YES, DEFINE SYMBOL>
LIBF3:>
IFN NELSW,<TRNN N,NELFL ;LOADING NELIAC
JRST .+4 ;NO
PUSHJ P,NELGO ;UNDEFINED SYMBOL NELGO
MOVE W,[SIXBIT /LIBNEL/]
PUSHJ P,LIBF2 ;LOAD NELIAC LIBRARY>
IFN ALGSW,<MOVE W,[SIXBIT /ALGLIB/]
IFE NAMESW,<TRNE N,ALGFL ;LOADING ALGOL?>
IFN NAMESW,<TRNN N,ALGFL ;ALGOL?
JRST LIBF5+1 ;NO
SKIPE CURNAM ;SEE MAIN PROG YET?
JRST LIBF5 ;YES
ERROR ,</ALGOL MAIN PROGRAM NOT LOADED!/>
EXIT
LIBF5:>
PUSHJ P,LIBF2 ;YES, LOAD LIBRARY>
IFN COBSW,<MOVE W,[SIXBIT /LIBOL/]
TRNE N,COBFL ;LOADING COBOL?
PUSHJ P,LIBF2 ;YES, SCAN LIBOL>
IFN REENT,<
IFE CPUSW,<MOVE W,[SIXBIT /IMP40/]>
IFN CPUSW,<MOVE W,['IMP40A'] ;ASSUME KA-10
TRNE F,KICPFL ;BUT IS IT?
HRRI W,'40I' ;NO, CHANGE TO IMP40A>
IFN FORSW,<SKIPG FORLIB ;IF LOADING FORLIB WE DON'T WANT IMP40>
TRNE N,COMFLS-F4FL ;ANY OTHER COMPILER ?
JRST LIBF4 ;YES, THEN WE DON'T WANT IMP40
TRNE N,VFLG ;WANT REENTRANT OP SYSTEM?
PUSHJ P,LIBF2 ;YES, TRY REENTRANT FORSE>
LIBF4:
IFE CPUSW,<MOVE W,[SIXBIT /LIB40/]>
IFN CPUSW,<MOVE W,['LIB40A']
TRNE F,KICPFL
HRRI W,'40I'>
IFN FORSW,<SKIPLE FORLIB ;FORSE OR FOROTS
MOVE W,['FORLIB'] ;YOU GET WHAT YOU ASK FOR>
IFN ALGSW,<TRNN N,ALGFL ;DON'T NEED LIB40 FOR ALGOL>
PUSHJ P,LIBF2 ;LOAD LIBRARY
IFN SAILSW,<MOVE W,LIBPNT ;SEE IF ANY MORE TO DO
CAME W,[XWD -RELLEN-1,LIBFLS-1]
JRST LIBAGN
MOVE W,PRGPNT ;IT COULD BE DANGEROUS TO LOAD PROGRAMS HERE
CAME W,[XWD -RELLEN-1,PRGFLS-1]
JRST LIBAGN ;MORE TO DO, TRY AGAIN>
POP P,ILD1 ;CALL TO LDDT1 WILL PUT IT IN OLDDEV
LIBF1: MOVE W,[SIXBIT /JOBDAT/] ;LOAD SYS:JOBDAT.REL
LIBF2: PUSHJ P,LDDT1
LIBGO: JUMPGE S,EOF2 ;JUMP IF NO UNDEFINED GLOBALS
TLO F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH
TLZ F,SYMSW ;DISABLE LOADING WITH SYMBOLS
JRST LDF ;INITIALIZE LOADING LIB4
IFN ALGSW!NELSW,<
IFN NELSW,<
NELGO: SKIPA C,[RADIX50 60,%NELGO]>
SHARE: MOVE C,[RADIX50 60,%SHARE]
MOVEI W,0
JRST SYMPT ;DEFINE IT >
; 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
IFN DIDAL,<TRNE F,XFLG ;INDEX IN CORE?
JRST INDEX1 ;YES>
JRST LOAD ;CONTINUE LIB. SEARCH
LIB1: CAIE A,4 ;TEST FOR ENTRY BLOCK
JRST LIB29 ;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
LIB29: CAIN A,14 ;INDEX BLOCK?
JRST INDEX0 ;YES
LIB30: HRRZ C,W ;GET WORD COUNT
JUMPE C,LOAD1 ;IF NUL BLOCK RETURN
CAILE C,^D18 ;ONLY ONE SUB-BLOCK
JRST LIB3 ;NO,SO USE OLD SLOW METHOD
ADDI C,1 ;ONE FOR RELOCATION WORD
LIB31: CAML C,BUFR2 ;DOES BLOCK OVERLAP BUFFERS?
SOJA C,LIB32 ;YES,ALLOW FOR INITIAL ILDB
ADDM C,BUFR1 ;ADD TO BYTE POINTER
MOVNS C ;NEGATE
ADDM C,BUFR2 ;TO SUBTRACT C FROM WORD COUNT
JRST LOAD1 ;GET NEXT BLOCK
LIB32: SUB C,BUFR2 ;ACCOUNT FOR REST OF THIS BUFFER
PUSHJ P,WORD+1 ;GET ANOTHER BUFFERFUL
JRST LIB31 ;TRY AGAIN
IFN SAILSW,<
COMMENT * BLOCK TYPE 16 AND 17 USED TO SPECIFY PROGRAMS AND
LIBRARIES WHICH MUST BE LOADED (SEARCHED) IF THE PROGRAM
IN WHICH THE BLOCK APPEARS IS LOADED. IT IS NOW TIME TO
LOAD AND SEARCH THESE FILES. IF ANY MAKE REQUESTS, THEY ARE ADDED
TO THE END. WE WILL COME BACK AND LOOK AGAIN IN CASE A
LIBRARY PROGRAM LOAD A REL PROGRAM. ORIGINAL CODE BY DCS*
SALOAD: MOVE T,[XWD -RELLEN-1,PRGFLS-1] ;TO RESET WITH AT END
MOVEI D,PRGPNT ;OINTER TO UPPER LIMIT
PUSHJ P,PRGPRG ;LOAD THEM IF ANY
;NOW FOR LIBRARY SEARCH
MOVE T,[XWD -RELLEN-1,LIBFLS-1]
MOVEI D,LIBPNT
PRGPRG: MOVEM D,LODLIM# ;SAVE POINTER TO LIMIT
MOVEM T,LODSTP# ;START FOR RESETTING
PRGBAK: MOVEM T,LODPNT# ;AND START
CAMN T,@LODLIM ;GOTTEN TO END YET?
JRST PRGDON ;YES, DUMP IT
SKIPN W,PRGDEV(T) ;IS DEVICE SPECIFIED?
MOVSI W,(SIXBIT /DSK/) ;NO, DSK
MOVEM W,ILD1 ;WHERE WE INIT FROM
MOVSI W,(SIXBIT /REL/) ;EXTENSION
MOVEM W,DTIN1
MOVE W,PRGFIL(T)
MOVEM W,DTIN ;FILE NAME
MOVE W,PRGPPN(T) ;THE PROJECT PROG
MOVEM W,DTIN+3
PUSH P,JRPRG ;A RETURN ADDRESS
TLZ F,ISW ;FORCE NEW INIT
HRRZ T,LODLIM
CAIN T,LIBPNT ;WHICH ONE
JRST LIBGO
JRST LDF
PRGRET: MOVE T,LODPNT ;RETURNS HERE, GET NEXT ONE
AOBJN T,PRGBAK
PRGDON: MOVE T,LODSTP ;RESTE POINTER IN CASE MORE ON OTHER LIBS
MOVEM T,@LODLIM
JRPRG: POPJ P,PRGRET ;PUSHED TO GET A RETURN ADDRESS
PRGFIL==1 ;REL INDEX FOR FILE NAMES
PRGPPN==RELLEN+1 ;AND FOR PPNS
PRGDEV==2*RELLEN+1 ;AND FOR DEVICES
> ;END OF IFN SAILSW
SUBTTL LDDT LOADS <SYS:DDT.REL> AND SETS SYMSW
LDDTX: TLO N,DDSW+EXEQSW ;T - LOAD AND GO TO DDT
LDDT: ;/D - LOAD DDT
IFN TENEX,<PUSH P,1
PUSH P,3
MOVEM 2,3 ; X = 2
MOVSI 1,100001
HRROI 2,[ASCIZ /<SUBSYS>UDDT.SAV/]
GTJFN
JRST LDDTQ
PUSH P,1 ;DDT JFN
MOVEI 1,400000
GEVEC ;LOADER'S EV
POP P,1
PUSH P,2
HRLI 1,400000 ;THIS FORK
GET
MOVEI 1,400000
GEVEC ;DDT'S EV
MOVEM 2,.JBDDT(3) ;3 HAS X IN IT
POP P,2
SEVEC ;RESTORE LOADER'S EVEC
TLO F,SYMSW!RMSMSW ;DO /S PROBABLY ON BY DEFAULT
MOVE 2,3
POP P,3
POP P,1
JRST DMN2
LDDTQ: TTCALL 3,[ASCIZ /
DDT10X NOT AVAILABLE. USING DEC DDT./]
MOVE 2,3
POP P,3
POP P,1>
IFN DMNSW,< PUSH P,D ;SAVE INCASE /NNND >
PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
MOVSI W,'DDT' ;FILE IDENTIFIER <DDT>
TLZ F,SYMSW!RMSMSW ;DON'T LOAD DDT WITH LOCAL SYMBOLS
PUSHJ P,LDDT1
PUSHJ P,LDF ;LOAD <SYS:DDT.REL>
TLO F,SYMSW!RMSMSW ;ENABLE LOADING WITH SYMBOLS
IFN DMNSW,< POP P,D ;RESTORE D
JRST DMN2 ;MOVE SYMBOL TABLE >
IFE DMNSW,< POPJ P,>
LDDT1: MOVEM W,DTIN ;STORE FILE IDENTIFIER
MOVE W,ILD1 ;SAVE OLD DEV
MOVEM W,OLDDEV
IFN PP,<SETZM PPPN ;CLEAR PERM PPN>
MOVSI W,'SYS' ;DEVICE IDENTIFIER <SYS>
MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER
TLZ F,ISW+LIBSW+SKIPSW+REWSW ;CLEAR OLD FLAGS
LDDT2: MOVSI W,'REL' ;EXTENSION IDENTIFIER <.REL>
LDDT3: MOVEM W,DTIN1 ;STORE EXTENSION IDENTIFIER
LDDT4: IFN PP,<
PUSH P,W ;SAVE W
SKIPN W,PPN ;GET TEMP PPN
MOVE W,PPPN ;TRY PERM
MOVEM W,DTIN+3 ;SET PPN
POP P,W ;RESTORE W>
POPJ P,
SUBTTL EOF TERMINATES LOADING OF A FILE
EOF: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER
EOF1: TLZ F,SLIBSW!SKIPSW ;CLEAR ONE FILE LIB. SEARCH FLAG
IFN DIDAL,<TRZ F,XFLG!LSTLOD ;CLEAR DIDAL FLAGS
IFN SYMDSW,<TRNE F,LSYMFL ;USING AUX BUF FOR LOCAL SYMBOLS?
JRST EOF2 ;YES>
MOVSI W,(1B0) ;FOOL MONITOR THAT WE HAVE NOT USED THIS BUFFER
HLLM W,ABUF ;THEN NEXT OUTPUT WILL BE A "DUMMY OUTPUT"
MOVSI W,700 ;RESET BYTE POINTER TO ASCII
MOVEM W,ABUF1 ;AND HOPE DUMMY OUTPUT WILL CLEAR DIDAL STUFF
SETZM ABUF2 ;ZERO BYTE COUNT TO FORCE DUMMY OUTPUT>
EOF2: TLNE F,RMSMSW ;IF REMEMBER LOADING WITH SYMBOLS IS ON
TLO F,SYMSW ;THEN RESTORE SYMBOL LOADING STATE
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
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
MOVE W,DIEND ;YES, GET END OF BUFFER+1>
SUBI W,1(S) ; COMPUT DEFICIENCY
JUMPL W,EOF2 ;JUMP IF NO OVERLAP
PUSHJ P,PRQ ;START WITH ?
PUSHJ P,PRNUM0 ;INFORM USER
ERROR 7,</WORDS OF OVERLAP#/>
JRST LD2 ;ERROR RETURN
IFN SPCHN,<FSCN1A: TLNN F,NSW
PUSHJ P,LIBF>
FSCN1: TLON F,FSW ;SKIP IF NOT FIRST CALL TO FSCN
FSCN2: TLNN F,CSW+DSW+ESW ;TEST SCAN FOR COMPLETION
POPJ P,
PUSHJ P,LD5B1 ;STORE FILE OR EXTENSION IDENT.
; LOADER CONTROL, NORMAL MODE
LDF: PUSHJ P,ILD ;INITIALIZE LOADING
TLNE F,LIBSW ;IN LIBRARY SEARCH MODE?
JRST LIB ;CHECK IF NO UNDFS.
SUBTTL LOAD SUBROUTINE
LOAD: MOVEM P,PDSAV ;SAVE PUSHDOWN POINTER
IFN WFWSW,<SETZM VARLNG ;LENGTH OF VARIABLE AREA-ADDED TO RELOC>
IFN ALGSW,<SETZM OWNLNG ;LENGTH OF OWN AREA-ADDED TO RELOC>
IFN FAILSW,<SETZM LFTHSW ;RESET LOAD LEFT HALF FIXUP SW>
IFN COBSW,<SETZM LOD37. ;CLEAR FLAG>
IFN MANTIS,<TRZE N,SYMFOR ;ZERO LOAD SYMBOLS IF IT WAS FORCED
TLZ F,SYMSW>
IFN TENEX,<SETZM NLSTGL ;ALLOW UNDEF. GLOBALS TO LIST>
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 B11SW,<SKIPN POLSW ;ERROR IF STILL DOING POLISH>
CAIL A,DISPL*2 ;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
CAIL A,DISPL ;SKIP IF CORRECT
HLRZ T,LOAD2-DISPL(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
IFE B11SW,<POLFIX==LOAD4A>
IFE FAILSW,<LINK==LOAD4A>
IFE WFWSW,<LVARB==LOAD4A>
IFE ALGSW,<ALGBLK==LOAD4A>
IFE SAILSW,<LDPRG==LOAD4A
LDLIB==LOAD4A>
IFE COBSW,<COBSYM==LOAD4A>
LOAD2: COMML,,LIB30 ;20,,0
SPDATA,,PROG ;21,,1
LOAD4A,,SYM ;22,,2
LOAD4A,,HISEG ;23,,3
LOAD4A,,LIB30 ;24,,4
LOAD4A,,HIGH ;25,,5
LOAD4A,,NAME ;26,,6
LOAD4A,,START ;27,,7
LOAD4A,,LOCD ;30,,10
LOAD4A,,POLFIX ;31,,11
LOAD4A,,LINK ;32,,12
LOAD4A,,LVARB ;33,,13
LOAD4A,,INDEX ;34,,14
LOAD4A,,ALGBLK ;35,,15
LOAD4A,,LDPRG ;36,,16
COBSYM,,LDLIB ;37,,17
DISPL==.-LOAD2
;ERROR EXIT FOR BAD HEADER WORDS
LOAD4:
IFN TENEX,<CAIN A,100 ;ASSIGN BLOCK?
JRST ASGSYM ;YES>
IFE K,<CAIN A,400 ;FORTRAN FOUR BLOCK
IFN MANTIS,< JRST F4LD
CAIE A,401 ;MANTIS DEBUGGER DATA PRESENT IN FORTRAN FILE
JRST LOAD4A ;NO
TLON F,SYMSW ;YES, FORCE SYMSW SET
TRO N,SYMFOR>
JRST F4LD>
LOAD4A: MOVE W,A ;GET BLOCK TYPE
ERROR ,</ILL. FORMAT BLOCK TYPE !/>
PUSHJ P,PRNUM ;PRINT BLOCK TYPE
JRST ILC1 ;PRINT SUBROUTINE NAME
SUBTTL LOAD PROGRAMS AND DATA (BLOCK TYPE 1)
;(BLOCK TYPE 37) TREAT AS BLOCK TYPE 1, BUT ONLY LOAD
;IF IN LOCAL SYMBOLS MODE
IFN COBSW,<
COBSYM: TLNN F,SYMSW ;LOCAL SYMBOLS?
JRST LIB30 ;NO, SKIP OVER THIS BLOCK
MOVEI V,-1(W) ;GET BLOCK LENGTH
ADDM V,LOD37. ;COUNT EXTRA CODE>
PROG: MOVEI V,-1(W) ;LOAD BLOCK LENGTH
PUSHJ P,RWORD ;READ BLOCK ORIGIN
SKIPGE W
PUSHJ P,PROGS ;SYMBOLIC IF 36 BITS
ADD V,W ;COMPUTE NEW PROG. BREAK
IFN REENT,<TLNN F,HIPROG
JRST PROGLW ;NOT HIGH SEGMENT
PROG3:
IFN TENEX,<MOVE X,HIGHX>
CAMGE W,HVAL1 ;CHECK TO SEE IF IN TOP SEG
JRST LOWCOR
MOVE T,.JBREL ;CHECK FOR OVERFLOW ON HIGH
CAIL T,@X
JRST PROG2
PUSHJ P,HIEXP
JRST FULLC
JRST PROG3>
IFN MONLOD,<TLNN N,DISW ;LOADING TO DISK?
JRST PROGLW ;NO, GO CHECK NEW BREAK
CAMG H,V ;NEW BREAK?
MOVE H,V ;YES, UPDATE
JRST PROG2 ;NO NEED TO CHECK FOR ROOM>
IFN REENT,<
LOWCOR: SUB V,HIGHX ;RELOC FOR PROPER
ADD V,LOWX ;LOADING OF LOW SEQMENT
SUB W,HIGHX
ADD W,LOWX>
PROGLW: MOVEI T,@X
CAMG H,T ;COMPARE WITH PREV. PROG. BREAK
MOVE H,T
TLNE F,FULLSW
JRST FULLC ;NO ERROR MESSAGE
IFN REENT,<CAML H,HVAL1
JRST COROVL ;WE HAVE OVERFLOWED THE LOW SEGMENT
CAMLE T,HILOW
MOVEM T,HILOW ;HIGHEST LOW CODE LOADED INTO>
CAILE H,1(S) ; SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
JRST FULLC
IFN REENT,< TLNE F,HIPROG
SUBI W,2000 ;HISEG LOADING LOW SEG>
IFN EXPAND,< JRST .-1]>
PROG2: MOVE V,W
PROG1: PUSHJ P,RWORD ;READ DATA WORD
IFN TEN30,<CAIN V,41 ;CHANGE FOR 10/30 JOBDAT
MOVEI V,.JB41 ;JOB41 IS DIFFERENT
CAIN V,74 ;SO IS JOBDAT
MOVEI V,.JBDDT>
IFN L,<CAML V,RINITL ;CHECK FOR BAD STORE>
IFN MONLOD,<PUSHJ P,DICHK ;MAKE SURE ADDRESS IS IN CORE>
MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC
IFN MONLOD,<TLO N,WOSW ;SET SWITCH TO WRITE OUT BUFFER>
AOJA V,PROG1 ;ADD ONE TO LOADER LOC. COUNTER
;HERE TO FIND SYMBOLIC ORIGIN
;W CONTAINS RADIX50 60,ORIGIN
;NEXT WORD CONTAINS OFFSET
;NOTE SYMBOL MUST BE GLOBAL AND DEFINED
PROGS: MOVE C,W ;PUT SYMBOL IN CORRECT SEARCH AC
TLC C,640000 ;PERMUTE FROM 60 TO 04
PUSHJ P,SDEF ;SEE IF DEFINED
SKIPA C,2(A) ;YES, GET VALUE
JRST PROGER ;NO, GIVE WARNING
HRRZ C,C ;CLEAR LEFT HALF IN CASE COMMON
PUSHJ P,RWORD ;GET NEXT WORD
ADD W,C ;FORM ORIGIN
SOJA V,CPOPJ ;BUT NOT SO MANY DATA WORDS
PROGER: MOVEM C,(P) ;REMOVE RETURN, SAVE C
ERROR ,</VALUE NOT DEFINED FOR SYMBOLIC RELOCATION COUNTER !/>
POP P,C
PUSHJ P,PRNAME
JRST LIB3 ;IGNORE THIS BLOCK
SUBTTL LOAD SYMBOLS (BLOCK TYPE 2)
SYM: PUSHJ P,PRWORD ;READ TWO DATA WORDS
PUSHJ P,SYMPT; PUT INTO TABLE
IFN REENT,<PUSHJ P,RESTRX>
JRST SYM
SYMPT: TLNE C,200000 ;GLOBAL REQUEST? WFW
JUMPL C,SYM3 ;CHECK FOR 60 NOT JUST HIGH BIT WFW
TLNN C,40000
JRST SYM1A ;LOCAL SYMBOL
TLNE C,100000
JRST SYM1B
SYMPTQ: 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
IFN RPGSW,<MOVE W,.JBERR ;RECORD THIS AS AN ERROR
ADDI W,1
HRRM W,.JBERR>
MOVE W,2(A) ;LOAD OLD VALUE
PUSHJ P,PRNUM ;PRINT OLD VALUE
ERROR 7,</MUL. DEF. GLOBAL IN PROG. !/>
MOVE C,SBRNAM ;GET PROGRAM NAME
PUSHJ P,PRNAME ;PRINT R-50 NAME
ERROR 0,</#/>
POPJ P, ;IGNORE MUL. DEF. GLOBAL SYM
; LOCAL SYMBOL
SYM1A: TLNN F,SYMSW ;SKIP IF LOAD LOCALS SWITCH ON
POPJ P,; IGNORE LOCAL SYMBOLS
IFN SYMDSW,<
IFE MONLOD,<TRNE F,LSYMFL ;ONLY PUT SYMBOLS ON DSK IF EXT SYM>
IFN MONLOD,<TLNN N,DISW ;BUT NOT IF LOADING TO DISK>
JRST SYM1X ;STORE SYMBOL ON DSK>
SYM1B: IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
PUSHJ P,SIZCHK ;YES, CHECK FOR OVERLAP>
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>
SYM1D: MOVEI A,-2(S) ;LOAD A TO SAVE INST. AT SYM2
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
IFE SYMDSW,<POPJ P,>
IFN SYMDSW,<
SYM1X:
IFN MONLOD,<SKIPL SYMEXT ;BEEN SETUP ONCE?
TLNE N,DISW ;OR, IF OUTPUTTING TO DSK
POPJ P, ;DON'T BOTHER>
IFE MONLOD,<SKIPL SYMEXT ;BEEN SETUP ONCE?>
TRNN F,LSYMFL ;OUTPUT FILE SET UP?
IFN MONLOD,<PUSHJ P,INITSYM ;NO, DO IT>
IFE MONLOD,<POPJ P, ;NO, DON'T OUTPUT SYMBOLS>
SOSG ABUF2
OUTPUT 2,
IDPB C,ABUF1
SOSG ABUF2
OUTPUT 2,
IDPB W,ABUF1
AOS SYMCNT#
POPJ P,>
IFN SYMDSW,<
SYOPEN: HLRZM W,SYMEXT#
MOVE W,DTIN ;GET FILE NAME
MOVEM W,SYMNAM ;SAVE IT
PUSHJ P,INITSYM ;OPEN FILE
JRST LD2DD ;AND RETURN TO SCAN
INITSYM:
TLZ N,AUXSWI!AUXSWE
INIT 2,14
SIXBIT /DSK/
ABUF,,0
HALT
PUSH P,0
PUSH P,1
PUSH P,2
PUSH P,3
MOVEI 0,AUX
MOVEM 0,.JBFF
OUTBUF 2,1
PJOB 0,
MOVEI 3,3
IDIVI 0,^D10
ADDI 1,"0"-40
LSHC 1,-6
SOJG 3,.-3
HRRI 2,'SYM'
MOVE 0,SYMNAM# ;GET NAME
JUMPN 0,.+3 ;WAS IT SET
MOVS 0,2 ;NO
MOVEM 0,SYMNAM ;STORE IT
SKIPN 1,SYMEXT ;ALREADY SET
MOVEI 1,'TMP'
HRRZM 1,SYMEXT ;STORE FILE EXTENSION
HRLZS 1
SETZB 2,3
ENTER 2,0
HALT
POP P,3
POP P,2
POP P,1
POP P,0
IORI F,LSYMFL ;SYMBOL FILE SETUP NOW
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
SYM2W1: PUSHJ P,SREQ ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
JRST SYM2B ;FOUND MORE
SYM2C: POPJ P,SYM1D ;RETURN, SEE SYM2 FOR USE OF ADDRESS
; 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
; 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,HISTRT ;AND MAKE RELATIVE
IFN B11SW,<TLZ W,040000>
SYM3X2: IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
PUSHJ P,SIZCHK ;YES, CHECK FOR OVERLAP>
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
SYM3A4: PUSHJ P,SDEF2 ;YES, CONTINUE WFW
JRST SYM3A ;FOUND ANOTHER WFW
JRST SYM3X2 ;REALLY NO CHAIN THERE WFW
SYM3A1: SKIPE V,2(A) ;IF ADDRESS OF CHAIN IS 0, THROW IT AWAY
JRST SYM3A2 ;AND USE THE NEW ONE, ELSE ADD THE CHAINS
MOVEM W,2(A) ;W IS ADDRESS OF NEW CHAIN,STORE ON TOP OF OLD 0
POPJ P,
SYM3A2:
SYM3A3: MOVE A,2(A)
SYM3B: HRRZ V,A
IFN L,<CAMGE V,RINITL
HALT>
IFN REENT,<CAMGE V,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK ; MAKE SURE ADDRESS IN V IS IN CORE>
HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
JUMPN A,SYM3B ; JUMP IF NOT THE LAST ADDR. IN CHAIN
HRRM W,@X ;COMBINE CHAINS
IFN MONLOD,<TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
POPJ P,;
;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 FO SAME
TDNE T,[XWD 77777,-1] ;EXCEPT FOR HIGH CODE BITS
POPJ P, ;ASSUME NON-LOADED LOCAL
HRRI V,2(B) ;GET LOCATION
SUBI V,(X) ;SO WE CAN USE @X
JRST FIXW1
FIXW: IFN REENT,<HRRZ T,V
CAMGE T,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
IFN L,< HRRZ T,V
CAMGE R,RINITL
POPJ P,>
FIXW1: TLNE V,200000 ;IS IT LEFT HALF
JRST FIXWL
IFN MONLOD,<TLNN V,100000 ;SKIP IF USING @X TO FIX SYMBOL TABLE
PUSHJ P,DICHK ;MAKE SURE ADDRESS IN V IS IN CORE>
MOVE T,@X ;GET WORD
ADD T,W ;VALUE OF GLOBAL
HRRM T,@X ;FIX WITHOUT CARRY
IFN MONLOD,<TLNN V,100000 ;SKIP IF JUST FIXED SYMBOL TABLE
TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
MOVSI D,200000 ;SET UP TO REMOVE DEFERED INTERNAL IF THERE
JRST SYMFIX
FIXWL: HRLZ T,W ;UPDATE VALUE OF LEFT HALF
IFN MONLOD,<TLNN V,100000 ;SKIP IF USING @X TO FIX SYMBOL TABLE
PUSHJ P,DICHK ;MAKE SURE ADDRESS IN V IS IN CORE>
ADDM T,@X ;BY VALUE OF GLOBAL
IFN MONLOD,<TLNN V,100000 ;SKIP IF JUST FIXED SYMBOL TABLE
TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
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
SYMFX1: 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 B11SW,<
TLNE V,40000 ;CHECK FOR POLISH
JRST POLSAT>
TLNN V,100000 ;SYMBOL TABLE?
JRST SYM2WA
ADD V,HISTRT ;MAKE ABSOLUTE
SUBI V,(X) ;GET READY TO ADD X
PUSHJ P,FIXW1
JRST SYM2W1
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,>
IFN REENT,<CAMGE V,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK ;MAKE SURE ADDRESS IN V IS IN CORE>
HRRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN
HRRM W,@X ;INSERT VALUE INTO PROGRAM
IFN MONLOD,<TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
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,(H); ANY ROOM LEFT?
IFN EXPAND,< JRST [PUSHJ P,XPAND>
TLOA F,FULLSW
IFN EXPAND,< JRST MVDWN
POPJ P,]>
TLNE F,SKIPSW+FULLSW
POPJ P, ; 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)
POPJ P,
>
REMSYM: MOVE T,1(S)
MOVEM T,1(A)
MOVE T,2(S)
MOVEM T,2(A)
CAIN S,A ;MOVING TO SELF?
JRST REMSY1 ;YES, DON'T CLEAR
SETZM 1(S) ;CLEAR NAME
SETZM 2(S) ;CLEAR POINTER
REMSY1: ADD S,SE3
POPJ P,
SUBTTL HIGH-SEGMENT (BLOCK TYPE 3)
;THIS PROGRAM IS INTENDED FOR HI SEGMENT IF RUNNING ON A PDP-10.
; THIS BLOCK TYPE OCCURS AFTER ENTRY AND NAME BLOCKS.
HISEG: HRRZ C,W ;GET WORD COUNT
PUSHJ P,WORD ;GOBBLE UP BYTE WORD.
PUSHJ P,WORD ;GET THE HIGH SEG OFSET
SOJE C,.+4 ;FINISHED IF NOT FORTRAN-10
MOVE C,W ;SAVE HIGH INFO
PUSHJ P,WORD ;GET LOW BREAK
EXCH W,C ;SWAP BACK
IFE REENT,<HISEG2==LOAD1A
JUMPGE W,LOAD1A ;NOT TWO SEG PROG.>
IFN REENT,<JUMPE W,HISEG2 ;IGNORE ZERO
IFE TENEX,<JUMPG W,HISEG3 ;NEG. IF TWOSEG PSEUDO-OP>
IFN TENEX,<TLNN W,-1
JRST HISEG3>
>;END OF IFN REENT
TRO F,TWOFL ;SET FLAG
IFN REENT,<
TRNE F,NOHI!NOHI6 ;TWO SEGMENTS LEGAL?
JRST ONESEG ;LOAD AS ONE SEGMENT
HISEG3: HRRZ D,W ;GET START OF HISEG
JUMPE D,.+2 ;NOT SPECIFIED
PUSHJ P,HCONT ;AS IF /H
HISEG2: PUSHJ P,HISEG1
JRST LOAD1 ;GET NEXT BLOCK
FAKEHI: ;AS IF BLOCK TYPE 3
HISEG1: TRNE F,NOHI!NOHI6 ;LOAD REENT?
POPJ P,
TLOE F,HIPROG ;LOADING HI PROG
POPJ P, ;IGNORE 2'ND HISEG
TRON F,SEENHI ;HAVE WE LOADED ANY OTHER HI STUFF?
PUSHJ P,SETUPH ;NO,SET UP HI SEG.
MOVEM R,LOWR
MOVE R,HIGHR
MOVE X,NAMPTR ;GET THE POINTER TO PROGRAM NAME
HRRM R,2(X) ;CALL THIS THE START OF THE PROGRAM
MOVE X,HIGHX
POPJ P,
SETUPH: MOVE X,HVAL1
CAIGE X,-1 ;SEE IF IT HAS BEEN CHANGED FROM ORIG
JRST SEENHS ;YES, MUST HAVE SEEN /H
MOVEI X,400000
MOVEM X,HVAL1
CAIG X,(H) ;HAVE WE RUN OVER WITH THE LOW SEG
JRST COROVL
ADDI X,.JBHDA
HRLI X,W
MOVEM X,HVAL
SEENHS: MOVE X,HVAL
MOVEM X,HIGHR
HRRZ X,.JBREL
SUB X,HVAL1
ADDI X,1
HRLI X,V
MOVEM X,HIGHX
POPJ P,
SETSEG: TRZ F,NOHI!SEGFL ;ALLOW HI-SEG
JUMPL D,.+2 ;/-H TURNS OFF NOHI ONLY
TRO F,SEGFL ;/1H FORCES HI
POPJ P,
>
ONESEG: HLRZ D,W ;GET LENGTH OF HISEG
SUBI D,(W) ;REMOVE OFSET
JUMPLE D,ONELOW ;LENGTH NOT AVAILABLE
MOVEM R,LOWR ;SAVE LOW SEGMENT RELOCATION
ADDM D,LOWR ;ADD TO LOW SEG RELOCATION
HRRZM W,HVAL1 ;SO RELOC WILL WORK
JRST LOAD1 ;GET NEXT BLOCK
ONELOW: HLRZ D,C ;TRY LOW SEG BREAK
SUBI D,(C)
JUMPLE D,TWOERR ;NOT AVAILABLE
MOVEM R,LOWR ;SAVE CURRENT BREAK
ADD R,D ;ADD LOW LENGTH
HRRZM W,HVAL1 ;SO RELOC WILL WORK
JRST LOAD1
TWOERR: ERROR 7,</TWO SEGMENTS ILLEGAL#/>
JRST LDRSTR
SUBTTL HIGHEST RELOCATABLE POINT (BLOCK TYPE 5)
HIGH0: CAIE A,4 ; TEST FOR END BLOCK (OVERLAP)
JRST LIB30
HIGH: TRNN F,TWOFL ;IS THIS A TWO SEGMENT PROGRAM?
JRST HIGH2A ;NO
HIGH2: PUSHJ P,RWORD ;GET HISEG BREAK
TRZ F,TWOFL ;CLEAR FLAG NOW
IFE REENT,<MOVE R,LOWR
JRST HIGH2A>
IFN REENT,<TRNE F,NOHI!NOHI6 ;SINGLE SEGMENT LOAD?
JRST [MOVE R,LOWR ;YES,GET LARGER RELOC
CAILE W,(R) ;IF FORTRAN-10
SKIPA C,W ;HISEG CODE IS ON TOP
SETZ C, ;OTHERWISE ZERO ABS VALUE
MOVE W,HVAL ;ORIGINAL VALUE
MOVEM W,HVAL1 ;RESET
PUSHJ P,RWORD ;GET LOW SEG BREAK IN W
CAMGE C,W ;PUT LARGER VALUE
MOVE C,W ;IN C
JRST HIGH2B] ;CONTINUE AS IF LOW ONLY
HRR R,W ;PUT BREAK IN R
CAMLE R,HVAL
MOVEM R,HVAL
MOVEM R,HIGHR
MOVE R,LOWR ;NEXT WORD IS LOW SEG BREAK
TLZ F,HIPROG ;CLEAR HIPROG
PUSHJ P,PRWORD ;GET WORD PAIR
HRR R,C ;GET LOW SEG BREAK
MOVEM R,LOWR ;SAVE IT
MOVE R,HIGHR ;GET HIGH BREAK
JRST HIGHN3 ;AND JOIN COMMON CODE>
HIGH2A: PUSHJ P,PRWORD ;READ TWO DATA WORDS.
HIGH2B: IFN REENT,<
TLZE F,HIPROG
JRST HIGHNP>
IFN WFWSW,<ADD C,VARLNG ;IF LOW SEG THEN VARIABLES GO AT END>
IFN ALGSW,<ADD C,OWNLNG ;ADD IN LENGTH OF OWN BLOCK>
IFN COBSW,<ADD C,LOD37. ;ADD IN LOCAL SYMBOLS
SKIPE LOD37. ;BUT WERE THERE ANY?
SUBI C,3 ;YES SO REMOVE THE 3 WORDS OVERWRITTEN>
IFE TENEX,<CAMGE C,W ;CHECK 2ND WORD (LOC PROG BRK IF PRESENT)
MOVE C,W>
HRR R,C ;SET NEW PROGRAM BREAK
HIGH31: MOVEM R,LOWR ;SAVE NEW VALUE OF R
IFN MONLOD,<TLNN N,DISW ;SKIP IF LOADING TO DISK>
ADDI C,(X)
CAIG H,(C)
MOVEI H,(C) ;SET UP H
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
JRST HIGH3 ;YES, DON'T WORRY ABOUT EXCEEDING CORE>
CAILE H,1(S) ;TEST PROGRAM BREAK
IFN EXPAND,<PUSHJ P,[ PUSHJ P,XPAND
POPJ P,
JRST POPJM2]>
IFE EXPAND,<TLO F,FULLSW>
HIGH3: MOVEI A,F.C
BLT A,B.C
IFN REENT,<TRNE F,NOHI!NOHI6 ;ONE SEGMENT PROGRAM?
JRST HIGHN4 ;YES
HRRZ W,LOWR ;GET LOW PROG BREAK
HRL W,HIGHR ;GET HIGH PROG BREAK
SETZ C, ;ZERO SYMBOL NAME
PUSHJ P,SYM1B ;PUT IN SYMBOL TABLE
MOVEM S,F.C+S ;SAVE NEW S AND B
MOVEM B,F.C+B ;INCASE OF ERROR
HIGHN4:>
TRZE N,F10TFL ;FORTRAN-10 SET NOHI?
TRZ F,NOHI ;YES, CLEAR IT
SETZM SBRNAM ;RELAX, RELOCATION BLOCK FOUND
TLNE F,SLIBSW+LIBSW ;NORMAL MODE EXIT THROUGH LOAD1
JRST LIB ;LIBRARY SEARCH EXIT
JRST LOAD1
IFN REENT,<
HIGHNP: HRR R,C
CAMG W,HVAL1 ;ABS. ADDRESS IN HIGH SEGMENT?
JRST HIGHN1 ;NO
CAIG C,(W) ;YES, GREATER THAN CURRENT HISEG RELOC?
HRR R,W ;YES, USE IT
SETZ W, ;DON'T USE IT AGAIN
HIGHN1: CAMLE R,HVAL
MOVEM R,HVAL
MOVEM R,HIGHR
HIGHN3: PUSH P,W ;SAVE W,CONTAIN HIGHEST ABSOLUTE ADDRESS
ADD W,LOWX ;LOC PROG BRK
CAIGE H,(W) ;CHECK FOR TOP OF LOW CORE
MOVEI H,(W)
POP P,W ;RESTORE
CAML H,HVAL1
JRST COROVL ;OVERFLOW OF LOW SEGMENT
HIGHN2: HRRZ R,HVAL
SUB R,HVAL1
ADD R,HISTRT
CAMLE R,.JBREL
JRST [PUSHJ P,HIEXP
JRST FULLC
JRST HIGHN2]
MOVE R,LOWR
MOVE X,LOWX
IFN WFWSW,<ADD R,VARLNG ;VARIABLES IN LOW SEG>
IFN ALGSW,<ADD R,OWNLNG ;OWN BLOCK IN LOW SEGMENT>
IFN COBSW,<ADD R,LOD37. ;ADD IN LOCAL SYMBOLS
SKIPE LOD37. ;BUT WERE THERE ANY?
SUBI R,3 ;YES SO REMOVE THE 3 WORDS OVERWRITTEN>
HRRZ C,R
CAIGE C,(W) ;IS ABSOLUTE LOCATION GREATER
HRR R,W ;YES USE IT
HRRZ C,R ;SET UP C AGAIN
JRST HIGH31 ;GO CHECK PROGRAM BREAK
>
SFULLC: TROE F,SFULSW ;PREVIOUS OVERFLOW?
JRST FULLC ;YES, DON'T PRINT MESSAGE
ERROR ,<?SYMBOL TABLE OVERLAP#?>
FULLC:
IFE K,< TLNE N,F4SW
POPJ P,>
JRST LIB3 ;LOOK FOR MORE
SUBTTL EXPAND HIGH SEGMENT
IFN REENT,<
HIEXP: TLNE F,FULLSW
POPJ P,
IFN EXPAND,<PUSH P,Q>
PUSH P,H
PUSH P,X
PUSH P,N
IFE K,<HRRZ X,MLTP
TLNN N,F4SW>
MOVEI X,1(S)
HRRZ N,X
SUB N,H
CAILE N,1777
JRST MOVHI
IFE EXPAND,<POPJ P,>
IFN EXPAND,<HRRZ N,.JBREL
ADDI N,2000
CAMG N,ALWCOR
CORE N,
JRST XPAND6
POP P,N
JRST XPAND3>
MOVHI: MOVEI N,-2000(X)
HRL N,X
HRRZ X,.JBREL
BLT N,-2000(X)
MOVNI H,2000
IFN EXPAND,<JRST XPAND8>
IFE EXPAND,<ADDM H,HISTRT
ADDM H,S
ADDM H,B
ADDM H,HIGHX
TLNE F,HIPROG
ADDM H,-1(P)
POP P,N
ADDM H,NAMPTR ;ADJUST POINTER TO NAME
IFE K,< TLNN F4SW
JRST HIXP1
ADDM H,PLTP
ADDM H,BITP
ADDM H,SDSTP
ADDM H,MLTP
TLNE N,SYDAT
ADDM H,V
HIXP1:>
POP P,X
POP P,H
AOS (P)
POPJ P,>
>
SUBTTL PROGRAM NAME (BLOCK TYPE 6)
NAME: SKIPE SBRNAM ;HAVE WE SEEN TWO IN A ROW?
JRST NAMERR ;YES, NO END BLOCK SEEN
NAME0: PUSHJ P,PRWORD ;READ TWO DATA WORDS
MOVEM C,SBRNAM ;SAVE SUBROUTINE NAME
IFN MANTIS,<CAMN C,[RADIX50 0,MANTIS]
CAME R,[W,,.JBDA] ;YES, BUT IS IT TO LOAD AT 140?
CAIA ;NO, NOT A DEBUG /MANTIS COMMAND
TRO N,MANTFL ;HAVE SEEN MANTIS NOW>
NCONT: HLRZ V,W ;GET COMPILER TYPE
ANDI V,7777 ;BITS 6-17
CAILE V,CMPLEN ;ONLY IF LEGAL TYPE
SETZ V, ;MAKE DEFAULT
HLL V,W ;GET CPU TYPE ALSO
TLZ V,7777 ;BITS 0-5
HRRZS W ;CLEAR TYPE
XCT CMPLER(V) ;DO SPECIAL FUNCTION
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: IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
PUSHJ P,SIZCHK ;YES, CHECK FOR OVERLAP>
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)
EXCH N,NAMPTR ;GET NAME POINTER, SAVE N
HRRZ V,N ;POINTER TO PREVIOUS NAME
SUBM B,V ;COMPUTE RELATIVE POSITIONS
HRLM V,2(N) ;STORE FORWARD POINTER
HRRZ N,B ;UPDATE NAME POINTER
EXCH N,NAMPTR ;SWAP BACK
NAME2: MOVEM C,1(B) ;STORE PROGRAM NAME
HRRZM R,2(B) ;STORE PROGRAM ORIGIN
IFN SYMDSW,<PUSH P,W ;SAVE W
HRRZ W,R ;ORIGIN
PUSHJ P,SYM1X ;PUT IN DSK FILE ALSO
POP P,W>
CAMG W,COMSAV ;CHECK COMMON SIZE
IFE REENT,<JRST LIB3 ;COMMON OK>
IFN REENT,<JRST [TRNE F,SEGFL ;LOAD LOW IN HI-SEG
PUSHJ P,FAKEHI ;YES
JRST LIB3]>
SKIPA C,COMM
ILC: MOVE C,1(A) ;NAME
PUSH P,C ;SAVE COMMON NAME
ERROR ,</ILL. COMMON !/>
POP P,C
PUSHJ P,PRNAME
ILC1: SKIPN SBRNAM
JRST ILC2
ERROR 0,</ PROG. !/>
MOVE C,SBRNAM ;RECOVER SUBROUTINE NAME
PUSHJ P,PRNAME
ILC2: ERROR 0,</ #/>
JRST LD2
NAMERR: TLNE F,FULLSW ;IF NOT ENUF CORE
JRST NAME0 ;END BLOCK IS NEVER SEEN
SETZM DTIN ;CLEAR WRONG FILE NAME FOR MESSAGE
ERROR ,</NO END BLOCK !/>
JRST ILC1
;COMPILER TYPE - DO SPECIAL FUNCTION FOR IT
CMPLER:
JFCL ; 0 UNKNOWN
PUSHJ P,F40NAM ; 1 FORTRAN (F40)
TRO N,COBFL!VFLG ; 2 COBOL
PUSHJ P,ALGNAM ; 3 ALGOL-60
TRO N,NELFL ; 4 NELIAC
TRO N,PL1FL ; 5 PL/1
TRO N,BLIFL ; 6 BLISS-10
TRO N,SAIFL ; 7 SAIL
PUSHJ P,FORNAM ;10 FORTRAN-10
;11 MACRO
;12 FAIL
CMPLEN==.-CMPLER
F40NAM: TRNE N,FORFL ;CANNOT MIX OLD & NEW
JRST F40ERR
TRO N,F4FL!VFLG ;SET FLAGS
IFE ALGSW,<ALGNAM:;PUT LABEL ON A POPJ>
POPJ P,
FORNAM: TRNE N,F4FL ;CANNOT MIX OLD & NEW
JRST F40ERR
TRO N,FORFL!VFLG
IFN FORSW,<SKIPG FORLIB ;IF NOT SET FOR FOROTS
AOS FORLIB ;DO SO>
HLLZ V,V ;SEE IF ANY CPU BITS
ROT V,6 ;PUT IN BITS 30-35
CAILE V,2 ;ONLY 0, 1, 2 VALID
SETZ V, ;DEFAULT
PUSHJ P,@[EXP CPOPJ,FORNMA,FORNMI](V)
SKIPL VSW ;USER DOES N'T WANT REENT OTS?
TRNE F,NOHI!SEGFL!SEENHI ;USER SET SEGMENT OR HI CODE SEEN?
POPJ P, ;YES
TRO F,NOHI ;DEFAULT IS ONE SEG
TRO N,F10TFL ;BUT ONLY FOR THIS FILE
HRRZM F,FORLIB ;SET FOROTS BY DEFAULT (FORLIB .GT. 0)
POPJ P,
FORNMI: TRNE N,KA10FL ;CANNOT MIX KA & KI
JRST FORERR
TRO N,KI10FL ;SET FLAGS
POPJ P,
FORNMA: TRNE N,KA10FL ;CANNOT MIX KA & KI
JRST FORERR
TLO N,KA10FL
POPJ P,
F40ERR: ERROR ,</CANNOT MIX F40 AND FORTRAN-10 COMPILED CODE@/>
FORERR: ERROR ,</CANNOT MIX KA10 AND KI10 FORTRAN-10 COMPILED CODE@/>
IFN ALGSW,<
ALGNAM: TRO N,ALGFL!VFLG ;SET ALGOL SEEN, AND DEFAULT REENT OPSYS
JUMPE W,CPOPJ ;NOT ALGOL MAIN PROGRAM
IFN NAMESW,<
PUSH P,C ;SAVE NAME
MOVE W,C ;EXPECTS NAME IN W
PUSHJ P,LDNAM ;USE THIS A PROGRAM NAME
POP P,C ;RESTORE C>
SETZ W, ;CLEAR COMMON SIZE, ONLY A MARKER
POPJ P, ;RETURN
>
SUBTTL STARTING ADDRESS (BLOCK TYPE 7)
START: PUSHJ P,PRWORD ;READ TWO DATA WORDS
TLNN N,ISAFLG ;SKIP IF IGNORE SA FLAG ON
HRRZM C,STADDR ;SET STARTING ADDRESS
IFN NAMESW,<
MOVE W,DTIN ;PICK UP BINARY FILE NAME
TLNN N,ISAFLG
MOVEM W,PRGNAM ;SAVE IT
MOVE W,NAMPTR ;GET NAME POINTER
MOVE W,1(W) ;SET UP NAME OF THIS PROGRAM
IFE ALGSW,<TLNN N,ISAFLG ;DONT SET NAME IF IGNORING SA'S>
IFN ALGSW,<TDNN N,[ISAFLG,,ALGFL] ;OR ALGOL LOADING>
PUSHJ P,LDNAM>
PUSHJ P,PRWORD ;**OBSCURE RETURN TO LOAD1**
IFN REENT,<
RESTRX: TLNE F,HIPROG
SKIPA X,HIGHX
MOVE X,LOWX
POPJ P,>
SUBTTL ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)
;PMP PATCH FOR LEFT HALF FIXUPS
IFN FAILSW!B11SW!WFWSW,<
LOCDLH: IFN L,<CAMGE V,RINITL
POPJ P,>
IFN REENT,<CAMGE V,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK>
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,>
IFN FAILSW,<
LOCDLI: PUSHJ P,LOCDLF
IFN REENT,<PUSHJ P,RESTRX>
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
IFN REENT,<PUSHJ P,RESTRX>
JRST LOCD
SUBTTL LVAR FIX-UP (BLOCK TYPE 13)
IFN WFWSW,<
LVARB: PUSHJ P,PRWORD ;THE FIRST TWO WORDS IN THE BLOCK
MOVEM W,VARLNG ;AR SPECIAL. SECOND IS LENGTH OF VARIABLES
IFN REENT,< TLNE F,HIPROG
MOVE C,LOWR ;USE LOW RELOC IF LOADING HI SEG>
;ELSE C HAS RELOC FOR THIS PROGRAM, USE IT
HRRZM C,VARREL ;THIS IS LOCATION 0 OF VARIABLE AREA
LVLP: PUSHJ P,PRWORD ;THINGS COME IN PAIRS
TLNE C,200000 ;BIT ON IF SYMBOL TABLE FIXUP
JRST LVSYM
HLRZ V,W ;NO GET LOC FROM LEFTH HALF OF SECOND
ADD W,VARREL ;AND RELOCATE VARIABLE
TLNE C,400000 ;ON FOR LEFT HALF
JRST [PUSHJ P,LOCDLF ;TAKE CARE OF IT
IFN REENT,< JRST LVLCOM] ;RESET X>
IFE REENT,< JRST LVLP] ;MUST BE LOW SEG X OK>
PUSHJ P,SYM4A ;RIGHT HALF CHAIN
IFN REENT,<LVLCOM: PUSHJ P,RESTRX>
JRST LVLP
LVSYM: MOVE V,B ;GET SYMBOL TABLE POINTER
ADD C,VARREL ;VALUE IS IN FIRST WORD FOR THESE
TLZ W,740000 ;MAKE SURE NO BITS ON
ADDI V,2 ;CORRECT POINTER TO SYMBOL TABLE
SRSYM: MOVE A,-1(V) ;GET A NAME
TLZN A,740000 ;CHECK FOR PROGRAM NAME
JRST LVLP ;LEAVE (PROBABLY A NON-LOADED LOCAL)
CAMN A,W ;IS IT THE RIGHT ONE??
JRST LVSYMD ;YES
ADD V,SE3 ;CHECK NEXT ONE
JUMPL V,SRSYM ;BUT ONLY IF SOME ARE THERE
JRST LVLP ;GIVE UP
LVSYMD: TLNE C,400000 ;WHICH HALF??
JRST LVSYML ;LEFT
ADD C,(V) ;ADDITIVE FIXUP
HRRM C,(V)
MOVSI D,200000 ;DEFERED BITS
LVSM1: PUSHJ P,COMSFX ;GO TAKE CARE OF IT
JRST LVLP ;NEXT PLEASE
LVSYML: HRLZS C
ADDM C,(V) ;WE DON'T HAVE TO WORRY ABOUT OVERFLOW HERE
MOVSI D,400000 ;LEFT DEFERED BITS
JRST LVSM1 ;GO WORRY ABOUT DEFERED INTERNALS>
SUBTTL FAIL LOADER
;ONLY LIST IF POLISH FIXUPS REQUIRED
XLIST
IFN FAILSW!B11SW,<LIST>
REPEAT 0,<IF POLISH FIXUPS CONTAIN GLOBAL REQUESTS WHICH
CAN NOT BE SATISFIED WHEN THEY ARE SEEN, THEY MUST BE
SAVED UNTIL THESE GLOBAL SYMBOLS BECOME DEFINED.
THE POLISH FIXUP IS SAVED IN THE UNDEFINED TABLE (POINTED
TO BY S). THE FIXUP IS SAVED IN TWO WORD BLOCKS THE FIRST
WORD OF WHICH (THE ONE WHICH WOULD NORMALL CONTAIN THE SYMBOL)
HAS SPECIAL BITS ON SO IT WILL NOT BE FOUND BY A SEARCH FOR
A GLOBAL REQUEST. SINCE THE UNDEFINED TABLE MAY BE
SHUFFELED INTO A RANDOM ORDER, IT IS NOT POSSIBLE TO KEEP
ALL OF A POLISH FIXUP TOGETHER OR TO HAVE POINTERS IN
THE USUAL SENCE FROM ONE TWO WORD BLOCK TO ANOTHER.
SUFFICIENT INFORMATION IS THEREFORE GIVEN TO DETERMINE
WHAT THE FIRST WORD OF THE NEXT DESIRED BLOCK IS AND THIS
BLOCK IS FOUND BY SEARCHING THE UNDEFINED TABLE FOR A MATCH.
EACH POLISH FIXUP WHICH IS ENTERED INTO THE UNDEFINED
TABLE IS GIVEN A UNIQUE NUMBER CALLED THE "HEAD NUMBER".
EACH ELEMENT OF THE FIXUP (EITHER OPERAND OR OPERATOR)
IS ASSIGNED A NUMBER CALLED THE "OP NUMBER". THUS
THE OP NUMBER AND HEAD NUMBER TOGETHER DETERMINE
A SPECIFIC ELEMENT OF A SPECIFIC FIXUP. EACH ELEMENT
(TWO WORD BLOCK) IS ARRANGED AS FOLLOWS:
WORD 1:
BITS 0-4 THESE ARE THE USUAL CODE BITS OF A RADIX50
SYMBOL AND CONTAIN 44 TO DISTINGUISH
AN ELEMENT OF A POLISH FIXUP FROM OTHER
SYMBOLS IN THE UNDEFINED TABLE
BITS 5-17 THE HEAD NUMBER OF THIS FIXUP
BITS 18-30 THE OP NUMBER OF THIS ELEMENT
BITS 31-35 THE OPERAND FOR THIS ELEMENT
OPERAND 2 INDICATES A WORD OF DATA
WORD 2:
IF THE OPERAND IS 2 THIS WORD CONTAINS THE DATA
IF THIS IS NOT A DATA OPERATOR THEN THE LEFT AND
RIGHT HALVES OF THIS WORD POINT TO THE TWO OPERANDS
THE CONTENTS OF THE HALF WORD IS THE RIGHT HALF
OF THE FIRST WORD OF THE BLOCK POINTED
TO. THUS THE LEFT HALF OF THE FIRST WORD COMBINED
WITH ONE OF THESE HALF WORDS IS THE FIRST WORD
OF THE BLOCK POINTED TO AND CAN BE FOUND BY SEARCHING
EACH FIXUP ALSO HAS A HEADER BLOCK. THIS BLOCK CONTAINS THE
FOLLOWING INFORMATION:
WORD 1:
BITS 0-17 0
BITS 18-21 44
BITS 22-35 THE HEAD NUMBER OF THIS FIXUP
WORD 2:
BITS 0-17 A COUNT OF THE NUMBER OF UNDEFINED
GLOBALS REMAINING IN THIS FIXUP
BITS 18-35 A HALF WORD POINTER OF THE
SAME TYPE FOUND IN OTHER ELEMENTS POINTING
TO THE FIRST ELEMENT OF POLISH
WHICH WILL BE THE STORE OPERATOR
THE REQUESTS FOR THE GLOBAL SYMBOLS NEEDED BY THE FIXUP ARE
ENTERED AS FOLLOWS:
WORD 1:
BITS 0-4 04
BITS 5-35 RADIX 50 FOR THE NAME OF THE SYMBOL
(NOTE THIS IS JUST A STANDARD GLOBAL REQUEST)
WORD 2:
BITS 0-4 44 (THIS IDENTIFIES IT AS "ADITIVE TYPE"
AND BIT 4 INDICATES POLISH)
BITS 5-17 THE HEAD NUMBER OF THE FIXUP
(THIS GIVES ENOUGH INFORMATION TO FIND THE HEADER
BLOCK AND UPDATE THE COUNT WHEN THE REQUEST IS
SATISFIED)
BITS 18-35 A HALF WORD POINTER TO THE ELEMENT OF THE
FIXUP INTO WHICH THE VALUE OF
THE SYMBOL SHOULD BE STORED
>
IFN FAILSW!B11SW,<
;POLISH FIXUPS <BLOCK TYPE 11>
PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH?
JRST COMPOL ;YES
ERROR ,</PUSHDOWN OVERFLOW#/>
JRST LD2
COMPOL: ERROR ,</POLISH TOO COMPLEX#/>
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
IFN WFWSW,<CAIN W,15
JRST [PUSHJ P,RDHLF ;THIS TRICK FOR VARIABLES
ADD W,VARREL ;HOPE SOMEONE HAS DONE
HRRZ C,W ;A BLOCK TYPE 13
JRST HLFOP]>
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,5 ;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,5 ;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,5
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,5 ;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
CAIGE A,-3
PUSHJ P,FSYMT
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+6(A) ;CALL THE CORRECT FIXUP ROUTINE
COMSTR: SETZM POLSW ;ALL DONE WITH POLISH
IFN REENT,<PUSHJ P,RESTRX>
MOVE T,OPNUM ;CHECK ON SIZES
MOVE V,HEADNM
CAIG V,477777
CAILE T,17777
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 ALSYM,LFSYM,RHSYM,ALSTR,LOCDLF,SYM4A,FAKESY
GLSTR: MOVE A,W
CAIGE A,-3
PUSHJ P,FSYMT
PUSHJ P,RDHLF ;GET THE STORE LOCATION
MOVEI A,23(A)
POP D,V ;GET VALUE
POP D,V
HRLM V,W ;SET UP STORAGE ELEMENT
AOS C,OPNUM
LSH C,5
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,>
IFN REENT,<CAMGE V,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK>
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 7,<JRST STRSAT>
FSYMT: PUSHJ P,RDHLF ;FIRST HALF OF SYMBOL
HRL V,W
PUSHJ P,RDHLF
HRR V,W
PUSH D,A ;SAVE STORE TYPE
PUSHJ P,RDHLF ;GET BLOCK NAME
HRL C,W
PUSHJ P,RDHLF
HRR C,W
TLO C,140000 ;MAKE BLOCK NAME
PUSHJ P,SDEF ;FIND IT
CAMN A,B
JRST FNOLOC ;MUST NOT BE LOADING LOCALS
FSLP: LDB C,[POINT 32,-1(A),35] ;GET NAME
CAMN C,V
JRST FNDSYM
SUB A,SE3
CAME A,B ;ALL DONE?
JRST FSLP ;NO
FNOLOC: POP D,A
MOVEI A,0 ;SET FOR A FAKE FIXUP
AOS (P)
POPJ P,
FNDSYM: MOVEI W,(A) ;LOC OF SYMBOL
SUB W,HISTRT
POP D,A
AOS (P)
POPJ P,
LFSYM: ADD V,HISTRT
HRLM W,(V)
MOVSI D,400000 ;LEFT HALF
JRST COMSFX
RHSYM: ADD V,HISTRT
HRRM W,(V)
MOVSI D,200000
JRST COMSFX
FAKESY: POPJ P, ;IGNORE
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,37 ;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,37 ;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
IFN FAILSW,<
;BLOCK TYPE 12 LINK
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
IFN REENT,<
CAMGE V,HVAL1 ;CHECK HISEG ADDRESS
SKIPA X,LOWX ;LOW SEGMENT
MOVE X,HIGHX ;HIGH SEGMENT BASE
>;IF REENT
IFN MONLOD,<PUSHJ P,DICHK>
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
IFN REENT,<
PUSHJ P,RESTRX ;RESTORE X
>;IF REENT
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
> ;END OF IFN FAILSW
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)
IFN REENT,<PUSHJ P,RESTRX>
POP P,W ;RESTORE THINGS
POP P,C
JRST SYM2W1
ALSYM: ADD V,HISTRT
MOVEM W,(V)
MOVSI D,600000
>
LIST ;END OF FAILSW CODE
IFN FAILSW!B11SW!WFWSW,<
COMSFX: IFN REENT,<PUSHJ P,SYMFX1
JRST RESTRX>
IFE REENT,<JRST SYMFX1>>
SUBTTL LIBRARY INDEX (BLOCK TYPE 14)
COMMENT * DIRECT ACCESS LIBRARY SEARCH MODE
INDEX WRITTEN BY FUDGE2.SEE DIDAL DOC (100-540-001-00)
DESIGN AND CODING BY D.M.NIXON JUL-AUG 1970
*
IFN DIDAL,<
INDEX8: POP P,LSTBLK ;SET UP LSTBLK FOR NEXT PROG
PUSHJ P,WORD ;READ FIRST WORD
HLRZ A,W ;BLOCK TYPE ONLY
CAIE A,14 ;IS IT AN INDEX?
JRST INDEXE ;NO, ERROR
JRST INDEX9 ;DON'T SET FLAG AGAIN
INDEX0: TRO F,XFLG ;SIGNAL INDEX IN CORE
MOVEI A,1 ;START ON BLOCK 1 (DSK)
HRROM A,LSTBLK ;BUT INDICATE AN INDEX
MOVE A,ILD1 ;INPUT DEVICE
DEVCHR A,
TLNE A,DTABIT ;IS IT A DTA?
TRO F,DTAFLG ;YES
INDEX9: MOVEI A,AUX+2 ;AUX BUFFER
HRLI A,4400 ;MAKE BYTE POINTER
MOVEM A,ABUF1 ;AND SAVE IT
HRL A,BUFR1 ;INPUT BUFFER
BLT A,AUX+201 ;STORE BLOCK
TRO F,LSTLOD ;AND FAKE LAST PROG READ
INDEX1: ILDB T,ABUF1
JUMPL T,INDEX3 ;END OF BLOCK IF NEGATIVE
HRRZS T ;WORD COUNT ONLY
INDEX2: ILDB C,ABUF1 ;GET NEXT SYMBOL
TLO C,040000 ;
PUSHJ P,SREQ ;SEARCH FOR IT
SOJA T,INDEX4 ;REQUEST MATCHES
SOJG T,INDEX2 ;KEEP TRYING
ILDB T,ABUF1 ;GET POINTER WORD
TRZN F,LSTLOD ;WAS LAST PROG LOADED?
JRST INDEX1 ;NO
TRNN F,DTAFLG ;ALWAYS SAVE IF DTA???
SKIPL LSTBLK ;SKIP IF LAST BLOCK WAS AN INDEX
MOVEM T,LSTBLK ;SAVE POINTER FOR CALCULATIONS
JRST INDEX1 ;GET NEXT PROG
INDEX4: ADDM T,ABUF1
ILDB A,ABUF1
PUSH P,A ;SAVE THIS BLOCK
TROE F,LSTLOD ;DID WE LOAD LAST PROG?
JRST [SKIPGE LSTBLK ;WAS LAST BLOCK AN INDEX?
JRST NXTBLK ;YES, SO GET NEXT ONE
MOVEM A,LSTBLK
JRST LOAD1] ;NEXT PROG IS ADJACENT
HRRZ T,LSTBLK ;GET LAST BLOCK NUMBER
CAIN T,(A) ;IN THIS BLOCK?
JRST THSBLK ;YES
NXTNDX: TRNE F,DTAFLG ;DIFFERENT TEST FOR DTA
JRST NXTDTA ;CHECK IF NEXT BUFFER IN CORE
CAIN T,-1(A) ;NEXT BLOCK?
JRST NXTBLK ;YES,JUST DO INPUT
INDEX5: USETI 1,(A) ;SET ON BLOCK
WAIT 1, ;LET I/O FINISH
MOVSI C,(1B0) ;CLEAR RING USE BIT IF ON
HRRZ T,BUFR
IORM C,BUFR ;SET UNUSED RING BIT (HELP OUT MONITOR)
SKIPL (T)
JRST NXTBLK ;ALL DONE NOW
ANDCAM C,(T) ;CLEAR USE BIT
HRRZ T,(T) ;GET NEXT BUFFER
JRST .-4 ;LOOP
NXTDTA: WAIT 1, ;LET I/O RUN TO COMPLETION
HRRZ T,BUFR ;GET POINTER TO CURRENT BUFFER
HLRZ T,1(T) ;FIRST DATA WORD IS LINK
CAIE T,(A) ;IS IT BLOCK WE WANT?
JRST INDEX5 ;NO
NXTBLK: IN 1,
JRST NEWBLK ;IT IS NOW
JRST WORD3 ;EOF OR ERROR
NEWBLK: MOVE A,(P) ;GET CURRENT BLOCK
JUMPL A,INDEX8 ;JUST READ AN INDEX
HLRZS A ;GET WORD COUNT
JRST INDEX6 ;WORD COUNT WILL BE CORRECT
THSBLK: SUB A,LSTBLK ;GET WORD DIFFERENCE
MOVSS A ;INTO RIGHT HALF
INDEX6: ADDM A,BUFR1
MOVNS A
ADDM A,BUFR2
INDEX7: POP P,LSTBLK ;STORE THIS AS LAST BLOCK READ
JRST LOAD1
INDEX3: HRRE A,T ;GET BLOCK # OF NEXT INDEX
JUMPL A,EOF ;FINISHED IF -1
PUSH P,T ;STACK THIS BLOCK
HRRZ T,LSTBLK ;GET LAST BLOCK
JRST NXTNDX ;CHECK IF NEXT BUFFER IN CORE
INDEX: PUSHJ P,WORD2 ;READ FIRST WORD OF NEXT BUFFER
INDEXE: TRZE F,XFLG ;INDEX IN CORE?
TTCALL 3,[ASCIZ /LIBRARY INDEX INCONSISTENT - CONTINUING
/] ;WARNING MESSAGE
JRST LOAD1A+1 ;AND CONTINUE
>
IFE DIDAL,<INDEX0:
INDEX: PUSHJ P,WORD2 ;READ FIRST WORD OF NEXT BUFFER
JRST LOAD1A+1>
SUBTTL ALGOL OWN BLOCK (TYPE 15)
IFN ALGSW,<
ALGBLK: SKIPE OWNLNG ;FIRST TIME THIS PROG?
JRST ALGB1 ;NO, JUST CHAINED SYMBOL INFO
PUSHJ P,RWORD ;READ 3RD WORD
IFN REENT,<TLNE F,HIPROG ;LOADING INTO HIGH SEGMENT?
EXCH X,LOWX ;YES, BUT OWN AREAS ARE IN LOW SEG>
HLRZ V,W ;GET START OF OWN BLOCK
IFN REENT,<TLNE F,HIPROG ;LOADING INTO HIGH SEGMENT?
HRRZ V,LOWR ;YES, BUT PUT OWN AREAS IN LOW SEG>
MOVEI C,(W) ;GET LENGTH OF OWN BLOCK
MOVEM C,OWNLNG ;SAVE IT TO FIX RELOC AT END
PUSHJ P,ALGB2 ;FIX AND CHECK PROG BREAK
MOVEI W,(V) ;GET CURRENT OWN ADDRESS
EXCH W,%OWN ;SAVE FOR NEXT TIME
MOVEM W,@X ;STORE LAST OWN ADDRESS IN LEFT HALF
HRLM C,@X ;LENGTH IN LEFT HALF
IFN REENT,<TLNE F,HIPROG ;HI-SEG?
EXCH X,LOWX ;YES, RESTORE X TO POINT TO HIGH SEG>
ALGB1: PUSHJ P,RWORD ;GET DATA WORD
HLRZ V,W ;GET ADDRESS TO FIX UP
ADD W,%OWN ;ADD IN ADDRESS OF OWN BLOCK
PUSHJ P,SYM4A ;FIX UP CHAINED REQUEST
JRST ALGB1 ;LOOP TIL DONE
ALGB2: ADDI H,(W) ;FIX PROG BREAK
IFN REENT,<CAML H,HILOW
MOVEM H,HILOW ;HIGHEST LOW CODE LOADED>
CAILE H,1(S) ;SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
JRST FULLC
IFN EXPAND,< JRST .+1]>
POPJ P,
>
SUBTTL SAIL BLOCK TYPES 16 AND 17
COMMENT * BLOCK TYPE 16 AND 17. SIXBIT FOR FIL,PPN,DEV
IN THE BLOCK. SEARCH TABLE FOR ALREADY REQUESTED. IF NOT
ENTER REQUEST. ORIGINAL CODE BY DCS REWRITTEN BY WFW*
IFN SAILSW,<
LDPRG: MOVEI D,PRGFLS-1 ;SET UP SOMETHING WE CAN SEARCH WITH
MOVE W,PRGPNT ;AND CURRENT POINTER
PUSHJ P,LDSAV ;GO ENTER (WILL NOT RETURN IF RUNS OUT)
MOVEM D,PRGPNT
JRST LDPRG ;BACK FOR MORE
LDLIB: MOVEI D,LIBFLS-1
MOVE W,LIBPNT
PUSHJ P,LDSAV
MOVEM D,LIBPNT
JRST LDLIB ;LOOKS JUST LIKE THE LAST ONE, DOESN'T IT
LDSAV: HRLI D,-RELLEN-1 ;GET AOBJN SET UP
MOVEM W,LODPN2# ;SAV IT
PUSHJ P,PRWORD ;GET FILE,PPN
MOVE A,W ;SAVE ONE
PUSHJ P,RWORD ;AND DEVICE
FILSR: CAMN D,LODPN2
JRST FENT ;HAVE GOTTEN THERE, ENTER FILE
CAME C,PRGFIL(D) ;CHECK FOR MATCH
JRST NOMT ;NOT FILE
CAME A,PRGPPN(D)
JRST NOMT ;NO PPN
CAME W,PRGDEV(D)
NOMT: AOBJN D,FILSR ;AND NOT DEVICE SHOULD ALWAYS JUMP
MOVE D,LODPN2
POPJ P, ;JUST RETURN CURRENT POINTER
FENT: MOVE D,LODPN2 ;ENTER IT
AOBJP D,WRONG ;THAT IS IF NOT TOO MANY
MOVEM C,PRGFIL-1(D) ;HAVE ALREADY INDEXED
MOVEM A,PRGPPN-1(D) ;HENCE THE -1
MOVEM W,PRGDEV-1(D)
POPJ P,
WRONG: ERROR ,</TOO MANY DEMANDED FILES#/>
JRST LD2
>
SUBTTL COMMON ALLOCATION (BLOCK TYPE 20)
COMMENT * THIS BLOCK CONSISTS OF WORD PAIRS (SAME AS TYPE 2)
FIRST WORD IS RADIX50 04,SYMBOL
SECOND WORD IS 0,,COMMON LENGTH
COMMON NAME MUST BE GLOBAL AND UNIQUE
IF NOT ALREADY DEFINED LOADER DEFINES SYMBOL AND ALLOCATES
SPACE. IF DEFINED LOADER CHECK FOR TRYING TO INCREASE COMMON
SIZE, AND GIVES ERROR IF SO
NOTE... COMMON BLOCKS MUST COME DEFORE ANY DATA BLOCKS
IE. AFTER BLOCKS 4,6,3 BUT BEFORE 1,2,37,..5
*
IFN K,<COMML==LOAD4A>
IFE K,<
COMML: PUSHJ P,PRWORD ;GET WORD PAIR
TLO C,400000 ;TURN IT INTO 44,SYMBOL (FOR FORTRAN)
TLO N,F4SW ;INHIBITS MATCH WITH 04,SYMBOL
PUSHJ P,SDEF ;SEE IF ALREADY DEFINED
JRST COMMLD ;YES, JUST CHECK SIZE
TLZ N,F4SW ;CLEAR AGAIN
IFN REENT,<TLNN F,HIPROG ;LOADING INTO HIGH SEGMENT?
JRST .+3 ;NO
EXCH R,LOWR ;YES, BUT COMMON ALWAYS GOES TO LOW SEG
EXCH X,LOWX>
HRL W,R ;CURRENT RELOCATION
ADDI R,(W) ;BUMP RELOCATION
MOVS W,W ;LENGTH,,START
PUSH P,W ;STORE COMMON VALUE
HRRZS W ;NORMAL SYMBOL ADDRESS
TLZ C,400000 ;BACK TO 04,SYMBOL
PUSHJ P,SYM1B ;DEFINE IT
POP P,W ;RESTORE VALUE
TLO C,400000 ;AND COMMON SYMBOL
PUSHJ P,SYM1B ;AND STORE IT ALSO
IFN REENT,<TLNN F,HIPROG ;LOADING INTO HIGH SEGMENT?
JRST COMML ;NO
EXCH R,LOWR ;YES, RESTORE RELOCATION TO HIGH
EXCH X,LOWX>
JRST COMML ;GET NEXT SYMBOL
COMMLD: TLZ N,F4SW ;CLEAR AGAIN
HLRZ C,2(A) ;PICK UP DEFINITION
CAMLE W,C ;CHECK SIZE
JRST ILC ;ILLEGAL
JRST COMML ;TRY NEXT
>
SUBTTL SPARSE DATA (BLOCK TYPE 21)
COMMENT *
THIS BLOCK IS SIMILAR TO TYPE 1 DATA
THE DATA WORDS ARE
COUNT,,LOCATION
DATA WORDS (COUNT NUMBER OF TIMES)
COUNT,,LOCATION
DATA WORDS
ETC.
*
SPDATA: PUSHJ P,RWORD ;READ BLOCK ORIGIN
SKIPGE W
PUSHJ P,PROGS ;SYMBOLIC IF 36 BITS
HLRZ C,W ;GET SUB BLOCK COUNT IN C
HRRZS W ;CLEAR IT
HRRZ V,C ;AND IN V (LENGTH WE NEED)
SPDTO: ADD V,W ;COMPUTE NEW PROG. BREAK
IFN REENT,<TLNN F,HIPROG
JRST SPDTLW ;NOT HIGH SEGMENT
SPDT3: CAMGE W,HVAL1 ;CHECK TO SEE IF IN TOP SEG
JRST LOWSPD
MOVE T,.JBREL ;CHECK FOR OVERFLOW ON HIGH
CAIL T,@X
JRST SPDT2
PUSHJ P,HIEXP
JRST FULLC
JRST SPDT3>
IFN MONLOD,<TLNN N,DISW ;LOADING TO DISK?
JRST SPDTLW ;NO, GO CHECK NEW BREAK
CAMG H,V ;NEW BREAK?
MOVE H,V ;YES, UPDATE
JRST SPDT2 ;NO NEED TO CHECK FOR ROOM>
IFN REENT,<
LOWSPD: SUB V,HIGHX ;RELOC FOR PROPER
ADD V,LOWX ;LOADING OF LOW SEQMENT
SUB W,HIGHX
ADD W,LOWX
>
SPDTLW: MOVEI T,@X
CAMG H,T ;COMPARE WITH PREV. PROG. BREAK
MOVE H,T
TLNE F,FULLSW
JRST FULLC ;NO ERROR MESSAGE
IFN REENT,<CAML H,HVAL1
JRST COROVL ;WE HAVE OVERFLOWED THE LOW SEGMENT
CAMLE T,HILOW
MOVEM T,HILOW ;HIGHEST LOW CODE LOADED INTO>
CAILE H,1(S) ; SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
JRST FULLC
IFN REENT,< TLNE F,HIPROG
SUBI W,2000 ;HISEG LOADING LOW SEG>
IFN EXPAND,< JRST .-1]>
SPDT2: MOVE V,W
SPDT1: PUSHJ P,RWORD ;READ DATA WORD
IFN L,<CAML V,RINITL ;CHECK FOR BAD STORE>
IFN MONLOD,<PUSHJ P,DICHK ;MAKE SURE ADDRESS IS IN CORE>
MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC
IFN MONLOD,<TLO N,WOSW ;SET SWITCH TO WRITE OUT BUFFER>
SOJLE C,SPDATA ;SUB-BLOCK RUN OUT, REFILL IT
AOJA V,SPDT1 ;ADD ONE TO LOADER LOC. COUNTER
SUBTTL TENEX ASSIGNMENT (BLOCK TYPE 100)
IFN TENEX,<
;IMPLEMENT THE SPECIAL BLOCK 100 REQUEST FOR ASSIGNING
; AND INCREMENTING OF EXTERNALS
ASGSYM: PUSHJ P,RWORD ;GET FIRST WORD
MOVE V,W ;SAVE SYM2
PUSHJ P,PRWORD ;GET SECOND AND THIRD WORDS
TLO C,040000 ;MAKE INTO GLOBAL
PUSHJ P,SDEF ;SEE IF DEFINED
JRST ASGSY1 ;OK. IT IS
PUSH P,PRQ ;IT'S NOT, GENERATE ERROR COMMENT
PUSHJ P,PRNAME
JSP A,ERRPT7
SIXBIT /UNDEFINED ASSIGN IN #/
ASGSY0: PUSHJ P,RWORD ;SHOULD RETURN TO LOAD1
JRST ASGSY0 ;LOOP UNTIL IT DOES
ASGSY1: ADD W,2(A) ;INCREMENT VALUE
EXCH W,2(A) ;SAVE NEW, GET OLD
MOVE C,V ;GET SYM2
TLO C,040000 ;MAKE INTO GLOBAL
PUSHJ P,SYMPTQ ;AND CONTINUE AS FOR GLOBAL DEF
JRST ASGSY0 ;AND RETURN
>
SUBTTL 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
IFE K,< TLNE N,F4SW ;ARE WE IN FORTRAN?
JRST SDEF2 ;YES,JUST TRY NEXT SYMBOL>
TLC C,400000 ;MIGHT BE SUPPRESSED INTERNAL
CAMN C,1(A) ;WAS IT?
JRST [TLC C,400000 ;BACK AS IT WAS
IORM C,1(A) ;YES, SO ENSURE IT'S SUPPRESSED
POPJ P,] ;EXIT WITH SYMBOL FOUND
TLC C,400000 ;NO, TRY NEXT SYMBOL
SDEF2: ADD A,SE3
JUMPL A,SDEF1
IFE K,< JRST CPOPJ1 ;SYMBOL NOT FOUND SKIPS ON RETURN>
IFN K,<
CPOPJ1: AOS (P)
POPJ P,>
SUBTTL 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
TRNN F,TWOFL ;POSSIBLE TWO SEGMENTS?
JRST RWORD5 ;NO
MOVSS W
PUSHJ P,CHECK ;USE CORRECT RELOCATION
HRRI W,@R
MOVSS W
JRST RWORD3 ;AND TEST RIGHT HALF
RWORD5: HRLZ T,R
ADD W,T ;LH RELOCATION
RWORD3: TLNN Q,200000 ;TEST RH RELOCATION BIT
JRST RWORD4 ;NOT RELOCATABLE
TRNE F,TWOFL ;POSSIBLE TWO SEGMENTS?
PUSHJ P,CHECK ;USE CORRECT RELOCATION
HRRI W,@R ;RH RELOCATION
RWORD4: LSH Q,2
POPJ P,
CHECK: MOVE T,HVAL1 ;START OF HISEGMENT
CAIG T,NEGOFF(W) ;IN HISEG?
JRST [CAILE W,(W) ;IS ADDRESS BELOW HISEG START?
JRST [MOVNS T ;YES
ADDI T,(W) ;THEREFORE WORRY ABOUT CARRY
HRR W,T ;INTO LEFT HALF
POPJ P,]
SUBI W,(T) ;IN HISEG, REMOVE OFSET
POPJ P,]
HRRI W,@LOWR ;USE LOW SEG RELOC
JRST CPOPJ1 ;SKIP RETURN
SUBTTL PRINT STORAGE MAP SUBROUTINE
PRMAP: TRZ F,LOCAFL ;ASSUME LOCAL SYMBOLS SUPPRESSED
CAIE D,1 ;IF /1M PRINT LOCAL SYMBOLS
CAMN D,[-7] ;TEST FOR /-1M ALSO
TRO F,LOCAFL ;YES,TURN ON FLAG
JUMPL D,PRTMAP-1 ;JUMP IF /-M OR /-1M
TRO N,ENDMAP ;ELSE SET DEFERRED MAP FLAG
POPJ P,
TRZ N,ENDMAP ;CLEAR DELAYED MAP FLAG
PRTMAP: PUSHJ P,FSCN1 ;LOAD OTHER FILES FIRST
IFN SPCHN,<TRZ N,MAPSUP ;SET MAP NOT SUPPRESSED
SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
TRNN N,CHNMAP ;TEST FOR ROOT MAP ALREADY PRINTED
JRST PRMP0A ; SKIP IF NO TO EITHER QUESTION
PUSHJ P,CRLFLF ;SPACE TWO LINE AND FORCE TTY OUTPUT
TLZ F,FCONSW ;SUPPRESS TTY OUTPUT
ERROR 0,</******************** !/> ;PRINT SEPARATOR
TLO F,FCONSW ;FORCE TTY OUTPUT AGAIN
ERROR 0,</LINK !/> ;PRINT LINK NUMBER
MOVE W,LINKNR ;GET CURRENT LINK NUMBER
PUSHJ P,RCNUMW ;PRINT IT IN DECIMAL
TLZ F,FCONSW ;SUPPRESS TTY OUTPUT
ERROR 0,</ ********************!/> ;PRINT SEPARATOR
PUSHJ P,CRLF ;PUT BLANK LINE ON MAP FILE ONLY
PUSHJ P,CRLF ; DITTO
TLO F,FCONSW ;FORCE TTY OUTPUT AGAIN
PUSHJ P,CRLF
JRST .+2 ;SKIP NEXT CRLF CALL
PRMP0A: >
PUSHJ P,CRLFLF ;START NEW PAGE
HRRZ W,R
IFN REENT,<CAIG W,.JBDA ;LOADED INTO LOW SEGMENT
JRST NOLOW ;DON'T PRINT IF NOTHING THERE>
PUSHJ P,PRNUM0
IFE REENT,<ERROR 7,<?IS THE PROGRAM BREAK@?>>
IFN REENT,<ERROR 7,<?IS THE LOW SEGMENT BREAK@?>
PUSHJ P,CRLF ;CR-LF ON ALL BUT TTY
NOLOW: MOVE W,HVAL ;HISEG BREAK
CAMG W,HVAL1 ;HAS IT CHANGED
JRST NOHIGH ;NO HI-SEGMENT
TLO F,FCONSW ;FORCE OUT HI-SEG BREAK ALSO
PUSHJ P,PRNUM0
ERROR 7,<?IS THE HIGH SEGMENT BREAK@?>
PUSHJ P,CRLF
NOHIGH:>
IFN SPCHN,<SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
TRNN N,CHNMAP ;TEST FOR ROOT MAP ALREADY PRINTED
JRST .+2 ; NO TO EITHER QUESTION, FALL THRU
JRST NOADDR ; ELSE SKIP HEADING OUTPUT>
IFE NAMESW,< MOVE W,DTOUT ;OUTPUT NAME >
IFN NAMESW,< SKIPN W,DTOUT
MOVE W,CURNAM ;USE PROGRAM NAME>
JUMPE W,.+3 ;DON'T PRINT IF NOT THERE
PUSHJ P,PWORD
PUSHJ P,SPACES ;SOME SPACES
;HERE TO DECODE AND PRINT VERSION NUMBER IN .JBVER
;USES T,V,D,Q
IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
MOVE X,XRES ;YES, SETUP X >
IFE L,<
SKIPN V,.JBVER(X) ;GET VERSION NUMBER
JRST NOVER ;WASN'T ONE
ROT V,3 ;PUT USER BITS LAST
MOVEI T,"%" ;TO INDICATE VERSION
PUSHJ P,TYPE2 ;OUTPUT CHARACTER
MOVEI Q,3 ;3 BYTES IN MAJOR FIELD
PUSHJ P,SHFTL ;SHIFT LEFT, SKIP 0 BYTES
JRST .+3 ;NO MAJOR FIELD
MOVEI D,"0" ;CONVERT TO ASCII 0-8
PUSHJ P,OUTVER ;OUTPUT IT
MOVEI Q,2 ;2 DIGITS IN MINOR FIELD
PUSHJ P,SHFTL
JRST .+3 ;NO MINOR FIELD
MOVEI D,"@" ;ALPHABETICAL
PUSHJ P,OUTVER
MOVEI T,"(" ;EDIT NUMBER IN PARENS
TLNN V,-1 ;SEE IF GIVEN
JRST NOEDIT ;NO
PUSHJ P,TYPE2 ;YES
MOVEI Q,6
PUSHJ P,SHFTL ;LEFT JUSTIFY
JRST .+3 ;NEVER GETS HERE
MOVEI D,"0" ;0-7 AGAIN
PUSHJ P,OUTVER
MOVEI T,")" ;CLOSE VERSION
PUSHJ P,TYPE2
NOEDIT: MOVEI T,"-" ;USER FIELD?
JUMPE V,.+4 ;NO
PUSHJ P,TYPE2 ;YES
MOVEI Q,1 ;ONLY ONE DIGIT
PUSHJ P,OUTVER ;OUTPUT IT
PUSHJ P,SPACES ;SOME SPACES
NOVER:>;END OF IFE L
ERROR 0,<?STORAGE MAP!?>
PUSHJ P,SPACES ;SOME SPACES
PUSH P,N
PUSH P,E
MOVE N,[POINT 6,DBUF] ;INITIALIZE DATE POINTER
MSTIME Q, ;GET THE TIME
IDIVI Q,^D60*^D1000
IDIVI Q,^D60
PUSH P,A ;SAVE MINUTES
PUSHJ P,OTOD1 ;STORE HOURS
POP P,Q ;GET MINUTES
PUSHJ P,OTOD ;STORE MINUTES
DATE E, ;GET DATE
IDIVI E,^D31 ;GET DAY
ADDI Q,1
PUSHJ P,OTOD ;STORE DAY
IDIVI E,^D12 ;GET MONTH
ROT Q,-1 ;DIV BY 2
HRR A,DTAB(Q) ;GET MNEMONIC
TLNN Q,400000
HLR A,DTAB(Q) ;OTHER SIDE
HRRM A,DBUF+1 ;STORE IT
MOVEI Q,^D64(E) ;GET YEAR
MOVE N,[POINT 6,DBUF+2]
PUSHJ P,OTOD ;STORE IT
POP P,E
POP P,N
PUSHJ P,DBUF1
PUSHJ P,CRLF
SKIPN STADDR ;PRINT STARTING ADDRESS
JRST NOADDR ;NO ADDRESS SEEN
ERROR 0,</STARTING ADDRESS !/>
PUSHJ P,SP1
MOVE W,STADDR ;GET ST. ADDR.
PUSHJ P,PRNUM0 ;PRINT IT
IFN NAMESW,<
PUSHJ P,SP1
MOVE W,[SIXBIT / PROG /]
PUSHJ P,PWORD
MOVE W,CURNAM ;PROG NAME
PUSHJ P,PWORD
PUSHJ P,SP1
MOVE W,ERRPT6 ;SIXBIT / FILE /
PUSHJ P,PWORD
MOVE W,PRGNAM ;FILE NAME
PUSHJ P,PWORD>
NOADDR: IFN REENT,<
HRRZ A,HVAL1 ;GET INITIAL HIGH START
ADDI A,.JBHDA ;ADD IN OFFSET
IFN SPCHN,<HRL A,BEGOV ;ASSUME NON-ROOT OVERLAY
SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
TRNN N,CHNMAP ;TEST FOR ROOT-MAP PRINTED
;ASSUMPTION CORRECT IF YES TO BOTH
; SKIP NEXT INSTRUCTION IF SO >
HRLI A,.JBDA ;LOW START
MOVSM A,SVBRKS ;INITIAL BREAKS>
HLRE A,B
MOVNS A
ADDI A,(B)
PRMAP1: SUBI A,2
IFN REENT!L,<SKIPN C,1(A) ;LOAD SYMBOL SKIP IF REAL SYMBOL
JRST PRMAP4 ;IGNORE ZERO NAME(TWOSEG BREAKS)>
IFE REENT!L,<MOVE C,1(A) ;LOAD SYMBOL>
TLNN C,300000 ;TEST FOR LOCAL SYMBOL
JRST .+4 ;GLOBAL (NOT LOCAL ANYWAY)
TRNN F,LOCAFL ;PRINT LOCAL SYMBOLS?
JRST PRMAP4 ;IGNORE LOCAL SYMBOLS
TLC C,040000 ;MAKE IT LOOK LIKE INTERN
TLNE C,040000
JRST PRMP1A
IFN SPCHN,<TRZ N,MAPSUP ;SET MAP NOT SUPPRESSED
SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
TRNN N,CHNMAP ;TEST FOR ROOT MAP PRINTED
JRST PRMP0C ; NO TO EITHER TEST, SKIP AROUND
HRRZ T,2(A) ;GET STARTING ADDRESS
CAML T,BEGOV ;TEST FOR BELOW OVERLAY
JRST PRMP0C ;NO,JUMP
TRO N,MAPSUP ;SUPPRESS IF RE-PRINTING ROOT
JRST PRMAP4 ; & SKIP TO NEXT SYMBOL
PRMP0C:>
PUSHJ P,CRLF
PUSHJ P,CRLF
JRST PRMP1B
PRMP1A:
IFN SPCHN,<TRNE N,MAPSUP ;TEST FOR SUPPRESSED MAP
JRST PRMAP4 ; YES, SKIP THIS SYMBOL>
PUSHJ P,TAB
MOVEI T,40 ;SPACE FOR OPEN GLOBAL
TLNE C,100000 ;LOCAL?
MOVEI T,47 ;YES, TYPE '
TLNE C,400000 ;HALF KILLED TO DDT?
ADDI T,3 ;YES, TYPE # FOR GLOBAL, * FOR LOCAL
PUSHJ P,TYPE2 ;PRINT CHARACTER
PRMP1B: PUSHJ P,PRNAM1 ;PRINT SYMBOL AND VALUE
TLNE C,040000
JRST PRMAP4 ;GLOBAL SYMBOL
HLRE C,W ;POINTER TO NEXT PROG. NAME
HRRZS W ;SO WE ONLY HAVE THE HALF WE WANT
PRMAP7: JUMPL C,PRMP7A
IFN REENT,<SKIPN 1(B) ;IS IT A ZERO SYMBOL
JRST [MOVE C,B ;SET UP C
JRST PRMAP2] ;AND GO
HRRZ T,HVAL ;GET TO OF HI PART
CAML W,HVAL1 ;IS PROGRAM START UP THERE??
JRST PRMAP6 ;YES
HRRZ T,HILOW ;GET HIGHEST LOCATION LOADED IN LOW
SUBI T,(X) ;REMOVE OFFSET
CAIE T,(W) ;EQUAL IF ZERO LENGTH PROG>
HRRZ T,R ;GET LOW, HERE ON LAST PROG
JRST PRMAP6 ;GO
PRMP7A: ADDI C,2(A) ;POINTER TO NEXT PROGRAM NAME
PRMAP2: IFN REENT,<
SKIPE 1(C) ;THIS IS A TWO SEG FILE
JRST PRMP2A ;NO
MOVE T,2(C) ;GET PROG BREAKS
TLNN T,-1 ;IF NO HIGH STUFF YET
HLL T,SVBRKS ;FAKE IT
SUB T,SVBRKS ;SUBTRACT LAST BREAKS
HRRZ W,T ;LOW BREAK
PUSH P,T ;SAVE T
PUSHJ P,PRNUM ;PRINT IT
POP P,T ;RESTORE
HLRZ W,T ;GET HIGH BREAK
JUMPE W,.+3 ;SKIP IF NO HIGH CODE
PUSHJ P,TAB ;AND TAB
PUSHJ P,PRNUM
MOVE T,2(C)
CAMN C,B ;EQUAL IF LAST PROG
SETZ C, ;SIGNAL END
TLNN T,-1
HLL T,SVBRKS
IFE TENEX,<CAMN T,SVBRKS ;ZERO LENGTH IF EQUAL
JRST PRMP6A ;SEE IF LIST ALL ON>
MOVEM T,SVBRKS ;SAVE FOR NEXT TIME
JRST PRMAP3 ;AND CONTINUE
PRMP2A:>
HRRZ T,(C) ;GET ITS STARTING ADRESS
PRMAP6: SUBM T,W ;SUBTRACT ORIGIN TO GET LENGTH
PUSHJ P,PRNUM ;PRINT PROGRAM LENGTH
PUSHJ P,CRLF
PRMP6A:
IFE TENEX,<TLNN N,ALLFLG ;SKIP IF LIST ALL MODE IS ON
TRNE W,777777 ;SKIP IF ZERO LENGTH PROGRAM>
IFN TENEX,<TLNE N,ALLFLG ;SKIP IF LIST ALL MODE IS ON>
JRST PRMAP3
HLRE C,2(A) ;GET BACK CORRECT LOCATION IF 0 LENGTH
JUMPE C,PRMAP5 ;JUMP IF LAST PROGRAM
ADDI C,2(A) ;IN CASE WE SKIPPED SOME PROGRAMS
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: PUSHJ P,CRLF ;GIVE AN XTRA CR-LF
IFN SPCHN,<SKIPN CHNACB ;TEST FOR SPECIAL CHAINING
JRST PMS ;NO, SKIP
TRO N,CHNMAP ;YES, SHOW ROOT-PHASE PRINTED
JRST PMS4 ; & EXIT>
IFN TENEX,<JRST PMS ;GO PRINT UNDEFINED GLOBALS>
SUBTTL LIST UNDEFINED AND MULTIPLY DEFINED GLOBALS
;LIST UNDEFINED GLOBALS
PMSQ:
IFN TENEX,<SETZM NLSTGL ;ALLOW UNDEFINED GLOBALS TO LIST>
PMS: PUSHJ P,FSCN1 ;LOAD FILES FIRST
JUMPGE S,PMS4 ;JUMP IF NO UNDEFINED GLOBALS
IFN TENEX,<SKIPE NLSTGL ;HAVE UNDEF GLOBALS BEEN LISTED?
POPJ P,0 ;YES
SETOM NLSTGL ;PREVENT IT FROM HAPPENING AGAIN>
PUSHJ P,FCRLF ;START THE MESSAGE
HLRE W,S ;COMPUTE NO. OF UNDEF. GLOBALS
MOVMS W
LSH W,-1 ;<LENGTH OF LIST>/2
PUSHJ P,RCNUMW ;PRINT AS DECIMAL NUMBER
ERROR 7,</UNDEFINED GLOBAL(S)@/>
MOVE A,S ;LOAD UNDEF. POINTER
PMS2: SKIPL W,1(A)
TLNN W,40000
JRST PMS2A
PUSHJ P,FCRLF
PUSHJ P,PRNAM0 ;PRINT SYMBOL AND POINTER
PMS2A: ADD A,SE3
JUMPL A,PMS2
PUSHJ P,CRLF ;NEW LINE
;LIST NUMBER OF MULTIPLY DEFINED GLOBALS
PMS3: SKIPN W,MDG ;ANY MULTIPLY DEFINED GLOBALS
JRST PMS4 ;NO, EXCELSIOR
PUSHJ P,FCRLF ;ROOM AT THE TOP
PUSHJ P,RCNUMW ;NUMBER OF MULTIPLES IN DECIMAL
ERROR 7,<?MULTIPLY DEFINED GLOBAL(S)@?>
PMS4: TLNE N,AUXSWE ;AUXILIARY OUTPUT DEVICE?
OUTPUT 2, ;INSURE A COMPLETE BUFFER
CPOPJ: POPJ P, ;RETURN
SUBTTL ENTER FILE ON AUXILIARY OUTPUT DEVICE
IAD2:
IFN SYMDSW,<TRNE F,LSYMFL ;ALREADY USING AUX DEV FOR LOCAL SYMBOLS?
POPJ P, ;YES, GIVE ERROR RETURN>
PUSH P,A ;SAVE A FOR RETURN
MOVE A,LD5C1 ;GET AUX. DEV.
DEVCHR A, ;GET DEVCHR
TLNN A,4 ;DOES IT HAVE A DIRECTORY
JRST [SKIPN A,DTOUT ;USE OUTPUT NAME IF GIVEN
JRST IAD2C ;FIND A DEFAULT
JRST IAD2A] ;JUST DO ENTER
MOVE A,DTOUT ;GET OUTPUT NAME
CAME A,[SIXBIT /JOBDAT/] ;DON'T USE JOBDAT
JUMPN A,IAD2A ;USE ANYTHING NON-ZERO
MOVSI A,(SIXBIT /DSK/) ;DEFAULT DEVICE
CAMN A,LD5C1 ;IS IT AUX. DEV.
JRST IAD2C ;YES LEAVE WELL ALONE
CLOSE 2, ;CLOSE OLD AUX. DEV.
MOVEM A,LD5C1 ;SET IT TO DSK
OPEN 2,OPEN2 ;OPEN IT FOR DSK
JRST IMD4 ;FAILED
IAD2C: IFN NAMESW,<
SKIPN A,CURNAM ;USE PROG NAME>
MOVSI A,(SIXBIT /MAP/) ;AN UNLIKELY NAME
MOVEM A,DTOUT ;SO ENTER WILL NOT FAIL
IAD2A:
IFN SPCHN,<MOVE A,CHNOUT+1 ;GET SP CHAIN DEV.
CAMN A,LD5C1 ;IS IT SAME AS AUX. DEV.
SKIPN CHNACB ;YES, ARE WE DOING SP CHAIN?
JRST IAD2B ;NO, PHEW!
DEVCHR A, ;IS IT REALLY A DSK?
TLNE A,DSKBIT
JRST IAD2B ;YES, LEAVE ALONE
RELEAS 2, ;NO, CLEAR OUT ANY RESIDUAL FILE
JRST IMD4 ;AWAY BEFORE SOMETHING TERRIBLE HAPPENS
IAD2B:>
POP P,A ;RECOVER A
SETZM DTOUT+2 ;CLEAR PROTECTION (LEVEL D)
ENTER 2,DTOUT ;WRITE FILE NAME IN DIRECTORY
JRST IMD3 ;NO MORE DIRECTORY SPACE
AOS (P) ;SKIP RETURN IF SUCCESSFUL
POPJ P,
IMD3: ERROR ,</ERROR WRITING FILE@/>
TLZ N,AUXSWE!AUXSWI ;CLEAR AUX DEVICE SWITCHES
JRST LD2
IMD4: MOVE P,PDLPT ;RESTORE STACK
AOBJN P,.+1 ;BUT SAVE RETURN ADDRESS
TLZ N,AUXSWE!AUXSWI ;NO AUX.DEV.NOW
ERROR ,</NO MAP DEVICE@/>
JRST PRMAP5 ;CONTINUE TO LOAD
SUBTTL MONLOD - DISK IMAGE MONITOR LOADER CODE
IFN MONLOD,<
DIOPEN: PUSH P,A ;SAVE AC A
PUSH P,H ;SAVE AC H
PUSH P,N ;SAVE 3 ACC'S
PUSH P,X ;IN A BLOCK
MOVE A,ILD1 ;GET DEVICE
MOVE N,A ;SPARE COPY
DEVCHR A, ;SEE WHAT IT IS
TLNN A,DSKBIT ;IS IT SOME SORT OF DSK?
SKIPA N,DIN1 ;NO, GET THE DEFAULT DEVICE (DSK)
MOVEM N,DIN1 ;YES, OBEY USER AND USE IT
MOVE A,[3,,N] ;SET UP BLOCK
DSKCHR A, ;WAS DSK, BUT SEE IF GENERIC "DSK"
JRST USEDSK ;NO POINT GOING THROUGH WITH THIS
TLNE A,(7B17) ;IS IT GENERIC DSK?
JRST USEDSK ;NO USE WHATS IN DIN1
SETOB N,H ;REQUEST FIRST F/S
MOVE A,[3,,N] ;SET UP A AGAIN
JOBSTR A, ;GET FIRST F/S IN SEARCH LIST
JRST USEDSK ;LEVEL C
JUMPL H,USEDSK ;SWP BIT SET
TLNN H,200000 ;IS NO CREATE BIT SET?
JRST USEDSK ;NO, GENERIC 'DSK' WILL USE THIS F/S
DSKCHR A, ;GET FIRST 3 ARGS
JRST USEDSK ;SHOULD NEVER HAPPEN BUT !!
TLNN A,740200 ;RHB!OFL!HWP!SWP!NNA SET?
CAIGE X,DALLOC ;ENOUGH SPACE?
JRST USEDSK ;CANNOT USE FASTEST F/S
MOVEM N,DIN1 ;USE F/S RATHER THAN 'DSK'
MOVEM N,GENERI ;SAVE F/S INCASE ENTER FAILS
USEDSK: POP P,X ;RESTORE ACC'S
POP P,N
MOVE H,(P) ;RESET H
USDSK2: OPEN 4,OPEN4 ;OPEN DEVICE 'DSK', MODE 16
HALT .-1 ;ERROR, NON-INTELIGENT INDICATION
MOVEM W,DIOUT1+1 ;STORE EXTENSION 'XPN'
MOVE A,DTIN ;GET FILE NAME
MOVEM A,DIOUT1 ;STORE IN 'LOOKUP-ENTER' BLOCK
SETZM DIOUT1+2 ;CLEAR PARAMETERS TO BE SUPPLIED BY MONITOR
SETZM DIOUT1+3 ;ALWAYS USE THIS JOB'S PROJ-PROG NUMBER
SETZM DIOUT+1 ;SAME AGAIN
MOVE A,[17,,11] ;STATES WORD
GETTAB A, ;GET IT
JRST .+3 ;FAILED, NOT LEVEL D FOR SURE
TLNE A,(7B9) ;TEST FOR LEVEL D
TDZA A,A ;YES, THIS IS LEVEL D
MOVEI A,2 ;NOT LEVEL D
ENTER 4,DIOUT(A) ;CREATE OR SUPERCEDE SAVE FILE
JRST ENTFAI ;ERROR, TRY DSK
JUMPE A,LEVELD ;JUMP IF LEVEL D
HRRZ A,.JBREL ;GET CURRENT SIZE
CAIL A,2000 ;NEED AT LEAST 2K
CAILE H,-2000(S) ;CHECK FOR 1K FREE
IFN EXPAND,<JRST [PUSHJ P,XPAND ;GET 1K OF ZEROS, WILL SAVE TIME LATER IN ANYCASE>
JRST FULLC ;NO MORE CORE
IFN EXPAND,< JRST .-1]> ;OK, TRY AGAIN
MOVSI A,-2000 ;FORM IOWD
HRRI A,(H) ;TO 1K OF BLANK
MOVEM A,LOLIST ;STORE IOWD
SETZM LOLIST+1 ;TERMINATE LIST
MOVEI A,DALLOC/10 ;PREALLOCATE THE HARD WAY
OUTPUT 4,LOLIST ;BY DOING OUTPUTS
SOJG A,.-1
MOVEI A,2 ;STILL NOT LEVEL D
LEVELD: CLOSE 4,4 ;WIPE OUT THE OLD FILE IF ONE EXISTS
LOOKUP 4,DIOUT(A) ;LOOKUP FOLLOWED BY ENTER ENABLES UPDATING
HALT .-1 ;ERROR
JUMPN A,ALLOK ;NOT LEVEL D
MOVE A,DIOUT+.RBALC ;SEE WHAT WE GOT
SKIPE GENERI ;IF NOT GENERIC DSK FIRST F/S
CAIL A,DALLOC ;WAS IT ENOUGH
TDZA A,A ;YES, BUT STILL LEVEL D
JRST TRYAGN ;NO JUST USE DSK
ALLOK: ENTER 4,DIOUT(A) ;FILE CAN BE BOTH READ AND WRITTEN
HALT .-1 ;ERROR
MOVE A,H ;GET HIGHEST ADDRESS LOADED SO FAR
SUBI A,-177(X) ;SIZE OF LOW BUFFER MUST BE AN
ANDI A,777600 ;INTEGRAL MULTIPLE OF BLOCK SIZE
MOVEM A,HIRES ;SET UP POINTER FOR LOCATION CHECKING
ADDI A,(X) ;GET ADDRESS OF START OF IMAGE BUFFER
HRRM A,HILIST ;HILIST IS IOWD FOR FILE WINDOW BUFFER
SUBI A,(X) ;A=SIZE OF LOW IMAGE BUFFER (RESIDENT)
MOVN A,A ;GET MINUS BUFFER SIZE
HRLM A,LOLIST ;SET UP WORD COUNT IN LOW IOWD
HRRM X,LOLIST ;ADDRESS FIELD OF IOWD
MOVEM X,XRES ;SAVE OFFSET OF RESIDENT PORTION
MOVE H,HILIST ;GET HIGH BUFFER ADDRESS
MOVNI A,DISIZE ;NEGATIVE SIZE OF FILE WINDOW
HRLM A,HILIST ;SET UP WORD COUNT OF HIGH IOWD
MOVE A,HIRES ;GET HIGHEST ADDRESS IN RESIDENT PORTION+1
LSH A,-7 ;CONVERT TO BLOCK NUMBER
MOVEM A,RESBLK ;STORE NUMBER OF BLOCKS IN RESIDENT PORTION
ADDI H,DISIZE ;H=TOP OF DISK WINDOW BUFFER
MOVEM H,DIEND ;LAST LOCATION IN WINDOW BUFFER+1
CAILE H,1(S) ;SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
JRST FULLC
IFN EXPAND,< JRST .-1]>
SOS HILIST ;IOWD POINTS TO BUFFER-1
SOS LOLIST ; "
SETZM HILIST+1 ;TERMINATOR SHOULD BE ZERO
SETZM LOLIST+1 ; "
TLO N,DISW ;SET DISK IMAGE IN USE FLAG
PUSH P,V ;SAVE CURRENT LOADER LOCATION COUNTER
MOVE V,HIRES ;GET FIRST ADDRESS NOT IN RESIDENT BUFFER
PUSHJ P,DICHK2 ;CALL TO INITIALIZE THE BUFFER HANDLER
POP P,V ;RESTORE V
POP P,H ;RESTORE H
SUBI H,(X) ;CONVERT TO ABSOLUTE FOR DISK IMAGE LOAD
POP P,A ;RESTORE AC A
JRST LD2D ;RETURN TO CONTINUE SCAN
DICHK: TLNN N,DISW ;ARE WE DOING A DISK IMAGE LOAD?
POPJ P, ;NO, ALL IS OK
HRRZ X,V ;LEFT HALF OF AC 'V' MAY CONTAIN FLAGS
CAMGE X,HIRES ;SKIP IF ADDRESS NOT IN RESIDENT PORTION
JRST DICHK1 ;ADDRESS IN AC X IS IN RESIDENT PORTION
CAMGE X,DILADD ;SKIP IF ADDRESS ABOVE CORRENT LOWEST WINDOW ADDRESS
JRST DICHK2 ;ADDRESS IS NOT RESIDENT
CAML X,DIHADD ;SKIP IF ADDRESS IS RESIDENT
JRST DICHK2 ;NOT RESIDENT
SKIPA X,XCUR ;GET OFFSET OF CURRENT WINDOW
DICHK1: MOVE X,XRES ;GET OFFSET OF RESIDENT LOW PORTION
POPJ P,
DICHK2: PUSH P,A ;GET ADDRESS IN AC 'V' INTO CORE
PUSH P,Q ;GET SOME AC'S TO WORK WITH
TLZE N,WOSW ;CURRENT BUFFER TO BE WRITTEN OUT?
PUSHJ P,DICHK3 ;YES, GO DO SO
MOVE A,HILIST ;GET ADDRESS-1 OF DISK IMAGE BUFFER
ADDI A,1 ;A NOW POINTS TO START OF BUFFER
SETZM (A) ;CLEAR THE FIRST WORD OF THE BUFFER
MOVS Q,A ;MOVE ADDRESS TO SOURCE FOR BLT
HRRI Q,1(A) ;SOURCE+1 TO DESTINATION
ADDI A,DISIZE ;SET A TO TOP OF BUFFER+1
BLT Q,-1(A) ;CLEAR THE BUFFER
HRRZ Q,V ;GET THE ADDRESS WE'RE LOOKING FOR
SUB Q,HIRES ;ACCOUNT FOR RESIDENT PART
IDIVI Q,DISIZE ;A=Q+1
IMULI Q,DISIZE ;FIRST ADDRESS IN WINDOW
IDIVI Q,^D128 ;GET BLOCK NUMBER (-NUMBER IN RESIDENT PORTION)
ADD Q,RESBLK ;NUMBER OF RESIDENT BLOCKS
USETI 4,1(Q) ;BLOCK 0 DOES NOT EXIST
STATZ 4,20000 ;END OF FILE?
JRST DICHK4 ;YES, NO SENSE READING
INPUT 4,HILIST ;TRY TO FILL THE DISK IMAGE BUFFER
STATZ 4,740000 ;CHECK FOR ERRORS, DON'T CARE ABOUT EOF
HALT .-3 ;TRY AGAIN ON CONTINUE
DICHK4: MOVEM Q,CURSET ;LEAVE BLOCK NUMBER AROUND FOR LATER USETO
IMULI Q,^D128 ;GET ADDRESS OF FIRST WORD IN CURRENT BUFFER
MOVEM Q,DILADD ;STORE FOR FUTURE COMPARES
ADDI Q,DISIZE ;ADD SIZE OF DISK IMAGE BUFFER
MOVEM Q,DIHADD ;STORE HIGH CURRENT ADDRESS+1
HRRZ Q,HILIST ;GET WINDOW ADDRESS-1
ADDI Q,1 ;NOW EQUAL TO ADDRESS
SUB Q,DILADD ;COMPUTE LOADER CURRENT WINDOW OFFSET
HRLI Q,V ;SET UP INDEX REGISTER FOR STORED X
MOVEM Q,XCUR ;STORE CURRENT OFFSET
POP P,Q ;RESTORE
POP P,A ;RESTORE
MOVE X,XCUR ;SET UP LOADER OFFSET REGISTER
POPJ P, ;RETURN, ADDRESS IN 'V' NOW RESIDENT
DICHK3: MOVE Q,CURSET ;GET BLOCK NUMBER FOR USETO
USETO 4,1(Q) ;THERE IS NO BLOCK 0
OUTPUT 4,HILIST ;WRITE OUT HE IMAGE
STATZ 4,740000 ;ERROR?
HALT .-3 ;YES, TRY AGAIN ON CONTINUE
POPJ P, ;RETURN
SIZCHK: EXCH A,DIEND ;SAVE A, GET END OF BUFFER ADDRESS
AOS (P) ;DEFAULT IS SKIP RETURN
CAIGE A,(S) ;IS SYMBOL TABLE ENCROACHING ON BUFFER?
AOS (P) ;NO,DON'T EXPAND CORE
EXCH A,DIEND ;RESTORE BOTH A AND DIEND
POPJ P, ;RETURN
DISYM: PUSH P,V ;SAVE CURRENT ADDRESS
MOVE V,A ;GET ADDRESS WERE LOOGING FOR
PUSHJ P,DICHK ;MAKE SURE IT IS IN CORE
POP P,V ;RESTORE V
POPJ P, ;RETURN
DIOVER: MOVE X,XRES ;CLEAN UP XPN FILE AND EXIT
MOVE A,.JBFF(X) ;GET LAST ADDRESS LOADER
SUB A,DILADD ;SUBTRACT CURRENT LOW ADDRESS
ADDI A,^D128 ;ROUND OFF TO NEAREST BLOCK SIZE
ANDI A,777600 ;FOR IOWD
MOVNS A ;NEGATE
HRLM A,HILIST ;PUT IN WINDOW IOWD
PUSHJ P,DICHK3 ;OUTPUT THE SYMBOL TABLE
USETO 4,1 ;SET UP TO OUTPUT RESIDENT PART
OUTPUT 4,LOLIST ;AND DO SO
STATZ 4,740000 ;ERROR CHECK
HALT .-3 ;IF ERROR TRY AGAIN
CLOSE 4,
EXIT
TRYAGN: PUSH P,DIOUT1 ;SAVE NAME
SETZM DIOUT1
RENAME 4,DIOUT(A) ;GET RID OF FILE
POP P,DIOUT1 ;RESTORE NAME
ENTFAI: SKIPN GENERI ;GENERIC DSK?
HALT . ;NO, JUST GIVE UP
MOVSI A,'DSK' ;TRY WITH JUST DSK
MOVEM A,DIN1
SETZM GENERI
SETZM DIOUT+.RBALC
JRST USDSK2 ;TRY AGAIN
>
SUBTTL PRINT SUBROUTINES
;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:
TRNN F,TTYFL
PUSHJ P,SP1
PUSHJ P,SP1
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: POINT 3,W,17 ;BYTE POINTER FOR OCTAL CONVERSION OF W
;HERE TO LEFT JUSTIFY V, COUNT IN IN Q
LSH V,3 ;STEP LEFT ONE
SHFTL: TLNN V,700000 ;LEFT JUSTIFIED?
SOJGE Q,.-2 ;NO SHIFT IF STILL IN FIELD
JUMPLE Q,CPOPJ ;NOTHING IN THIS FIELD
JRST CPOPJ1 ;SKIP RTETURN, AT LEAST ONE CHAR
;HERE TO OUTPUT CHARACTERS LEFT AFTER SHIFTING LEFT
OUTVER: SETZ T, ;CLEAR T TO REMOVE JUNK
LSHC T,3 ;SHIFT IN FROM T
ADDI T,(D) ;EITHER "0" OR "A"
PUSHJ P,TYPE2 ;PRINT
SOJG Q,OUTVER ;MORE?
POPJ P, ;NO
IFN NAMESW,<
LDNAM: MOVE T,[POINT 6,CURNAM] ;POINTER
SETZM CURNAM ;CLEAR OLD NAME INCASE FEWER CHARS. IN NEW
MOVNI D,6 ;SET COUNT
TLZ W,740000 ;REMOVE CODE BITS
SETNAM: IDIVI W,50 ;CONVERT FROM RAD 50
HRLM C,(P)
AOJGE D,.+2
PUSHJ P,SETNAM
HLRZ C,(P)
JUMPE C,INAM
ADDI C,17
CAILE C,31
ADDI C,7
CAIG C,72 ;REMOVE SPECIAL CHARS. (. $ %)
IDPB C,T
INAM: POPJ P, >
;SPECIAL ENTRY POINT WITH NUMBER IN REGISTER W, FALLS THRU TO RCNUM
RCNUMW: MOVE Q,W ;COPY NUMBER INTO PROPER REGISTER
;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)
JUMPE Q,.+2
PUSHJ P,RCNUM
HLRZ T,(P)
JRST TYPE2
SPACES: PUSHJ P,SP1
SP1: PUSHJ P,SPACE
SPACE: MOVEI T,40
JRST TYPE2
; 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,
;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: SETZM TABCNT ;RESET TAB COUNT ON NEW LINE
MOVEI T,15 ;CARRIAGE RETURN LINE FEED
PUSHJ P,TYPE2
TRCA T,7 ;CR.XOR.7=LF
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
TLOE N,AUXSWE ;IS AUX. DEV. ENTERED?
JRST TYPE2A ; YES, SKIP
PUSHJ P,IAD2 ;NOPE, DO SO!
JRST TYPE3 ;ERROR RETURN
TYPE2A: SOSG ABUF2 ;SPACE LEFT IN BUFFER?
OUTPUT 2, ;CREATE A NEW BUFFER
IDPB T,ABUF1 ;DEPOSIT CHARACTER
IFN RPGSW,<
TRNN F,NOTTTY ;IF TTY IS ANOTHER DEVICE
;DON'T OUTPUT TO IT>
TLNN F,FCONSW ;FORCE OUTPUT TO CONSOLE TOO?
POPJ P, ;NOPE
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
POPJ P,
SUBTTL SYMBOL PRINT - RADIX 50
; ACCUMULATORS USED: D,T
PRNAME: MOVE T,C ;LOAD SYMBOL
TLZ T,740000 ;ZERO CODE BITS
CAML T,[50*50*50*50*50] ;SYMBOL LEFT JUSTIFIED
JRST SPT0 ;YES
PUSH P,T
PUSH P,C
MOVEI C,6
MOVEI D,1
IDIVI T,50
JUMPN V,.+2
IMULI D,50
SOJN C,.-3
POP P,C
POP P,T
IMUL T,D
SPT0: 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
AOJGE D,.+2 ;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
TAB1: PUSHJ P,CRLF
TAB: AOS T,TABCNT
CAIN T,5
JRST TAB1
TLNE N,AUXSWI ;TTY BY DEFAULT?
TRNE F,TTYFL
JRST SP1
MOVEI T,11
JRST TYPE2
OTOD: IBP N
OTOD1: IDIVI Q,^D10
ADDI Q,20 ;FORM SIXBIT
IDPB Q,N
ADDI A,20
IDPB A,N
POPJ P,
DTAB: SIXBIT /JANFEB/
SIXBIT /MARAPR/
SIXBIT /MAYJUN/
SIXBIT /JULAUG/
SIXBIT /SEPOCT/
SIXBIT /NOVDEC/
SUBTTL ERROR MESSAGE PRINT SUBROUTINE
; FORM OF CALL:
; JSP A,ERRPT
; SIXBIT /<MESSAGE>/
; ACCUMULATORS USED: T,V,C,W
ERRPT: PUSHJ P,FCRLF ;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,'@'
JRST ERRPT4
CAIN T,'%'
JRST ERRPT9
CAIN T,'!'
JRST ERRP42 ;JUST RETURN,LEAVE FCONSW ON
CAIE T,'#'
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: TLZ F,FCONSW ;ONE ERROR PER CONSOLE
ERRP42: POP P,Q ;***DMN*** FIX FOR ILC MESSAGE
AOJ V, ;PROGRAM BUMMERS BEWARE:
JRST @V ;V HAS AN INDEX OF A
ERRPT5: POINT 6,0(A)
ERRPT6: SIXBIT / FILE /
ERRPT8: 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
TRC T,100 ;CONVERT TO PRINTING CHAR.
ERRP8: PUSHJ P,TYPE2
ERRPT7: PUSHJ P,SPACE
JRST ERRPT0
ERRPT9: MOVEI V,@V
PUSH P,V
ERROR 7,<?ILLEGAL -LOADER@?>
POP P,V
JRST ERRP41
;PRINT QUESTION MARK
PRQ: PUSH P,T ;SAVE
TLO F,FCONSW ;FORCE TTY OUTPUT ON ANY ERROR
MOVEI T,"?" ;PRINT ?
PUSHJ P,TYPE2 ;...
POP P,T ;RESTORE
POPJ P, ;RETURN
SUBTTL INPUT - OUTPUT INTERFACE
;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W
WORDPR: PUSHJ P,WORD ;GET FIRST WORD OF PAIR
MOVE C,W ;KEEP IT HANDY
WORD: SOSGE BUFR2 ;SKIP IF BUFFER NOT EMPTY
JRST WORD2
WORD1: ILDB W,BUFR1 ;PICK UP 36 BIT WORD
POPJ P,
WORD2: IN 1, ;GET NEXT BUFFER LOAD
JRST WORD ;DATA OK - CONTINUE LOADING
WORD3: STATZ 1,IODEND ;TEST FOR EOF
JRST EOF ;END OF FILE EXIT
ERROR ,< /INPUT ERROR#/>
JRST LD2 ;GO TO ERROR RETURN
SE3: XWD 2,2 ;SYMBOL POINTER INCREMENT
PDLPT: IOWD PDLSIZ,PDLST ;INITIAL PUSHDOWN STACK
COMM: SQUOZE 0,.COMM.
LSTPT: POINT 6,W ;CHARACTER POINTER TO W
IOBKTL==40000
IOIMPM==400000
IODERR==200000
IODTER==100000
IODEND==20000
IOBAD==IODERR!IODTER!IOBKTL!IOIMPM
SUBTTL IMPURE CODE
IFN PURESW,< RELOC
LOWCOD: RELOC
HICODE:
PHASE LOWCOD>
DBUF1: JSP A,ERRPT7
DBUF: SIXBIT /TI:ME DY-MON-YR @/
POPJ P,
;DATA FOR PURE OPEN UUO'S
IFN SPCHN,<
CHNENT: 0
SIXBIT .CHN.
0
0
CHNOUT: EXP 16
SIXBIT /DSK/
0
>
IFN RPGSW,<
OPEN1: EXP 1
RPG1: Z
XWD 0,CTLIN
>
OPEN2: EXP 1
LD5C1: Z
XWD ABUF,0
OPEN3: EXP 14
ILD1: Z
XWD 0,BUFR
IFN MONLOD,<
OPEN4: EXP 16
DIN1: SIXBIT /DSK/
Z
>
IFN PURESW,<DEPHASE
CODLN==.-HICODE>
SUBTTL DATA STORAGE
IFN PURESW,< RELOC
LOWCOD: BLOCK CODLN>
DATBEG:! ;STORAGE AREA CLEARED FROM HERE ON INITIALIZATION
ZBEG:! ;CLEARED FROM HERE TO ZEND ON REINITIALIZATION
MDG: BLOCK 1 ;COUNTER FOR MUL DEF GLOBALS
IFN REENT,<HILOW: BLOCK 1 ;HIGHEST NON-BLOCK STMT IN LOW SEG>
STADDR: BLOCK 1 ;HOLDS STARTING ADDRESS
IFN KUTSW,<CORSZ: BLOCK 1>
IFN REENT,<VSW: BLOCK 1>
IFN NAMESW,<CURNAM: BLOCK 1>
IFN B11SW,<POLSW: BLOCK 1>
IFN FAILSW,<LINKTB: BLOCK 21>
IFN SPCHN,<CHNACB: BLOCK 1>
ZEND==.-1
PDSAV: BLOCK 1 ;SAVED PUSHDOWN POINTER
COMSAV: BLOCK 1 ;LENGTH OF COMMON
PDLST: BLOCK PDLSIZ
F.C: BLOCK 1
BLOCK 1 ;STORE N HERE
BLOCK 1 ;STORE X HERE
BLOCK 1 ;STORE H HERE
BLOCK 1 ;STORE S HERE
BLOCK 1 ;STORE R HERE
B.C: BLOCK 1
NAMPTR: BLOCK 1 ;POINTER TO PROGRAM NAME
IFN NAMESW,<
PRGNAM: BLOCK 1 ;STORE BINARY FILE NAME-USED TO MAKE SYSTAT MORE MEANINGFUL
>
IFN REENT,<
HIGHX: BLOCK 1
HIGHR: BLOCK 1 ;HOLD X AND R WHILE LOADING LOW SEG PIECES
LOWX: BLOCK 1
HVAL: BLOCK 1 ;ORG OF HIGH SEG>
HVAL1: BLOCK 1 ;ACTUAL ORG OF HIGH SEG
LOWR: BLOCK 1 ;HOLD X AND R WHILE LOADING HISEG PIECES
IFN COBSW,<LOD37.: BLOCK 1>
IFN DMNSW,<KORSP: BLOCK 1>
IFN LDAC,<BOTACS: BLOCK 1>
IFN WFWSW,<VARLNG: BLOCK 1
VARREL: BLOCK 1>
IFN SAILSW,<LIBFLS: BLOCK RELLEN*3
PRGFLS: BLOCK RELLEN*3>
IFN MONLOD,<
HIRES: BLOCK 1 ;HIGHEST RESIDENT LOADED ADDRESS+1
XRES: BLOCK 1 ;DISPLACEMENT OF RESIDENT PORTION OF LOADED IMAGE
XCUR: BLOCK 1 ;DISPLACEMENT OF CURRENT PORTION OF LOADED IMAGE (WINDOW)
DILADD: BLOCK 1 ;LOWEST ADDRESS IN CURRENT WINDOW
DIHADD: BLOCK 1 ;HIGHEST ADDRESS IN CURRENT WINDOW+1
DIEND: BLOCK 1 ;ADDRESS+1 OF TOP OF WINDOW BUFFER
CURSET: BLOCK 1 ;CURRENT USETI/USETO NUMBER
RESBLK: BLOCK 1 ;NUMBER OF BLOCKS IN RESIDENT PORTION
GENERI: BLOCK 1 ;NAME OF CURRENT F/S
>
IFN TENEX,<
NLSTGL: BLOCK 1 ;FLAG INHIBITS MULT. LIST OF UNDEF. GLOBALS>
PT1: BLOCK 1
IFN RPGSW,<
NONLOD: BLOCK 1
SVRPG: BLOCK 1
IFN TEMP,<
TMPFIL: BLOCK 2
TMPFLG: BLOCK 1>
>
OLDDEV: BLOCK 1 ;OLD DEVICE ON LIBRARY SEARCH
LSTDEV: BLOCK 1 ;LAST DEVICE BEFORE THIS ONE
IFN PP,<
PPPN: BLOCK 1 ;PERM PPN
PPN: BLOCK 1 ;TEMP PPN
PPNE: BLOCK 1
PPNV: BLOCK 1
PPNW: BLOCK 1
IFN SFDSW,<MYPPN: BLOCK 1 ;HOLD USER'S PPN
SFDADD: BLOCK 2 ;DEVICE AND SCAN SWITCH
SFD: BLOCK SFDSW+2 ;TEMP SFD BLOCK
PSFDAD: BLOCK 2 ;DEV AND SCAN SWITCH
PSFD: BLOCK SFDSW+2 ;PERM SFD BLOCK>
>
IFN B11SW,<
GLBCNT: BLOCK 1
HDSAV: BLOCK 1
HEADNM: BLOCK 1
LFTHSW: BLOCK 1
OPNUM: BLOCK 1
SVHWD: BLOCK 1
SVSAT: BLOCK 1
PPDB: BLOCK PPDL+1
>
HISTRT: BLOCK 1 ;JOBREL AT START OF LOADING
IFN L,<
LSPXIT: BLOCK 1
RINITL: BLOCK 1
OLDJR: BLOCK 1>
IFN SPCHN,<
LINKNR: BLOCK 1 ;CURRENT OVERLAY LINK NUMBER
CHNTAB: BLOCK 1 ;CHAIN VECTOR TABLE,, NEXT BLOCK
BEGOV: BLOCK 1 ;RELATIVE ADDRESS OF BEGINNING OF OVERLAY
CHNACN: BLOCK 1 ;RELATIVE POINTER FOR SAVED NAMPTR
>
TABCNT: BLOCK 1
LIMBO: BLOCK 1 ;WHERE OLD CHARS. ARE STORED
IFN DIDAL,<LSTBLK: BLOCK 1 ;POINTER TO LAST PROG LOADED>
IFN EXPAND,<ALWCOR: BLOCK 1 ;CORE AVAILABLE TO USER>
IFN ALGSW,<%OWN: BLOCK 1 ;ADDRESS OF ALGOL OWN AREA
OWNLNG: BLOCK 1 ;LENGTH OF OWN BLOCK>
IFN REENT,<SVBRKS: BLOCK 1 ;XWD HIGH,LOW (PROG BREAKS)>
IFN FORSW,<FORLIB: BLOCK 1 ;0=LIB40,1=FOROTS>
SUBTTL BUFFER HEADERS AND HEADER HEADERS
BUFO: BLOCK 1 ;CONSOLE INPUT HEADER HEADER
BUFO1: BLOCK 1
BUFO2: BLOCK 1
BUFI: BLOCK 1 ;CONSOLE OUTPUT HEADER HEADER
BUFI1: BLOCK 1
BUFI2: BLOCK 1
ABUF: BLOCK 1 ;AUXILIARY OUTPUT HEADER HEADER
ABUF1: BLOCK 1
ABUF2: BLOCK 1
BUFR: BLOCK 1 ;BINARY INPUT HEADER HEADER
BUFR1: BLOCK 1
BUFR2: BLOCK 1
DTIN: BLOCK 1 ;DECTAPE INPUT BLOCK
DTIN1: BLOCK 3
DTOUT: BLOCK 1 ;DECTAPE OUTPUT BLOCK
DTOUT1: BLOCK 3
IFN MONLOD,<
DIOUT:
IFE PURESW,<EXP .RBALC ;DISK IMAGE INPUT/OUTPUT BLOCK>
IFN PURESW,<BLOCK 1>
BLOCK 1
DIOUT1: BLOCK .RBEST-2 ;BIG WASTE OF SPACE IN ORDER TO PRE ALLOCATE SOME DISK
IFE PURESW,<EXP DALLOC ;PRE ALLOCATE SOME BLOCKS>
IFN PURESW,<BLOCK 1> ;.RBEST
BLOCK 1 ;.RBALC
>
TTY1: BLOCK TTYL ;TTY BUFFER AREA
BUF1: BLOCK BUFL ;LOAD BUFFER AREA
AUX: BLOCK ABUFL ;AUX BUFFER AREA
IFN MONLOD,<
LOLIST: BLOCK 2 ;IOLIST FOR LOW PART OF IMAGE
HILIST: BLOCK 2 ;IOLIST FOR HIGH (VIRTUAL) PART OF LOADED IMAGE
>
IFN RPGSW,<
CTLIN: BLOCK 3
CTLNAM: BLOCK 3
CTLBUF: BLOCK 203+1
>
SUBTTL FORTRAN DATA STORAGE
IFN STANSW,<PATCH: BLOCK 20 ;STANFORD HAS SEMI-INFINITE CORE>
SBRNAM: BLOCK 1
IFE K,<
TOPTAB: BLOCK 1 ;TOP OF TABLES
CTAB: BLOCK 1; COMMON
ATAB: BLOCK 1; ARRAYS
STAB: BLOCK 1; SCALARS
GSTAB: BLOCK 1; GLOBAL SUBPROGS
AOTAB: BLOCK 1; OFFSET ARRAYS
CCON: BLOCK 1; CONSTANTS
PTEMP: BLOCK 1; PERMANENT TEMPS
TTEMP: BLOCK 1; TEMPORARY TEMPS
IFN SPCHN,<
SAVBAS: BLOCK 1 ;HIGHEST RELATIVE ADDRESS IN PROGRAM>
COMBAS: BLOCK 1; BASE OF COMMON
LLC: BLOCK 1; PROGRAM ORIGIN
BITP: BLOCK 1; BIT POINTER
BITC: BLOCK 1; BIT COUNT
PLTP: BLOCK 1; PROGRAMMER LABEL TABLE
MLTP: BLOCK 1; MADE LABEL TABLE
SDS: BLOCK 1 ;START OF DATA STATEMENTS
SDSTP: BLOCK 1 ;START OF DATA STATEMENTS POINTER
BLKSIZ: BLOCK 1; BLOCK SIZE
MODIF: BLOCK 1; ADDRESS MODIFICATION +1
SVFORH: BLOCK 1 ;SAVE H WHILE LOADING F4 PROGRAMS
IOWDPP: BLOCK 2
CT1: BLOCK 1 ;TEMP FOR C
LTC: BLOCK 1
ITC: BLOCK 1
ENC: BLOCK 1
WCNT: BLOCK 1 ;DATA WORD COUNT
RCNT: BLOCK 1 ;DATA REPEAT COUNT
LTCTEM: BLOCK 1 ;TEMP FOR LTC
DWCT: BLOCK 1 ;DATA WORD COUNT
IFN MANTIS,<MNTSYM: BLOCK 1 ;HOLDS MANTIS AUX SYMBOL POINTER>
>
VAR ;DUMP VARIABLES
DATEND:! ;END OF AREA CLEARED ON INITIALIZATION
IFN PURESW,<RELOC>
SUBTTL REMAP UUO
IFN PURESW,<HHIGO: PHASE BUF1 ;DON'T NEED BUF1 NOW>
HIGO: CORE V, ;CORE UUO
JFCL ;NEVER FAILS
HINOGO:
IFN REENT,<MOVE D,HVAL ;GET CURRENT HIGH SEG TOP
CAMG D,HVAL1 ;ANYTHING LOADED IN HI-SEG
JRST HIRET ;NO
SUB D,HVAL1 ;SEE HOW MUCH
TRNE D,1777 ;JUST CROSSED A K BOUND?
JRST HIOK ;NO
HRRZ V,D ;LENGTH ONLY
ADD V,HISTRT ;PLUS BASE
CAMGE V,.JBREL ;WE MIGHT HAVE GOT 1K EXTRA
CORE V,
JFCL
HIOK: MOVE V,HISTRT ;NOW REMAP THE HISEG.
REMAP V, ;REMAP UUO.
JRST REMPFL ;FATAL ERROR.>
HIRET: IFN NAMESW,<
IFE TENEX,<MOVE W,CURNAM ;GET PROGRAM NAME>
IFN TENEX,<SKIPA W,.+1
'(PRIV)'>
SETNAM W, ;SET IT FOR VERSION WATCHING>
JRST 0 ;EXECUTE CODE IN ACC'S
IFN REENT,<
REMPFL: TTCALL 3,SEGMES ;PRINT SEGMES
EXIT ;AND DIE
SEGMES: ASCIZ /?REMAP FAILURE/
>
IFN PURESW,<HIGONE: DEPHASE>
SUBTTL LISP LOADER
;END HERE IF 1K LOADER REQUESTED.
IFN K,<IFE L,<END BEG>
IFN L,< XLIST ;THE LITERALS
LIT ;MUST DUMP NOW SO THEY GET OUTPUT
LIST
LODMAK: MOVEI A,LODMAK
MOVEM A,137 ;SET UP TO SAVE THE LISP LOADER
INIT 17
SIXBIT /DSK/
0
HALT
ENTER LMFILE
HALT
OUTPUT LMLST
STATZ 740000
HALT
RELEASE
EXIT
LMFILE: SIXBIT /LISP/
SIXBIT /LOD/
0
0
LMLST: IOWD 1,.+1 ;IOWD
IOWD LODMAK-LD+1,137 ;AND CORE IMAGE
0
END LODMAK>>
SUBTTL FORTRAN FOUR LOADER
F4LD: TLNE F,SKIPSW!FULLSW ;ARE WE IN SKIP MODE
JRST REJECT ;YES,DON'T LOAD ANY OF THIS
MOVEI W,-2(S); GENERATE TABLES
CAIG W,(H) ;NEED TO EXPAND?
IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
POPJ P,
JRST POPJM3]>
IFE EXPAND,< TLO F,FULLSW>
TLO N,F4SW; SET FORTRAN FOUR FLAG
HRRZ V,R; SET PROG BREAK INTO V
MOVEM V,LLC; SAVE FIRST WORD ADDRESS
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;
HRREI W,-^D36; BITS PER WORDUM
MOVEM W,BITC; BIT COUNT
PUSHJ P,BITWX ;MAKE SURE OF ENOUGH SPACE
MOVE W,[JRST ALLOVE] ;LAST DATA STATEMENT
MOVEM W,(S)
TEXTR: PUSHJ P,WORD; TEXT BY DEFAULT
HLRZ C,W
CAIN C,-1
JRST HEADER; HEADER
MOVEI C,1; RELOCATABLE
TLNN F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
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
TLNN F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
PUSHJ P,BITW; TYPE 0
JRST ABS
SUBTTL 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
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
SUBTTL STORE WORD AND SET BIT TABLE
BITW: MOVEM W,@X; STORE AWAY OFFSET
IDPB C,BITP; STORE BIT
AOSGE BITC; STEP BIT COUNT
AOJA V,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,(H)
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
AOJ V,; STEP LOADER LOCATION
BITWX: IFN REENT,<
TLNE F,HIPROG
JRST FORTHI>
CAIGE H,@X
MOVEI H,@X ;KEEP H SET RIGHT FOR HISEG STUFF
BITWX2: HRRZ T,MLTP
CAIG T,(H); OVERFLOW CHECK
IFE EXPAND,<TLO F,FULLSW>
IFN EXPAND,<PUSHJ P, [PUSHJ P,XPAND
POPJ P,
JRST POPJM3]>
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,(H)
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,(H)
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
IFN REENT,<
FORTHI: HRRZ T,.JBREL ;CHECK FOR CORE OVERFLOW
CAIGE T,@X
PUSHJ P,[PUSHJ P,HIEXP
POPJ P,
JRST POPJM3] ;CHECK AGAIN
JRST BITWX2>
SUBTTL PROCESS END CODE WORD
ENDS: PUSHJ P,WORD; GET STARTING ADDRESS
JUMPE W,ENDS1; NOT MAIN
ADDI W,(R); RELOCATION OFFSET
TLNE N,ISAFLG; IGNORE STARTING ADDRESS
JRST ENDS1
HRRZM W,STADDR ;STORE STARTING ADDRESS
IFN NAMESW,<MOVE W,NAMPTR ;GET POINTER
MOVE W,1(W) ;SET UP NAME
PUSHJ P,LDNAM
MOVE W,DTIN
MOVEM W,PRGNAM>
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
MOVEM H,SVFORH
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
IFN SPCHN,<MOVEM W,SAVBAS ;SAVE AS HIGHEST ADDRESS IN PROGRAM>
PUSHJ P,WORD; COMMON BLOCK SIZE
HRRZM W,BLKSIZ
JUMPE W,PASS2; NO COMMON
COMTOP: PUSHJ P,WORDPR ;GET A COMMON PAIR
TLNE F,SKIPSW!FULLSW ;IF SKIPPING
JRST COMCO1 ;DON'T USE
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
COMCO1: SOS BLKSIZ
SOSLE BLKSIZ
JRST COMTOP
JRST PASS2
COMYES: 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.
AOJA V,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
SUBTTL BEGIN HERE PASS2 TEXT PROCESSING
PASS2: ADDI V,(X)
IFN REENT,<TLNE F,HIPROG
HRRZ V,H>
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
IFE L,<IFN REENT,<TLNN F,HIPROG ;DON'T BOTHER IF IN HISEG, CHAIN NOT SMART ENOUGH>
TLOE N,PGM1 ;YES, IS THIS FIRST F4 PROG?
JRST NOPRG ;NO
HRR W,COMBAS ;YES, PLACE PROG BREAK IN LH
HRLM W,.JBCHN(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
MOVEI W,TABDIS; HEAD OF TABLE
HRLI W,-TABLNG ;SET UP FOR AOBJN
HLRZ T,(W); GET ENTRY
CAME T,C; CHECK
AOBJN W,.-2
JUMPGE W,LOAD4A ;RAN OUT OF ENTRIES
HRRZ W,(W); GET DISPATCH
LDB C,[POINT 12,@X,35]
JRST (W); DISPATCH
PASS2C: PUSHJ P,PASS2A
JRST PASS2B
JRST ENDTP
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
TABLNG==.-TABDIS
;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
IFN MANTIS,<CAIN W,770000; SPECIAL DEBUGGER DATA
JRST SPECBUG>
JRST LOAD4A; DATA STATEMENTS WILL GO HERE
TTR50: RADIX50 10,%TEMP.
PTR50: RADIX50 10,TEMP.
CNR50: RADIX50 10,CONST.
IFN MANTIS,<
SPECB: CAML W,.JBREL ;ROOM?
AOJA W,[CORE W, ;NO, GET IT
JRST MORCOR
JRST .+1] ;GOT IT
PUSHJ P,WORD ;GET SPECIAL DATA
MOVEM W,@MNTSYM ;DEPOSIT IT
SOSG BLKSIZ ;MORE?
JRST TEXTR ;NO
SPECBUG:TRNN N,MANTFL ;ARE WE LOADING MANTIS DATA?
JRST [PUSHJ P,WORD ;NO, READ A WORD
SOSG BLKSIZ ;AND IGNORE IT
JRST TEXTR ;BLOCK EXHAUSTED?
JRST @.] ;NO, LOOP
AOS W,MNTSYM ;STEP SPECIAL POINTER
SOJG W,SPECB ;LOOP IF SETUP ALREADY
HRRZ W,.JBREL ;SET IT UP NOW
MOVEM W,MNTSYM
JRST SPECBUG ;AND STEP IT>
SUBTTL 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: AOJ 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
TRNN W,7777 ;IGNORE SIX BITS ;U/O-LKS
JRST PSTA ;NO COMMON ;U/O-LKS
PUSHJ P,COMDID ;PROCESS COMMON
JRST PCOM1
COMDID: ANDI W,7777 ;IGNORE SIX BITS ;U/O-LKS
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
TRNN W,7777 ;IGNORE SIX BITS ;U/O-LKS
JRST NCO ;U/O-LKS
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
JRST .+2
PPLT: ADD C,PLTP
HRRZ C,(C)
JRST PCOMX
SYMXX: PUSH P,V
PUSHJ P,SYMPT
POP P,V
IFE REENT,<POPJ P,>
IFN REENT,<JRST RESTRX>
SWAPSY: MOVEI T,0; SET TO EXCHANGE DEFS
EXCH T,1(C); GET NAME
IFN MANTIS,<TRNE N,MANTFL ;LOADING MANTIS DATA?
SKIPA C,(C) ;YES, GET FULLWORD VALUE>
HRRZ C,(C) ;GET HALFWORD 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
POPJ P,
JRST TBLCHK]>
POPJ P,
SUBTTL END OF PASS2
ALLOVE: TLZ N,F4SW ;END OF F4 PROG
HRRZ V,SDSTP ;GET READY TO ZERO OUT DATA STMTS
SETZM (V) ;AT LEAST ONE THERE
CAIL V,(S) ;IS THERE MORE THAN ONE??
JRST NOMODS ;NO
HRLS V
ADDI V,1 ;SET UP BLT
BLT V,(S) ;ZERO OUT ALL OF IT
NOMODS: MOVE H,SVFORH
TLNE F,FULLSW!SKIPSW
JRST HIGH3A
HRR R,COMBAS ;TOP OF THE DATA
CAMG H,SDS ;HIGHEST LOC GREATER THAN DATA STATEMENTS?
JRST HIGH3A ;NO, RETURN
ADDI H,1(S) ;YES, SET UP MEANINGFUL ERROR COMMENT
SUB H,SDS ;...
TLO F,FULLSW ;INDICATE OVERFLO
HIGH3A: IFN REENT,<SETZ W, ;CAUSES TROUBLE OTHERWISE
TLZE F,HIPROG
JRST HIGHN1
IFE SPCHN,<HRRZ V,GSTAB>
IFN SPCHN,<HRRZ V,SAVBAS ;GET END OF PROGRAM RELATIVE ADDRESS
;THIS MEANS THAT WITH SPECIAL CHAINING THE
;ENTIRE LAST PROGRAM OF A LINK WILL BE SAVED
;BUT COMMON DECLARED FOR THE FIRST TIME
;IN THAT PROGRAM WON'T BE. THIS SHOULD NOT
;CAUSE PROBLEMS BECAUSE IF COMMON APPEARS HERE
;NOBODY ELSE CAN REFERENCE IT ANYWAY. >
MOVEI V,@X
CAMLE V,HILOW
MOVEM V,HILOW>
HRRZ C,R
JRST HIGH31 ;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,(H)
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
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: IFE L,<IFN REENT,<
TLNN F,HIPROG>
TLOE N,BLKD1 ;IS THIS FIRST BLOCK DATA?
JRST ENDTP ;NO
HRR V,COMBAS ;PLACE PROG BREAK IN RH FOR
HRRM V,.JBCHN(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; OVERLAP CHECK
AOJA V,ENDTP0
ENDTP2: SETZM PT1
ENDTPW: HRRZ V,SDSTP
IFN EXPAND,<IFN REENT,<TLNE F,HIPROG
JRST ENDTPI>
SUBI V,(X)
CAMG V,COMBAS
PUSHJ P,[SUB V,COMBAS
MOVNS V
JRST XPAND9]
JFCL ;FOR ERROR RETURN FROM XPAND
ENDTPH: 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
AOJ V,
ADD W,@X; ITEMS COUNT
MOVEM W,ITC
MOVE W,[MOVEM W,LTC]
MOVEM W,@X; SETUP FOR DATA EXECUTION
AOJ V,
MOVSI W,(MOVEI W,0)
EXCH W,@X
MOVEM W,ENC; END COUNT
AOJ 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
JUMPE T,FORCNF
SUB T,PT1; SUBTRACT INDUCTION NUMBER
ASH T,1
SUBI T,1
HRRM T,@X
HLRZ T,@X
ADDI T,P
HRLM T,@X
AOJA V,LOOP
IFN EXPAND,<IFN REENT,<
ENDTPI: HRRZ V,COMBAS
MOVEI V,@X
CAMLE V,.JBREL
JRST [PUSHJ P,HIEXP
JRST ENDTPH
JRST ENDTPI]
JRST ENDTPH>>
FORCNF: ERROR ,</FORTRAN CONFUSED ABOUT DATA STATEMENTS!/>
JRST ILC1
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
AOJ V,
TLO N,SYDAT
PUSHJ P,PROC; PROCESS THE TAG
JUMPGE V,DATAOV ;DATA STATEMENT BELOW CODE TOP
JRST LOOP ;PROPER RETURN
DOINT.: POP P,V; GET ADDRESS OF INITIAL VALUE
PUSH P,(V); STORE INDUCTION VARIABLE
AOJ V,
PUSH P,V; INITIAL ADDRESS
JRST (V)
DOEND.: HLRE T,@(P) ;RETAIN SIGN OF INCREMENT
ADDM T,-2(P); INCREMENT
HRRE T,@(P); GET FINAL VALUE
SUB T,-2(P) ;FINAL - CURRENT
IMUL T,@(P) ;INCLUDE SIGN OF INCREMENT
JUMPL T,DODONE ;SIGN IS ONLY IMPORTANT THING
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
HRRZ C,SDS
IFE EXPAND,<SUBI C,(X) ;CHECK FOR ROOM
CAMGE C,COMBAS ;IS IT THERE
TLO F,FULLSW ;NO (DONE EARLIER IF EXPAND)
HRRZ C,SDS>
SUBI C,1 ;GET ONE LESS (TOP LOCATION TO ZERO)
IFN REENT,<TLNE F,HIPROG
MOVE C,.JBREL>
SECZER: CAMLE W,C ;ANY DATA TO ZERO?
JRST @SDS ;NO, DO DATA STATEMENTS
;FULLSW IS ON IF COMBAS GT. SDS
TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO?
SETZM (W) ;YES, DO SO
TLON N,DZER ;GO BACK FOR MORE?
AOJA W,SECZER ;YES, PLEASE
HRLI W,-1(W) ;SET UP BLT POINTER TO ZERO DATA
TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO?
BLT W,(C) ;YES, DO SO
JRST @SDS ;GO DO DATA STATEMENTS
DATAOV: ERROR 0,</DATA STATEMENT OVERFLOW!/>
JRST ILC1
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
HRRZS T
ADDI T,(W); OFFSET
IFN REENT,<HRRZS T ;CLEAR LEFT HALF INCASE OF CARRY
CAML T,HVAL1
JRST [ADD T,HIGHX
HRRZS T ;MUST GET RID OF LEFT HALF
CAMLE T,.JBREL
JRST DATAOV ;IN CASE FORTRAN GOOFS ON LIMITS
JRST DWFS.1]
ADD T,LOWX>
HRRZS T
IFE REENT,<ADDI T,(X)>
CAML T,SDS
JRST DATAOV
DWFS.1: PUSHJ P,DREAD ;GET A DATA WORD
HRRZS T
IFN REENT,<CAMG T,.JBREL ;JUST TO MAKE SURE>
CAMN T,SDS
JRST DATAOV
TLNN F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM?
MOVEM W,(T) ;YES, STORE IT
SOSE W,DWCT; STEP DOWN AND TEST
AOJA T,DWFS.1 ;ONE MORE TIME, MOZART BABY!
POPJ P,
SUBTTL ROUTINE TO SKIP FORTRAN OUTPUT
;SUBSECTION OF THE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. CODE TAKEN FROM FUDGE2.
MACHCD: HRRZ C,W ;GET THE WORD COUNT
PUSHJ P,WORD ;INPUT A WORD
SOJG C,.-1 ;LOOP BACK FOR REST OF THE BLOCK
;GO LOOK FOR NEXT BLOCK
REJECT: PUSHJ P,WORD ;READ A FORTRAN BLOCK HEADER
TLC W,-1 ;TURN ONES TO ZEROES IN LEFT HALF
TLNE W,-1 ;WAS LEFT HALF ALL ONES?
JRST REJECT ;NO, IT WAS CALCULATED MACHINE CODE
CAIN W,-2 ;YES, IS RIGHT HALF = 777776?
JRST ENDST ;YES, PROCESS F4 END BLOCK
LDB C,[POINT 6,W,23];GET CODE BITS FROM BITS 18-23
TRZ W,770000 ;THEN WIPE THEM OUT
CAIN C,77 ;IS IT SPECIAL DEBUGGER DATA?
JRST MACHCD ;YES, TREAT IT LIKE DATA
CAIE C,70 ;IS IT A DATA STATEMENT?
CAIN C,50 ;IS IT ABSOLUTE MACHINE CODE?
JRST MACHCD ;YES, TREAT IT LIKE DATA STATEMENTS
PUSHJ P,WORD ;NO, ITS A LABEL OF SOME SORT
JRST REJECT ;WHICH CONSISTS OF ONE WORD
;LOOK FOR NEXT BLOCK HEADER
ENDST: MOVEI C,1 ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
MOVEI T,6 ;TO GO
F4LUP1: PUSHJ P,WORD ;GET TABLE MEMBER
F4LUP3: SOJGE C,F4LUP1 ;LOOP WITHIN A TABLE
JUMPL T,LOAD1 ;LAST TABLE - RETURN
SOJG T,F4LUP2 ;FIRST TWO WORDS AND FIVE TABLES
JUMPE T,F4LUP1 ;COMMON LENGTH WORD
F4LUP2: PUSHJ P,WORD ;READ HEADER WORD
MOVE C,W ;COUNT TO COUNTER
JRST F4LUP3 ;STASH
SUBTTL LISP LOADER
IFE L,< END BEG>
IFN L,< XLIST
LIT
LIST
LODMAK: MOVEI A,LODMAK
MOVEM A,137 ;SET UP TO SAVE THE LISP LOADER
INIT 17
SIXBIT /DSK/
0
HALT
ENTER LMFILE
HALT
OUTPUT LMLST
STATZ 740000
HALT
RELEASE
EXIT
LMFILE: SIXBIT /LISP/
SIXBIT /LOD/
0
0
LMLST: IOWD 1,.+1 ;IOWD
IOWD LODMAK-LD+1,137 ;AND CORE IMAGE
0
END LODMAK>