<div id='wikitext'>
<pre><b> File: LOADER.PA of Tape: Sources/Fortran/os8-f4-5</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/OS8 FORTRAN II RELOCATING LOADER V4
/
/
/
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1973, 1975, 1980
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/AND DATAPLAN GMBH, LAUDA, BRD
/
/
/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.
/
/
/
/
/
/
/LOADER.07	DECEMBER 5, 1973
/
/
/CHANGES MADE FOR V4	J.K.	1975
/
/ .VERSION NUMBER PRINTED ON MAP
/ .BIT ZERO OF 17645 IS USED INSTEAD OF THE WHOLE
/	WORD TO INDICATE THAT THE LOADER WAS CHAINED
/	TO FROM SABR
/ .CORE ROUTINE STANDARIZED
/ .CHECK FOR BATCH CORRECTED
/		V40	WVDM	1980
/ .MULTI-8 AND V40 QUIRCKS
/FIELD 0, PAGE 0

	VERSION=6400	/PRINTS ON MAP
	PATCH=01
	JSTFLD=	7744
	JSTADR=	7745
	JSBITS=	7746
	MOFILE=	7600
	MIFILE=	7617
	MPARAM=	7643
	DCB=	7760
	MSTCDF=	7773	/**V40**
	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
/RUN-TIME SYSTEM PAGE 0 - PROPAGATED TROUGH ALL FIELDS

*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	/&quot;DESIRED LENGTH&quot; 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 I	(LDRZZ1
SSTART,	CDF 10
	TAD I	(MPARAM+2
	SMA CLA
	JMP NOTSBR
	TAD I	(MPARAM+2
	AND	(3777
	DCA I	(MPARAM+2
	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 &quot;FORTRL.TM&quot; IF IT EXISTS
	0
	NOP		/IT DIDN&#039;T EXIST - BIG DEAL
	TAD TEMP
LDRYYY,	CDF  10
	DCA I (MIFILE
NOTSBR,	CIF 10
	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 &quot;SYS&quot;
	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
	JMS I (BATCK
CORO,	TAD	CORSIZ	/GET FLD OF TEST
	RTL
	RAL
	AND	COR70
	TAD	COREX	/MASK USEFUL BITS
	DCA	.+1
COR1,	CDF
	TAD I	CORLOC	/SAVE CURRENT CONTENTS
COR2,	NOP
	DCA	COR1
	TAD	COR2
	DCA I	CORLOC
COR70,	70
	TAD I	CORLOC	/TRY TO READ BACK
CORX,	7400
	TAD	CORX
	TAD	CORV	/TAD	(1400)
	SZA CLA
	JMP	COREX	/NON-EXISTENT FLD EXIT
	TAD	COR1
	DCA I	CORLOC	/RESTORE LOC
	ISZ	CORSIZ
	JMP	CORO
COREX,	CDF 0
	TAD	CORSIZ
	CIA
FOUNDX,	CDF CIF 10
	DCA I	(WROVLY	/POSTPONE SPREADING FIELD ZERO RESIDENT
	TAD (TTYOUT	/ THRU FIELDS UNTIL /I,/O AND /H ARE TESTED
	DCA I (TYPE
	JMP I .+1
	LDRXXX
SIX,	0
SEVEN,	0

LWOWIE,	CDF CIF 10
	JMP I (SIOERR
CORLOC,	CORX
CORV,	1400
CORSIZ,	1
TEMP,	0;0;0;0
	PAGE
/FULL LINKAGE ROUTINES FOR RUN-TIME SYSTEM

	*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
	CDF	0	/(TABLES IN FIELD 0!) **M8**
	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
FINRXX,	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
	IFNZRO	FINRXX-600	&lt;FINERR,_ERROR&gt;
	/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 &quot;FCLOSE&quot;
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
	PAGE
	*1000
PROPGT,	0		/CALLED FROM FIELD 1 LOADER WHEN 1ST
	CDF 10		/CHECKING FOR I/O SWITCHES.
	DCA I LTOPCOR	/-# OF CORE FIELDS IN AC
	TAD I LTOPCOR
	DCA I LFCTR
	TAD I LTOPCOR
	CDF 0
	CMA		/GET # OF HI CORE FIELD
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
	CDF CIF 10	/PROPGT IS CALLED FROM FIELD  1 ONLY
	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
LLWOWIE,LWOWIE
L6001,	6001
LJSBITS,JSBITS
LJSTADR,JSTADR
LJSTFLD,JSTFLD
L6213,	6213
LCDF,	CDF
LLINK1,	LINK-1
LLINK2,	LINK-MDUMP-2
LDRZZ1,	CDF	10	/COME HERE IF NOT CHAINED TO
	DCA I	LMOFIL
	ISZ	LMOFIL
	ISZ	LMOCNT
	JMP	.-3
	CLA CLL CMA RAL	/-2
	DCA I LDOPRP
	CDF	00
	JMP I	.+1
	LDRYYY
LMOFIL,	7600
LMOCNT,	-47
LLRSTRT,LRSTRT
LDOPRP,	DOPROP
FORTRL,	FILENAME FORTRL.TM
	PAGE
	*1200		/LINKING LOADER SUBROUTINES FOR /I AND /O OPTIONS
INPENB,	0
	ISZ INPFLG
	JMP INRTRN	/ALREADY HAVE A /I
	JMS TWOPAG	/HAS USER SPECIFIED 2-PG. HNDLRS?
	TAD OUPFLG
	SPA CLA
	JMP INVRGN
	TAD K2200
	DCA INHNDL
	TAD (FINBUF
	DCA I (ST1600	/MARK THE INPUT BUFFER IN PAGE 1600
	TAD K2377
	JMS SETHLA
INRTRN,	CDF CIF 10
	JMP I INPENB

INVRGN,	TAD K1000
	DCA INHNDL
	TAD K1577
	JMP INRTRN-1

OUPENB,	0
	ISZ OUPFLG
	JMP OURTRN
	JMS TWOPAG	/HAS USER SPECIFIED 2 PG. HNDLRS?
	TAD INPFLG
	SPA CLA
	JMP OUVRGN
	TAD K2200
	DCA OUHNDL
	TAD (FOUBUF
	DCA I (ST1600	/MARK OUTPUT BUFFER IN 1600
	TAD K2377
	JMS SETHLA
OURTRN,	CDF CIF 10
	JMP I OUPENB

OUVRGN,	TAD K1000
	DCA OUHNDL
	TAD K1577
	JMP OURTRN-1

INPFLG,	-1
OUPFLG,	-1
K1000,	1000		/SET TO 1001 FOR 2 PAGE HANDLERS
K2200,	2200		/SET TO 2401 FOR 2 PAGE HANDLERS.
K2377,	2377		/SET TO 2577 FOR 2 PAGE HANDLERS.
K1577,	1577		/SET TO 1777 FOR 2 PAGE HANDLERS.
/SUBROUTINE TO CHECK FOR /H SWITCH MEANING USER
/WANTS RUN TIME DEVICE INDEPENDENT I/O TO
/BE ABLE TO USE 2 PAGE DEVICE HANDLERS
/
TWOPAG,	0
	CDF	10
	TAD I	(MPARAM
	AND	(20	/IS /H SWITCH SET?
	SNA	CLA
	JMP I	TWOPAG	/NO-RETURN (DATA FLD=1)
	TAD	(1001	/YES-RESET HANDLR FETCH TO ACCEPT
	DCA	K1000	/TWO PAGE HANDLERS
	TAD	(2401	/RESET FETCH FOR SECOND HANDLER
	DCA	K2200
	TAD	(2777
	DCA	K2377	/RESET HLA CONSTANT FOR 2 PG HANDLRS
	TAD	(1777
	DCA	K1577	/RESET 2ND HLA CONSTANT FOR 2 PG 
	TAD	(2000
	DCA I	(K1600	/RESET BUFR. ADDRESS-SEE *LDRXIT*
	CDF	00
	TAD	(1400
	DCA I	(FINBUF	/RESET IN AND OUT BUFFER ADDRESSES
	TAD	(1400	/TO MAKE ROOM FOR 2 PG HANDLR
	DCA I	(FOUBUF
	CDF	10
	JMP I	TWOPAG	/RETN. DATA FLD=1

SETHLA,	0
	DCA I (HLAZ
	TAD I (HLAZ
	CIA
	DCA I (HLAIO
	CDF 0
	JMP I SETHLA
BATCK,	0
	CDF 0
	TAD I (7777
	AND (70
	SNA
	JMP I BATCK
	CLL RTR
	RAR
	CMA
	DCA	TMPC
	TAD I	(7777
	RAL
	SPA CLA
	IAC
	TAD	TMPC
	JMP I	(FOUNDX
TMPC,	0
	PAGE
	FIELD 1
/FIELD 1 PAGE 0 EQUIVALENCES - FIT INTO USR CRACKS

	DEVHND=20
	BANK=21
	TM1=22
	TM2=23
	RECNO=24
	OVLYFG=25
	CUR=26
	WORD=27
	HLAPTR=30
	HLA=31
	RCON=32
	COML=33		/HI COMMON LOC, 0 IF NONE
	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	/FALL INTO NEXT PAGE
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	/&quot;M&quot;,&quot;P&quot; AND &quot;U&quot; 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
	PAGE
BUILDX,	TAD LSTADR
	SZA CLA
	JMP ALREDY
	TAD (MAIN-1
	DCA X1
	JMS I (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
BLDLPY,	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

BFLD1,	TAD COML
	SNA		/IS THERE ANY COMMON?
	JMP BLDLPX	/NO
	CLL CMA
	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 &quot;CHAIN&quot; TO WORK PROPERLY)
	TAD COML
	IAC
	DCA I X1
	TAD COML
	CMA
	TAD I TM1
	AND (7600
	JMP BLDLPY
CVTREC,	0
	TAD	CUR
	CLL RTL
	RTL
	RAL
	AND (7
	JMP I CVTREC

STOINF,	0
	DCA X1
	TAD LSTFLD
	DCA I X1
	TAD LSTADR
	DCA I X1
	DCA I X1
	JMP I STOINF
LSTADR,	0
LSTFLD,	0
	PAGE

MAPIO,	TAD I ML7600
	SNA
	TAD TTYNO	/TELETYPE IS DEFAULT LISTING DEVICE
	JMS I (GETHND
	TAD I	ML7604	/PICK UP EXTENSION WORD.
	SNA		/NON-ZERO?
	TAD	(1520	/NO-SUPPLY &#039;.MP&#039; EXTENSION.
	DCA I	ML7604	/YES-LEAVE ALONE
	TAD ML7601
	DCA MNAME
	TAD I (EASGN
	TAD (100	/4 SHIFTED LEFT INTO THE &quot;DESIRED LENGTH&quot; 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,	4600
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,	HLT		/THREE-WAY JUMP FOR CHAR OUTPUT
	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
/CLOSE OUTPUT FILE

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
ML7604,	7604		/POINTER TO FILE EXT. WORD
	JMP I IONULL
	PAGE
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
	TAD XX7600	/PARITY TTY HACK
	KRS
	TAD (-7603
	SNA CLA
	KSF
	SKP
	JMP I (MGET		/17667=07605
	ISZ IJMP
	ISZ INCHCT
IJMPE,	JMP IJMP
	CIF 0
	JMS I DEVHND
INCTLW,	0410
INBUF,	4600
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		/THREE-WAY JUMP FOR CHAR INPUT
	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
	ISZ	BANK
	CMA
	AND	XX7600
	JMP LOAD+1
LFAILD,	ISZ BANK
	JMP LOAD+2
EASGN,	0
LREQUR,	0
LOADOK,	JMS I (WRPGBF
	JMP I LOAD

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
	PAGE
/ 4600-5177 USED FOR LOADER MAP OUTPUT BUFFER
/  5200-5577 USED FOR LIBRARY DIRECTORY BUFFER

	*5600

/** CAN ONLY USE FIRST HALF OF THIS PAGE - 2ND HALF IS PART OF MST
/** NO LITERALS IN THIS PAGE!

LBRY,	TAD RECNO
	JMS LBSRCH
	JMP I .+1
	GETCD

LBSRCH,	0		/LIBRARY SEARCH ROUTINE
	DCA LBREC	/SAVE START BLK OF LIBRARY
	CIF 0
	JMS I DEVHND	/READ LIBRARY DIRECTORY
LBCTLW,	0210
L5200,	5200
LBREC,	0
	JMP I LIOERR
	TAD LBCTLW
	DCA I LINCTL
	TAD L7177
	DCA I LIN6377
	DCA I LINISZ
	TAD L5177
	DCA X1		/INITIALIZE FOR SEARCH
LBRYLP,	JMS I LSETS1	/GET NEXT DIRECTORY ENTRY
	TAD I X1
	SNA
	JMP I LBSRCH	/END OF DIRECTORY
	TAD L5200
	DCA LBFPTR
	JMS I LSEARCH	/IS IT IN SYMTAB?
	JMP LBRYLP	/NO
	TAD I LSYMNUM
	TAD LTVEC1
	DCA TM1
	CDF 0
	TAD I TM1
	CDF 10
	SZA CLA		/IS SYMBOL ALREADY DEFINED?
	JMP LBRYLP	/YES
LBLDLP,	TAD I LBFPTR	/GET MODULE TO LOAD
	SNA
	JMP LBRYLP-2	/NO MORE MODULES TO LOAD
	AND L177
	IAC
	TAD LBREC
	DCA RECNO
	DCA BANK
	TAD I LBFPTR
	AND L7600
	JMS I LLOAD	/LOAD LIBRARY MODULE
	ISZ LBFPTR
	JMP LBLDLP	/GET NEXT MODULE

LBFPTR,	0
LIOERR,	INERR
LINCTL,	INCTLW
L7177,	7177
LIN6377,	IN6377
L5177,	5177
LSETS1,	SETS1
LSEARCH,	SEARCH
L177,	177
L7600,	7600
LLOAD,	LOAD
LSYMNUM,	SYMNUM
LINISZ,	INISZ
LTVEC1,	TVEC-1
	IFZERO	.-5700&amp;4000	&lt;LBRERR,	_ERROR&gt;
/MAIN LOADING CODE
/MODIFIED VERSION OF
/PAPER-TAPE LINKING LOADER

/DEFINITIONS

BCRT=	200
TVEC=	300
ORGT=	100		/LOCAL SYMBOL TABLE NOW IN FIELD 0
MST=	6177		/MAIN SYMBOL TABLE

*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 &amp; TV TABLE
	ISZ	NSUB
	JMP	.-2	/NOT DONE
	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
	DCA	COML	/INIT. OLD COMMON AT 0000
	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 COML
	CIA
	CLL CML		/IF NO COMMON EXISTS, OR
	TAD WORD	/IF NEW COMMON .LE. OLD IT&#039;S
	SNL SZA CLA	/OK, ELSE ERROR
	JMP I ER3P
	TAD COML
	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 I HLA1P	/IF WE HAVE LOADED
	SZA CLA		/ANY CODE INTO FIELD 1
	JMP I ER3P	/IT&#039;S AN ERROR
	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 &amp; 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
	RTR
	RTR
	RAR
	AND K7400	/ISOLATE HI 4 BITS
	DCA WORD	/FROM 1ST CHAR
	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
	ER5
	RC3		/DEFINE SYMBOL
	RC4		/ORIGIN
	RC5		/CDF TO CURRENT BANK
	RC6		/REPLACE LOCAL # WITH GLOBAL #
	ER5
RC10A,	RC10		/LEADER-TRAILER
	ER5
ER3P,	ER3		/HIGH COMMON
ER5P,	ER5
	ER5
	ER5
	ER5
	RC17		/EXTERNAL SYMBOL SPECIFICATION
	PAGE
/NEW ORIGIN

RC4,	TAD	WORD	/NEW ORIGIN
	CLL
	TAD	RCON	/+ RELOCATION CONSTANT
	DCA	CUR	/= NEW LOADING ADDRESS
	SZL
	JMP I OVERFP	/FIELD OVERFLOW
	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
/
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
B1,

HLATST,	0
	TAD HLAZ
	TAD HLAIO
HLASZA,	SZA CLA		/SET TO CLA BY /R AND RESTART
	JMP I (UIOERR
	JMP I HLATST
HLAIO,	-777
	PAGE
/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
	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	/&quot;ER&quot;
	JMS	TTWO
	TAD	K2217	/&quot;RO&quot;
	JMS	TTWO
	TAD	K2240	/&quot;R &quot;
	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 &amp; LINE FEED
/
CRLF,	0
	TAD	K215
	JMS I	TYPE
	TAD	K212
	JMS I	TYPE
	JMP I	CRLF
/
/UNPACK &amp; 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
C3,
SYMNUM, 0
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
	PAGE
/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 (IN S1-S3)
/
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
	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
	CDF 10
	JMP I	ER2P

GETSYM,	0	/GET SYMBOL AND SEARCH TABLE
	JMS	DEFN
	JMS	SEARCH
	JMS	INSERT
	JMP I	GETSYM
/READ 1 FRAME &amp; 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

MAIN,	1501;1116;4040	/&quot;MAIN&quot;

/
/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
	PAGE
/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
	CDF 10
	TAD	HLA	/STORE HIGHEST LOADED ADDRESS
	DCA I	HLAPTR	/IN PROPER LOC. (HLA0-7)
	JMP I (LOADOK
/LOADER MAP PRINT ROUTINE CONTINUED

MAPX,	SNL CLA		/IF LINK=1 ONLY PRINT PAGE COUNTS,
	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
	TAD	(2640	/PRINT V#
	JMS I	TTWOP
	TAD (VERSION+PATCH
	JMS I TTWOP
	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	/JUMP IF MORE SYMBOLS, ELSE FALL INTO NEXT PG
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
	CMA RTL 	/DIVIDE BY 200 AND COMPLEMENT
	RTL
	RTL
	AND	K37	/=NUMBER OF PAGES LEFT + 1
	SZA
	TAD	(-1	/REDUCE IF NON-ZERO
	JMS I TOCTP
	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
T3,	0
T4,	0
K7B,	7
K70,	70
K260,	260
K4025,	4025
K4040,	4040
M03,	-3
BCRTA4, BCRT
CRLFP,	CRLF
ER4P,	ER4
HSRP,	ICHAR
MSTA4,	MST-3
TOCTP,	TOCT
TTWOP,	TTWO
TVECA,	TVEC-1
M100D,	7700
	PAGE
/WROVLY IS USED TO STORE THE FIELD COUNT FOR THE PROPGT
/ROUTINE- PROPGT IS CALLED THE FIRST TIME THAT IOTEST IS
/CALLED-SEE LOC.325 IN FIELD ZERO(APPROX.)

BC1000,	1000
WROVLY,	0
	TAD OVLYFG
	SPA SNA CLA
	JMP I WROVLY
	CIF 0
	JMS I (SHNDLR
	0110
	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 PREAD
	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
/LOADER CLEANUP CODE - PREPARES TO RETURN TO OS/8

LDRXIT,	CDF 10
	TAD I (HLA1
	TAD BC200
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	K1600
	CDF 0
	DCA I ST1600
	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 BC200
	13		/RESET EVERYTHING
	TAD I (MPARAM
	AND (40		/GET &quot;/G&quot; SWITCH
	SNA CLA
	JMP CALMON	/GO SWITCH NOT ON
	JMS I	BC200
	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 &quot;FINBUF&quot; OR &quot;FOUBUF&quot; BY /I AND /O
P4,	16
P5,	100
P6,	-15
/ROUTINE TO TEST FOR /I AND /O SWITCHES

IOTEST,	0
	TAD I (MPARAM
	AND (10
	SNA CLA		//I?
	JMP .+4
	JMS I (HLATST
	CDF CIF 0
	JMS I (INPENB
	TAD I (MPARAM+1
BC200,	AND BC1000
	SNA CLA		//O?
	JMP .+4
	JMS I (HLATST
	CDF CIF 0
	JMS I (OUPENB
	ISZ	DOPROP	/SHOULD WE PROPAGATE RESIDENT(AND WRITE OUT
	JMP	.+4	/THE RUN-TIME ROUTINES?)--NO
	TAD	WROVLY	/YES-FIELD COUNT IS IN WROVLY
	CDF	CIF 0
	JMS I	(PROPGT	/DO IT
	JMP I IOTEST
K1600,	1600	/RESET TO 2000 IF TWO PG.DEV.HNDLRS AT RUN TIME
DOPROP,	7777	/ONCE-ONLY FLAG FOR PROPAGATING FIELD ZERO
			/RESIDENT AND WRITING OUT RUNTIME ROUTINES
			/NOT RESET AFTER /R!!!!
			/SET TO -2 IF CALLED BY &quot;.R LOADER&quot;
			/BECAUSE OF USELESS INIT CALL TO IOTEST
	PAGE
	FIELD 0
	*200
	$-$-$
</pre>
<hr/>
</div>