/RELOCATING LOADER FOR PS/8
	FIELD 0
	/ONCE ONLY CODE FOR RELOCATABLE LOADER
	IFNDEF LIBRARY <LIBRARY=1>
	JSTFLD=7744
	JSTADR=7745
	JSBITS=7746
	MOFILE=7600
	MIFILE=7617
	MPARAM=7643
	DCB=7760
	MSTCDF=7772
	MSTADR=7775
	SHNDLR=7607
	MGET=7667
	MTEMP=27
	OLDT9=7		/LOCATION OF HANDLER ENTRY OF DEVICE WITH DIRECTORY IN CORE
	*0
ZERO,	JMS I XSHNDLR
ONE,	2010
	3600
	MTEMP+11
	HLT
FIVE,	JMP I .+1
	7600
XSHNDLR,	SHNDLR
X1,	0
X2,	0
X3,	0
X4,	0
	*16
	NOPUNC
	*100
	ENPUNC
DFRSTR,	CIF 10
	JMS I DF200
	11		/KICK OUT MONITOR
DFSAVE,	0		/RESTORE CALLING FIELD
	JMP I CDZSKP	/AND EXIT

SAVEDF,	0		/COMMON SAVE-FIELD PROCESSOR FOR FORTRAN I/O
	DCA CDZSKP	/CALLING ADDRESS
	RDF
	TAD .+2
	DCA DFSAVE	/CALLING FIELD
CDF CIF 0
	JMP I SAVEDF
DF200,	200
/
*33
	BNK=00
/
/	COMMON SUBROUTINE CALL LINKAGE ROUTINE
/
LINK,	0
K6201,	CDF	BNK	     /SET DATA FIELD TO THIS BANK
K6202,	CIF	00	     /SET INSTRUCTION FIELD TO ZERO
	JMP I	MLINKP	     /EXIT TO MASTER LINKAGE ROUTINE
MLINKP,	MLINK
/
/	COMMON SUBROUTINE RETURN LINKAGE ROUTINE
/
RTN,	0
	CDF	BNK	     /SET DATA FIELD TO THIS BANK
	CIF	00	     /SET INSTRUCTION FIELD TO ZERO
	JMP I	MRTNP	     /EXIT TO MASTER RETURN ROUTINE
MRTNP,	MRTN
/
/	CHANGE DATA FIELD TO CURRENT AND SKIP
/
CDFSKP, 0
	ISZ	CDFSKP	     /INDEX ADDRESS FOR SKIPPING
	CDF	BNK	     /CHANGE DATA FIELD TO CURRENT BANK
	JMP I	CDFSKP	     /EXIT
/
/	CHANGE DATA FIELD TO ZERO AND SKIP
/
CDZSKP, 0
	ISZ	CDZSKP	     /INDEX RETURN ADDRESS FOR SKIPPING
	CDF	10	     /CHANGE DATA FIELD TO ZERO
	JMP I	CDZSKP	     /EXIT
/
/	OFF BANK INDIRECT SUBROUTINE
/
OBISUB, 0
	CDF	BNK	     /SET DATA FIELD TO THIS BANK
	CIF	00	     /SET INSTRUCTION FIELD TO ZERO
	JMP I	MOBIP	     /EXIT TO MASTER OFF BANK INDIRECT SUBROUTINE
MOBIP,	MOBI
/
/	OFF PAGE INDIRECT SUBROUTINE
/
OPISUB, 0
	CDF	BNK	     /SET DATA FIELD TO THIS BANK
	CIF	00	     /SET INSTRUCTION FIELD TO BANK 0
	JMP I	MOPIP	     /EXIT TO MASTER OFF PAGE INDIRECT SUBROUTINE
MOPIP,	MOPI
/
/	ROUTINE TO HANDLE DUMMY ARGUMENTS
/
DUMSUB, 0
	CDF	BNK	     /SET DATA FIELD TO THIS BANK
	CIF	00	     /SET INSTRUCTION FIELD TO BANK 0
	JMP I	MDUMP	     /EXIT TO MASTER DUMMY ARGUMENT ROUTINE
MDUMP,	MDUM

/	PAGE 0 CELLS FOR FORTRAN EXECUTION TIME I/O

/	CELLS SET UP BY LINKING LOADER - CANNOT GO PAST 77
INHNDL,	0	/PAGE FOR INPUT HANDLER IF /I SWITCH WAS ON
OUHNDL,	0	/PAGE FOR OUTPUT HANDLER IF /O SWITCH WAS ON
ELENGT,	0	/"DESIRED LENGTH" FOR FORTRAN OUTPUT FILES - USUALLY 0

	*DF200+1
/OTHER PAGE 0 LOCATIONS
FOPOLD,	0
FINPTR,	0
FICHCT,	0	/MUST BE INIT. TO -1 AT LOOKUP
FINTMP,	0	/MUST BE INIT. TO 10 AT LOOKUP
OHNDLR,	0	/SET BY FENTER - CLEARED BY FCLOSE
IHNDLR,	0	/SET BY FLUKUP - NEVER CLEARED
FOUPTR,	0
FOCHCT,	0
	*200
LSTART,	JMP LDRYYY
SSTART,	CDF 10
	TAD I (MOFILE
	SNA CLA
	JMP LDRYYY
	TAD (MOFILE+11
	DCA X1
	TAD (MOFILE
	DCA SEVEN
	TAD (-5
	DCA SIX
	TAD (TEMP-1
	DCA X2
MOVLP1,	TAD I SEVEN
	CDF 0
	DCA I X2
	CDF 10
	TAD I X1
	DCA I SEVEN
	ISZ SEVEN
	ISZ SIX
	JMP MOVLP1
	TAD TEMP+1	/GET BLOCK NUMBER WHICH SABR PLACED HERE
	DCA I (MIFILE+1
	DCA I (MIFILE+2
	CLA CLL CMA RAL
	AND I (MPARAM
	DCA I (MPARAM	/REMOVE /L SWITCH FROM SABR INPUT
	CDF 0
	CIF 10
	CLA IAC
	JMS I (200
	4		/DELETE
	FORTRL		/THE FILE "FORTRL.TM" IF IT EXISTS
	0
	NOP		/IT DIDN'T EXIST - BIG DEAL
	TAD TEMP
LDRYYY,	CDF CIF 10
	DCA I (MIFILE
	CDF 0
	JMS I (200
	12		/GET DEVICE NUMBER WITHOUT HANDLER
	2424		/TT
TTYNUM,	3100		/Y
	1000		/RANDOM NUMBER
	JMP LWOWIE	/WHAT - NO TELETYPE???
	CIF 10
	CLA IAC		/DEVICE "SYS"
	JMS I (200
	2
PTSLIB,	SYSLIB
	0		/USELESS LENGTH WORD
	CLA SKP
	TAD PTSLIB
	CDF 10
	DCA I (PSYSLB
	TAD TTYNUM
	DCA I (TTYNO	/STORE AWAY TTY DEVICE NUMBER
	TAD (-7
	DCA FLDCTR
FLDLP,	TAD FLDCTR
	TAD (10
	CLL RTL
	RAL
	TAD (6201
	DCA TSTCDF
	DCA LINK
TSTCDF,	HLT
	TAD (1234
	DCA I (LINK
	CLA
	TAD I (LINK
	NOP		/PDP-8 BUG IN EXTENDED MEMORY
	CDF 0
	TAD (-1234
	SNA
	TAD LINK
	SZA CLA
	JMP FOUNDF
	ISZ FLDCTR
	JMP FLDLP
	CLA CMA
FOUNDF,	TAD FLDCTR
	CIA
	TAD (-10
	JMS I (PROPGT	/SPREAD THE FIELD ZERO RESIDENT THROUGH THE FIELDS
	CDF CIF 10
	TAD (TTYOUT
	DCA I (TYPE
	JMP I .+1
	LDRXXX

SIX,	0
SEVEN,	0
FORTRL,	TEXT	/FORTRLTM/

LWOWIE,	CDF CIF 10
	JMP I (SIOERR
FLDCTR,	0
TEMP,	0;0;0;0
/
/FIELD 0
/FULL LINKAGE ROUTINES
/
	*400
K77A,	0077		/MUST BE FIRST LOC ON PAGE
/
/	MASTER OFF PAGE INDIRECT ROUTINE
/
MOPI,	DCA	AC	/SAVE AC
	TAD I	OPIP	/PICK UP ADDRESS OF PARAMETER
	DCA	DUMSUB
	TAD I	DUMSUB	/ACTUAL PARAMETER
	DCA	7	/TO A TEMP
	TAD I	7	/PICK UP FINAL DATA
	DCA I	K7	/TO LOCATION 7 IN FROM BANK
	RDF		/FROM BANK
ATVX,	TAD	K6202	/MAKE A CIF FROM INSTRUCTION
	DCA	ATV	/SAVE IN THIS SEQUENCE
	JMP	ATV-1
/
/	MASTER OFF BANK INDIRECT ROUTINE
/
MOBI,	DCA	AC	/SAVE AC
	TAD I	OBIP	/ADDRESS OF PARAMETER
	DCA	DUMSUB
	TAD I	DUMSUB	/ACTUAL COMMON ADDRESS
	DCA	7	/SAVE IT
	RDF		/FROM BANK
	TAD	K6201	/MAKE A CDF FROM INSTRUCTION
	DCA	.+3	/PLACE IN THIS SEQUANCE
	CDF	10	/CHANGE DATA FIELD TO COMMON
	TAD I	7	/ACTUAL DATA
	NOP		/BECOMES CDF AND CIF FROM INSTRUCTION
	DCA I	K7	/TO LOCATION 7 IN FROM BANK
	RDF
	CDF 10
	JMP	ATVX
/
/	MASTER INDIRECT DUMMY ARGUMENT SUBROUTINE
/
MDUM,	DCA	AC	/SAVE AC
	TAD I 	DUMP	/PICK UP ADDRESS OF PAR
	DCA	DUMSUB
	TAD I	DUMSUB	/PICK UP POINTER TO 2 WORD VECTOR
	DCA	DUMTEM	/TO A TEMPORARY
	TAD I	DUMTEM	/FIELD DATA IS IN AS A CDF
	DCA	ABCRT	/TO THIS SEQUANCE
	RDF		/FROM FIELD
	TAD	K6202	/MAKE A CIF INSTRUCTION
	DCA	ATV	/TO THIS SEQUANCE FOR EXIT
	ISZ	DUMTEM	/POINT TO LOCATION IN FIELD
	TAD I	DUMTEM	/ACTUAL LOCATION IN UNKNOWN FIELD
	DCA I	K7	/TO FROM FIELD LOCATION 7
ABCRT,	NOP		/BECOMES CDF UNKNOWN
	ISZ	DUMSUB	/BUMP RETURN ADDRESS
ATV,	NOP		/BECOMES CIF FROM
	TAD	AC	/RESTORE AC
	JMP I	DUMSUB	/EXIT
AC=CDZSKP
DUMTEM=OBISUB
OPIP,	OPISUB
OBIP,	OBISUB
DUMP,	DUMSUB
/
/	MASTER LINKAGE ROUTINE
/
MLINK,	DCA	AC	/SAVE AC
	RDF
	TAD	K6201	/MAKE A CDF
	DCA	DUMTEM
	TAD I	LINKP	/ADDRESS OF CODE WORD
	JMS	RTS1
	TAD	DUMTEM	/CDF FROM INSTRUCTION
	DCA I	DUMSUB	/TO FIRST WORD OF 2 WORD VECTOR
	ISZ	DUMSUB	/POINT TO DISPLACEMENT
	TAD	LINK	/ADDRESS OF CODE WORD
	IAC			/INCR. TO FIRST ARG
	DCA I	DUMSUB	/TO SECOND WORD OF 2 WORD VECTOR
	JMP	ATVX-1
/
/	MASTER RETURN ROUTINE
/
MRTN,	DCA	AC	/SAVE AC
	TAD I	RTNP	/ADDRESS OF CODE WORD
	JMS	RTS1
	TAD I	DUMSUB	/FIELD TO RETURN TO AS A CDF INSTRUCTION
	TAD	K2
	DCA	ATV
	ISZ	DUMSUB
	TAD I	DUMSUB
	DCA	DUMSUB
	JMP	ATV
/
/DATA
/
K100A,	100
K7700A,	7700
LINKP,	LINK
RTNP,	RTN
/
/SUBROUTINE 1
/
RTS1,	0
	DCA	LINK
	TAD I	LINK	/CODE WORD
K200A,	AND	K77A	/MASK OUT NUMBER OF ARGUMENTS
	TAD	K200A	/+DISPLACEMENT
	DCA	ABCRT	/GIVES ADDRESS OF BCRT ENTRY
	TAD	ABCRT
	TAD	K100A	/+DISPLACEMENT
	DCA	ATV	/GIVES ADDRESS OF TV DISPLACEMENT
K6203,	CDF CIF	00	/SET TO USE TABLES IN BANK 0
	TAD I	ABCRT	/TO CDF INSTRUCTION
	DCA	RTSCDF	/TO FIRST WORD OF 2 WORD VECTOR
	TAD I	ATV	/TO BANK DISPLACEMENT
	SNA			/WAS IT LOADED?
	JMP	NOTIN		/NO

	DCA	DUMSUB	/TO SECOND WORD OF 2 WORD VECTOR
RTSCDF,	0
	JMP I	RTS1

NOTIN,	CIF 10
	JMS I K7700A
K7,	7
	1			/USER ERROR 1 - PROGRAM NOT LOADED
FASIGN,	0		/CALLED FROM SABR - DOES ASSIGN AND
	DCA	CDFSKP	/EITHER LOOKUP,ENTER OR CLOSE
	TAD FASIGN
	JMS SAVEDF
	CIF 10
	JMS I K7700A
	10		/CALL USR IN
	CIF 10
	JMS I K200A
	1		/ASSIGN HANDLER
ASDEV,	0;0		/SET UP BY SABR
ASPAGE,	0		/DITTO
	JMP ASERR	/ASSIGN FAILURE
ZRONAM,	DCA FLUNAM	/ZERO FILENAME FOR LOOKUP
	TAD ASDEV+1	/PUT DEVICE NUMBER IN AC
	JMP I CDFSKP	/JUMP TO APPROPRIATE ROUTINE

	*567		/MUST CROSS PAGE BOUNDARY JUST SO
FLUKUP,	CIF 10
	JMS I K200A
K2,	2		/LOOKUP FILE
FLUNAM,	0		/REPLACED BY BLOCK NUMBER
FLUCNT,	0		/REPLACED BY LENGTH (UNUSED)
ASERR,	ISZ CDZSKP	/SKIP RETURN IF ERROR
	TAD ASPAGE
	DCA IHNDLR	/SET UP INPUT HANDLER ENTRY AND FLAG
	TAD FLUNAM
	DCA FINREC	/***** THIS SHOULD BE AT LOC 600! *****
	CLA CMA
	DCA FICHCT
	TAD FIN10
	DCA FINTMP
	JMP FRESET	/RESET I/O AND RETURN FROM FASIGN

	/GET A CHARACTER ROUTINE.
	/RETURNS TO .+1 IF ERROR, .+2 IF NORMAL
	/CHAR IN AC ON OUTPUT
	/DOES NOT HANDLE END-OF-FILE VERY WELL
FICHAR,	0
	TAD FICHAR
	JMS SAVEDF	/SAVE RETURN FIELD AND ADDRESS
FNXTCH,	ISZ FICHCT	/BUMP CHAR COUNT
	JMP FIGET
	JMS I IHNDLR	/IT OVERFLOWED - READ IN A NEW BUFFER
FI200,	200
FINBUF,	1200
FINREC,	0
FI7700,	SMA CLA
	SKP		/END - OF - FILE ERROR - IGNORE
	JMP DFSAVE	/ERROR RETURN
	ISZ FINREC
	CLA CMA
	TAD FINBUF
	DCA FINPTR
	TAD FI7200
	DCA FICHCT	/INITIALIZE FOR NEW RECORD
FIGET,	TAD FINTMP	/GET HIGH-ORDER-BIT BUFFER
	SPA		/IS IT FULL?
	JMP FITHRD	/YES - OUTPUT COMBINED HIGH-ORDER BITS
FI7200,	CLA
	ISZ FINPTR
	TAD I FINPTR	/GET A LOC FROM THE BUFFER
	AND FI7400
	RAL CLL
	TAD FINTMP	/PUT THE HIGH ORDER BITS ONTO THE HOB BUFFER
FINXX,	RTL
	RTL
	DCA FINTMP
	TAD I FINPTR
	JMP DFEXIT	/RETURN WITH SKIP
FITHRD,	DCA I FINPTR	/FUDGE THIRD CHAR INTO BUFFER
	CLL CML
	JMP FINXX	/RESET FINTMP TO 10

	/PUT A CHARACTER
	/RETURNS TO .+1 IF ERR, .+2 IF NORMAL
	/CALLED WITH CHAR IN AC
FOCHAR,	0
	DCA FOUTMP	/SAVE CHAR
	TAD FOCHAR
	JMS SAVEDF	/SAVE CALLING FIELD AND LOC
FOLOOP,	ISZ FOUJMP
	ISZ FOCHCT	/BUMP CHAR COUNT
FOJMP,	JMP FOUJMP	/TAKE A BRANCH OF THE THREE-WAY JUMP
	JMS I OHNDLR
	4200
FOUBUF,	1200
FOUREC,	0
	JMP DFSAVE	/OUTPUT ERROR
	ISZ FOUREC
	JMS FOSETP
	ISZ FOCCNT	/BUMP FILE LENGTH
	ISZ FOOCNT	/ALSO ENTER COUNT
	JMP FOLOOP	/NOW GO PUT THE CHAR INTO THE NEW BUFFER
	JMP DFSAVE	/ENTER COUNT OVERFLOWED - ERROR RETURN

FOUJMP,	JMP .		/THREE-WAY SWITCH
	JMP FOUCH1
	JMP FOUCH2
FOUCH3,	TAD FOUTMP
	RTL
	RTL
	DCA FOUTMP
	TAD FOUTMP
	AND FI7400
	TAD I FOPOLD	/PUT HIGH ORDER BITS OF CHAR3
	DCA I FOPOLD	/INTO HIGH ORDER BITS OF CHAR 1
	TAD FOUTMP
	RTL
	RTL
	AND FI7400
	TAD I FOUPTR	/PUT LOW ORDER BITS OF CHAR 3
	DCA I FOUPTR	/INTO HIGH ORDER BITS OF CHAR 2
	TAD FOJMP
	DCA FOUJMP
	ISZ FOUPTR
	JMP DFEXIT	/RETURN NORMALLY
FOUCH2,	TAD FOUPTR
	DCA FOPOLD	/SAVE POINTER TO CHAR 1
	ISZ FOUPTR
FOUCH1,	TAD FOUTMP
	DCA I FOUPTR	/STORE CHAR 1 OR 2
DFEXIT,	ISZ CDZSKP	/INCREMENT RETURN ADDR
	JMP DFSAVE	/AND GO THERE

FOSETP,	0
	TAD FO7177
	DCA FOCHCT
	TAD FOUBUF
	DCA FOUPTR
	TAD FOJMP
	DCA FOUJMP
	JMP I FOSETP

FO7177,	7177
FIN10,	10

FENTER,	TAD ELENGT	/ELENGT=0 UNLESS SOME KLUDGE SETS IT UP
	CIF 10		/FENTER JUMPED TO BY FASIGN
	JMS I FI200
	3
FOONAM,	0		/FILE NAME IN LOCS 0-3
FOOCNT,	0
	ISZ CDZSKP	/FOR ENTER, ERROR RETURN IS SKIP RETURN
	TAD FOONAM
	DCA FOUREC	/INITIALIZE OUTPUT RECORD #
	JMS FOSETP	/SET UP CHARACTER POINTERS
	DCA FOONAM	/SET FOONAM FOR NEXT ENTER
	TAD I PASPAG
	JMP STOHND	/GO TO COMMON CODE WITH "FCLOSE"
PASPAG,	ASPAGE

FCLOSE,	CIF 10		/JUMPED TO BY FASIGN
	JMS I FI200	/CALL I/O MONITOR
	4
FOCNAM,	0		/FILE NAME IN 0-3
FOCCNT,	0		/CLOSING LENGTH
	ISZ CDZSKP	/ERROR - BUMP RETURN
STOHND,	DCA OHNDLR
	DCA FOCCNT	/INITIALIZE CLOSING COUNT FOR NEXT FILE
FRESET,	CIF 10
	JMS I FI200
	13		/RESET ALL DEVICE HANDLER ENTRIES
	0		/BUT RETAIN ANY OPEN OUTPUT FILES
	JMP DFRSTR	/RETURN FROM FASIGN AFTER KICKING MONITOR OUT
	FOUTMP=FICHAR
FI7400,	7400
	*1000
PROPGT,	0
	CDF 10
	DCA I LTOPCOR
	TAD I LTOPCOR
	DCA I LFCTR
	CDF 0
	TAD I LFLDCTR
	TAD L7
PROPLP,	DCA FC
	CLA CMA
	TAD FC
	SNA CLA
	JMP FIELD1
	TAD FC
	JMS CHGBNK
	JMS STOBNK
	CLA CMA
	TAD FC
	JMP PROPLP
FIELD1,	CLA IAC
	JMS CHGBNK
	JMS I LSHNDLR
	4100
	0
	MTEMP
	JMP I LLWOWIE
	JMS I LSHNDLR
	4201
	400
	MTEMP+21		/WRITE OUT RUN-TIME ROUTINES
	JMP I LLWOWIE
	JMS CHGBNK
	TAD L6001
	DCA I LJSBITS
	TAD L6213
	DCA I LJSTFLD
	TAD LLRSTRT
	DCA I LJSTADR
	JMP I PROPGT
FC,	0

CHGBNK,	0
	CLL RTL
	RAL
	TAD LCDF
	DCA X1
	TAD X1
	DCA LINK+1
	TAD X1
	DCA RTN+1
	TAD X1
	DCA CDFSKP+2
	TAD X1
	DCA OBISUB+1
	TAD X1
	DCA OPISUB+1
	TAD X1
	DCA DUMSUB+1
	JMP I CHGBNK

STOBNK,	0
	TAD LLINK1
	DCA X2
	TAD X2
	DCA X3
	TAD LLINK2
	DCA X4
	TAD X1
	DCA STOCDF
STOLUP,	CDF 0
	TAD I X2
STOCDF,	HLT
	DCA I X3
	ISZ X4
	JMP STOLUP
	CDF 0
	JMP I STOBNK
SYSLIB,	TEXT	/LIB8/
	2214	/.RL

LTOPCOR,TOPCOR
LSHNDLR,SHNDLR
LFCTR,	FCTR
LFLDCTR,FLDCTR
L7,	7
LLWOWIE,LWOWIE
L6001,	6001
LJSBITS,JSBITS
LJSTADR,JSTADR
LJSTFLD,JSTFLD
L6213,	6213
LCDF,	CDF
LLINK1,	LINK-1
LLINK2,	LINK-MDUMP-2
LLRSTRT,LRSTRT
	*1200		/LINKING LOADER SUBROUTINES FOR /I AND /O OPTIONS
INPENB,	0
	ISZ INPFLG
	JMP INRTRN	/ALREADY HAVE A /I
	TAD OUPFLG
	SPA CLA
	JMP INVRGN
	TAD (2200
	DCA INHNDL
	TAD (FINBUF
	CDF 10
	DCA I (ST1600	/MARK THE INPUT BUFFER IN PAGE 1600
	TAD (2377
	JMS SETHLA
INRTRN,	CDF CIF 10
	JMP I INPENB

INVRGN,	TAD (1000
	DCA INHNDL
	TAD (1577
	JMP INRTRN-1

OUPENB,	0
	ISZ OUPFLG
	JMP OURTRN
	TAD INPFLG
	SPA CLA
	JMP OUVRGN
	TAD (2200
	DCA OUHNDL
	TAD (FOUBUF
	CDF 10
	DCA I (ST1600	/MARK OUTPUT BUFFER IN 1600
	TAD (2377
	JMS SETHLA
OURTRN,	CDF CIF 10
	JMP I OUPENB

OUVRGN,	TAD (1000
	DCA OUHNDL
	TAD (1577
	JMP OURTRN-1

INPFLG,	-1
OUPFLG,	-1

SETHLA,	0
	CDF 10
	DCA I (HLAZ
	TAD I (HLAZ
	CIA
	DCA I (HLAIO
	CDF 0
	JMP I SETHLA
	FIELD 1
	DEVHND=20
	BANK=21
	TM1=22
	TM2=23
	RECNO=24
	OVLYFG=25
	CUR=26
	WORD=27
	HLAPTR=30
	HLA=31
	RCON=32
	COML=33
	TYPE=34
	CSUM=35
	NSUB=36
	*3600
LRSTRT,	DCA I (MIFILE
LDRZZZ,	JMS I (IONULL
LDRXXX,	TAD (MIFILE
	DCA FILPTR
	DCA OVLYFG
	DCA I (WRBFSW
	JMS I (START
	JMP IOCHEK	/GO TEST FOR /I, /O ALD /0-7
LDRLP,	DCA BANK
	TAD I FILPTR
	SNA
	JMP GETCD
	JMS GETHND
	TAD I FILPTR
	ISZ FILPTR
	DCA RECNO
	TAD I (MPARAM
	RAR
	SZL CLA
	JMP I (LBRY
	JMS I (LOAD
	JMP LDRLP
GETCD,	TAD I (MPARAM+3
	SNA
	JMP LKATMP
	DCA I (LSTADR
	TAD I (MPARAM-1
	CLL RAL
	AND (17
	CLL RTL
	TAD (CDF CIF 0
	DCA I (LSTFLD
LKATMP,	JMS I (WRPGBF
	TAD I (MPARAM
	AND (40
	SZA CLA
	JMP BUILD
	TAD I (MPARAM-1
	SPA CLA
	JMP BUILD
	JMS MAP
CDCALL,	JMS I (200
	5
	2214
	TAD I (MPARAM+1
	AND (100
	SZA CLA
	JMP LDRZZZ
IOCHEK,	JMS I (IOTEST
	DCA TM1
	TAD (MIFILE
	DCA FILPTR
	TAD I (MPARAM+2
	AND (1774
	SNA
	JMP LDRLP
	RAL
	ISZ TM1
	SNL
	JMP .-3
	CLA CMA CLL RTL
	TAD TM1
	JMP LDRLP
FILPTR,	0
MAP,	0
	TAD I (MPARAM+1
	AND (4410	/"M","P" AND "U" OPTIONS
	SNA
MAPRTN,	JMP I MAP
	CLL RTR
	RTR
	AND (200
	SZA CLA
	CLL CML IAC
	CML RAL		/FORM 0 IF /U, 1 IF /P AND 2 IF /M
	DCA TM1
	JMP I (MAPIO

BUILD,	TAD (SHNDLR
	DCA DEVHND
	TAD PSYSLB
	SZA
	JMS I (LBSRCH
	JMS MAP
	JMP I (BUILDX
PSYSLB,	0

GETHND,	0
	AND (17
	DCA I (EASGN
	TAD (401
	DCA LASGN
	TAD I (EASGN
	ISZ FILPTR
	JMS I (200
	1		/ASSIGN
LASGN,	401
	JMP I (HNDERR	/BAD HANDLER
	TAD LASGN
	DCA DEVHND
	JMP I GETHND
	*4000
BUILDX,	TAD LSTADR
	SZA CLA
	JMP ALREDY
	TAD (MAIN-1
	DCA X1
	JMS SETS1
	JMS I (SEARCH
	JMP I (ERSTAD
	TAD (TVEC-1
	TAD I (SYMNUM
	DCA TM1
	CDF 0
	TAD I TM1
	SNA
	JMP I (ERSTAD
	DCA LSTADR
	TAD TM1
	TAD (7700
	DCA TM1
	CLA CLL CML RTL		/CHANGE CDF TO CDF CIF
	TAD I TM1
	DCA LSTFLD
ALREDY,	CDF 10
	JMS I (WROVLY
	TAD (1400
	JMS STOINF
	DCA OLDT9
	TAD (HLA7
	DCA TM1
	TAD (-10
	DCA X3
	DCA I X1
	DCA X4
BLDLP,	CLA CLL CML RTL
	TAD X3
	SNA CLA
	JMP BFLD1	/TREAT FIELD 1 (COMMON AREA) DIFFERENTLY
BLDLPX,	TAD I TM1
	AND (7600
	SNA
	JMP BLDSKP
	TAD (170
	CLL CML CMA RTR
	RTR
	TAD X3
	CLL CMA RTL
	RAL
	DCA I X1
	DCA I X1
	ISZ X4
BLDSKP,	CLA CMA
	TAD TM1
	DCA TM1
	ISZ X3
	JMP BLDLP
	TAD X4
	CIA
	DCA I (1400
	CIF 0
	JMS I (SHNDLR
	4210
	1200
	MTEMP+10
	HLT
	CDF 0
	TAD (JSTFLD-1
	JMS STOINF
	TAD LSTADR
	DCA I (MSTADR
	TAD LSTFLD
	DCA I (MSTCDF
	JMP I (LDRXIT

STOINF,	0
	DCA X1
	TAD LSTFLD
	DCA I X1
	TAD LSTADR
	DCA I X1
	DCA I X1
	JMP I STOINF
LSTADR,	0
LSTFLD,	0

BFLD1,	TAD COML
	CMA CLL
	SNA		/IS THERE ANY COMMON?
	JMP BLDLPX	/NO
	TAD I TM1
	SNL CLA		/IS THERE ANY CODE IN FIELD 1?
	JMP BLDSKP	/NO
	TAD (110	/SAVE FIELD 1 IN TWO SEGMENTS - PAGE 0 AND
	DCA I X1	/THE CODE FOLLOWING THE END OF THE COMMON AREA
	ISZ X4		/(THIS IS TO ENABLE "CHAIN" TO WORK PROPERLY)
	TAD COML
	IAC
	DCA I X1
	TAD COML
	CMA
	JMP BLDLPX	/TAKE ADVANTAGE OF COMMON CODE

SETS1,	0
	TAD (S1-1
	DCA X2
	TAD I X1
	DCA I X2
	TAD I X1
	DCA I X2
	TAD I X1
	DCA I X2
	JMP I SETS1
	*4200
MAPIO,	TAD I ML7600
	SNA
	TAD TTYNO	/TELETYPE IS DEFAULT LISTING DEVICE
	JMS I (GETHND
	TAD ML7601
	DCA MNAME
	TAD I (EASGN
	TAD (100	/4 SHIFTED LEFT INTO THE "DESIRED LENGTH" POSITION
	JMS I (200
	3
MNAME,	0
MECNT,	0
	JMP I (OUERR
	TAD MNAME
	DCA ORECNO
	JMS OUSETP
	DCA MCCNT
	TAD (OCHAR
	DCA TYPE
	TAD TM1
	CLL CML RAR
	JMP I (MAPX
OCHAR,	0
	DCA OUTEMP
	ISZ OJMP
	ISZ OCHCNT
OJMPE,	JMP OJMP
	CIF 0
	JMS I DEVHND
	4210
OUBUF,	4700
ORECNO,	0
	JMP I (OUERR
	ISZ ORECNO
	ISZ MCCNT
	JMS OUSETP
	ISZ MECNT
	JMP OCHAR+2
	JMP I (OUERR
OUSETP,	0
	TAD (-601
	DCA OCHCNT
	TAD OUBUF
	DCA OUPTR
	TAD OJMPE
	DCA OJMP
	JMP I OUSETP
OJMP,	0
	JMP OCHAR1
	JMP OCHAR2
OCHAR3,	TAD OJMPE
	DCA OJMP
	TAD OUTEMP
	RTL
	RTL
	DCA OUTEMP
	TAD OUTEMP
	AND OU7400
	TAD I OUPOLD
	DCA I OUPOLD
	TAD OUTEMP
	RTL
	RTL
	AND OU7400
	TAD I OUPTR
	DCA I OUPTR
	ISZ OUPTR
	JMP OUCOM
OCHAR2,	TAD OUPTR
	DCA OUPOLD
	ISZ OUPTR
OCHAR1,	TAD OUTEMP
	AND OU377
	DCA I OUPTR
OUCOM,	JMP I OCHAR
OCHCNT,	0
	OUPOLD=OUSETP
OUTEMP,	0
OU7400,	7400
OUPTR,	0
OU377,	377
OCLOS,	TAD (232
	JMS OCHAR
	TAD OCHCNT
	CMA
	SZA CLA
	JMP .-4
	JMS OCHAR
	TAD I (EASGN
	JMS I (200
	4
ML7601,	7601
MCCNT,	0
	JMP I (OUERR
	TAD (TTYOUT
	DCA TYPE
	JMP I (MAPRTN
TTYOUT,	0
	6046
	6041
	JMP .-1
ML7600,	7600
	JMP I TTYOUT
TTYNO,	0	/SET TO TTY DEVICE NUMBER BY INITIALIZATION
IONULL,	0
	TAD ML7600
	DCA I (HLASZA
	JMP I IONULL
	*4400
LOAD,	0
	DCA LREQUR
	TAD BANK
	TAD (HLAZ
	DCA HLAPTR
	JMS I (SETRCN	/SET UP HLA AND RCON
	TAD RCON
	CLL CML
	TAD LREQUR
	TAD (400
	SNL SZA CLA
	JMP LFAILD
	TAD RECNO
	DCA LRECNO
	CLA CMA
	DCA INCHCT
	JMS ICHAR
	SNA CLA
	JMP .-2
	JMP I (MORE
ICHAR,	0
	KRS
	TAD (-203
	SNA CLA
	KSF
	SKP
	JMP I (MGET		/17667=07605
	ISZ IJMP
	ISZ INCHCT
IJMPE,	JMP IJMP
	CIF 0
	JMS I DEVHND
INCTLW,	0410
INBUF,	4700
LRECNO,	0
	JMP INCKEF
INISZ,	ISZ LRECNO
	ISZ LRECNO
	TAD IN6377
	DCA INCHCT
	TAD INBUF
	DCA INPTR
	TAD IJMPE
	DCA IJMP
	JMP ICHAR+1
IJMP,	HLT
	JMP ICHAR1
	JMP ICHAR2
ICHAR3,	TAD IJMPE
	DCA IJMP
	TAD I INPTR
	ISZ INPTR
	AND IN7400
	CLL RTR
	RTR
	TAD INTEMP
	RTR
	RTR
	JMP INCOM
ICHAR2,	TAD I INPTR
	ISZ INPTR
	AND IN7400
	DCA INTEMP
ICHAR1,	TAD I INPTR
INCOM,	AND IN377
	JMP I ICHAR
INCKEF,	SMA CLA
	JMP LRECNO+2
	JMP I (INERR
INPTR,	0
INCHCT,	0
INTEMP,	0
IN7400,	7400
IN377,	377
IN6377,	6377

XX7600=.
XER2,	7600
	TAD EASGN
	TAD (DCB-1
	DCA TM2
	TAD I TM2
	SPA CLA
	JMP DIRDEV
	TAD (2205
	JMS I (TTWO
	TAD (1417
	JMS I (TTWO
	TAD (0104
	JMS I (TTWO
	JMS I (CRLF
DIRDEV,	TAD I HLAPTR
	AND XX7600
	TAD XX7600
	CIA
	JMP LOAD+1
LFAILD,	ISZ BANK
	JMP LOAD+2
EASGN,	0
LREQUR,	0
LOADOK,	JMS I (WRPGBF
	JMP I LOAD
CVTREC,	0
	TAD CUR
	CLL RTL
	RTL
	RAL
	AND (7
	JMP I CVTREC
MAIN,	1501;1116;4040
	*4600		/CODE IN THIS PAGE CAN'T GO PAST 4677
	IFNZRO LIBRARY <
LBRY,	TAD RECNO
	JMS LBSRCH
	JMP I .+1
	GETCD
LBSRCH,	0
	DCA LBREC
	CIF 0
	JMS I DEVHND
LBCTLW,	0210
L5300,	5300
LBREC,	0
	JMP I LIOERR
	TAD LBCTLW
	DCA I LINCTL
	TAD L7177
	DCA I LIN6377
	DCA I LINISZ
	TAD L5277
	DCA X1
LBRYLP,	JMS I LSETS1
	TAD I X1
	SNA
	JMP I LBSRCH
	TAD L5300
	DCA LBFPTR
	JMS I LSEARCH
	JMP LBRYLP
	TAD I LSYMNUM
	TAD LTVEC1
	DCA TM1
	CDF 0
	TAD I TM1
	CDF 10
	SZA CLA
	JMP LBRYLP
LBLDLP,	TAD I LBFPTR
	SNA
	JMP LBRYLP-2
	AND L177
	IAC
	TAD LBREC
	DCA RECNO
	DCA BANK
	TAD I LBFPTR
	AND L7600
	JMS I LLOAD
	ISZ LBFPTR
	JMP LBLDLP
LBFPTR,	0
LIOERR,	INERR
LINCTL,	INCTLW
L7177,	7177
LIN6377,	IN6377
L5277,	5277
LSETS1,	SETS1
LSEARCH,	SEARCH
L177,	177
L7600,	7600
LLOAD,	LOAD
LSYMNUM,	SYMNUM
LINISZ,	INISZ
LTVEC1,	TVEC-1
	>
	IFZERO LIBRARY <
LBRY,	HLT
LBSRCH,	0
	CLA CLL
	JMP I LBSRCH
	>
/LOADR7.024
/LOADER.V07 DEC-08-A2C3-07
/COPYRIGHT 1968, 1969, DIGITAL EQUIPMENT CORP., MAYNARD, MASS
/
/(COMMON CHANGED TO FIELD 1)
/

/
/DEFINITIONS
/
BCRT=200
TVEC=300
ORGT=100	/LOCAL SYMBOL TABLE NOW IN FIELD 0
MST=6177
/
*6200
/
/START OF PROGRAM - INITIALIZATION
/
START,	0
	TAD	K7600		/SET COUNTER FOR 200
	DCA	NSUB
	TAD	BCRTA		/POINTER TO BANK TABLE
	DCA	X3
	CDF 00
	DCA I	X3		/CLEAR BANK TABLE & TV TABLE
	ISZ	NSUB
	JMP	.-2		/NOT DONE
Y1,	CDF 10
	TAD	M10
	DCA	NSUB
	TAD	HLAZA
	DCA	X3
	TAD	K777
	DCA I	X3		/BANK0 HIGHEST LOADED ADDR. =777
	ISZ	NSUB		/NSUB INCREMENTS TO ZERO
	JMP	.-2
	CMA
	DCA	COML		/INIT. OLD COMMON AT 7777
	JMP I START
/
/REENTRY FOR NEXT ROUTINE TO BE LOADED
/
MORE,	DCA	LMTC		/CLR LOCAL SYMBOL COUNT
	DCA	CSUM		/CLR CHECKSUM
	TAD	MORE1A		/SET FOR RETURN TO MORE1 IF LEADER
	DCA	EOF
MORE1,	JMS	RWORD
	TAD	RC10A		/RESET EOF TO WATCH FOR TRAILER
	DCA	EOF
	TAD	CODE		/CK FOR HIGH COMMON
	TAD	M12
	SZA CLA
	JMP I	ER5P		/NOT THERE
	TAD	WORD		/CK THAT NEW COMMON .LE. OLD
	CIA CLL
	TAD	COML
	SNL CLA
	JMP I	ER3P		/TOO BIG
	TAD	COML		/CK FOR 1ST ROUTINE
	IAC
	SNA CLA
	TAD	WORD		/IF NO PREVIOUS COMMON AND IF
	AND	K7600		/THIS PROGRAM HAS COMMON ABOVE 177
	SNA			/THEN SET COMMON LIMIT TO LIMIT OF THIS PROG
	JMP	GETSW
	AND	K7400
	TAD	K377	/HIGH COMMON MUST BE AT A MULTIPLE OF 400
	DCA	COML
	TAD	COML
	CLL CMA
	TAD I	HLA1P
	SZL CLA		/HAVE WE LOADED CODE INTO THE COMMON AREA?
	JMP I	ER3P	/YES - ERROR IN COMMON
	TAD	COML		/SET BANK1 HIGHEST LOADED ADDRESS
	DCA I	HLA1P
	JMS I	(SETRCN		/SET UP HLA AND RCON AGAIN JUST IN CASE
GETSW,	TAD	BANK		/BANK NUMBER
	TAD	TOPCOR		/OK FOR NON-EX. MEM.
	SMA CLA
	JMP I	ER2I		/TOO BIG
/
/MAIN LOADING LOOP
/
LOOP,	JMS	RWORD
	TAD	BASE		/LOCATE CORRECT FUNCTION
	TAD	CODE		/IN TRANSFER TABLE
	DCA	CODE
CODE,	0		/TRANSFER TO APPROPRIATE ADDRESS
/
/READ 12-BIT COMPUTER WORD & 4-BIT RELOCATION CODE
/FROM 2 INPUT CHARACTERS
/
RWORD,	0
	JMS I	HSRPA		/FIRST FRAME
	DCA	WORD
	TAD	WORD		/EXTRACT RELOC. CODE
	RTR
	RTR
	AND	K17
	DCA	CODE
	TAD	CODE		/CK FOR LEADER
	TAD	M10
	SNA CLA
	JMP I	EOF		/YES
	TAD	WORD		/ADD TO CHECKSUM
	TAD	CSUM
	DCA	CSUM
	JMS FORMWD
	JMS I	RCHARP
	TAD	WORD
	DCA	WORD
	JMP I	RWORD
FORMWD,	0
	TAD	WORD
	AND	K17		/MOVE LOW 4 BITS TO HIGH ORDER
	CLL RTR
	RTR
	RAR
	DCA	WORD
	JMP I FORMWD
/
/DATA
/
EOF,	0
LMTC,	0
K17,	17
K377,	377
K777,	777
K7400,	7400
K7600,	7600
M10,	-10
M12,	-12
BASE,	JMP I TRTAB
BCRTA,	BCRT-1
HLAZA,	HLAZ-1
HSRPA,	ICHAR
MORE1A, MORE1
RCHARP,	RCHAR
TOPCOR,	0
HLA1P,	HLA1
ER2I,	ER2

/
/RELOCATION CODE TRANSFER TABLE
/
TRTAB,	RC0			/LOAD AS IS
	RC1			/ADD RELOCATION CONSTANT
	RC2
	RC3			/DEFINE SYMBOL
	RC4			/ORIGIN
	RC5			/CDF TO CURRENT BANK
	RC6			/REPLACE LOCAL # WITH GLOBAL #
	RC7
RC10A,	RC10			/LEADER-TRAILER
	RC11
ER3P,	ER3			/HIGH COMMON
ER5P,	RC13
	RC14
	RC15
	RC16
	RC17			/EXTERNAL SYMBOL SPECIFICATION
/
*START+200
/
/NEW ORIGIN
/
RC4,	TAD	WORD		/NEW ORIGIN
	TAD	RCON		/+ RELOCATION CONSTANT
	DCA	CUR		/= NEW LOADING ADDRESS
	JMP I	LOOPP1
/
/CHANGE CDF TO CURRENT BANK
/
RC5,	TAD	BANK		/MOVE BANK TO BITS 6-8
	CLL RTL
	RAL
	TAD	WORD		/PICK UP CDF
	JMP	RC1+2
/
/REPLACE LOCAL EXTERNAL SYMBOL NUMBER WITH GLOBAL EXT. SYM. NO.
/
RC6,	TAD	WORD
	AND	K77		/EXTRACT LOCAL NUMBER
	DCA	B1
	TAD	B1		/CK IF LOCAL # .LE. LOCAL SYM. COUNT
	CIA
	TAD I	LMTCP1
	SPA CLA
	JMP I	ER5I		/NO
	TAD	B1		/ADD LOCAL # TO BASE OF TABLE
	TAD	ORGTA
	DCA	B1
	TAD	WORD		/LOAD ARG COUNT
	AND	K7700
KCDF,	CDF 0
	TAD I	B1		/+ GLOBAL #
	CDF 10
	JMP	RC1+2		/AT CURRENT LOADING ADDRESS
/
/ADD RELOCATION CONSTANT TO WORD
/
RC1,	TAD	WORD
	TAD	RCON
	DCA	WORD
/
/LOAD WORD DIRECTLY AS IT IS
/
RC0,	TAD	HLA		/CK FOR CURRENT ADDRESS TO LOAD
	CIA CLL 		/.GE. HIGHEST ALREADY LOADED
	TAD	CUR
	SNL CLA
	JMP	.+3		/NO
	TAD	CUR		/YES, RESET HIGHEST
	DCA	HLA
	CLL
	TAD	CUR		/CK FOR ATTEMPT TO LOAD TOP PAGE
	TAD	K200
	SZL CLA
	JMP I	OVERFP		/YES, ROUTINE IS TOO BIG
	CLA CMA
	TAD	BANK
	SZA CLA
	JMP	JUSTLD
	CLL CML CLA RTR
	TAD	CUR
	SZL SPA CLA
	JMP	GT2000
	TAD	OVLYFG
K7700,	SMA CLA
	JMP	OFFSET
	JMS I 	(CVTREC
	TAD	(-11
	JMP	PAGEX2
GT2000,	TAD	CUR
	CLL
	TAD	(-3600
	SZL CLA
	JMP	PAGEX1
	JMS I	(WROVLY
	CLA CMA
	DCA	OVLYFG
	JMP	JUSTLD
PAGEX1,	TAD	K200
	JMS I	(CVTREC
PAGEX2,	TAD	(MTEMP+11
	JMS I	(WRPGBF
	CLA CLL CML RTR
	TAD	CUR
	SZL SPA CLA
	TAD	K200
	TAD	CUR
	AND	(377
	TAD	(1400
	JMP	JUSTLD+1
OFFSET,	CLA IAC
	DCA	OVLYFG
	TAD	(1600
JUSTLD,	TAD	CUR
	DCA	CURX
	TAD	BANK
	CLL RTL
	RAL
	TAD	KCDF
	DCA	.+2
	TAD	WORD
	HLT
	DCA I	CURX
	CDF 10
	ISZ	CUR
	JMP I	LOOPP1
CURX,	0
/
/DATA
/
B1,	0
K77,	77
K200,	200
ER5I,	ER5
LMTCP1, LMTC
LOOPP1, LOOP
ORGTA,	ORGT
OVERFP, OVERFL
HLAZ,	0			/HLA GROUP MUST REMAIN IN GIVEN ORDER
HLA1,	0
HLA2,	0
HLA3,	0
HLA4,	0
HLA5,	0
HLA6,	0
HLA7,	0

HLATST,	0
	TAD HLAZ
	TAD HLAIO
HLASZA,	SZA CLA	/SET TO CLA BY /R AND RESTART
	JMP I (UIOERR
	JMP I HLATST
HLAIO,	-777
/
*START+400
/
/SYMBOL DEFINITION
/
RC3,	JMS I	GTSYMP
	TAD	TVM1		/ADJUSTED BASE OF TRANSFER VECTOR TABLE
	TAD	SYMNUM		/+ NUM. OF SYMBOL IN MST
	DCA	C1
	TAD	RCON		/LOADING ADDRESS OF THE SYMBOL
	TAD	WORD
	CDF 00
	DCA I	C1		/TO THE TRANS. VEC. TABLE
	TAD	C1		/GET POINTER INTO TRANSFER VECTOR TABLE
	TAD	M100A		/FORM CORRESPONDING POINTER INTO BANK TABLE
	DCA	C1		/=PTR. TO BANK TABLE STORAGE
	TAD	BANK		/GET BANK IN BITS 6-8
	CLL RTL
	RAL
	DCA I	C1		/STORE IN BANK TABLE
Y5,	CDF 10
RC3A,	TAD	NSUB		/CHECK FOR TOO MANY SYMBOLS
	TAD	M100A
	SPA SNA CLA
	JMP I	LOOPP2		/NO
	JMP	ER1
/
/TRANSFER VECTOR
/
RC17,	TAD	WORD		/COUNTER OF SYMBOLS TO COME
	CIA
	DCA	C2
RC17A,	JMS I	GTSYMP
	ISZ I	LMTCP2		/INC. LOCAL SYM. CTR.
	TAD	ORGTA2		/GET PTR TO STORAGE IN ORIG. TABLE
	TAD I	LMTCP2
	DCA	C1
	CMA			/SYM. # -1 TO ORIG. TABLE
	TAD	SYMNUM
	CDF 0
	DCA I	C1
	CDF 10
	ISZ	C2		/CK CTR.
	JMP	RC17A		/NOT DONE
	JMP	RC3A
/
/ERRORS
/
	SIOERR=.
H7600,	7600
	DCA ERBACK
	IAC
HNDERR,	IAC
ERSTAD,	IAC
INERR,	IAC
OUERR,	IAC
ER5,	IAC		/ILLEGAL INPUT FORMAT
ER4,	IAC		/CHECKSUM ERROR
ER3,	IAC		/HIGHEST COMMON NOT FIRST
ER2,	IAC		/PROGRAM TOO LARGE
ER1,	IAC		/SYMBOL TABLE OVERFLOW
UIOERR,	DCA	C3
	JMS	CRLF
	TAD	K0522		/"ER"
	JMS	TTWO
	TAD	K2217		/"RO"
	JMS	TTWO
	TAD	K2240		/"R "
	JMS	TTWO
	TAD	C3		/#
	JMS	TOCT
	JMS I	(WRPGBF
ERBACK,	JMP I	(CDCALL
	CDF CIF 0
	JMP I	H7600		/RETURN TO MONITOR
/
/TYPE A CARRIAGE RETURN & LINE FEED
/
CRLF,	0
	TAD	K215
	JMS I	TYPE
	TAD	K212
	JMS I	TYPE
	JMP I	CRLF
/
/UNPACK & TYPE 2 6-BIT CHARACTERS
/
TTWO,	0
	DCA	C1
	CMA			/SET FLAG FOR 1ST CHARACTER
	DCA	C2
	TAD	C1		/MOVE LEFT HALF DOWN
	RTR
	RTR
	RTR
	SKP
TTWO1,	TAD	C1		/GET RIGHT HALF
	AND	C77
	TAD	M40		/200 OR 300 GROUP?
	SPA
	TAD	K100		/300 + 6BIT
	TAD	K2240		/200 + 6BIT
	JMS I	TYPE
	ISZ	C2		/2ND CHARACTER DONE?
	JMP I	TTWO
	JMP	TTWO1		/NO
/
/TYPE OCTAL CONTENTS OF AC
/
TOCT,	0
	DCA	C1
	TAD	M4B
	DCA	C2
TOCT1,	TAD	C1		/MOVE NEXT DIGIT INTO BITS 9-11
	RTL
	RAL
	DCA	C1
	TAD	C1		/GET DIGIT
	RAL
	AND	KK7
	TAD	C260		/CONVERT TO ASCII
	JMS I	TYPE
	ISZ	C2
	JMP	TOCT1		/MORE TO GO
	JMP I	TOCT
/
/DATA
/
C1,	0
C2,		0
SYMNUM, 0
C3=SYMNUM
KK7,	7
C77,	77
K100,	100
K212,	212
K215,	215
C260,	260
K0522,	0522
K2217,	2217
K2240,	2240
M4B,	-4
M40,	-40
M100A,	-100
GTSYMP,	GETSYM
LMTCP2, LMTC
LOOPP2, LOOP
ORGTA2, ORGT
TVM1,	TVEC-1
/
/UNUSED RELOCATION CODES
/
RC2=ER5
RC7=ER5
RC11=ER5
RC12=ER5	/USED BUT NOT NEEDED IN TABLE
RC13=ER5
RC14=ER5
RC15=ER5
RC16=ER5
/
*START+600
/
/STORE OR LOOK UP SYMBOL IN SYMBOL TABLE
/
DEFN,	0
/
/READ A SYMBOL FROM INPUT ASCII - 6 FRAMES
/
	CLA CLL CMA RTL
	DCA	D1
	TAD	S1A		/POINTER TO 3 WORD BUFFER
	DCA	X3
RSYM1,	JMS	RCHAR
	AND	K0077		/EXTRACT 6-BIT
	CLL RTL
	RTL
	RTL
	DCA	D3		/SAVE LEFT HALF
	JMS	RCHAR
	AND	K0077		/GET RIGHT HALF
	TAD	D3
	DCA I	X3
	ISZ	D1
	JMP	RSYM1		/NOT DONE
	JMP I DEFN
/
/SEARCH SYMBOL TABLE FOR CURRENT SYMBOL
/
SEARCH,	0
	DCA I	SYMNMP		/CLR SYMBOL COUNTER
	TAD	MSTA		/SET SYMBOL TABLE PTR
	DCA	D4
	TAD	NSUB		/SET CTR FOR NUMBER OF SYMBOLS
	CMA			/+1 (IN CASE NSUB=0)
	DCA	D5
	JMP	SRCH2
SRCH1,	ISZ I	SYMNMP		/KEEP COUNT
	TAD	D4		/TEST TABLE ENTRY
/
/COMPARE IN S1-S3 WITH SYMBOL TABLE ENTRY
/ASSUMES PTR TO SYM. TABLE ENTRY IN AC
/
	DCA	X4		/SYM. TAB. PTR
	CLA CLL CMA RTL
	DCA	D2		/COUNTER
	TAD	S1A
	DCA	X3		/PTR TO S1/S3
COMP1,	TAD I	X4		/COMPARE WORDS
	CIA
	TAD I	X3
	SZA CLA
	JMP	NOMACH		/NOT ALIKE
	ISZ	D2
	JMP	COMP1		/TRY NEXT WORD OF TRIPLET
	ISZ SEARCH
	JMP I SEARCH
NOMACH,	CLA CLL CMA RTL
	TAD D4
	DCA	D4
SRCH2,	ISZ	D5
	JMP	SRCH1		/NOT DONE
	JMP I SEARCH
/
/ENTER A SYMBOL IN THE SYMBOL TABLE
/
INSERT,	0
	TAD	NSUB		/(NUMBER OF SYMBOLS)*3
	CLL RAL
	TAD	NSUB
	CIA			/SUBTRACT FROM BASE OF TABLE
	TAD	MSTA
	DCA	X3		/FOR POINTER
	TAD	S1		/1ST WORD
	DCA I	X3
	TAD	S2		/2ND
	DCA I	X3
	TAD	S3		/3RD
	DCA I	X3
	ISZ	NSUB		/COMPUTE SYM. TAB. NUMBER
	TAD	NSUB
	DCA I	SYMNMP
	JMP I	INSERT
/
/CORE OVERFLOW
/
OVERFL,	TAD	BCRTA3
	DCA	D1
	TAD	TVECA3
	DCA	D2
	TAD	M100
	DCA	D3
	CDF 00
OVERF2, TAD I	D1		/CK FOR CDF IN BCRT
	SPA CLA
	JMP	.+3		/YES
	DCA I	D1		/NO, CLEAR IT
	DCA I	D2		/CLEAR TV WORD
	ISZ	D1
	ISZ	D2
	ISZ	D3
	JMP	OVERF2		/MORE TO GO
Y6,	CDF 10
	JMP I	ER2P
GETSYM,	0
	JMS DEFN
	JMS SEARCH
	JMS INSERT
	JMP I GETSYM
/
/READ 1 FRAME & ADD TO CHECKSUM
/
RCHAR,	0
	JMS I	HSRPB
	DCA	D4
	TAD	D4
	TAD	CSUM
	DCA	CSUM
	TAD	D4
	JMP I	RCHAR

SETRCN,	0		/SUBR TO SET HIGHEST-LOADED ADDRESS (HLA)
	TAD I	HLAPTR	/AND RELOCATION CONSTANT (RCON)
	DCA	HLA
	TAD	HLA
	AND	(7600
	DCA	RCON
	JMP I	SETRCN
/
/DATA
/
D1,	0
D2,	0
D3,	0
D4,	0
D5,	0
S1,	0
S2,	0
S3,	0
K0077,	77
M100,	-100
BCRTA3, BCRT
ER2P,	XER2
HSRPB,	ICHAR
MSTA,	MST-3
S1A,	S1-1
SYMNMP, SYMNUM
TVECA3, TVEC
/
*START+1000
/
/TRAILER CODE EXIT
/
RC10,	JMS I (FORMWD
	JMS I	HSRP		/GET LOW ORDER PART
	TAD	WORD
	CIA
	TAD	CSUM		/COMPARE WITH ACCUMULATED SUM
	SZA CLA
	JMP I	ER4P		/NOT EQUAL
	TAD	BCRTA4
	DCA	T1
	TAD	TVECA
	DCA	X2
	TAD	M100D
	DCA	T3
K6201A,	CDF 00
RC10Z,	TAD I	X2		/GET TV ENTRY
	SNA CLA
	JMP	.+5		/NOT DEFINED; IGNORE IT
	TAD I	T1		/GET BCRT WORD
	AND	K70		/EXTRACT BANK
	TAD	K6201A		/COMBINE CDF
	DCA I	T1
	ISZ	T1
	ISZ	T3
	JMP	RC10Z		/NOT DONE YET
Y7,	CDF 10
	TAD	HLA		/STORE HIGHEST LOADED ADDRESS
	DCA I	HLAPTR		/IN PROPER LOC. (HLA0-7)
	JMP I (LOADOK
MAPX,	SNL CLA
	TAD	NSUB		/OTHERWISE PRINT SYMBOLS
	CMA
	DCA	T1		/CTR OF ROUTINES
	TAD	MSTA4		/SYMB. TAB. PTR.
	DCA	X1
	TAD	TVECA		/TV PTR
	DCA	X2
	TAD	BCRTA4		/BCRT PTR
	DCA	T4
	JMS I	CRLFP
	JMP	PRINT1
PRINT,	TAD TM1
	RTR CLL
	CDF 0
	TAD I X2
	CDF 10
	DCA TM2
	TAD TM2
	SNL SZA CLA
	JMP PIGNOR
	TAD I	X1
	JMS I	TTWOP
	TAD I	X1
	JMS I	TTWOP
	TAD I	X1
	JMS I	TTWOP
	TAD	K4040		/2 SPACES
	JMS I	TTWOP
	CDF 00
	TAD I	T4		/PRINT BANK NUMBER
	CDF 10
	RTR
	RAR
	AND	K7B
	TAD	K260
	JMS I	TYPE
	TAD	TM2		/PRINT SYMBOL VALUE
	JMS I	TOCTP
	TAD	TM2		/IF ADDRESS=0,IT IS UNDEFINED
	SZA CLA
	JMP	.+3		/ITS OK
	TAD	K4025		/TYPE SPACE,U
	JMS I	TTWOP
	JMS I	CRLFP
	TAD	M03
PIGNOR,	TAD	M03
	TAD	X1
	DCA	X1
	ISZ	T4
PRINT1, ISZ	T1
	JMP	PRINT		/MORE SYMBOLS
PAGES,	TAD	FCTR		/SET CTR FOR CORRECT # OF BANKS
	DCA	T1
	TAD	(HLAZ-1		/INIT. PTR. TO HLA LIST
	DCA	X1
	TAD I	X1		/GET HLA OF NEXT BANK
	CLL RTL 		/DIVIDE BY 200
	RTL
	RTL
	AND	K37		/=NUMBER OF PAGES USED
	CMA
	TAD	K37		/=NUMBER OF PAGES LEFT
	JMS I	TOCTP		/PRINT
	JMS I	CRLFP
	ISZ	T1
	JMP	PAGES+4 	/NOT DONE WITH ALL BANKS
	JMP I	(OCLOS
/
/DATA
/
FCTR,	0			/# OF HIGHEST MEM. FIELD
K37,	37
T1,	0
T2,	0
T3,	0
T4,	0
K7B,	7
K70,	70
K260,	260
K4025,	4025
K4040,	4040
M03,	-3
M100D,	-100
BCRTA4, BCRT
CRLFP,	CRLF
ER4P,	ER4
HSRP,	ICHAR
MSTA4,	MST-3
TOCTP,	TOCT
TTWOP,	TTWO
TVECA,	TVEC-1
/
*START+1200
WROVLY,	0
	TAD OVLYFG
	SPA SNA CLA
	JMP I WROVLY
		/I DONT THINK I HAVE TO DUMP THE PAGE BUFFER.
		/(I COULD BE WRONG)
	CIF 0
	JMS I (SHNDLR
	0110
L1600,	1600
	MTEMP
	JMP I (SIOERR
	CIF 0
	JMS I (SHNDLR
	5010
	1600
	MTEMP
	JMP I (SIOERR
	DCA OVLYFG
	JMP I WROVLY

WRPGBF,	0
	DCA PRECNO
	TAD WRBFSW
	SNA
	JMP IWONDR
	CIA
	TAD PRECNO
	SNA CLA
	JMP I WRPGBF
	CIF 0
	JMS I (SHNDLR
	4210
	1400
WRBFSW,	0
	JMP I (SIOERR
PREAD,	DCA OLDT9
	TAD PRECNO
	SNA CLA
	JMP SETBF
	CIF 0
	JMS I (SHNDLR
	0210
	1400
PRECNO,	0
	JMP I (SIOERR
SETBF,	TAD PRECNO
	DCA WRBFSW
	JMP I WRPGBF
IWONDR,	TAD PRECNO
	TAD (-MTEMP-10
	SPA CLA		/IF THE NEW PAGE IS NOT IN 0-1777
	JMP PREAD
	JMP SETBF	/ITS VIRGIN - DON'T READ IT IN

LDRXIT,	CDF 10
	TAD I (HLA1
	TAD (200
L7700,	SMA CLA		/DID WE LOAD OVER THE LOADER?
	TAD (FIVE	/NO
	DCA WROVLY	/WROVLY=0 OR 5
	CIF 0
	JMS I (SHNDLR
	0201
	400
	MTEMP+21		/READ BACK THE RUN-TIME ROUTINES
	JMP I (SIOERR		/BADDIE
	TAD L1600
	CDF 0
	DCA I ST1600	/INDICATE WHICH BUFFER IS AT 1600 (IF ANY)
	TAD I P4
	DCA I P5
	ISZ P4
	ISZ P5
	ISZ P6
	JMP .-5		/ALSO MOVE 16-32 INTO LOC 100
	CDF 10
	JMS I (200
	13		/RESET EVERYTHING
	TAD I (MPARAM
	AND (40		/GET "/G" SWITCH
	SNA CLA
	JMP CALMON	/GO SWITCH NOT ON
	JMS I (200
	11		/KICK MONITOR OUT
	CDF CIF 0
	TAD (MSTCDF
	DCA I (FIVE+1	/GO TO PROGRAM START ADR INSTEAD OF 7600
	ISZ I (ONE	/OPTOMIZE READ A LITTLE ON DECTAPE
	JMP I WROVLY

CALMON,	CLA CMA
	DCA I L7700	/INDICATE I/O MONITOR IS IN CORE
	CDF CIF 0
	JMP I WROVLY	/GET OUT

ST1600,	177		/THIS IS SET TO "FINBUF" OR "FOUBUF" BY /I AND /O
P4,	16
P5,	100
P6,	-15

IOTEST,	0
	TAD I (MPARAM
	AND (10
	SNA CLA
	JMP .+4
	JMS I (HLATST
	CDF CIF 0
	JMS I (INPENB
	TAD I (MPARAM+1
	AND (1000
	SNA CLA
	JMP .+4
	JMS I (HLATST
	CDF CIF 0
	JMS I (OUPENB
	JMP I IOTEST
	$