Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0002/loader.mac
There are 9 other files named loader.mac in the archive. Click here to see a list.
COMMENT VALID 00113 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00010 00002 SUBTTL RP GRUEN/NGP/WFW/DMN V.052 7-SEP-70
C00014 00003 SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS
C00017 00004 SUBTTL ACCUMULATOR ASSIGNMENTS
C00019 00005 FLAGS F(0 - 17)
C00022 00006 MORE FLAGS IN F (18-35)
C00024 00007 IFE K,< TITLE LOADER - LOADS MACRO AND FORTRAN FOUR>
C00026 00008 SUBTTL CCL INITIALIZATION
C00029 00009 RPGS3: MOVEI CTLBUF
C00031 00010 SUBTTL NORMAL INITIALIZATION
C00039 00011 LOADER SCAN FOR FILE NAMES
C00045 00012 SUBTTL CHARACTER HANDLING
C00048 00013 OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>
C00053 00014 RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
C00056 00015 IFN SYMARG,<
C00059 00016 SUBTTL TERMINATION
C00064 00017 SUBTTL PRINT FINAL MESSAGE
C00070 00018 SUBTTL SET UP JOBDAT
C00083 00019 SUBTTL BLT SYMBOL TABLE INTO HIGH SEGMENT
C00087 00020 NOBLT: HRRZ Q,HILOW GET HIGHEST LOC LOADED
C00089 00021 SUBTTL WRITE DUMP FILE
C00092 00022 SUBTTL WRITE CHAIN FILES
C00095 00023 SUBTTL SPECIAL CHAINB
C00099 00024 SMTBFX: TLNE N,PPCSW IF NOT CUTTING BACK SYMBOL TABLE
C00104 00025 SUBTTL EXPAND CORE
C00107 00026 SUBTTL SWITCH HANDLING
C00108 00027 DISPATCH TABLE FOR SWITCHES
C00112 00028 PAIRED SWITCHES ( +,-)
C00115 00029 IFN REENT,< H SWITCH --- EITHER /H OR /NH
C00117 00030 SWITCH MODE NUMERIC ARGUMENT
C00119 00031 ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0
C00120 00032 SUBTTL CHARACTER CLASSIFICATION TABLE DESCRIPTION:
C00122 00033 BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE
C00125 00034 SUBTTL INITIALIZE LOADING OF A FILE
C00129 00035 SUBTTL LIBRARY SEARCH CONTROL AND LOADER CONTROL
C00132 00036 LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE
C00134 00037 IFN SAILSW,<
C00137 00038 SUBTTL LDDT LOADS <SYS:DDT.REL> AND SETS SYMSW
C00140 00039 SUBTTL EOF TERMINATES LOADING OF A FILE
C00142 00040 SUBTTL LOAD SUBROUTINE
C00145 00041 SUBTTL LOAD PROGRAMS AND DATA (BLOCK TYPE 1)
C00148 00042 SUBTTL LOAD SYMBOLS (BLOCK TYPE 2)
C00150 00043 LOCAL SYMBOL
C00153 00044 GLOBAL DEFINITION MATCHES REQUEST
C00156 00045 COMBINE TWO REQUEST CHAINS
C00159 00046 FIXWL: HRLZ T,W UPDATE VALUE OF LEFT HALF
C00161 00047 PATCH VALUES INTO CHAINED REQUEST
C00163 00048 SUBTTL HIGH-SEGMENT (BLOCK TYPE 3)
C00167 00049 SUBTTL HIGHEST RELOCATABLE POINT (BLOCK TYPE 5)
C00172 00050 SUBTTL EXPAND HIGH SEGMENT
C00174 00051 SUBTTL PROGRAM NAME (BLOCK TYPE 6)
C00177 00052 COMPILER TYPE - DO SPECIAL FUNCTION FOR IT
C00178 00053 SUBTTL STARTING ADDRESS (BLOCK TYPE 7)
C00179 00054 SUBTTL ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)
C00181 00055 SUBTTL LVAR FIX-UP (BLOCK TYPE 13)
C00184 00056 SUBTTL FAIL LOADER
C00189 00057 IFN FAILSW,< POLISH FIXUPS FOR FAIL (BLOCK TYPE 11)
C00194 00058 HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
C00196 00059 HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
C00199 00060 FINALLY WE GET TO STORE THIS MESS
C00202 00061 ALSTR1:
C00210 00062 POLSAT: PUSH P,C SAVE SYMBOL
C00215 00063 STRSAT: MOVE W,C GET VALUE TO STORE IN W
C00216 00064 SUBTTL LIBRARY INDEX (BLOCK TYPE 14)
C00219 00065 INDEX4: ADDM T,ABUF1
C00223 00066 THSBLK: SUB A,LSTBLK GET WORD DIFFERENCE
C00225 00067 SUBTTL ALGOL OWN BLOCK (TYPE 15)
C00228 00068 SUBTTL SAIL BLOCK TYPE 16 AND 17
C00230 00069 SUBTTL SYMBOL TABLE SEARCH SUBROUTINES
C00232 00070 SUBTTL RELOCATION AND BLOCK INPUT
C00235 00071 SUBTTL PRINT STORAGE MAP SUBROUTINE
C00240 00072 PRMP1A: PUSHJ P,TAB
C00244 00073 SUBTTL LIST UNDEFINED AND MULTIPLY DEFINED GLOBALS
C00246 00074 SUBTTL ENTER FILE ON AUXILIARY OUTPUT DEVICE
C00248 00075 SUBTTL PRINT SUBROUTINES
C00249 00076 IFN NAMESW,<
C00250 00077 ACCUMULATORS USED: Q,T,D
C00253 00078 SUBTTL SYMBOL PRINT - RADIX 50
C00255 00079 OTOD: IBP N
C00256 00080 SUBTTL ERROR MESSAGE PRINT SUBROUTINE
C00258 00081 ERRPT8: TLO F,FCONSW INSURE TTY OUTPUT
C00259 00082 SUBTTL INPUT - OUTPUT INTERFACE
C00261 00083 SUBTTL IMPURE CODE
C00262 00084 SUBTTL DATA STORAGE
C00264 00085 PT1: BLOCK 1
C00266 00086 SUBTTL BUFFER HEADERS AND HEADER HEADERS
C00268 00087 SUBTTL FORTRAN DATA STORAGE
C00270 00088 SUBTTL REMAP UUO
C00272 00089 SUBTTL LISP LOADER
C00273 00090 SUBTTL FORTRAN FOUR LOADER
C00275 00091 SUBTTL PROCESS TABLE ENTRIES
C00277 00092 SUBTTL STORE WORD AND SET BIT TABLE
C00280 00093 SUBTTL PROCESS END CODE WORD
C00285 00094 PRSTWX: PUSHJ P,WORDPR GET A WORD PAIR
C00286 00095 SUBTTL BEGIN HERE PASS2 TEXT PROCESSING
C00288 00096 TABDIS: XWD 11,PCONS CONSTANTS
C00290 00097 SUBTTL ROUTINES TO PROCESS POINTERS
C00293 00098 NCO: PUSHJ P,SWAPSY
C00295 00099 SWAPSY: MOVEI T,0 SET TO EXCHANGE DEFS
C00296 00100 SUBTTL END OF PASS2
C00299 00101 FBLKD: TLOE N,BLKD1 IS THIS FIRST BLOCK DATA?
C00303 00102 CONPOL: ADD T,ITC CONSTANT BASE
C00305 00103 DODONE: POP P,-1(P) BACK UP ADDRESS
C00307 00104 DREAD: TLNE N,RCF NEW REPEAT COUNT NEEDED
C00309 00105 SUBTTL ROUTINE TO SKIP FORTRAN OUTPUT
C00312 00106 SUBTTL LISP LOADER
C00313 00107 SYMSRT - SORT SYMBOL TABLE FOR RAID
C00319 00108 SYMSRT
C00322 00109 NOW, HOW BIG IS SYMBOL TABLE GOING TO BE?
C00325 00110 PASS 2 - COPY SYMBOL NAMES TO NEW SYMBOL TABLE. BUILD BN/BS AREAS
C00329 00111 WE SORT THINGS HERE
C00333 00112 CALL WITH 2=FIRST ADDRESS IN RANGE, 3=ADDRESS OF LAST ITEM IN RANGE
C00336 00113 SYLPOP: HRL 6,PD PD COPIED TO LH OR ARGUMENT
C00338 ENDMK
C;
SUBTTL RP GRUEN/NGP/WFW/DMN V.052 7-SEP-70
; RFS 11-30-70
; TURNED ON FAILSW,SAILSW FOR NIH USAGE.
; DCS 1-24-71
; ADDITIONS FOR SAIL (SHARED EXECS, UPDATED STANSW)
; REG 7-17-71
; TURN ON REENT FEATURES
; REG 3-23-74
; MOVED BLOCK TYPES 15 AND 16 TO 16 AND 17
; REG 2-20-75
; ADDED SORTSY SWITCH, ETC.
; TVR 30-AUG-75
; TURNED OFF SORTSY FOR LISP LOADER
VLOADER==52
VPATCH==0 ;DEC PATCH LEVEL
VCUSTOM==<SIXBIT / SG1/> ;NON-DEC PATCH LEVEL
;SAISEG VERSION 1
LOC <JOBVER==137>
XWD VCUSTOM,VLOADER+1000*VPATCH
RELOC
COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)
SWITCHES ON (NON-ZERO) IN DEC VERSION
SEG2SW GIVES TWO SEGMENT CODE (IF MACRO ALLOWS IT)
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 #
DIDAL GIVES DIRECT ACCESS LIBRARY SEARCH MODE
ALGSW WILL LOAD ALGOL OWN BLOCK (TYPE 15)
SWITCHES OFF (ZERO) IN DEC VERSION
K GIVES 1KLOADER - NO F4
L FOR LISP LOADER
SPMON GIVES SPMON LOADER (MONITOR LOADER)
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
SAILSW GIVES BLOCK TYPE 15 (FORCE LOAD OF REL FILES)
AND 16 (FORCE SEARCH OF LIBRARIES) FOR SAIL
SORTSY SORTS SYMBOL TABLE FOR RAID ON XXX COMMAND SWITCH
SILENT FORCES LISP LOADER TO BE SILENT
*
COMMENT/
AT STANFORD WE USE
STANSW, SAILSW, FAILSW, SORTSY, AND REENT ALL ON
L,ALGSW, PURESW AND SEG2SW ALL OFF
/
STANSW==1
SAILSW==1
FAILSW==1
REENT==1
ALGSW==0
PURESW==0
SEG2SW==0
SORTSY==1
SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS
IFNDEF SPMON,<SPMON=0>
IFN SPMON,< TEN30==1
K==1>
IFNDEF L,<L=0>
IFNDEF SILENT,<SILENT=0>
IFNDEF TEN30,<TEN30=0>
IFN TEN30!L,< RPGSW=0
PP=0
IFNDEF DMNSW,< DMNSW=0>
DIDAL==1
IFNDEF DIDAL,< DIDAL=0>
ALGSW=0
PURESW=0
REENT=0
LDAC=0
KUTSW=0
SEG2SW=0
NAMESW=0>
IFN TEN30,< EXPAND=0>
IFNDEF SORTSY,<SORTSY==0>
IFNDEF K,<K=0>
STANSW==1
IFNDEF STANSW,<STANSW=0>
IFN STANSW,< FAILSW=1
TEMP==1
REENT==1>
IFNDEF LNSSW,<LNSSW=0>
IFN LNSSW,<LDAC=1
PP=0>
FAILSW==1
IFNDEF FAILSW,<FAILSW=0>
IFNDEF RPGSW,<RPGSW==1>
IFN RPGSW,<PP==1> ;REQUIRE DISK FOR CCL
IFE RPGSW,<TEMP=0>
IFNDEF PP,<PP==1>
IFN L,<PP==1
SORTSY==0>
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==20>
IFN LDAC,<IFG 20-SYMPAT,<SYMPAT==20>>>
IFNDEF REENT,<REENT==1>
IFE REENT,<PURESW=0
SEG2SW=0>
IFG STANSW,<SEG2SW==0
PURESW==0>
IFDEF TWOSEG,<IFNDEF SEG2SW,<SEG2SW==1>>
IFNDEF SEG2SW,<SEG2SW==0>
IFN SEG2SW,<PURESW==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==0>
SAILSW==1
IFNDEF SAILSW,<SAILSW==0>
IFN SORTSY,<SORTSY==1> ;NORMALIZE TO 1 OR 0 SEE LD9
SUBTTL ACCUMULATOR ASSIGNMENTS
F=0 ;FLAGS IN BOTH HALVES OF F
N=1 ;FLAGS IN LH, PROGRAM NAME POINTER IN RH
X=2 ;LOADER OFFSET
H=3 ;HIGHEST LOC LOADED
S=4 ;UNDEFINED POINTER
R=5 ;RELOCATION CONSTANT
B=6 ;SYMBOL TABLE POINTER
D=7
T=10
V=T+1
W=12 ;VALUE
C=W+1 ;SYMBOL
E=C+1 ;DATA WORD COUNTER
Q=15 ;RELOCATION BITS
A=Q+1 ;SYMBOL SEARCH POINTER
P=17 ;PUSHDOWN POINTER
;MONITOR LOCATIONS IN THE USER AREA
JOBDA==140
JOBHDA==10
EXTERN JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41
IFN REENT,< EXTERN JOBHRL,JOBCOR>
IFE K,<EXTERN JOBCHN ;RH = PROG BREAK OF FIRST BLOCK DATA
;LH = PROG BREAK OF FIRST F4 PROG>
IFN RPGSW,< EXTERN JOBERR>
IFN LDAC,< EXTERN JOBBLT>
IFN FAILSW,< EXTERN JOBAPR>
NEGOFF==400 ;NEGATIVE OFFSET OF HIGH SEGMENT
IFN FAILSW,<;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS
PPDL==60>
;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
IFN REENT,<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
NAMSSW==10000 ;NAME BLOCK HAS BEEN SEEN FOR THIS PROG
ISW==20000 ;ON - DO NOT PERFORM INIT
SYMSW==40000 ;ON - LOAD LOCAL SYMBOLS
DSW==100000 ;ON - CHAR IN IDENTIFIER
NSW==200000 ;ON - SUPPRESS LIBRARY SEARCH
SSW==400000 ;ON - SWITCH MODE
;FLAGS N(0 - 17)
ALLFLG==1 ;ON - LIST ALL GLOBALS
ISAFLG==2 ;ON - IGNORE STARTING ADDRESSES
COMFLG==4 ;ON - SIZE OF COMMON SET
IFE K,< F4SW==10 ;F4 IN PROGRESS
RCF==20 ;READ DATA COUNT
SYDAT==40; SYMBOL IN DATA>
SLASH==100 ;SLASH SEEN
IFE K,< BLKD1==200 ;ON- FIRST BLOCK DATA SEEN
PGM1==400 ;ON FIRST F4 PROG SEEN
DZER==1000 ;ON - ZERO SECOND DATA WORD>
EXEQSW==2000 ;IMMEDIATE EXECUTION
DDSW==4000 ;GO TO DDT
IFN RPGSW,<RPGF==10000 ;IN RPG MODE>
AUXSWI==20000 ;ON - AUX. DEVICE INITIALIZED
AUXSWE==40000 ;ON - AUX. DEVICE ENTERED
IFN PP,<PPSW==100000 ;ON - READING PROJ-PROG #>
IFN PP!SPCHN,<PPCSW==200000 ;ON - READING PROJ #>
IFN FAILSW,<HSW==400000 ;USED IN BLOCK 11 POLISH FIXUPS>
;MORE FLAGS IN F (18-35)
IFN REENT,<
SEENHI==1 ;HAVE SEEN HI STUFF
NOHI==2 ;LOAD AS NON-REENTRANT>
IFN RPGSW,<NOTTTY==4 ;DEV "TTY" IS NOT A TTY>
NOHI6==10 ;PDP-6 TYPE SYSTEM
IFN DMNSW,<HISYM==20 ;BLT SYMBOLS INTO HIGH SEGMENT>
SEGFL==40 ;LOAD INTO HI-SEG>
IFN DIDAL,<XFLG==100 ;INDEX IN CORE (BLOCK TYPE 14)
LSTLOD==200 ;LAST PROG WAS LOADED
DTAFLG==400 ;LIBRARY DEVICE IS A DTA (NEEDED FOR INDEXING)>
IFN DMNSW,<DMNFLG==1000> ;SYMBOL TABLE TO BE MOVED DOWN
IFN REENT,<VFLG==2000 ;DO LIB SEARCH OF IMP40.REL BEFORE LIB40>
IFN SYMARG,<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
IFE K,<F4FL==400000 ;FORTRAN SEEN>
COBFL==200000 ;COBOL SEEN
IFN ALGSW,<ALGFL==100000 ;ALGOL SEEN>
DEFINE ERROR (X,Y)<
JSP A,ERRPT'X
SIXBIT Y>
IFE K,< TITLE LOADER - LOADS MACRO AND FORTRAN FOUR>
IFN K,< TITLE 1KLOAD - LOADS MACRO>
IFN PURESW,<
IFE SEG2SW,<HISEG>
IFN SEG2SW,<TWOSEGMENTS
RELOC 400000>>
IFN SPCHN,<
DSKBLK==200 ;LENGTH OF DISK BLOCKS
VECLEN==^D25 ;LENGTH OF VECTOR TABLE FOR OVERLAYS>
IFN SAILSW,<
RELLEN==^D40 ;#NUMBER OF REL FILES OR LIBRARIES (MUST BE SAME)>
;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]
IFE STANSW,<
OPDEF SETNAM [CALLI 43]
>
IFN STANSW,<
OPDEF SETNAM [CALLI 400002]
OPDEF SHOWIT [CALLI 400011]
>
OPDEF TMPCOR [CALLI 44]
MLON
IFDEF SALL,< SALL>
SUBTTL CCL INITIALIZATION
IFN RPGSW,<
BEG: JRST LD ;NORMAL INITIALIZATION
RPGSET: 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,(SIXBIT /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
SETZM NONLOD ;NOT YET STARTED SCAN
JRST RPGS3C ;GET BACK IN MAIN STREAM
RPGTMP: SETZM TMPFLG ;MARK AS NOT TMP >;IFN TEMP
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?
HLLZ N+2 ;YES.
HRRI 'LOA' ;LOADER NAME PART OF FILE NAME.
MOVEM CTLNAM
MOVSI 'TMP' ;AND EXTENSION.
MOVEM CTLNAM+1
SETZM CTLNAM+3
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
SETZM CTLNAM+3 ;(FOR STANFORD, MAKE THE PPN MATCH)
RENAME 16,CTLNAM
JFCL ;IGNORE FAILURE
RPGS3B: RELEASE 16, ;GET RID OF DEVICE
RPGS3A: SETZM NONLOD ;TO INDICATE WE HAVE NOT YET STARTED TO SCAN
;COMMAND IN FILE.
RPGS3: MOVEI CTLBUF
MOVEM JOBFF
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,JOBREL
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.
>
SUBTTL NORMAL INITIALIZATION
LD:
IFE RPGSW,<
BEG: >;RPGSW
IFN L,< HRRZM 0,LSPXIT
HRRZM W,LSPREL ;BY TVR AFTER DBA AFTER JRA FOR UCI
MOVEI 0,0
HRRZM R,RINITL
IFN SILENT,<
MOVEM N,INBYTP ;SAVE BYTE POINTER
MOVEM S,INBYTC ;AND THE BYTE COUNT
>
RESET >;IFN L
IFE L,<
IFN RPGSW,< HLLZS JOBERR ;MAKE SURE ITS CLEAR.>;RPGSW
RESET ;INITIALIZE THIS JOB
NUTS: SETZ N, ;CLEAR N
CTLSET: SETZB F,S ;CLEAR THESE AS WELL
HLRZ X,JOBSA ;TOP OF LOADER
HRLI X,V ;PUT IN INDEX
HRRZI H,JOBDA(X) ;PROGRAM BREAK
MOVE R,[XWD W,JOBDA] ;INITIAL RELOCATION >;IFE L
IFN SORTSY,< SETZM DOSORT> ;INITIALLY, DON'T SORT SYMBOLS
MOVSI E,(SIXBIT /TTY/)
DEVCHR E,
TLNN E,10 ;IS IT A REAL TTY?
IFE RPGSW,< EXIT >;NO, EXIT IF NOT TTY. ;NOT RPGSW
IFN RPGSW,<JRST [TLNN F,RPGF ;IN CCL MODE?
EXIT ;NO, EXIT IF NOT TTY
TRO F,NOTTTY ;SET FLAG
JRST LD1] ;SKIP INIT >;RPGSW
INIT 3,1 ;INITIALIZE CONSOLE
'TTY '
XWD BUFO,BUFI
CALLEX: EXIT ;DEVICE ERROR, FATAL TO JOB
MOVEI E,TTY1
MOVEM E,JOBFF
INBUF 3,1
OUTBUF 3,1 ;INITIALIZE OUTPUT BUFFERS
OUTPUT 3, ;DO INITIAL REDUNDANT OUTPUT
IFE L,<
LD1: HRRZ B,JOBREL ;MUST BE JOBREL FOR LOADING REENTRANT
HRRZM B,HISTRT
SUBI B,2 ;INITIALIZE SYMBOL TABLE POINTER
CAILE H,1(B) ;TEST CORE ALLOCATION
JRST [HRRZ B,JOBREL;TOP OF CORE
ADDI B,2000 ;1K MORE
CORE B, ;TRY TO GET IT
EXIT ;INSUFFICIENT CORE, FATAL TO JOB
JRST LD1] ;TRY AGAIN >;IFE L
IFN L,<
;The following has to lose in certain circumstances, since executing CORE UUO
;does not affect JOBSYM, hence will loop getting more core until the system
;has no more to offer, at which time it EXITs. --- TVR
;(Now prints error message - Feb76)
MOVE B,JOBSYM ;INSTEAD OF JOBREL FOR SYMBOL TABLE FIXUPS
TRNN B,1 ;MAKE IT POINT TO A FREE LOCATION
SUBI B,1 ;(just like JOBREL).
HRRZM B,HISTRT
SUBI B,2 ;INITIALIZE SYMBOL TABLE POINTER
CAILE H,1(B) ;TEST CORE ALLOCATION
JRST [OUTSTR [ASCIZ/
Error in LISP Loader: Called with H greater than JOBSYM. /]
HALT .] ;TRY AGAIN >;IFN L
IFN EXPAND,< IFE STANSW ,<SETZ S,
CORE S, ;GET PERMITTED CORE
JFCL
LSH S,12
SUBI S,1 ;CONVERT TO NUMBER OF WORDS
MOVEM S,ALWCOR ;SAVE IT FOR XPAND TEST>>
IFN STANSW,<
MOVEI S,-1 ;THERE IS ALWAYS CORE AT STANFORD!!
MOVEM S,ALWCOR >
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
HRRZ T,B ;Initialize pointer to end of globals
HRLI T,-2
MOVEM T,GLBEND
MOVEI T,GLBEND
MOVEM T,GLBENP ;AND POINTER POINTER
HRR N,B ;INITIALIZE PROGRAM NAME POINTER
IFE L,< HRRI R,JOBDA ;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
SETZM MDG ;MULTIPLY DEFINED GLOBAL COUNT
SETZM STADDR ;CLEAR STARTING ADDRESS
IFN REENT,<MOVSI W,1
MOVEM W,HVAL1
MOVEM W,HVAL
MOVEM X,LOWX
SETZM HILOW
MOVEM R,LOWR
HRRZI W,1
IFE STANSW,< SETUWP W, ;SETUWP UUO.
TRO F,NOHI6 ;PDP-6 COMES HERE.>
MOVEM F,F.C ;PDP-10 COMES HERE.>
IFE L,< IFN STANSW,< TRO F,DMNFLG ;ASSUME /B IS SAID...
MOVEM F,F.C ;AND SAVE>>
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 JOB41
MOVEM W,JOB41(X) ;...>
IFN L,< MOVE W,JOBREL
HRRZM W,OLDJR>
IFN SPCHN,<SETZM CHNACB ;USED AS DEV INITED FLAG TOO>
IFN NAMESW,<SETZM CURNAM>
IFN STANSW,<SETZM OPEN4+1 > ;EXISTENCE OF A DUMP DEVICE IS USED AS A FLAG
IFN FAILSW,<MOVEI W,440000 ;SET UP THE SPECIAL BITS OF HEADNUM(ADD+POLISH)
MOVEM W,HEADNM
SETZM POLSW ;SWITCH SAYS WE ARE DOING POLISH
MOVEI W,PDLOV ;ENABLE FOR PDL OV
MOVEM W,JOBAPR
MOVEI W,200000
CALLI W,16
SETZM LINKTB ;ZERO OUT TABLE OF LINKS
MOVE W,[XWD LINKTB,LINKTB+1]
BLT W,LINKTB+20>
IFN DMNSW,<MOVEI W,SYMPAT
MOVEM W,KORSP>
IFN KUTSW,< IFE STANSW,<SETOM CORSZ>>
IFN KUTSW,< IFN STANSW,<SETZM CORSZ>> ;ASSUME /K FOR KIDS...
IFN RPGSW,<JRST LD2Q>
LD2: IFN RPGSW,<MOVSI B,RPGF ;HERE ON ERRORS, TURN OFF RPG
ANDCAM B,F.C+N ;IN CORE>
;LOADER SCAN FOR FILE NAMES
LD2Q: MOVSI B,F.C ;RESTORE ACCUMULATORS
BLT B,B
MOVE P,PDLPT ;INITIALIZE PUSHDOWN LIST
SETZM BUFI2 ;CLEAR INPUT BUFFER POINTER
IFE PP,< SETZM ILD1 ;CLEAR INPUT DEVICE NAME>
IFN PP,< MOVSI T,(SIXBIT /DSK/) ;ASSUME DSK.
MOVEM T,ILD1
SETZM OLDDEV ;TO MAKE IT GO BACK AFTER /D FOR LIBSR>
SETZM DTIN ;CLEAR INPUT FILE NAME
LD2B: RELEAS 1, ;RELEASE BINARY INPUT DEVICE
IFN RPGSW,< TLNE N,RPGF ;NOT IF DOING CCL STUFF
JRST LD2BA>
IFN SILENT,<
SKIPE INBYTP ;DO WE HAVE CHARACTERS WAITING
JRST LD2BA ;IFSO, THEN SKIP THEM
>;IFN SILENT
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
LD2D: IFN PP,<SETZM PPN ;DON'T REMEMBER PPN FROM ONE FILE TO NEXT.
LD2DB: SKIPE W,OLDDEV ;RESET DEVICE IF NEEDED.
CAMN W,ILD1 ;IS IT SAME?
JRST LD2DA ;YES, FORGET IT.
TLZ F,ISW+DSW+FSW+REWSW
MOVEM W,ILD1>
LD2DA: MOVEI W,0 ;INITIALIZE IDENTIFIER SCAN
MOVEI E,6 ;INITIALIZE CHARACTER COUNTER
MOVE V,LSTPT ;INITIALIZE BYTE POINTER TO W
TLZ F,SSW+DSW+FSW ;LEAVE SWITCH MODE
LD3: IFN RPGSW,<TLNE N,RPGF ;CHECK RPG FEATURE
JRST RPGRD>
IFN SILENT,<SKIPE T,INBYTP
JRST BYTRD>
SOSG BUFI2 ;DECREMENT CHARACTER COUNTER
INPUT 3, ;FILL TTY BUFFER
ILDB T,BUFI1 ;LOAD T WITH NEXT CHARACTER
LD3AA: CAIN T,175 ;OLD ALTMOD
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
;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 RPGSW,<
RPGRD1: MOVNI T,5
ADDM T,CTLIN+2
AOS CTLIN+1
RPGRD: SOSG CTLIN+2 ;CHECK CHARACTER COUNT.
JRST [IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO READ DONE?
JRST LD2 ;YES, JUST LEAVE>
IN 17,0
JRST .+1
STATO 17,740000
JRST LD2
JSP A,ERRPT
SIXBIT /ERROR WHILE READING COMMAND FILE%/
JRST LD2]
IBP CTLIN+1 ;ADVANCE POINTER
MOVE T,@CTLIN+1 ;AND CHECK FOR LINE #
TRNE T,1
JRST RPGRD1
LDB T,CTLIN+1 ;GET CHR
JRST LD3AA ;PASS IT ON>
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 SILENT,<
BYTRD: SKIPN INBYTC ; ARE WE FINISHED?
JRST DONBYT ; YEP
ILDB T,INBYTP ; PICK UP THE CHARACTER FROM INPUT BYTE PTR IN T
SKIPN T ; END OF THE STRING?
JRST DONBYT ; NULLS TERMINATE THEM TOO
SOS INBYTC
JRST LD3AA
DONBYT: SETZM INBYTP ; FORCE TTY INPUT NEXT TIME
MOVEI T,33 ; NEW MODEL ALTMODE
JRST LD3AA
>
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,LD2D ;JUMP IF NULL DEVICE IDENTIFIER
MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER
IFN PP,<MOVEM W,OLDDEV ;WE HAVE A NEW ONE, DO IGNORE OLD.>
TLZ F,ISW+DSW+FSW+REWSW ;CLEAR OLD DEVICE FLAGS
JRST LD2D ;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 LD2D ;RETURN FOR NEXT IDENTIFIER
;INPUT SPECIFICATION DELIMITER <,>
LD5B:
IFN PP,<TLZE N,PPCSW ;READING PP #?
JRST [
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 LD2DB ];GET PROG NAME>
PUSHJ P,RBRA ;CHECK FOR MISSING RBRA>
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 <]>, OR '^'
LD5C:
IFN SPCHN!STANSW,<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
IFE STANSW,< JRST LD6A2]> ;READ NUMBERS AS SWITCHES
IFN STANSW,< JRST LD2DB]>
CAIN T,"]" ;END OF PP #?
JRST [PUSHJ P,RBRA ;PROCESS RIGHT BRACKET
JRST LD3] ;READ NEXT IDENT>
IFN STANSW,< CAIE T,"^" ;WRITE DMP FILE?
TDZA T,T ;NO. MUST BE "="
MOVEI T,SAVFIL-DTOUT > ;YES. SET OFFSET TO FILENAME BLOCK
IFE STANSW,< SETZ T,>
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
IFN STANSW,< JRST [MOVSI W,'MAP' ;ASSUME <.MAP> IN DEFAULT CASE
JUMPE T,.+1
MOVSI W,'DMP' ;USE DIFFERENT EXT. FOR DUMP FILES
JRST .+1] >
IFE STANSW,< MOVSI W,'MAP' > ;ASSUME <.MAP> IN DEFAULT CASE
MOVEM W,DTOUT1(T) ;STORE FILE EXTENSION IDENTIFIER
MOVE W,DTIN ;LOAD INPUT FILE IDENTIFIER
MOVEM W,DTOUT(T) ;USE AS OUTPUT FILE IDENTIFIER
IFN SPCHN,<MOVEM W,CHNENT ;AND FOR SPECAIL CHAINING>
IFN PP,<MOVE W,PPN ;PROJ-PROG #
MOVEM W,DTOUT+3(T) ;...>
MOVE W,ILD1 ;LOAD INPUT DEVICE IDENTIFIER
IFN STANSW,< JUMPN T,LD5S > ;DMP FILE USES DIFFERENT CHANNEL
MOVEM W,LD5C1 ;USE AS OUTPUT DEVICE IDENTIFIER
IFN PP,<SKIPE W,OLDDEV ;RESTORE OLD
MOVEM W,ILD1>
;INITIALIZE AUXILIARY OUTPUT DEVICE
TRZ F,TTYFL
TLZE N,AUXSWI+AUXSWE ;FLUSH CURRENT DEVICE
RELEASE 2, ;...
DEVCHR W, ;IS DEVICE A TTY?
TLNE W,10 ;...
JRST [TRO F,TTYFL ;TTY IS AUX. DEV.
JRST LD2D] ;YES, SKIP INIT
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,JOBFF
OUTBUF 2,1 ;INITIALIZE SINGLE BUFFER
TLO N,AUXSWI ;SET INITIALIZED FLAG
IFN LNSSW,<EXCH E,JOBFF
SUBI E,AUX
IDIV C,E
OUTBUF 2,(C)>
JRST LD2D ;RETURN TO CONTINUE SCAN
IFN STANSW,<
LD5S: CAMN W,[SIXBIT/SYS/] ;DON'T WRITE DUMP FILES ON SYS: !!!
MOVSI W,'DSK' ;(USE DSK: INSTEAD)
MOVEM W,OPEN4+1
IFN PP,<SKIPE W,OLDDEV ;RESTORE OLD DEVICE
MOVEM W,ILD1>
OPEN 4,OPEN4 ;KEEP IT PURE
JRST ILD5A
TLNE F,REWSW ;REWIND REQUESTED?
UTPCLR 4, ;DECTAPE REWIND
TLZE F,REWSW ;SKIP IF NO REWIND REQUESTED
MTAPE 4,1 ;REWIND THE AUX DEV
ENTER 4,SAVFIL
JRST LD5SFL
JRST LD2D
LD5SFL: ERROR ,</ENTER FAILED ON DUMP FILE@/>
JRST LD2 >
;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
IFN PP,<
RBRA: TLZN N,PPSW ;READING PP #?
POPJ P, ;NOPE, RETURN
TLZE N,PPCSW ;COMMA SEEN?
JRST LD7A ;NOPE, INDICATE ERROR
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,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>
IFN SYMARG,<
;CONVERT SYMBOL IN W TO RADIX-50 IN C
;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
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:
IFE SILENT,<
PUSHJ P,CRLF ;START A NEW LINE
>;IFE SILENT
IFN RPGSW,<RELEASE 17,0 ;RELEASE COMMAND DEVICE>
PUSHJ P,SASYM ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
MOVE W,[SIXBIT ?LOADER?] ;FINAL MESSAGE
PUSHJ P,BLTSET ;SETUP FOR FINAL BLT
IFN NAMESW,<HRRZ W,HISTRT ;IN CASE NO NAME SET, USE FIRST LOADED
MOVE W,-1(W)
SKIPN CURNAM
PUSHJ P,LDNAM
SKIPE W,CURNAM
CAMN W,[SIXBIT /MAIN/] ;FORTRAN MAIN PROG, OR MACRO NO TITLE
SKIPE W,PRGNAM ;USE BINARY FILE NAME IN EITHER CASE
MOVEM W,CURNAM
SETNAM W, ;SETNAME>
IFN L,< MOVE W,LSPREL ;BY TVR AFTER DBA AFTER JRA FOR UCI
RELEASE 1,0 ;Release .REL file channel (and avoid wonderful
;timing race whereby LISP gets clobbered by system
;reading in another buffer between the time the LOADER
;returns to LISP and LISP does a RESET. TVR Apr76
JRST @LSPXIT>
IFE L,< ;NONE OF THIS NEEDED FOR LISP
IFN STANSW,< SKIPE OPEN4+1 ;DUMP FILE TO BE MADE?
PUSHJ P,WRTSAV ;YES >
RELEASE 2, ;RELEASE AUX. DEV.
RELEASE 1,0 ;INPUT DEVICE
RELEASE 3,0 ;TTY
IFN SPCHN,<RELEASE 4,0 ;SPECIAL CHAINING CHANEL>
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,<TLNN N,RPGF ;IF IN RPG MODE
JRST LD5E2
HRRZ C,JOBERR ;CHECK FOR ERRORS
JUMPE C,LD5E2 ;NONE
EXDLTD: TTCALL 3,[ASCIZ /?EXECUTION DELETED
/]
JRST LD5E3>
LD5E2: HRRZ W,JOBSA(X)
TLNE N,DDSW ;SHOULD WE START DDT??
HRRZ W,JOBDDT(X)
IFN RPGSW,< TLNE N,RPGF ;IF IN RPG MODE
JUMPE W,[TTCALL 3,[ASCIZ /?NO STARTING ADDRESS
/]
JRST EXDLTD]>
JUMPE W,LD5E3 ;ANYTHING THERE?
TLOA W,(JRST) ;SET UP A JRST
LD5E3: SKIPA W,CALLEX ;NO OR NO EXECUTE, SET CALLI 12
TTCALL 3,[ASCIZ /EXECUTION
/]
IFN LDAC,< HRLZ P,BOTACS ;SET UP FOR ACBLT
MOVEM W,JOBBLT+1(X) ;SET JOBBLT
MOVE W,[BLT P,P]
MOVEM W,JOBBLT(X)>
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 REENT,<
MOVSI V,LD ;DOES IT HAVE HISEG
JUMPG V,HINOGO ;NO,DON'T DO CORE UUO
MOVSI V,1 ;SET HISEG CORE NON-ZERO
JRST HIGO ;AND GO>
IFE REENT,<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>
LSTAC: IFN LDAC,<JRST JOBBLT>
IFE LDAC,<EXIT>
DEPHASE
> ;;;;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,.+4 ;NO MESSAGE FROM CHAIN IN CCL@>>
IFE SILENT,<
PUSHJ P,FCRLF ;A RETURN
PUSHJ P,PWORD ;AND CHAIN OR LOADER
PUSHJ P,SPACE
>;IFN SILENT
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,JOBREL ;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,(R) ;IS DESIRED AMOUNT BIGGER THAN NEEDED
MINCUT: HRRZ C,R ;GET MIN AMOUNT
IORI C,1777 ;CONVERT TO A 1K MULTIPLE
IFN DMNSW,< TRNN F,DMNFLG ;DID WE MOVE SYMBOLS??
SKIPN JOBDDT(X) ;IF NOT IS DDT THERE??
JRST .+2>
IFE DMNSW,<SKIPE JOBDDT(X) ;IF NO SYMBOL MOVING JUST CHECK DDT>
JRST NOCUT ;DO NOT CUT IF SYMBOLS AT TOP AND DDT
NOCUT1: MOVEM C,JOBREL(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,JOBREL
SUB Q,OLDJR ;PROPER SIZE>
IFE SILENT,<
IFE L,<HRRZ Q,JOBREL(X)>
IFE STANSW,<LSH Q,-12 ;GET CORE SIZE TO PRINT>
IFN STANSW,<LSH Q,-11 ;GET CORE SIZE TO PRINT IN PAGES!>
ADDI Q,1
PUSHJ P,RCNUM
IFN REENT,<MOVE Q,HVAL
SUB Q,HVAL1
HRRZS Q
JUMPE Q,NOHY ;NO HIGH SEGMENT
MOVEI T,"+"-40 ;THERE IS A HISEG
PUSHJ P,TYPE
IFE STANSW,<LSH Q,-12 ;GET CORE SIZE TO PRINT>
IFN STANSW,<LSH Q,-11 ;GET CORE SIZE TO PRINT IN PAGES!>
ADDI Q,1
PUSHJ P,RCNUM
NOHY:>>
IFE STANSW,<MOVE W,[SIXBIT /K CORE/]>
IFN STANSW,<MOVE W,[SIXBIT / PAGES/]>
IFE SILENT,<
PUSHJ P,PWORD
PUSHJ P,CRLF
>
IFE L,<
IFN RPGSW,<TLNE N,RPGF
JRST NOMAX ;DO NOT PRINT EXTRA JUNK IN RPG MODE>
MOVE Q,JOBREL
LSH Q,-12
ADDI Q,1
PUSHJ P,RCNUM ;PRINT MAX LOW CORE SIZE
IFN REENT,< SKIPE Q,JOBHRL ;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 MAX/]
PUSHJ P,PWORD
IFN DMNSW,<TRNN F,DMNFLG>
SKIPN JOBDDT(X)
SKIPA Q,JOBREL(X)
MOVEI Q,1(S) ;FIND THE AMOUNT OF SPACE LEFT OVER
SUB Q,JOBFF(X)
PUSHJ P,RCNUM
MOVE W,[SIXBIT / WORDS/]
PUSHJ P,PWORD
MOVE W,[SIXBIT / FREE/]
PUSHJ P,PWORD
PUSHJ P,CRLF >
NOMAX:
IFE L,< MOVE W,JOBDDT(X) >
IFN L,< SKIPN W,JOBDDT ;Don't overwrite old setting of JOBDDT!
MOVE W,LSPDDT > ;JOBDDT has to be kept in a special place for LISP - TVR
SETDDT W,
IFE TEN30,<HRLI Q,20(X) ;SET UP BLT FOR CODE
HRRI Q,20>
IFN TEN30,<HRLI Q,JOBDDT(X)
HRRI Q,JOBDDT>
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>
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 F,ALGFL ;IF ALGOL PROG LOADED
PUSHJ P,SYMPT ;DEFINE %OWN>
IFN RPGSW,< HLRE A,S
MOVNS A
LSH A,-1
ADD A,JOBERR
HRRM A,JOBERR>
PUSHJ P,PMS1 ;PRINT UNDEFS
HRRZ A,H ;DON'T CLOBBER H IF STILL INSERTING SYMBOLS
SUBI A,(X) ;HIGHEST LOC LOADED INCLUDES LOC STMTS
CAILE A,(R) ;CHECK AGAINST R
HRR R,A ;AND USE LARGER
IFE L,< HRRZ A,STADDR ;GET STARTING ADDRESS
HRRM A,JOBSA(X) ;STORE STARTING ADDRESS
HRRZM R,JOBFF(X) ;AND CURRENT END OF PROG
HRLM R,JOBSA(X) >;IFE L
Comment $ By REG, intended for his future amusement
At this point, the core image of the loader looks as follows:
------------------------------
| Loader code, ddt |
| and symbols, if you're |
| so lucky to be debugging |
------------------------------ LOWX[ 11,,origin of lower in loader
| Low segment code that's | R [ 12,,highest address loaded in lower
| been loaded. |
| |
------------------------------
| some free space |
------------------------------ B [ -count,,first symbol address-1
| symbol table (old style) | (note the count is not the symbol table size!)
| | (but, B turns into an IOWD before calling symsrt)
| |
| | HISTRT [last loc in symbol table, addr of remap
------------------------------ HIGHX [ 11,,origin of upper in loader+400000
| High segment code | HVAL [ 12,,highest address in upper
| | HVAL1 [ 400000 = upper segment origin
------------------------------
| some free space |
------------------------------ JOBREL
After calling SYMSRT the core image looks like:
------------------------------
| Loader code, ddt |
| and symbols, if you're |
| so lucky to be debugging |
------------------------------ LOWX[ 11,,origin of lower in loader
| Low segment code that's | R [ 12,,highest address loaded in lower
| been loaded. |
| |
------------------------------
| some free space |
| |
| |
| |
------------------------------ HIGHX [ 11,,origin of upper in loader+400000
| High segment code | HVAL [ 12,,highest address in upper
| |
------------------------------
| some free space |
------------------------------ B [ IOWD for new symbol table
| symbol table (new style) | S [ 0,,address of symbols-1
| |
| |
------------------------------ JOBREL
If we're loading symbols into the upper, blt the symbols down adjacent to the top
of the code loaded in the upper. If we're loading symbols in the lower, and
there is an upper, we must make sure there's room between the lower and upper
for the new symbols to fit into. (If there's no room, BLT the upper and the
symbols up (a multiple of 1K) to make room for the symbols.) Then BLT the
symbols into the hole and cut back core size to flush the copy of the symbols
that are above the upper.
$
IFN DMNSW,< MOVE C,[RADIX50 44,PAT..] ;MARK PATCH SPACE FOR RPG
MOVEI W,(R)
SKIPE JOBDDT(X) ;BUT ONLY IF DDT LOADED
PUSHJ P,SYMPT
IFN REENT,< TRNE F,HISYM ;SHOULD SYMBOLS GO IN HISEG?
JRST BLTSYM ;YES>
>;IFN DMNSW
IFN DMNSW!LDAC,< ;ONLY ASSEMBLE IF EITHER SET
IFE LDAC,< TRNN F,DMNFLG ;GET EXTRA SPACE IF SYMBOLS
JRST NODDT ;MOVED OR IF LOADING ACS>;IFE LDAC
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 >;IFN LDAC
>;IFN DMNSW
ADDI A,(R) ;GET ACTUAL PLACE TO PUT END OF SPACE
ADDI A,(X)
CAIL A,(S) ;DO NOT OVERWRITE SYMBOLS
IFE EXPAND,< PUSHJ P,MORCOR >
IFN EXPAND,< JRST [PUSHJ P,XPAND
PUSHJ P,MORCOR
JRST .-1] >;IFN EXPAND
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 LDAC
>;IFN DMNSW!LDAC
IFN DMNSW,< TRNN F,DMNFLG ;NOW THE CODE TO MOVE SYMBOLS
JRST NODDT
HLLZ A,GLBEND ;INCLUDE LOCALS, ETC. IN SYMBOL TABLE
ADD B,A
IFN SORTSY,< PUSH P,[0] ;FLAG NOT TO SHRINK CORE AFTER SYMSORT
SKIPN DOSORT ;NEW FORMAT SYMBOL TABLE?
JRST NOSRTY ;NO
PUSHJ P,SYMSRT ;SORT SYMBOLS.
HRRZ Q,HVAL ;JOBREL OF HIGH SEGMENT
SUB Q,HVAL1 ;MINUS HIGH SEGMENT ORIGIN
HRRZ Q,Q
JUMPE Q,NOSRTY ;JUMP IF THERE'S NO HIGH SEGMENT TO WORRY
HRRZM B,0(P) ;STORE FLAG FOR SHRINKING CORE.
HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
ADD Q,B
HLROS Q
MOVNS Q ;Q_POSITIVE WORD COUNT OF ALL SYMBOLS
HRRZ A,R ;HIGHEST ADDRESS LOADED IN LOWER
ADD A,KORSP ;PLUS PATCH SPACE
ADDI A,(X) ;ABS ADDRESS IN LOADER'S CORE IMAGE.
ADDI Q,(A) ;Q_1+LAST ADDR. NEEDED FOR SYMBOLS.
HRRZ W,HIGHX ;RELOCATION OF HIGH SEGMENT
SUB W,HVAL1 ;MINUS ADDR OF ORIGIN = ABS ADDRESS OF HI
SUBI Q,(W) ;AMOUNT OF EXTRA ROOM NEEDED
JUMPLE Q,NOSRTY ;JUMP IF NO EXTRA ROOM IS NEEDED.
TRO Q,1777 ;ROUND UP TO A 1K BOUNDARY
ADDI Q,1
MOVE A,Q ;REMEMBER RELOCATION AMOUNT.
ADD Q,JOBREL
CORE Q,
JRST MORCOR ;LOSE.
PUSH P,A ;SAVE RELOCATION AMOUNT.
MOVE Q,JOBREL
SUBI Q,1777 ;FIRST DESTINATION ADDRESS
SRTBL1: MOVN A,(P) ;-AMOUNT ADDED
ADDI A,(Q) ;SOURCE ADDRESS
CAIGE A,(W) ;CONTINUE AS LONG AS SOURCE ADDRESS IS HIGH
JRST SRTBL2 ;DONE WITH BLTS.
MOVSI A,(A)
HRRI A,(Q)
BLT A,1777(Q) ;MOVE 1K UPWARDS
SUBI Q,2000 ;DECREMENT DESTINATION ADDRESS
JRST SRTBL1 ;SEE ABOUT MOVING ANOTHER 1K
SRTBL2: POP P,A ;AMOUNT WE MOVED THINGS
ADD B,A
ADD S,A ;ANNOUNCE WE MOVED THE SYMBOLS
ADDM A,HIGHX ;ALSO, WE MOVED THE UPPER.
ADDM A,HISTRT ;NEW ADDR FOR REMAP
ADDM A,(P) ;AND WE MOVED THE SHRINK BOUNDARY
>;IFN SORTSY
NOSRTY: HRRZ A,R ;HIGHEST ADDRESS LOADED IN LOWER
ADD A,KORSP ;PLUS PATCH SPACE
MOVE W,A ;SAVE RELATIVE DESTINATION
ADDI A,(X) ;DESTINATION OF BLT.
HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
ADD Q,B
HLROS Q
MOVNS Q ;POSITIVE WORD COUNT OF ALL SYMBOLS
ADDI Q,-1(A) ;GET PLACE TO STOP BLT
HRLI A,1(S) ;SOURCE OF BLT
SUBI W,1(S) ;DEST-SOURCE = AMT BY WHICH TO CHANGE S AND B
BLT A,(Q) ;MOVE SYMBOL TABLE
IFN SORTSY,< POP P,A
JUMPE A,NOSRTZ
CORE A, ;SHRINK CORE. REMOVE EXTRA COPY OF SYMBOL TABLE
JFCL ;THIS SHOULDN'T HAPPEN.
MOVEI A,1(Q) ;THIS THE FIRST ADDRESS PAST BLT
CAMLE A,HISTRT ;IS IT BELOW UPPER?
JRST NOSRTZ ;NO. (MUST BE RIGHT AT BOUNDARY)
SETZM 1(Q)
CAML A,HISTRT ;IS IT BELOW WORD BELOW UPPER?
JRST NOSRTZ ;NO. DON'T BLT
MOVSI A,1(Q) ;ZERO BETWEEN SYMBOLS AND HIGH SEGMENT
HRRI A,2(Q) ;
BLT A,@HISTRT
NOSRTZ:
>;IFN SORTSY
ADD S,W
ADD B,W ;CORRECT S AND B FOR MOVE (RELOCATED TO USER SPACE)
HRRI R,1(Q) ;SET R TO POINT TO END OF SYMBOLS
SUBI R,(X)
SKIPN JOBDDT(X) ;SKIP IF DDT IS LOADED
JRST NODDT ;NO DDT. DO LEAVE SYMBOLS.
HRRM R,JOBFF(X)
HRLM R,JOBSA(X) ;AND SAVE AWAY NEW JOBFF
IFN LDAC,< SKIPA >;SKIP THE ADD TO R
NODDT:
>;IFN DMNSW
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,JOBSYM(X)>
IFN L,< MOVEM A,JOBSYM>
MOVE A,S
ADDI A,1
IFN L,< MOVEM A,JOBUSY >
IFE L,< MOVEM A,JOBUSY(X)
MOVE A,HISTRT ;TAKE POSSIBLE REMAP INTO ACCOUNT
MOVEM A,JOBREL(X) ;SET UP FOR IMEDIATE EXECUTION
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,JOBCOR(X)
TRNN F,SEENHI
POPJ P,
HRRZ A,HVAL
HRRZM A,JOBHRL(X)
IFE STANSW,< SUB A,HVAL1 ;DON'T PUT SHIT IN LH AT STANFORD
HRLM A,JOBHRL(X)> ;IFE STANSW
>;IFN REENT
>;IFE L
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 A,GLBEND ;INCLUDE LOCALS, ETC. IN SYMBOL TABLE
ADD B,A
IFN SORTSY,< SKIPE DOSORT
PUSHJ P,SYMSRT >
HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
HLR S,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 ;IOWD TO ALL SYMBOLS
HLRO Q,Q ;-WC OF ALL SYMBOLS
MOVN Q,Q ;+WC OF ALL SYMS
ADD Q,HVAL ;ADD LENGTH OF HISEG
SUB Q,HVAL1 ;BUT REMOVE ORIGIN
ADD Q,HISTRT ;START OF HISEG IN CORE
HRRZ Q,Q ;Q=LAST PHYSICAL ADDR. NEEDED FOR SYMBOLS
;The following is a kludge to fix to a bug. If there's a new format symbol
;table and HVAL is so close to a 1K boundary that adding KORSP will put it
;over then the BLT at BLTSY0 will overlap the source and destination incorrectly.
;This is because the code assume the symbols are located entirely below the
;upper (in the loader's core image), whereas sorted symbols are located
;entirely above the upper.
;It should be fixed to BLT symbols up 1K before entering BLTSY0, but instead,
;since the symbol patch space isn't useful with new format, the problem is
;eliminated by not adding in KORSP.
IFN SORTSY,< SKIPE DOSORT
JRST BLTSY0 >
ADD Q,KORSP ;PLUS SPACE FOR SYMBOL PATCHES
CORE Q, ;EXPAND IF NEEDED
PUSHJ P,MORCOR
MOVE Q,JOBREL
BLTSY0: PUSH P,B ;SAVE B (IOWD TO SYMBOLS)
SOJ B, ;REMOVE CARRY FROM ADD TO FOLLOW. -WC,,ADDR-2
MOVSS B ;SWAP SYMBOL POINTER ADDR-2,,-WC
ADD B,Q ;ADDR-1,,FIRST DESTINATION OF BLT.
HRRM B,(P) ;SAVE NEW B (-WC,,FIRST DEST. OF BLT)
ADD B,S ;INCASE ANY UNDEFS. (S IS -WC,,-WC OF UNDEFS)
BLT B,(Q) ;MOVE SYMBOLS
POP P,B ;GET NEW B
SUB B,HISTRT ;MAKE IT RELATIVE TO OUR UPPER'S ORIGIN
ADD B,HVAL1 ;BUT ABS WITH RESPECT TO UPPER AFTER REMAP
SOJ B, ;REMOVE CARRY
ADDI S,(B) ;SET UP JOBUSY
BLTSY1: MOVE Q,JOBREL
SUB Q,HISTRT
ADD Q,HVAL1
SUBI Q,1 ;ONE TOO HIGH
MOVEM Q,HVAL
JRST NODDT
NOBLT: HRRZ Q,HILOW ;GET HIGHEST LOC LOADED
HRRZ A,S ;GET BOTTOM OF UNDF SYMBOLS
SUB A,KORSP ;DON'T FORGET PATCH SPACE
IORI A,1777 ;MAKE INTO A K BOUND
IORI Q,1777
CAIN 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
TRO F,SEENHI ;SO JOBHRL WILL BE SET UP
JRST BLTSY1 ;AND USE COMMON CODE
>
IFN DMNSW!LDAC,<
MORCOR: ERROR ,</MORE CORE NEEDED#/>
EXIT>
SUBTTL WRITE DUMP FILE
IFE STANSW,<XLIST>
IFN L,<XLIST> ;NONE OF THIS FOR LISP
IFN STANSW,< IFE L,<
HINAME=134 ;NOT KNOWN IN JOBDAT
HILOC=135
EXTERNAL JOBSAV,JOBS41
; SWAP UUO does not know about segments, so we have to fake it.
; Writes out core from JOBSAV+1(X) to JOBFF and the segment. The
; mess should be replaced with
; MOVSI V,SWPBLK
; SWAP V,
; HALT .
; And code at LD5S should be changed not to do OPEN and ENTER but
; rather put the args, into SWPBLK which should replace the block
; called SAVFIL. Then it will be done right.
WRTSAV: MOVE V,JOB41(X) ;SAVE JOB41
MOVEM V,JOBS41(X)
IFN KUTSW,< SKIPL V,CORSZ ;NEG MEANS DO NOT KUT BACK CORE
CAMGE V,JOBREL(X)
MOVE V,JOBREL(X)
MOVEM V,JOBCOR(X) ;GUARANTEE THIS MUCH WHEN LOADED >;KUTSW
SETZM HILOC(X) ;ASSUME NO SEGMENT.
SETZM IOWDPP+1
SETZM IOWDPP+2
MOVEI V,JOBSAV+1 ;-SIZE OF LOWER
SUB V,JOBFF(X)
ANDCMI V,1 ;MAKE SURE THAT THE WC IS EVEN! REG
HRLI V,JOBSAV(X) ;FIRST LOCATION OF SAVE
MOVSM V,IOWDPP
MOVE V,HVAL1 ;HIGH SEGMENT EXISTS?
SUB V,HVAL
JUMPE V,WRTSA2 ;NO
HRL V,HISTRT ;YES, MAKE IOWD
ANDCMI V,1 ;MAKE SURE THAT THE WC IS EVEN! REG
MOVSM V,IOWDPP+1
MOVE V,CURNAM ;SET SEGMENT NAME
MOVEM V,HINAME(X)
HLRO V,IOWDPP ;-WC OF LOWER.
MOVM V,V ;WC OF LOWER.
TRZE V,177 ;SKIP IF RECORD BOUNDARY.
ADDI V,200 ;ADVANCE TO NEXT RECORD
ADDI V,JOBSAV+1 ;CORE ADDRESS OF FIRST DISK RECORD THAT'S FREE
MOVEM V,HILOC(X) ;UPPER SEG ORGIN IN DMP FILE.
WRTSA2: OUT 4,IOWDPP
JRST WRTSA3 ;NO ERRORS
ERROR 0,</WRITE ERROR ON DUMP FILE@/>
RELEAS 4,
HALT CPOPJ
WRTSA3: PUSH P,Q ;SAVE Q (SETUP BY BLTSET)
RELEAS 4,
MOVE W,['SAVED ']
PUSHJ P,PWORD
MOVE W,OPEN4+1
PUSHJ P,PFWORD
MOVEI T,':'
PUSHJ P,TYPE
MOVE W,SAVFIL
PUSHJ P,PFWORD
MOVEI T,'.'
PUSHJ P,TYPE
HLLZ W,SAVFIL+1
PUSHJ P,PFWORD
POP P,Q
JRST CRLF
>> LIST
SUBTTL WRITE CHAIN FILES
IFE K,< ;DONT INCLUDE IN 1KLOAD
CHNC: SKIPA A,JOBCHN(X) ;CHAIN FROM BREAK OF FIRST BLOCK DATA
CHNR: HLR A,JOBCHN(X) ;CHAIN FROM BREAK OF FIRST F4 PROG
IFN ALGSW,<TRNE F,ALGFL ;IF ALGOL LOADING
POPJ P, ;JUST RETURN>
HRRZS A ;ONLY RIGHT HALF IS SIGNIFICANT
JUMPE A,LD7C ;DON'T CHAIN IF ZERO
TLNN N,AUXSWI ;IS THERE AN AUX DEV?
JRST LD7D ;NO, DON'T CHAIN
PUSH P,A ;SAVE WHEREFROM TO CHAIN
JUMPE D,.+2 ;STARTING ADDR SPECIFIED?
HRRZM D,STADDR ;USE IT
CLOSE 2, ;INSURE END OF MAP FILE
TLZ N,AUXSWI+AUXSWE ;INSURE NO PRINTED OUTPUT
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 JOBDDT(X) ;IF JOBDDT KEEP SYMBOLS
CAILE W,1(S)
JRST CHNLW1
HRRZ W,JOBREL ;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,JOBSYM(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,JOBCHN(X)
PUSH A,JOBSA(X) ;SETUP SIX WORD TABLE
PUSH A,JOBSYM(X) ;...
PUSH A,JOB41(X)
PUSH A,JOBDDT(X)
SETSTS 2,17 ;SET AUX DEV TO DUMP MODE
MOVSI W,435056 ;USE .CHN AS EXTENSION
MOVEM W,DTOUT1 ;...
PUSHJ P,IAD2 ;DO THE ENTER
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
IFE SPCHN,< XLIST >
IFN SPCHN,<
CHNBG:
PUSHJ P,FSCN1A ;FORCE SCAN TO COMPLETION FOR CURRENT FILE
TLNN N,AUXSWI ;IS THERE AN AUX DEV??
JRST LD7D
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
OPEN 4,CHNOUT ;OPEN FILE FOR CHAIN
JRST ILD5 ;CANT OPEN CHAIN FILE
ENTER 4,CHNENT ;ENTER CHAIN FILE
JRST IMD3 ;NO CAN DO
HRRZ W,N
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
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
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@/>
JRST LD2 ;GIVE UP
NOER: 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 R,(X) ;A GOOD GUESS>
SUBM A,W ;W=-LENGTH
SUBI A,1 ;SET TO BASE-1 (FOR IOWD)
HRL A,W ;GET COUNT
MOVEM A,IOWDPP
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
ADDI W,DSKBLK-1
IDIVI W,DSKBLK ;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
HRR N,W ;AND RESET IT
NOMVB: HRR R,BEGOV ;PICK UP BASE OF AREA
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,
>
LIST
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,JOBREL
ADDI Q,2000
XPAND1: PUSH P,H ;GET SOME REGISTERS TO USE
PUSH P,X
PUSH P,N
PUSH P,JOBREL ;SAVE PREVIOUS SIZE
CAMG Q,ALWCOR ;CHECK TO SEE IF RUNNING OVER
CORE Q,
JRST XPAND6
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 JOBREL
HRRZ Q,JOBREL;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,GLBEND ;It better not be in an AC when XPAND is called!!!
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
ADD N,H
IFE K,< TLNN N,F4SW ;F4?
JRST XPAND3
ADDM H,PLTP
ADDM H,BITP
ADDM H,SDSTP
ADDM H,MLTP
TLNE N,SYDAT
ADDM H,V>
XPAND3: AOSA -3(P)
XPAND5: POP P,N
POP P,X
POP P,H
POP P,Q
POPJ P,
XPAND6: POP P,A ;CLEAR JOBREL OUT OF STACK
ERROR ,</MORE CORE NEEDED#/>
JRST XPAND5
XPAND7: PUSHJ P,XPAND
JRST SFULLC
JRST POPJM2
XPAND9: PUSH P,Q ;SAVE Q
HRRZ Q,JOBREL ;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:
IFN STANSW,< CAIE T,"%" ;ACCEPT '%' AS WELL AS '/' >
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
JRST LD3 ;EAT A SWITCH
;ALPHABETIC CHARACTER, SWITCH MODE
LD6:
CAIL T,141 ;ACCEPT LOWER CASE SWITCHES
SUBI T,40
IFN SPCHN!STANSW,<XCT LD6B-74(T) ;EXECUTE SWITCH FUNCTION>
IFE SPCHN!STANSW,<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
COMMENT/
AT STANFORD MAP SWITCHES < TO H
AND > TO V (THIS WILL BE OVERRIDDEN IF SOMEONE TRIES SPCHN=1)
WHAT A CROCK: FW/
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
IFN SORTSY,<PUSHJ P,SETSRT;>JRST LD7B ;? - SORT SYMBOL TABLE (ELSE ERROR)
JRST LD7B ;@ - ERROR>;END IFN SPCHN
IFG STANSW-SPCHN,<PUSHJ P,HSET ;< BECOMES H
PUSHJ P,RHTCRK ;= - LOSING COMPATABILITY MODE (OLD SYMBOL FORMAT)
PUSHJ P,VSWTCH ;> BECOMES V
IFN SORTSY,<PUSHJ P,SETSRT;>JRST LD7B ;? - SORT SYMBOL TABLE (ELSE ERROR)
JRST LD7B>
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,LIBF ;F - LIBRARY SEARCH
PUSHJ P,LD5E ;G - GO INTO EXECUTION
IFE STANSW,<IFN REENT,< PUSHJ P,HSET ;H - REENTRANT. PROGRAM>
IFE REENT,<JFCL ;NOT REENT AND NOT STANFORD>>
IFN STANSW,<PUSHJ P,LDDTQX ;H - LOAD AND START RAID>
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,PMS ;U - PRINT UNDEFINED LIST
IFE STANSW,<IFN REENT,<PUSHJ P,VSWTCH ;V - LOAD REENTRANT LIB40>
IFE REENT,<JRST LD7B ;V -NO REENT, NO STANFORD: ERROR>>
IFN STANSW,<PUSHJ P,LDDTQ ;V - LOAD RAID>
TLZ F,SYMSW+RMSMSW ;W - LOAD WITHOUT SYMBOLS
TLZ N,ALLFLG ;X - DO NOT LIST ALL GLOBALS
IFE SAILSW,<
TLO F,REWSW ;Y - REWIND BEFORE USE
>
IFN SAILSW,<
PUSHJ P,SEGLOD ;Y - LOAD SYS:SAILOW FOR 2-SGMT SAIL
>
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,
IFN SORTSY,<
SETSRT: SETZM DOSORT ;ASSUME /-?
SKIPL D
SETOM DOSORT ;SET /? SEEN
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
TLZ F,SYMSW!RMSMSW ;DON'T
POPJ P,
IFN REENT,<
VSWTCH: JUMPL D,.+2 ;SKIP IF /-V
TROA F,VFLG ;SEARCH RE-ENTRANT LIBRARY
TRZ F,VFLG ;DON'T
POPJ P,>
IFN SAILSW,<
SEGLOD: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
HRRZ W,R ;CHECK LEGAL
CAILE W,140 ; (MUST BE NOTHING LOADED EARLIER)
JRST [ERROR ,<./Y MUST APPEAR BEFORE ANY FILES ARE LOADED`.>
JRST LD2] ;TRY AGAIN
MOVE W,[SIXBIT /SAILOW/] ;WILL LOAD SAILOW NOW
ADD W,D ;SAILOW, SAILOX, SAILOY, DEPENDING
;ON ARG -- W FOR SAIL, X FOR OSAIL, Y FOR NSAIL
TLZ F,SYMSW!RMSMSW ;SET SWITCHES (SEE LDDT)
PUSHJ P,LDDT1 ;SET SYS AS DEVICE, PREPARE
PUSHJ P,LDF ;LOAD SAILOW
POPJ P, ;AFRAID OF `JRST LDF'
>; END OF SEGMENT LOADING OPTION
IFN STANSW,< ;MAKE RUSSELL HAPPY BY DISTRIBUTING GLOBALS LIKE WE USED TO
RHTCRK: HLLZ C,GLBEND
ADD B,C ;INCLUDE CURRENT STUFF
HRRZS GLBEND ;NO MORE STUFF HERE
MOVEI C,B
MOVEM C,GLBENP ;NOW MAKE EVERYONE LOOK AT B INSTEAD
POPJ P,
>; END OF RHTCRK
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.
ERROR ,<?/H ILLEGAL AFTER FIRST HISEG FILE IS LOADED@?>>
LDRSTR: ERROR 0,</LOADER RESTARTED@/>
JRST LD ;START AGAIN
IFN REENT,<
REMPFL: ERROR ,</?LOADER REMAP FAILURE@/>
JRST LDRSTR
HCONT: HRRZ C,D
ANDCMI C,1777
CAIL C,400000
CAIG C,(H)
JRST COROVL ;BEING SET LOWER THEN 400000 OR MORE THAN TO OF LOW SEG
;;; HRRZM C,HVAL1 ;WE HAVE REMOVED THE ODD BITS TO MAKE A 1K MULT
; ABOVE REMOVED BY JBR 12/10/75
ADDI C,JOBHDA
CAILE C,(D) ;MAKE SURE OF ENOUGH ROOM
MOVE D,C
HRLI D,W ;SET UP W IN LEFT HALF
MOVEM D,HVAL
MOVEI C,400000 ;; JBR 12/10/75
MOVEM C,HVAL1 ;; JBR 12/10/75
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 ALGSW,<TRNE F,ALGFL ;IF LOADING ALGOL
POPJ P, ;JUST RETURN>
CAIN D,1 ;SPECIAL CASE
TROA F,HISYM ;YES ,BLT SYMBOLS INTO HISEG
JUMPL D,.+2
TROA F,DMNFLG ;TURN ON /B
IFN KUTSW,<TRZA F,DMNFLG ;TURN OFF IF /-B
SETZM CORSZ ;SET TO CUT BACK CORE>
IFE KUTSW,<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 ;00-10
BYTE (4)4,4,4,4,12,0,0,0,0 ;11-21
BYTE (4)0,0,0,0,0,0,0,0,0 ;22-32
BYTE (4)13,0,0,0,0,4,0,4,0 ;33-43
IFE SYMARG,<IFN STANSW,<BYTE (4)0,5,0,0,5,3,0,0,11> ;44-54
IFE STANSW,<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 ;55-65
IFE SPCHN!STANSW,< BYTE (4)2,2,2,2,6,0,0,10,0> ;66-76
IFN SPCHN!STANSW,< BYTE (4)2,2,2,2,6,0,1,10,1>
IFE RPGSW,< BYTE (4)SORTSY,0,1,1,1,1,1,1,1> ;77-107
IFN RPGSW,< BYTE (4) SORTSY,10,1,1,1,1,1,1,1> ;77-107
BYTE (4)1,1,1,1,1,1,1,1,1 ;110-120
BYTE (4)1,1,1,1,1,1,1,1,1 ;121-131
IFE PP,<BYTE (4)1,0,0,0,0,10,0,1,1> ;132-142
IFN PP,<IFN STANSW,<IFE L,< BYTE (4)1,10,0,10,10,10,0,1,1>> ;Activate '^'
IFE STANSW,< BYTE (4)1,10,0,10,0,10,0,1,1>>
IFN L,< BYTE (4)1,10,0,10,0,10,0,1,1>>
BYTE (4)1,1,1,1,1,1,1,1,1 ;143-153
BYTE (4)1,1,1,1,1,1,1,1,1 ;154-164
BYTE (4)1,1,1,1,1,1,0,0,13 ;165-175
BYTE (4)13,4 ;176-177
SUBTTL INITIALIZE LOADING OF A FILE
ILD: MOVEI W,BUF1 ;LOAD BUFFER ORIGIN
MOVEM W,JOBFF
TLOE F,ISW ;SKIP IF INIT REQUIRED
JRST ILD6 ;DONT DO INIT
ILD7: OPEN 1,OPEN3 ;KEEP IT PURE
JRST ILD5B
IFN STANSW,<
MOVEI W,1
SHOWIT W, ;Display input file's ststus on wholine
>;STANSW
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,<
IFE K,<
IFN STANSW,< IFE L,< INBUF 1,23> ;STANFORD, NOT LISP
IFN L,< INBUF 1,2> ;STANFORD, LISP >;IFN STANSW
IFE STANSW,< INBUF 1,2 ;SET UP BUFFERS >;IFE STANSW
>;IFE K
IFN K,< INBUF 1,1 ;SET UP BUFFER>
>;IFE LNSSW
IFN LNSSW,<INBUF 1,1
MOVEI W,BUF1
EXCH W,JOBFF
SUBI W,BUF1
IFE K,< MOVEI C,4*203+1>
IFN K,< MOVEI C,203+1>
IDIV C,W
INBUF 1,(C)
>;IFN LNSSW
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: 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:>>
IFN PP,<MOVSI W,(SIXBIT /DSK/)
CAMN W,ILD1 ;TRIED DSK ONCE?
JRST ILD9 ;YES, FILE DOES NOT EXIST
MOVEM W,ILD1 ;SET IT UP
SETZM PPN ;CLEAR OLD VALUE
PUSHJ P,LDDT2 ;SET UP .REL
TLZ F,ESW ;SO WE CAN TRY BLANK EXT
JRST ILD7 ;OPEN DSK,TRY AGAIN>
ILD9: ERROR ,</CANNOT FIND#/>
JRST LD2
; DEVICE SELECTION ERROR
ILD5A: SKIPA W,LD5C1
ILD5B: MOVE W,ILD1
ILD5: TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,PRQ ;START W/ ?
PUSHJ P,PWORD ;PRINT DEVICE NAME
ERROR 7,</UNAVAILABLE@/>
JRST LD2
SUBTTL LIBRARY SEARCH CONTROL AND LOADER CONTROL
;LIBF ENABLES A LIBRARY SEARCH OF <SYS:LIB4.REL>
LIBF: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
PUSH P,ILD1 ;SAVE DEVICE NAME
PUSHJ P,LIBF1 ;LOAD SYS:JOBDAT.REL
IFN SAILSW,<LIBAGN: PUSHJ P,SALOAD ;LOAD RELS AND SEARCH LIBS>
IFN REENT,<TRNN F,SEENHI ;IF ANY HISEG LOADED NO RE-ENT OP SYSTEM
TRNN F,VFLG
JRST LIBF3
IFN ALGSW,<TRNE F,ALGFL ;SPECIAL ACTION IF LOADING ALGOL
JRST [MOVE C,[RADIX50 44,%ALGDR]
MOVEI W,400010 ;JOBHDA
PUSHJ P,SYMPT ;DEFINE IT
JRST LIBF3] ;DON'T LOAD IMP40>
MOVE W,[SIXBIT /IMP40/]
PUSHJ P,LIBF2
LIBF3:>
TRNN F,COBFL ;COBOL SEEN?
SKIPA W,[SIXBIT /LIB40/] ;FIRST TRY AT NAME
MOVE W,[SIXBIT /LIBOL/] ;YES, SEARCH COBOL'S LIBRARY ONLY
PUSHJ P,LIBF2 ;LOAD SYS:LIB40.REL
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
; 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:
IFN DIDAL,<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
AOJA C,LIB31 ;ONE FOR RELOCATION WORD
BLOCK0: HRRZ C,W ;GET WORD COUNT
JUMPE C,LOAD1 ;NOISE 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 15 AND 16 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
IFN STANSW,<
LDDTQQ: 'RAID '
'NRAID '
'RAID '
'ORAID '
LDDTQX: TLO N,DDSW+EXEQSW ;WILL START RAID AFTER LOADING
LDDTQ: PUSH P,D ;SAVE ARG
PUSHJ P,FSCN1 ;SEE BELOW
;;%##% RHT MAKE /NV LOAD NRAID
HRRZ D,(P) ;GET ARGUMENT
CAILE D,3
MOVEI D,0
MOVE W,LDDTQQ(D)
IFN SORTSY,< TRNN D,1
SETOM DOSORT> ;FLAG TO SORT SYMBOLS TOO.
;;%##% ^
IFN DMNSW,<SETZM (P);ELSE>POP P,D ;/0D FOR DMN2 (BELOW) !?!
JRST LDDT11 ;JOIN FORCES
>;IFN STANSW
LDDTX:
IFN ALGSW,<TRNE F,ALGSW
POPJ P,>
TLO N,DDSW+EXEQSW ;T - LOAD AND GO TO DDT
LDDT:
IFN ALGSW,<TRNE F,ALGFL
POPJ P,>
IFN DMNSW,< PUSH P,D ;SAVE INCASE /NNND >
PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
MOVSI W,444464 ;FILE IDENTIFIER <DDT>
LDDT11: 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
IFN PP,<MOVE W,ILD1 ;SAVE OLD DEV
MOVEM W,OLDDEV>
MOVSI W,637163 ;DEVICE IDENTIFIER <SYS>
MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER
TLZ F,ISW+LIBSW+SKIPSW+REWSW ;CLEAR OLD FLAGS
LDDT2: MOVSI W,624554 ;EXTENSION IDENTIFIER <.REL>
LDDT3: MOVEM W,DTIN1 ;STORE EXTENSION IDENTIFIER
LDDT4:IFN PP,<EXCH W,PPN ;GET PROJ-PROG #
MOVEM W,DTIN+3
EXCH W,PPN ;W MUST BE SAVED SINCE IT MAY BE USED LATER>
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>
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
SUBI W,1(S) ; COMPUT DEFICIENCY
JUMPL W,EOF2 ;JUMP IF NO OVERLAP
TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,PRQ ;START WITH ?
PUSHJ P,PRNUM0 ;INFORM USER
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
TLNN F,CSW+DSW+ESW ;TEST SCAN FOR COMPLETION
POPJ P,
FSCN2: PUSHJ P,LD5B1 ;STORE FILE OR EXTENSION IDENT.
; LOADER CONTROL, NORMAL MODE
LDF: PUSHJ P,ILD ;INITIALIZE LOADING
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>
LOAD1: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER
LOAD1A: PUSHJ P,WORD ;INPUT BLOCK HEADER WORD
MOVNI E,400000(W) ;WORD COUNT - FROM RH OF HEADER
HLRZ A,W ;BLOCK TYPE - FROM LH OF HEADER
IFN FAILSW,<SKIPN POLSW ;ERROR IF STILL DOING POLISH>
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 FAILSW,<POLFIX==LOAD4A
LINK==LOAD4A>
IFE WFWSW,<LVARB==LOAD4A>
IFE DIDAL,<INDEX==LOAD4A>
IFE ALGSW,<ALGBLK==LOAD4A>
;DEC STANDARD NOW INCLUDES BLOCKS 16 AND 17 AS LDPRG AND LDLIB. REG 3-23-74
LOAD2: XWD LOCD, BLOCK0 ;10,,0
XWD POLFIX, PROG ;11,,1
XWD LINK, SYM ;12,,2
XWD LVARB, HISEG ;13,,3
XWD INDEX, LIB30 ;14,,4
XWD ALGBLK, HIGH ;15,,5
XWD LDPRG, NAME ;16,,6
XWD LDLIB, START ;17,,7
DISPL==.-LOAD2
;ERROR EXIT FOR BAD HEADER WORDS
LOAD4: IFE K,<
CAIN A,400 ;FORTRAN FOUR BLOCK
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)
PROG: MOVEI V,-1(W) ;LOAD BLOCK LENGTH
PUSHJ P,RWORD ;READ BLOCK ORIGIN
ADD V,W ;COMPUTE NEW PROG. BREAK
IFN REENT,<TLNN F,HIPROG
JRST PROGLW ;NOT HIGH SEGMENT
PROG3: CAMGE W,HVAL1 ;CHECK TO SEE IF IN TOP SEG
JRST LOWCOR
MOVE T,JOBREL ;CHECK FOR OVERFLOW ON HIGH
CAIL T,@X
JRST PROG2
PUSHJ P,HIEXP
JRST FULLC
JRST PROG3>
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,JOB41 ;JOB41 IS DIFFERENT
CAIN V,74 ;SO IS JOBDAT
MOVEI V,JOBDDT>
IFN L,< CAMGE V,RINITL ;CHECK FOR BAD STORE
JRST [ CAIN V,JOBDDT ;SPECIAL HACK TO SET JOBDDT
MOVEM W,LSPDDT ;FOR LISP LOADER - TVR
JRST STLSPD ] >
MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC
STLSPD: AOJA V,PROG1 ;ADD ONE TO LOADER LOC. COUNTER
IFN REENT,<
LOWCOR: SUB V,HIGHX ;RELOC FOR PROPER
ADD V,LOWX ;LOADING OF LOW SEQMENT
SUB W,HIGHX
ADD W,LOWX
JRST PROGLW>
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,100000 ;LOCAL OR BLOCK NAME?
TLNN C,40000
JRST SYM1A ;LOCAL SYMBOL
; TLNE C,100000
; JRST SYM1B
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 SYM1BG
; PROCESS MULTIPLY DEFINED GLOBAL
SYM1: CAMN W,2(A) ;COMPARE NEW AND OLD VALUE
POPJ P,;
IFN L,< EXCH W,2(A) ;I don't know about the rest of you guys, but I want to
> ; use the new value. DWP 6/5/74
AOS MDG ;COUNT MULTIPLY DEFINED GLOBALS
PUSHJ P,PRQ ;START W/ ?
PUSHJ P,PRNAM ;PRINT SYMBOL AND VALUE
IFN RPGSW,<MOVE W,JOBERR ;RECORD THIS AS AN ERROR
ADDI W,1
HRRM W,JOBERR>
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
SYM1B: CAIL H,(S) ;STORE DEFINED SYMBOL
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
SYM1C: IFE K,<
TLNE N,F4SW; FORTRAN FOUR REQUIRES A BLT
PUSHJ P,MVDWN; OF THE TABLES>
MOVEI A,-2(S) ;LOAD A TO SAVE INST. AT SYM2
MOVE T,@GLBENP
;BUG TRAP
TLNE C,040000 ;Trap off globals
TLNE C,300000
JRST SYM1D
HALT SYM1DG
;END BUG TRAP
SYM1D: SUBI S,2; UPDATE UNDEFINED POINTER
SUB B,[XWD 2,0] ;TO PREVENT PDLOV IF NO GLOBALS
POP B,2(A) ;MOVE UNDEFINED VALUE POINTER
POP B,1(A) ;MOVE UNDEFINED SYMBOL
ADD B,[XWD 4,0] ;COMPENSATE FOR POP
POP T,2(B) ;MOVE GLOBAL VALUE POINTER
POP T,1(B) ;MOVE GLOBAL SYMBOL
SYM1E: MOVEM W,2(T) ;STORE VALUE
MOVEM C,1(T) ;STORE SYMBOL
MOVEM T,@GLBENP
POPJ P,
; GLOBAL SYMBOL
SYM1BG: CAIL H,(S) ;STORE DEFINED SYMBOL
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
IFE K,<
TLNE N,F4SW; FORTRAN FOUR REQUIRES A BLT
PUSHJ P,MVDWN; OF THE TABLES>
MOVEI A,-2(S) ;LOAD A TO SAVE INST. AT SYM2
;BUG TRAP
TLNE C,040000 ;Trap off non-globals
TLNE C,300000
HALT SYM1D
;END BUG TRAP
SYM1DG: SUBI S,2; UPDATE UNDEFINED POINTER
TLC B,400000 ;AVOID PDLOV IF NO GLOBALS YET
POP B,2(A) ;MOVE UNDEFINED VALUE POINTER
POP B,1(A) ;MOVE UNDEFINED SYMBOL
TLC B,400000
MOVEM W,2(B) ;STORE VALUE
MOVEM C,1(B) ;STORE SYMBOL
POPJ P,
; GLOBAL DEFINITION MATCHES REQUEST
SYM2: PUSH P,SYM2C ;NEXT MUST BE A SUBROUTINE FOR LATER, SET RETURN
SYM2B: MOVE V,2(A) ;LOAD REQUEST POINTER
PUSHJ P,REMSYM
JUMPL V,SYM2W ;ADDITIVE REQUEST? WFW
PUSHJ P,SYM4A ;REPLACE CHAIN WITH DEFINITION
SYM2W1: PUSHJ P,SREQ ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
JRST SYM2B ;FOUND MORE
MOVE A,SVA ;RESTORE A
SYM2C: POPJ P,SYM1DG ;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
MOVE V,1(B) ;Trap fixups to globals
TLNE V,040000
JRST SYM3X2 ;We'll worry about finding the symbol at SYM2W
HRRI W,2(B) ;GET LOCATION IN RIGHT HALF
TLO W,1
SUB W,HISTRT ;AND MAKE RELATIVE
;IFN FAILSW,<TLZ W,040000> ;No longer needed, see SYM2W
SYM3X2: CAIL H,(S) ;STORE REQUEST IN UNDEF. TABLE WFW
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
SYM3X: IFE K,<
TLNE N,F4SW; FORTRAN FOUR
PUSHJ P,MVDWN; ADJUST TABLES IF F4>
SUB S,SE3 ;ADVANCE UNDEFINED POINTER
MOVEM W,2(S) ;STORE UNDEFINED VALUE POINTER
MOVEM C,1(S) ;STORE UNDEFINED SYMBOL
POPJ P,;
; COMBINE TWO REQUEST CHAINS
SYM3A: SKIPL 2(A) ;IS IT ADDITIVE WFW
JRST SYM3A1 ;NO, PROCESS WFW
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>
HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
JUMPN A,SYM3B ; JUMP IF NOT THE LAST ADDR. IN CHAIN
HRRM W,@X ;COMBINE CHAINS
POPJ P,;
;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
MOVE T,@X ;GET WORD
ADD T,W ;VALUE OF GLOBAL
HRRM T,@X ;FIX WITHOUT CARRY
MOVSI D,200000 ;SET UP TO REMOVE DEFERED INTERNAL IF THERE
JRST SYMFIX
FIXWL: HRLZ T,W ;UPDATE VALUE OF LEFT HALF
ADDM T,@X ;BY VALUE OF GLOBAL
MOVSI D,400000 ;LEFT DEFERED INTERNAL
SYMFIX: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP
POPJ P, ;NO, RETURN
ADDI V,(X) ;GET THE LOCATION
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: TLNN V,100000 ;SYMBOL TABLE?
JRST SYM2WA
TLNE V,40000 ;GLOBAL?
JRST [ EXCH C,V
PUSHJ P,SDEF
JRST [ MOVE C,V
HRRI V,2(A)
JRST SYM2WB ]
EXCH C,V
HALT . ]
ADD V,HISTRT ;MAKE ABSOLUTE
SYM2WB: SUBI V,(X) ;GET READY TO ADD X
PUSHJ P,FIXW1
JRST SYM2W1
SYM2WA: IFN FAILSW,<
TLNE V,40000 ;CHECK FOR POLISH
JRST POLSAT>
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>
HRRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN
HRRM W,@X ;INSERT VALUE INTO PROGRAM
MOVE V,T
SYM4A: JUMPN V,SYM4 ;JUMP IF NOT LAST ADDR. IN CHAIN
POPJ P,
IFE K,<
MVDWN: HRRZ T,MLTP
IFN EXPAND,< SUBI T,2>
CAIG T,(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,
>
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: PUSHJ P,WORD ;GOBBLE UP A WORD.
JUMPE W,HISEG2 ;MACRO V36
PUSHJ P,WORD ;GET THE OFSET
IFE REENT,<HISEG2==LOAD1A
JUMPGE W,LOAD1A ;NOT TWO SEG PROG.>
IFN REENT,<JUMPE W,HISEG2 ;IGNORE ZERO
JUMPG W,HISEG3 ;NEG. IF TWOSEG PSEUDO-OP>
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
HRRM R,2(N) ;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,JOBHDA
HRLI X,W
MOVEM X,HVAL
SEENHS: MOVE X,HVAL
MOVEM X,HIGHR
HRRZ X,JOBREL
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,TWOERR ;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
TWOERR: ERROR 7,</HIGH SEGMENT ILLEGAL#/>
JRST LDRSTR
SUBTTL HIGHEST RELOCATABLE POINT (BLOCK TYPE 5)
SFULLC: TLOE F,FULLSW ;PREVIOUS OVERFLOW?
JRST FULLC ;YES, DON'T PRINT MESSAGE
ERROR ,<?SYMBOL TABLE OVERLAP#?>
FULLC: TLO F,FULLSW ;CORE OVERLAP ERROR RETURN
IFE K,< TLNE N,F4SW
POPJ P,>
JRST LIB3 ;LOOK FOR MORE
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
MOVE W,HVAL ;ORIGINAL VALUE
MOVEM W,HVAL1 ;RESET
JRST HIGH2A] ;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>
HIGH0: CAIE A,4 ; TEST FOR END BLOCK (OVERLAP)
JRST LIB30
HIGH: TRNE F,TWOFL ;IS THIS A TWO SEGMENT PROGRAM?
JRST HIGH2 ;YES
HIGH2A: PUSHJ P,PRWORD ;READ TWO DATA WORDS.
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>
CAMGE C,W ;CHECK 2ND WORD (LOC PROG BRK IF PRESENT)
MOVE C,W
HRR R,C ;SET NEW PROGRAM BREAK
HIGH31: ADDI C,(X)
CAIG H,(C)
MOVEI H,(C) ;SET UP H
CAILE H,1(S) ;TEST PROGRAM BREAK
IFN EXPAND,<PUSHJ P,[ PUSHJ P,XPAND
TLOA F,FULLSW
JRST POPJM2
POPJ P,]>
IFE EXPAND,<TLO F,FULLSW>
HIGH3: MOVEI A,F.C
BLT A,B.C
IFN REENT,<TRNE F,NOHI!NOHI6 ;ONE SEGMENT PROGRAM?
JRST HIGHN4 ;YES
HRLZ W,HIGHR ;GET HIGH PROG BREAK
JUMPE W,[HRRZ W,R ;NO HIGH SEGMENT YET
JRST .+2] ;SO USE LOW RELOCATION ONLY
HRR W,LOWR ;GET LOW 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:>
TLZ F,NAMSSW ;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
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,JOBREL
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>
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
SUBTTL EXPAND HIGH SEGMENT
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,JOBREL
ADDI N,2000
CAMG N,ALWCOR
CORE N,
JRST XPAND6
PUSHJ P,ZTOP
POP P,N
JRST XPAND3>
MOVHI: MOVEI N,-2000(X)
HRL N,X
HRRZ X,JOBREL
BLT N,-2000(X)
PUSHJ P,ZTOP
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
SUBI N,2000 ;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,>
ZTOP: HRRZ N,JOBREL
MOVEI X,-1776(N)
HRLI X,-1777(N)
SETZM -1(X)
BLT X,(N)
POPJ P,>
SUBTTL PROGRAM NAME (BLOCK TYPE 6)
NAME: TLOE F,NAMSSW ;HAVE WE SEEN TWO IN A ROW?
JRST NAMERR ;YES, NO END BLOCK SEEN
PUSHJ P,PRWORD ;READ TWO DATA WORDS
MOVEM C,SBRNAM ;SAVE SUBROUTINE NAME
NCONT: HLRE V,W ;GET COMPILER TYPE
HRRZS W ;CLEAR TYPE
JUMPL V,.+3
CAIGE V,CMPLEN-CMPLER ;ONLY IF LEGAL 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,[ ;JUMP IF NO COMMON IN THIS JON
MOVE T,@GLBENP ;We'll need the global pointer (but if we get
JRST NAME2 ] ;it and call XPAND, we'll lose big!).
HRRI R,@R ;FIRST PROGRAM SET LOAD ORIGIN
NAME1: CAILE H,-1(S) ;TEST FOR AVAIL. SYMBOL SPACE
IFN EXPAND,< PUSHJ P,XPAND7>
IFE EXPAND,< JRST SFULLC>
MOVE T,@GLBENP ;Pick up pointer to end of globals
SUBI S,2 ;UPDATE UNDEF. TABLE POINTER
SUB B,[XWD 2,0] ;TO PREVENT PDLOV
POP B,2(S)
POP B,1(S)
ADD B,[XWD 4,0] ;COMPENSATE FOR POPS
POP T,2(B)
POP T,1(B)
NAME1A: HRRZ V,N ;POINTER TO PREVIOUS NAME
SUBM T,V ;COMPUTE RELATIVE POSITIONS
HRLM V,2(N) ;STORE FORWARD POINTER
HRR N,T ;UPDATE NAME POINTER
NAME2: MOVEM C,1(T) ;STORE PROGRAM NAME
HRRZM R,2(T) ;STORE PROGRAM ORIGIN
MOVEM T,@GLBENP ;Save up pointer to end of globals
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: SETZM DTIN ;CLEAR WRONG FILE NAME FOR MESSAGE
ERROR ,</NO END BLOCK !/>
JRST ILC1
;COMPILER TYPE - DO SPECIAL FUNCTION FOR IT
DEFINE CTYPE (CONDITION,TRUE,FALSE)
<IFN CONDITION,<TRUE>
IFE CONDITION,<FALSE>>
CMPLER: CTYPE 1,JFCL,JFCL ;0 MACRO
CTYPE K-1,<TRO F,F4FL>,JFCL ;1 FORTRAN
CTYPE 1,<TRO F,COBFL>,JFCL ;2 COBOL
CTYPE ALGSW,<PUSHJ P,ALGNAM>,JFCL ;3 ALGOL
;4 NELIAC
;5 PL/1
CMPLEN:
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 STANSW&REENT,<
MOVE W,DTIN+2
TLNN N,ISAFLG
MOVEM W,PRGCRD ;SAVE DATE & TIME FOR SETCRD>
IFN NAMESW,<
MOVE W,DTIN ;PICK UP BINARY FILE NAME
TLNN N,ISAFLG
MOVEM W,PRGNAM ;SAVE IT
MOVE W,1(N) ;SET UP NAME OF THIS PROGRAM
TLNN N,ISAFLG ;DONT SET NAME IF IGNORING SA'S
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!WFWSW,<
LOCDLH: IFN L,<CAMGE V,RINITL
POPJ P,>
IFN REENT,<CAMGE V,HVAL1
SKIPA X,LOWX
MOVE X,HIGHX>
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 FAILSW=1
XLIST
IFN FAILSW,<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,< ;POLISH FIXUPS FOR FAIL (BLOCK TYPE 11)
Comment
REG 10/22/74 TO ADD 3 NEW POLISH OPERATORS. JFFO,ABS, AND REMAINDER.
JFR 3-28-76
New sub items in Polish loader blocks (type 11):
Store operators:
-7 MOVEM op1,(op2)
-10 store op1 as the value of link (block type 12) op2
[linkend of -op2 if op2 negative]
Operators:
20 maximum
21 minimum
22 if op1=op2 then -1 else 0
23 fetch value of link op1 [linkend -op1 if op1 negative]
24 definition characteristic--consider operand as
RADIX50 and return 0 if unknown, 1 if known but
undefined, -1 if known and defined
25 skip op2 half-words of Polish if op1 neq op2;
skip forwards if op2 positive and backwards(LINK-10 only)
if op2 negative; the skipping is done after relocation
words are taken into account; in any case, return 0.
26 skip to just beyond the next END block if op1 neq 0
27 MOVE--get loader's current idea of what will be in
location op1 when loading is complete (not counting
linkend processing)
Each Polish block must contain a store operator, even if it is a dummy
and will never be executed. Link numbers are specified as half-word
quantities. To fetch the current value of link 1 and store as linkend 2,
the polish block would look like
11,,3 ;polish block,,3 data words
0 ;no relocation
23,,0 ;fetch link/linkend,,half-word operand is next
1,,-10 ;link #1,,store link/linkend
-2,,0 ;linkend #2,,filler
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
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
MOVEI W,MXPLOP ;START WITH FAKE OPERATOR SO STORE WILL NOT HACK
RPOL0: PUSH D,W ;SAVE OPERATOR IN STACK
MOVE V,DESTB-3(W) ;GET NUMBER OF OPERANDS NEEDED
MOVEM V,SVSAT ;ALSO SAVE IT
RPOL: PUSHJ P,RDHLF ;GET A HALF WORD
TRNE W,400000 ;IS IT A STORE OP?
JRST STOROP ;YES, DO IT
IFN WFWSW,<CAIN W,15
MAKE ASSEMBLY ERROR MESSAGE - THIS CODE NO LONGER WORKS WITH FAIL - REG
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,MXPLOP-1 ;OPERATOR IN RANGE?
JRST LOAD4A ;ILL FORMAT
JRST RPOL0 ;GO STACK OPERATOR
;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,MXPLOP ;IS IT?
JRST LOAD4A ;NO, ILL FORMAT
HRRZ T,(D) ;GET THE VALUE TYPE
CAILE W,-7
JUMPN T,GLSTR ;AND TREAT GLOBALS SPECIAL
MOVE A,W ;THE TYPE OF STORE OPERATOR
CAIL W,-6
CAILE W,-4
JRST .+2 ;NOT A SYMBOL TABLE STORE
PUSHJ P,FSYMT ;SYMBOL TABLE STORE. (MAY CLOBBER A TO ZERO)
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+10(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 T11LNK,T11MVM,ALSYM,LFSYM,RHSYM,ALSTR,LOCDLF,SYM4A,FAKESY
GLSTR: MOVE A,W
CAIGE A,-3
PUSHJ P,FSYMT ;SYMBOL TABLE STORE OP. (MAY CLOBBER A TO ZERO)
PUSHJ P,RDHLF ;GET THE STORE LOCATION
MOVEI A,MXPLOP+10(A) ;REFORM TO MAKE LARGE POSITIVE INDEX TO OPTAB
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>
HRRZ T,@X
MOVEM W,@X ;FULL WORD FIXUPS
MOVE V,T
ALSTR: JUMPN V,ALSTR1
POPJ P,
;NUMBER OF ARGS-1 FOR EACH POLISH OPERATOR. AND 100 TO TERMINATE LIST
DESTB: EXP 1,1,1,1,1,1,1,1,0,0,0,1,0,1,1,1,0,0,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
PUSHJ P,JFFOOP
PUSHJ P,REMOP
MOVM W,C
PUSHJ P,MAXOP
PUSHJ P,MINOP
PUSHJ P,EQOP
PUSHJ P,LNKOP
PUSHJ P,DEFOP
PUSHJ P,SKPOP
PUSHJ P,SKEOP
PUSHJ P,MOVOP
MXPLOP==.-OPTAB+3 ;1 MORE THAN LARGEST LEGAL OPERATOR NUMBER
REPEAT 11,<JRST STRSAT> ;11 STORE OPERATORS,
;-1 TO -10 & 0 (SEE FSYMT&FNOLOC)
;SEE ALSO GLSTR
JFFOOP: PUSH P,C+1 ;JFFO OP (LIKE ^L IN MACRO-10)
JFFO C,.+2
MOVEI C+1,44
MOVE W,C+1
POP P,C+1
POPJ P,
REMOP: IDIV W,C ;REMAINDER
MOVE W,C
POPJ P,
MAXOP: CAMGE W,C
MOVE W,C
POPJ P,
MINOP: CAMLE W,C
MOVE W,C
POPJ P,
EQOP: CAME W,C
TDZA W,W
SETO W,
POPJ P,
LNKOP: HRREI C,(C) ;SIGN EXTEND
JUMPGE C,.+2
SKIPA W,[HLRZ W,LINKTB(C)] ;FETCH LINK END
MOVE W,[HRRZ W,LINKTB(C)] ;FETCH LINK
MOVM C,C
CAILE C,20
JRST LOAD4A ;RANGE CHECK
XCT W
POPJ P,
DEFOP: ;DEFINITION STATUS OF SYMBOL IN C
MOVEI W,1 ;ASSUME WE'VE SEEN IT BUT IT'S UNDEFINED
PUSHJ P,SDEF ;LOOK FOR MATCH OF SYMBOL IN C
SKIPA W,[-1] ;IS DEFINED
PUSHJ P,SREQ ;NOT DEFINED. IS IT REQUESTED?
POPJ P, ;YES, SO RETURN 1
MOVEI W,0 ;NO, SO RETURN 0
POPJ P,
SKPOP: ;SKIP (C) HALFWORDS OF POLISH IF (W) NEQ 0, RETURN 0
TDZN W,W
POPJ P, ;W WAS ZERO
JUMPL C,LOAD4A ;WE CANT GO BACKWARDS
JUMPE C,.-2 ;FOR SKIP OF ZERO WORDS
PUSH P,C ;SAVE COUNT ON STACK
PUSHJ P,RDHLF ;READ A HALF WORD
SOSLE (P) ;DECR COUNT
JRST .-2 ;NOT DONE YET
POP P,W ;ADJUST STACK, LOAD ZERO RETURN VALUE
POPJ P,
SKEOP: ;SKIP TO BEYOND NEXT END BLOCK IF (C) NEQ 0
MOVE W,C
TDZN W,W
POPJ P, ;OPERAND WAS ZERO
JRST .+2 ;JUMP INTO LOOP
PUSHJ P,RWORD ;GET NEXT WORD
TRNE E,377777 ;HAS PRESENT BLOCK ENDED?
JRST .-2 ;NO
SETZM POLSW ;DONE LOADING POLISH
SKEOP2: PUSHJ P,WORD ;GET HEADER WORD
HLRZ C,W ;BLOCK TYPE
CAIE C,5 ;END?
JRST SKEOP1 ;NO
MOVNI E,400000(W) ;CONTROL WORD
PUSHJ P,RWORD ;READ WORD OF END BLOCK
JRST .-1 ;UNTIL DONE
SKEOP1: MOVEI C,(W) ;WORD COUNT
JUMPE C,SKEOP2 ;NOISE WORD
CAIG C,22 ;ONE SUBBLOCK?
AOJA C,SKE.1 ;YES, COUNT ITS RELOC BITS
IDIVI C,22 ;WHOLE BLOCKS
IMULI C,23 ;WORDS IN WHOLE BLOCKS
JUMPE C+1,.+2 ;IF NO REMAINDER
ADDI C,1(C+1) ;PARTIAL BLOCK HAS RELOC BITS
SKE.1:
CAML C,BUFR2 ;DOES BLOCK OVERLAP BUFFERS?
SOJA C,SKE32 ;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 SKEOP2 ;GET NEXT BLOCK
SKE32: SUB C,BUFR2 ;ACCOUNT FOR REST OF THIS BUFFER
PUSHJ P,WORD+1 ;GET ANOTHER BUFFERFUL
JRST SKE.1 ;TRY AGAIN
MOVOP: MOVEI V,(C) ;ADDRESS
IFN REENT,<
CAMGE V,HVAL1 ;CHECK SEG ADDR
SKIPA X,LOWX
MOVE X,HIGHX
>;IFN REENT
MOVE W,@X
IFN REENT,<
PUSHJ P,RESTRX
>;IFN REENT
POPJ P,
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,@GLBENP
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,@GLBENP ;ALL DONE?
JRST FSLP ;NO
FNOLOC: POP D,A
MOVEI A,0 ;SET FOR A FAKE FIXUP (CALLS FAKESY BY USING STRTAB+6)
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 ;STORE IN LEFT HALF OF SYMBOL VALUE
HRLM W,(V)
MOVSI D,400000 ;LEFT HALF
JRST COMSFX
RHSYM: ADD V,HISTRT ;STORE IN RIGHT HALF OR SYMBOL VALUE
HRRM W,(V)
MOVSI D,200000
JRST COMSFX
FAKESY: POPJ P, ;IGNORE SYMBOL TABLE STORES TO NON-EX SYMBOLS.
T11LNK: HRREI V,(V) ;SIGN EXTEND
JUMPGE V,.+2
SKIPA C,[HRLM W,@LINKTB(V)] ;LINKEND
MOVE C,[HRRM W,@LINKTB(V)] ;LINK
MOVM V,V
CAIL V,20
JRST LOAD4A
XCT C
POPJ P,
T11MVM:
IFN REENT,<
CAMGE V,HVAL1 ;CHECK SEG ADDR
SKIPA X,LOWX
MOVE X,HIGHX
>;IFN REENT
MOVEM W,@X
IFN REENT,<
PUSHJ P,RESTRX
>;IFN REENT
POPJ P,
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
;LINK AND LINKEND BLOCKS ARE DONE HERE.
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
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
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-MXPLOP(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
>;IFN FAILSW (PAGE 57)
LIST ;END OF FAILSW CODE
IFN FAILSW!WFWSW,<
COMSFX: IFN REENT,<PUSHJ P,SYMFX1 ;WAS IFE, I THINK THAT'S WRONG -- DCS
JRST RESTRX>
IFE REENT,<JRST SYMFX1>> ;WAS IFN, I THINK THAT'S WRONG -- DCS
REMSYM: MOVE T,1(S)
MOVEM T,1(A)
MOVE T,2(S)
MOVEM T,2(A)
ADD S,SE3
MOVEM A,SVA
POPJ P,
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,100 ;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
HLRE A,T ;GET WORD COUNT
JUMPL A,INDEX3 ;END OF BLOCK IF NEGATIVE
CAIE A,4 ;IS IT ENTRY
JRST INDEX
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
; ***** THE EQUIV. OF THE NEXT INSTR. MAY WELL BE IN LATER VERSIONS.
; ***** IT WAS MISSING, AND FOULED UP THE INDEX STUFF. (DCS 7-7-71)
HLLM C,BUFR ;INDICATE VIRGIN BUFFER
HRRZ T,BUFR
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
COMMENT * DCS -- 3/15/71
This code required modification to work with DEC's FUDGE2
(with /X) at Stanford. I don't know the formats, so I don't know
if the bugs are unique to Stanford.
In particular, the special 0 test seems to cause all the
trouble -- removing it fixed it. However, my fix may well foul
up with Dectapes (see the SPR for "details?").
*
COMMENT JFR 9-24-75 Fix to work with corrected FUDGE2.
SKIPL LSTBLK ;WAS LAST BLOCK AN INDEX?
JRST INDEX6 ;NO
HRRZ T,AUX+3 ;GET FIRST ENTRY BLOCK TYPE COUNT
HRRZ T,AUX+4(T) ;GET FIRST POINTER WORD
MOVEM T,LSTBLK ;SOME WHERE TO STORE IT
JRST INDEX6
IFN 0,< ;JFR
; 0 TEST REMOVED HERE -- DCS
SKIPL LSTBLK ;WAS LAST BLOCK AN INDEX?
AOJA A,INDEX6 ;NO, ALWAYS ONE WORD OUT THEN
HRRZ T,AUX+3 ;GET FIRST ENTRY BLOCK TYPE COUNT
HRRZ T,AUX+4(T) ;GET FIRST POINTER WORD
MOVEM T,LSTBLK ;SOME WHERE TO STORE IT
HRRZ T,(P) ;GET CURRENT BLOCK NUMBER
CAME T,LSTBLK ;SAME BLOCK
AOJA A,INDEX6 ;NO
TRNN F,DTAFLG ;BUFR2 OK IF DTA
SOS BUFR2 ;ONE WORD TOO MANY THOUGH
JRST INDEX6 ;YES, WORD COUNT WILL BE CORRECT
; IF A IS 0, INDEX6 INDEX7 -- DCS
>;IFN 0 JFR
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: IN 1, ;GET NEXT BUFFER
SOSA BUFR2 ;O.K. RETURN, BUT 1 WORD TOO MANY
JRST WORD3 ;ERROR OR EOF
PUSHJ P,WORD ;READ FIRST WORD
INDEXE: TRZE F,XFLG ;INDEX IN CORE?
TTCALL 3,[ASCIZ /LIBRARY INDEX INCONSISTENT - CONTINUING
/] ;WARNING MESSAGE
JRST LOAD1A+1 ;AND CONTINUE
>
SUBTTL ALGOL OWN BLOCK (TYPE 15)
IFN ALGSW,<
ALGBLK: PUSHJ P,RWORD ;READ 3RD WORD
HLRZ V,W ;GET START OF OWN BLOCK
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
ADDI V,(R) ;RELOCATE
MOVEI W,(V) ;GET CURRENT OWN ADDRESS
EXCH W,%OWN ;SAVE FOR NEXT TIME
MOVEM W,@X ;STORE LAST OWN ADDRESS IN LEFT HALF
ALGB1: PUSHJ P,RWORD ;GET DATA WORD
HLRZ V,W ;GET ADDRESS TO FIX UP
HRRZS W ;RIGHT HALF ONLY
ADD W,%OWN ;ADD IN ADDRESS OF OWN BLOCK
ADDM W,@X ;FIX UP RIGHT HALF
JRST ALGB1 ;LOOP TIL DONE
ALGNAM: JUMPE W,CPOPJ ;NOT ALGOL MAIN PROG
TROE F,ALGFL ;SET ALGOL SEEN FLAG
JRST ALGER1 ;ONLY ONE ALGOL MAIN PROG ALLOWED
IFN REENT,<TRNN F,SEENHI ;ANYTHING IN HIGH SEGMENT?>
CAME R,[XWD W,JOBDA] ;ANYTHING LOADED IN LOW SEGMENT?
JRST ALGER2 ;YES, ERROR ALSO
SETZM %OWN ;INITIALISE OWN AREA POINTER
IFN REENT,<TRO F,VFLG ;DEFAULT RE-ENTRANT OP-SYSTEM>
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,
ALGER1: ERROR ,</ONLY ONE ALGOL MAIN PROGRAM ALLOWED#/>
JRST LD2
ALGER2: ERROR ,</ALGOL MAIN PROGRAM MUST BE LOADED FIRST#/>
JRST LD2
>
SUBTTL SAIL BLOCK TYPE 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*
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 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
; Rewritten by TVR
SREQ: JUMPGE S,CPOPJ1 ;JUMP IF NO UNDEF. SYMBOLS
MOVE A,S ;LOAD REQUEST SEARCH POINTER
JRST SDEF1
SDEF: MOVE A,B ;LOAD DEF. SYMBOL SEARCH POINTER
TLNE C,040000 ;Is it a global?
TLNE C,300000
MOVE A,@GLBENP ;Yes, use global pointer
SDEF1: TLNE N,F4SW ;FORTRAN search can be faster
JRST SDEFF4
PUSH P,T ;Save T just in case
MOVE T,C ;Keep around half-killed for compare
TLC T,400000
SDEF1A: CAMN C,1(A) ;Compare with symbol
JRST SDEFRT ;Gotcha! Non-skip return
CAMN T,1(A)
JRST [ TLO C,400000 ;If suppressed, set same in symbol
MOVEM C,1(A) ;table
JRST SDEFRT ]
ADD A,SE3
JUMPL A,SDEF1A ;End test, try next symbol
AOS -1(P) ;Symbol not found skips on return
SDEFRT: POP P,T ;Restore T
POPJ P,
SDEF2: ADD A,SE3 ;WFW jumps into middle of old symbol table
JRST SDEF1 ;search routines, we'll comply
SDEFF4: CAMN C,1(A) ;A faster loop for FORTRASH
POPJ P,
ADD A,SE3
JUMPL A,SDEFF4
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,
;this kludge decides whether to use HISEG or LOWSEG relocation.
;addresses greater than HVAL1-NEGOFF (NEGOFF=400) are given
;high segment relocation.
CHECK: MOVE T,HVAL1 ;START OF HISEGMENT
CAIG T,NEGOFF(W) ;IN HISEG?
JRST CHECK1
HRRI W,@LOWR ;USE LOW SEG RELOC
JRST CPOPJ1 ;SKIP RETURN
CHECK1: PUSH P,W ;DON'T CLOBBER LEFT HALF
SUBI W,(T) ;REMOVE HIGH SEGMENT OFSET
HLL W,(P)
SUB P,[1,,1]
POPJ P,
SUBTTL PRINT STORAGE MAP SUBROUTINE
PRMAP: CAIN D,1 ;IF /1M PRINT LOCAL SYMBOLS
TROA F,LOCAFL ;YES,TURN ON FLAG
TRZ F,LOCAFL ;CLEAR JUST IN CASE
PUSHJ P,FSCN1 ;LOAD OTHER FILES FIRST
PUSHJ P,CRLFLF ;START NEW PAGE
HRRZ W,R
IFN REENT,<CAIG W,JOBDA ;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:>
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
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,JOBHDA ;ADD IN OFFSET
HRLI A,JOBDA ;LOW START
MOVSM A,SVBRKS ;INITIAL BREAKS>
HLRE A,B
MOVNS A
ADDI A,(B)
PRMAP1: SUBI A,2
IFN REENT,<SKIPN C,1(A) ;LOAD SYMBOL SKIP IF REAL SYMBOL
JRST PRMAP4 ;IGNORE ZERO NAME(TWOSEG BREAKS)>
IFE REENT,<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,140000 ;MAKE IT LOOK LIKE INTERN
TLNE C,040000
JRST PRMP1A
PUSHJ P,CRLF
PUSHJ P,CRLF
SETZM TABCNT
JRST PRMP1B
PRMP1A: PUSHJ P,TAB
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,W ;SAVE IT
JUMPGE T,.+2 ;IF NEGATIVE
TDZA W,W ;MAKE ZERO (FIRST TIME THRU)
HLRZ W,T ;GET HIGH BREAK
PUSHJ P,PRNUM ;PRINT IT
PUSHJ P,TAB ;AND TAB
POP P,W ;LOW BREAK
PUSHJ P,PRNUM
MOVE T,2(C)
CAMN C,B ;EQUAL IF LAST PROG
SETZ C, ;SIGNAL END
TLNN T,-1
HLL T,SVBRKS
CAMN T,SVBRKS ;ZERO LENGTT 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
IFN REENT,<CAMGE W,HVAL1 ;MAKE SURE BOTH IN SAME SEGMENT
CAMGE T,HVAL1
CAMGE T,W
JRST [HLRE T,(C) ;NO TRY NEXT ONE DOWN
JUMPE T,@PRMAP7 ;END GO USE PROG BREAK
ADDI C,(T)
JRST PRMAP2] ;CHECK THIS ONE>
PRMAP6: SUBM T,W ;SUBTRACT ORIGIN TO GET LENGTH
PUSHJ P,PRNUM ;PRINT PROGRAM LENGTH
PUSHJ P,CRLF
PRMP6A: TLNN N,ALLFLG ;SKIP IF LIST ALL MODE IS ON
TRNE W,777777 ;SKIP IF ZERO LENGTH PROGRAM
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
SUBTTL LIST UNDEFINED AND MULTIPLY DEFINED GLOBALS
PUSHJ P,PMS1 ;PRINT UNDEFINED SYMBOLS
;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,PRQ ;PRINT ?
PUSHJ P,PRNUM0 ;NUMBER OF MULTIPLES
ERROR 7,<?MULTIPLY DEFINED GLOBALS@?>
PMS4: TLNE N,AUXSWE ;AUXILIARY OUTPUT DEVICE?
OUTPUT 2, ;INSURE A COMPLETE BUFFER
POPJ P, ;RETURN
;LIST UNDEFINED GLOBALS
PMS1: PUSHJ P,FSCN1 ;LOAD FILES FIRST
JUMPGE S,CPOPJ ;JUMP IF NO UNDEFINED GLOBALS
PUSHJ P,FCRLF ;START THE MESSAGE
PUSH P,S ;SAVE POINTER TO UNDEFINEDS
MOVEI W,0 ;COUNT UNDEF SYMBOLS.
PMS1A: SKIPL A,1(S)
TLNN A,40000
JRST .+2
ADDI W,1
ADD S,SE3
JUMPL S,PMS1A
PUSHJ P,PRNUM0 ;NOTE THIS IS AN OCTAL PRINTER
ERROR 7,</UNDEFINED GLOBALS@/>
POP P,S ;RESTORE.
MOVE A,S ;POINTER TO UNDEFS
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
CPOPJ: POPJ P,
PMS: PUSHJ P,PMS1 ;PRINT UNDEFINED SYMBOLS
JUMPGE S,CPOPJ ;NO UNDEFINED SYMBOLS
PUSHJ P,CRLF ;NEW LINE,MAKE ? VISIBLE
PUSHJ P,PRQ ;FIX FOR BATCH TO PRINT ALL SYMBOLS
JRST CRLF ;SPACE AFTER LISTING
SUBTTL ENTER FILE ON AUXILIARY OUTPUT DEVICE
IAD2: 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 IAD2A ;NO SO JUST RETURN
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 .+5 ;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
IFN NAMESW,< SKIPN A,CURNAM ;USE PROG NAME>
MOVSI A,(SIXBIT /MAP/) ;AN UNLIKELY NAME
MOVEM A,DTOUT ;SO ENTER WILL NOT FAIL
IAD2A: 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
POPJ P,
IMD3: ERROR ,</DIR. FULL@/>
JRST LD2
IMD4: MOVE P,[XWD -40,PDLST] ;RESTORE STACK
TLZ N,AUXSWE!AUXSWI ;NO AUX.DEV.NOW
ERROR ,</NO MAP DEVICE@/>
JRST PRMAP5 ;CONTINUE TO LOAD
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: XWD 220300,W
IFN NAMESW,<
LDNAM: MOVE T,[POINT 6,CURNAM] ;POINTER
MOVNI D,6 ;SET COUNT
TLZ W,740000 ;REMOVE CODE BITS
SETNAM: IDIVI W,50 ;CONVERT FROM RAD 50
HRLM C,(P)
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, >
;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,
PFWORD: MOVNI Q,6 ;PRINT FILE NAME
MOVE D,LSTPT
PWORD3: ILDB T,D
JUMPE T,CPOPJ
PUSHJ P,TYPE
AOJL Q,PWORD3
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: 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
TLON N,AUXSWE ;IS AUX. DEV. ENTERED?
PUSHJ P,IAD2 ;NOPE, DO SO!
SOSG ABUF2 ;SPACE LEFT IN BUFFER?
OUTPUT 2, ;CREATE A NEW BUFFER
IDPB T,ABUF1 ;DEPOSIT CHARACTER
TLNN F,FCONSW ;FORCE OUTPUT TO CONSOLE TOO?
POPJ P, ;NOPE
TYPE3: IFN RPGSW,<
TRNE F,NOTTTY ;IF TTY IS ANOTHER DEVICE
POPJ P, ;DON'T OUTPUT TO IT>
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
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
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: SETZM TABCNT
PUSHJ P,CRLF
TAB: AOS T,TABCNT
CAIN T,5
JRST TAB1
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: TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,CRLF ;ROOM AT THE TOP
PUSHJ P,PRQ ;START OFF WITH ?
ERRPT0: PUSH P,Q ;SAVE Q
SKIPA V,ERRPT5
ERRPT1: PUSHJ P,TYPE
ILDB T,V
CAIN T,"@"-40
JRST ERRPT4
CAIN T,"%"-40
JRST ERRPT9
CAIN T,"!"-40
JRST ERRP42 ;JUST RETURN,LEAVE FCONSW ON
CAIE T,"#"-40
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: TLO F,FCONSW ;INSURE TTY OUTPUT
PUSHJ P,PRQ ;START WITH ?
CAIGE T,140 ;IS IT A NON-PRINTING CHAR?
CAIL T,40
JRST ERRP8
PUSH P,T
MOVEI T,136 ;UP ARROW
PUSHJ P,TYPE2
POP P,T
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
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
IFE K,<
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: XWD -41,PDLST-1; INITIAL PUSHDOWN POINTER
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 SEG2SW,< RELOC
LOWCOD: RELOC>
IFN PURESW,<HICODE:
IFN SEG2SW,< PHASE LOWCOD>
IFE SEG2SW,< PHASE 140>>
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: 17
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 STANSW,<
OPEN4: EXP 17
Z
Z >
IFN PURESW,<DEPHASE
CODLN=.-HICODE>
SUBTTL DATA STORAGE
IFN PURESW,<
IFE SEG2SW,<LOC 140>
IFN SEG2SW,<RELOC>
LOWCOD: BLOCK CODLN>
PDSAV: BLOCK 1 ;SAVED PUSHDOWN POINTER
COMSAV: BLOCK 1 ;LENGTH OF COMMON
MDG: BLOCK 1 ;COUNTER FOR MUL DEF GLOBALS
GLBEND: BLOCK 1 ;Pointer to end of globals in symbol table
GLBENP: BLOCK 1 ;PNTR TO ABOVE, OR TO B (SEE RHTCRK)
PDLST: BLOCK 40
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
STADDR: BLOCK 1 ;HOLDS STARTING ADDRESS
IFN NAMESW,<
PRGNAM: BLOCK 1 ;STORE BINARY FILE NAME-USED TO MAKE SYSTAT MORE MEANINGFUL
>
IFN REENT,<
IFN STANSW,<
PRGCRD: BLOCK 1 ;SAVE DATE & TIME FOR SETCRD UUO>
HIGHX: BLOCK 1
HIGHR: BLOCK 1 ;HOLD X AND R WHILE LOADING LOW SEG PIECES
LOWX: BLOCK 1
HILOW: BLOCK 1 ;HIGHEST NON-BLOCK STMT IN LOW SEG
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 KUTSW,<CORSZ: 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>
PT1: BLOCK 1
SVA: BLOCK 1
IFN RPGSW,<
NONLOD: BLOCK 1
SVRPG: BLOCK 1
IFN TEMP,<
TMPFIL: BLOCK 2
TMPFLG: BLOCK 1>
>
IFN NAMESW,<
CURNAM: BLOCK 1
>
IFN PP,<
OLDDEV: BLOCK 1
PPN: BLOCK 1
PPNE: BLOCK 1
PPNV: BLOCK 1
PPNW: BLOCK 1
>
IFN FAILSW,<
GLBCNT: BLOCK 1
HDSAV: BLOCK 1
HEADNM: BLOCK 1
LFTHSW: BLOCK 1
OPNUM: BLOCK 1
POLSW: BLOCK 1
SVHWD: BLOCK 1
SVSAT: BLOCK 1
PPDB: BLOCK PPDL+1
LINKTB: BLOCK 21
>
HISTRT: BLOCK 1 ;JOBREL AT START OF LOADING
IFN L,<
LSPXIT: BLOCK 1
LSPREL: BLOCK 1 ;BY TVR AFTER DBA AFTER JRA FOR UCI
LSPDDT: BLOCK 1 ;Special location for JOBDDT for LISP Loader
RINITL: BLOCK 1
OLDJR: BLOCK 1>
IFN SPCHN,<
CHNTAB: BLOCK 1
BEGOV: BLOCK 1
CHNACN: BLOCK 1
CHNACB: BLOCK 1>
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 SILENT,<
INBYTP: BLOCK 1
INBYTC: BLOCK 1
>;IFN SILENT
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 STANSW, <
SAVFIL: BLOCK 4 ;FILE NAME BLOCK FOR DUMP FILE >
TTYL==52 ;TWO TTY BUFFERS
IFN STANSW,< TTYL==70 ;;;STANFORD, JUST TO BE DIFFERENT, HAS BIG TTY BFRS>
IFE LNSSW,<
IFE K,< BUFL==406 ;TWO DTA BUFFERS FOR LOAD
IFN STANSW,<IFE L,<BUFL==23*203>>;STANFORD, NOT LISP, USE 7 BUFFERS >;IFE K
IFN K,< BUFL==203 ;ONE DTA BUFFER FOR LOAD >;IFN K
ABUFL==203 ;ONE DTA BUFFER FOR AUX DEV
>;IFE LNSSW
IFN LNSSW,<
IFE K,<BUFL==4*203+1>
IFN K,<BUFL==203+1>
ABUFL==2*203+1>
TTY1: BLOCK TTYL ;TTY BUFFER AREA
BUF1: BLOCK BUFL ;LOAD BUFFER AREA
AUX: BLOCK ABUFL ;AUX BUFFER AREA
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>
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
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 3>
SBRNAM: BLOCK 1
IFE K,<
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>
VAR ;DUMP VARIABLES
IFN PURESW,<RELOC>
SUBTTL REMAP UUO
IFN REENT,<
IFN PURESW,<HHIGO: PHASE BUF1 ;DON'T NEED BUF1 NOW>
HIGO: CORE V, ;CORE UUO
JFCL ;NEVER FAILS
HINOGO: MOVE D,HVAL
CAMG D,HVAL1 ;ANYTHING IN HI-SEG
JRST 0 ;NO
IFN STANSW,<MOVE V,PRGCRD
TLZ V,777000 ;NO PROTECTION
CALLI V,400073 ;SET DATE & TIME WHICH WILL BE COPIED TO UPPER>
SEGAG2: MOVE V,HISTRT ;NOW REMAP THE HISEG.
REMAP V, ;REMAP UUO.
IFN STANSW,< JRST SEGAGN ;Type error message and let him try again.>
IFE STANSW,<
IFN PURESW,< JRST HIGET > ;FATAL ERROR.
IFE PURESW,< JRST REMPFL > ;FATAL ERROR.>
HIRET: JRST 0 ;EXECUTE CODE IN ACC'S
IFN STANSW,<
SEGAGN: TTCALL 3,SEGAGM ;Tell him REMAP failed and that he can try again.
EXIT 1,
JRST SEGAG2 ;Now try again.
SEGAGM: ASCIZ /
?REMAP FAILED TO MAKE UPPER SEGMENT. PROBABLY NO JOB SLOTS AVAILABLE.
Type CONTINUE to retry the REMAP./ >
IFN PURESW,<
HIGET: HRRZI V,SEGBLK ;DATA FOR
GETSEG V, ;GETSEG UUO
SKIPA ;CANNOT CONTINUE NO HISEG
JRST REMPFL ;REGAINED LOADER HISEG
;GO PRINT MESSAGE
TTCALL 3,SEGMES ;PRINT SEGMES
EXIT ;AND DIE
SEGBLK: SIXBIT /SYS/
SIXBIT /LOADER/
EXP 0,0,0,0
SEGMES: ASCIZ /?CANNOT FIND LOADER.SHR
/
HIGONE: DEPHASE>>
SUBTTL LISP LOADER
;END HERE IF 1K LOADER REQUESTED.
IFN K,<IFE L,<END BEG>
IFE L,< XLIST >
IFN L,< LIT
VAR
LODMAK: MOVEI A,LODMAK
MOVEM A,137
INIT 17
SIXBIT /DSK/
0
HALT
ENTER LMFILE
HALT
OUTPUT [IOWD 1,LMLST ;OUTPUT LENGTH OF FILE
0]
OUTPUT LMLST
STATZ 740000
HALT
RELEASE
CALL [SIXBIT /EXIT/]
LMFILE: SIXBIT /LISP/
SIXBIT /LOD/
0
0
LMLST: IOWD LODMAK+1-LD,137
0
END LODMAK>>
LIST
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
TLOA F,FULLSW
JRST POPJM3
POPJ P,]>
IFE EXPAND,< TLO F,FULLSW>
;IFN REENT,<TRO F,F4FL!VFLG ;RE-ENTRANT LIB40>
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
TLOA F,FULLSW
JRST POPJM3
POPJ P,]>
POPJ P,;
SMLT: SUB C,BLKSIZ; STRETCH
MOVS W,MLTP ;LEFT HALF HAS OLD BASE
ADD C,MLTP ;RIGHT HALF HAS NEW BASE
IFN EXPAND,< HRRZS C ;GET RID OF COUNT
CAIG C,(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,JOBREL ;CHECK FOR CORE OVERFLOW
CAIGE T,@X
PUSHJ P,[PUSHJ P,HIEXP
TLOA F,FULLSW
JRST POPJM3 ;CHECK AGAIN
POPJ P,]
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 STANSW&REENT,<MOVE W,DTIN+2
MOVEM W,PRGCRD ;DATE & TIME FOR SETCRD>
IFN NAMESW,<MOVE W,1(N) ;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
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
TLOE N,PGM1 ;YES, IS THIS FIRST F4 PROG?
JRST NOPRG ;NO
HRR W,COMBAS ;YES, PLACE PROG BREAK IN LH
IFE L,<IFN REENT,<TLNN F,HIPROG ;DON'T BOTHER IF IN HISEG, CHAIN NOT SMART ENOUGH>
HRLM W,JOBCHN(X) ;FOR CHAIN>
NOPRG: HRRZ W,PLTP; GET PROG TABLE BASE
HLRZ C,PLTP; AND SIZE
ADD W,C; COMPUTE END OF PROG TABLE
ADD W,[POINT 1,1]; AND BEGINNING OF BIT TABLE
EXCH W,BITP; SWAP POINTERS
PASS2B: ILDB C,BITP; GET A BIT
JUMPE C,PASS2C; NO PASS2 PROCESSING
PUSHJ P,PROC; PROCESS A TAG
JRST PASS2B; MORE TO COME
JRST ENDTP;
PROC: LDB C,[POINT 6,@X,23]; TAG
SETZM MODIF; ZERO TO ADDRESS MODIFIER
TRZE C,40
AOS MODIF
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
JRST LOAD4A; DATA STATEMENTS WILL GO HERE
TTR50: RADIX50 10,%TEMP.
PTR50: RADIX50 10,TEMP.
CNR50: RADIX50 10,CONST.
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
JUMPE W,PSTA; NO COMMON
PUSHJ P,COMDID ;PROCESS COMMON
JRST PCOM1
COMDID: LSH W,1 ;PROCESS COMMON TABLE ENTRIES
ADD W,CTAB; COMMON TAG
ADDI W,-2(X); OFFSET
PUSHJ P,SWAPSY; GET SYMBOL AND SET TO DEFINED
ADD C,1(W); BASE OF COMMON
SUBI W,-2(X) ;MAKE W RELATIVE SO WHEN TBLCHK CALLS XPAND WE WIN
POPJ P, ;RETURN
PATO: ROT C,1
ADD C,AOTAB; ARRAY OFFSET
MOVEM C,CT1; SAVE CURRENT POINTER (LEAVE RELATIVE IN CASE OF XPAND)
ADDI C,-2(X); LOADER OFFSET
HRRZ C,1(C); PICK UP REFERENCE POINTER
ANDI C,7777; MASK TO ADDRESS
ROT C,1; ALWAYS A ARRAY
ADDI C,-2(X)
ADD C,ATAB
HLRZ W,(C); COMMON CHECK
JUMPE W,NCO
PUSHJ P,COMDID ;PROCESS COMMON
PUSHJ P,SYDEF ;CAN CAUSE CALL TO XPAND, SO AVOID ABSOLUTE ADDRESSES
MOVE C,CT1
ADDI C,-2(X) ;RELOCATE C AGAIN (AVOID LOSSAGE IF XPAND WAS CALLED)
HRRE C,(C)
ADDI W,-2(X) ;RELOCATE W AGAIN (AVOID LOSSAGE IF XPAND WAS CALLED)
ADD C,1(W)
JRST PCOMX
NCO: PUSHJ P,SWAPSY;
ADDI C,(R) ;DEFINE SYMBOL IN TRUE LOC
PUSHJ P,SYDEF ;...
MOVE C,CT1
ADDI C,-2(X)
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
HRRZ C,(C) ;GET VALUE
POPJ P,
TBLCHK: HRRZ W,MLTP ;GETT TOP OV TABLES
SUBI W,2
CAMG W,TOPTAB ;WILL IT OVERLAP
IFE EXPAND,<TLO F,FULLSW>
IFN EXPAND,<JRST [PUSHJ P,XPAND
TLOA F,FULLSW
JRST TBLCHK
POPJ P,]>
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
HRRZ V,GSTAB
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: TLOE N,BLKD1 ;IS THIS FIRST BLOCK DATA?
JRST ENDTP ;NO
HRR V,COMBAS ;PLACE PROG BREAK IN RH FOR
IFE L,<IFN REENT,< TLNN F,HIPROG>
HRRM V,JOBCHN(X) ;CHAIN>
ENDTP: TLNE F,FULLSW+SKIPSW
JRST ALLOVE
HRR V,GSTAB
ENDTP0: CAML V,STAB; ANY MORE GLOBSUBS
JRST ENDTP2; NO
MOVE C,@X; GET SUBPROG NAME
PUSHJ P,SREQ; IS IT ALLREADY REQUESTED
AOJA V,ENDTP0; YES
PUSHJ P,SDEF; OR DEFINED
AOJA V,ENDTP0; YES
PUSHJ P,TBLCHK
MOVEI W,0 ;PREPARE DUMMY LINK
TLNN F,FULLSW+SKIPSW ;ABORT
PUSHJ P,SYM3X; PUT IN DUMMY REQUEST
PUSHJ P,BITWX; 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
JRST [SUB V,COMBAS
MOVNS V
PUSHJ P,XPAND9
TLO F,FULLSW
JRST .+1]
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,JOBREL
JRST [PUSHJ P,HIEXP
TLOA F,FULLSW
JRST ENDTPI
JRST ENDTPH]
JRST ENDTPH>>
FORCNF: ERROR ,</FORTRAN CONFUSED ABOUT DATA STATEMENTS#/>
JRST LD2
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
JRST LOAD4A ;DATA STATEMENT BELOW CODE TOP
JRST LOOP ;PROPER RETURN
DOINT.: POP P,V; GET ADDRESS OF INITIAL VALUE
PUSH P,(V); STORE INDUCTION VARIABLE
AOJ V,
PUSH P,V; INITIAL ADDRESS
JRST (V)
DOEND.: HLRE T,@(P) ;RETAIN SIGN OF INCREMENT
ADDM T,-2(P); INCREMENT
HRRZ 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,JOBREL>
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 LD2
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,JOBREL
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,JOBREL ;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,MACHCD ;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
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
IFN L,<
LIT
VAR
LODMAK: MOVEI A,LODMAK
MOVEM A,137
INIT 17
SIXBIT /DSK/
0
HALT
ENTER LMFILE
HALT
OUTPUT [IOWD 1,LMLST ;OUTPUT LENGTH OF FILE
0]
OUTPUT LMLST
STATZ 740000
HALT
RELEASE
CALL [SIXBIT /EXIT/]
LMFILE: SIXBIT /LISP/
SIXBIT /LOD/
0
0
LMLST: IOWD LODMAK+1-LD,137
0
END LODMAK>
IFE SORTSY,< END BEG>
SUBTTL SYMSRT - SORT SYMBOL TABLE FOR RAID
;THE REMAINDER OF THIS ASSEMBLY IS CONDITIONAL ON SORTSY SWITCH NON ZERO.
COMMENT $
Symbol Table Format
Word Description
0 -1 flags new format symbol table
1 BN relative pointer to Block Names
2 BS relative pointer to Block Structure
3 FULLV relative pointer to full word values
4 FREES relative pointer to free space
5 CLASS1 relative pointer to first class 1 symbol
6 CLASS2 relative pointer to first class 2 symbol
7 CLASS3 relative pointer to first class 3 symbol
10 CLASS4 relative pointer to first class 4 symbol
11 LASTV relative pointer to first word beyond
the symbol table
BN table of RADIX50 block and program names
BS table of block and program structure (see below)
FULLV table of full word values pointed to by class 4 symbols
FREES free space for adding symbols. initially zero
CLASS1 Pairs of words for each class 1 symbol.
First word is RADIX50 of symbol name with type flags
Second word: Byte(13)bnum(5)0(18)value
where bnum is an index to BN and BS table.
Class 1 symbols have values in the range 0 to 377777.
CLASS2 Same as CLASS1 space, except class2 symbols have
values in the range of 400000 to 777777.
CLASS3 Same as CLASS1 space, except class3 symbols have
non-zero values with zero right halves. The left
half of the value is stored in the right half of
the value word of the symbol entry.
CLASS4 Pairs of words for each class 4 symbol.
First word is RADIX50 of symbol name with type flags
Second word: Byte(13)bnum(5)14(18)vp.
Bnum is an index to BN and BS table.
Vp is a pointer, relative to beginning of symbol table,
to a word in the FULLV table that contains the value.
Note that the index field is set to 14, so that if 14
contains the address of the symbol table, you may
indirect through this word.
Class 4 values are all values not contained in the
other classes.
Values are sorted by arithmetic order in each class. Class 3 values
are considered as right-half quantities while being sorted.
Block Structure space:
All pointers in BS space are relative to BS space (and may be used
to index BN space). BN (block name) space comes before BS space
in the symbol table.
Words corresponding to program names have left-half links to the next
program name. Zero terminates this list. Right-halves are zero.
Word zero of BS space always corresponds to a program name.
Words corresponding to block names have left-half links to the BS
space word corresponding to the program containing this block. The
right-half links to the block immediately containing this block. The
outermost block's right-half link points to the program name word.
All blocks that are associated with a particular program are entered
immediately following that program name, and before the next program
name.
$
;SYMSRT
;CALLING:
; MOVE S,[IOWD POINTER TO UNDEF GLOBALS]
; MOVE B,[IOWD POINTER TO SYMBOLS]
; PUSHJ 17,SYMSRT
; RETURN HERE ALWAYS. B CONTAINS NEW IOWD. RH OF S ALSO SET FROM RH OF B.
; (LH OF S IS ZEROED)
;NO OTHER ACS ARE CLOBBERED.
SYMSRT: MOVEM 16,SRTSAC+16
MOVEI 16,SRTSAC
BLT 16,SRTSAC+15
HLLZ B,B ;KEEP ONLY COUNT OF DEFINED SYMBOLS
ADD B,S ;IOWD TO ALL SYMBOLS, INCLUDING UNDEF GLOBALS
JUMPGE S,SYMSX2 ;JUMP IF THERE ARE NO UNDEF GLOBALS
SYMSX1: SKIPL A,1(S) ;SKIP IF THIS ISN'T A GLOBAL SYMBOL NAME
TLNN A,40000 ;SKIP IF THIS IS A GLOBAL UNDEF SYMBOL
SETZM 1(S) ;NOT A GLOBAL SYMBOL-FLUSH SYMBOL NAME
SETZM 2(S) ;SET SYMBOL VALUE TO 0
ADD S,SE3
JUMPL S,SYMSX1
SYMSX2:
;PASS 1 - LOOK THRU THE OLD SYMBOL TABLE AND COUNT VARIOUS THINGS.
SETZM CLASST ;ZERO CLASS COUNTERS
MOVE 2,[CLASST,,CLASST+1]
BLT 2,CLASST+4
MOVEI 16,1(B) ;ADDR
HLRO 15,B ;-N
MOVN 15,15 ;N
HRL 15,15 ;N,,N
ADD 16,15 ;N,,ADDR+N
SUB 16,[2,,2] ;N-2,,ADDR+N-2. GOD HELP YOU IF RESULT IS NEGATIVE
MOVEM 16,OPTR ;SAVE POINTER
SYMLP1: SKIPN 15,(16) ;GET RADIX50
JRST SYLP1Z ;NOTHING THERE.
MOVE 14,1(16) ;14_VALUE; 15_RADIX50
MOVEI 2,0 ;ASSUME "CLASS 0" = BLOCK/PROGRAM NAME
LDB 13,[POINT 4,15,3] ;GET SYMBOL TYPE
JUMPE 13,SYLP1A ;0 IS PROGRAM NAME
CAIN 13,3
JRST SYLP1A ;14 IS BLOCK NAME
PUSHJ P,CLASS ;2_CLASS TYPE (1,2,3 OR 4)
SYLP1A: AOS CLASST(2) ;COUNT EACH SYMBOL CLASS
SYLP1Z: SUB 16,[2,,2]
JUMPG 16,SYMLP1
;;FALL OFF PAGE
;NOW, HOW BIG IS SYMBOL TABLE GOING TO BE?
MOVE 2,CLASST ;NUMBER OF PROGRAM/BLOCK NAMES
ADD 2,CLASST+1 ;PLUS CLASS 1
ADD 2,CLASST+2 ;PLUS CLASS 2
ADD 2,CLASST+3 ;PLUS CLASS 3
ADD 2,CLASST+4 ;PLUS CLASS 4
LSH 2,1 ;TIMES 2
ADD 2,CLASST+4 ;PLUS THIRD WORD FOR EACH CLASS 4 SYMBOL
ADD 2,KORSP ;PLUS USER REQUESTED SYMBOL PATCH SPACE
ADDI 2,12 ;PLUS OVERHEAD WORDS AT FRONT OF TABLE
MOVE 1,JOBREL
MOVN 3,2
HRL 1,3 ;-WC,,MA-1 OF NEW SYMBOL TABLE
MOVEM 1,NPTR ;SAVE IOWD POINTER TO NEW SYMBOLS
HRRZM 1,NBASE ;SET BASE OF NEW SYMBOL TABLE
AOS NBASE ;DIRECT POINTER TO NEW TABLE
ADD 1,2 ;LAST ADDRESS NEEDED
MOVE 3,1 ;SAVE THIS (IS LAST ADDRESS FOR BLT)
CORE 1, ;GET SOME CORE
PUSHJ P,MORCOR ;LOSE.
MOVE 1,NBASE
SETZM (1)
HRL 1,1 ;NBASE,,NBASE
ADDI 1,1 ;SOURCE,,DEST FOR BLT
BLT 1,(3) ;ZERO NEW CORE SPACE FOR SYMBOL TABLE
MOVE 1,NBASE ;GET BASE ADDRESS AGAIN
SETOM (1) ;-1 FLAGS THE NEW FORMAT SYMBOLS
MOVEI 3,12 ;POINTER TO BN
MOVEM 3,1(1) ;BN POINTER
ADD 3,CLASST ;PLUS NUMBER OF BN'S
MOVEM 3,2(1) ;GIVES POINTER TO BS'S
ADD 3,CLASST ;PLUS NUMBER OF BS'S (= NUMBER OF BN'S)
MOVEM 3,3(1) ;GIVES POINTER TO FV'S
ADD 3,CLASST+4 ;PLUS NUMBER OF FV'S
MOVEM 3,4(1) ;GIVES POINTER TO FF
ADD 3,KORSP ;PLUS AMOUNT OF FREE SPACE
MOVEM 3,5(1) ;GIVES POINTER TO CLASS1
ADD 3,CLASST+1
ADD 3,CLASST+1 ;PLUS 2*CLASS1 SPACES
MOVEM 3,6(1) ;POINTER TO CLASS2 SPACE
ADD 3,CLASST+2
ADD 3,CLASST+2
MOVEM 3,7(1) ;POINTER TO CLASS3 SPACE
ADD 3,CLASST+3
ADD 3,CLASST+3
MOVEM 3,10(1) ;POINTER TO CLASS4 SPACE
ADD 3,CLASST+4
ADD 3,CLASST+4
MOVEM 3,11(1) ;POINTER TO THE END OF THE AREA.
;PASS 2 - COPY SYMBOL NAMES TO NEW SYMBOL TABLE. BUILD BN/BS AREAS
;1 STILL CONTAINS NBASE
SETZM CLASST ;ZERO CLASS COUNTERS
MOVE 2,[CLASST,,CLASST+1]
BLT 2,CLASST+4
SETOM SVSTK
SETOM ID
SETZM PD
MOVE 16,OPTR ;GET POINTER TO OLD TABLE
SYMLP2: SKIPN 15,(16) ;GET RADIX50
JRST SYLP2Z ;NOTHING THERE.
MOVE 14,1(16) ;14_VALUE; 15_RADIX50
LDB 13,[POINT 4,15,3] ;GET SYMBOL TYPE
JUMPE 13,SYLP2B ;0 IS PROGRAM NAME
CAIN 13,3
JRST SYLP2C ;14 IS BLOCK NAME
PUSHJ P,CLASS ;2_CLASS TYPE (1,2,3 OR 4)
AOS 3,CLASST(2) ;COUNT CLASS TYPE
CAIN 2,3 ;CLASS 3 SYMBOL?
MOVSS 1(16) ;YES. SWAP HALVES TO MAKE THE SORT WORK RIGHT.
LSH 3,1 ;DOUBLE COUNT TO MAKE INDEX.
ADDI 2,4(1) ;GET ADDRESS OF BASE OF CLASS
ADD 3,(2) ;RELATIVE ADDRESS IN NEW SYMBOL TABLE+2
ADDI 3,(1) ;ABSOLUTE ADDRESS+2
MOVEM 15,-2(3) ;STORE RADIX50 OF SYMBOL
HRLZ 14,ID ;GET BLOCK ID
LSH 14,5 ;MOVE IT OVER TO MAKE ROOM FOR INDEX/INDIRECT
HRRI 14,1(16) ;POINTER TO THE VALUE CELL
MOVEM 14,-1(3) ;STUFF IN NEW SYMBOL TABLE
JRST SYLP2Z ;LOOP.
SYLP2B: MOVE 6,PD
MOVEI 14,0 ;ARGUMENT TO SYLPOP
CAMGE 6,ID ;IF PD .LT. ID THERE WERE NESTED BLOCKS
PUSHJ P,SYLPOP ;POP NESTED BLOCKS BELONGING TO PREVIOUS PD
AOS 6,ID ;COUNT NEW PROGRAM ID
MOVE 11,1(1) ;GET BASE OF BN AREA
ADDI 11,(1)
ADDI 11,(6) ;PLUS CURRENT INDEX
MOVEM 15,(11) ;STORE CURRENT PROGRAM NAME IN BN SPACE
MOVE 7,PD ;GET PD OF PREVIOUS PROGRAM
MOVEM 6,PD ;STORE NEW PD
MOVE 11,2(1) ;GET POINTER TO BS SPACE
ADDI 11,(1)
ADDI 11,(7)
HRLZM 6,(11) ;LH POINTER TO CURRENT ID IN PREVIOUS PROG'S WORD
JRST SYLP2Z ;GET NEXT
SYLP2C: AOS 6,ID ;COUNT NEW BLOCK
MOVE 11,1(1) ;GET BASE OF BN AREA
ADDI 11,(1)
ADDI 11,(6) ;PLUS CURRENT INDEX
MOVEM 15,(11) ;STORE CURRENT BLOCK NAME IN BN SPACE
PUSHJ P,SYLPOP ;14 HAS BLOCK LEVEL.
SYLP2Z: SUB 16,[2,,2]
JUMPG 16,SYMLP2
MOVE 6,PD
MOVE 11,2(1) ;GET BASE OF BS AREA
ADDI 11,(1)
ADDI 11,(6) ;PLUS CURRENT INDEX
SETZB 14,(11) ;FINISH BS LINKAGE FOR LAST PROGRAM
CAMGE 6,ID
PUSHJ P,SYLPOP ;FINISH DANGLING BLOCK STRUCTURE
;;FALL OFF PAGE
;WE SORT THINGS HERE
MOVE 2,5(1) ;FIRST ADDRESS FOR CLASS1
MOVE 3,6(1) ;FIRST ADDRESS BEYOND CLASS1
ADDI 2,(1) ;MAKE ADDRESSES ABSOLUTE
ADDI 3,-2(1) ;MAKE ADDRESS WITHIN CLASS
CAILE 3,(2) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
MOVE 2,6(1) ;FIRST ADDRESS FOR CLASS2
MOVE 3,7(1) ;FIRST ADDRESS BEYOND CLASS2
ADDI 2,(1) ;MAKE ADDRESSES ABSOLUTE
ADDI 3,-2(1) ;MAKE ADDRESS WITHIN CLASS
CAILE 3,(2) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
MOVE 2,7(1) ;FIRST ADDRESS FOR CLASS3
MOVE 3,10(1) ;FIRST ADDRESS BEYOND CLASS3
ADDI 2,(1) ;MAKE ADDRESSES ABSOLUTE
ADDI 3,-2(1) ;MAKE ADDRESS WITHIN CLASS
CAILE 3,(2) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
MOVE 2,10(1) ;FIRST ADDRESS FOR CLASS4
MOVE 3,11(1) ;FIRST ADDRESS BEYOND CLASS4
ADDI 2,(1) ;MAKE ADDRESSES ABSOLUTE
ADDI 3,-2(1) ;MAKE ADDRESS WITHIN CLASS
CAILE 3,(2) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
;COPY SYMBOL VALUES TO NEW TABLE
MOVE 2,5(1) ;FIRST CLASS1 VALUE
MOVE 3,10(1) ;FIRST BEYOND CLASS3
ADDI 2,(1) ;MAKE ADDRESSES ABSOLUTE
ADDI 3,(1)
SYMLP3: CAIL 2,(3) ;AT THE END YET?
JRST SYML3A ;YES.
MOVE 4,@1(2) ;GET VALUE
HRRM 4,1(2) ;REPLACE POINTER WITH VALUE
ADDI 2,2
JRST SYMLP3
SYML3A: MOVE 2,10(1) ;FIRST CLASS4 VALUE
MOVE 3,11(1) ;FIRST BEYOND CLASS4
MOVE 4,3(1) ;ADDRESS OF FULL WORD SPACE
ADDI 2,(1) ;MAKE ADDRESSES ABSOLUTE
ADDI 3,(1)
ADDI 4,(1)
MOVE 5,3(1) ;RELATIVE ADDRESS OF FULL WORD SPACE
HRLI 5,14 ;SET INDEX FIELD
SYML3B: CAIL 2,(3) ;AT THE END YET?
JRST SYMXIT ;YES. - ALL DONE
MOVE 6,@1(2) ;GET VALUE
MOVEM 6,(4) ;STORE IN FULL WORD SPACE
DPB 5,[POINT 23,1(2),35] ;STORE RELATIVE POINTER TO SYMBOL. AND INDEX
ADDI 2,2 ;ADVANCE TO NEXT SYMBOL
ADDI 4,1 ;ADVANCE ABSOLUTE POINTER TO FULL WD SPACE
AOJA 5,SYML3B ;ADVANCE RELATIVE POINTER TO FULL WD SPACE
SYMXIT: MOVSI 16,SRTSAC
BLT 16,16
MOVE B,NPTR ;RETURN NEW POINTER
HRRZ S,NPTR ;CHANGE S TOO.
; LEAVE BLANK SPACE FOR RAID AND UNDEFINED TABLE FOR DDT
; SETZM KORSP ;EXTRA SPACE IS NOW INSIDE THE SYM. TABLE.
POPJ P,
;CALL WITH 2=FIRST ADDRESS IN RANGE, 3=ADDRESS OF LAST ITEM IN RANGE
;THIS IS QUICKSORT WITHOUT STRAIGHT INSERTION SORT FOR SMALL SUBFILES.
SSORT: MOVEI 4,(2) ;LEFT POINTER
MOVEI 5,(3) ;RIGHT POINTER
MOVE 6,@1(4) ;"KEY LEFT" ELEMENT
MRST1: CAML 6,@1(5) ;IF "KEY LEFT" .GT. "KEY RIGHT"
JRST MRST2 ;NEED TO EXCHANGE (OR MAYBE STOP?)
SUBI 5,2 ;MOVE RIGHT SIDE TOWARD CENTER
JRST MRST1 ;LOOP
MRST2: CAIN 4,(5) ;REACHED THE MIDDLE YET?
JRST MRST4 ;YES. NOW TIME TO SORT THE SUBFILES.
MOVE 7,(4) ;EXCHANGE
EXCH 7,(5)
MOVEM 7,(4)
MOVE 7,1(4)
EXCH 7,1(5)
MOVEM 7,1(4)
MRST3: ADDI 4,2 ;MOVE LEFT END TOWARD CENTER
CAMLE 6,@1(4)
JRST MRST3 ;"KEY RIGHT" .GT. "KEY LEFT"
CAIN 4,(5) ;REACHED THE MIDDLE YET?
JRST MRST4 ;YES. NOW TIME TO SORT THE SUBFILES.
MOVE 7,(4) ;EXCHANGE
EXCH 7,(5)
MOVEM 7,(4)
MOVE 7,1(4)
EXCH 7,1(5)
MOVEM 7,1(4)
SUBI 5,2 ;MOVE RIGHT SIDE TOWARD CENTER
JRST MRST1 ;LOOP
MRST4: MOVEI 6,(3)
SUBI 6,(2)
JUMPE 6,CPOPJ ;IF 2=3, THE ONE ELEMENT FILE IS SORTED
LSH 6,-1 ;C=1/2 SIZE OF ORIGINAL FILE.
MOVEI 7,(3)
SUBI 7,(5) ;D=SIZE OF RIGHT SUBFILE
CAILE 6,(7) ;IF D .GT. C THEN SORT LEFT SUBFILE FIRST.
JRST MRST5 ;C .GT. D SORT RIGHTSUBFILE FIRST.
MOVSI 6,2(4)
HRRI 6,(3) ;LEFT EDGE,,RIGHT EDGE OF RIGHTSUBFILE
MOVEI 3,(4) ;SET RIGHT EDGE OF SMALL SUBFILE
JRST MRST6
MRST5: MOVSI 6,(2)
HRRI 6,-2(4)
MOVEI 2,(4)
MRST6: PUSH P,6 ;STUFF ON STACK.
PUSHJ P,SSORT ;!
POP P,6
MOVEI 3,(6)
HLRZ 2,6
JRST SSORT
SYLPOP: HRL 6,PD ;PD COPIED TO LH OR ARGUMENT
SKIPGE 7,SVSTK ;GET "STACK TOP"
JRST SYLPSH ;STACK IS EMPTY. TIME TO PUSH
SYLPP1: ADD 7,2(1) ;GET STACK ADDRESS
ADDI 7,(1)
HRRZ 10,(7)
CAMG 10,14 ;IS STACK LEVEL GREATER THAN BLOCK LEVEL?
JRST SYLPSH ;NO. WE CAN PUSH NEW ENTRY
HLRE 10,(7) ;GET NEW STACK TOP TO 10
MOVEM 10,SVSTK ;SAVE NEW STACK TOP
MOVEM 6,(7) ;STORE NEW STUFF IN STACK
SKIPL 7,10
JRST SYLPP1 ;LOOP UNTIL NO STACK OR WE FIND THE PLACE
JUMPLE 14,CPOPJ ;STACK EMPTIED. ONLY PUSH ITEM IF REAL
SYLPSH: HRL 14,SVSTK ;OLD STACK POINTER,,BLOCK LEVEL
HRRZM 6,SVSTK ;STORE NEW TOP OF STACK
ADD 6,2(1)
ADDI 6,(1)
MOVEM 14,(6) ;STUFF DATA ON TOP OF STACK.
POPJ P,
CLASS: MOVEI 2,1 ;ASSUME CLASS 1
JUMPL 14,CLASS3 ;IF NEGATIVE IT MUST BE CLASS 3 OR 4
CAIGE 14,400000 ;LOWER SEGMENT
POPJ P, ;CLASS 1
CAIG 14,777777 ;UPPER SEGMENT
AOJA 2,CPOPJ ;YES - CLASS 2
CLASS3: MOVEI 2,3 ;CLASS 3 OR 4
TRNE 14,777777 ;ANYTHING IN RH?
MOVEI 2,4 ;YES. THIS IS CLASS 4
POPJ P,
SRTSAC: BLOCK 20 ;SAVE ACS DURING SORT
NBASE: 0
OPTR: 0
NPTR: 0 ;POINTER TO NEW SYMBOLS
CLASST: BLOCK 5 ;"CLASS 0" THRU CLASS 4
PD: 0
ID: 0
SVSTK: 0
DOSORT: 0 ;SET TO -1 WHEN /? SWITCH IS SEEN
END BEG