A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape2 / load.pa

/ 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