--- /dev/null
+/ OS/8 F4 LOADER, V24A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/
+/ FIXES FOR V23 J.K. 1975
+/
+/ .CORE ROUTINE- RECONIZE CORE RESTRICTION
+/
+/
+/
+/ CHAMGES FOR OS/8 V3D AND OS/78 BY P.T.
+/ .CHANGED VERSION NUMBER TO 24A
+/ .PUT IN NEW DATE ALGORITHM
+/
+/
+VERNUM=24
+PATCH="A
+
+ESDPG= 7400 /START OF ESD REFERENCE PG IN FIELD 1
+LHDR= 7200 /WD0 IN CORE OF LDR HDR IN FIELD 1
+OS8SWS= 7643
+OSJSWD= 7746
+OS8DCB= 7760
+OSDATE= 7666
+AC7776= CLL STA RAL
+AC7775= CLL STA RTL
+AC4000= CLA STL RAR
+AC2000= CLA STL RTR
+AC0002= CLA STL RTL
+
+/ PASS0 DEFINITIONS
+/ ----- -----------
+
+MCTTBL= 6000 /MODULE COUNT TABLE BASE
+OVTLEN= 2^20^7+2+1 /2 WORDS/OVERLAY, 2 FOR MAIN & 1 FGL
+OVLTBL= MCTTBL-OVTLEN /(FGL = FOR GOOD LUCK)
+MODTBL= 21^7+MCTTBL+3 /START OF MODULE TABLE
+NUMMOD= 7200-MODTBL%3 /NUMBER OF ENTRIES IN MODULE TABLE
+PTRIO= NDX6 /FLD1;INIT SET TO 7617-1
+RALFBF= 7000 /FLD1;BLK TO READ"ESD"FOR FILE CHK
+\f/LOADER IMAGE HEADER BLOCK DUMMY SECTION
+
+ NOPUNCH
+ *LHDR
+ 2 /LOADER IMAGE FILE ID
+QRTSWP, ZBLOCK 2 /SWAPPER ARGS TO LOAD AND START USER MAIN
+QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED BY THIS PROGRAM
+QVERNO, 0 /LOADER VERSION NUMBER
+QDPFLG, 0 /"D.P. HARDWARE REQUIRED" FLAG
+QUSRLV, ZBLOCK 40 /USER OVERLAY LEVEL DSRN INFO
+LDBUFS, ZBLOCK 50 /PASS2 BUFFER POINTERS
+ ENPUNCH
+
+
+ /RTS ENTRY POINTS
+ /** SOME OF THESE MAY CHANGE IN FUTURE VERSIONS OF RTS **
+ /** (I HOPE NOT)
+
+JARGER= 204
+JBAK= 210
+JDATE= 203
+JDEF= 213
+JDISMS= 412
+JENDF= 211
+JEOFSW= 16
+JEXIT= 223
+JHANG= 524
+JIDLE= 227
+JINT= 403
+JRDAO= 217
+JREADO= 221
+JRENDO= 206
+JRETRN= 235
+JREW= 212
+JRSVO= 207
+JRUO= 215
+JSWAP= 222
+JT812= 225
+JUERR= 204
+JWDAO= 216
+JWRITO= 220
+JWUO= 214
+\f *0
+TMP0, 0 /TMP0-TMP4 FOR GEN. USE
+TMP1, 0
+TMP2, 0
+TMP3, 0
+
+ *10 /INDEX REGISTERS
+NDX0, 0
+NDX1, 0
+NDX2, 0
+NDX3, 0
+NDX4, 0
+NDX5, 0
+NDX6, 0
+NDX7, OVLTBL-1 /POINTER INTO OVERLAY LENGTH TABLE
+
+USR, 200 /USR CALL: COULD BE 200 OR 7700
+PPACK, PACK /CHANGED TO TTYO BY ERROR ROUTINE
+IOFLG, 0
+SYMTM3, SYMTBL-3
+ORGFLG, 0
+RFPTR1, 0
+GPTR, 0
+LBPTR, 0
+TRPCNT, 0
+P2FLG, 0
+CZFLG, 0
+F1FLG, 0
+S8FLG, 0
+OVRFLO, -1
+SWITZ, -1
+SVMAIN, -4 /0 IF /S SPECIFIED
+DPFLG, 0
+
+\f/MORE PAGE ZERO LOCATIONS
+GTYP, 0
+EPTR, 0
+EPT2, 0
+ETYP, 0
+BPTR, 0
+BPT2, 0
+REFPTR, 0
+RLEN, 0
+FTMP0, 0;0
+RBLK, 0
+FATAL, 0
+BP, LDBUFS /POINTER INTO PASS2 BUFFER ARRAY
+A1, 1;0 /CURRENT ADDRESS IN FIELDS 1-7
+LNONUM, 0
+LBCNT, 0
+BLKCNT, 0
+TRAPV, 0;0
+BLKSIZ, 0
+BSECTP, 0 /POINTER INTO BINARY SECTION TABLE (PASS 2)
+OUTINH, 0
+BLKBEG, 0
+NEWBLK, 0
+NEWLEN, 0
+MCNT, 0
+MBGCNT, 0
+TMP4, 0
+TMP5, 0
+ PAGE
+\f/LOADER STARTS AT 200
+
+ ISZ .+2 /NON-CHAIN ENTRY
+ JMP I .+1 /CHAIN ENTRY
+ START
+
+/COME HERE TO READ/WRITE THE LOADER IMAGE.
+
+LDRIO, 0 /AC=4000 FOR WRITE, 0 FOR READ
+ DCA LDRIOC /STORE READ/WRITE
+ JMS I (NEWBUF
+ TAD BP
+ DCA LDRIOA
+ ISZ LDRIOA
+ TAD I LDRIOA
+ DCA LDRIOB /BLOCK #
+ ISZ LDRIOA
+ TAD I LDRIOA /NUMBER OF BLOCKS LEFT IN SECTION
+ SPA SNA
+ JMP LDRIOR /NULL BUFFER - JUST IN CASE
+ TAD [-4
+ SMA
+ CLA /IF >4 BLOCKS LEFT ONLY DO 4
+ TAD [4
+ CLL RTR
+ RTR
+ RTR
+ TAD LDRIOC /ADD READ/WRITE
+ CDF 0
+ TAD I (OUTFLD
+ TAD (-CDF
+ DCA LDRIOC /STORE R/W + BLOCK COUNT + FLD BITS
+ TAD BLKBEG
+ DCA LDRIOA
+ JMS I [IOHAN /DF MUST BE 0 HERE!
+ LIMGU /LOADER IMAGE FILE
+LDRIOC, 0
+LDRIOA, 0
+LDRIOB, 0
+ CDF 10
+LDRIOR, CLA
+ JMP I LDRIO
+\fSETBGX, 0
+ CLA IAC
+ TAD GPTR
+ JMS SETBPT /EXTREMELY COMMON SEQUENCE
+ JMP I SETBGX
+
+SETBPT, 0
+ DCA BPTR /STORE BPTR
+ CLA IAC
+ TAD BPTR
+ DCA BPT2 /AND PTR TO NEXT WD
+ JMP I SETBPT
+ORGMSG, TEXT /ILLEGAL ORIGIN/
+SYMMSG, TEXT /OVER SYMB/
+IOMSG, TEXT %LOADER I/O ERROR%
+ENTMSG, TEXT %OS/8 ENTER ERROR%
+ PAGE
+\f/TTYHAN- TTY HANDLER FOR OUTPUT OF ANY MESSAGE IN ANY FIELD.
+/ MESSAGE MUST BE FIELD CONTAINED & TERMINATE WITH 0
+/ HANDLER CAN BE CALLED ACROSS FLDS WITH AC CLR.
+/ RTN WITH"IF & DF" SET TO CALLING FLD.
+/
+/ CALL CDF X /X=FLD OF CALLER*10
+/ CIF Y /Y=FLD OF TTYHAN*10
+/ JMS TTYHAN
+/ CDF Z /Z=FLD OF MESS.BUF
+/ BUFADR /MESS BUF. ADDR.
+/
+TTYHAN, 0
+ TAD (6203 /SETUP MICRO INSTR
+ RDF /CDF & CIF FOR RTN
+ DCA CRLFF+1
+ TAD I TTYHAN /SET UP FLD OF
+ DCA TTYCDF /MESS BUF
+ ISZ TTYHAN
+ CMA
+ TAD I TTYHAN /SET UP MESS BUFF ADDR-1
+ DCA MESADR
+ ISZ TTYHAN
+ DCA MESADR+1
+TTYCDF, 0
+ JMS CRLF
+TTYLP, ISZ MESADR+1
+ JMP .+3
+ TAD I MESADR
+ JMP HAF
+ ISZ MESADR
+ CLA CMA
+ DCA MESADR+1
+ TAD I MESADR
+ RTR
+ RTR
+ RTR
+HAF, AND [77
+ SNA
+ JMP CRLFF
+ TAD [240
+ AND [77
+ TAD [240
+ JMS TTYO
+ JMP TTYLP
+CRLFF, JMS CRLF
+ 0
+ JMP I TTYHAN
+MESADR, 0
+ 0
+\fRTNOS8, 0 /HERE ON PASS1 FATAL ERROR
+ STA
+ CDF 10
+ DCA I (OVLTBL /PRINT SYMBOL MAP W/O OVERLAY LENGTH TABLE
+DOMAP, JMS I (SYMMAP
+ CDF
+ TAD I RTNOS8 /ADDR OF TTY
+ DCA .+3 /MSG
+ JMS I [TTYHAN
+ CDF
+ 0
+ TAD (TTYO
+ DCA PPACK /FAKE OUT SYMBOL PRINTER
+ TAD LNONUM
+ DCA GTYP /PUT LEVEL AND OVERLAY IN GTYP
+ JMS I (CVLOVL /OUTPUT LEVEL AND OVERLAY
+ AC7775
+ DCA TMP5 /PRINT 3 DIGIT FILE-WITHIN-OVERLAY
+ TAD MCNT
+ TAD MBGCNT
+ IAC
+ CLL RTL
+ RAL
+ JMS I (CVRT
+ JMS CRLF /OUTPUT CRLF AFTERWARDS
+ JMP I .+1 /RTN TO
+ 7605 /OS8
+
+LDRNAM, 1;0617;2224;2216;1404 /SYS:FORTRN.LD
+ ZBLOCK 5 /NO DEFAULT SYMBOL MAP DEVICE
+
+TTYO, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYO
+/
+CRLF, 0
+ TAD (215
+ JMS TTYO
+ TAD (212
+ JMS TTYO
+ JMP I CRLF
+\f/OS8ER- USED WHEN AN OS/8 ERROR OCCURS WHICH IS FATAL
+
+OS8ER, 0
+ CDF 0
+ JMS I [TTYHAN
+ CDF 0 /FLD OF MESS BUF
+ SYSERR /ADR OFMESS BUF
+ JMP I [7605 /RTN TO OS8
+
+SYSERR, TEXT /SYSTEM ERROR/
+TYTBL, 4040 /CHARS FOR SMAP
+ 0530 /EX (EXTERN)
+ 4040 /GOOD TYPES ARE
+ 4040 /SPACES
+ 1505 /ME (MUL ENTRY)
+ 1523 /MS (MUL SECTN)
+ 4040 /GEN 8MOD SECT
+ 4040 /8MOD COM SECT
+ 4040 /8MOD F1 SECT
+ PAGE
+\f/IOHAN- I/O HANDLER 1)FETCHES A OS8 DEVICE HANDLER;
+/ 2)CHKS FOR E.O.FILE;3)ISSUES CALL TO THE HANDLER.
+/ RTN TO CALLER WITH "IOFLG" SET IF
+/ NUM OF BLKS TRANSF LESS THAN REQ AMT.
+/ CAN BE CALLED FROM ANY FLD
+/ IF AC=0,DO ALL OF THE ABOVE.
+/ IF AC=DEV NUM,DO ONLY "FETCH"PART
+/
+/ CALL CDF X
+/ CIF Y
+/ JMS IOHAN
+/ ADDR /PTR TO UNIT,LEN,STBLK OF FILE IN FLD 1
+/ ARG(1)/OS8 ARG: FCN CTRL WD
+/ ARG(2)/ " : TRNASF BUF ADR
+/ ARG(3)/ " : REL STBLK OF TRANSF
+/
+IOHAN, 0
+ DCA UNITSV /SAV DEV NUM IF ONE
+ DCA IOFLG /CLR FLG
+ RDF
+ TAD P6201
+ DCA GETCDF+1
+ TAD P6203 /SETUP CIF & CDF FOR
+ RDF /RTN JMP
+ DCA RTNIO
+/FETCH A DEV HANDLER OR LOOKUP ENTRY PT
+/IF DESIRED HANDLER IS IN CORE
+ TAD UNITSV /GET DEV NUM IF ONE
+ SNA CLA /JUST A FETCH?
+ JMP .+3 /NO
+ JMS INQIRE /YES
+ JMP RTNIO
+ TAD I IOHAN /GET PTR TO UNIT(DEV NUM)
+ DCA ULSADR
+ CDF 10
+ TAD I ULSADR /GET DEV NUM
+ AND [17
+ SNA
+ JMS I [OS8ER
+ DCA UNITSV
+ JMS INQIRE
+/CHK FOR E.O.FILE
+ ISZ IOHAN
+ JMS GETCDF
+ TAD I IOHAN /GET FCN CTRL WD
+ CLL RTL /NUM OF PAGES IS CONVRTED
+ RTL /TO NUM BLKS & PUT
+ RTL /IN BITS 8-11
+ AND [17
+ DCA TMP0 /NUM BLKS TO TRANSF
+\f/SETUP FCN CTRL WD; TRANSF BUF ADR; & ABS STBLK OF TRANSF
+/FOR OS8 CALL TO HANDLER
+ TAD I IOHAN /FCN CTRL WD
+ DCA FCNWD
+ ISZ IOHAN
+ TAD I IOHAN /TRANSF BUF ADR
+ DCA FCNWD+1
+ ISZ IOHAN
+ TAD I IOHAN /GET REL STBLK & BUILD
+ TAD TMP0 /ABS STBLK
+ CIA CLL
+ ISZ ULSADR
+ CDF 10
+ TAD I ULSADR /FILE LEN-(REL STB+NUM BLKS)
+ SNL SZA /E.O.FILE CONDITION?
+ JMP .+3 /YES
+ CLA /NO
+ JMP SETSBN
+ TAD TMP0
+ SMA SZA /ANY BLKS TO TRANSF?
+ JMP IOH /YES
+ CLA /NO
+/CHK IF FILE LEN=0; IF SO DO SEQ STUFF
+ TAD I ULSADR
+ SNA CLA /SEQ DEV?
+ JMP IOH+1 /YES
+ CMA /NO,=-1 IF NUM BLKS TRANSF L.T. REQ
+ DCA IOFLG
+ JMP RTNIO
+IOH, DCA TMP0 /THIS NUM OF BLKS
+/UPDATE FCN CTRL WD IN OS8 CALL
+ TAD FCNWD
+ AND (4077 /REMOVE REQ NUM OF PGS
+ DCA FCNWD /& PUT IN THE
+ TAD TMP0 /ALTERED NUM
+ CLL RTR
+ RTR
+ RTR
+ TAD FCNWD
+ DCA FCNWD
+ CMA /=-1 IF NUM BLKS TRANSF L.T. REQ
+ DCA IOFLG
+/SETUP STARTING BLK NUMBER
+/
+SETSBN, ISZ ULSADR
+ CDF 10
+ TAD I ULSADR /GET ABS STBLK
+ JMS GETCDF /GET DF
+ TAD I IOHAN /ADD REL STBLK
+ DCA FCNWD+2
+ TAD I IOHAN /UPDATE REL STBLK
+ TAD TMP0 /BY NUM BLKS OF TRANSF
+ DCA I IOHAN
+\f/CALL TO THE HANDLER
+P6203, CIF CDF 0 /IOHAN & OS8 DEV HAN IN FLD 0
+ KSF /CHK FOR CTRLC
+ JMP .+5
+ KRS
+ TAD (-203
+ SNA CLA
+ JMP I [7605
+ JMS I IOENT
+FCNWD, 0
+ 0
+ 0
+ JMP HNDERR /ERROR RETURN OF CALL
+ ISZ IOHAN
+RTNIO, 0 /CIF INSTR
+ JMP I IOHAN
+IOENT, 0
+ULSADR, 0
+UNITSV, 0
+/
+GETCDF, 0
+ 0
+ JMP I GETCDF
+
+HNDERR, JMS I [RTNOS8
+ IOMSG
+\f/INQIRE- DETERMINE IF DESIRED DEV HANDLER IS IN CORE
+/ & IF SO,GET ITS ENTRY PT
+ DVTBL=7647
+INQIRE, 0
+ CDF 10
+ TAD UNITSV
+ TAD (DVTBL-1
+ DCA IOENT /ADR OF ENRTY PT IN RESID. TBL
+ TAD I IOENT /GET ENTRY PT IF ONE
+ DCA IOENT
+ TAD IOENT
+ SZA CLA /DEV HAN WAS IN CORE?
+ JMP I INQIRE /YES
+ TAD (7201 /NO
+ DCA P6201+4
+ TAD UNITSV /GET DEV NUM BK
+P6201, CDF 0
+ CIF 10
+ JMS I USR
+ 1
+ 0
+ JMS I [OS8ER
+ TAD .-2
+ DCA IOENT
+ JMP I INQIRE
+ PAGE
+\fNXTESD, 0
+ ISZ EPTR /ADV PTR TO
+ ISZ EPTR /WD 0 OF
+ TAD EPTR /NEXT ENTRY
+ AND [377 /IF AT BLK
+ SNA CLA /BOUNDARY
+ TAD [4 /BUMP IT FOUR
+ TAD EPTR
+ JMS I [SETEPT
+ TAD [3 /CHECK FOR
+ TAD EPTR /END OF
+ DCA TMP0 /ESD
+ TAD I TMP0 /TYPE WD
+ AND [17 /TO AC B8-B11
+ SZA /LAST ESD?
+ ISZ NXTESD /NO
+ DCA ETYP /SAVE TYPE
+ JMP I NXTESD
+\fADVOVR, 0 /UPDATE PASS1 PASS2 ARGS
+ ISZ MCNT /MORE MODS IN THIS OVR?
+ JMP SAMOVR /YES
+ JMS NXTOVR /SET ARGS FOR NEXT OVER
+ JMP EOLVL /RTN HERE= END OF LEVEL
+ TAD P2FLG /DOING PASS2 ?
+ SMA CLA
+ JMP BY10 /NO
+ TAD (2 /GET NEW LDR
+ TAD BSECTP /IMAGE REL BLK
+ DCA TMP0 /FOR NEXT OVR
+ TAD TMP0
+ DCA NDX0
+ TAD I NDX0 /LENGTH OF OVERLAY
+ TAD I TMP0 /PLUS OLD RELATIVE BLOCK
+ DCA I TMP0 /EQUALS NEW RELATIVE BLOCK
+BY10, TAD LNONUM /ADD 1 TO BITS
+ TAD (20 /4-7 OF LEVEL
+ DCA LNONUM /AND OVR LAY NUM
+ JMP SAMOVR
+EOLVL, JMS NXTOVR /GET NXT OVR NEW LEVEL
+ JMP SAMOV4 /HERE=END OF ALL LEVELS
+ TAD LNONUM /ADD 1 TO
+ AND [3400 /THE LEVEL
+ TAD (400 /BITS (1-3)
+ DCA LNONUM /AND CLEAR THE OVR BITS
+ TAD P2FLG
+ SMA CLA /DOING PASS2 ?
+ JMP BY7 /NO
+ TAD [4
+ TAD BSECTP /UPDATE BIN SECTION PTR
+ DCA BSECTP
+ JMP SAMOVR
+\fBY7, ISZ I (LEVSYM+2 /SET THE INTERNAL LEVEL SYMBOL TO LEVLN+1
+ TAD (LEVSYM /ENTER NEW
+ JMS I [LOOK /LEVEL SYMBOL INTO GST
+ TAD [4
+ TAD LNONUM /SET TYPE
+ DCA I GPTR /TO PROG SECTION
+ IAC /SET PTR TO
+ TAD GPTR /NEW LEVEL
+ DCA I [LVPTR
+LEVRND, TAD I BPT2
+ CLL
+ TAD [377 /ROUND UP OLD LEVEL
+ AND [7400 /TO A BLOCK BOUNDARY
+ SZL
+ ISZ I BPTR /MIND THE CARRIES!
+ DCA I BPT2
+SAMOVR, TAD [3 /ADV PTR TO
+ TAD RFPTR1 /NXT RALF
+ DCA RFPTR1 /MODULE
+ JMP I ADVOVR
+SAMOV4, ISZ ADVOVR /BUMP RETURN
+ TAD P2FLG
+ SPA CLA
+ JMP SAMOVR /SKIP ROUNDUP IF PASS 2
+ JMS I (LEVLUP /MERGE OVERLAY SIZE INTO LEVEL SIZE
+ JMP LEVRND /AND RND UP LAST LEVEL
+\fNXTOVR, 0 /HERE AT END OF OVERLAY
+ ISZ MTBL /GET NUM OF
+ TAD I MTBL /MOD IN NXT
+ SNA /OVR
+ JMP I NXTOVR /=END OF LEVEL
+ DCA MBGCNT
+ TAD MBGCNT
+ CIA
+ DCA MCNT
+ TAD P2FLG
+ SMA CLA
+ JMS I (LEVLUP /SET CUR. LEVL =MAX (CUR LEVL, CURNT OVR)
+ ISZ NXTOVR /RTN P+1 IF
+ JMP I NXTOVR /NOT END OF LEVEL
+
+
+SETCNT, 0
+ TAD (MCTTBL+1 /PTR TO MOD
+ DCA MTBL /COUNT TBL
+ TAD I MTBL /-NUM IN
+ DCA MBGCNT
+ TAD MBGCNT
+ CIA /MAIN
+ DCA MCNT
+ TAD (MODTBL+3 /PTR TO TOP
+ DCA RFPTR1 /OF MOD TBL
+ DCA I (OVRSIZ
+ DCA I (OVRSIZ+1
+ JMP I SETCNT
+MTBL, 0
+ PAGE
+\f/LOOKUP OR ENTER A SYMBOL INTO
+/GLOBAL SYMBOL TABLE (GST). PTR
+/TO SYMBOL IN FIELD 1 IS IN
+/AC. USUALLY ITS AN ESD.
+/RTN P+1=NO MATCH
+/RTN P+2=MATCH
+
+LOOK, 0
+ DCA TMP0 /PTR TO SYM
+ CDF 10
+ TAD I TMP0 /SELECT
+ RTR /BUCKET
+ RTR /A-Z, SPACE
+ RTR /OR POUND
+ AND [77
+ TAD (BUCKET-1 /PTR TO BUCKET
+LOP5, DCA TMP1 /PTR TO PREV ENTRY
+ TAD I TMP1 /PTR TO NEXT ENTRY
+ SNA /0=BUCKET BOTTOM
+ JMP HOOKIN /NO MATCH
+ IAC /APPEND SYMBOL
+ DCA GPTR /LOOK FOR
+ AC7775 /3 WORD MATCH
+ DCA TMP2
+ TAD TMP0
+ DCA EPTR
+YUCCH, TAD I EPTR
+ CIA CLL
+ TAD I GPTR
+ SZA CLA
+ JMP YECCH /SYMBOLS DIFFER
+ ISZ EPTR
+ ISZ GPTR
+ ISZ TMP2 /ALL MATCH?
+ JMP YUCCH /NO
+ ISZ LOOK /BUMP RTN
+SETTYP, TAD I EPTR /GET ESD TYPE
+ AND [17
+ DCA ETYP
+ CLA IAC
+ TAD EPTR
+ JMS I [SETEPT /BUMP EPTR AND SET EPT2
+ TAD I EPTR /GET ESD NUM
+ RTR /IN B1-B7
+ RTR /AND SET
+ AND (177 /REFERENCE
+ TAD (ESDPG /POINTER
+ DCA REFPTR
+ TAD I GPTR /SET GST
+ AND [17 /TYPE
+ DCA GTYP /FIELD BITS OF
+ TAD I EPTR /VALUE WORDS
+ AND [7 /CLR
+ DCA I EPTR /HI 9
+ JMP I LOOK
+\fYECCH, SZL /IS NEW GUY LESS THAN GST ENTRY?
+ JMP HOOKIN /YES HOOK-IN HERE
+ TAD I TMP1
+ JMP LOP5 /TRY NEXT
+HOOKIN, TAD I TMP1 /GET FWD LINK
+ DCA I NDX4 /TO NEXT INTO
+ TAD NDX4 /NEW. PUT FWD
+ DCA I TMP1 /LINK TO NEW INTO PREV.
+ TAD TMP0 /3 SYM
+ DCA EPTR /INTO GST
+ AC7775
+ DCA TMP2
+ TAD I EPTR
+ DCA I NDX4
+ ISZ EPTR
+ ISZ TMP2
+ JMP .-4
+ ISZ NDX4 /SET PTR TO
+ TAD NDX4 /WORD 4 (TYPE)
+ DCA GPTR /OF GST
+ ISZ NDX4 /SET PTR TO NEXT
+ ISZ NDX4 /FREE ENTRY
+ TAD [7 /SEE IF
+ TAD NDX4 /GST IS FULL
+ TAD ENDSYM /END OF GST
+ SPA SNA CLA
+ JMP SETTYP /ITS OK
+ JMS I [RTNOS8 /SYMBOL TABLE
+ SYMMSG /OVER FLOW
+ENDSYM, 1-OVLTBL
+
+SETEPT, 0
+ DCA EPTR
+ CLA IAC
+ TAD EPTR
+ DCA EPT2 /SET PTR TO BOTH WDS OF DBLWD
+ JMP I SETEPT
+\fGETTYP, 0 /ADV GST PTR
+ TAD [7 /TO WD 4 OF
+ TAD GPTR /ENTRY
+ DCA GPTR /CHECK FOR
+ TAD GPTR
+ TAD ENDSYM
+ SMA CLA
+ JMP I GETTYP
+ TAD I GPTR /END OF GST.
+ SZA CLA /IF NOT END,
+ ISZ GETTYP /ISZ RETURN.
+ JMP I GETTYP
+
+OLINE, 0 /OUTPUT A LINE OF TEXT TO THE SYMBOL MAP
+ DCA TMP5
+OLINLP, TAD I TMP5
+ JMS I (HAFWD
+ TAD I TMP5
+ ISZ TMP5
+ AND [77
+ SZA CLA
+ JMP OLINLP
+ JMS I [PCRLF /DOUBLE SPACE AFTERWARDS
+ JMS I [PCRLF
+ JMP I OLINE
+ PAGE
+\f/HERE TO OUTPUT SYMBOL MAP
+/EACH SYMBOL IN GST IS 7 WORDS LONG
+/THE FORMAT IS:
+/WD0 PTR TO NEXT ALPHABETICAL SYMBOL
+/WD1 SYMBOL NAME IN PACKED SIX BIT
+/WD2 ASCII. 00 IS INTERPRETED AS SPACE
+/WD3 SIX CHARS MAX PER SYMBOL
+/WD4 B0=1=TRAP VECT SYMBOL ON PASS1 OR
+/ B0=1=PASS2 ERROR, B1-B3=LEVEL NUM
+/ (0-7) B4-B7=OVERLAY NUM (0-17)
+/ B8-B11=TYPE. TYPE FORMAT IS:
+/ 0=END OF ESD TBL (NA TO LDR)
+/ 1=ENTRY POINT
+/ 2=EXTERN
+/ 3=COMMON SECTION
+/ 4=PROGRAM SECTION
+/ 5=MULTIPLE ENTRY POINT
+/ 6=MULTIPLE SECTION
+/ 7=GENERAL 8-MODE SECTION
+/ 10=FIELD1 8-M0DE SECTION
+/ 11=COMMON PG0 8-MODE SECTION
+/ 12-17=UNDEFINED
+/
+/WD5 B0-B8=PTR TO PARENT SYMBOL (0R 0)
+/ ON PASS1 =TRAP VECTOR DISPLACEMENT
+/ ON PASS2
+/ B9-B11=FIELD BITS OF SYMBOL
+/WD6 ADDR BITS OF SYMBOL
+
+/OUTPUT FORMAT OF MAP IS:
+/
+/SYMBOL VALUE LEVEL OVRNUM TYPE(*)
+/
+/THE TYPE COLUMN IS EITHER 2 BLANKS OR
+/EX=EXTERN
+/ME=MULTIPLE ENTRY POINT
+/MS=MULTIPLE SECTION
+/ASTERISK MEANS SOME TYPE OF ILLEGAL
+/REFERENCE TO A SYMBOL AND USUALLY
+/MEANS A LOADER ORIGINATED TRAP HAS
+/BEEN GENERATED SOMEWHERE IN THE BINARY
+/E.G. SUBR GROG AT LEVEL 2 CALLS SUBR
+/COLUMBO AT LEVEL 1. A USER 7 TRAP
+/WOULD BE GENERATED IN SUBR GROG, AND
+/THE SYMBOL COLUMBO WOULD HAVE AN
+/ASTERISK ASIDE OF IT IN THE TYPE
+/COLUMN
+\fSYMMAP, 0
+ CDF
+ TAD I (LDRNAM+5 /MAP UNIT
+ SNA /IS IT 0 ?
+ JMP NOMAP /YES, NO MAP TO OUTPUT
+ JMS I [IOHAN /FETCH HANDLER
+ TAD I (LDRNAM+5 /ENTER OUTPUT
+ CIF 10
+ JMS I USR
+ 3
+MPBLK, LDRNAM+6
+ 0
+ JMP ENTERR /WHOOPS WE HAVE AN ENTER ERROR
+ TAD I (LDRNAM+5
+ AND [17
+ CDF 10
+ DCA I (SMAPU /STORE SYMBOL MAP UNIT
+ TAD (SMAPU /SYMMAP ARGS
+ DCA NDX0 /FOR I/O
+ TAD MPBLK+1 /LENGTH
+ CIA
+ DCA I NDX0
+ TAD MPBLK
+ DCA I NDX0
+ TAD (BUCKET /START AT 1ST
+ DCA RLEN /BUCKET (A)
+ TAD (-42 /DO UP UNTIL BUT NOT INCL.
+ DCA RBLK /POUND SIGN
+ AC7775 /INIT PACK ARGS
+ DCA FATAL
+ TAD (RALFBF
+ DCA TMP4
+ TAD SM600
+ DCA BLKCNT
+ JMS I [PCRLF
+ TAD (TLINE
+ JMS I (OLINE
+ TAD (STLINE
+ JMS I (OLINE /OUTPUT TITLE AND SUBTITLE
+ TAD I RLEN /1ST SYM
+LOP10, DCA GPTR
+ TAD GPTR /ANY MORE IN
+ SZA /THIS BUCKET ?
+ JMP JOUSYM /YES
+ ISZ RLEN /NXT BUCKET
+ ISZ RBLK /DONE ALL
+ JMP LOP10-1 /NO
+ ISZ SWITZ /BEEN HERE BEF?
+ JMP DUNMP /YES ALL DONE
+ CLA CMA /SET FOR JUST
+ DCA RBLK /POUND SYMS
+ TAD SVMAIN
+ SNA /DO ONLY #MAIN?
+ JMP LOP10-1 /NO - DO ALL # SYMBOLS
+PRMAIN, CLA /** REPLACED WITH JMS I (OUTSYM **
+\fDUNMP, TAD [-4 /OUT PUT
+ DCA TMP5 /THE HIGHEST LOCATION
+ TAD A1 /USED BY THE PROGRAM
+ TAD (4060 /FLD BITS
+ JMS HAFWD
+ TAD A1+1
+ JMS I (CVRT
+ TAD (HLINE
+ JMS I (OLINE /PRINT " = HIGHEST LOC USED"
+ JMS I (PROVLY /PRINT OVERLAY TABLE
+SM600, CLA /** AC NOT 0 ON RETURN**
+ TAD (214
+ JMS I PPACK
+ TAD (232 /CTRL Z
+OUFILP, JMS I PPACK
+ TAD BLKCNT /HAVE WE FILLED
+ TAD [600 /A BLOCK UP COMPLETELY?
+ SZA CLA
+ JMP OUFILP /NO
+ CDF /CLOSE SYMMAP
+ TAD I (SYLST /AC=LENGTH
+ DCA SMPCLN
+ TAD I (LDRNAM+5 /MAP UNIT
+ CIF 10
+ JMS I USR
+ 4
+ LDRNAM+6
+SMPCLN, 0
+ JMS I [OS8ER
+NOMAP, CDF 10
+ JMP I SYMMAP
+JOUSYM, JMS I (OUTSYM
+ TAD I GPTR /NEXT SYM TO DO
+ JMP LOP10
+\fHAFWD, 0 /OUTPUT THE 2 6 BIT ASCII CHARS IN AC
+ DCA TMP3
+ TAD TMP3 /LEFT HALF 1ST
+ RTR
+ RTR
+ RTR
+ JMS SIXTO8
+ TAD TMP3
+ JMS SIXTO8
+ JMP I HAFWD
+
+SIXTO8, 0 /CVRT AC FROM
+ AND [77 /6 TO 8 BIT ASCII
+ SZA
+ TAD [240 /TURN ZEROS TO BLANKS
+ AND [77
+ TAD [240
+ JMS I PPACK /PUT IN BUFF IN PS/8 FORMAT
+ JMP I SIXTO8
+
+ENTERR, DCA I (DOMAP /CANCEL SYMBOL MAP FROM RTNOS8
+ JMS I [RTNOS8 /AS WE MASY HAVE COME FROM SYMMAP
+ ENTMSG
+ PAGE
+\f/PACK ASCII IN AC INTO OUTPUT BUFF IN
+/OS/8 3 WORD FORMAT TO 2 12 BIT WORDS
+
+PACK, 0
+ ISZ FATAL /3RD WORD ?
+ JMP ONEOR2 /NO
+ DCA TMP0 /SAVE CHAR
+ AC7776 /BU BUFF PTR
+ TAD TMP4
+ DCA TMP4
+ AC7775
+ DCA FATAL /RESET CNTR
+ JMS ROL /POSITION HI
+ DCA I TMP4
+ ISZ TMP4
+ JMS ROL /POSITION LO
+ONEOR2, DCA I TMP4
+ ISZ TMP4
+ ISZ BLKCNT /BLOCK FULL ?
+ JMP I PACK /NO
+ JMS WRBUF
+ TAD SBPTR
+ DCA TMP4 /RESET ARGS
+ TAD (-600
+ DCA BLKCNT
+ JMP I PACK
+
+ROL, 0
+ TAD TMP0 /3RD CHAR
+ RTL /POSITION
+ RTL /BITS
+ DCA TMP0 /SAV FOR NXT CALL ON LO
+ TAD TMP0
+ AND [7400
+ TAD I TMP4 /ADD IN OLDY
+ JMP I ROL
+
+WRBUF, 0 /WRITE OUT
+ CDF /SYM MAP
+ JMS I [IOHAN /BUFFER
+ SMAPU /ADDR OF SYM U
+ 200^1!4000!10 /1 BLK OF FLD 1
+SBPTR, 7000 /1ST ADDR
+SYLST, 0 /REL BLK
+ CDF 10
+ JMP I WRBUF
+\fCVRT, 0 /CONVERT AC TO
+ DCA CVRTMP /ASCII NUM
+ TAD TMP5 /-NUM OF DIGITS
+ DCA TMP1 /TO CONVERT
+LOP7, TAD CVRTMP /CVRT LEFT TO
+ RTL /RIGHT
+ RAL /3 BITS PER
+ DCA CVRTMP /DIGIT
+ TAD CVRTMP
+ RAL
+ AND [7
+ TAD (260
+ JMS I PPACK
+ ISZ TMP1 /ENOUGH ?
+ JMP LOP7 /NO
+ JMS I (HAFWD /OUTPUT A PAIR
+ JMP I CVRT /OF SPACES
+
+OUTSYM, 0 /DO ONE SYMBOL
+ DCA NDX1 /ADDRESS IN AC ON ENTRY
+ AC7775
+ DCA TMP2
+ TAD I NDX1 /SYMBOL IS 1ST
+ JMS I (HAFWD
+ ISZ TMP2
+ JMP .-3
+ TAD I NDX1 /SAVE
+ DCA GTYP /TYPE
+ TAD I NDX1 /FLD OF SYMBOL
+ JMS PR15
+ JMS CVLOVL /CONVERT ADDR, LEVEL, OVERLAY
+ TAD GTYP /NOW DO TYPE
+ AND (17 /ITS B8-B11
+ TAD (TYTBL-1 /PTR TO TBL OF
+ DCA TMP0 /CHAR PAIRS FOR
+ CDF 0
+ TAD I TMP0 /TYPE EG EX FOR
+ CDF 10
+ JMS I (HAFWD /EXTERN
+ TAD GTYP /IF ERROR WAS
+ SPA CLA /FOUND DURING PASS2 B0 OF TYPE=1 EG ILLEGAL SUBR CALL. * ON MAP INDICATES
+ TAD (12 /PASS2 ERROR
+ TAD [240
+ JMS I PPACK
+ JMS PCRLF
+ JMP I OUTSYM
+
+CVRTMP, 0
+\fCVLOVL, 0
+ CLA CMA
+ DCA TMP5 /DO LEVEL NUM
+ TAD GTYP /ITS B1-B3 OF
+ RAL /OF TYPE WORD
+ JMS CVRT
+ AC7776 /DO OVER NUM
+ DCA TMP5 /ITS B4-B7 OF
+ TAD GTYP /TYPE WORD
+ RTL /POSITION INTO
+ AND (1700 /HI 2 DIGITS
+ JMS CVRT
+ JMP I CVLOVL
+
+PCRLF, 0
+ TAD (215 /EOL
+ JMS I PPACK
+ TAD (212
+ JMS I PPACK
+ JMP I PCRLF
+
+PR15, 0
+ AND [7
+ TAD (4060
+ JMS I (HAFWD
+ TAD [-4 /NOW DO ADDR OF
+ DCA TMP5 /SYMBOL
+ TAD I NDX1
+ JMS CVRT
+ JMP I PR15
+ PAGE
+\f/PASS 2 OF LOADER - TRANSFORMS BINARIES INTO LOADER IMAGE FILE
+
+PASS2, DCA LNONUM /SET FOR MAIN
+ JMS I (BLDTV /BUILD TRAP VECTOR
+ TAD LBCNT /PROCESS LIBR
+ CIA /MODULES 1ST
+ SNA /ANY TO DO?
+ JMP BY12 /NO
+ DCA LBCNT /=-NUM TO DO
+ TAD LBPTR /PTR TO 1ST
+ DCA RFPTR1 /LIBR MOD
+ JMS SETREF /INIT RELOC ARGS AND PROCESS TXT
+ TAD [3 /ADV TO NXT
+ TAD RFPTR1 /LIBR MOD.
+ DCA RFPTR1
+ ISZ LBCNT /DONE LIBR?
+ JMP .-5 /NO
+BY12, JMS I (SETCNT /SET ARGS TO PROCESS USER MODS.
+ JMS SETREF /DO 1 MOD
+ JMS I (ADVOVR /ADVANCE ARGS
+ JMP .-2 /RTN HERE IF MORE TO DO
+ JMS I (WRALL /WRITE OUT ALL THE RESIDENT BIN BLOCKS
+\f/END OF PASS 2 - RETURN TO OS8 OR CHAIN TO RSYS
+
+ TAD (7616
+ DCA NDX0
+ TAD I (LIMGU /SAVE UNIT AND BLOCK OF LOADER IMAGE
+ DCA I NDX0 /FILE IN CD AREA IN CASE WE CHAIN
+ TAD I (LIMGU+2
+ DCA I NDX0 /TO THE RUN-TIME-SYSTEM
+ DCA I NDX0 /A PRECAUTION
+ CDF 0
+ CIF 10
+ JMS I USR
+ 10 /LOCK USR IN
+ TAD (200
+ DCA USR
+ TAD I (LDRNAM
+ CIF 10
+ JMS I USR
+ 4
+ LDRNAM+1 /CLOSE LOADER IMAGE FILE
+LDCLEN, 0
+ JMS I [OS8ER /OOPS!
+ JMS I (SYMMAP /PRINT SYMBOL TABLE IF REQUESTED
+ TAD I (OS8SWS
+ CDF 0
+ AND (40 /TEST /G SWITCH
+ SNA CLA
+ JMP I [7605 /NOT ON - RETURN TO OS8
+ CLA IAC
+CHAIN, CIF 10
+ JMS I USR
+CHCODE, 2
+ RTSNAM /LOOKUP RTS
+ 0
+ JMP NORTS
+ TAD (6
+ DCA CHCODE /CHANGE LOOKUP TO CHAIN
+ JMP CHAIN
+
+NORTS, DCA I (LDRNAM+5 /KILL SECOND STORAGE MAP
+ JMS I [RTNOS8
+ RTSMSG
+RTSNAM, 0622;2423;0000;2326 /FRTS.SV
+\fSETREF, 0
+ JMS I (RDRLES /GET MODULE ESD TABLE
+ AC7776
+ DCA EPTR
+LOP12, JMS I .+4 /GET NXTESD
+ JMP BY11 /ALL DONE
+ TAD EPTR /LOOK UP
+ JMS I [LOOK /SYMBOL
+ NXTESD
+ CLA CMA /IGNORE ESD IF
+ TAD ETYP /ITS AN ENTRY
+ SNA CLA /POINT
+ JMP LOP12 /IGNORE
+ TAD GPTR /PUT ADDR OF
+ DCA I REFPTR /GST SYM IN
+ JMP LOP12 /ESD REF. PAGE
+BY11, CDF 0 /COMPUTE 1ST
+ TAD EPTR /TEXT BLK
+ AND [7400
+ CLL RTL
+ RTL
+ RAL
+ IAC
+ DCA I (TXTBLK
+ CLA CMA /SET CNT TO -1
+ DCA BLKCNT /TO KICK OFF 1ST TXT READ
+ TAD RFPTR1 /PTR TO
+ DCA I (TXTBLK-3 /RALF MOD
+ CDF 10
+ JMS I (TXTSCN /RELOCATE
+ JMP I SETREF /TEXT
+ PAGE
+\fBLDTV, 0 /BUILD UP
+ TAD TRPCNT /TRAP VECTOR
+ SNA CLA /ANY TO DO?
+ JMP I BLDTV /NO
+ TAD .+2 /GET BASE
+ JMS I [LOOK /ADDR OF
+ TRPSYM /TRAP VECT
+ ISZ GPTR
+ TAD I GPTR
+ DCA TMP0
+ ISZ GPTR
+ TAD I GPTR
+ DCA TMP1
+ TAD TMP0 /FOR SUBR
+ DCA TRAPV /TRPVEC
+ TAD TMP1
+ DCA TRAPV+1
+ JMS NEWORG /PROCESS NEW ORIGIN
+ DCA TRPCNT /WILL BE USED TO MARK GST SYMS
+ TAD .+2 /THAT HAVE A VECTOR ENTRY
+ JMS I [LOOK /GET SWAPPER
+ SWPSYM /ADDR
+ ISZ GPTR
+ ISZ GPTR
+ TAD I GPTR
+ DCA RFPTR1
+\f TAD SYMTM3 /SCAN GST
+LOP11, DCA GPTR /FOR ALL
+ JMS I [GETTYP /TRAP SYMS
+ JMP I BLDTV /ALL DONE
+ TAD I GPTR /IF TYPE WD
+ SMA CLA /B0=1, THEN SYMBOL NEEDS A VECTOR ENTRY
+ JMP LOP11+1 /TRY NEXT 1ST WD OF ENTRY IS
+ TAD (3000 /TRAP3
+ JMS I [PUTBIN
+ TAD RFPTR1 /NXT IS
+ JMS I [PUTBIN /SWAP ADDR
+ CLL CML CLA RAR /CLR B0
+ TAD I GPTR /OF TYPE WD
+ DCA I GPTR
+ TAD I GPTR
+ ISZ GPTR
+ RTL
+ RTL
+ DCA TMP0 /HAVE TO MUSH SOME BITS AROUND:
+ TAD TMP0 /OVERLAY NUMBER MOVES FROM B4-7 TO B0-3
+ AND [7400
+ DCA TMP1 /LEVEL NUMBER MOVES FROM B1-3 TO B6-8
+ TAD TMP0
+ RTL
+ RTL
+ AND (70
+ TAD TMP1
+ TAD I GPTR /ADD FLD BITS TO MESS
+ JMS I [PUTBIN
+ TAD TRPCNT /ADV VECT
+ TAD (10 /ENTRY NUM
+ DCA TRPCNT /COUNTER
+ TAD I GPTR /TAG HI 9
+ TAD TRPCNT /OF GST SYM
+ DCA I GPTR /WD5 WITH TV ENTRY NUMBER
+ ISZ GPTR
+ TAD I GPTR /ENTER
+ JMS I [PUTBIN /ADDR
+ AC7776
+ TAD GPTR
+ JMP LOP11 /FOR THIS SYM
+\fNEWORG, 0
+ TAD BSECTP
+ JMS I [SETEPT /SET PTR TO CURRENT SECTION
+ TAD I EPT2
+ CIA CLL
+ TAD TMP1
+ DCA TMP3
+ TAD TMP3
+ AND (6000
+ DCA TMP2 /DO A DOUBLE PRECISION SUBTRACT
+ CML RAL
+ TAD I EPTR
+ CIA CLL
+ TAD TMP0
+ SPA
+ JMP BADORG /OUT OF RANGE
+ CLL RAR
+ TAD TMP2 /COMBINE AND SHIFT RIGHT 8
+ RAL
+ RTL
+ RTL /(I.E. LEFT 5)
+ DCA TMP2
+ TAD TMP2
+ ISZ EPT2
+ TAD I EPT2 /ADD TO RELATIVE BLOCK OF SECTION
+ DCA NEWBLK
+ ISZ EPT2
+ TAD TMP2
+ CIA
+ TAD I EPT2
+ SPA
+ JMP BADORG /ORIGIN OUT OF RANGE
+ DCA NEWLEN
+ JMS I (NEWBB /GET BUFFER USING NEWBLK AND NEWLEN
+ TAD TMP3
+ AND (1777
+ TAD BLKBEG
+ DCA BLKSIZ /FORM POINTER INTO PROPER BUFFER
+ JMP I NEWORG
+BADORG, JMS I [RTNOS8
+ ORGMSG /ORIGIN OUT OF CURRENT FILE LIMITS
+ JMP I NEWORG
+ PAGE
+\fPROVLY, 0 /ROUTINE TO PRINT OVERLAY INFO IN SYMBOL MAP
+ JMS I [PCRLF
+ TAD (OTLINE
+ JMS I (OLINE
+ TAD (OVLTBL-1
+ DCA NDX1
+PROVLP, TAD I NDX1 /GET ENTRY
+ SPA /TEBLE ENDS WITH -1
+ JMP I PROVLY
+ DCA GTYP
+ TAD [240
+ JMS I PPACK
+ JMS I (CVLOVL /PRINT LEVEL AND OVERLAY
+ TAD GTYP
+ JMS I (PR15 /PRINT 15-BIT LENGTH
+ JMS I [PCRLF
+ JMP PROVLP
+
+RDRLES, 0 /READ A
+ TAD RFPTR1 /PTR TO RALF
+ DCA RLARG-1 /MOD
+ DCA RLARG+2 /STRT AT BLK 0
+ CDF /AND READ
+ JMS I [IOHAN /3 BLKS INTO
+ 0 /10000-11400
+RLARG, 200^3!10
+ 0
+ 0
+ CDF 10
+ JMP I RDRLES
+\f/STARTING WITH THE LATEST,
+/WRITE OUT ALL CORE RESIDENT
+/BINARY BUFFERS
+
+WRALL, 0
+ TAD BP
+ IAC /PTR TO
+ DCA TMP0 /CURNT BLK
+ TAD I TMP0
+ SNA CLA /ALL DONE ?
+ JMP I WRALL /YES
+ AC4000
+ JMS I (LDRIO /WRITE IT
+ TAD I BP
+ SNA
+ JMP I WRALL
+ DCA BP
+ JMP WRALL+1
+
+NOTREL, JMS I [RTNOS8
+ RELMSG
+
+RELMSG, TEXT /BAD INPUT FILE/
+
+RTSMSG, TEXT /NO FRTS/
+\fMERGE, 0
+ JMS I (GETTXT /COMBINE TXT
+ DCA FTMP0 /PAIR WITH
+ JMS I (GETTXT /PAIR WHOSE
+ DCA FTMP0+1 /ADDR IS IN BPTR
+ CLL
+ TAD I BPT2
+ TAD FTMP0+1
+ DCA TMP1
+ RAL
+ TAD I BPTR
+ TAD FTMP0
+ AND [7
+ DCA TMP0
+ TAD FTMP0 /GET THE OPCODE OR WHATEVER
+ AND [7770 /IS IN THE HIGH 9 BITS
+ TAD TMP0 /AND COMBINE THEM WITH THE RELOCATED ADDRESS
+ JMS I [PUTBIN /AND OUTPUT THE MESS
+ TAD TMP1
+ JMS I [PUTBIN /DON'T FORGET WORD 2
+ JMP I MERGE
+
+GETCTL, 0 /GET TEXT
+ JMS I (GETTXT /CTRL WORD
+ DCA TMP0 /B4-B11
+ TAD TMP0 /IS TYPE
+ AND [377 /INDICATOR
+ DCA REFPTR /SOMETIMES
+ TAD REFPTR /ITS AN ESD.
+ TAD (ESDPG /WHEN IT IS,
+ DCA GPTR /GPTR PNTS
+ TAD I GPTR /TO THE
+ DCA GPTR /CORRESPONDING GST SYM (WORD 4)
+ JMS I [SETBGX /AND BPTR POINTS TO THE VALUE
+ TAD TMP0 /TEXT TYPE
+ RTL /IS IN
+ RTL /B0-B3
+ RAL /PUT IN
+ AND [17 /AC8-AC11
+ TAD GETCTL
+ DCA GETCTL /USE IT TO BUMP RETURN ADDRESS
+ JMP I GETCTL
+ PAGE
+\f/COME HERE ON ORIGIN OR WHEN CROSSING
+/AN AREA BOUNDARY TO SELECT A BINARY
+/CORE BUFFER FOR A NEW LOADER IMAGE
+/AREA. THE BINARY BUFFER TABLE
+/ASSOCIATES CORE BUFFERS TO LOADER
+/IMAGE AREAS.
+
+/EACH ENTRY HAS FOUR WORDS - THEY CONTAIN:
+
+/WORD 1 POINTER TO BUFFER OF NEXT EARLIEST REFERENCE
+/WORD 2 RELATIVE BLOCK NUMBER (0 IF UNUSED)
+/WORD 3 NUMBER OF BLOCKS LEFT UNTIL END OF SECTION
+/WORD 4 BUFFER ADDRESS AND FIELD
+
+/EACH ENTRY MAPS FROM 1 TO 4 BLOCKS (400 TO 2000 OCTAL WORDS) FROM THE
+/ADDRESSES GENERATED BY THE LOADER ONTO THE LOADER IMAGE FILE.
+/THE RELATIVE BLOCK NUMBERS ARE ALWAYS OF THE FORM S+4N, WHERE
+/S IS THE RELATIVE BLOCK NUMBER OF THE NEAREST BINARY SECTION
+/ (A BINARY SECTION IS AN OVERLAY OR "MAIN").
+
+/THE BUFFERS ARE ORGANIZED AS A CHAIN IN ORDER OF REFERENCE,
+/WITH WORD 1 BEING THE LINK TO THE NEXT EARLIEST BUFFER. IN CASE
+/A BUFFER NEEDS TO BE WRITTEN THE CHAIN IS TRAVERSED AND THE LAST BUFFER
+/WRITTEN OUT, SINCE IT WAS THE LEAST RECENTLY ACCESSED.
+\fNEWBB, 0 /ENTER WITH NEW
+ TAD BP
+ DCA NDX5 /SAVE CURRENT "MOST RECENT" BUFFER
+ TAD I NDX5
+ CIA
+ TAD NEWBLK /CHECK WHETHER THE BUFFER WE WANT
+ SNA CLA /IS THE CURRENT BUFFER
+ JMP QUIKIE /YES - SAVE GRIEF
+NEWBB4, TAD BP /MAKE THE CURNT
+ DCA BPPREV /BUFFER THE PREVIOUS BUFF
+ TAD I BP /MAK THE BUF OF
+ DCA BP /NEXT EARLIEST REFERENCE THE NEW CURNT BUFF
+ TAD BP /GET THE PTR TO
+ IAC /LDR IMAGE BLK
+ DCA CURBLK /IN THIS BUFF
+ TAD I CURBLK /HAVE WE SCANNED
+ CIA /IS NEWBLK
+ TAD NEWBLK /IN CORE
+ SNA CLA /?
+ JMP GOTBLK /YES
+ TAD I BP /ARE WE AT THE
+ SZA CLA /BUFFER OF EARLIEST REF?
+ JMP NEWBB4 /NO DO NEXT
+ STL /INITIALIZE LINK AS FLAG
+ TAD I CURBLK /IS THERE A
+ SNA CLA /BLK TO WRITE?
+ JMP VIRGIN /NO - NONE TO READ, EITHER
+ AC4000
+ JMS I (LDRIO /YES WRITE IT
+ CLL /SET FLAG THAT BUFFER WAS WRITTEN
+VIRGIN, TAD NEWBLK
+ DCA I CURBLK
+ ISZ CURBLK
+ TAD NEWLEN /STORE NEW BLOCK # AND LENGTH
+ DCA I CURBLK /IN BUFFER CONTROL WORD
+ RAR /GET "VIRGIN FLAG"
+ DCA NEWBUF
+ TAD MAXBLK
+ CMA CLL
+ TAD NEWBLK /CHECK IF THE BLOCK WE'RE MAPPING
+ SNL CLA /IS LARGER THAN ANY OTHER SO FAR -
+ JMP .+3 /IF SO WE DON'T HAVE TO READ IT
+ TAD NEWBLK
+ DCA MAXBLK /UPDATE MAXBLK
+ TAD NEWBUF /LINK = MAX FLAG, SIGN = VIRGIN FLAG
+ SNL SMA CLA /IF NEITHER IS ON,
+ JMS I (LDRIO /READ THE BLOCKS INTO THE BUFFER
+GOTBLK, TAD I BP
+ DCA I BPPREV /BREAK NEW BUFFER OUT OF THE CHAIN
+ STA
+ TAD NDX5 /NDX5 CONTAINS PTR TO OLD "MOST RECENT" + 1
+ DCA I BP /MAKE NEW BUFFER THE BUFFER OF LATEST REFERENCE
+QUIKIE, JMS NEWBUF /SET UP FOR PUTBIN
+ JMP I NEWBB /AND RETURN
+\f/COME HERE TO CUMPUTE A 15 BIT
+/BUFFER ADDRESS FROM AN ENTRY
+/IN THE BINARY BUFFER TABLE.
+
+NEWBUF, 0
+ TAD [3
+ TAD BP
+ DCA OUTFLD
+ TAD I OUTFLD /LOAD ADRESS AND FIELD
+ AND (7600
+ DCA BLKBEG
+ TAD I OUTFLD
+ AND (70
+ TAD (CDF
+ DCA OUTFLD /DECOMPOSE INTO ADDRESS AND CDF
+ JMP I NEWBUF
+
+BPPREV, 0
+MAXBLK, 0
+\f/COME HERE TO STORE 1 WORD
+/IN SOME BINARY OUTPUT BUFFER
+
+PUTBIN, 0
+ DCA TMP2 /SAVE DATA
+ TAD ORGFLG /N.E. 0 MEANS
+ SZA CLA /INHIBIT
+ JMP I PUTBIN /BINARY OUTPUT BECAUSE OF NEW ORIGIN
+ TAD OUTINH /N.E. 0 MEANS
+ SNA CLA /INHIBIT BIN OUT BECAUSE OF BAD ORIGIN
+ JMP OUTFLD /ITS OK
+ TAD I OUTINH /SET B0 OF
+ RAL /OFFENDING GST
+ CLL CML RAR /SYMBOL
+ DCA I OUTINH /SEE SUBR REORG
+ JMP I PUTBIN /FOR DEFINITION OF C(OUTINH)
+OUTFLD, 0 /CDF X
+ TAD TMP2 /STORE IT
+ DCA I BLKSIZ /AWAY
+ CDF 10 /RESTORE FLD
+ ISZ BLKSIZ /BUMP PTR
+ TAD BLKBEG
+ CIA
+ TAD BLKSIZ /HAVE WE
+ AND (1777 /CROSSED A
+ SZA CLA /BLK BOUND?
+ JMP I PUTBIN /NO
+ TAD NEWBLK
+ TAD [4
+ DCA NEWBLK
+ TAD NEWLEN
+ TAD [-4
+ DCA NEWLEN /BUMP BLOCK NUMBER AND REMAINING BLOCKS
+ JMS NEWBB /SELECT A NEW BUFFER
+ TAD BLKBEG
+ DCA BLKSIZ /RE-INITIALIZE WORD POINTER
+ JMP I PUTBIN
+CURBLK, 0
+ PAGE
+\f/COME HERE TO SCAN AND RELOCATE
+/THE TEXT OF AN ENTIRE MODULE
+
+TXTSCN, 0 /SET CTRL WD
+ JMS I (GETCTL /ARGS. RTN TO .+1,2,3, OR 4
+ JMP RELC2 /SPECIAL TYPE
+ JMP RELC6 /DIRECT COPY
+ JMP REORG /NEW ORIGIN
+ TAD I GPTR /RELOCATE FPP
+ AND [17 /PAIR
+ DCA TMP0 /GST SYM TYPE
+ AC7776 /IS RELOCATION
+ TAD TMP0 /WITH RESPECT
+ SZA CLA /TO GST EXTERN?
+ JMP BY2 /NO
+SETTRP, JMS GETTXT /BAD TEXT.
+ CLA
+ JMS GETTXT /IGNORE RELOCATION AND MAKE AN ERROR TRAP
+ CLA
+ TAD (3000 /=TRAP3
+ JMS I [PUTBIN
+ TAD (JUERR /RTS ERROR
+ JMS I [PUTBIN /TRAP SUBR
+BY2M5, TAD I GPTR /SET ILLEGAL
+ RAL /REFERENCE
+ CLL CML RAR /BIT IN
+ DCA I GPTR /GST TYPE WD
+ JMP TXTSCN+1 /DO NEXT
+BY2, TAD (-5 /RELOCATE TO
+ TAD TMP0 /A MULTIPLE
+ SNA CLA /ENTRY?
+ JMP SETTRP /YES
+ TAD I GPTR /CHECK FOR LEGALITY OF REFERENCE
+ AND (0360 /WITH RESPECT TO LEVEL AND OVERLAY NUMBER
+ DCA TMP1 / = GST OVER NUM
+ TAD LNONUM /=CURNT MOD
+ AND [3400 /LEVEL NUM
+ DCA TMP2
+ TAD I GPTR
+ AND [3400
+ SNA /RELOCATE TO MAIN?
+ JMP RELC /YES, ITS OK
+ CIA /IS RELOCATION
+ TAD TMP2 /ACROSS LEVELS
+ SZA /?
+ JMP TSTTRP /YES
+ TAD LNONUM /=CURRENT MOD
+ AND (0360 /OVER NUM
+ CIA
+ TAD TMP1 /WITHIN LEVL CALL IS LEGAL ONLY
+ SNA CLA /IF WITHIN OVR ALSO.
+ JMP RELC /ITS OK
+\f /** TSTTRP REPLACED BY "SKP CLA" IF /U SPECIFIED
+TSTTRP, SMA CLA /NOT OK - IS X LEVL LO TO HI?
+ JMP SETTRP /NO
+ TAD I BPTR /TRAP VECT
+ TAD [7770 /SUBTRACT 1 FROM ENTRY NUM
+ AND [7770 /IN HIGH 9 BITS OF GST WD 5
+ CLL RAR /DIV BY 2 TO GET ENTRY NUM * 4
+ TAD TRAPV+1 /LINK IS 0
+ DCA I (SYMX+1 /STORE VECTOR ENTRY ADDRESS
+ RAL
+ TAD TRAPV /IN SYMX AS A DOUBLEWORD
+ DCA I (SYMX
+ TAD (SYMX
+ JMS I [SETBPT /COMBINE IT WITH TXT PAIR
+ JMS I (MERGE /I.E. RELOCATE TO TRAP VECT
+ TAD FTMP0
+ AND [7
+ SNA
+ TAD FTMP0+1
+ SNA CLA /WERE LOW ORDER 15 BITS OF TXT=0?
+ JMP TXTSCN+1 /YES, ITS OK
+ JMP BY2M5 /SET ILL REF BIT. NOTE TRAP IS NOT GENERATED
+
+RELC, JMS I (MERGE /MAKE FPP PAIR AND STORE IN BIN BUFFER
+ JMP TXTSCN+1 /DO NEXT
+RELC2, TAD REFPTR /CHK IND.
+ SNA CLA /FOR SPECIAL TYPE
+ JMP I TXTSCN /0=END OF TEXT
+ JMP TXTSCN+1 /1=IGNORE 1 WORD OF TEXT
+RELC6, TAD REFPTR /IND HOLDS
+ CIA /NUM OF WDS
+ DCA REFPTR /TO COPY
+ JMS GETTXT
+ JMS I [PUTBIN
+ ISZ REFPTR
+ JMP .-3
+ JMP TXTSCN+1
+REORG, ISZ ORGFLG /SET INHIBIT BIN OUT FLG
+ JMS I (MERGE /GET NEW ORIGIN
+ TAD I GPTR /SEE IF
+ AND (3760 /ORIGIN IS
+ CIA /TO A DIFFERENT
+ TAD LNONUM /BINARY SECTION
+ SZA CLA /?
+ TAD GPTR /YES - SET INHIBIT/ERROR FLAG
+ SNA
+ JMS I (NEWORG /NO - SET UP NEW ORIGIN
+ DCA OUTINH
+ DCA ORGFLG
+ JMP TXTSCN+1
+\fGETTXT, 0 /GET ONE WORD OF TEXT FROM THE BUFFER
+ ISZ BLKCNT
+ JMP RDTCDF
+ CDF /TO READ IN
+ JMS I [IOHAN /RALF TEXT
+ 0 /PTR TO UNIT
+ 200^4!10 /OR 200^17!20
+ 0
+TXTBLK, 2
+ TAD .-2 /SET TXT
+ DCA RBLK /BUF PTR
+ TAD TXTWDS /-NUM OF
+ DCA BLKCNT /WDS-1 IN
+RDTCDF, CDF 10 /OR CDF 20
+ TAD I RBLK
+ CDF 10
+ ISZ RBLK
+ JMP I GETTXT /RETURN
+TXTWDS, -2000 /OR -7400
+ PAGE
+\f/ENTER A SYMBOL INTO GST. PTR TO ESD
+/SYMBOL IS IN AC
+
+ JMP I PUTSYM /FOR XPAGE RTN
+PUTSYM, 0
+ JMS I [LOOK /LOOKUP SYMBOL
+ JMP I (NOMAT /NEW SYMBOL DISPOSITION
+/TYPE OF MATCH 2 EXTERNS, 2 COMMONS, ETC.
+/ETYP HOLDS SYM TYPE FOR ESD GTYP HOLDS GST TYPE
+
+ TAD (5
+ DCA TMP0 /FOR ME,MS
+ TAD ETYP
+ TAD (-7
+ SPA
+ TAD (2
+ TAD [4
+ RAR CLL
+ CMA
+ DCA TMP2
+ CML CMA /GET -1
+ TAD GTYP /RESTR LNK, GET GST TYP-1
+ RAL
+ TAD (MYSTIC /GET ADDR OF 4 CODES
+ DCA TMP1
+ CDF 0
+ TAD I TMP1 /GET 4 CODES
+ CDF 10
+CTST, ISZ TMP2 /WHICH CODE ?
+ JMP SHFT3 /NOT THIS 1
+ AND [7
+ TAD T2J /PICK UP JMP I
+ DCA .+1
+ 0
+T2J, JMP I .+1
+ ISCOM3 /FORT COMM N FLD1 SECTION
+ PUTSYM-1 /ESD IS EXT JUST EXIT
+ REP /GST IS EXT GO REPLACE
+ MULENT /MULTIPLE ENTS
+ ISCOM /2 F COMMS OR 2 COMMZS OR 2 FLD1S
+ BADDY /MULTIPLE SECTS
+ BADDY /UNDEF TYPES
+ BADDY
+ BADDY
+SHFT3, RAR
+ RTR
+ JMP CTST
+\fBADDY, TAD MCNT
+ TAD MBGCNT
+ DCA MTMCNT /SAVE PARAMS FOR ERROR MESSAGE LATER
+ CLA IAC
+ TAD LNONUM /MULTIPLE SECTION
+ DCA FATAL
+ ISZ TMP0 /IS FATAL
+MULENT, TAD I GPTR /SET TYPE TO
+ AND (7760 /5 FOR MUL ENT
+ TAD TMP0 /OR 6 FOR
+ DCA I GPTR /MUL. SECTION
+ JMP I PUTSYM
+
+ISCOM3, TAD (11 /F COMM N FLD1 (RITE9=11)
+ DCA I GPTR /SET TYP TO F1
+ ISZ F1FLG
+ISCOM, JMS I [SETBGX
+ TAD BPTR /UPDATE
+ DCA I REFPTR /ESD REFERENCE PTR
+ JMS I (MAXCOM /PUT LARGER OF 2 COMMONS INTO
+ JMP I PUTSYM /GST WORDS 5 AND 6
+MTMCNT, 0
+\f/THE FOLOWING TABLE IS USED TO
+/DISPOSITION SYMBOL MATCHES BETWEEN
+/A RALF ESD AND A GST SYMBOL
+/EACH DIGIT IN THE TABLE IS AN INDEX
+/INTO A TABLE THAT IS USED TO CALL
+/ROUTINES TO HANDLE THE VARIOUS TYPES
+/OF MATCHES:
+/ 0=FORT COMMON AND FLD1 SECTION
+/ 1=ANY MATCH WITH ESD EXTERN
+/ 2=ANY MATCH WITH GST EXTERN
+/ 3=MULTIPLE ENTRY POINTS
+/ 4=2 FORT COMMONS OR 2 FIELD1
+/ SECTIONS OR 2 COMMZ SECTS
+/ 5=MULTIPLE SECTIONS
+/ 6-7=UNDEFINED AND HALT
+/
+/THE FIRST 2 WORDS COVER ALL POSSIBLE
+/MATCHES WITH GST TYPE 1, THE SECOND
+/TWO WORDS ARE FOR GST TYPE 2 ETC
+/THE 4 DIGITS IN THE FIRST WORD OF
+/ANY PAIR CORRESPOND TO ESD TYPES
+/11,7,3,1 RESPECTIVELY
+/ESD CORRESPONDENCE FOR THE 2ND WORD
+/IS 12,10,4,2
+/ESD TYPE 12 IS UNDEFINED
+
+MYSTIC, 5553 /G1 E(11,7,3,1)
+ 7551 /E(12,10,4,2)
+ 2222 /G2 E(11,7,3,1)
+ 7221 /E(12,10,4,2)
+ 0545 /G3
+ 7551
+ 5555 /G4
+ 7551
+ 5553 /G5
+ 7551
+ 5555 /G6
+ 7551
+ 5555 /G7
+ 7551
+ 5555 /G10
+ 7451
+ 4505 /G11
+ 7551
+\f
+ESDSCN, 0
+ CLL STA RTL /-3
+ TAD I (0
+ SZA CLA
+ JMP I (NOTREL /NOT RALF MODULES - NASTY!
+ TAD I (2 /CHK FOR DP
+ SPA CLA /HARDWARE REQUIRED
+ ISZ DPFLG /ISZ=YES
+ AC7776 /ENTER ESD OF MODULE
+ DCA EPTR /INTO GST. ESD STARTS AT 10000
+ JMS I (NXTESD /GET NXT 1
+ JMP I ESDSCN /NO MORE
+ TAD EPTR
+ JMS PUTSYM /ENTER IT
+ JMP .-4 /DO ANOTHER
+
+MSMSG, TEXT /MULT SECT/
+CORMSG, TEXT /OVER CORE/
+LIMSG, TEXT /OVER IMAG/
+MNMSG, TEXT /NO MAIN/
+ PAGE
+\f/CONTINUATION OF SUB PUTSYM
+
+REP, DCA GTYP
+ AC7775 /REPLACE GST
+ TAD ETYP /EXTERN
+ SNA /IS IT A REF TO COMMON?
+ JMP MNSECN /YES
+ TAD M4 /IS IT A REF
+ SMA CLA /8 MODE SECN ?
+ JMP NOMAT
+ TAD I GPTR /NO CHK FOR
+ AND [3400 /CROSS LEVEL
+ CIA /REFERENCE
+ DCA TMP0 /COMPARE WITH
+ TAD LNONUM /CURNT LEVEL
+ AND [3400
+ SNA /DOING MAIN ?
+ JMP NOMAT /YES DONT CHK FOR TRAP ENTRY
+ TAD TMP0
+ SNA CLA /X LEVEL?
+ JMP NOMAT
+ ISZ TRPCNT /YES BUMP TRAP VECTOR COUNTER
+ AC4000 /SET B0=1, GST SYM WILL GO IN TRAP VECTOR
+NOMAT, DCA GTYP
+ TAD ETYP /ENTER GST
+ TAD (.+3-1 /WORDS 4,5,6.
+ DCA TMP0 /DISPATCH ESD
+ JMP I TMP0 /TYPE 1,2,3,4
+ JMP ENTMN2 /ENTRY POINT
+ JMP ENTMN /EXTERN
+ JMP MNSECN /COMMON SECN
+ JMP PRGSCN /PROGRAM SECN
+M4, -4
+M7, -7
+ JMP MNS8 /GEN 8 MODE SCT
+ JMP MNCZ /COMM 8 MODE
+ JMP MNF1 /FLD1 8 MODE
+\fPRGSCN, TAD LNONUM
+ AND [3400 /IS IT A MAIN
+ SNA CLA /?
+ JMP MNSECN /YES
+ TAD I [OVRSIZ
+ DCA TMP0
+ TAD I [OVRSIZ+1
+ DCA TMP1 /SAVE OLD OVERLAY SIZE
+ CLL
+ TAD I EPT2
+ TAD TMP1
+ DCA I [OVRSIZ+1
+ RAL
+ TAD I EPTR
+ TAD TMP0
+ DCA I [OVRSIZ /SET OVLY SIZE = OVLY SIZE + SECTION SIZE
+ TAD TMP0
+ DCA I EPTR
+ TAD TMP1
+ DCA I EPT2 /SET SECTION SIZE = OLD OVERLAY SIZE
+ TAD GPTR /PUT ADDR OF
+ IAC /GST WD5 OF
+ DCA I REFPTR /SECTION SYM INTO ESD REFERENCE PAGE
+ENTM2, TAD [LVPTR /SET REFERENCE
+ DCA REFPTR /TO PARENT SYM =WD5 OF #YLVLN
+ENTMN, TAD LNONUM /=CURNT OVRLAY AND CURNT LEVEL NUM
+ JMP MNSEC5
+\fENTMN2, TAD LNONUM /SEE IF ENTRY
+ AND [3400 /POINT IS IN
+ SNA CLA /MAIN?
+ JMP ENTMN /YES
+ TAD I REFPTR /IS PARENT
+ JMS I [SETBPT /REFERENCE TO
+ CLA CMA /COMMON?
+ TAD REFPTR /LOOK FOR
+ DCA TMP0 /TYPE CODE 3
+ AC7775
+ TAD I TMP0
+ SNA
+ JMP ENTMN /YES, HANDLE LIKE A MAIN ENTRY POINT
+ TAD M4 /IS IT A REF
+ SNA CLA /TO AN 8 SECT?
+ JMP MNSEC5 /YES HANDLE LIKE MAIN
+ CLL
+ TAD I BPT2
+ TAD I EPT2
+ DCA I EPT2 /SET OVR ENT = OVR ENT + OVR
+ RAL
+ TAD I BPTR
+ AND [7 /WATCH HIGH-ORDER BITS
+ TAD I EPTR
+ DCA I EPTR
+ JMP ENTM2 /SIZE OF SECTION
+MNF1, ISZ F1FLG /SET FOR NE TO
+ JMP MNSECN /0 SO DO8S WILL
+MNCZ, ISZ CZFLG /KNOW THESE
+ JMP MNSECN /TYPES OF SECTS
+\fMNS8, ISZ S8FLG /EXIST AND WILL FIT THEM INTO CORE
+MNSECN, TAD GPTR /PUT ADDR OF
+ IAC /GST WD5 OF
+ DCA I REFPTR /SECTION SYM INTO ESD REFERENCE PAGE
+ TAD (SYMX+1 /THIS VALUE
+ DCA REFPTR /YIELDS 0 IN HI 9 WD 5 OF GST SYM
+MNSEC5, TAD ETYP /SYM TYPE TO AC8-11. AC MAY HAVE
+ TAD GTYP /LEVEL AND OVR BITS (AC1-7) ALREADY SET
+ DCA I GPTR /GST WD4 HOLDS SYMBOL TYPE
+ JMS I [SETBGX /SET BPTR TO GST WORD
+ DCA TMP0 /PREPARE FOR DIVISION BY 7
+ TAD I REFPTR
+ TAD (2-SYMTBL /GET OFFSET FROM SYMTBL
+ TAD M7
+ ISZ TMP0
+ SMA
+ JMP .-3 /DIVIDE BY REPEATED SUBTRACTION
+ STA /AC IS NOT NECESSARILY ZERO!
+ TAD TMP0
+ CLL RTL /ROTATE SYMBOL NUMBER INTO AC BITS 0-8
+ RAL
+ TAD I EPTR /AND INSERT IT INTO THE ADDRESS
+ DCA I BPTR /DOUBLEWORD TO FORM THE GST
+ TAD I EPT2 /ADDRESS DOUBLEWORD
+ DCA I BPT2
+ JMP I .+1
+ PUTSYM-1
+ PAGE
+\fSTPAS1, DCA I NDX0 /ZERO OUT GST
+ ISZ STCNT /NDX0 SET UP BY PASS0
+ JMP STPAS1
+ JMS I (SETCNT /SET MOD CNTS
+ JMS I (RDRLES /READ A RALF ESD
+ JMS I (ESDSCN /PROCESS IT
+ JMS I (ADVOVR /UPDATE COUNTS
+ JMP .-3 /DO NEXT
+ TAD LIBRSW
+ SNA CLA /LIBRARY SEARCH POSSIBLE?
+ JMP I (DOCORE /NO - SKIP IT
+ TAD SYMTM3 /TOP OF
+ DCA GPTR /GST
+ TAD RFPTR1 /1ST FREE
+ DCA LBPTR /ENTRY IN MODULE TBL THIS IS WHERE LIBR MODULES WILL GO
+ JMS I (GETEXT /GET AN
+ JMP .+3 /EXTERN
+LOP4, JMS I (GETEXT
+ TAD RESFLG /=1 IF
+ DCA IOFLG /LIBR CAT IS ENTIRELY CORE RES
+ DCA LBREC /SET I/O FOR
+ DCA LSTBLK /BLK 0 OF LIBRARY
+ DCA RBLK /SET REL BLK
+ DCA RLEN /AND LENGTH
+ JMP BY3 /TO 0
+NXTENT, TAD NDX1 /ADV TO
+ AND [-4 /NXT ENTRY
+ TAD (2 /BUT GET
+ DCA NDX1 /LENGTH OF
+ JMS I (GETLEN /PREV ONE 1ST
+ ISZ NUMENT /MORE IN CORE?
+ JMP BY3+1 /YES
+ TAD IOFLG /END OF
+ SZA CLA /CATALOGUE?
+ JMP LOP4 /YES, NO MATCH ON THIS EXTERN
+BY3, JMS RDLBR /GET NEXT
+ TAD [-4 /CAT. BLKS
+ TAD GPTR /LOOK FOR
+ DCA NDX0 /LIBR MATCH
+ AC7775
+ DCA TMP0
+\fLBFLD, CDF 0 /CDF 20 IF GREATER THAN 8K CORE
+ TAD I NDX1
+ CDF 10
+ CMA /IS IT THE END
+ SNA /OF CAT ?
+ JMP LOP4 /YES
+ IAC
+ TAD I NDX0
+ SZA CLA /MATCH 1?
+ JMP NXTENT /NO TRY NXT LIBR ENTRY
+ ISZ TMP0 /ALL MATCH?
+ JMP LBFLD /NO
+ JMS I (GETLEN /UPDATE RBLK,
+ CLA CMA /RLEN
+ TAD RFPTR1 /ENTER MOD
+ DCA NDX0 /INTO TBL
+ TAD I (MODTBL /LIBR UNIT
+ DCA I NDX0
+ TAD RLEN /LENGTH OF
+ DCA I NDX0 /MODULE
+ TAD I (MODTBL+2 /STARTING BLOCK OF LIBRARY, +
+ TAD RBLK / RELATIVE BLOCK OF MODULE =
+ DCA I NDX0 / ABSOLUTE BLK OF MOD
+ ISZ LBCNT /=NUM OF LIBR MOD IN MAIN
+ TAD GPTR /SAVE GST
+ DCA LSTBLK /PTR
+ JMS I (RDRLES /READ IN ESD
+ DCA LNONUM /SET FOR MAIN
+ JMS I (ESDSCN /PROCESS ESD
+ TAD [3 /ADV MODULE
+ TAD RFPTR1 /TBL PTR
+ DCA RFPTR1
+ TAD LSTBLK
+ DCA GPTR
+ ISZ MLEFT /MOD TBL FULL?
+ JMP LOP4 /NO DO SOME MORE
+ JMP I (DOCORE
+
+LIBRSW, 0 /NON-ZERO IF LIBRARY SEARCH POSSIBLE
+STCNT, SYMTBL-OVLTBL
+\fRDLBR, 0
+ TAD IOFLG /IS THIS
+ SZA CLA /THE END
+ JMP ENDLB /OF CAT.?
+ CDF /NO
+ JMS I [IOHAN /READ SOME
+ MODTBL /MORE
+LBARG, 200^5 /OR 200^17!20
+ LB0BUF /OR 0
+LBREC, 0 /REL CAT BLK
+ TAD LBREC /GET -NUM OF
+ CIA /BLKS READ,
+ TAD LSTBLK /AND COMPUTE
+ DCA TMP0 /THE NUM OF
+ TAD (-100 /ENTRIES IN
+ ISZ TMP0 /CORE. THERE
+ JMP .-2 /ARE 100 PER
+ DCA OLDCNT /BLOCK
+ TAD LBREC /UPDATE
+ DCA LSTBLK /LSTBLK
+ENDLB, TAD OLDCNT
+ DCA NUMENT
+ CLA CMA /SET PTR TO
+ TAD LBARG+1 /1ST ENTRY
+ DCA NDX1
+ CDF 10
+ JMP I RDLBR
+LSTBLK, 0
+MLEFT, 0
+RESFLG, 1
+NUMENT, 0
+OLDCNT, 0
+ PAGE
+
+\f/END OF PASS 1 - FIT EVERYTHING INTO CORE
+
+DOCORE, TAD TRPCNT
+ SNA CLA
+ JMP LOP3-3 /NO OVRS
+ TAD (TRPSYM /ENTER TRAP
+ JMS I [LOOK /VECT. SYM
+ TAD [4 /ITS A
+ DCA I GPTR /MAIN SECN
+ ISZ GPTR /GST WD6
+ ISZ GPTR /HOLDS LENGTH
+ TAD TRPCNT /GET SIZE OF
+ RTL CLL /TRAP VECTOR
+ DCA I GPTR /= NUMBER OF ENTRIES * 4
+ JMS I (DO8S /GO DO ALL 8 MODE SECTIONS
+ TAD SYMTM3 /ALLOCATE
+ DCA GPTR /CORE FOR
+LOP3, JMS I [GETTYP /ALL MAIN NON 8 MODE
+ JMP DUNMN /SECTIONS
+ AC7775 /4=PROG
+ TAD I GPTR /SECN, 3=COMMON
+ RAR CLL
+ SNA CLA
+ JMS I (FIT /GO FIT SECN
+ JMP LOP3
+\fDUNMN, STA
+ DCA I NDX7 /TERMINATE OVERLAY LENGTH LIST
+ TAD A1
+ DCA I (OVLTBL /STORE ENTRY FOR LEVEL 0
+ TAD A1+1
+ DCA I (OVLTBL+1
+ TAD A1+1
+ CLL
+ TAD [377
+ AND [7400
+ SZL
+ ISZ A1 /(WATCH CARRY!)
+ DCA A1+1 /DITTO FOR NON-FIELD 0
+ CLA IAC /WILL HOLD
+ DCA BLKCNT /SIZE OF LOADER IMAGE
+ TAD (1460 /RESET INT.
+ DCA I (LEVSYM+2 /#YLVLN SYM
+ TAD (QUSRLV-1 /WHERE OVRLAY
+ DCA NDX3 /DSRN INFO GOES IN LHDR
+ CLA IAC
+ DCA I NDX3 /USER MAIN IS LEVEL 0
+ TAD (10
+ DCA I NDX3 /SET UP LOADING INFORMATION FOR USER MAIN
+ STA /IN THE USRLV TABLE JUST LIKE
+ TAD A1 /ANY OTHER OVERLAY LEVEL
+ CLL RAR
+ TAD A1+1 /LENGTH HAS TO BE COMPUTED FROM
+ RAL /CORE LENGTH
+ RTL
+ RTL
+ DCA TMP0
+ CLA IAC
+ DCA I NDX3 /USER MAIN FIRST THING IN LDR IMAGE
+ TAD TMP0
+ DCA I NDX3
+ TAD TMP0
+\fLOP6, TAD BLKCNT /UPDATE LENGTH
+ DCA BLKCNT /OF LDR IMAGE
+ ISZ I (LEVSYM+2 /NEXT LEVEL
+ TAD (LEVSYM /LOOKUP
+ ISZ NLVL
+ JMS I [LOOK /#YLVLN
+ JMP DUNLVL /DONE ALL OVR LEVELS
+ JMS I (FIT /FIT LEVEL
+ ISZ GPTR /IN CORE
+ TAD I NDX3 /NUMBER OF OVERLAYS ON THIS LEVEL - ALSO
+ CIA /SERVES AS AN INDICATOR TO THE RUN-TIME
+ DCA TMP0 /SYSTEM THAT THIS LEVEL IS INITIALLY
+ TAD I GPTR /UNINHABITED.
+ AND [7 /GET FIELD BITS
+ CLL RTL
+ RAL
+ ISZ GPTR
+ TAD I GPTR /AND ADDRESS BITS
+ DCA I NDX3 /PUT-EM OUT
+ TAD BLKCNT /STARTING BLOCK OF LEVEL
+ DCA I NDX3
+ TAD BLKSIZ
+ DCA I NDX3 /LENGTH OF A SINGLE OVERLAY IN THE LEVEL
+ TAD BLKSIZ /(NUM OF OVRS)*
+ ISZ TMP0 /NUM OF BLKS
+ JMP .-2 /AC=LENGTH OF LEVEL
+ JMP LOP6 /DO NEXT LEVEL
+NLVL, 0
+\fDUNLVL, CLA /AC NOT ZERO!
+ TAD SYMTM3 /NOW RESOLVE
+ DCA GPTR /ALL OTHER SYMBOLS
+LP1, JMS I [GETTYP
+ JMP I (ALLDN1 /ALL DONE
+ JMS I [SETBGX /SET BPTR TO GST WD5
+ TAD I BPTR
+ AND [7770
+ SNA
+ JMP LP1 /NO RELATIVE SYMBOL - DON'T RELOCATE
+ DCA EPTR
+ TAD EPTR /FIGURE OUT THE SYMBOL TABLE ADDRESS
+ CLL RTR /OF THE RELATIVE SYMBOL BY
+ STL CMA RAR /TAKING 7 * THE RELATIVE SYMBOL NUMBER
+ TAD EPTR /IN BITS 0-8 AND ADDING IN THE BASE
+ TAD (SYMTBL-1 /ADDRESS OF THE SYMBOL TABLE
+ JMS I [SETEPT
+ TAD I EPT2
+ CLL
+ TAD I BPT2
+ DCA I BPT2
+ RAL
+ TAD I BPTR
+ AND [7 /THROW AWAY THE OLD RELATIVE SYMBOL #
+ TAD I EPTR
+ DCA I BPTR /AND PERFORM THE RELOCATION
+ JMP LP1 /DO AGAIN
+ PAGE
+\fALLDN1, TAD A1
+ DCA I (QHGHAD /SAVE HIGHEST PROGRAM ADDRESS
+ TAD A1+1 /SO THAT RTS WILL KNOW HOW MUCH ROOM
+ DCA I (QHGHAD+1 /IT HAS FOR BUFFERS & THINGS
+ TAD FATAL /ANY MULTIPLE
+ SNA /SECTIONS?
+ JMP NOMSCT /NO
+ DCA LNONUM
+ CDF 0
+ TAD I (MTMCNT
+ DCA MBGCNT /RESTORE ERROR PARAMETERS
+ CDF 10
+ JMS I [RTNOS8
+ MSMSG
+NOMSCT, TAD (SASYM /GET STRT
+ JMS I [LOOK /ADDR MAIN
+ SKP /NO MAIN
+ JMP .+3
+ JMS I [RTNOS8
+ MNMSG
+ TAD SVMAIN /IF .NE. SET TO
+ SZA /POINT TO GST
+ TAD GPTR /FOR PND MAIN
+ DCA SVMAIN /FOR /S THINGS IN SYMMAP RT.
+ CDF 0
+ TAD I (JOUSYM
+ DCA I (PRMAIN /ENABLING PRINTING OF #MAIN ON ERRORS
+ CDF 10
+ ISZ GPTR
+ TAD I GPTR /MAKE SWAPPER CONTROL WORD
+ DCA I (QRTSWP /LEVEL 0, OVERLAY 0 IS MAIN
+ ISZ GPTR
+ TAD I GPTR /12 BIT ADDR
+ DCA I (QRTSWP+1
+ TAD DPFLG /N.E. MEANS LDR IMAGE NEEDS DP HRDWRE
+ DCA I (QDPFLG /RETAIN INFO IN LHDR FOR PASS3
+\f CDF 0 /FETCH LDR
+ TAD I (LDRNAM /IMAGE
+ JMS I [IOHAN /HANDLER
+ TAD BLKCNT
+ CLL RTL /SINCE WE KNOW THE LENGTH OF THE
+ SZL SPA /LDR IMAGE FILE, TELL IT TO THE USR
+ CLA /(UNLESS ITS >255)
+ RTL
+ SZL
+ CLA
+ TAD I (LDRNAM /OPEN LDR
+ CIF 10 /IMAGE
+ JMS I USR
+ 3
+LDRBLK, LDRNAM+1
+LDRLEN, 0
+ JMP I (ENTERR
+ TAD BLKCNT /SEE IF LDR
+ STL /IMAGE WILL
+ TAD LDRLEN /FIT ON
+ SZL SNA CLA /TENTATIVE FILE
+ JMP .+3 /IT FITS
+ JMS I [RTNOS8 /OUTPUT FILE
+ LIMSG /TOO SMALL
+ TAD BLKCNT /CLOSE LDR
+ DCA I (LDCLEN /IMAGE FILE
+ TAD (LIMGU-1 /PASS2
+ DCA NDX0
+ TAD I (LDRNAM
+ CDF 10
+ AND [17
+ DCA I NDX0 /UNIT
+ TAD BLKCNT
+ DCA I NDX0 /LENGTH
+ TAD LDRBLK
+ DCA I NDX0 /STRT BLK
+ CDF 0
+ JMS I [IOHAN
+ LIMGU /WRITE OUT LOADER IMAGE HEADER BLOCK
+ 4210
+ LHDR
+ 0 /IN RELATIVE BLOCK 0 OF LOADER IMAGE FILE
+ CDF 10
+\f/SET UP TABLE THAT RELATES
+/BINARY SECTINS TO LDR
+/IMAGE RELATIVE BLOCK NUMS.
+/1 DBL WD AND 2 SINGLE-WD ARGUMENTS PER
+/SECTION (15 BIT ADDR, RELATIVE
+/BLOCK, AND LENGTH). THERE ARE
+/8 SECTIONS
+/(MAIN, LEVL1,....,LEVL7)
+/TABLE STARTS AT LHDR AND
+/IS USED BY SUBR NEWORG
+
+ TAD (LHDR-1
+ DCA NDX1
+ TAD (QUSRLV /NOW DO THE
+ DCA NDX0 /8 LEVELS
+ TAD [-10
+ DCA TMP0
+SETSLP, TAD I NDX0
+ DCA BSECTP
+ TAD BSECTP
+ CLL RTR
+ RAR
+ AND [7
+ DCA I NDX1 /FIRST COMES 15-BIT ADDRESS
+ TAD BSECTP
+ AND [7400
+ DCA I NDX1
+ TAD I NDX0
+ DCA I NDX1 /THEN RELATIVE BLOCK NUMBER
+ TAD I NDX0
+ DCA I NDX1 /THEN LENGTH
+ ISZ NDX0 /SKIP OVER NEXT OVERLAY COUNT
+ ISZ TMP0
+ JMP SETSLP
+ TAD (LHDR /PTR TO TOP
+ DCA BSECTP /OF TABLE
+ CLA CMA /SET FLG
+ DCA P2FLG /FOR SUBR ADVOVR
+ JMP I .+1
+ PASS2
+ PAGE
+\fDO8S, 0 /DO 8 SECTIONS
+ TAD CZFLG /ANY 8 MODE
+ SZA CLA /COMMONS ?
+ JMS FIT8S /GO FIT IT
+ TAD F1FLG /ANY 8 MODE
+ SNA CLA /FIELD 1 ?
+ JMP .+3 /NO
+ STA
+ JMS FIT8S
+ TAD S8FLG /ANY GEN 8 MODE
+ SNA CLA /SECTIONS ?
+ JMP I DO8S /NO ALL DONE
+ TAD [7770 /THIS WILL
+ DCA OVRFLO /INHIBIT FLD1 OVER FLOW ERR
+ CLA IAC
+ JMS FIT8S
+ JMP I DO8S
+
+/FIT 8 MODE SECTIONS
+
+FIT8S, 0
+ TAD [7770
+ DCA STYPE /-8M0DE SECT TYPE (7-11)
+ TAD SYMTM3 /SEARCH GST FOR
+ DCA GPTR /8 MODE SECTNS
+F8SECT, JMS I [GETTYP
+ JMP I FIT8S /ALL DONE
+ TAD STYPE
+ TAD I GPTR
+ SZA CLA /8 SECTION ?
+ JMP F8SECT /NO
+ JMS I [SETBGX
+ TAD I BPT2
+ TAD (177 /ROUND SECTION LENGTH
+ AND (7600 /TO A PAGE BOUNDARY
+ DCA I BPT2
+ JMS I (FIT /NOW FIT IT
+ TAD OVRFLO /SEE IF FLD1
+ TAD A1 /IS OVR FLOWED ****
+ SPA SNA CLA /?
+ JMP F8SECT /DO ANOTHER
+TOOBIG, JMS I [RTNOS8
+ CORMSG /PRINT ERROR & GO AWAY
+STYPE, 0
+\fFIT, 0 /FIT SECTION
+ JMS I [SETBGX /SET BPTR TO POINT TO GST WD5
+ TAD I BPT2
+ AND [7400
+ CLL RAL
+ TAD I BPTR
+ RTL
+ RTL /GET LENGTH OF SEGMENT IN BLOCKS
+ DCA BLKSIZ
+ TAD I BPT2
+ CLL
+ TAD A1+1
+ DCA TMP5
+ TAD A1+1
+ DCA I BPT2
+ TAD TMP5
+ DCA A1+1 /SET BPTR = A1
+ RAL /WHILE SETTING A1 = A1 + BPTR
+ TAD I BPTR
+ TAD A1
+ DCA TMP5
+ TAD TMP5
+ AND [7770
+ SZA CLA /IF NEW ADDRESS IS > 77777,
+ JMP TOOBIG /THE THING WILL NEVER FIT
+ TAD A1
+ DCA I BPTR
+ TAD TMP5
+ DCA A1
+ JMP I FIT /RETURN
+\fLEVLUP, 0 /LEVEL = MAX (LEVEL, OVRSIZ); OVRSIZ=0
+ TAD I [OVRSIZ
+ TAD LNONUM
+ DCA I NDX7 /RECORD THE SIZE OF THIS OVERLAY
+ TAD I [OVRSIZ+1 /FOR THE SYMBOL MAP PRINTOUT
+ DCA I NDX7
+ TAD [OVRSIZ
+ JMS I [SETEPT
+ TAD I [LVPTR
+ JMS I [SETBPT
+ JMS MAXCOM
+ DCA I EPT2
+ DCA I EPTR
+ JMP I LEVLUP
+
+MAXCOM, 0 /BPTR = MAX (EPTR, BPTR)
+ TAD I EPTR
+ CIA CLL
+ TAD I BPTR
+ SZA CLA /CHECK HIGH-ORDER WORDS FIRST
+ JMP .+4 /THEY DIFFER
+ TAD I EPT2
+ CIA CLL
+ TAD I BPT2 /USE LOW ORDER WORDS IF HIGH ORDERS ARE =
+ SZL CLA /IS EPTR > BPTR?
+ JMP I MAXCOM /NO - EXIT
+ TAD I EPTR
+ DCA I BPTR
+ TAD I EPT2
+ DCA I BPT2 /YES - BPTR=EPTR
+ JMP I MAXCOM
+\fGETLEN, 0
+ CDF 0 /OR CDF 20
+ TAD I NDX1 /LEN OF ENTRY
+ CDF 10
+ SNA /=0 MEANS LENGTH HAS ALREADY
+ JMP I GETLEN /BEEN COMPUTED. NE 0 MEANS
+ DCA TMP0 /ENTRY POINT IS THE 1ST IN A NEW MODULE
+ TAD RLEN /UPDATE REL
+ TAD RBLK /BLOCK AND
+ DCA RBLK /LENGTH OF
+ TAD TMP0 /NEW MODULE
+ DCA RLEN
+ JMP I GETLEN
+
+GETEXT, 0 /LOOK FOR GST
+ JMS I [GETTYP /EXTERN
+ JMP I (DOCORE /END OF GST
+ TAD I GPTR /TYPE WD TO AC
+ AND [17 /B8-B11
+ RTR CLL /2=EXTERN
+ SZA CLA /GOT ONE?
+ JMP .-6 /NO, RETRY
+ JMP I GETEXT
+ PAGE
+
+LB0BUF= .
+\f/START OF PROGRAM
+
+START, ISZ XSTRT /IF CHAINED TO
+ CIF CDF 10
+ CLL STA RAL
+ AND I (7643 /AND OUT THE /L SWITCH
+ DCA I (7643
+ JMP I .+1
+XSTRT, PASS0
+\f/THIS SUBROUTINE SHOULD RESIDE IN THE
+/FIELD 0 I/O BUFFER SINCE IT
+/EXECUTES ONLY ONCE
+/SUBROUTINE TO DETERMINE CORE SIZE
+/
+/THIS WORKS ON ANY PDP-8 FAMILY COMPUTER.
+/THE VALUE,FROM 1 TO 10(OCTAL) OF THE 1ST NON-EXISTENT
+/MEMORY FLD IS RETURNED IN THE AC.
+/
+/NOTE--THIS ROUTN MUST BE PLACED IN FLD 0
+/
+CORE, 0
+ TAD (6203
+ RDF
+ DCA CORTN
+ CDF 0
+ TAD I (7777
+ AND COR70
+ SNA
+ JMP CORELP
+ CLL RTR
+ RAR
+ JMP CORTN
+CORELP, CDF 0 /NEEDED FOR PDP-8L
+ TAD TRYFLD /GET FLD TO TST
+ CLL RTL
+ RAL
+ AND COR70 /MASK USEFUL BITS
+ TAD CORELP
+ DCA .+1 /SET UP CDF TO FLD
+ 0
+ TAD I CORLOC /SAV CURRENT CONTENTS
+ NOP /HACK FOR PDP-8
+ DCA .-3
+ TAD .-2 /7000 IS A GOOD PATTERN
+ DCA I CORLOC
+COR70, 70 /HACK FOR PDP-8.,NO-OP
+ TAD I CORLOC /TRY TO READ BK 7000
+ 7400 /HACK FOR PDP-8,.NO-OP
+ TAD .-1 /GUARD AGAINST WRAP AROUND
+ TAD CORLOC+1 /TAD 1400
+ SZA CLA
+ JMP .+5 /NON EXISTENT FLD EXIT
+ TAD COR70-6 /RESTORE CONTENS DESTROYED
+ DCA I CORLOC
+ ISZ TRYFLD /TRY NXT HIGHER FLD
+ JMP CORELP
+ TAD TRYFLD
+ TAD (-1
+CORTN, 0
+ JMP I CORE
+CORLOC, COR70+2 /ADR TO TST IN EACH FLD
+ 1400 /7000+7400+1400=0
+TRYFLD, 1 /CURRENT FLD TO TST
+ PAGE
+\f *6600
+DATCHG, 0 /FIND THE MONTH/YEAR
+ CLL RTR /THIS CODE FINDS THE MONTH
+ RAR /BY CALCULATING THE ADDRESS
+ AND (777 /OF THE CORRECT MONTH
+ CLL RTR /IN THE TABLE OF MONTHS
+ RTR
+ AND (36
+ TAD (MONTHS-3 /HAVE THE ADDRESS OF MONTH-1
+ DCA NDX2 /SAVE IT IN FIELD 0, PAGE 0
+ CDF 0 /CHANGE DATA FIELD TO 0
+ TAD I NDX2 /GET FIRST 2 CHARS. OF MONTH
+ CDF 10 /CHANGE DATA FIELD TO 1
+ DCA I (LDATE+2 /INSERT INTO THE TEXT LINE
+ CDF 0 /CHANGE DATA FIELD TO 0
+ TAD I NDX2 /GET LAST 2 CHARS. OF MONTH
+ CDF 10 /CHANGE DATA FIELD TO 1
+ DCA I (LDATE+3 /INSERT INTO THE TEXT LINE
+ TAD I (OSDATE /GET THE DATE--FIND THE YEAR
+ AND (7 /GET THE YEAR OFFSET BITS
+ DCA I (YRTEMP /STORE THEM AWAY
+ CDF 0 /CHANGE DATA FIELD TO 0
+ TAD I (7777 /GET THE DATE EXTENSION BITS
+ CDF 10 /CHANGE DATA FIELD TO 1
+ AND (600 /MASK TO GET BITS 3 AND 4
+ CLL RTR /ROTATE TO GET THEM INTO
+ RTR /BIT POSITIONS 7 AND 8
+ TAD (106 /GET THE NEW BASE YEAR
+ TAD I (YRTEMP /ADD THE YEAR OFFSET BITS
+ CIF 10 /CHANGE THE DATA FIELD TO 1
+ JMP I DATCHG /HAVE THE YEAR
+\fGETDAT, 0
+ TAD I (YRTEMP /GET THE YEAR
+ AND (7700 /MASK AND ROTATE
+ CLL RTR /TO GET THE FIRST
+ RTR /DIGIT (IN SIXBIT)
+ RTR
+ TAD (5500 /STICK A HYPHEN IN FRONT
+ DCA I (LDATE+4 /PUT IN THE TEXT LINE
+ TAD I (YRTEMP /GET THE YEAR AGAIN
+ AND (77 /MASK AND ROTATE TO
+ CLL RTL /GET THE SECOND DIGIT
+ RTL /(IN SIXBIT)
+ RTL
+ TAD (40 /STICK A SPACE AFTER IT
+ CIF 10 /CHANGE INSTRUCTION FIELD TO 1
+ JMP I GETDAT
+\fMONTHS, 5512;0116 /-JAN
+ 5506;0502 /-FEB
+ 5515;0122 /-MAR
+ 5501;2022 /-APR
+ 5515;0131 /-MAY
+ 5512;2516 /-JUN
+ 5512;2514 /-JUL
+ 5501;2507 /-AUG
+ 5523;0520 /-SEP
+ 5517;0324 /-OCT
+ 5516;1726 /-NOV
+ 5504;0503 /-DEC
+ PAGE
+\f FIELD 1
+/PAGE 0 FLD1 TAGS FOR PASS0
+/(PASS 0 LIVES WITH THE USR RESIDENT)
+
+NMCTS= 20
+MODCNT= 21
+LVLCNT= 22
+OVRCNT= 23
+PTRULS= 24
+MXFLD= 25
+\f *2000
+
+/START OF GLOBAL SYMBOL TABLE
+/BUCKET COMES FIRST, INTERNAL
+/SYMBOLS AND FIELD 1 CONSTANTS ARE
+/HERE ALSO. GST RUNS FROM
+/SYMTBL TO OVLTBL-1
+
+BUCKET, AAAAAA;0;0;0;EEEEEE;0 /A,B,C,D,E,F
+ 0;0;0;0;0;0 /G-L
+ 0;0;0;0;0;0 /M-R
+ 0;0;0;0;0;0 /S-X
+ 0;0 /Y,Z
+ 0;0;0;0;0 /UNUSED BUCKETS MUST BE 0
+ 0 /SPACE (FOR BLANK COMMON)
+ 0;0
+ POUND /POUND SIGN FOR INTERNAL SYMBOLS, ALL ARE OF THE FORM (POUND XXXXX)
+\fTRPSYM, TEXT '#YTRAP'
+ 0 /TRAP VECTOR
+LEVSYM, TEXT '#YLVL0'
+ 0 /OVERLAY LEVEL
+SWPSYM, TEXT '#SWAP'
+ 0;0
+SASYM, TEXT '#MAIN'
+ 0;0 /STARTING ADDRESS
+
+/TITLE LINE FOR LOADER MAP
+
+TLINE, TEXT 'LOADER V'
+ *.-1
+LXX, VERNUM&70^7+VERNUM+6060 /VERNUM IN SIXBIT
+ PATCH&77^100+40 /PATCH LEVEL
+LDATE, TEXT ' NO-DA -TE '
+STLINE, TEXT 'SYMBOL VALUE LVL OVLY'
+HLINE, TEXT '= 1ST FREE LOCATION'
+OTLINE, TEXT 'LVL OVLY LENGTH'
+SMAPU, ZBLOCK 3 /SYMMAP UNIT, LENGTH, ST BLK #
+LIMGU, ZBLOCK 3 /LDR IMG "
+OVRSIZ, 0;0
+LVPTR, OVRSIZ
+SYMX, 1;SYMTBL-2
+\f/SYSTEM SYMBOL TABLE
+
+AAAAAA, 0
+ TEXT /ARGERR/
+ *.-1
+ 1;0
+ JARGER
+
+EEEEEE, 0
+ TEXT /EXIT/
+ 1;0
+ JEXIT
+
+POUND, .+7
+ TEXT /#ARGER/
+ *.-1
+ 1;0
+ JARGER
+ .+7
+ TEXT /#BAK/
+ 1;0
+ JBAK
+ .+7
+ TEXT /#DATE/
+ 1;0
+ JDATE
+ .+7
+ TEXT /#DEF/
+ 1;0
+ JDEF
+ .+7
+ TEXT /#DISMS/
+ *.-1
+ 1;0
+ JDISMS
+ .+7
+ TEXT /#ENDF/
+ 1;0
+ JENDF
+ .+7
+ TEXT /#EOFSW/
+ *.-1
+ 1;0
+ JEOFSW
+ .+7
+ TEXT /#EXIT/
+ 1;0
+ JEXIT
+ .+7
+ TEXT /#HANG/
+ 1;0
+ JHANG
+ .+7
+ TEXT /#IDLE/
+ 1;0
+ JIDLE
+ .+7
+ TEXT /#INT/
+ 1;0
+ JINT
+ .+7
+ TEXT /#RDAO/
+ 1;0
+ JRDAO
+ .+7
+ TEXT /#READO/
+ *.-1
+ 1;0
+ JREADO
+ .+7
+ TEXT /#RENDO/
+ *.-1
+ 1;0
+ JRENDO
+ .+7
+ TEXT /#RETRN/
+ *.-1
+ 1;0
+ JRETRN
+ .+7
+ TEXT /#REW/
+ 1;0
+ JREW
+ .+7
+ TEXT /#RSVO/
+ 1;0
+ JRSVO
+ .+7
+ TEXT /#RUO/
+ 1;0
+ JRUO
+ .+7
+ TEXT /#SWAP/
+ 1;0
+ JSWAP
+ .+7
+ TEXT /#T812/
+ 1;0
+ JT812
+ .+7
+ TEXT /#UE/
+ 0
+ 1;0
+ JUERR
+ .+7
+ TEXT /#WDAO/
+ 1;0
+ JWDAO
+ .+7
+ TEXT /#WRITO/
+ *.-1
+ 1;0
+ JWRITO
+ 0 /LAST ONE
+ TEXT /#WUO/
+ 1;0
+ JWUO
+SYMTBL, 0 /START OF GST
+\f/PASS0- THIS IS THE BEGINNING OF PASS0
+
+PASS0, JMP .+4 /NORMAL ENTRY PT
+ DCA CDSW /CHAINED TO ENTRY PT - NO DECODE 1ST TIME
+ TAD (7616
+ DCA PTRIO
+ TAD (-10
+ DCA LVLCNT /SET LEVEL AND OVERLAY COUNTERS
+ DCA OVRCNT
+ CIF 0
+ JMS I (CORE /DETERMINE CORE SIZE
+ DCA MXFLD
+ JMS I (CORMOV
+ CDF 0
+ 0-1
+ CDF 0
+ LB0BUF-1 /MOVE LOWER FIELD 0 TO A SAFE PLACE
+ -2000
+ CDF 0
+ TAD I (OSJSWD /GET JOB STATUS WORD
+ AND (376 /CLEAR DESIRED FLAGS
+ TAD (3403 /SET NO RESTART, USR AND CD AREAS CLEAR
+ DCA I (OSJSWD /AS WELL AS BATCH FLAG
+ CDF 10
+ TAD I (OSDATE
+ SNA
+ JMP NODATE
+ CLL RTR /ROTATE AND MASK TO GET THE DAY
+ RAR
+ AND (37
+ JMS MAKSXB /CONVERT TO SIXBIT
+ DCA I (LDATE+1 /PUT THE DAY INTO THE TEXT LINE
+ TAD I (OSDATE /GET THE DATE---FIND MONTH
+ CIF 0 /CHANGE DATA FIELD TO 0
+ JMS I (DATCHG /FIND THE MONTH/YEAR
+ JMS MAKSXB /CONVERT THE YEAR TO SIXBIT
+ DCA YRTEMP /STORE IT AWAY
+ CIF 0 /CHANGE INSTRUC. FIELD TO 0
+ JMS I (GETDAT /PRINT THE YEAR
+ DCA I (LDATE+5 /PUT REST OF YEAR IN TEXT LINE
+\f/SET UP OTHER POINTERS TO MODULE TABLES
+
+NODATE, TAD (-NUMMOD
+ DCA I (MCTTBL
+ TAD (MCTTBL+1
+ DCA NMCTS /INITIALIZE MODULE CT TBL PTR
+ TAD (MODTBL+2
+ DCA PTRULS /INITIALIZE MODULE TBL PTR
+ DCA MODCNT
+ DCA I (MODTBL /CLEAR LIBRARY UNIT
+ DCA I NMCTS /CLEAR FOR 1ST LEVEL MODULE COUNTS
+CDSW, JMP I (RALFLP /ZEROED IF CHAINED TO
+ JMP I (DECO
+
+MAKSXB, 0
+ DCA TMP0
+ DCA TMP1
+ TAD TMP0
+ TAD (-12
+ ISZ TMP1
+ SMA
+ JMP .-3 /SUBTRACT 10 IN A LOOP
+ TAD (5772 /AS GOOD A NUMBER AS ANY
+ DCA TMP0
+ TAD TMP1
+ CLL RTL
+ RTL
+ RTL /GET THE TENS DIGIT INTO POSITION
+ TAD TMP0
+ JMP I MAKSXB
+YRTEMP, 0
+ PAGE
+\f/DECODE COMMAND DECODER INPUT
+
+RALFLP, JMS I (200
+ 5 /COMMAND DECODE
+ 2214 /.RL DEFAULT EXTENSION
+ TAD (7616
+ DCA PTRIO
+ TAD I (OS8SWS+1
+ AND (40
+ CDF 0
+ SZA CLA /IS /S SWITCH ON?
+ DCA I (SVMAIN+LB0BUF /CLEAR (RELOCATED) SVMAIN
+DECO, CDF 10 /FOR FULL SYMBOL MAP LISTING
+ TAD I (7600 /CHK FOR LOADER IMAGE FILE
+ SNA /OUTPUT FILE?
+ JMP SM /NO
+ AND (0017 /MUST BE AN "MS" DEV
+ TAD (OS8DCB-1
+ DCA TMP0
+ TAD I TMP0
+ SPA CLA /IS IT?
+ JMP .+4 /YES
+SM1, TAD (DEVERR /NO,ERR
+ JMS I (ERORR
+ JMP RALFLP
+ TAD I P7604
+ SNA
+ TAD (1404 /.LD
+ DCA I P7604 /INTO EXTENSION IF NONE SPECIFIED
+ JMS I (CORMOV /MOVE LOADER IMAGE FILE NAME
+ CDF 10
+ 7600-1
+ CDF 0 /INTO FIELD 0
+ LDRNAM+LB0BUF-1
+ -5
+SM, TAD I (7605 /CHK FOR SYM MAP FILE
+ SNA
+ JMP SM2 /NONE
+ AND (17
+ TAD (OS8DCB-1
+ DCA TMP0
+ TAD I TMP0
+ RAL /LOOK AT "READ ONLY" BIT IN DCB
+ SPA CLA
+ JMP SM1 /ERROR - NO GOOD FOR OUTPUT
+ TAD I (7611
+ SNA
+ TAD (1423 /.LS DEFAULT MAP EXTENSION
+ DCA I (7611
+ JMS I (CORMOV /MOVE SYMMAP FILE NAME INTO FIELD 0
+ CDF 10
+P7604, 7605-1
+ CDF 0
+ LDRNAM+LB0BUF+4
+ -5
+\f/COLLECT INPUT FILES
+
+SM2, TAD I (OS8SWS
+ CLL RAR
+ SZL CLA / IS /L SWITCH ON?
+ JMP LIBRAR /YES - THIS IS A LIBRARY FILE
+FILELP, TAD I PTRIO
+ SNA
+ JMP FINLIN /NO MORE INPUT FILES
+ DCA TMP0
+ TAD TMP0
+ AND (17
+ ISZ PTRULS
+ DCA I PTRULS /STORE UNIT NUMBER
+ TAD TMP0
+ AND (7760
+ CLL RTR
+ RTR
+ TAD (7400
+ CIA
+ ISZ PTRULS
+ DCA I PTRULS /STORE LENGTH
+ TAD I PTRIO
+ ISZ PTRULS
+ DCA I PTRULS /STORE STARTING BLOCK NUMBER
+ ISZ MODCNT
+ JMP FILELP /CONTINUE
+
+FINLIN, JMS I (CORDSW /CHECK C AND O SWITCHES
+ TAD I (OS8SWS
+ AND (40
+ SZA CLA /IF THE /G SWITCH IS ON
+ JMP I (EOPAS0 /ITS THE END
+ TAD I (OS8SWS-1
+ SPA CLA /IF AN ALTMODE TERMINATED THE LINE,
+ JMP I (EOPAS0 /DITTO
+ TAD (-MCTTBL-1
+ TAD NMCTS
+ SZA CLA /ARE WE STILL IN THE MAIN SECTION?
+ JMS I (UPDMOD /NO - UPDATE OVERLAY & MODULE COUNTS
+ JMP RALFLP
+\fLIBRAR, TAD I PTRIO
+ AND (17
+ DCA I (MODTBL /STORE LIBRARY PARAMETERS
+ TAD I PTRIO /NEGLECTING LENGTH, WHICH WILL
+ DCA I (MODTBL+2 /BE FILLED IN LATER
+ TAD I PTRIO
+ SNA CLA
+ JMP FINLIN /ONLY ONE FILE ALLOWED ON THE LINE
+ TAD (MIERR
+ JMP SM1+1 /OTHERWISE ITS MIXED INPUT
+ PAGE
+\f/UPDMOD- UPDATE MODULE COUNT TBL
+
+UPDMOD,0
+ CLL
+ TAD MODCNT /UPDATE -NUM OF
+ TAD I (MCTTBL /UNUSED MODULES
+ DCA I (MCTTBL
+ SZL
+ JMP MAXRLF /MAX NUMBER EXCEEDED
+ ISZ OVRCNT /BUMP OVERLAY NUMBER
+SKPCLA, SKP CLA
+ JMP MAXOVL /MORE THAN 16 OVERLAYS IN A LEVEL
+ TAD MODCNT /UPDATE +NUM OF
+ TAD I NMCTS /MODULES IN LAST LEVEL
+ SNA /****
+ JMP I UPDMOD
+ DCA I NMCTS
+ ISZ NMCTS /ADV PTR TO NXT LOC
+ DCA I NMCTS /ZERO THE NXT LOC IN PREPARATION
+ DCA MODCNT /CLR CNT FOR NXT LEVEL
+ JMP I UPDMOD
+
+/CORDSW- LOOK FOR SWS C AND O
+
+CORDSW, 0
+ TAD I (OS8SWS+1
+ AND (10
+ SNA CLA /CHECK FOR /U SWITCH
+ JMP CHKCSW
+ CDF 0
+ TAD SKPCLA /INHIBIT LEVEL CHECKING
+ DCA I (TSTTRP
+ CDF 10
+CHKCSW, TAD I (OS8SWS
+ RTL
+ SPA CLA
+ JMP I (RALFLP
+ TAD I (OS8SWS+1
+ RTL
+ SMA CLA
+ JMP I CORDSW
+
+/O-SWITCH
+
+ JMS UPDMOD
+ ISZ NMCTS /ADV PTR FOR NXT GUY
+ DCA I NMCTS /CLR FOR NXT LEVEL MOD CNT
+ TAD (-21
+ DCA OVRCNT
+ ISZ LVLCNT /BUMP LEVEL COUNTER
+ JMP I (RALFLP
+ TAD (MXLERR
+ JMP MAXRLF+1 /TOO MANY LEVELS
+\fMAXRLF, TAD (MXRERR
+ JMS ERORR
+ CDF CIF 0
+ JMP I (7605
+MAXOVL, TAD (MXOERR
+ JMP MAXRLF+1
+
+/ERORR- PRINTS OUT ERROR MESSAGES OF A
+/ BUFR LOCATED IN FLD1
+/ ENTER WITN ADR OF BUFR IN AC
+/
+ERORR, 0
+ DCA BFADR
+ CDF 10 /CALL TTYHAN
+ JMS I (CORMOV
+ CDF 0
+ LB0BUF-1 /MOVE LOWER FIELD 0 BACK
+ CDF 0 /SO WE CAN USE THE MESSAGE HANDLER
+ 0-1
+ -2000
+ CIF 0
+ JMS I (TTYHAN
+ CDF 10
+BFADR, 0
+ JMP I ERORR
+\fMIERR, TEXT /MIXED INPUT/
+DEVERR, TEXT /BAD OUTPUT DEVICE/
+MXRERR, TEXT /TOO MANY RALF FILES/
+MXLERR, TEXT /TOO MANY LEVELS/
+MXOERR, TEXT /TOO MANY OVERLAYS/
+ PAGE
+\f/PASS1, PASS2 INITIALIZATION
+
+EOPAS0, JMS I (UPDMOD /BUMP COUNTS FOR LAST LINE OF INPUT
+ ISZ NMCTS
+ DCA I NMCTS /PUT IN A DOUBLE ZERO AT THE END
+ JMS I (CORMOV
+ CDF 0
+ LB0BUF-1
+ CDF 0
+ 0-1 /MOVE LOWER FIELD 0 BACK INTO PLACE
+ -2000
+ TAD I (MODTBL
+ SZA CLA /USER-SPECIFIED LIBRARY?
+ JMP RDLIBH /YES
+ CLA IAC
+ JMS I (200
+ 2 /LOOKUP
+ LIBRY
+ 0
+ JMP NOLIB /FORLIB.RL NOT FOUND
+ TAD .-3 /GET STARTING BLOCK
+ DCA I (MODTBL+2
+ CLA IAC
+ DCA I (MODTBL /STORE UNIT AND BLOCK #
+RDLIBH, STL RTR
+ DCA I (MODTBL+1 /JUST TO BE CAREFUL
+ CIF 0
+ JMS I (IOHAN /READ BLOCK 0 OF THE LIBRARY CATALOG
+ MODTBL
+ 0210
+PLB, RALFBF
+ 0
+ STA
+ TAD I PLB
+ SNA CLA /IS IT AN HONEST - TO - GOD LIBRARY?
+ JMP .+4 /YES
+NOLIB, DCA I (MODTBL
+ DCA I (MODTBL+2
+ DCA I (RALFBF+3 /ZERO COUNT WORD IN BUFFER
+ TAD I (RALFBF+3
+ DCA I (MODTBL+1 /STORE LENGTH OF CATALOGUE
+ TAD (LHDR-1
+ DCA NDX0
+ TAD (-400
+ DCA TMP0
+ DCA I NDX0 /0 OUT
+ ISZ TMP0 /LDR HDR
+ JMP .-2 /GET PAGE 0
+\f/PASS1 INITIALIZATION CONTINUED
+
+ TAD I (MCTTBL /UNUSED
+ DCA TMP2 /MODULES
+ TAD (MCTTBL+2 /GET NUMBER OF OVERLAYS
+ DCA NDX0 / IN EACH LEVEL
+ TAD (QUSRLV+4 /WHERE THE
+ DCA TMP0 /CNTS GO IN
+ JMP BY0 /LDR HDR BLK
+LOP0, ISZ I TMP0 /INCREMENT NUMBER OF OVERLAYS IN THIS LEVEL
+ TAD I NDX0
+ SZA CLA /END OF LEVEL?
+ JMP LOP0 /NO
+ TAD (4 /THIS LEVEL
+ TAD TMP0
+ DCA TMP0
+BY0, DCA I TMP0 /RESET CNT
+ TAD I NDX0 /0,0 ENDS
+ SZA CLA /MOD CNT TBL
+ JMP LOP0 /DO MORE PTR TO
+ TAD I (MODTBL+1 /GET LENGTH OF LIBRARY CATALOG
+ DCA TMP4 /BLOCKS
+ TAD TMP2 /CHK FOR MAX
+ SZA CLA /NUM OF RALFS 0=MOD TBL IS FULL
+ TAD I (MODTBL /CHK FOR NO
+ CDF
+ DCA I (LIBRSW /LIBRARY AND SET SWITCH ACCORDINGLY
+ TAD TMP2 /-NUM LEFT
+ DCA I (MLEFT /OF RALF MODS
+ TAD (SYMTBL-1 /PTR TO TOP
+ DCA I (NDX4 /OF GST
+ TAD I (OSJSWD
+ AND (7377 /KILL "BATCH PROTECTED" FLAG
+ DCA I (OSJSWD
+\f AC7776 /IS THERE
+ TAD MXFLD /GREATER THAN 12K OF CORE
+ SPA SNA CLA /?
+ JMP LS16K /NO
+ TAD (200^12!30 /SET TXT I/O
+ DCA I (TXTBLK-2 /BUFFS UP IN FLD 3
+ TAD (-5000 /-WDCNT (12
+ DCA I (TXTWDS /BLKS)
+ TAD (6231 /CDF 30
+ DCA I (RDTCDF
+LS16K, TAD (7700 /USR IS NOT
+ DCA I (USR /IN CORE
+ CDF 10
+ JMP I (INIBFS
+LIBRY, 0617;2214;1102;2214 /FORLIB.RL
+ PAGE
+\f/THIS IS THE INITIAL BINARY BUFFER TABLE
+
+R= LDBUFS-BUFTAB
+
+BUFTAB, .+4+R; 0; 0; 3200 /03200-05177
+B8KPT, .+4+R; 0; 0; 5200 /05200-07177
+ .+4+R; 0; 0; 0020 /20000-21777
+B12KPT, .+4+R; 0; 0; 2020 /22000-23777
+B16KPT, .+4+R; 0; 0; 4020 /24000-25777
+ .+4+R; 0; 0; 0040 /40000-41777
+B20KPT, .+4+R; 0; 0; 2040 /42000-43777
+ .+4+R; 0; 0; 4040 /44000-45777
+ .+4+R; 0; 0; 0050 /5000-51777
+ 0; 0; 0; 2050 /52000-53777
+\fINIBFS, TAD MXFLD
+ TAD (JMP STBPTR-1
+ DCA .+1
+ HLT /DISPATCH ON NUMBER OF FIELDS
+STBPTR, DCA B8KPT
+ DCA B12KPT
+ DCA B16KPT
+ DCA B20KPT
+ NOP
+ NOP /NOT SET UP TO USE MORE THAN 24K
+ NOP
+ JMS I (CORMOV
+ CDF 10
+ BUFTAB-1 /MOVE THE BINARY BUFFER TABLE
+ CDF 10
+ LDBUFS-1 /INTO A SAFE PLACE
+ -50
+ CDF 0
+ TAD LVLCNT /SET -NUM OF
+ TAD (11 /LEVELS
+ CIA
+ DCA I (NLVL
+ TAD (-5 /NUM OF LIBR
+ DCA TMP2 /BLKS FOR 8K
+ CLA CMA
+ TAD MXFLD
+ SNA CLA /GREATER THAN 8K CORE?
+ JMP TO8K /NO SET LIBR ARGS
+ DCA I (LBARG+1
+ TAD (200^12!20 /12 BLKS FLD2
+ DCA I (LBARG
+ TAD (6221 /CDF 20
+ DCA I (LBFLD
+ TAD (6221
+ DCA I (GETLEN+1
+ TAD (-12
+ DCA TMP2
+TO8K, TAD TMP2 /WILL LIBR
+ TAD TMP4 /BE CORE
+ SMA SZA CLA /RESIDENT?
+ DCA I (RESFLG /NO
+ TAD (SYMTBL-1
+ DCA I (NDX0
+\f CDF 10
+ TAD (ESDPG-1 /ENTER DEFAULT
+ DCA NDX0 /VALUES FOR
+ TAD (-200 /ESD REF PAGE
+ DCA TMP0 /IT SAVES
+ TAD (SYMTBL+5 /PROBLEMS WITH
+ DCA I NDX0 /EXTERNS
+ ISZ TMP0
+ JMP .-3
+ CLA STL RTL
+ DCA I (LHDR /STORE LOADER IMAGE CODE IN HEADER
+ TAD (VERNUM
+ DCA I (QVERNO /STORE LOADER VERSION NUMBER
+ CIF 0
+ JMP I (STPAS1
+ PAGE
+\f/CORMOV- A CORE MOVE FOR A CHUNK OF CORE IN
+/ ANY FLD TO ANY FLD.
+/
+/ CALL JMS CORMOV
+/ CDF Z1 /Z1=FROM FLD
+/ ADDR1 /ADDR OF (1ST LOC-1)
+/ CDF Z2 /Z2=TO FLD
+/ ADDR2 /ADDR OF (1ST LOC-1)
+/ -N /-OCT NUM OF WDS TO MOV
+/
+CORMOV, 0
+ CLA CMA
+ TAD CORMOV
+ DCA NDX0
+ TAD I NDX0
+ DCA TOCDF-2
+ TAD I NDX0
+ DCA NDX1
+ TAD I NDX0
+ DCA TOCDF
+ TAD I NDX0
+ DCA NDX2
+ TAD I NDX0
+ DCA TMP0
+ 0
+ TAD I NDX1
+TOCDF, 0
+ DCA I NDX2
+ ISZ TMP0
+ JMP TOCDF-2
+ CDF 10
+ JMP I NDX0 /RTN
+
+ $$$$$
+\f