	.TITLE *** RSX TASK BUILDER *** 
/
/ COPYRIGHT (C) 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 INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/ SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/ VIDED 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 DOCUMENT IS SUBJECT TO CHANGE
/ WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/ MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/ OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
/ DEC.
/
	.EJECT
/ EDIT #95
/
/
/ TASK BUILDER          22 DEC 70              H. KREJCI
/			4 DEC 71		R. MCLEAN
/			25 APR 72		W. DESIMONE
/                       4 APR 73               M. HEBENSTREIT
/			22 AUG 73		G. COLE
/			11  DEC 75		M. HEBENSTREIT
/
/ 096	30-DEC-75 (RCHM)	FIX FOR SIZE ONLY OPTIONS NOT MULTIPLES
/				OF 400 (OCTAL).
/
/ ASSEMBLY PARAMETERS:
/	FOR DOS OPERATION:	NONE
/	FOR RSX TKB:		RSX=0
/	FOR RSX BTK:		RSX=0 AND BATCH=0
/
/	DEFAULT PRIORITY:	DFLTPR=XX
/	DEFAULT BUFFERS:	DFLTBF=XX
/
/ COMMAND INPUT -- ALL KEYED IN INFORMATION IS ACCEPTED IN LOGICAL
/ LINES.  A CARRIAGE RETURN IS USED TO CONTINUE A LOGICAL LINE
/ ONTO THE NEXT PHYSICAL LINE.  AN ALTMODE IS USED TO TERMINATE
/ A LOGICAL LINE.  A LINE CONSISTS OF NAMES (ROUTINES, OPTIONS,
/ PARAMETERS), LIBRARY INDICATORS, AND BREAK CHARACTERS (NAME
/ TERMINATORS).  BLANKS ARE IGNORED.  NAMES MAY CONSIST OF 1-6
/ ALPHANUMERIC CHARACTERS.  A LIBRARY INDICATOR (#) MAY APPEAR ANY
/ WHERE WITHIN A NAME TO INDICATE THAT THE BINARY UNIT OF
/ A ROUTINE IS NOT TO BE FOUND ON THE USER'S DEVICE, BUT RATHER
/ WITHIN A LIBRARY.
/ THE FOLLOWING CHARACTERS ARE RECOGNIZED AS BREAK CHARACTERS,
/ BUT ONLY ACCEPTED AS VALID BREAK CHARACTERS WHEN APPROPRIATE:
/ EQUAL SIGN, COLON, COMMA, SLASH, LEFT PAREN, RIGHT PAREN, & ALT- 
/ MODE.  WHEN A COMMAND INPUT ERROR IS DETECTED, THE ENTIRE LOGICAL
/ LINE IS REJECTED.  IOPS ASCII EDITING (RUBOUT & ^U) APPLY ONLY 
/ TO PHYSICAL LINES.
/
/ ^P USES:
/ TO RESTART TASK BUILDER DURING COMMAND INPUT
/ TO RESTART A READ OPERATION AFTER EOM
/ TO READ A FILE FROM A NON-FILE-ORIENTED DEVICE
/ (THE REQ'D FILE NAME IS TYPED OUT BEFORE READING)
/ TO CONTINUE AFTER A PAUSE
/ AT ANY OTHER TIME, ^P WILL EXIT TO MONITOR.
/
/
/
/
/ REVISION              9 JUL 70              H. KREJCI
/
/ THE TASK BUILDER WILL RELOCATE THRU AN EOF (INSTEAD OF THE FIRST BINARY
/ UNIT)  IF RELOCATING FROM THE USER'S DEVICE [LDPROG: NXUN & CODE23].
/ THUS, THE NAMES IN COMMAND INPUT, WITHOUT LIBRARY INDICATORS, ARE FILE
/ NAMES RATHER THAN PROGRAM NAMES.
/ LIBRARY INDICATORS ARE ONLY ACCEPTED ON RESIDENT ROUTINE NAMES (NO
/ LONGER ON LINK COMPONENT NAMES) [COMMAND INPUT].
/ THE RESIDENT CODE MAY BE EXCLUSIVELY LIBRARY ROUTINES.  INITIAL CONTROL
/ IS TRANSFERRED TO THE FIRST ROUTINE RELOCATED [COMMAND INPUT].
/ TNE NAMES OF FILES CONTAINING RESIDENT ROUTINES OR INTERNAL LINK
/ COMPONENTS NEED NOT CORESPOND TO PROGRAM OR GLOBAL SYMBOL NAMES.
/ EXTERNAL LINK COMPONENTS ARE ONLY ACCEPTED FROM FILES WITH FILE NAMES
/ CORESPONDING TO THE COMPONENT NAMES (GLOBAL SYMBOL DEFS) [LDPROG,
/ CODE10, LTBCHK].  ANY OTHER ROUTINES IN A FILE WITH AN EXTERNAL
/ COMPONENT ARE CONSIDERED INTERNAL COMPONENTS.
/ THE PROGRAM ANNOTATION STILL REFERS TO ROUTINE NAMES RATHER THAN FILE
/ NAMES.
/
	.TITLE *** CHAIN GLOSSARY AND DEFINITIONS.
/
/ INDICATOR WORDS -- INDICATOR WORDS USED IN TABLES (RCL, LDT, ODT, 
/ & TTL'S) HAVE THE FOLLOWING BIT DESIGNATIONS:
/    BIT 17 -- THIS ENTRY DEFINES A LINK NAME
/    BIT 16 -- THIS ENTRY DEFINES AN EXTERNAL LINK COMPONENT
/    BIT 15 -- THIS ENTRY DEFINES AN INTERNAL LINK COMPONENT
/    BIT 14 -- ROUTINE IS ON USER'S DEVICE
/    BIT 13 -- ROUTINE IS IN A LIBRARY
/    BIT 11 -- ROUTINE IS RESIDENT (RCL ENTRY)
/
/CLT	CORE LIMITS TABLE (EXECUTABLE CODE)
/
/	HIGHEST FREE ADDRESS IN ANY GIVEN PAGE OR BANK. EXECUTABLE
/	CODE SPACE IS ALLOCATED ONLY THROUGH THIS TABLE. THE TABLE IS
/	TERMINATED BY A -1. CLTX1 IS THE POINTER TO THE END OF THE TABLE
/	I.E TO THE -1.
/
/
/GST	GLOBAL SYMBOL TABLE
/
/	CONSTRUCTED INITIALLY IMMEDIATELY AFTER THE LTB. THE FORMAT IS
/	AS FOLLOWS:
/
/	WORD 1	IXXXXX	I=INDICATOR
/			XXXXX="NAME" OF ENTRY.
/	WORD 2	IXXXXX	I=1BIT INDICATOR SET=>ENTRY IS 3 WORD LONG.
/	WORD 3	3 RAD 50 CHARACTERS.
/	WORD 4	NOT PRESENT EXCEPT IF I=3 OR 7
/	WORD 5	NOT PRESENT EXCEPT IF I=3 OR 7
/
/	WORD 1 - I=0 => DELETED GLOBAL SYMBOL ENTRY
/
/	WORD 1 - I=1 => UNRESOLVED GLOBAL SYMBOL REFERENCE
/
/	WORD 1 - I=3 => ENTRY IS A DEFINED COMMON BLOCK. XXXXX IS THE
/			SIZE OF THE BLOCK.
/
/	WORD 1 - I=4 => COMMON ELEMENT REFERENCE
/
/	WORD 1 - I=5 =>	ENTRY IS DEFINED IN THE LTB AND IS A LINK
/			"NAME". XXXXX IN WORD 1 IS A POINTER
/			TO THE LTB ENTRY FOR THIS PARTICULAR LINK COMPONENT.
/
/	WORD 1 - I=6 => DUMMY GLOBAL SYMBOL ENTRY
/
/	WORD 1 - I=7 => ENTRY IS AN UNDEFINED COMMON BLOCK, I.E. NOT THE
/			TARGET OF A BLOCK DATA SUBROUTINE. THIS ENTRY IS
/			5 WORDS LONG AS IS THE ENTRY SIZE FOR I=3. THE
/			EXTRA INFORMATION IS 1) A WORD POINTING TO A
/			CHAIN OF ADDRESS CONTAINING TRANSFER VECTORS TO
/			THE CONTENTS OF THE BLOCK AND 2) A BASE ADDRESS
/			FOR THE COMMON BLOCK.
/
/LDT	LINK DESCRIPTOR TABLE
/
/	SAME FORMAT AS RCL.
/	WORD 1	INDICATOR WORD:
/		BIT 17 - SET INDICATES THAT NAME IS THE NAME OF A LINK.
/		BIT 16 - SET INDICATES THAT NAME IS KNOWN EXTERNALLY.
/		BIT 15 - SET INDICATES THAT NAME IS KNOWN INTERNALLY.
/	WORD 2	6BIT NAME
/	WORD 3	6BIT NAME
/
/	LINK TABLE - PRELIMINARY CONSTRUCTION
/
/	THE LINK TABLE IS THE MECHANISM WHICH ALLOWS TRANSFER OF CONTROL
/	BETWEEN RESIDENT AND NON-RESIDENT LINKS. THIS TABLE CONTAINS AN
/	ENTRY FOR EACH EXTERNAL COMPONENT OF EVERY LINK. THE TABLE IS
/	BUILT FROM THE TTL AND THE LDT. THE LTB ENTRY FORMAT DURING
/	PRELIMINARY CONSTRUCTION IS AS FOLLOWS:
/
/	WORD	0	INDICATOR	FROM TTL.
/		1	3-6BIT CHARACTER LINK NAME
/		2	3-6BIT CHARACTER LINK NAME
/		3	3-6BIT CHARACTER COMPONENT NAME
/		4	3-6BIT CHARACTER COMPONENT NAME
/		5	RELOCATION FLAG
/		6	0
/		7	0
/		8	LINK NUMBER
/		9	INDEX		LDT INDEX WHICH REPRESENTS
/					THIS LINK. 0 IF THIS IS AN SCL
/		10	0
/
/NCL	NAMED COMMON LIST
/
/	ANY COMMON BLOCK NAMED IN THE SHARE OR RES COMMANDS IS PLACED INTO
/	THIS LIST. THE HEAD OF THE LIST IS ALWAYS POINTED TO BY "NCLBSE"
/	AND THE TAIL IS ALWAYS POINTED TO BY "RCL.BS". THE LIST HAS THE
/	FOLLOWING FORMAT:
/
/	WORD 1	BIT 0		SET IF THE SECOND WORD OF THE ELEMENT IS
/				USED FOR NAMES.
/	WORD 1	BIT 1		SET IF THE BLOCK NAMED IS TO BE WITHIN
/				SHARED SPACE
/	WORD 1	BIT 2-17	RAD50 REPRESENTATION OF THE FIRST THREE
/				CHARACTERS OF THE COMMON BLOCK NAME.
/	WORD 2	BIT 0		SET IF THE COMMON BLOCK IS TO BE FORCED
/				INTO HIGH MEMORY (RES OPTION).
/	WORD 2	BIT 1		CURRENTLY UNUSED.
/	WORD 2	BIT 2-17	RAD50 REPRESENTATION OF THE LAST THREE
/				CHARACTERS OF THE COMMON BLOCK NAME.
/	WORD 3			BASE OF SHARED COMMON (ABSENT FOR RES ENTRIES)
/	WORD 4			SIZE OF SHARED COMMON (ABSENT FOR RES ENTRIES)
/
/RCL	RESIDENT CODE LIST
/
/	ANY CODE WHICH GETS PLACED IN THE RESIDENT AREA IS FLAGGED IN
/	THIS LIST. THE LIST FORMAT IS:
/
/	WORD 2	6BIT NAME OF RESIDENT CODE
/	WORD 3	6BIT NAME OF RESIDENT CODE
/	WORD 1	INDICATOR WORD:
/		BIT 11 - SET BY RCL SET UP CODE, MEANING UNKNOWN.
/		BIT 12 - CODE IN THE SYSTEM LIBRARY.
/		BIT 13 - CODE IN THE USER LIBRARY.
/		BIT 14 - CODE COMES FROM THE USER.
/
/SCL	SINGLE COMPONENT LINK
/
/	DEFINITION: A LINK WITH NO CORRESPONDING ENTRY IN THE LINK
/		    DESCRIPTION TABLE. THE NAME OF THE LINK IS THE
/		    NAME OF THE COMPONENT.
/
/TTL	TRUNK TO TWIG LIST
/
/	THE TTL CONSISTS OF A SERIES OF LISTS. EACH LIST BEGINS WITH
/	A LINK NAME WHICH DOES NOT OVERLAY ANYTHING ELSE. IT ENDS WITH
/	A LINK NAME WHICH IS NOT OVERLAYED BY ANYTHING ELSE. THE REST
/	OF THE ITEMS IN THE LIST 2,3,...,N-1 MAY OR MAY NOT OVERLAY EACH
/	OTHER BUT THEY DO OVERLAY THE FIRST ELEMENT IN THE LIST.
/	EXAMPLE:
/	>SUB1:SUB2
/	>SUB2:SUB3,SUB4
/	PRODUCES THE TTL:
/	SUB1->SUB2->SUB3
/		AND
/	SUB1->SUB2->SUB4
/	THE TTL IS BUILT FROM THE ODT WHICH IS DESTROYED IN THE PROCESS.
/	EACH TTL ELEMENT IS DELIMITED BY A -1 AND EACH TTL ENTRY ITEM
/	CONSISTS OF A 3 WORD ENTRY.
/
/	WORD 1	INDICATOR WORD, AS IN THE ODT.
/	WORD 2	6BIT NAME
/	WORD 3	6BIT NAME
/
/CBDBUF		SYSTEM COMMON BLOCK DEFINITIONS LIST
/
/		THIS LIST GIVES THE NAME BASE AND SIZE FOR UP TO FOUR
/		SYSTEM COMMONS SPECIFIED FOR AN EXEC MODE TASK.
/		THE FORMAT OF THIS LIST IS:
/
/	WORD 1			3-6BIT CHARACTER NAME
/	WORD 2			3-6BIT CHARACTER NAME
/	WORD 3			BASE OF SYSTEM COMMON
/	WORD 4			SIZE OF SYSTEM COMMON
	.TITLE *** EQUATES ***
/
	.IFUND	RSX
/
.SCOM=100
SL=-1	 /SYSTEM LIBRARY
CI=-2	/COMMAND INPUT
TO=-3	/TYPED OUTPUT
UD=-4	/USER PROGRAM DEVICE
UL=-5	/USER'S LIBRARY
RO=-6	/RELOCATED OUTPUT
X10=10
X11=11
X12=12
X13=13
X14=14
	.ENDC
	.IFDEF	RSX
X10=10
X11=11
X12=12
X13=13
X14=14
	.IFUND	DAT1
SL=12
	.ENDC
	.IFUND	DAT2
CI=14
	.ENDC
	.IFUND	DAT3
TO=15
	.ENDC
	.IFUND	DAT4
UD=21
	.ENDC
	.IFUND	DAT5
UL=13
	.ENDC
	.IFUND	DAT6
RO=22
	.ENDC
ECLA=641000
	.IFDEF	DAT1
SL=DAT1
	.ENDC
	.IFDEF	DAT2
CI=DAT2
	.ENDC
	.IFDEF	DAT3
TO=DAT3
	.ENDC
	.IFDEF	DAT4
UD=DAT4
	.ENDC
	.IFDEF	DAT5
UL=DAT5
	.ENDC
	.IFDEF	DAT6
RO=DAT6
	.ENDC
	.ENDC
/
	.IFUND	DFLTPR	/(MJH-85)
DFLTPR=620		/(MJH-85) IF NO PRIORITY SPECIFIED TO TKB ASSUME DEFAULT (400 DECIMAL)
	.ENDC		/(MJH-85)
/
	.IFUND	DFLTBF	/(MJH-85)
DFLTBF=0		/(MJH-85) IF THE BUFFS OPTION NOT SPECIFIED ASSUME NO I/O BUFFERS
	.ENDC		/(MJH-85)
/-
	.TITLE *** TKB INITIALIZATION ***
/
START	DZM	MAX.XX	/INITIALIZE MAX BLANK COMMON BLOCK SIZE
	.IFDEF	RSX
	CAL	RELTDV	/ISSUE A TDV REQUEST TO CLEAR TDV
	LAC	TDVEV	/PICK UP TDV EVENTVARIABLE TO SEE IF IT IS OK
	SPA
	JMP	TDVER	/NO -- TDV ERROR
	CAL	PREAUL	/PREALLOCATE USER'S LIBRARY
	LAC	(RO)	/PREALLOCATE OUTPUT DEVICE
	JMS	PREALL
	LAC	(UL)	/DO A HINF ON USER LIBRARY
	JMS	HINLUN
	LAC	EV	/SAVE EVENT VARIABLE
	DAC	ULHINF
	LAC	(UD)	/DO A HINF ON USER'S DEVICE
	JMS	HINLUN
	LAC	EV	/SAVE EVENT VARIABLE
	DAC	UDHINF
	SAD	ULHINF	/IS IT THE SAME AS UL?
	JMP	.+3	/NO DON'T PREALLOCATE
	LAC	(UD)
	JMS	PREALL	/PREALLOCATE
	LAC	(SL)	/CHECK SYSTEM LIBRARY
	JMS	HINLUN
	LAC	EV	/CHECK EVENT VARIABLE
	SAD	ULHINF	/IF THE SAME DON'T PREALLOCATE
	JMP	NOPREA
	SAD	UDHINF
	JMP	NOPREA
	LAC	(SL)
	JMS	PREALL	/PREALLOCATE
NOPREA	CAL	PARSIZ	/GET THE PARTITION SIZE
	.ENDC
	.IFUND	RSX
	.INIT CI,0,CPTYPD /SETUP ^P TRANSFER ADDRESS
	.ENDC
	.TITLE *** INITIALIZE OPTION PROCESSING ***
/
	.IFUND	BATCH
	JMS	TYPE	/TYPE PROGRAM NAME AND VERSION
	MES1
/
/ FETCH AND RECORD OPTIONS
/
	.IFUND	RSX
	JMS	CRTN	/REQUEST OPTIONS
	.ENDC
	JMS	TYPE
	MES10
	.ENDC
FROSNL	DZM	SZFLAG
	DZM	FPFLAG	/CLEAR THE FLOATING POINT FLAG
	DZM	GMFLAG
	DZM	SAFLAG
	DZM	PSFLAG
	DZM	SLFLAG	/SYSTEM LIBRARY FLAG
	DZM	PRFLAG	/CLEAR PRIVILEDGED FLAG
	DZM	BKFLAG	/BANK MODE RELOCATION FLAG
	LAC	(DFLTBF	/(MJH-85) SET UP DEFAULT NO. OF I/O BUFFERS
	DAC	BUFFS	/(MJH-85)
	DZM	XMFLAG	/(MJH-85) CLEAR XVM FLAG
	DZM	IOFLAG	/(MJH-85) CLEAR IOT PERMISSION FLAG
	DZM	SHFLAG	/(MJH-85) CLEAR SHARED COMMONS FLAG
	JMS	RV.INT	/(MJH-85) INIT THE NCL
	LAC	(7777)	/SET UP FOR PAGE MODE OPERATION
	DAC	ADRMSK
	CMA
	DAC	OPCMSK
	LAC	LIBRP
	DAC	LIBNAM
	CLA!IAC		/(MJH-85)PRINT LOAD MAP
	DAC	LMFLAG
	.IFDEF	RSX
	CAL	LJEA	/LOAD THE JEA REGISTER
	LAC	EV	/OK?
	SPA
	JMP	NOFPP	/NO FPP NOT AVAILABLE
	ISZ	FPFLAG
	LAC	LIBNAM	/CHANGE THE LIBRARY NAME
	AND	(770077)
	XOR	(600)
	DAC	LIBNAM
	.ENDC
	.IFDEF	BATCH
NOFPP	JMS	.+1	/SET UP PROTECT CHECK
	0
	LAC	.-1
	RTL
	SMA
	ISZ	PRFLAG	/SET PROTECTION FLAGS
	.ENDC
	.TITLE *** FETCH OPTIONS ***
	.IFUND	BATCH
/
NOFPP	JMS	RFAN	/READ LINE AND FETCH FIRST NAME
	JMS	ZLLX	/ZERO LENGTH LINE?
	JMP	FROFTN	/YES -- NO OPTIONS OR PARAMETERS SPECIFIED
FRONX	LAC	FANM	/NO -- ERR 101 IF 0 OR 7 CHAR NAME
	SZA
	JMP	.+4
NAMERR	JMS	ERR1	/(MJH-85)
	MES101
	JMP	FROSNL
	LAC	FANB	/ERR 103 IF BREAK CHAR IS NOT A
	SAD	(054)	/COMMA OR ALTMODE OR SLASH
	JMP	FRONC
	SAD	(175)
	JMP	FRONC
	SAD	(57	/(MJH-85) SLASH?
	JMP	FROREN	/(MJH-85) YES -- GO CHECK TO SEE IF OPTION IS RES
	SAD	(072)	/IS IT A :
	SKP		/YES LOOK FOR A LIBRARY AND NAME OR BUFFS:N
	JMP	FRO103	/NO ERROR
	LAC	FANM
	SAD	(251400) /UL
	JMP	FROUL
	SAD	(231400) /SL
	JMP	FROSL
	SAD	(022506	/(MJH-85) BUF?
	JMP	FROBUF	/(MJH-85) YES
FRO103	JMS	ERR3
	MES103
	JMP	FROSNL
/
FRONC	LAC	FANM+1	/COMPARE NAME WITH RECOGNIZED OPTION
	SZA		/AND PARAMETER SYMBOLS, ERR 32 IF MATCH 
	JMP	FRO32	/NOT FOUND
	LAC	FANM
	SAD	(200114) /PAL
	JMP	FROPAL
	SAD	(230103) /SAC
	JMP	FROSAC
	SAD	(161500) /NM
	JMP	FRONM
	SAD	(071500) /GM
	JMP	FROGM
	SAD	(233200) /SZ
	JMP	FROSZ
	SAD	(053015) /EXM
	JMP	FROPR
	SAD	(021322) /BKR
	JMP	FROBKR
	SAD	(200722) /PGR
	JMP	FROPGR
	SAD	(162215) /NRM
	JMP	FRONPM
	SAD	(062000) /FP
	JMP	FROFP
	SAD	(160620)	/NFP
	JMP	NOFPPA
	SAD	(302615		/(MJH-85) XVM?
	JMP	FROXVM		/(MJH-85) YES -- GO SET XVM FLAG
	SAD	(111724		/(MJH-85) IOT?
	JMP	FROIOT		/(MJH-85) YES -- GO SET IOT FLAG
	SAD	(231022		/(MJH-85) SHR?
	JMP	FROSHR		/(MJH-85) YES -- GO SET SHARE FLAG
FRO32	JMS	ERR2	/SYMBOL NOT RECOGNIZED
	MES32
	JMP	FROSNL
FRO33	JMS	ERR2		/(MJH-85) INCONSISTANT OPTION
	MES33			/(MJH-85)
	JMP	FROSNL		/(MJH-85)
/
FROPAL	ISZ	PSFLAG	/SET PAUSE FLAG
	JMP	FROLNX
FROSAC	ISZ	SAFLAG
	JMP	FROLNX
FRONM	DZM	LMFLAG	/CLEAR LOAD MAP FLAG
	JMP	FROLNX
FROGM	ISZ	GMFLAG	/SET GLOBAL MAP FLAG
	JMP	FROLNX
FROSZ	ISZ	SZFLAG	/SET SIZE FLAG
	JMP	FROLNX
FROPR	LAC	IOFLAG		/(MJH-85) SEE IF ANY NRM FLAGS ARE SET
	TAD	XMFLAG		/(MJH-85) IF SO, DECLARE AN ERROR
	TAD	SHFLAG		/(MJH-85)
	SZA			/(MJH-85)
	JMP	FRO33		/(MJH-85) NRM HAS BEEN IMPLIED, DECLARE ERROR
	ISZ	PRFLAG		/(MJH-85) OK -- SET PRIV FLAG
	JMP	FROLNX
FROBKR	ISZ	BKFLAG
	LAC	(17777)
FROBPX	DAC	ADRMSK	/SET UP OPCODE AND ADDRESS MASK'S
	CMA
	DAC	OPCMSK
	JMP	FROLNX
FROPGR	DZM	BKFLAG
	LAC	(7777)
	JMP	FROBPX
FROFP	LAC	SLFLAG	/IS THERE A SYSTEM LIBRARY SPECIFIED?
	ISZ	FPFLAG	/UPDATE THE FP FLAG TO INDICATE A FP UNIT
	SZA
	JMP	FROLNX	/YES DON'T CHANGE NAME
	LAC	LIBNAM
	AND	(770077
	XOR	(600
	DAC	LIBNAM
	JMP	FROLNX
/
FROXVM	LAC	PRFLAG		/(MJH-85) IS PRIV FLAG SET?
	SZA			/(MJH-85)
	JMP	FRO33		/(MJH-85) YES -- ERROR
	ISZ	XMFLAG		/(MJH-85) NO -- SET XVM FLAG
	JMP	FROLNX		/(MJH-85)
/
FROIOT	LAC	PRFLAG		/(MJH-85) IS PRIV FLAG SET?
	SZA			/(MJH-85)
	JMP	FRO33		/(MJH-85) YES -- ERROR
	ISZ	IOFLAG		/(MJH-85) NO -- SET IOT PERMISSION FLAG
	JMP	FROLNX		/(MJH-85)
/
FROSHR	LAC	PRFLAG		/(MJH-85) IS PRIV FLAG SET?
	SZA			/(MJH-85)
	JMP	FRO33		/(MJH-85) YES -- ERROR
	ISZ	SHFLAG		/(MJH-85) NO -- SET SHARE FLAG
	JMP	FROLNX		/(MJH-85)
/
NOFPPA	DZM	FPFLAG	/CLEAR FP FLAG
	LAC	SLFLAG		/(MJH-85) IS THERE A SYSTEM LIB?
	SZA			/(MJH-85)
	JMP	FROLNX		/(MJH-85) IF SO, DON'T CHANGE LIB NAME
	LAC	LIBNAM
	AND	(770077)
	XOR	(002200)
	DAC	LIBNAM
	JMP	FROLNX
FRONPM	DZM	PRFLAG	/CLEAR PRIVILEDGED FLAG
	JMP	FROLNX
FROSL	JMS	FAN	/READ LIBRARY NAME FOR
	LAC	FANM	/SYSTEM LIBRARY
	SZA		/IS THERE A NAME?
	JMP	.+4	/YES
	JMS	ERR1	/NO ERROR
	MES101
	JMP	FROSNL
	ISZ	SLFLAG	/SET THE SYSTEM LIBRARY FLAG
	DAC	SLLIBR	/SET IN SEEK REQUEST
	LAC	FANM+1	/SET UP SECOND HALF OF NAME
	DAC	SLLIBR+1
	JMP	FROLNX
FROUL	JMS	FAN	/READ LIBRARY NAME FOR
	LAC	FANM	/USER'S LIBRARY
	SZA		/IS THERE A NAME?
	JMP	.+4	/YES OK
	JMS	ERR1
	MES101
	JMP	FROSNL
	DAC	ULLIBR
	LAC	FANM+1
	DAC	ULLIBR+1
	JMP	FROLNX
/
/
/ THE CODE FROM FRORES THRU VTCEXT GLEANED FROM CHAIN 170 *********************
FROREN	LAC	FANM		/(MJH-85)
	SAD	(220523		/(MJH-85) IS THIS THE RES OPTION?
	SKP			/(MJH-85)
	JMP	FRO32		/(MJH-85) NO -- ERROR
	JMS	RES.ON		/(MJH-85) YES -- TURN RES.SW TO A SKP
FROVTB	JMS	FAN	/GET NAME OF COMMON AREA  
	LAC	FANM	/CHECK FOR LENGHT ERROR  
	SNA		/ 
	JMP	NAMERR	/ 
/
/MAKE ENTRY IN NAMED COMMON LIST (NCL) FOR THIS NAME
/ FORMAT FOR NCL IS GIVEN IN THE GLOSSARY (SEE ABOVE).
/
	JMS NCL.CM		/(RCHM-158) GO INSERT NAME IN NCL.  
/
/CHECK TERMINATOR---OPTION ENDED BY A SLASH. A COMMA
/IS USED TO SPERATE THE NAMES ALL OTHER TERMINATORS ARE ILLEGAL
/
	LAC	FANB	/ 
	SAD	(57	/SLASH  
	JMP	VTCEXT	/EXIT FROM OPTION  
	SAD	(54	/COMMA  
	JMP	FROVTB	/GET NEXT NAME  
	JMP	FRO103	/IMPROPER BREAK CHAR  
/
/EXIT FROM VTC/---/ OR RES/---/ OPTION--MAKE SURE
/NEXT ELEMENT IN COMMAND LINE IS NOT JUST AN
/ALTMORE (IE) END OF OPTIONS
/
VTCEXT	JMS RES.OFF		/(RCHM-158) TURN OFF RES SWITCH.  
	JMS	FAN	/GET NEXT OPTION  
	SAD	(175	/IS THIS END OF OPTIONS  
	SKP		/ 
	JMP	FRONX	/NO--GO SERVICE OPTION  
	LAC	FANM	/MAYBE--FANM=FANM+1=0  
	SZA		/IF IT IS  
	JMP	FRONX	/NO--GO SERVICE OPTION  
	SAD	FANM+1		/ 
	JMP	FROINT	/YES---INITIALIZE PER OPTION & PARAMETERS  
	JMP	FRONX	/NO--GO SERVICE OPTION--WILL BE AN ERROR  
/
FROBUF	LAC	FANM+1		/(MJH-85) WAS THE OPTIONS BUFFS?
	SAD	(062300		/(MJH-85)
	SKP			/(MJH-85)
	JMP	FRO32		/(MJH-85) NO -- ERROR
	LAW	-1		/(MJH-85) YES -- PREPARE TO GET NO. OF BUFFS
	DAC	PRZLN		/(MJH-85)
	JMS	FDC		/(MJH-85) READ NUMBER (DECIMAL)
	SAD	(175		/(MJH-85) IS BREAK CHAR AN ALTMODE?
	SKP			/(MJH-85) YES
	SAD	(54		/(MJH-85) NO -- COMMA?
	SKP			/(MJH-85) YES
	JMP	FRO103		/(MJH-85) NO -- ERROR
	DAC	FANB		/(MJH-85) SAVE BREAK CHAR
	ISZ	PRZLN		/(MJH-85) WERE ANY NUMBERS TYPED?
	SKP			/(MJH-85)
	JMP	FRO103		/(MJH-85) NO -- ERROR
	LAC	FOCA		/(MJH-85) YES -- GET NO.
	DAC	BUFFS		/(MJH-85) SAVE THE NO. OF BUFFERS
	JMP	FROLNX		/(MJH-85)
/
/
FROLNX	LAC	FANB	/LAST NAME TEST
	SAD	(175)	/ALTMODE BREAK?
	JMP	FROINT	/YES -- INITIALIZE PER ACCEPTED OPTIONS & PARAMS
	JMS	FAN	/NO -- FETCH ANOTHER NAME
	JMP	FRONX
	.TITLE *** CLEAN UP AFTER OPTION PROCESSING ***
/
FROINT	LAC	SZFLAG	/INCREASE MAP LINE LENGTH IF SIZE OPTION
	SNA
	JMP	FROFTN
	LAC	(022000)	/(MJH-85)
	DAC	MAPBUF
	LAC	(040)
	DAC	MAPFAD+13
	.ENDC
FROFTN	LAC	ADRMSK	/SAVE ADDRESS MASK FOR RESTORATION (LDR CODE 23)
	DAC	AMREST	/AND SET ENVIRONMENT TO BANK OR PAGE
	LAC	(CLT)	/SET UP CORE LIMITS-TABLE (CLT)
	DAC	CLTX1	/OF UPPER LIMITS OF EACH EXISTING CORE
	LAC	(77777)	/BANK OR PAGE -- TERMINATED BY -1
FROCT1	DAC*	CLTX1
	SAD	(-1)
	.IFUND	BATCH
	JMP	FROFTA
	.ENDC
	.IFDEF	BATCH
	JMP	FTKNM
	.ENDC
	AND	OPCMSK
	AAC	-1		/(MJH-85)
	ISZ	CLTX1
	JMP	FROCT1
	.TITLE *** GET TASK NAME ***
/
	.IFUND	BATCH
/
FROFTA	JMS	CRTN	/REQUEST TASK NAME
	JMS	TYPE
	MES20
	.ENDC
FTKNM	DZM	BTCHSW	/CAUSES NAME TO BEGIN AFTER SPACE
	JMS	RFAN
	JMS	NLEX	/REJECT IF NAME LENGTH ERROR
	.IFUND	BATCH
	JMP	FTKNM
	.ENDC
	.IFDEF	BATCH
	JMP	EXITB
	.ENDC
	.IFUND BATCH	/TEST FOR ALTMODE TERMINATOR; RETRY QUERY
	JMS	AMBX	/RETURNS TO PLUS2 IF OK, PLUS 1 IF ERROR
	JMP	FTKNM
	.ENDC
	.IFDEF	BATCH	/ALLOW ALTMODE OR COMMA IN BTK...
	LAC	FANB	/GET LAST CHARACTER
	SAD	(054)	/TEST FOR COMMA
	SKP		/CONTINUE IF COMMA
	SAD	(175)	/TEST FOR ALTMODE IF NOT COMMA
	JMP	FTKNMX	/IT IS EITHER AN ALTMODE OR A COMMA
	JMS	AMBX	/THIS WILL CAUSE MESSAGE TO BE OUTPUT
	JMP	EXITB	/EXIT WILL ALWAYS OCCUR HERE
	JMP	EXITB	/EXXIT WILL NEVER COME HERE(CANT BE AN ALTMODE!!)
	.ENDC
FTKNMX	LAC	FANM	/PICK UP FIRST WORD OF FILE NAME
	DAC	ROFNAM	/SAVE TASK (FILES) NAME
	LAC	FANM+1
	DAC	ROFNAM+1
	.IFUND	BATCH
	JMS	CRTN
	.ENDC
/
	.IFUND	RSX
	.INIT	RO,1,0	/OPEN TSK (EXTENSION) FILE
	.ENTER	RO,ROFNAM
	.ENDC
	.IFDEF	RSX
	CAL	ATTUD	/ATTACH ALL INPUT AND OUTPUT DEVICES
	CAL	ATTLU
	CAL	ATTRO
	CAL	ENTRO
	JMS	WFENEV
	SKP
	JMP	ER701	/I/O ERROR
	.ENDC
	.TITLE *** GET TASK PRIORITY ***
	.IFUND	BATCH
/
PRIAGN	JMS	TYPE	/REQUEST DEFAULT PRIORITY
	MES21
	JMS	CRTN	/RETURN CARRIAGE
	JMS	TYPE	/TYPE ANGLE BRACKET
	CAGB
	JMS	RFRD	/READ COMMAND LINE
	LAW	-1
	DAC	PRZLN	/CHECK FOR ZERO LENGTH LINE
	JMS	FDC	/READ AN OCTAL CHARACTER
	SAD	(175)	/IS IT AN ALTMODE?
	SKP		/YES OK
	JMP	PRILEG	/NO ERROR
	ISZ	PRZLN	/DID LINE CONTAIN OTHER THAN NUMBERS?
	SKP		/NO OK
	JMP	PRIDFT	/YES NO PRIORITY (MJH-85)
	LAC	FOCA	/PICK UP PRIORITY FOUND
	SNA		/IS IT ZERO?
	JMP	PRIDFT	/NO PRIORITY FOUND OK (MJH-85)
	SPA		/IS IT POSITIVE?
	JMP	PRILEG	/NO ERROR
	TAD	(-1001)	/IS IT GREATER THAN 512?
	SPA
	JMP	PRIOK	/NO MUST BE OK
PRILEG	JMS	CRTN	/PRINT ERROR MESSAGE
	JMS	ERR1
	MES23
	JMS	CRTN
	JMP	PRIAGN	/TRY AGAIN
PRIDFT	LAC	(DFLTPR	/(MJH-85) IF NO PRIO GIVEN USE DEFAULT
	SKP		/(MJH-85)
PRIOK	LAC	FOCA	/NUMBER OK SAVE IT
	DAC	DEFPRI
FCDP	JMS	CRTN
/
	.TITLE *** GET TASK PARTITION ***
	JMS	TYPE	/REQUEST PARTITION DESCRIPTION
	MES22
FCPDR	JMS	RFAN	/READ LINE & FETCH FIRST NAME
	JMS	NLEX	/REJECT IF NAME LENGTH ERR
	JMP	FCPDR
	DAC	CPNAM+0	/SAVE PARTITION NAME
	LAC	FANM+1
	DAC	CPNAM+1
	JMS	FDES	/FETCH DESCRIPTION (BASE, SIZE)
	JMP	FCPDR	/REJECT IF ERROR
	JMS	FAC	/FETCH NEXT CHARACTER (ALTMODE BREAK)
	DAC	FANB
	JMS	AMBX	/ALTMODE BREAK?
	JMP	FCPDR	/NO -- REJECT
	.ENDC
	.IFDEF	BATCH
	LAC	(DFLTPR)	/SET UP BATCH PRIORITY OF 400 (MJH-85)
	DAC	DEFPRI
	CAL	PIFCPB	/GET TDV INFORMATION
	LAC	PIFNAM
	DAC	CPNAM	/SET UP THE TDV NAME
	LAC	PIFNAM+1
	DAC	CPNAM+1
	LAC	PRFLAG
	CAL	PIFCPB
	LAC	PRFLAG
	SNA
	DZM	FDESB
	.ENDC
	LAC	FDESB	/YES -- SET 'PTBASE' & 'LDLMT' PER
	DAC	PTBASE	/BASE ADDRESS OF PARTITION
	DAC	LDLMT
	AND	(007760)/IF LDLMT IS WITHIN THE FIRST 20 REGISTERS
	SZA		/SET TO THE 21ST
	JMP	FCPDR1
	LAC	LDLMT
	AND	(070000)
	XOR	(000020)
	DAC	LDLMT
/
FCPDR1	LAC	(100000	/(MJH-85) SET DEFAULT BASE OF SAS TO 32K
	DAC	SAS	/(MJH-85)
	LAC	SHFLAG	/(MJH-85) IS SHARE ON?
	SNA		/(MJH-85)
	JMP	VPSST	/(MJH-85) NO
	LAC	XMFLAG	/(MJH-85) YES -- HOW ABOUT XVM?
	SNA		/(MJH-85)
	JMP	.+3	/(MJH-85)
	LAC	(360000	/(MJH-85) YES -- SET BASE OF SAS TO 120K
	SKP		/(MJH-85)
	LAC	(60000	/(MJH-85) NO -- SET BASE OF SAS TO 24K
	DAC	SAS	/(MJH-85) SAVE BASE OF SAS
/
VPSST	LAC	FDESZ	/(MJH-85) GET PART SIZE
	DAC	APS	/(MJH-85) SAVE IT AS ACTUAL PARTITION SIZE
	CLL		/(MJH-85)
	LAC	BUFFS	/(MJH-85) MULTIPLY BUFFERS BY 422
	MUL		/(MJH-85)
	422		/(MJH-85)
	LAC	PRFLAG	/(MJH-85) EXEC MODE?
	SZA		/(MJH-85)
	JMP	VPSEXM	/(MJH-85) YES -- DON'T ROUND OFF BUFFER SPACE
	LACQ		/(MJH-85) NO -- ROUND BUFFER SPACE TO 400 OCTAL
	AAC	377	/(MJH-85)
	AND	(777400	/(MJH-85)
	SKP
VPSEXM	LACQ		/(MJH-85)
	TCA		/(MJH-85) NEGATE SPACE NEEDED FOR BUFFERS
	TAD	APS	/(MJH-85) SUBTRACT FORM ACTUAL PART SIZE
	SPA!SNA		/(MJH-85) TOO MANY BUFFERS FOR PART?
	JMP	TMBUF	/(MJH-85) YES -- ERROR
	DAC	EPS	/(MJH-85) NO -- SAVE EFFECTIVE PARTITION SIZE
	TCA		/(MJH-85) NEGATE AND SAVE FOR LATER USE
	DAC	TEMP1	/(MJH-85)
	LAC	SHFLAG	/(MJH-87) IS CORE SHARING ON?
	SNA		/(MJH-87)
	JMP	VEEPS1	/(MJH-87) NO
	LAC	EPS	/(MJH-85) YES -- SEE IF SAS<EPS
	TCA		/(MJH-85)
	TAD	SAS	/(MJH-85)
	SMA		/(MJH-85)
	JMP	VEEPS	/(MJH-85) NO -- SO VPS=EPS
	LAC	SAS	/(MJH-85) YES -- SO VPS=SAS
	JMP	VPSSET	/(MJH-85)
VEEPS1	LAC	XMFLAG	/(MJH-89) IS XVM MODE ON?
	SZA		/(MJH-89)
	JMP	VEEPS	/(MJH-89) YES -- THEN SET VPS=EPS SINCE NO SHR
	LAC	EPS	/(MJH-89) NO -- REDUCE VPS TO 32K IF EPS>32K
	TAD	(-100000
	SPA		/(MJH-89)
	JMP	VEEPS	/(MJH-89) SET VPS=EPS SINCE EPS<32K
	LAC	(100000
	JMP	VPSSET	/(MJH-89) SET VPS=32K SINCE EPS>32K
VEEPS	LAC	EPS	/(MJH-85)
VPSSET	DAC	VPS	/(MJH-85) SAVE VIRTUAL PARTITION SIZE
	AAC	-1	/(MJH-85) FIND TOP USEABLE ADDRESS IN PART
	TAD	PTBASE	/(MJH-85)
	DAC	MAXREG	/(MJH-85) SAVE IT
	JMP	FSCBD0	/(MJH-85)
/
TMBUF	JMS	ERR2	/(MJH-85) TOO MANY BUFFERS
	MES119		/(MJH-85)
	JMP	EXIT	/(MJH-85)
	.TITLE *** GET SHARED OR SYSTEM COMMON BLOCKS ***
/
	.IFUND	BATCH
FSCBD0	LAC	SHFLAG	/(MJH-85) IS SHARE ON?
	SNA		/(MJH-85)
	JMP	FCBD0	/(MJH-85) NO -- CHECK FOR SYSTEM COMMONS
	JMS	SHR.ON	/(MJH-85) YES -- SET SHR.SW TO SKP
	LAC	SAS	/(MJH-88) CALC BASE OF ESAS
	TAD	(400	/(MJH-88)
	DAC	ESAS	/(MJH-88)
	JMS	CRTN	/(MJH-85) ASK FOR SHARED COMMONS
	JMS	TYPE	/(MJH-85)
	MES25		/(MJH-85)
FSCBD	JMS	RFAN	/(MJH-85) READ A LINE AND FETCH NAME
	JMS	ZLLX	/(MJH-85) TEST FOR ZERO LENGHT LINE
	JMP	FRORCL	/(MJH-85) IT WAS SO GET RESIDENT CODE
	DZM	SHCSZ	/(MJH-85) ZERO OFFSET FOR NEXT SHARED COMMON
	LAC	ESAS	/(MJH-85) SET BASE FOR THIS COMMON
	DAC	SHCBS	/(MJH-85)
FSCBD1	JMS	NLEX	/(MJH-85) NAME LENGTH ERROR?
	JMP	FSCBD	/(MJH-85) YES
	JMS	NCL.CH	/(MJH-85) NO -- CONVERT NAME INTO RAD50
	JMS	NCL.SC	/(MJH-85) IS COMMON ALREADY IN NCL?
	SKP		/(MJH-85)
	JMP	FSCBDA	/(MJH-85) YES -- ERROR
	LAC	FANM	/(MJH-85) NO -- IS THIS BLANK COMMON?
	SAD	(563030	/(MJH-85)
	SKP		/(MJH-85)
	JMP	.+4	/(MJH-85)
	LAC	FANM+1	/(MJH-85)
	SNA		/(MJH-85)
	JMP	FSCBDA	/(MJH-85) YES -- ERROR
	LAC	FANB	/(MJH-85) NO -- GET BREAK CHAR
	SAD	(175	/(MJH-85) ALTMODE?
	JMP	FSCBD8	/(MJH-85) YES
	SAD	(54	/(MJH-85) NO -- COMMA?
	JMP	FSCBD8	/(MJH-85) YES
	SAD	(50	/(MJH-85) NO -- (?
	SKP		/(MJH-85) YES
	JMP	FSCBDB	/(MJH-85) NO -- ERROR
/
/ SO FAR NAME( HAS BEEN READ , LOOK FOR AN OCTAL NUMBER
/
	LAW	-1	/(MJH-85) SET UP TO GET OCATL NUM
	DAC	PRZLN		/(MJH-85)
	JMS	FOC		/(MJH-85) GO GET NUMBER
	ISZ	PRZLN		/(MJH-85) ANY CHARS TYPED?
	SKP			/(MJH-85)
	JMP	FSCBDB		/(MJH-85) NO -- ERROR
	SAD	(54		/(MJH-85) YES -- WAS BREAK A COMMA?
	JMP	FSCBD6		/(MJH-85) YES
	SAD	(51		/(MJH-85) NO -- )?
	SKP			/(MJH-85) YES
	JMP	FSCBDB		/(MJH-85) NO -- ERROR
/
/ NAME(#) HAS BEEN READ, POSITION COMMON
/
	LAC	SHCSZ		/(MJH-85) GET OFFSET FROM PREVIOUS COMMON
	TAD	SHCBS		/(MJH-85) ADD BASE OF PREVIOUS COMMON
	DAC	SHCBS		/(MJH-85) SAVE THE BASE OF THIS COMMON
	DAC	FDESB		/(MJH-85)
	TCA			/(MJH-85) NEGATE
	TAD	ESAS		/(MJH-85) ADD BASE OF ESAS
	TAD	(17400		/(MJH-85) ADD SIZE OF ESAS
	SPA			/(MJH-85) CHECK FOR COMMON OUT OF SAS
	JMP	FSCBDC		/(MJH-85) OUT OF SAS -- ERROR
	DAC	FDESZ		/(MJH-85) OK -- SAVE THE REAL SIZE OF THIS SHARED COMMON
	LAC	FOCA		/(MJH-85) GET THE OFFSET FOR NEXT COMMON
	SPA			/(MJH-85) POSITIVE?
	JMP	FSCBDD		/(MJH-85) NO -- ERROR
	DAC	SHCSZ		/(MJH-85) YES -- SAVE OFFSET FOR NEXT COMMON
	JMP	FSCBD7		/(MJH-85) GO ENTER DATA INTO NCL
/
/ NAME(#, HAS BEEN READ, GET OFFSET FOR NEXT COMMON
/
FSCBD6	LAC	FOCA		/(MJH-85) IS BASE WITHIN SAS?
	TAD	(400		/(MJH-85)
	SPA			/(MJH-85)
	JMP	FSCBDC		/(MJH-85) NO -- ERROR
	LAC	FOCA		/(MJH-85) YES -- GET BASE OF THIS COMMON
	TAD	ESAS		/(MJH-85)
	DAC	SHCBS		/(MJH-85) SAVE BASE OF THIS COMMON
	DAC	FDESB		/(MJH-85)
	TCA			/(MJH-85) HAS BASE EXCEEDED SAS?
	TAD	ESAS		/(MJH-85)
	TAD	(17400		/(MJH-85)
	SPA			/(MJH-85)
	JMP	FSCBDC		/(MJH-85) YES -- ERROR
	DAC	FDESZ		/(MJH-85) NO -- SAVE REAL SIZE OF COMMON
	LAW	-1		/(MJH-85) PREPARE TO GET OFFSET FOR NEXT COMMON
	DAC	PRZLN		/(MJH-85)
	JMS	FOC		/(MJH-85) GO GET OFFSET
	ISZ	PRZLN		/(MJH-85) WERE ANY CHARS TYPED?
	SKP			/(MJH-85)
	JMP	FSCBDB		/(MJH-85) NO -- ERROR
	SAD	(51		/(MJH-85) YES -- IS BREAK A )?
	SKP			/(MJH-85)
	JMP	FSCBDB		/(MJH-85) NO -- ERROR
	LAC	FOCA		/(MJH-85) YES -- IS OFFSET LEGAL?
	SPA			/(MJH-85)
	JMP	FSCBDD		/(MJH-85) NO -- ERROR
	DAC	SHCSZ		/(MJH-85) YES -- SAVE OFFSET FOR NEST COMMON
	JMP	FSCBD7		/(MJH-85) GO ENTER DATA INTO NCL
/
/ NAME BREAK HAS BEEN READ, POSITION COMMON
/
FSCBD8	LAC	SHCSZ		/(MJH-85) GET BASE OF THIS COMMON
	TAD	SHCBS		/(MJH-85)
	DAC	SHCBS		/(MJH-85) SAVE THE BASE
	DAC	FDESB		/(MJH-85)
	TCA			/(MJH-85) GET SIZE OF COMMON
	TAD	ESAS		/(MJH-85)
	TAD	(17400		/(MJH-85)
	SPA			/(MJH-85) IS IT WITHIN ESAS?
	JMP	FSCBDC		/(MJH-85)
	DAC	FDESZ		/(MJH-85) YES -- SAVE SIZE OF COMMON
	DZM	SHCSZ		/(MJH-85) SET OFFSET FOR NEXT COMMON TO 0
/
/ STORE DATA IN NCL
/
FSCBD7	JMS	NCL.CM		/(MJH-85) ENTER DATA INTO NCL
	LAC	FANB		/(MJH-85) GET BREAK CHAR
	SAD	(175		/(MJH-85) ALTMODE?
	JMP	FRORCL		/(MJH-85) YES -- GO GET RESIDENT CODE
	SAD	(54		/(MJH-85) NO -- COMMA?
	SKP			/(MJH-85)
	JMS	FAC		/(MJH-85) NOT COMMA -- READ NEXT CHAR
	DAC	FANB		/(MJH-85) SAVE BREAK CHAR
	SAD	(54		/(MJH-85) COMMA?
	JMP	FSCBD2		/(MJH-85) YES -- PREPARE TO GET NEXT SHARED COMMON
	JMS	AMBX		/(MJH-85) NO -- IF BREAK IS NOT ALTMODE ERROR
	JMP	FSCBD		/(MJH-85) ERROR
	JMP	FRORCL		/(MJH-85) OK -- GO GET RESIDET CODE
/
FSCBD2	JMS	FAN		/(MJH-85) READ A NAME
	JMP	FSCBD1		/(MJH-85) GO GET NUMERIC DATA
/
FSCBDA	LAC	(MES33	/(MJH-85) INCONSISTANT OPTION
	JMP	FSCBDZ		/(MJH-85)
FSCBDB	LAC	(MES103		/(MJH-85) ILLEGAL BREAK
	JMP	FSCBDZ		/(MJH-85)
FSCBDC	LAC	(MES119		/(MJH-85) OUT OF SAS
	JMP	FSCBDZ		/(MJH-85)
FSCBDD	LAC	(MES36		/(MJH-85) ILLEGAL SIZE
FSCBDZ	DAC	.+3		/(MJH-85)
	JMS	CRTN		/(MJH-85)
	JMS	TYPE		/(MJH-85)
	XX			/(MJH-85)
	JMP	FSCBD		/(MJH-85)
/
SHCSZ	0			/(MJH-85) OFFSET FOR NEXT SHARED COMMON
SHCBS	0			/(MJH-85) BASE OF PREVIOUS SHARED COMMON
	.EJECT
/
FCBD0	LAC	PRFLAG	/CHECK FOR PRIVILEDGED FLAG
	SNA		/SINCE NO SYSTEM COMMON IS ALLOWED FOR NPR TASK'S
	JMP	FRORCL	/NO SYSTEM COMMON ALLOWED
	JMS	CRTN	/REQUEST SYSTEM COMMON BLOCK DEFINITIONS
	JMS	TYPE
	MES24
FCBD    JMS     RFAN   /READ LINE AND FETCH 1ST NAME
        JMS     ZLLX   /ZERO LENGTH LINE?
        JMP     FRORCL /YES -- NO SYS COM BLOCKS
        LAC     (CBDBUF-1)/INITIALIZE BLOCK DEF STORAGE
	DAC*	(X12)
	DAC*	(X13)
	LAW	-20
	DAC	TEMP1
	DZM*	X13
	ISZ	TEMP1
	JMP	.-2
FCBD1	JMS	NLEX	/NO -- REJECT IF NAME LENGTH ERR
	JMP	FCBD
	JMS	NCL.CH		/(MJH-85) CONVERT NAME INTO RAD50
	JMS	NCL.SC		/(MJH-85) IS COMMON IN NCL ALREADY?
	SKP			/(MJH-85) NO -- OK
	JMP	FCBD4		/(MJH-85) YES -- ERROR
	.IFDEF	RSX
	CLC		/SET COMMON BLK. DEFIN. FLAG FOR FDES.
	DAC	SYCF
	.ENDC
	JMS	FDES	/FETCH DESCRIPTION (BASE, SIZE)
	JMP	FCBD	/REJECT IF ERROR
	LAC	FANM+0	/SAVE BLOCK NAME & DEFINITION
	DAC*	X12
	LAC	FANM+1
	DAC*	X12
	LAC	FDESB
	DAC*	X12
	LAC	FDESZ
	DAC*	X12
	JMS	FAC	/FETCH NEXT CHARACTER
	DAC	FANB
	SAD	(054)	/COMMA ?
	JMP	FCBD2	/YES -- ANOTHER DEFINITION FOLLOWS
	JMS	AMBX	/NO -- REJECT IF NOT ALTMODE
	JMP	FCBD
	JMP	FRORCL	/ALTMODE, NO MORE DEFINITIONS
/
FCBD2	LAC*	(X12)	/IS THERE ROOM TO STORE ANOTHER DEF?
	SAD	(CBDBUF+17)
	JMP	FCBD3
	JMS	FAN	/YES -- FETCH NAME
	JMP	FCBD1	/PROCESS DEFINITION
/
FCBD3	JMS	CRTN	/REJECT, TOO MANY DEFINITIONS
	JMS	TYPE
	MES34
	JMP	FCBD
/
FCBD4	JMS	CRTN		/(MJH-85) INCONSISTNAT OPTION
	JMS	TYPE		/(MJH-85)
	MES33			/(MJH-85)
	JMP	FCBD		/(MJH-85)
/
	.TITLE ***  NAMED COMMON LIST (NCL) BUILD AND ALTER ROUTINES
/+
/ GLEANED FROM CHAIN 170 *********************
/
/ COMMON CODE USED  TO BUILD NEW AND MODIFY OLD
/ ENTRIES IN THE NCL. THE FORMAT OF THE NCL IS GIVEN IN THE GLOSSARY.
/ THIS ROUTINE ASSUMES THAT THE NAME TO BE SEARCHED FOR IS IN SIXBIT
/ FORMAT RESIDING IN CELLS FANM AND FANM+1.
/
/ CALL:
/
/	...			/SET UP FANM AND FANM+1
/	JMS NCL.CM		/SET UP NCL ACCORDING TO 
/				/SHR.SW, AND RES.SW.
/-
NCL.CM	XX			/ ENTRY POINT FOR NCL PROCESSOR.   
	JMS	NCL.CH		/SETUP SYM1 AND SYM2 TO SCAN NCL   
NCL.C1	JMS NCL.SC		/ CALL NCL SCANNER.   
	JMP NCL.C2		/ SCANNER INDICATES NAME NOT FOUND.   
NCL.C6	XCT SHR.SW		/ CHECK TO SEE IF JUST THIS NAME IS SHR.   
	JMP NCL.C4		/ NO, GO CHECK RES OPTIONS.   
NCL.C3	LAC* NCL.PT		/ FETCH WORD WITH SHR FLAG.   
	AND (577777)		/ TURN OFF SHR FLAG.   
	XOR (200000)		/ REENABLE SHR FLAG.   
	DAC* NCL.PT		/ RESTORE NEW VALUE OF SHR FLAG.   
NCL.C4	ISZ NCL.PT		/ POINT TO WORD WITH RES FLAG.   
	XCT RES.SW		/ IS THIS PARTICULAR COMMON TO BE RES?   
	JMP* NCL.CM		/ NO, RETURN TO CALLER.   
NCL.C5	LAC* NCL.PT		/ FETCH LIST ENTRY FROM LIST.   
	AND (377777)		/ TURN OFF RES SWITCH.   
	XOR (400000)		/ TURN ON RES SWITCH.   
	DAC* NCL.PT		/ RESTORE NEW SWITCH IN LIST.   
	JMP* NCL.CM		/ RETURN TO USER, ALL DONE.   
/+
/ THE NAMED COMMON DID NOT OCCUR IN THE NCL. MAKE A NEW ENTRY AND
/ REENTER NCL.CM CODE ABOVE.
/-
NCL.C2	LAC RCLBSE		/ FETCH POINTER TO NEXT AVAILABLE LIST   
				/ ENTRY.   
	DAC NCL.PT		/ SET UP POINTER TO IT.   
	LAC SYM1		/ FETCH 1ST HALF OF COMMON NAME.   
	DAC* RCLBSE		/ PUT IN LIST.   
	ISZ RCLBSE		/ BUMP LAST ADDRESS.   
	LAC SYM2		/ FETCH 2ND HALF OF COMMON NAME.   
	DAC* RCLBSE		/ PUT IN LIST.   
	ISZ RCLBSE		/ BUMP LAST ADDRESS.   
	XCT	SHR.SW		/(MJH-85) IS SHARE ON?
	JMP	NCL.C6		/(MJH-85) NO -- MAKE NEW ENTRY
	LAC	FDESB		/(MJH-85) YES -- ENDTER BASE AND SIZE OF SHARED COMMON
	DAC*	RCLBSE		/(MJH-85)
	ISZ	RCLBSE		/(MJH-85)
	LAC	FDESZ		/(MJH-85)
	DAC*	RCLBSE		/(MJH-85)
	ISZ	RCLBSE		/(MJH-85)
	JMP NCL.C6		/ GO SET SWITCHES APPROPRIATELY.  (MJH-85)
/
/ SUBROUTINE NCL.CH -- SET UP SYM1 AND SYM2 FOR SCANNING NCL
/
/ GLEANED FORM CHAIN 170 *********************
/
NCL.CH	XX			/(MJH-85)
	DZM	SYM2		/PREPARE FOR COMPARISON LOOP.   
	LAC FANM		/ FETCH THREE CHARACTERS OF COMMON NAME.   
	JMS CTR50		/ CONVERT TO RAD50 FORMAT.   
	DAC SYM1		/ SAVE IN SYM1 FOR COMPARISON.   
	LAC FANM+1		/ FETCH NEXT THREE CHARACTERS.   
	SNA			/ IS THE SECOND PART OF THE SYMBOL IMPORTANT?   
	JMP*	NCL.CH		/RETURN  
	JMS CTR50		/(RCHM-158) CONVERT TO RAD50.   
	DAC SYM2		/ SAVE SECOND HALF OF COMMON BLOCK NAME.   
	LAC SYM1		/ SET UP FIRST HALF OF GLOBAL NAME.   
	XOR (400000)		/ FLAG 2WORD NAME.   
	DAC SYM1		/ FINISH NCL SCANNER SETUP   
	JMP*	NCL.CH		/RETURN  (MJH-85)
	.ENDC
/
/ SUBROUTINE TO INITIALIZE THE NCL
/
/ GLEANED FROM CHAIN 170 *********************
/
RV.INT	XX			/ INITIALIZE NCL.  (MJH-85)
	JMS RES.OFF		/ TURN RES OFF.  (MJH-85)
	JMS SHR.OFF		/ TURN SHR OFF.  (MJH-85)
	.IFUND	RSX		/(MJH-85)
	LAC*	(.SCOM+2	/(MJH-85) GET BASE OF NCL
	.ENDC			/(MJH-85)
	.IFDEF	RSX		/(MJH-85)
	LAC	ENDTKB		/(MJH-85)
	.ENDC			/(MJH-85)
	DAC NCL.BS		/ SET UP BASE OF NCL.  (MJH-85)
	DAC RCLBSE		/ SET UP BASE OF RCL (LAST ADDRESS OF  (MJH-85)
				/ NCL).
	JMP* RV.INT		/ RETURN TO CALLER.  (MJH-85)
	.IFUND	BATCH
	.TITLE *** SUBROUTINE TO GET BASE AND SIZE OF PARTITION ***
/
/ FDES -- SUBROUTINE TO FETCH DESCRIPTION & LEAVE
/	  BASE & SIZE IN 'FDESB' & 'FDESZ'
/	  PRIVILEDGED FORMAT:  (BASE,SIZE)
/	  RETURN AT JMS+1 IF ERROR
/	  RETURN AT JMS+2 IF NO ERROR
/
/	  UNPRIVILEDGED FORMAT:	(SIZE)
/	  RETURN AT JMS+1 IF ERROR
/	  RETURN AT JMS+2 IF NO ERROR
/
/
/	IF FDES USED FOR SYSTEM COMMON BLOCK DEFINITION, MUST
/	SET SYCF TO NON-ZERO PRIOR TO CALLING FDES.  FDES REINIT.'S
/	SYCF TO ZERO ON EXIT.
/
/
FDES	0
	LAC	FANB	/ERR IF LAST BREAK WAS NOT LEFT PAREN
	.IFDEF	RSX
	SAD	(175)
	JMP	FDESRX	/ALTMODE
	.ENDC
	SAD	(050)
	SKP
	JMP	FDESX
	JMS	FOC	/FETCH OCTAL CONSTANT (BASE)
	SAD	(054)	/ERR IF BREAK IS NOT COMMA
	SKP
	JMP	FDESA
	CLA
	SAD	PRFLAG	/IS THIS PRIVILEDGED?
	JMP	FDESXA	/NO ERROR EXIT
	LAC	FOCA
	AND	(700377)	/CHK. FOR MULTIPLES OF 400 .
	SZA
	JMP	FILSZ	/ILLEGAL SIZE
	LAC	FOCA
	DAC	FDESB
	JMS	FOC	/FETCH OCTAL CONSTANT (SIZE)
	SAD	(051)	/ERR IF BREAK IS NOT RIGHT PAREN
	SKP
	JMP	FDESX
	LAC	FOCA
	AND	(700377)	/CHECK FOR MULTIPLES OF 400.
	SZA
	JMP	FILSZ	/ILLEGAL SIZE
	LAC	FOCA
	DAC	FDESZ
	JMP	FILSZA	/CHK. BASE+SIZE .
	.IFDEF	RSX
FDESRX	LAC	SYCF	/COMMON BLK. DEFIN.?
	SZA
	JMP	FDESXA	/YES.  ERROR.  MUST SPEC. BASE AND SIZE
	LAC	FANM	/PICK UP THE PARTITION NAME
	DAC	PIFNAM	/SET IT IN THE PARTITION INF REQUEST
	LAC	FANM+1	/PICK UP THE SECOND HALF
	DAC	PIFNAM+1
	CAL	PIFCPB	/DO A PARTITION INFORMATION ON THIS PARTITION
	LAC	PIFEV	/PICK UP THE EVENT VARIABLE
	SPA		/DOES THE PARTITION EXIST?
	JMP	FNNF	/NO -- ERROR TRY AGAIN
	LAC	PRFLAG	/IS THIS TASK PRIVILEDGED?
	SNA
	DZM	FDESB	/NO -- CLEAR THE BASE ADDRESS POINTER
	.ENDC
FILSZA	LAC	PRFLAG		/(MJH-85) IS TASK EXEC MODE?
	SZA			/(MJH-85)
	JMP	FILSZB		/(MJH-85) YES
	LAC	FDESZ		/(MJH-85)NO -- IF PART SIZE <128K?
	SPA			/(MJH-85)
	JMP	FILSZ		/(MJH-85) NO -- ERROR
	ISZ	FDES		/(MJH-85) YES -- GOOD
	JMP	FDESXT		/(MJH-85)
FILSZB	LAC	FDESB	/YES.  BE SURE BASE+SIZE L.E. 32K.  (MJH-85)
	TAD	FDESZ
        TAD     (-100000)
        SMA!SZA
	JMP	FILSZ	/STRADDLES 32K BOUND.  ERROR!!!!
	ISZ	FDES	/RETURN NO ERROR
	JMP	FDESXT
	.IFDEF	RSX
FNNF	JMS	TYPE	/ERROR
	MES35
	JMS	CRTN
	JMP	FDESXT
SYCF	0		/SYSTEM COMMON BLK. DEFIN. FLAG.
	.ENDC
/
FILSZ	JMS	TYPE
	MES36
	JMS	CRTN
	JMP	FDESXT
/
/
FDESA	SAD	(051)	/IS IT A RIGHT PAREN?
	SKP		/YES OK
	JMP	FDESX	/NO ERROR
	LAC	PRFLAG	/CHECK PRIVILEDGED FLAG
	SZA
	JMP	FDESX	/YES ERROR
	LAC	FOCA
	AND (377)		/CHECK FOR MULTIPLE OF 400		/(096)
	SZA			/OCTAL FOR SIZE OF NON PRIVILEDGED	/(096)
	JMP FILSZ		/USER					/(096)
	LAC FOCA		/FETCH SIZE OF PARTITION.		/(096)
	DAC	FDESZ	/SET UP SIZE
	DZM	FDESB	/CLEAR BASE ADDRESS
	ISZ	FDES	/RETURN OK
	JMP	FDESXT
/
FDESXA	LAC	FOCB	/PICK UP THE BREAK CHARACTER
FDESX	DAC	FANB	/ERROR, TYPE MESSAGE AND
	JMS	ERR3	/RETURN AT JMS+1
	MES103
FDESXT=.
	.IFDEF	RSX
	DZM	SYCF	/REINIT. SYS. COMMON BLK. DEFIN. FLAG.
	.ENDC
	JMP*	FDES
/
FDESB	0		/BASE BUFFER
FDESZ	0		/SIZE BUFFER
	.TITLE *** FETCH OCTAL OR DECIMAL SUBROUTINES ***
/
/ FOC -- SUBROUTINE TO FETCH OCTAL CONSTANT
/
FOC	0
	DZM	FOCM		/(MJH-85) CLEAR MINUS SIGN FLAG
	DZM	FOCA	/CLEAR OCTAL ASSEMBLY REGISTER
FOC1	JMS	FAC	/FETCH & SAVE CHAR
	DAC	FOCB
	SAD	(55		/(MJH-85) IS CHAR A MINUS?
	JMP	FOC3		/(MJH-85) YES
	AND	(007)
	DAC	FOCC
	LAC	FOCB
	AND	(170)
	SAD	(060)
	JMP	FOC2
FOC4	LAC	FOCM		/(MJH-85) HAS MINUS BEEN READ?
	SNA			/(MJH-85)
	JMP	FOC5		/(MJH-85) NO
	LAC	FOCA		/(MJH-85) YES -- NEGATE RESULT
	TCA			/(MJH-85)
	DAC	FOCA		/(MJH-85)
FOC5	LAC	FOCB		/(MJH-85)
	JMP*	FOC
/
FOC2	LAC	FOCA
	JMS	LCS3
	AND	(777770)
	XOR	FOCC
	DAC	FOCA
	DZM	PRZLN		/(MJH-85) CHAR NUMERIC CHAR READ FLAG
	JMP	FOC1
FOC3	LAC	FOCM		/(MJH-85) IS THIS MINUS A BREAK?
	SZA			/(MJH-85)
	JMP	FOC4		/(MJH-85) YES -- GO EXIT
	LAC	PRZLN		/(MJH-85) HAS A NUMERIC CHAR BEEN READ?
	SNA			/(MJH-85)
	JMP	FOC4		/(MJH-85) YES -- MINUS IS A BREAK
	ISZ	FOCM		/(MJH-85) NO -- SET MINUS FLAG
	JMP	FOC1		/(MJH-85)
/
/
FOCM	0			/(MJH-85)
FOCA	0
FOCB	0
FOCC	0
/
/
/ FDC -- SUBROUTINE TO FETCH DECIMAL CONSTANT
/
FDC	0
	DZM	FOCA	/CLEAR OUT PREVIOUS CONSTANT
FDC1	JMS	FAC	/PICK UP A CHARACTER
	DAC	FOCB	/SAVE IT
	AND	(17)	/MASK OFF DECIMAL VALUE
	DAC	FOCC
	LAC	FOCB
	AND	(170)	/TEST TO SEE IF IN RANGE 1
	SAD	(60)
	JMP	FDC2
	SAD	(70)
	JMP	FDC2
	SAD	(71)
	JMP	FDC2
	LAC	FOCB
	JMP*	FDC
FDC2	LAC	FOCA	/PICK UP PREVIOUS VALUES
	CLL
	JMS	LCS3
	TAD	FOCA
	TAD	FOCA
	TAD	FOCC
	DAC	FOCA	/STORE NEW VALUE
	DZM	PRZLN	/SET NON-ZERO LENGTH LINE FOUND
	JMP	FDC1	/PICK UP ANOTHER DIGIT
/
	.TITLE *** GET RESIDENT CODE ***
/ READ ONE LINE OF RESIDENT CODE NAMES (MINIMUN, ONE NAME) AND
/ CONSTRUCT THE RESIDENT-CODE-LIST (RCL).
/ RCL ENTRY FORMAT:
/    INDICATOR WORD
/    ROUTINE NAME (TWO WORDS
/    .SIXBT RT FILLED WITH ZEROS)
/
FRORCL	JMS	CRTN		/REQUEST RESIDENT CODE LIST
	JMS	SHR.OF		/(MJH-85) TURN OFF SHR.SW
	JMS	TYPE
	MES50
	.ENDC
	.IFDEF	BATCH
FSCBD0=.
	.ENDC
	DZM	BTCHSW		/CAUSE RCL TO BEGIN AFTER FIRST SPACE
/
RCLSNL	LAC	RCLBSE		/START NEW LINE -- SET ENTRY
	DAC	LDTX1		/INDEX
	JMS	RFAN		/READ A LINE AND FETCH AN NAME
	LAC	FANM
	SZA			/ ERR 51 IF ZERO LENGTH LINE
	JMP	RCLBX		/ OTHERWISE, ERR 101 IF 0 OR 7 CHARACTER NAME
	LAC	FANM+1		/
	SNA			/ OTHERWISE, ACCEPT NAME
	JMP	.+4		/ AS NAME OF MAIN PROGRAM
RCL101	JMS	ERR1		/ IF COMMA OR ALTMODE BREAK
	MES101			/ CHARACTER
	JMP	RCLSNL
	LAC	FANB
	SAD	(175)
	SKP
	JMP	RCL101
	JMS	ERR1
	MES51
	JMP	RCLSNL
RCLBX	LAC	FANB		/BREAK CHARACTER TEST --
	SAD	(054)		/ERR 103 IF OTHER THAN
	JMP	RCLNX		/COMMA OR ALTMODE.
	SAD	(175)
	JMP	RCLNX
	JMS	ERR3
	MES103
	JMP	RCLSNL
RCLNX	LAC	RCLBSE		/ERR 118 IF NAME HAS
	JMS	LDTSCN		/ALREADY BEEN ENTERED IN RCL
	SPA
	JMP	.+4
	JMS	ERR2
	MES118
	JMP	RCLSNL
	LAC	FANI		/MAKE RCL ENTRY
	AND	(070)
	XOR	(100)
	DAC	FANI
	JMS	LDTENT
/
	LAC	FANB		/ALTMODE BREAK CHARACTER?
	SAD	(175)
	JMP	RCLLDT		/YES -- END OF LIST
/
	JMS	FAN		/NO -- FETCH ANOTHER NAME
	LAC	FANM		/ ERR 101 IF 0 OR 7 CHARS
	SZA
	JMP	RCLBX
	JMP	RCL101
/
	.TITLE *** END THE RCL ***
/
RCLLDT	LAC	LDTX1	/END RCL AND START LDT.  RCL WILL BE
	DAC	LDTBSE	/FOLLOWED BY AN INDICATOR FOR A LINK DEFINITION
	DAC	LDTLSX	/(001) EVEN IF THERE ARE NO LINK DEFINITIONS.
			/THIS IS NECESSARY WHEN RELOCATING THE RESIDENT
			/CODE (TERMINATES LIST SCAN IN SUBROUTINE RAO).
	.TITLE *** GET LINK DEFINITIONS ***
/
/ READ LINK DEFINITIONS (IF ANY) AND CONSTRUCT THE
/ LINK-DEFINITION-TABLE (LDT) FOLLOWING THE RCL.
/ LDT ENTRY FORMAT
/    INDICATOR -- SAME AS RCL
/    NAME -- SAME AS RCL
/
	.IFUND	BATCH
	JMS	CRTN
	JMS	TYPE		/TYPE --
	MES60			/"DESCRIBE LINKS & STRUCTURE"
	.ENDC
/
LDTSNL	DZM	LDTEIF		/START NEW LINE, SET E/I FLAG TO EXT.
	.IFDEF	BATCH
	JMP	RCO		/RESIDENT CODE ONLY
	.ENDC
	.IFUND	BATCH
	JMS	RFAN		/READ LINE AND FETCH FIRST NAME
	LAC	FANM		/ERR 101 IF 0 OR 7 CHAR NAME
	SZA
	JMP	LDTECX
	LAC	FANM+1	/INTERPRET ZERO LENGTH LINE AS 'RESIDENT ONLY' 
	SNA
	JMP	RCO
	JMS	ERR1
	MES101
	JMP	LDTRSL
LDTECX	LAC	FANB		/TEST FOR EQUALS OR COLON BREAK CHAR
	SAD	(075)		/ IF EQUAL SIGN -- LINK DEFINITION
	JMP	LDTSN1		/ IF COLON -- END LINK DEFINITIONS
	SAD	(072)		/ AND START OVERLAY DESCRIPTION
	JMP	LDTODT		/ IF OTHER -- ERR 103
	JMS	ERR3
	MES103
	JMP	LDTRSL
LDTSN1	LAC	RCLBSE		/SCAN RCL & LDT FOR NAME
	JMS	LDTSCN		/JUST FETCHED FROM COMMAND STRING
	SPA			/ERR 102 IF FOUND
	JMP	.+4
	JMS	ERR2
	MES102
	JMP	LDTRSL
	LAC	FANI		/TEST FETCHED NAME INDICATOR FOR
	AND	(020)		/BIT-13. ERR 113 IF 
	SNA			/SET. OTHERWISE, SET INDICATOR
	JMP	.+4		/FOR A LINK NAME LDT ENTRY.
	JMS	ERR2		/I.E., SET BIT-17 & CLEAR OTHERS.
	MES113
	JMP	LDTRSL
	CLA!IAC			/(MJH-85)
	DAC	FANI
	JMS	LDTENT		/ENTER INDICATOR & NAME IN LDT
/
LDTFAN	JMS	FAN		/FETCH ANOTHER NAME
	LAC	FANM		/ERR 101 IF 0 OR 7 CHAR NAME
	SZA
	JMP	.+4
	JMS	ERR1
	MES101
	JMP	LDTRSL
	LAC	FANB		/TEST FOR COMMA, ALTMODE, OR SLASH
	SAD	(054)		/BREAK CHARACTER. ERR 103 IF OTHER.
	JMP	LDTSFX
	SAD	(175)
	JMP	LDTSFX
	SAD	(057)
	JMP	LDTSSF
	JMS	ERR3
	MES103
	JMP	LDTRSL
LDTSSF	LAC	LDTEIF		/SLASH BREAK, ERR 103 IF
	SNA			/E/I FLAG IS ALREADY SET
	JMP	.+4		/INTERNAL.  OTHERWISE, SET E/I
	JMS	ERR3		/TO EXTERNAL 
	MES103
	JMP	LDTRSL
	ISZ	LDTEIF
	JMP	LDTSN3
/
LDTSFX	LAC	LDTEIF		/COMMA OR ALTMODE BREAK, TEST FOR
	SNA			/SLASH READ
	JMP	LDTSN3
	LAC	FANI		/INTERNAL COMPONENT NAME -- ERR 115
	AND	(020)		/IF LIBRARY INDICATOR
	SNA
	JMP	.+4
	JMS	ERR2
	MES115
	JMP	LDTRSL
	LAC	RCLBSE		/SCAN BOTH
LDTSN2	JMS	LDTSCN		/RCL & LDT FOR NAME.  ERR 116
	SPA			/IF NAME IS FOUND AND IS NOT
	JMP	LDTSN4		/ALSO AN INTERNAL COMPONENT
	DAC	TEMP1		/NAME
	LAC*	TEMP1
	AND	(004)
	SNA
	JMP	.+4
	LAC	TEMP1
	TAD	LDTESZ
	JMP	LDTSN2
	JMS	ERR2
	MES116
	JMP	LDTRSL
/
LDTSN4	LAC	LDTLSX		/ERR 104 IF NAME IS FOUND IN 
	JMS	LDTSCN		/CURRENT LINE
	SMA
	JMP	.+3
	LAC	(004)		/(BIT-15 FOR INT SUB NAME)
	JMP	LDTEN2
	JMS	ERR2
	MES104
	JMP	LDTRSL
LDTSN3	LAC	FANI		/EXTERNAL COMPONENT NAME -- ERR 114
	AND	(020)		/IF LIBRARY INDICATOR
	SNA
	JMP	.+4
	JMS	ERR2
	MES114
	JMP	LDTRSL
	LAC	RCLBSE		/SCAN RCL & LDT FOR NAME, ERR 105
	JMS	LDTSCN		/IF FOUND.
	SMA
	JMP	.+3
	LAC	(002)		/(BIT-16 FOR EXT SUB NAME)
	JMP	LDTEN2
	JMS	ERR2
	MES105
	JMP	LDTRSL
LDTEN2	XOR	FANI		/SET INDICATOR AND MAKE
	DAC	FANI		/LDT ENTRY
	JMS	LDTENT
	LAC	FANB		/END OF LINE?
	SAD	(175)
	SKP
	JMP	LDTFAN		/NO -- FETCH ANOTHER NAME
	LAC	LDTX1		/YES -- UPDATE LINE START
	DAC	LDTLSX		/INDEX AND START A NEW
	JMP	LDTSNL		/LINE
/
LDTRSL	LAC	LDTLSX	/ERROR DETECTED, RESTART LOGICAL LINE
	DAC	LDTX1
	JMP	LDTSNL
	.ENDC
	.TITLE *** LDT MANIPULATION SUBROUTINES ***
/
/ LDTENT -- SUBROUTINE TO MAKE A RCL OR LDT ENTRY.
/           THE INDICATOR AND NAME ARE TAKEN FROM FANI, FANM,
/           & FANM+1.
/           LDTX1 IS UPDATED TO POINT TO THE NEXT LDT ENTRY
/
LDTENT	0
	LAC	FANI
	JMS	LDTENS
	LAC	FANM
	JMS	LDTENS
	LAC	FANM+1
	JMS	LDTENS
	JMP*	LDTENT
/
LDTENS	0
	DAC*	LDTX1
	.IFDEF	RSX
	LAC	LDTX1	/CHECK FOR CORE OVERFLOW
	SAD	ENDPAR	/IS THE PARTITION TOO SMALL?
	JMP	ERR7	/YES TELL USER TO TRY A BIGGER PARTITION
	.ENDC
	ISZ	LDTX1
	JMP*	LDTENS
/
/ LDTSCN -- SUBROUTINE TO SCAN THE RCL OR LDT FOR
/           THE NAME CONTAINED IN FANM & FANM+1.  THE SCAN 
/           START INDEX IS TAKEN FROM AC.  IF NAME IS
/           FOUND, THE LDT ENTRY INDEX IS RETURNED IN AC.
/           IF NOT FOUND, AC IS SET TO -1
/           TEMP1 IS USED TO SCAN ENTRIES
/           TEMP2 IS USED TO SCAN WITHIN ENTRIES
/
LDTSCN	0
LDTSC1	SAD	LDTX1	/TEST FOR END OF TABLE
	JMP	LDTSC3
	DAC	TEMP1
	DAC	TEMP2
	ISZ	TEMP2	/COMPARE TWO WORD NAME
	LAC*	TEMP2
	SAD	FANM
	SKP
	JMP	LDTSC2	/FIRST WORD, NO MATCH
	ISZ	TEMP2
	LAC*	TEMP2
	SAD	FANM+1
	SKP
	JMP	LDTSC2	/SECOND WORD, NO MATCH
	LAC	TEMP1	/NAME MATCH, EXIT WITH AC CONTAINING THE
	JMP*	LDTSCN	/INDEX OF ENTRY WITH MATCHING NAME.
/
LDTSC2	LAC	TEMP1	/NO MATCH, AUGMENT ENTRY INDEX
	TAD	LDTESZ
	JMP	LDTSC1
/
LDTSC3	LAW	-1	/NAME NOT FOUND IN LDT, EXIT WITH
	JMP*	LDTSCN	/AC=-1
	.IFUND	BATCH
/
	.TITLE *** END THE LDT ***
/
LDTODT	CLA!IAC		/TERMINATE LDT WITH AN INDICATOR FOR A  (MJH-85)
	DAC*	LDTX1	/LINK DEFINITION.
	LAC	LDTX1	/INITIALIZE ODT
	IAC		/(MJH-85)
	DAC	ODTX1	/ODT IS PRECEDED BY AN ALTMODE TO PROVIDE
	LAC	(175)	/A 'PREVIOUS BREAK CHARACTER' FOR THE
	DAC*	ODTX1	/FIRST ODT ENTRY.
	ISZ	ODTX1
	LAC	ODTX1
	DAC	ODTBSE
	DAC	ODTLSX
	JMP	ODTSN1
	.TITLE *** CONSTRUCT THE ODT ***
/
/ READ OVERLAY DESCRIPTION COMMANDS AND CONSTRUCT THE
/ OVERLAY DESCRIPTION TABLE (ODT) FOLLOWING THE LDT.
/ ODT ENTRY FORMAT:
/    INDICATOR--SAME AS IN LDT
/    NAME--SAME AS IN LDT
/    REGISTER USED WHEN PROCESSING LDT (BACK POINTER)
/    BREAK CHARACTER (IMAGE ALPHA)
/
ODTSNL	NOP			/START NEW LINE
	JMS	RFAN		/READ COMMAND LINE  & FETCH FIRST NAME
	LAC	FANM		/TEST FOR NAME SIZE ERROR
	SZA
	JMP	ODTCX1
	LAC	FANM+1		/NAME SIZE ERROR -- IF ZERO
	SNA			/LENGTH NAME & ALTMODE BREAK
	JMP	.+4		/(I.E., ZERO LENGTH LINE), TERMINATE
ODT101	JMS	ERR1		/ODT, OTHERWISE ERR 101
	MES101
	JMP	ODTRSL
	LAC	FANB
	SAD	(175)
	SKP
	JMP	ODT101
	LAC	ODTX1		/ZERO LENGTH LINE, TERMINATE
	SAD	ODTBSE		/ODT, UNLESS ZERO LENGTH ODT.
	JMP	ODT101
	JMP	ODTTTL
ODTCX1	LAC	FANB		/BREAK FOLLOWING FIRST NAME MUST
	SAD	(072)		/BE A COLON--ERROR IF NOT.
	JMP	ODTSN1		/  EQUAL SIGN, ERR 107
	SAD	(075)		/  OTHER, ERR 108
	JMP	.+4
	JMS	ERR1
	MES108
	JMP	ODTRSL
	JMS	ERR1
	MES107
	JMP	ODTRSL
/
ODTFAN	JMS	FAN		/FETCH ANOTHER NAME
	LAC	FANM		/ERR 101 IF 0 OR 7 CHAR NAME
	SNA
	JMP	ODT101
ODTSN1	LAC	RCLBSE		/SCAN RCL & LDT FOR NAME
	JMS	LDTSCN
	SMA
	JMP	ODTS1A
	LAC	FANI		/NOT FOUND -- CONSIDER EXTERNAL NAME
	AND	(757)		/ERR 114 IF LIB IND ON EXTERNAL COMP NAME
	SAD	FANI
	JMP	.+4
	JMS	ERR2
	MES114
	JMP	ODTRSL
	XOR	(002)		/SET BIT (16) IN FETCHED NAME INDICATOR
	DAC	FANI
	JMP	ODTCX2
/
ODTS1A	DAC	TEMP1		/NAME FOUND--
	LAC*	TEMP1		/ ERR 106 IF NAME IS A LINK COMPONENT
	AND	(100)		/ERR 117 IF NAME OF RESIDENT ROUTINE
	SNA
	JMP	.+4
	JMS	ERR2
	MES117
	JMP	ODTRSL
	LAC*	TEMP1
	AND	(001)		/ERR 113 IF NAME IS A LINK NAME
	SZA			/ AND A LIBRARY INDICATOR WAS
	JMP	.+4		/ KEYED IN.
	JMS	ERR2		/ OTHERWISE, ACCEPT NAME AND
	MES106			/ SET INDICATOR BIT-17 (CLEAR OTHERS)
	JMP	ODTRSL		/ IN NAME FETCH INDICATOR (PREPARE
	LAC	FANI		/ FOR OTD ENTRY
	AND	(020)
	SNA
	JMP	.+4
	JMS	ERR2
	MES113
	JMP	ODTRSL
	CLA!IAC			/(MJH-85)
	DAC	FANI
ODTCX2	LAC	FANB		/TEST BREAK CHARACTER FOR COLON.
	SAD	(072)		/COMMA OR ALTMODE.
	JMP	ODTLC		/ERR 103 IF OTHER
	SAD	(054)
	JMP	ODTRC
	SAD	(175)
	JMP	ODTRC
	JMS	ERR3
	MES103
	JMP	ODTRSL
ODTRC	LAC	ODTBSE		/BREAK CHARACTER IS COMMA OR ALTMODE.
	JMS	ODTSCN		/SINCE FIRST NAME MUST BE FOLLOWED
	SPA			/BY A COLON, THIS NAME MUST FOLLOW
	JMP	ODTE1		/A COLON.  A NAME MAY APPEAR ONCE
	JMS	ERR2		/ON THE RIGHT OF A COLON AND IF
	MES110			/USED LEFT OF A COLON IT MUST
	JMP	ODTRSL		/HAVE BEEN USED ON THE RIGHT FIRST.
				/THEREFORE, ERR 110 IF NAME IS
				/ALREADY IN THE ODT.
/
ODTLC	LAC	ODTX1		/COLON BREAK CHAR, I.E., NAME IS
	AAC	-1		/USED LEFT OF COLON -- TEST PREVIOUS  (MJH-85)
	DAC	TEMP1		/BREAK CHARACTER FOR COLON OR
	LAC*	TEMP1		/ALTMODE.  ERR 109 IF OTHER.
	SAD	(072)
	JMP	ODTCNC
	SAD	(175)
	JMP	ODTANC
	JMS	ERR1
	MES109
	JMP	ODTRSL
ODTCNC	LAC	ODTBSE		/COLON-NAME-COLON  NAME USED BOTH
	JMS	ODTSCN		/RIGHT & LEFT OF COLONS, AND
	SPA			/SHOULD NOT APPEAR AGAIN
	JMP	ODTE1		/IN THE ODT. ERR 111 IF FOUND
	JMS	ERR2
	MES111
	JMP	ODTRSL
ODTANC	LAC	ODTBSE		/ALTMODE-NAME-COLON  NAME IS USED
	JMS	ODTSCN		/LEFT OF COLON.  THEREFORE IF NAME
	SPA			/CAN BE FOUND IN THE ODT, IT MUST
	JMP	ODTE1		/BE RIGHT OF A COLON AND NOT ALSO
	AAC	-1		/LEFT OF A COLON (I.E., IT MUST  (MJH-85)
	TAD	ODTESZ		/NOT HAVE A COLON BREAK).  ERR 112
	DAC	TEMP1		/IF NAME IS FOUND WITH COLON BREAK.
	LAC*	TEMP1
	ISZ	TEMP1
	SAD	(072)
	SKP
	JMP	.+4
	JMS	ERR2
	MES112
	JMP	ODTRSL
	LAC	TEMP1		/NAME FOUND, BUT RIGHT OF COLON ONLY.
	JMS	ODTSCN		/CONTINUE ODT SCAN, ERR 111 IF
	SPA			/NAME IS FOUND AGAIN.
	JMP	ODTE1
	JMS	ERR2
	MES111
	JMP	ODTRSL
/
ODTE1	JMS	ODTENT		/MAKE ODT ENTRY
	LAC	FANB		/END OF LINE?
	SAD	(175)
	SKP
	JMP	ODTFAN		/NO -- FETCH ANOTHER NAME
	LAC	ODTX1		/YES -- UPDATE LINE START
	DAC	ODTLSX		/INDEX AND START A NEW
	JMP	ODTSNL		/LINE
/
ODTRSL	LAC	ODTLSX	/ERROR DETECTED -- HAS A LINE OF OVERLAY 
	SAD	ODTBSE	/DESCRIPTION BEEN ACCEPTED?
	JMP	LDTRSL	/NO -- RESTART LINE OF LINK DEFINITION
	DAC	ODTX1	/YES -- RESTART LINE OF OVERLAY DESCRIPTION
	JMP	ODTSNL
	.TITLE *** ODT MANIPULATION SUBROUTINES ***
/
/ ODTENT -- SUBROUTINE TO MAKE AN OVERLAY-DESCRIPTION-TABLE ENTRY.
/	    THE INDICATOR, NAME, & BREAK CHARACTER ARE
/	    TAKEN FROM FANI, FANM, FANM+1, & FANB
/	    ODTX1 IS UPDATED TO POINT TO THE NEXT ODT ENTRY
/
ODTENT	0			/FORMAT: INDICATOR
	LAC	FANI		/         NAME
	JMS	ODTENS		/         NAME
	LAC	FANM		/         ZERO
	JMS	ODTENS		/         BREAK
	LAC	FANM+1
	JMS	ODTENS
	CLA
	JMS	ODTENS
	LAC	FANB
	JMS	ODTENS
	JMP*	ODTENT
/
ODTENS	0
	DAC*	ODTX1
	.IFDEF	RSX
	LAC	ODTX1	/PICK UP THE POINTER TO THE LOCATION USED
	SAD	ENDPAR	/IS THIS THE END OF THE PARTITION?
	JMP	ERR7	/YES PARTITION TOO SMALL FOR THIS STRUCTURE
	.ENDC
	ISZ	ODTX1
	JMP*	ODTENS
/
/ ODTSCN -- SUBROUTINE TO SCAN THE OVERLAY-DESCRIPTION-TABLE
/	    FOR THE NAME CONTAINED IN FANM & FANM+1.  THE
/	    SCAN START INDEX IS TAKEN FROM AC.  IF NAME
/	    IS FOUND, THE LDT ENTRY INDEX IS LEFT IN AC.
/	    IF NOT FOUND, AC IS SET TO -1.
/             TEMP1 IS USED TO SCAN ENTRIES
/             TEMP2 IS USED TO SCAN WITHIN ENTRIES
/
ODTSCN	0
ODTSC1	SAD	ODTX1		/TEST FOR END OF TABLE
	JMP	ODTSC3
	DAC	TEMP1
	DAC	TEMP2
	ISZ	TEMP2		/COMPARE TWO WORDS
	LAC*	TEMP2
	SAD	FANM
	SKP
	JMP	ODTSC2		/FIRST WORD, NO MATCH
	ISZ	TEMP2
	LAC*	TEMP2
	SAD	FANM+1
	SKP
	JMP	ODTSC2		/SECOND WORD, NO MATCH
	LAC	TEMP1		/NAME MATCH, EXIT WITH AC CONTAINING THE
	JMP*	ODTSCN		/INDEX OF ENTRY WITH MATCHING NAME
ODTSC2	LAC	TEMP1		/NO MATCH, AUGMENT ENTRY INDEX
	TAD	ODTESZ
	JMP	ODTSC1
ODTSC3	LAW	-1		/NOT FOUND, EXIT WITH AC=-1
	JMP*	ODTSCN
/
	.TITLE *** END THE ODT ***
/
ODTTTL	LAC	ODTX1	/END OF ODT, START TTL
	DAC	TTLBSE
	DAC	TTLX1
	JMP	TTLSNL
	.TITLE *** CONSTRUCT THE TTL ***
/
/ PROCESS ODT TO BUILD "TRUNK-TO-TWIG LISTS" (TTL'S).
/ ONE LIST FOR EACH SET OF "LINKS WITH SOME COMMON CORE".
/ EACH LIST BEGINS WITH A LINK THAT IS NOT DEFINED AS OVERLAYING
/ ANOTHER LINK (TRUNK), FOLLOWED BY LINKS THAT ARE DEFINED AS 
/ BOTH OVERLAYING AND OVERLAYED (IF ANY), AND ENDING WITH
/ A LINK THAT IS NOT DEFINED AS OVERLAYED BY ANOTHER LINK (TWIG).
/ TTL ENTRY FORMAT (3 WDS):
/    INDICATOR -- SAME AS IN LDT
/    LINK NAME -- SAME AS IN LDT
/ EACH LIST IS TERMINATED BY ONE WORD SET TO -1
/
TTLSNL	LAW	-1	/START NEW LIST -- SET POINTER TO -1
	DAC	TTLPNT
	LAC	ODTBSE	/SET TTLX2 TO POINT TO FIRST ODT ENTRY
	DAC	TTLX2
TTLFO1	LAC	TTLX2	/FETCH ODT ENTRY PER TTLX2
	JMS	TTLFOE
	LAC	TTLOEN	/BLANK (ZERO) NAME?
	SZA
	JMP	TTLE1	/NO -- ENTER INDICATOR AND NAME IN TTL
	LAC	TTLX2	/YES -- TEST FOR END OF ODT.  IF NOT, FETCH
	TAD	ODTESZ	/ANOTHER ODT ENTRY
	DAC	TTLX2	/IF END OF ODT AND THE ENTIRE ODT HAS NOT BEEN
	SAD	ODTX1	/BLANKED (ZEROED), TERMINATE THIS TLL
	SKP		/AND PROCEDE TO START ANOTHER TTL
	JMP	TTLFO1	/IF ENTIRE ODT HAS BEEN BLANKED (POINTER=-1)
	LAC	TTLPNT	/ALL TTL'S HAVE BEEN MADE.
	SMA
	JMP	TTLTRM
	JMP	TTLLTB
/
TTLE1	LAC	TTLOEI	/NON-BLANK  NAME FOUND -- ENTER INDICATOR
	JMS	TTLENT	/AND NAME IN TTL
	LAC	TTLOEN
	JMS	TTLENT
	LAC	TTLOEN+1
	JMS	TTLENT
/
TTLSP1	LAC	TTLX2	/SET POINTER IN ODT, SET ODT ENTRY
	AAC	3	/INDEX THE POINTER, AND AUGMENT ODT INDEX  (MJH-85)
	DAC	TEMP1
	LAC	TTLPNT
	DAC*	TEMP1
	LAC	TTLX2
	DAC	TTLPNT
	TAD	ODTESZ
	DAC	TTLX2
	LAC	TTLOEB	/SEARCH FOR AN OVERLAYING LINK.  IF A 
	SAD	(072)	/COLON BREAK CHAR, AN OVERLAYING LINK
	JMP	TTLFO1	/FOLLOWS IN ODT.  OTHERWISE, REMAINDER
	LAC	TTLOEN	/ODT MUST BE SEARCHED.
	DAC	TEMP3
	LAC	TTLOEN+1
	DAC	TEMP4
TTLOS1	LAC	TTLX2	/SCAN ODT FOR NAME IN TEMP3 & TEMP4
	SAD	ODTX1
	JMP	TTLTRM	/NOT FOUND, TERMINATE TTL & BLANK NAME
	JMS	TTLFOE
	LAC	TTLOEN
	SAD	TEMP3
	SKP
	JMP	TTLOS2
	LAC	TTLOEN+1
	SAD	TEMP4
	JMP	TTLSP1	/NAME FOUND, SET POINTER IN ODT AND 
			/SEARCH FOR ANOTHER OVERLAYING LINK.
TTLOS2	LAC	TTLX2
	TAD	ODTESZ
	DAC	TTLX2
	JMP	TTLOS1
/
TTLTRM	LAW	-1	/TERMINATE A TTL
	JMS	TTLENT
/
TTLBE1	LAC	TTLPNT	/SAVE POINTER-1 (TO FETCH PREVIOUS
	DAC*	(X10)	/BREAK CHAR), BLANK (ZERO) NAME IN ODT
	AAC	-1	/ENTRY INDICATED BY POINTER, AND NEW  (MJH-85)
	DAC	TEMP1	/POINTER FROM BLANKED ODT ENTRY.
	DZM*	X10
	DZM*	X10
	LAC*	X10
	DAC	TTLPNT
/
TTLBE2	LAC*	TEMP1	/SCAN PREVIOUS BREAK CHARACTERS TIL A
	SAD	(072)	/COLON OR ALTMODE IS FOUND.
	JMP	TTLBE3
	SAD	(175)
	JMP	TTLBE3
	LAC	TEMP1
	TAD	ODTMES
	DAC	TEMP1
	JMP	TTLBE2
/
TTLBE3	LAC	TEMP1	/SCAN ODT FROM NAME FOLLOWING COLON OR
	IAC		/ALTMODE THRU A NAME TERMINATED BY COLON
	DAC	TTLX2	/OR ALTMODE FOR A NON-BLANK NAME.  IF NOT
TTLBE4	JMS	TTLFOE	/FOUND, FOLLOW POINTER BACK TO BLANK THE
	LAC	TTLOEN	/NAME OF THE LINK OVERLAYED BY THIS
	SZA		/LINK OR GROUP OF LINKS.
	JMP	TTLSNL	/IF FOUND, START NEW LIST
	LAC	TTLOEB
	SAD	(072)
	JMP	TTLBE5
	SAD	(175)
	JMP	TTLBE5
	LAC	TTLX2
	TAD	ODTESZ
	DAC	TTLX2
	JMP	TTLBE4
/
TTLBE5	LAC	TTLPNT
	SMA
	JMP	TTLBE1
	JMP	TTLSNL
	.TITLE *** TTL MANIPULATION SUBROUTINES ***
/
/ TTLFOE -- SUBROUTINE TO FETCH THE ODT ENTRY WHOSE INDEX IS IN AC.
/           THE ENTRY IS LEFT IN THE FIVE FOLLOWING REGISTERS:
/
TTLOEI	0	/INDICATOR
TTLOEN	.BLOCK 2	/NAME
TTLOEP	0	/POINTER
TTLOEB	0	/BREAK CHAR
/
TTLFOE	0
	AAC	-1		/(MJH-85)
	DAC*	(X10)
	LAC	(TTLOEI-1)
	DAC*	(X11)
	LAW	-5
	DAC	TTLFOC
TTLFOL	LAC*	X10
	DAC*	X11
	ISZ	TTLFOC
	JMP	TTLFOL
	JMP*	TTLFOE
/
TTLFOC	0
/
/ TTLENT -- SUBROUTINE TO ENTER THE WORD IN AC IN TTL
/
TTLENT	0
	DAC*	TTLX1
	.IFDEF	RSX
	LAC	TTLX1	/PICK UP THE POINTER TO THE LAST LOCATION USED
	SAD	ENDPAR	/IS THIS THE END OF THE PARTITION?
	JMP	ERR7	/YES PARTITION TOO SMALL FOR THIS STRUCTURE
	.ENDC
	ISZ	TTLX1
	JMP*	TTLENT
	.ENDC
/
	.TITLE *** MISC. SUBROUITNES ***
/ NLEX -- SUBROUTINE TO TEST FOR A NAME LENGTH ERROR
/	  IF OTHER THAN 1-6 CHARACTER NAME, TYPE ERROR
/	  MESSAGE AND RETURN AT JMS+1.
/	  IF 1-6 CHAR NAME, RETURN AT JMS+2 WITH
/	  FIRST HALF OF NAME IN AC
/
NLEX	0
	LAC	FANM+0
	SZA
	JMP	.+4
	JMS	ERR1
	MES101
	JMP*	NLEX
	ISZ	NLEX
	JMP*	NLEX
/
/ AMBX -- SUBROUTINE TO TEST FOR ALTMODE BREAK
/	  IF NON-ALTMODE BREAK, TYPE ERROR
/	  MESSAGE AND RETURN AT JMS+1
/	  IF ALTMODE BREAK, RETURN AT JMS+2
/
AMBX	0
	LAC	FANB
	SAD	(175)
	JMP	.+4
	JMS	ERR3
	MES103
	JMP*	AMBX
	ISZ	AMBX
	JMP*	AMBX
	.EJECT
/
/ RFAN -- SUBROUTINE TO READ A COMMAND LINE (LOGICAL) AND
/	  FETCH THE FIRST NAME. I.E. TO SET THE FOUR
/	  FOLLOWING WORDS. THE BREAK CHARACTER IS LEFT IN AC.
/		FANI	INDICATOR
/		FANM	6-SIX BIT CHARACTER NAME (TWO WORDS)
/		FANM+1
/		FANB	BREAK CHARACTER (TERMINATING NAME)
/	  INDICATOR BITS SET AS FOLLOWS:
/		BIT-14 USER FILE
/		BIT-13 USER LIBRARY
/		BIT-12 SYSTEM LIBRARY
/	NAME IS RIGHT JUSTIFIED, LEFT FILLED WITH ZEROS.
/	FANM IS SET ZERO TO INDICATE A NAME LENGTH ERROR.
/	FANM+1 IS SET: 0 FOR ZERO LENGTH NAME
/	FANM+1 IS SET -1 FOR LENGTH GREATER THAN SIX CHAR
/
FANI	0		/FILE SOURCE INDICATOR
FANM	.BLOCK	2	/FILE NAME BUFFER
FANB	0		/BREAK CHAR BUFFER
CBUF	.BLOCK	42	/COMMAND BUFFER (80 CHARACTERS)
	.ASCII <15>
/
RFAN	0
	.IFUND	BATCH
	.IFDEF	RSX
	CAL	ATTTO	/ATTACH TO OUTPUT TTY
	CAL	ATTCI	/ATTCH TO INPUT TTY
	.ENDC
	JMS	CRTN	/RETURN CARRIAGE
	JMS	TYPE	/TYPE ANGLE BRACKET
	CAGB
	.ENDC
	JMS	RFRD	/READ COMMAND LINE (PHYSICAL LINE)
	JMS	FAN	/FETCH FIRST NAME
	.IFUND	BATCH
	.IFDEF	RSX
	LAC	(CI)	/DETACH FROM TTY'S
	JMS	DETACH
	LAC	(TO)
	JMS	DETACH
	.ENDC
	.ENDC
	JMP*	RFAN	/EXIT
/
CAGB	.ASCII	/>/<175>
CHYP	.ASCII	/-/<175>
	.EJECT
/
RFRD	0		/SUBROUTINE TO READ A LINE AND RESET
	.IFUND	RSX
RFRDZ	.READ	CI,2,CBUF,34	/FACX1 & FACX2 IN FAC
	.WAIT	CI
	.ENDC
	.IFDEF	RSX
	.IFUND	BATCH
	CAL	RDCI
	JMS	WFEV
	LAC	(CI)	/LUN INCASE OF I/O ERROR
	LAC	SUX10	/RESTORE AUTO-INCR. 10.
	DAC*	(X10)
        LAC     SUX12
        DAC*    (X12)
        LAC     SUX13
        DAC*    (X13)
	.ENDC
	LAC	CBUF+2	/CHECK FOR ^Q EXIT
	AND	(774000)
	SAD	(104000)	/IS IT A ^Q?
	JMP	CPEXIT	/YES EXIT
	.ENDC
	LAC	(FACB+5)
	DAC	FACX1
	LAC	(CBUF+2)
	DAC	FACX2
	JMP*	RFRD
/
/SAVE REG. FOR X10 ABOVE.
/
	.IFDEF	RSX
	.IFUND BATCH
SUX10	0		/TEMP. FOR AUTO-INCR 10.
SUX12   0
SUX13   0
	.ENDC
	.ENDC
	.EJECT
/
/
/ FAN -- SUBROUTINE TO "FETCH A NAME". REGISTERS FANI, FANM, & FANB
/	 ARE SET AS DESCRIBED UNDER "RFAN".
/
FAN	0
	LAC	(010)		/SET INDICATOR BIT-14
	DAC	FANI		/TO INDICATE USER DEVICE SRC
	DZM	FANM
	DZM	FANM+1
	LAC	(FANBF-1)		/SETUP TO READ UP TO SIX CHARACTERS
	DAC*	(X10)		/INTO FANBF THRU FANBF+5
	LAW	-7
	DAC	FANX1
FAN1	JMS	FAC		/FETCH A CHARACTER
	SAD	(043)		/TEST FOR LIB INDICATOR (#)
	JMP	FAN5
	SAD	(072)		/BREAK CHARACTERS TEST --
	JMP	FAN2		/COLON
	SAD	(054)
	JMP	FAN2		/COMMA
	SAD	(075)
	JMP	FAN2		/EQUAL SIGN
	SAD	(057)
	JMP	FAN2		/SLASH
	SAD	(050)
	JMP	FAN2		/LEFT PAREN
	SAD	(051)
	JMP	FAN2		/RIGHT PAREN
	SAD	(175)
	JMP	FAN2		/ALTMODE
	AND	(077)		/MASK TO SIX-BIT
	DAC*	X10		/SAVE CHAR
	ISZ	FANX1
	JMP	FAN1
	DAC	FANB		/NAME TOO LONG--USE SEVENTH CHARACTER
	DZM	FANM		/AS BREAK CHAR, CLEAR FIRST NAME
	LAW	-1		/WORD AND SET SECOND NAME WORD
	DAC	FANM+1		/TO -1, AND EXIT
	JMP	FAN4
FAN2	DAC	FANB		/SAVE BREAK CHARACTER
	DZM*	X10		/CLEAR TRAILING CHARACTERS THRU
	ISZ	FANX1		/SEVENTH (EXTRA WORD TO SAVE CODE)
	JMP	.-2
	LAC	(FANBF-1)		/SETUP TO PACK SIX CHARACTERS
	DAC*	(X10)		/INTO FANM & FANM+1
	LAC	(FANM)
	DAC	FANX1
	LAW	-6
	DAC	FANX2
FAN3	LAC*	FANX1		/PACK NAME
	CLL
	JMS	LCS6
	XOR*	X10
	DAC*	FANX1
	LAC	FANX2
	SAD	(-4)
	ISZ	FANX1
	ISZ	FANX2
	JMP	FAN3
FAN4	LAC	FANB		/LOAD AC WITH BREAK CHARACTER
	JMP*	FAN		/AND EXIT
/
FAN5	LAC	(020)		/LIBRARY INDICATOR FOUND
	DAC	FANI		/SET INDICATOR BIT-13
	JMP	FAN1		/(CLEAR OTHER BITS)
/
FANX1	0
FANX2	0
FANBF	.BLOCK	7
	.EJECT
/
/ FAC -- SUBROUTINE TO FETCH A CHARACTER FROM THE COMMAND
/	 BUFFER AND LEAVE IT IN AC. IF CHAR IS A CARRIAGE
/	 RETURN, ANOTHER LINE WILL BE READ. IF CHAR IS
/	 AN ALTMODE (END OF LINE), IT WILL RETURNED FOR THIS
/	 AND ALL SUCCEEDING CALLS UNTIL A NEW LINE IS READ.
/          IF CHARACTER IS A BLANK, IT WILL BE IGNORED.
/	 FACX1 & FACX2 ARE RESET WHEN A NEW LINE IS READ.
/
FAC	0
FAC0	LAC	FACX1		/TEST FOR EMPTY CHARACTER FACB
	SAD	(FACB+5)
	JMP	FAC2
FAC1	LAC*	FACX1		/FETCH CHARACTER FROM FACB
	AND	(177)
	.IFDEF	BATCH
	PAL		/SAVE THE CHARACTER
	LAC	BTCHSW	/CHECK FOR BATCH MODE
	SZA
	JMP	NOBTCH	/NOT BATCH
	PLA		/RESTORE AC
	SAD	(040
	JMP	SPFND
	SAD	(15)	/CRRTN?
	LAC	(175)	/YES FORCE ALTMODE
	SAD	(175)	/CRRTN ? 
	JMP*	FAC	/RETURN
	JMP	FAC4	/IGNORE
SPFND	ISZ	BTCHSW	/SET UP TO SKIP NEXT TIME
	JMP	FAC4
NOBTCH	PLA		/RESTORE AC
	.ENDC
	SAD	(040)		/IGNORE BLANKS
	JMP	FAC4
	SAD	(015)		/IF THE CARRIAGE RETURN, READ A
	JMP	FAC3		/CONTINUATION LINE, TO FETCH CHARACTER.
	SAD	(175)		/AUGMENT FACB INDEX & EXIT, UNLESS
	JMP*	FAC		/CHARACTER WAS ALTMODE, THEN
	ISZ	FACX1		/EXIT WITHOUT AUGMENTING THE
	JMP*	FAC		/FACB INDEX.
/
FAC2	LAC*	FACX2		/UNPACK FIVE CHARACTERS FROM COMMAND
	ISZ	FACX2		/BUFFER AND STORE AS 7-BIT IMAGE
	RCL
	JMS	LCS7
	DAC	FACB
	JMS	LCS7
	DAC	FACB+1
	JMS	LCS7
	AND	(170)
	DAC	FACB+2
	LAC*	FACX2
	ISZ	FACX2
	RTL
	RTL
	DAC	FACB+3
	AND	(007)
	XOR	FACB+2
	DAC	FACB+2
	LAC	FACB+3
	JMS	LCS7
	DAC	FACB+3
	JMS	LCS7
	DAC	FACB+4
	LAC	(FACB)		/RESET FACB INDEX
	DAC	FACX1
	JMP	FAC1		/TO FETCH A CHAR FROM FACB
/
	.IFUND	BATCH
FAC3=.
	.IFDEF	RSX
	LAC*	(X10)		/SAVE AUTO-INCR 10.
	DAC	SUX10
        LAC*    (X12)
        DAC     SUX12
        LAC*    (X13)
        DAC     SUX13
	.ENDC
	JMS	TYPE		/TYPE HYPHEN TO INDICATE CONTINUATION.
	CHYP			/OF IS EXPECTED.
	JMS	RFRD		/READ A NEW LINE & RESET FACX1 & FACX2
	JMP	FAC2		/TO FETCH A CHAR FROM FACB
/
	.ENDC
	.IFDEF	BATCH
FAC3	LAC	(175)	/RETURN ALTMODE
	JMP*	FAC
/
	.ENDC
FAC4	ISZ	FACX1
	JMP	FAC0
/
FACX1	0			/FACB INDEX
FACX2	0			/COMMAND BUFFER INDEX
FACB	.BLOCK	5		/FIVE CHARACTER BUFFER
BTCHSW	0
	.IFDEF	BATCH
FDESB	0
FDESZ	0
	.ENDC
	.TITLE *** ERROR ROUTINES ***
/
/ ERR1, ERR2, & ERR3 -- SUBROUTINES TO OUTPUT ERROR MESSAGES.
/ EACH TAKES THE ADDRESS OF THE MESSAGE FROM THE WORD FOLLOWING
/ THE CALL (JMS).
/ ERR1  OUTPUTS A MESSAGE AND RETURNS
/ ERR2  OUTPUTS A MESSAGE, THE NAME IN FANM&FANM+1, AND RETURNS
/ ERR3  OUTPUTS A MESSAGE, THE BREAK CHAR IN FANB, AND RETURNS.
/
ERR1	0
	LAC*	ERR1
	ISZ	ERR1
	JMS	ERRTO
	JMP*	ERR1
/
ERR2	0
	LAC*	ERR2
	ISZ	ERR2
	JMS	ERRTO
	JMS	TYPE
	MES100
	LAC	FANM
	JMS	ERR6BO
	LAC	FANM+1
	JMS	ERR6BO
	JMP*	ERR2
/
ERR3	0
	LAC*	ERR3
	ISZ	ERR3
	JMS	ERRTO
	JMS	TYPE
	MES100
	LAC	FANB
	DAC	ERR6BF+2
	.IFUND	RSX
ERR3Z	.WRITE	TO,3,ERR6BF,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
	CAL	WRTOE
	JMS	WFEV
	LAC	(TO)	/LUN INCASE OF I/O ERROR
	.ENDC
	JMP*	ERR3
/
	.IFDEF	RSX
ERR7	JMS	ERR1	/PRINT PARTITION TOO SMALL MESSAGE
	MES7
	JMP	EXIT	/EXIT TASK
/
	.ENDC
/
ERR6BO	0	/.SIXBT OUTPUT
	DAC	TEMP1
	LAW	-3
	DAC	TEMP3
ERR6BL	LAC	TEMP1
	JMS	LCS7
	DAC	TEMP2
	RAR
	DAC	TEMP1
	LAC	TEMP2
	AND	(077)
	SNA
	JMP	ERR6BA
	XOR	(040)
	AAC	40		/(MJH-85)
	DAC	ERR6BF+2
	.IFUND	RSX
ERR6BZ	.WRITE	TO,3,ERR6BF,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
	CAL	WRTOE
	JMS	WFEV
	LAC	(TO)	/LUN INCASE OF I/O ERROR
	.ENDC
ERR6BA	ISZ	TEMP3
	JMP	ERR6BL
	JMP*	ERR6BO
/
ERR6BF	002000
	0
	0
	177
/
/
ERRTO	0
	AAC	-2		/(MJH-85)
	.IFUND	RSX
	DAC	ERRTOW+2
	.ENDC
	.IFDEF	RSX
	DAC	ERRTOW
	.ENDC
	JMS	CRTN
	.IFUND	RSX
ERRTOW	.WRITE	TO,2,XX,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
	CAL	WRTOX
	JMS	WFEV
	LAC	(TO)	/LUN IN CASE OF I/O ERROR
	.ENDC
	JMP*	ERRTO
	.TITLE *** MISC SUBROUTINES AND CPBS ***
/
/ ZLLX -- SUBROUTINE TO TEST FOR A ZERO 
/         LENGTH LINE (ALTMODE ONLY)
/	RETURN AT JMS+1 IF YES
/	RETURN AT JMS+2 IF NO
/
ZLLX	0
	LAC	FANM
	SZA
	JMP	ZLL1
	LAC	FANM+1
	SZA
	JMP	ZLL1
	LAC	FANB
	SAD	(175)
	JMP*	ZLLX	/YES
ZLL1	ISZ	ZLLX	/NO
	JMP*	ZLLX
	.EJECT
/
/
	.IFDEF	RSX
/
/	RSX CPB'S
/
/
RELTDV	37	/READ TDV REQUEST
	TDVEV	/EVENT VARIABLE FOR TDV
	CBUF		/PARAMETER BUFFER (NOT USED)
	42		/WORD COUNT
/
TDVER	CAL	WRTDVE	/WRITE TDV ERROR
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	(2)	/REQUEST TDV
	DAC	TDVEV
	JMP	EXIT
/
WRTDVE	2700	/WRITE TDV ERROR MESSAGE
	EV	/EVENT VARIABLE ADDRESS
	15	/TDV OUTPUT DEVICE
	2	/ASCII
	TDVEMS	/BUFFER
/
TDVEMS	TDVERN-TDVEMS/2*1000+2
	0
	.ASCII	/TKB-TDV ERR/<15>
TDVERN=.
/
/
WRTOX	2700
	EV
	TO
	2
ERRTOW	XX
WRTOE	2700
	EV
	TO
	3
	ERR6BF
RDCI	2600
	EV
	CI
	2
	CBUF
	42
/
LJEA	17	/LOAD THE JEA REGISTER USED TO CHECK FOR FP UNIT
	EV
	0	/LOAD TO LOCATION 0
/
	.EJECT
PREALL	0
	DAC	PREALU	/STORE LUN
	CAL	PREAD	/PREALLOCATE
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EV	/CHECK EVENT VARIABLE
	SMA		/IS NEGATIVE?
	JMP*	PREALL	/NO RETURN
	SAD	(-6)	/UN-IMPLEMENTED FUNCTION?
	JMP*	PREALL	/YES ERROR
	JMS	IOERR	/NO REAL ERROR
	LAC	PREALU	/LUN OF ERROR
/
HINLUN	0
	DAC	HINLN	/STORE LUN
	CAL	HINRQ	/DO A HINF REQUEST
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	JMP*	HINLUN	/RETURN
/
ULHINF	0
UDHINF	0
	.EJECT
/
PREAD	2300	/PREALLOCATE
	EV	/EVENT VARIABLE ADDRESS
PREALU	0	/LUN
/
HINRQ	3600	/HINF
	EV	/EVENT VARIABLE ADDRESS
HINLN	0	/LUN
/
PREAUL	2300
	EV
	UL
/
ATTRO	2400
	0
	RO
ATTUD	2400	/ATTACH
	0	/EVENT VARIABLE ADDRESS
	UD	/USER'S DEVICE
ATTLU	2400	/ATTACH
	0	/EVENT VARIABLE
	UL	/USER'S LIBRARY
ATTTO	2400	/ATTACH
	0	/EVENT VARIABLE ADDRESS
	TO	/TTY OUTPUT
ATTCI	2400	/ATTACH
	0	/EVENT VARIABLE ADDRESS
	CI	/TTY INPUT
ENTRO	3300	/ENTER
	EV	/EVENT VARIABLE ADDRESS
	RO	/RELOCATABLE OUTPUT
ROFNAM	0	/FILE NAME
	0
	.SIXBT	/TSK/
PBADR	0
CPEXIT	CAL	WRCPEX	/WRITE ^P EXIT MESSAGE
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	JMP	EXIT	/EXIT
/
WRCPEX	2700	/WRITE CAL
	EV		/EVENT VARIABLE
	TO	/LUN SLOT
	2	/DATA MODE
	CPMSG	/BUFFER
/
CPMSG	6002
	0
	.ASCII	/^^^ TKB ^Q EXIT/<15>
	.ENDC
	.TITLE *** MESSAGES ***
/
/
/ TELETYPE OUTPUT MESSAGES.  THE TWO WORDS PRECEDING EACH
/ MESSAGE ARE USED AS AN IOPS ASCII HEADER.  THE ONLY HEADER
/ REQUIREMENT FOR TTY OUTPUT IS A GREATER THAN ONE WORD-
/ PAIR COUNT.
/
	.IFUND	BRIEF
	6002
	0
MES1	.ASCII	"TASK BUILDER XVM V1A000"<15>
	.ENDC
	.IFDEF	RSX
	6002
	0
MES7	.ASCII	/TKB-PARTITION TOO SMALL/<15>
	.ENDC
	.IFUND	BRIEF
	4002
	0
MES10	.ASCII	/LIST OPTIONS/<175>
	3002
	0
MES20	.ASCII	/NAME TASK/<175>
	6002
	0
MES21	.ASCII	/SPECIFY DEFAULT PRIORITY/<175>
	5002
	0
MES22	.ASCII	/DESCRIBE PARTITION/<175>
	.ENDC
	.IFDEF	BRIEF
	2002
MES1	064000
	2002
	0
MES10	.ASCII	/OPT/<175>
	2002
	0
MES20	.ASCII	/TN/<175>
	2002
	0
MES21	.ASCII	/DP/<175>
	2002
	0
MES22	.ASCII	/PAR/<175>
	.ENDC
	5002
	0
MES23	.ASCII	/^ IMPROPER PRIORITY/<175>
	.IFUND	BRIEF
	7002
	0
MES24	.ASCII	/DESCRIBE SYSTEM COMMON BLOCKS/<175>
	.ENDC
	.IFDEF	BRIEF
	2002
	0
MES24	.ASCII	/SCB/<175>
	.ENDC
	.IFDEF	BRIEF
	3002
	0
MES25	.ASCII	/SHRCB/<175>
	.ENDC
	.IFUND	BRIEF
	7002
	0
MES25	.ASCII	/DESCRIBE SHARED COMMON BLOCKS/<175>
	.ENDC
	6002
	0
MES32	.ASCII	/^ UNRECOGNIZED SYMBOL/<175>
	6002
	0
MES33	.ASCII	/^ INCONSISTANT OPTION/<175>
	6002
	0
MES34	.ASCII	/^ TOO MANY DEFINITIONS/<175>
	.IFDEF	RSX
		7002
	0
MES35	.ASCII	/^ PARTITION NOT IN SYSTEM/<175>
	.ENDC
	4002
	0
MES36	.ASCII	/^ ILLEGAL SIZE/<175>
	.IFUND	BRIEF
	6002
	0
MES50	.ASCII	/DEFINE RESIDENT CODE/<175>
	.ENDC
	.IFDEF	BRIEF
	2002
	0
MES50	.ASCII	/RC/<175>
	.ENDC
	5002
	0
MES51	.ASCII	/^ RES ROUTINE REQ'D/<175>
	.IFUND	BRIEF
	7002
	0
MES60	.ASCII	/DESCRIBE LINKS & STRUCTURE/<175>
	.ENDC
	.IFDEF	BRIEF
	2002
	0
MES60	.ASCII	/L&S/<175>
	.ENDC
	2002
	0
MES100	.ASCII	/ -- /<175>
	5002
	0
MES101	.ASCII	/^ NAME LENGTH ERR/<175>
	6002
	0
MES102	.ASCII	/^ LINK NAME USED PRV/<175>
	6002
	0
MES103	.ASCII	/^ IMPROPER BREAK CHAR/<175>
	10002
	0
MES104	.ASCII	/^ INTERNAL NAME REPEATED IN LINE/<175>
	6002
	0
MES105	.ASCII	/^ EXTERNAL NAME USED PRV/<175>
	10002
	0
MES106	.ASCII	/^ COMPONENT NAME USED AS LINK NAME/<175>
	11002
	0
MES107	.ASCII	/^ LINK DEF WITHIN OVERLAY DESCRIPTION/<175>
	11002
	0
MES108	.ASCII	/^ COLON MUST FOLLOW FIRST LINK NAME/<175>
	10002
	0
MES109	.ASCII	/^ MORE THAN ONE LINK OVERLAYED/<175>
	10002
	0
MES110	.ASCII	/^ NAME RIGHT OF COLON USED PRV/<175>
	7002
	0
MES111	.ASCII	/^ NAME USED MORE THAN TWICE/<175>
	10002
	0
MES112	.ASCII	/^ NAME USED LEFT OF COLON TWICE/<175>
	7002
	0
MES113	.ASCII	/^ LIB IND ON LINK NAME/<175>
	7002
	0
MES114	.ASCII	/^ LIB IND ON EXTERNAL NAME/<175>
	7002
	0
MES115	.ASCII	/^ LIB IND ON INTERNAL NAME/<175>
	6002
	0
MES116	.ASCII	/^ INTERNAL NAME USED PRV/<175>
	11002
	0
MES117	.ASCII	/^ RES ROUTINE NAME USED AS LINK NAME/<175>
	7002
	0
MES118	.ASCII	/^ NAME USED MORE THAN ONCE/<175>
	5002
	0
MES119	.ASCII	/^ COMMON OUT OF SAS/<175>
	7002
	0
MES120	.ASCII /TOO MANY BUFFERS SPECIFIED/<175>
/
	.TITLE *** MOVE TTLS TO HIGH CORE ***
/
/ ALL COMMAND INPUT HAS BEEN ACCEPTED
/
/ THE OVERLAY-DESCRIPTION-TABLE, AND THE CODE REQUIRED TO GENERATE 
/ THE RCL, LDT, ODT, & TTL'S, ARE NO LONGER NEEDED -- LEAVE  
/ RCL &  LDT IN THEIR PRESENT LOW CORE POSITION AND MOVE THE TTL'S 
/ TO AS HIGH CORE AS POSSIBLE.
/
	.IFDEF	RSX
TRTTL=ENDPAR
	.ENDC
TTLLTB	LAC	(EXIT)	/RESTART VIA ^P IS NO LONGER POSSIBLE,
	DAC	CPTVA	/SET ^P TRANSFER ADDRESS TO EXIT IF ^P.
	.IFDEF	RSX
	LAC	ENDPAR	/SUBTRACT 2 FROM ENDPAR TO PREVENT
	AAC	-2	/NEXM WHEN SEARCHING TABLE
	DAC	ENDPAR	/SINCE LAST ENTRY IS NOT 3 WORDS
	.ENDC
	LAC	TTLBSE		/CHANGE TTLBSE & TTLX1 AND
	AAC	-1		/SETUP TO MOVE TTL'S  (MJH-85)
	DAC*	(X10)
	LAC	TTLX1
	TCA			/(MJH-85)
	TAD	TTLBSE
	DAC	TEMP1
	LAC	TRTTL
	IAC			/(MJH-85)
	TAD	TEMP1
	DAC	TTLBSE
	AAC	-1		/(MJH-85)
	DAC*	(X11)
	.IFDEF	RSX
	LAC	TTLBSE	/CHECK TO SEE IF THE BASE OF
	TCA		/THE NEW TABLE AND THE TOP OF
	TAD	TTLX1	/WILL OVERLAP
	SMA
	JMP	TBLOVL	/YES ERROR TABLE OVERLAP
	.ENDC
	LAC	TRTTL
	DAC	TTLX1
	JMP	MOVTTL
	.IFUND	RSX
TRTTL	.	/THE TOP OF THE RELOCATED TTL'S WILL OVERLAY 
	.ENDC
/		/THIS WORD.
/
/^^^^^^^^^^^^^^^^^^^^^ CORE PRECEDING THIS ^^^^^^^^^^^^^^^^^^^^^
/^^^^^^^^^^^^^^^^^^^ LOCATION IS WRITTEN OVER ^^^^^^^^^^^^^^^^^^
/
MOVTTL	LAC*	X10	/MOVE TTL'S
	DAC*	X11
	ISZ	TEMP1
	JMP	MOVTTL
	JMS	CRTN
/
	.TITLE *** CONSTRUCT LTB ***
/
/ CONSTRUCT THE PRELIMINARY LINK TABLE (LTB) BY SCANNING THE
/ TTL'S AND GENERATING AN LTB ENTRY FOR EACH NEW ROUTINE (LINK
/ OR LINK COMPONENT) NAME.  THE ONLY PERMANENT ENTRY ELEMENT IN THE
/ PRELIMINARY LTB IS THE LINK NUMBER.
/
/ LINK TABLE ENTRY FORMATS:
/
/    PRELIMINARY  FINAL           WHEN LINK
/    CONSTRUCTION CONSTRUCTION    IS RESIDENT
/
/     IND. (TTL)  0               0
/     LINK-	  DAC  BUF	  DAC  BUF
/        NAME	  JMS* (EXU)	  LAC  .-2
/     COMPONENT	  DAC* .+3	  DAC* .+3
/        NAME	  LAC  BUF	  LAC  BUF
/     R-FLAG	  JMP* .+2	  JMP* .+2
/     0		  ENTRY		  ENTRY
/     0		  ENTRY+1	  ENTRY+1
/     LINK #      LINK #          LINK #
/     INDEX	  MIN ADR	  MIN ADR
/     0		  MAX ADR	  MAX ADR
/
/ IND AND LINK NAME ARE
/ USED ONLY IN THE FIRST
/ LDT ENTRY FOR EACH LINK
/ (ZEROED IN OTHERS)
/
/ R-FLAG IS INITIALLY ZERO
/ AND IS SET NON-ZERO WHEN 
/ LINK IS RELOCATED & OUTPUT.
/
/ INDEX -- THE LDT INDEX OF
/ THE FIRST COMPONENT OF THIS
/ LINK.  ZERO IF LINK NAME AND
/ LONE COMPONENT ARE THE SAME
/ (NO LINK DEFINITION).
/
/ DEFINITION: SCL -- SINGLE COMPONENT LINK.  A LINK WHOSE SINGLE
/ COMPONENT HAS THE SAME NAME.  I.E., A LINK THAT IS NOT DEFINED
/ IN THE LINK DEFINITION TABLE (LDT).
/
	LAC	TTLBSE	/INITIALIZE LTB
	DAC	LTBX2
	AAC	-1		/(MJH-85)
	DAC	LTBTOP
	DAC	LTBBSE
	DZM	LNKNUM
	LAC	TTLBSE	/SETUP FOR TTL SCAN (LTBX3)
	JMP	CPLT1A
CPLT1	LAC	LTBX3	/FETCH NEXT TTL ENTRY
	TAD	TTLESZ
CPLT1A	DAC	LTBX3
	JMS	FETTTL
	LAC	TTLETY	/END OF TTL?
	SMA
	JMP	CPLT2	/NO -- SCAN LTB FOR LINK NAME
	LAC	LTBX3	/YES -- END OF LAST TTL?
	SAD	TTLX1
	JMP	DLTBL	/YES -- DETERMINE SIZE AND LOCATION 
			/       AT EXECUTE TIME
	IAC			/NO -- AUGMENT LTBX3 AND FETCH (MJH-85)
	JMP	CPLT1A	/      NEXT TTL ENTRY
CPLT2	LAC	LTBTOP	/SETUP FOR LTB SCAN (LTBX2)
	DAC	LTBX2	/(SCAN FROM TOP TO BASE)
CPLT3	LAC	LTBX2	/INDEX AT BASE?
	SAD	LTBBSE
	JMP	CPLT4	/YES -- NAME NOT FOUND, ADD ENTRY AT BASE
	TAD	LTBMES	/NO -- DECREMENT INDEX AND FETCH NEXT
	DAC	LTBX2	/LTB ENTRY
	JMS	FETLTB
	LAC	LTBETY+1 /NAME FOUND?
	SAD	TTLETY+1
	SKP
	JMP	CPLT3	/NO -- FETCH NEXT LTB ENTRY
	LAC	LTBETY+2
	SAD	TTLETY+2
	JMP	CPLT1	/YES -- FETCH NEXT TTL
	JMP	CPLT3	/NO -- FETCH NEXT LTB ENTRY
/
CPLT4	LAC	TTLETY+1 /SETUP LTB ENTRY FOR A SCL (SINGLE COMPONENT 
	DAC	LTBETY+1 /LINK).
	DAC	LTBETY+3
	LAC	TTLETY+2
	DAC	LTBETY+2
	DAC	LTBETY+4
	DZM	LTBETY+5
	DZM	LTBETY+6
	DZM	LTBETY+7
	ISZ	LNKNUM
	LAC	LNKNUM
	DAC	LTBETY+10
	DZM	LTBETY+11
	DZM	LTBETY+12
	LAC	TTLETY	/TEST FOR A SCL
	DAC	LTBETY
	AND	(001)
	SZA
	JMP	CPLT5	/NO -- ENTER EXTERNAL COMPONENTS IN LTB
	LAC	LTBBSE	/YES -- MAKE SINGLE LTB ENTRY
	TAD	LTBMES
	DAC	LTBBSE
	JMS	SETLTB
	JMP	CPLT1
/
CPLT5	LAC	LDTBSE	/SCAN LDT FOR LINK NAME
	DAC	LTBX4
CPLT6	LAC	LTBX4
	JMS	FETLDT
	LAC	LTBX4
	TAD	LDTESZ
	DAC	LTBX4
	LAC	LDTETY+1
	SAD	LTBETY+1
	SKP
	JMP	CPLT6
	LAC	LDTETY+2
	SAD	LTBETY+2
	SKP
	JMP	CPLT6
	LAC	LTBX4	/NAME FOUND, SET INDEX OF FIRST COMPONENT 
	DAC	LTBETY+11 /IN LTB ENTRY
CPLT7	JMS	FETLDT	/FETCH COMPONENT NAME
	LAC	LDTETY	/EXTERNAL NAME?
	AND	(002)
	SNA
	JMP	CPLT1	/NO -- END OF ENTRIES FOR THIS LINK
	LAC	LDTETY+1 /YES -- SET COMPONENT NAME IN LDT ENTRY
	DAC	LTBETY+3
	LAC	LDTETY+2
	DAC	LTBETY+4
/
	LAC	LTBBSE	/ADD LTB ENTRY
	TAD	LTBMES
	DAC	LTBBSE
	JMS	SETLTB
	DZM	LTBETY	/BLANK (ZERO) IND, NAME, AND INDEX
	DZM	LTBETY+1
	DZM	LTBETY+2
	DZM	LTBETY+11
	LAC	LTBX4
	TAD	LDTESZ
	DAC	LTBX4
	JMP	CPLT7
/
/ DETERMINE THE LIMITS OF CORE THAT WILL BE OCCUPIED
/ BY THE LINK TABLE, AND ADJUST THE LOAD (LDLMT).
/ THE LINK TABLE INCLUDES AN AC BUFFER, AN ELEVEN WORD
/ BUFFER FRO EACH EXTERNAL LINK COMPONENT, A TRANSFER VECTOR
/ TO .RSXEX (EXECUTE), AND A POINTER TO THE AC BUFFER (LTB BASE).
/
DLTBL	LAC	LDLMT	/SETUP FOR POSSIBLE HOLE (FIT ROUTINE)
	DAC	FITRHL
	LAC	LTBBSE	/DETERMINE TABLE SIZE MINUS ONE
	CMA
	AAC	2		/(MJH-85)
	TAD	LTBTOP
	DAC	TEMP10	/(LDLMT ADJUSTMENT)
	IAC			/(MJH-85)
	TAD	LDLMT
	AND	OPCMSK
	DAC	TEMP11
	LAC	LDLMT
	AND	OPCMSK
	SAD	TEMP11
	JMP	DLTBL1
	LAC	TEMP11	/TABLE WON'T FIT IN REMAINDER OF PAGE,
	DAC	LDLMT	/UPDATE 'LDLMT' & AND RECORD HOLE
	LAC	(FITRHL+1)
	DAC	FITX1R
DLTBL1	LAC	LDLMT	/IS LOAD LIMIT BELOW 0020 IN PAGE?
	AND	(007760)
	SZA
	JMP	DLTBL2
	LAC	TEMP11	/YES -- AVOID AUTO-INCREMENT REGISTERS
	XOR	(020)
	DAC	LDLMT
DLTBL2	LAC	LDLMT
	IAC			/(MJH-85)
	DAC	LTBBAD	/SET LTB LIMITS
	TAD	TEMP10
	AAC	-1		/(MJH-85)
	DAC	LTBTAD
	AAC	2		/UPDATE LDLMT  (MJH-85)
	DAC	LDLMT
/
/ MAKE A DUMMY GLOBAL SYMBOL REFERENCE FOR .RSXEX (EXECUTE) AND
/ GLOBAL SYMBOL DEFINITIONS FOR ALL EXTERNAL LINK
/ COMPONENT NAMES.  SYMBOLS ARE DEFINED AS POINTING TO
/ THE REGISTER THAT THE FIRST WORD OF THE CORESPONDING 
/ LINK TABLE WILL OCCUPY AT EXECUTE TIME.
/
	LAW	-1	/INITIALIZE SYMBOL TABLE TO BE CONSTRUCTED
	TAD	LTBBSE	/IN DECREASING CORE BELOW THE LINK TABLE
	DAC	SYMBEG
	DAC	SYMEND
/
	LAC	(530743)/.RSXEX IN RADIX-50 IS 530743,113340
	DAC	SYM1
	LAC	(113340)
	DAC	SYM2
	LAC	(677777)
	DAC	SYMDEF
	JMS	DEFSYM
/
	LAC	LTBTAD
	DAC	TEMP5
	LAC	LTBTOP
	DAC	LTBX2
CGST1	LAC	LTBX2
	SAD	LTBBSE
	JMP	CGST2
	TAD	LTBMES
	DAC	LTBX2
	JMS	FETLTB
	LAC	LTBETY+3
	JMS	CTR50
	DAC	SYM1
	LAC	LTBETY+4
	JMS	CTR50
	DAC	SYM2
	SNA
	JMP	.+4
	LAC	SYM1
	XOR	(400000)
	DAC	SYM1
	LAC	TEMP5
	TAD	LTBMES
	DAC	TEMP5
	XOR	(500000)
	DAC	SYMDEF
	JMS	DEFSYM
	JMP	CGST1
/
/ INITIALIZE PATCH TABLE TO BE CONSTRUCTED IN INCREASING CORE
/ FROM THE END OF THE LINK DEFINITION TABLE (LTB).  I.E., TO 
/ WRITE OVER THE OVERLAY DESCRIPTION TABLE (OTB)
/
CGST2	LAC	ODTBSE
	DAC	PTBBSE
	JMP	WRC
	.EJECT
/ NO OVERLAY DESCRIPTION -- RESIDENT CODE ONLY
/
RCO	LAC	(EXIT)	/RESTART VIA ^P IS NO LONGER POSSIBLE
	DAC	CPTVA
	LAC	(SKP)	/SET SKIP-IF-RESIDENT-ONLY SWITCH TO SKIP
	DAC	SIFRO
	LAC	(001)	/TERMINATE RCL WITH AN LDT INDICATOR
	DAC*	LDTX1	/TO STOP RESIDENT CODE SCAN
	LAC	LDTX1	/INITIALIZE PATCH TABLE TO FOLLOW THE RCL
	TAD	(001)
	DAC	PTBBSE
	LAC	TRTTL	/INITIALIZE SYMBOL TABLE TO START WHERE THE
	DAC	SYMBEG	/TTL'S WOULD HAVE STARTED IF OVERLAYS 
	DAC	SYMEND	/EXISTED
	DZM	LTBTAD	/INDICATE ZERO LENGTH LINK TABLE.  THIS WILL
	DZM	LTBBAD	/CAUSE EXECUTE TO NOT LOAD A LINK 
			/AND TO NOT SET A T.V. IN ITS HIGHEST REG.
	.IFUND	BATCH
	JMS	CRTN	/RETURN CARRIAGE
	.ENDC
	LAC	VPS		/(MJH-85) DETERMINE ALLO STRATEGY
	TAD	(-100000	/(MJH-85)
	SMA!CLA!SZA			/(MJH-85)
	IAC			/(MJH-85)
	IAC			/(MJH-85)
	DAC	STRATG		/(MJH-85)
	JMS	PRSTRA		/(MJH-85) PRINT STRATEGY AND VPS,EPS,APS
	JMP	ENTSCB
/
	.EJECT
WRC	LAC	LDLMT	/INITIALIZE BLANK COMMON LOAD LIMIT
	DAC	LDLMT3
	LAC	VPS		/(MJH-85) DETERMIN ALLO STRATEGY
	TAD	(-100000	/(MJH-85)
	SMA!CLA!SZA			/(MJH-85)
	AAC	2		/(MJH-85)
	IAC			/(MJH-85)
	DAC	STRATG		/(MJH-85)
	JMS	PRSTRA		/(MJH-85) PRINT STRATEGY VPS,APS, AND EPS
/
	LAC	LMFLAG	/IF MAP FLAG IS SET, TYPE:
	SNA
	JMP	LTML	/   LINK TABLE
	JMS	TYPE	/   XXXXX XXXXX
	MES602		/   RESIDENT CODE
LTML	DZM	SYM1	/(DONE TO INCLUDE LINK TBL SIZE IN SUMCOR
	JMS	SYMMAP	/TYPMAP DOES NOT OUTPUT IF LMFLAG IS RESET)
	LAC	LTBBAD
	AAC	-1		/(INCL AC BUFFER IN LTB SIZE)  (MJH-85)
	DAC	SLIMFA
	LAC	LTBTAD
	IAC			/(MJH-85)
	DAC	SLIMLA
	JMS	SLIM
	JMS	TYPMAP
	LAC	LMFLAG
	SNA
	JMP	ENTSCB
	JMS	CRTN
	JMS	TYPE
	MES603
/
/ ENTER SYSTEM COMMON BLOCK DEFINITIONS IN SYMBOL TABLE
/
ENTSCB	LAC	(CBDBUF-1)
	DAC*	(X12)
/
ES1	LAC*	X12
	SNA
	JMP	ES3
	JMS	CTR50
	DAC	SYM1
	LAC*	X12
	JMS	CTR50
	DAC	SYM2
	LAC*	X12
	DAC	TEMP1
	LAC*	X12
	XOR	(300000)
	JMS	ENTSYM
	LAC	SYM2
	SZA!CLA
	LAC	(400000)
	XOR	SYM1
	JMS	ENTSYM
	LAC	SYM2
	SZA
	JMS	ENTSYM
	CLA
	JMS	ENTSYM
	LAC	TEMP1
	AND	(77777)
	JMS	ENTSYM
	JMP	ES1
/
ES3	LAC	SHFLAG		/(MJH-85) IS SHARE ON?
	SNA			/(MJH-85)
	JMP	ES2		/(MJH-85) NO -- GO OUTPUT RESIDENT CODE
	LAC	NCL.BS		/(MJH-85) YES -- BEGIN SCANNING NCL
	DAC	NCL.PT		/(MJH-85)
ESCB1	LAC	NCL.PT		/(MJH-85)
	SAD	RCLBSE		/(MJH-85) END OF NCL?
	JMP	ES2		/(MJH-85) YES
	LAC*	NCL.PT		/(MJH-85) NO -- IS NCL ENTRY A SHARED COMMON?
	AND	(200000		/(MJH-85)
	SNA			/(MJH-85)
	JMP	ESCB2		/(MJH-85) NO -- SKIP THIS ENTRY AND GO TO NEXT
	LAC*	NCL.PT		/(MJH-85) YES -- ENTER NAME INTO SYM1 AND SYM2
	AND	(577777		/(MJH-85)
	DAC	SYM1		/(MJH-85)
	ISZ	NCL.PT		/(MJH-85)
	LAC*	NCL.PT		/(MJH-85)
	AND	(177777		/(MJH-85)
	DAC	SYM2		/(MJH-85)
	ISZ	NCL.PT		/(MJH-85) GET BASE OF SHARED COMMON
	LAC*	NCL.PT		/(MJH-85)
	DAC	TEMP1		/(MJH-85)
	ISZ	NCL.PT		/(MJH-85)
	LAC*	NCL.PT		/(MJH-85) GET SIZEOF COMMONS
	XOR	(300000		/(MJH-85) INDICATE THIS COMMON IS DEFINED
	JMS	ENTSYM		/(MJH-85)ENTER COMMON INTO SYMBOL TABLE
	LAC	SYM1		/(MJH-85)
	JMS	ENTSYM		/(MJH-85)
	LAC	SYM2		/(MJH-85)
	SZA			/(MJH-85)
	JMS	ENTSYM		/(MJH-85)
	CLA			/(MJH-85)
	JMS	ENTSYM		/(MJH-85)
	LAC	TEMP1		/(MJH-85)
	JMS	ENTSYM		/(MJH-85)
	ISZ	NCL.PT		/(MJH-85)
	JMP	ESCB1		/(MJH-85) GO CONSIDER NEXT NCL ENTRY
/
ESCB2	ISZ	NCL.PT		/(MJH-85) SKIP THIS NCL ENTRY
	ISZ	NCL.PT		/(MJH-85)
	JMP	ESCB1		/(MJH-85) GO CONSIDER NEXT ENTRY
/
ES2	LAC	SYMEND
	DAC	SYMEB1
/
	DZM	LNKNUM	/RELOCATE AND OUTPUT RESIDENT CODE
	LAC	RCLBSE
	DAC	RAOX
	LAC	STRATG		/(MJH-85) IF STRATEGY 3 SET SIF.HM TO SKP
	SAD	(3		/(MJH-85) SO UNINIT COMMONS WILL LOAD HIGH
	JMP	ES4		/(MJH-85)
	LAC	(NOP		/(MJH-85)
	SKP			/(MJH-85)
ES4	LAC	(SKP		/(MJH-85)
	DAC	SIF.HM		/(MJH-85)
			/----------------------------
	JMS	RAO	/RELOCATE AND OUTPUT LINK 000
			/----------------------------
	LAC	(NOP		/(MJH-85) RESET SIF.HM
	DAC	SIF.HM		/(MJH-85)
	LAC	PTBASE	/SAVE SIZE OF RESIDENT CODE
	TCA			/(MJH-85)
	TAD	LDLMT2
	DAC	RESSIZ
	DAC	SUMCOR	/INITIALIZE SUMCOR (SUMCOR AS COMPUTED IN
			/RAO MAY BE IN ERR BECAUSE OF AUTO INCREMENT REG
			/AVOIDANCE.  FURTHER COMPUTATION OF SUMCOR
			/IN RAO WILL BE CORRECT)
	LAC	LDLMT2	/UPDATE LDLMT
	DAC	LDLMT
	LAC	(FITRHL)/RESTORE FITX1 RESET WORD
	DAC	FITX1R
	LAC	SYMEND	/SYMBOL TABLE ENTRIES GENERATED BEYOND THIS
	DAC	SYMEB1	/POINT ARE DELETED AFTER RELOCATION OF
			/EACH LINK.
/
	XCT	SIFRO	/SKIP RELOCATION OF LINKS IF 'RESIDENT ONLY'
	JMP	REL1
/
	LAC	LDLMT2	/SETUP BLANK COMMON LIMIT FOR RESIDENT ONLY
	DAC	LDLMT3
	JMP	REL70
/
	.TITLE *** RELOCATION LOOP ***
/ RELOCATION LOOP --
/ THE TTL'S AND THE LTB HAVE BEEN ORDERED SUCH THAT AS A
/ LINK NAME IF FETCHED FROM THE TTL'S AND THE LTB IS SCANNED
/ FOR THAT NAME, THE NAMES PASSED ARE NAMES OF LINKS THAT HAVE
/ BEEN RELOCATED AND OUTPUT AND ARE NOT OVERLAYED BY THE LINK 
/ WHOSE NAME WAS FETCHED FROM THE TTL'S.  I.E., THEY DETERMINE
/ A LOAD LIMIT FOR THE LINK WHOSE NAME WAS FETCHED FROM THE TTL'S.
/
REL1	LAC	TTLBSE	/RESET TTL SCAN INDEX (LTBX3)
	DAC	LTBX3
REL10	LAC	LTBTOP	/RESET LTB SCAN INDEX (LTBX2)
	DAC	LTBX2
REL20	LAC	LTBX3	/FETCH A TTL ENTRY
	JMS	FETTTL
	LAC	TTLETY	/END OF TTL?
	SMA
	JMP	REL30	/NO -- FETCH AN LTB ENTRY
	LAC	LTBX3	/YES -- END OF LAST TTL?
	SAD	TTLX1
	JMP	REL70	/YES -- ALL LINKS RELOCATED & OUTPUT
	IAC		/NO -- AUGMENT TTL SCAN INDES, RESET LTB  (MJH-85)
	DAC	LTBX3	/      SCAN INDEX, AND CONTINUE SCANNING
	JMP	REL10
/
REL30	LAC	LTBX2	/FETCH NEXT LTB ENTRY
	TAD	LTBMES
	DAC	LTBX2
	JMS	FETLTB
	LAC	LTBETY+1 /SKIP ENTRY IF BLANK LINK NAME
	SNA
	JMP	REL30
	SAD	TTLETY+1 /DO LINK NAMES (TTL & LTB) MATCH?
	SKP
	JMP	REL40	/NO -- UPDATE LOAD LIMIT
	LAC	LTBETY+2
	SAD	TTLETY+2
	JMP	REL50	/YES -- RELOCATE AND OUTPUT UNLESS R-FLAG 
REL40	LAC	LDLMT	/UPDATE LDLMT
	TCA		/(MJH-85)
	TAD	LTBETY+12
	SPA
	JMP	REL30
	LAC	LTBETY+12
	IAC		/(MJH-85)
	DAC	LDLMT
	JMP	REL30
/
REL50	LAC	LTBETY+5 /IS R-FLAG SET?
	SZA		/NO -- RELOCATE AND OUTPUT LINK
	JMP	REL60	/YES -- LINK HAS ALREADY BEEN RELOCATED & OUTPUT
/
/ PREPARE TO RELOCATE AND OUTPUT A LINK
/
	LAC	LTBETY+10 /SET LINK NUMBER
	DAC	LNKNUM
/
	LAC	LTBETY+11 /SETUP DUMMY LDT ENTRY IF SINGLE
	SZA		/COMPONENT LINK
	JMP	REL51
	LAC	LTBETY
	DAC	DUMLDT
	LAC	LTBETY+1
	DAC	DUMLDT+1
	LAC	LTBETY+2
	DAC	DUMLDT+2
	LAC	(DUMLDT)
REL51	DAC	RAOX	/SET RAOX TO POINT TO THE FIRST
			/COMPONENT DESCRIPTION.
	LAC	LMFLAG	/TYPE LINK NAME IF
	SNA		/MAP FLAG IS SET
	JMP	REL53
	JMS	CRTN
	JMS	TYPE
	MES604
	LAC	LTBETY+1
	DAC	T6BW1
	LAC	LTBETY+2
	DAC	T6BW2
	JMS	T6BN
	JMS	CRTN
			/------------------------
REL53	JMS	RAO	/RELOCATE AND OUTPUT LINK
			/------------------------
	LAC	LDLMT2	/UPDATE BLANK COMMON LIMIT
	TCA		/(MJH-85)
	TAD	LDLMT3
	SMA
	JMP	REL54
	LAC	LDLMT2
	DAC	LDLMT3
	JMP	REL54
/
/ SET CORE LIMITS IN ALL LTB ENTRIES FOR THE LINK JUST
/ RELOCATED AND OUTPUT.
/
REL54	LAC	LDLMT2
	AAC	-1	/(MJH-85)
	DAC	MAXLAD
	LAC	LDLMT
	DAC	MINLAD
/
	LAC	LTBX2
	JMS	FETLTB
REL55	LAC	LTBETY+5 /IS R-FLAG SET?
	SNA
	JMP	REL58	/NO -- TERMINAL ERROR
	LAC	MINLAD	/YES -- SET CORE LIMITS IN LTB ENTRY
	DAC	LTBETY+11
	LAC	MAXLAD
	DAC	LTBETY+12
	LAC	LTBX2
	JMS	SETLTB
	LAC	LTBX2
	SAD	LTBBSE
	JMP	REL60
	TAD	LTBMES
	JMS	FETLTB
	LAC	LTBETY+1
	SZA
	JMP	REL60
	LAC	LTBX2
	TAD	LTBMES
	DAC	LTBX2
	JMP	REL55
/
REL58	JMS	TYPE	/R-FLAG WAS NOT SET DURING RAO.
	MES720		/I.E., A GLOBAL DEFINITION FOR THE 
	LAC	LTBETY+3 /EXTERNAL LINK COMPONENT NAME DID NOT
	DAC	T6BW1	/EXIST. 
	LAC	LTBETY+4 /TYPE:
	DAC	T6BW2	 /  "MISSING GLOBAL DEFINITION -- NAME"
	JMS	T6BN
	JMS	CRTN
	JMP	EXIT
/
REL60	LAC	LTBX3	/AUGMENT TTL SCAN INDEX
	TAD	TTLESZ
	DAC	LTBX3
	JMP	REL20
	.EJECT
/ ALL LINKS HAVE BEEN RELOCATED AND OUTPUT
/
REL70	LAC	LDLMT2
	DAC	LDLMT
/
/ WRITE LINK #777 (ACTUALLY #377777)
/
	LAC	(377777)
	DAC	LNKNUM
	DAC	OUTBUF+3
	LAC	(021000)
	DAC	OUTBUF
	LAC	(100000)
	DAC	OUTBUF+2
WXCT1	LAC	LDLMT3	/BASE OF BLANK COMMON
	DAC	LDLMT2	/SAVE BASE OF BLK COM IN LDLMT2
	LAC	MAXREG	/(MJH-85) SAVE HIGHEST FREE ADDR FOR TOP DOWN(HIGH) LOADS
	DAC	LDLMT3	/(MJH-85)
	LAC	FITX1R	/(MJH-85) RESET HOLES
	DAC	FITX1	/(MJH-85)
	LAC	MAX.XX	/(MJH-85) GET MAX SIZE OF BLANK COMMON (.XX)
	TCA		/(MJH-85)
	DAC	SIZE	/(MJH-85) SET COMMON BLOCK FLAG
	DAC	BLKFLG	/(MJH-85) INDICATE THIS ONE IS NOT INITIALIZED
	DZM	BLKDSW	/(MJH-85)
	LAC	STRATG	/(MJH-85) SET SIF.HM TO SKP IF STRATEGY 3
	SAD	(3	/(MJH-85)
	JMP	.+3	/(MJH-85)
	LAC	(NOP	/(MJH-85)
	SKP		/(MJH-85)
	LAC	(SKP	/(MJH-85)
	DAC	SIF.HM	/(MJH-85)
	JMS	CK.XX	/(MJH-85) RES SWITHC SHOULD BE SET IF .XX WAS RES'D
	JMS	FIT	/(MJH-85) FIND THE LOAD ADDRESS FOR .XX
	LAC	LOADADR	/(MJH-85) SAVE BASE OF .XX
	DAC	OUTBUF+4
	DAC	BSE.XX	/(MJH-95) SAVE BASE OF BLANK COMMON
	LAC	MAXREG	/(MJH-85) HAS .XX BEEN LOADED TOP DOWN?
	SAD	LDLMT3	/(MJH-85)
	SKP		/(MJH-85)
	JMP	WXCT1A	/(MJH-85) YES
	LAC	OUTBUF+4	/(MJH-85) NO -- GET HIGHEST REG USED FOR BOTTOM UP LOADING
	AAC	-1	/(MJH-85)
	TAD	MAX.XX	/(MJH-85)
	DAC	MINREG	/(MJH-85) SAVE IT IN MINREG
	JMP	WXCT2	/(MJH-85)
WXCT1A	LAC	LDLMT2	/(MJH-85) GET HIGHEST REG USED FOR BOTTOM UP LOADING
	AAC	-1	/(MJH-85)
	DAC	MINREG	/(MJH-85) SAVE IT IN MINREG
WXCT2	LAC	SUMCOR	/SUMATION OF CORE REQ'D
	DAC	OUTBUF+5
	LAC	RESSIZ	/SIZE OF RESIDENT CODE
	DAC	OUTBUF+6
	LAC	LTBBAD	/BASE ADR OF LINK TABLE
	DAC	OUTBUF+7
	LAC	DEFPRI	/PICK UP THE DEFAULT PRIORITY
	DAC	OUTBUF+10
	CLL	/SET UP TASK ENTRY POINT AND FLAGS
	LAC	PRFLAG	/BANK MODE FLAG
	CMA
	RAR
	LAC	BKFLAG	/PRIVILEDGED MODE
	CLA!SZA
	CLA!IAC		/(MJH-85)
	RTR
	RAR
	XOR MAINEP	/TASK ENTRY POINT
	DAC	OUTBUF+11
	LAC	FPFLAG	/INCLUDE THE FP FLAG
	RTR
	XOR	OUTBUF+11
	DAC	OUTBUF+11
	LAC	CPNAM+0 /PARTITION NAME
	DAC	OUTBUF+12
	LAC	CPNAM+1
	DAC	OUTBUF+13
	LAC	PTBASE	/PARTITION BASE
	DAC	OUTBUF+14
	LAC	(NOP	/(MJH-89) INIT SIF.HM TO NOP, IF TOP DOWN LOADING
	DAC	SIF.HM	/(MJH-89) HAS OCCURRED LATER RESET IF TO A SKP
	LAC	VPS	/TASK MAX REGISTER  (MJH-85)
	TAD	PTBASE		/(MJH-85)
	AAC	-1		/(MJH-85) GET MAXIMUN TASK REG USED
	PAL			/(MJH-85) IF ANY TOP DOWN LOADING HAS OCCURRED
	SAD	MAXREG		/(MJH-85) MXTREG=PART BASE+VPS-1
	JMP	WXCT2A		/(MJH-85) IF NOT MXTREG=TOP OF .XX
	LAC	(SKP		/(MJH-89) TOP DOWN LOADING HAS OCCURRED
	DAC	SIF.HM		/(MJH-89) RESET SIF.HM TO A SKP
	PLA			/(MJH-85)
	JMP	WXCT2B		/(MJH-85)
WXCT2A	LAC	OUTBUF+4	/(MJH-85)
	TAD	MAX.XX		/(MJH-85)
	AAC	-1		/(MJH-85)
WXCT2B	DAC	OUTBUF+15	/(MJH-85) SAVE MAXIMUM TASK REG USED
	DAC	MXTREG		/(MJH-85)
	LAC	PRFLAG		/(MJH-85) IS TASK EXEC MODE?
	SZA!CLL			/(MJH-85)
	JMP	WXCT2C		/(MJH-85) YES
	LAC	IOFLAG		/(MJH-85) NO -- SET IO AND XM FLAGS INTO OUTBUF+16 FOR INSTALL
	RAL			/(MJH-85) IO FLAG IS BIT 16 AND XM FLAG IS BIT 17
	TAD	XMFLAG		/(MJH-85)
	DAC	CBDBUF		/(MJH-85)
WXCT2C	LAC	(CBDBUF-1)/FOUR SYSTEM COMMON  (MJH-85)
	DAC*	(X13)	/BLOCK DESCRIPTIONS
	LAC	(OUTBUF+16-1)
	DAC*	(X12)
	LAW	-20
	DAC	TEMP1
	LAC*	X13
	DAC*	X12
	ISZ	TEMP1
	JMP	.-3
/
WXCT2D	JMS	WOB	/(MJH-85)
/
	XCT	SIFRO	/DON'T WRITE LINK TABLE IF RESIDENT ONLY
	SKP
	JMP	WLTB3
/
/ WRITE OUT LINK TABLE
/
	LAC	LTBBAD
	DAC	LOADADR
	LAC	LTBBSE
WLTB1	DAC	LTBX2
	SAD	LTBTOP
	JMP	WLTB2
	JMS	FETLTB	/FETCH AN LTB ENTRY
			/"DAC*  LOADADR" EACH WORD OF ENTRY
/
	CLA		/ZERO
	JMS	WLTS
	LAW	-1	/DAC BUF
	TAD	LTBBAD
	AND	ADRMSK
	DAC	TEMP10
	XOR	(040000)
	JMS	WLTS
	LAC	LTBTAD	/JMS*	(.RSXEX)
	AND	ADRMSK
	XOR	(120000)
	JMS	WLTS
	LAC	LOADADR	/DAC*  .+3
	AND	ADRMSK
	TAD	(060003)
	JMS	WLTS
	LAC	TEMP10	/LAC   BUF
	XOR	(200000)
	JMS	WLTS
	LAC	LOADADR	/JMP*  .+2
	AND	ADRMSK
	TAD	(620002)
	JMS	WLTS
	LAC	LTBETY+6 /ENTRY POINT
	JMS	WLTS
	LAC	LTBETY+7 /ENTRY POINT PLUS ONE
	JMS	WLTS
	LAC	LTBETY+10 /LINK NUMBER
	JMS	WLTS
	LAC	LTBETY+11 /MIN ADR
	JMS	WLTS
	LAC	LTBETY+12 /MAX ADR
	JMS	WLTS
	LAC	LTBX2
	TAD	LTBESZ
	JMP	WLTB1
/
WLTS	0
	JMS	STORE
	ISZ	LOADADR
	JMP*	WLTS
/
WLTB2	LAC	EXECEP	/SET TRANSFER VECTOR TO .RSXEX (EXECUTE) IN
	JMS	WLTS	/LINK TABLE
	LAC	LTBBAD	/SET POINTER TO LTB BASE IN LINK TABLE
	JMS	WLTS
/
	JMS	FROP	/WRITE PARTIAL RECORD
WLTB3	JMS	WNPPR	/WRITE DUMMY CODE-3 RECORD
/
	.IFDEF	RSX
	CAL	CLOSRO
	.ENDC
	.IFUND	RSX
	.CLOSE	RO	/CLOSE TSK FILE
	.ENDC
	JMS	PAUSX	/PAUSE IF PAUSE FLAG
/
	LAC	LMFLAG	/TYPE BLANK COMMON (.XX) BOUNDS
	SNA		/IF BLANK COMMON EXISTS AND IF
	JMP	TOCREA	/MAP FLAG IS SET
	LAC	MAX.XX
	SNA
	JMP	TOCRQS	/(MJH-85)
	JMS	CRTN
	JMS	TYPE
	MES605
	JMS	PRTPRG	/(MJH-85)
TOCRQS	LAC	(MES722		/(MJH-85) SET UP TO PRINT RES'D COMMONS
	DAC	TOCRQM		/(MJH-85)
	LAC	(XCT RES.SW	/(MJH-85)
	DAC	TOCRQX		/(MJH-85)
	JMS	TOCRQ0		/(MJH-85) GO PRINT RES'D COMMONS IF ANY
/
	LAC	(MES723		/(MJH-85) SET UP TO PRINT SHARED COMMONS IF ANY
	DAC	TOCRQM		/(MJH-85)
	LAC	(XCT SHR.SW	/(MJH-85)
	DAC	TOCRQX		/(MJH-85)
	JMS	TOCRQ0		/(MJH-85) PRINT THEM
/
	JMS	CRTN		/(MJH-85) PRINT MINIMUM EPS
	JMS	TYPE		/(MJH-85)
	MES724			/(MJH-85) MIN EPS
	XCT	SIF.HM		/(MJH-89) HAS TOP DOWN LOADING OCCURRED?
	JMP	MEPSL		/(MJH-89) NO -- MIN EPS=MXTREG (ROUNDED)
	LAC	MINREG		/(MJH-89) YES -- GET FREE CORE
	TCA			/(MJH-89)
	TAD	MAXREG		/(MJH-89) AC=FREE CORE
	TCA			/(MJH-89) MIN EPS=MAX TASK REG-FREE CORE
	TAD	MXTREG		/(MJH-89)
	SKP			/(MJH-89)
MEPSL	LAC	MXTREG		/(MJH-89) BOTTOM UP ONLY -- MIN EPS=MAX TASK REG
	LMQ			/(MJH-89)
	LAC	PRFLAG		/(MJH-89) IS TASK EXEC MODE?
	SZA			/(MJH-89)
	JMP	MEPSP		/(MJH-89) YES -- DON'T ROUND MIN EPS
	LACQ			/(MJH-89) NO -- ROUND MIN EPS
	AAC	377		/(MJH-89)
	AND	(777400		/(MJH-89)
	JMP	MEPSP1		/(MJH-93)
MEPSP	LACQ			/(MJH-89)
	TCA			/(MJH-93) SUBTRACT BASE OF PART FROM MXTREG
	TAD	PTBASE		/(MJH-93)
	TCA			/(MJH-93)
MEPSP1	JMS	PONUM		/(MJH-93) PRINT MIN EPS
TOCREA	JMS	CRTN	/TYPE OUT CORE REQUIRED
	JMS	TYPE
	MES690
TOCREQ	DZM	SYM1
	JMS	SYMMAP
	LAC	PTBASE
	DAC	SLIMFA
	LAC	MXTREG		/(MJH-85)
	DAC	SLIMLA
	JMS	SLIM
	ISZ	LMFLAG
	JMS	TYPMAP
/
	LAC	MINREG		/(MJH-85) CHECK FOR A CORE OVERFLOW
	TCA			/(MJH-85)
	TAD	MAXREG		/(MJH-85)
	SMA
	JMP	EXIT
	JMS	CRTN
	JMS	TYPE
	MES711
/
	.IFUND	RSX
EXIT	.EXIT		/EXIT
	.ENDC
	.IFDEF	RSX
EXIT	LAC	(SL)	/DETACH ALL DEVICES BEFORE EXITING
	JMS	DETACH
	LAC	(CI)
	JMS	DETACH
	LAC	(TO)
	JMS	DETACH
	LAC	(UD)
	JMS	DETACH
	LAC	(UL)
	JMS	DETACH
	LAC	(RO)
	JMS	DETACH
	LAC	TDVEV	/PICK UP THE TDV EVENT VARIABLE
	SAD	(2)	/IS IT A CAR RTN?
	CAL	REQTDV	/YES -- REQUEST TDV BEFORE EXITING
	CAL	(10)	/EXIT
	.IFDEF	BATCH
EXITB	JMS	CRTN
	JMP	EXIT
	.ENDC
	.ENDC
	.TITLE *** TTL SUBROUTINES ***
/WFCP -- SUBROUTINE TO WAIT FOR ^P AND RETURN CONTROL TO CALLER
/
WFCP	0
	.IFUND	RSX
	LAC	CPTVA	/SAVE ^P TRANS VECTOR
	DAC	CPBUF
	LAC	(WFCPR)	/SET ^P TV TO TRANSFER TO WFCPR 
	DAC	CPTVA	/WHEN ^P IS TYPED IN
	JMP	.	/WAIT HERE FOR ^P
WFCPR	LAC	CPBUF	/RESTORE CONTENTS OF ^P TV
	DAC	CPTVA
	.ENDC
	.IFDEF	RSX
	CAL	(6)
	.ENDC
	JMP*	WFCP	/EXIT
/
CPTVA	START
CPBUF	0
/
/ ^P HANDLER -- TRANSFER CONTROL PER CPTVA
/
CPTYPD	JMS	CRTN
	JMP*	CPTVA
/
/ FETLDT -- SUBROUTINE TO FETCH THE LDT ENTRY WHOSE INDEX IS IN AC.
/           THE ENTRY IS RETURNED IN LDTETY THRU LDTETY+2
/
FETLDT	0
	AAC	-1		/(MJH-85)
	DAC*	(X10)
	LAC*	X10
	DAC	LDTETY
	LAC*	X10
	DAC	LDTETY+1
	LAC*	X10
	DAC	LDTETY+2
	JMP*	FETLDT
/
/ FETTTL -- SUBROUTINE TO FETCH THE TTL ENTRY WHOSE INDEX IS IN AC.
/           THE ENTRY IS RETURNED IN TTLETY THRU TTLETY+2
/
FETTTL	0
	AAC	-1		/(MJH-85)
	DAC*	(X10)
	LAC*	X10
	DAC	TTLETY
	LAC*	X10
	DAC	TTLETY+1
	LAC*	X10
	DAC	TTLETY+2
	JMP*	FETTTL
/
/ FETLTB -- SUBROUTINE TO FETCH THE LTB ENTRY WHOSE INDEX IS IN AC.
/           THE ENTRY IS RETURNED IN LTBETY THRU LTBETY+10
/
FETLTB	0
	AAC	-1		/(MJH-85)
	DAC*	(X10)
	LAC	(LTBETY-1)
	DAC*	(X11)
	LAW	-13
	DAC	TEMP1
	LAC*	X10
	DAC*	X11
	ISZ	TEMP1
	JMP	.-3
	JMP*	FETLTB
/
/ SETLTB -- SUBROUTINE TO SET THE LTB ENTRY WHOSE INDEX IN IN AC
/           THE ENTRY IS TAKEN FROM LTBETY TO LTBETY+10
/
SETLTB	0
	AAC	-1		/(MJH-85)
	DAC*	(X11)
	LAC	(LTBETY-1)
	DAC*	(X10)
	LAW	-13
	DAC	TEMP1
	LAC*	X10
	DAC*	X11
	ISZ	TEMP1
	JMP	.-3
	JMP*	SETLTB
/
/ T6BN -- SUBROUTINE TO TYPE THE .SIXBT NAME IN T6BW1 & T6BW2
/         THRU THE FIRST BLANK OR SIXTH CHARACTER
/
T6BN	0
	.IFDEF RSX
	LAC	(T6BNB+2
	DAC	T6BX4
	LAC	(40
	DAC	T6BNB+2
	DAC	T6BNB+3
	DAC	T6BNB+4
	DAC	T6BNB+5
	DAC	T6BNB+6
	DAC	T6BNB+7
	.ENDC
	DZM	T6BX5		/(MJH-85)
	LAC	T6BW1
	JMS	T6BNS
	LAW	-1		/(MJH-85)
	DAC	T6BX5		/(MJH-85)
	LAC	T6BW2
	JMS	T6BNS
	JMP*	T6BN
/
T6BNS	0
	DAC	T6BX1
	LAW	-3
	DAC	T6BX3
T6BNL	LAC	T6BX1
	JMS	LCS7
	DAC	T6BX2
	RAR
	DAC	T6BX1
	LAC	T6BX2
	AND	(077)
	SNA
	.IFUND	RSX		/(MJH-85)
	JMP*	T6BN		/(MJH-85)
	.ENDC			/(MJH-85)
	.IFDEF	RSX		/(MJH-85)
	JMP	T6BNZ		/(MJH-85)
	.ENDC			/(MJH-85)
	XOR	(040)
	AAC	40		/(MJH-85)
	.IFUND RSX
	DAC	T6BNB+2
	.ENDC
	.IFDEF RSX
	DAC*	T6BX4
	ISZ	T6BX4
	ISZ	T6BX3
	JMP	T6BNL
	ISZ	T6BX5		/(MJH-85)
	JMP*	T6BNS		/(MJH-85)
	.ENDC
	.IFUND	RSX
T6BNZ	.WRITE	TO,3,T6BNB,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
T6BNZ	CAL	WRTO		/(MJH-85)
	JMS	WFEV
	LAC	(TO)	/LUN IN CASE OF I/O ERROR
	.ENDC
	.IFUND RSX
	ISZ	T6BX3
	JMP	T6BNL
	.ENDC
	JMP*	T6BNS
/
T6BW1	0
T6BW2	0
T6BX1	0
T6BX2	0
T6BX3	0
T6BX5	0			/(MJH-85)
	.IFUND RSX
T6BNB	002000
	0
	XX
	177
	.ENDC
	.IFDEF RSX
T6BNB	T6BX4-T6BNB/2*1000
	0
	40
	40
	40
	40
	40
	40
	175
	177
T6BX4	0
	.ENDC
	.EJECT
/
/ TYPE -- SUBROUTINE TO TYPE A MESSAGE
/
/ CALLING SEQUENCE:
/	JMS	TYPE
/	MESXX
/	...
/ MESXX	.ASCII	/MESSAGE/
/
/ THE TWO WORDS PRECEDING THE MESSAGE ARE USED AS AN IOPS ASCII
/ HEADER.  THE ONLY HEADER REQUIREMENTS FOR TTY OUTPUT IS A GREATER
/ THAN ONE WORD PAIR COUNT.
/
TYPE	0
	LAC*	TYPE
	AAC	-2		/(MJH-85)
	.IFUND	RSX
	DAC	.+3
	.WRITE	TO,2,XX,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
	DAC	WRTOA
	CAL	WRTOB
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	LAC	(TO)	/LUN INCASE OF I/O ERROR
	.ENDC
	ISZ	TYPE
	JMP*	TYPE
/
/ CRTN -- SUBROUTINE TO RETURN CARRIAGE
/
CRTN	0
	JMS	TYPE
	CRTNX
	JMP*	CRTN
/
	2002	/HEADER
	0
CRTNX	.ASCII	<015>
	.EJECT
/
/ LCS3 -- LEFT-CIRCULAR-SHIFT THREE
/
LCS3	0
	RAL
	RTL
	JMP*	LCS3
/
/ LCS6 -- LEFT-CIRCULAR-SHIFT SIX
/
LCS6	0
	JMS	LCS3
	JMS	LCS3
	JMP*	LCS6
/
/ LCS7 -- LEFT-CIRCULAR-SHIFT SEVEN
/
LCS7	0
	RAL
	JMS	LCS6
	JMP*	LCS7
/
	.TITLE *** PROGRAM VARIABLES ***
RCLBSE	0	/BASE OF RESIDENT CODE LIST
LDTBSE	0	/BASE OF LINK DEFINITION TABLE
LDTLSX	0	/LDT LINE START INDEX
LDTEIF	0	/LDT EXTERNAL (000)/INTERNAL (001) SUB NAME FLAG
LDTX1	0	/RCL & LDT ENTRY INDEX (POINTS TO NEXT ENTRY)
LDTESZ	3	/LDT & RCL ENTRY SIZE
ODTBSE	0	/BASE OF OVERLAY-DESCRIPTION-TABLE
ODTLSX	0	/ODT LINE START INDEX
ODTX1	0	/ODT ENTRY INDEX (POINTS TO NEXT ENTRY)
ODTESZ	+5	/ODT ENTRY SIZE
ODTMES	-5	/2S COMP OF ODT ENTRY SIZE
TTLBSE	0	/BASE OF TRUNK-TO-TWIG LISTS
TTLPNT	0	/BACK POINTER (TO REF'ING ODT ENTRY)
TTLESZ	3	/TTL ENTRY SIZE
TTLX1	0	/TTL INDEX (POINTS TO NEXT ENTRY)
TTLX2	0	/INDEX USED TO SCAN ODT
LTBTOP	0	/TOP OF LINK TABLE (ADR OF T.V. TO EXECUTE)
LTBBSE	0	/BASE OF LTB
LTBMES	-13	/2S COMPL OF LDTB ENTRY SIZE
LTBESZ	+13	/LTB ENTRY SIZE
LTBTAD	0	/LTB TOP ADR (AT EXECUTE TIME)
LTBBAD	0	/LTB BASE ADR (AT EXECUTE TIME)
LTBX2	0	/INDEX USED TO SCAN LTB
LTBX3	0	/INDEX USED TO SCAN TTL'S
LTBX4	0	/INDEX USED TO SCAN LDT
PTBBSE	0	/BASE OF PATCH TABLE (PTB)
PTBX1	0	/PTB INDEX (POINTS TO NEXT ENTRY)
PTBX2	0	/PTB SCAN INDEX
LNKNUM	0	/LINK NUMBER
MINLAD	0	/MIN LINK ADR
MAXLAD	0	/MAX LINK ADR
PTBASE	0	/PARTITION BASE ADDRESS
MAXREG	0	/MAX REG REQ
MAINEP	-1	/ENTRY POINT TO MAIN PROG
PRFLAG	0	/PRIVILEDGED TASK FLAG
FPFLAG	0	/FLOATING POINT UNIT FLAG
BKFLAG	0	/BANK PAGE FLAG
AMREST	0	/RELOCATION RESTORE FLAG
CLTX1	0	/TEMP LOC
LIBRP	.SIXBT	/BRX/	/PAGE MODE FLAG
EXECEP	0	/ENTRY POINT TO RSX EXECUTE (.RSXEX)
MAX.XX	0	/SIZE OF LARGEST BLANK COMMON
SUMCOR	0	/SUMMATION OF CORE REQUIRED
DEFPRI	0	/DEFAULT PRIORITY OF TASK
PRZLN	0	/DEFAULT PRIORITY CHECK FOR ZERO LENGTH LINE
RESSIZ	0	/SIZE OF RESIDENT CODE
LDLMT	0	/LOAD LIMIT BEFORE RELOCATION (TO SUB RAO)
LDLMT2	0	/LOAD LIMIT AFTER RELOCATION (FROM SUB RAO)
LDLMT3	0	/LIMIT OF BLANK COMMON
LTBETY	.BLOCK 13 /LTB ENTRY BUFFER
TTLETY	.BLOCK 3 /TTY ENTRY BUFFER
LDTETY	.BLOCK 3 /LDT ENTRY BUFFER
DUMLDT	.BLOCK 3 /DUMMY LDT ENTRY
	000001	 /(MUST FOLLOW DUMLDT)
CLT	77777 /CORE LIMITS TABLE (CLT)
	67777
	57777
	47777
	37777
	27777
	17777
	07777
CLTX2	0	/CLT SCAN INDEX
TEMP1	0
TEMP2	0
TEMP3	0
TEMP4	0
TEMP5	0
TEMP10	0
TEMP11	0
SLFLAG	0	/SYSTEM LIBRARY NAME FLAG
LMFLAG	1	/LOAD MAP FLAG   ZERO:OFF::NON-ZERO:ON
GMFLAG	0	/GLOBAL MAP FLAG   ZERO:OFF::NON-ZERO:ON
SZFLAG	0	/SIZE OUTPUT FLAG   ZERO:OFF::NON-ZERO:ON
SAFLAG	0	/SINGLE ALLOCATION FLAG (OF LABELED COMMON BLOCKS)
		/0:OFF::NON-ZERO:ON
PSFLAG	0	/PAUSE FLAG  ZERO:OFF::NON-ZERO:ON
BUFFS	0	/(MJH-85) I/O BUFFS REQUESTED
XMFLAG	0	/(MJH-85) SET IF XVM OPTION DECLARED
IOFLAG	0	/(MJH-85) SET IF IOT OPTION DECLARED
SHFLAG	0	/(MJH-85) SET IS SHARE OPTION DECLARED
SIF.HM	NOP	/(MJH-85) SET TO SKP IF UNINIT COMMONS LOAD TOP DOWN
RES.SW	NOP	/(MJH-85) SET TO SKP IF COMMON HAS BEEN RES'D
SHR.SW	NOP	/(MJH-85) SET TO SKP IF COMMON IS SHARED
ESAS	0	/(MJH-85) BASE OF ESAS
SAS	0	/(MJH-88) BASE OF SAS
APS	0	/(MJH-85) ACTUAL PARTITION SIZE
EPS	0	/(MJH-85) EFFECTIVE PARTITION SIZE
VPS	0	/(MJH-85) VIRTUAL PARTITION SIZE
NCL.PT	0	/(MJH-85) POINTER TO NCL
NCL.BS	0	/(MJH-85) BASE OF NCL
STRATG	0	/(MJH-85) STRATEGY FOR MEMORY ALLOCATION (1,2, OR 3)
MINREG	0	/(MJH-85) HIGHEST FREE ADDR FOR BOTTOM UP LOADING
PFLAG	0	/(MJH-85)
RESG	0	/(MJH-85) SET IF A GLOBAL WAS RESOLVED ON LAST PASS THRU LIB
RESGBL	0	/(MJH-85) SET IF A GLOBAL WAS RESOLVED ON LAST PASS THRU BOTH LIBS
MXTREG	0	/(MJH-85) HIGHEST ADDR USED BY A TASK
SIFRO	NOP	/SKIP-IF-RESIDENT-ONLY SWITCH  OVERLAYS:NOP::NO-OVERLAYS:SKP
/
	.IFUND	RSX
ROFNAM	.SIXBT	/------TSK/
	.ENDC
ADRMSK	007777	/ADDRESS MASK
OPCMSK	770000	/"OPCODE" MASK
/
CPNAM	.BLOCK 2	/CORE PARTITION NAME
/
CBDBUF	.BLOCK 24	/SYST COMMON BLOCK DESCRIPTIONS
			/FIVE ENTRIES (NAME (2WDS), BASE, SIZE)
	0	/COMMON BLOCK DESCRIPTIONS TERMINATOR
/
	.TITLE *** RELOCATE AND OUTPUT LINK ***
/ RAO -- SUBROUTINE TO RELOCATE AND OUTPUT A LINK
/
/ 'RAOX' POINTS TO EITHER:
/ 1. THE FIRST RCL ENTRY WHEN RELOCATING THE RESIDENT CODE.
/ 2. THE SECOND LDT ENTRY OF A LINK DESCRIPTION WHEN RELOCATING
/    A NON-SCL LINK.
/ 3. THE DUMMY LDT ENTRY WHEN RELOCATING A SCL.
/
/ IN ANY CASE 'RAOX' POINTS TO AN TABLE ENTRY THAT DEFINES
/ A ROUTINE TO BE RELOCATED & OUTPUT (AN INDICATOR WORD
/ AND A TWO-WORD NAME).  IN THE CASE OF A MULTI-ROUTINE
/ LINK OR MORE THAN ONE RESIDENT ROUTINE, SUCCEDING ENTRIES
/ INDICATE OTHER ROUTINES TO BE RELOCATED.  IN ANY CASE,
/ NAMES OF ROUTINES ARE FETCHED AND THE ROUTINES RELOCATED
/ AND OUTPUT UNTIL AN INDICATOR WITH BIT-17 SET IS FOUND.
/
/ ROUTINES ARE RELOCATED ABOVE THE
/ ADDRESS IN 'LDLMT'.  WHEN FINISHED RELOCATING A LINK (OR THE
/ RESIDENT CODE), 'LDLMT2' POINTS TO THE WORD ABOVE
/ THE LAST ROUTINE RELOCATED & OUTPUT.
/
/ LDLMT2 IS LEFT POINTING TO THE NEXT AVAILABLE REGISTER
/ LDLMT IS NOT ALTERED
/
/ SYMBOL TABLE ENTRY CODES:
/	0 -- DELETED GLOBAL SYMBOL ENTRY
/	1 -- UNRESOLVED GLOBAL SYMBOL REFERENCE *
/	5 -- GLOBAL SYMBOL DEFINITION, OR RESOLVED
/	     GLOBAL SYMBOL REFERENCE *
/	6 -- DUMMY GLOBAL SYMBOL ENTRY  
/	     USED TO INSURE THE RELOCATION OF A
/	     LIBRARY ROUTINE. (IT MIGHT NOT BE 
/	     REFERENCED FROM WITHIN THE LINK OR
/	     RESIDENT CODE BEING RELOCATED, OR
/	     IT MAY BE ONLY REFERENCED BY ROUTINES
/	     FOLLOWING IT IN THE LIBRARY.)
/	7 -- UNDEFINED COMMON BLOCK NAME *
/	3 -- DEFINED COMMON BLOCK NAME *
/	4 -- COMMON ELEMENT REFERENCE *
/ 			* SAME AS LINKING LOADER
/
RAOX	0
/
/ CODE FROM RAO THRU RAO4D GLEANED FROM CHAIN 170 *********************
/
RAO	0
	JMS	MV.BLK	/(MJH-91) CHECK TO SEE IF SYMBOL TABLE SHOULD BE TRIMMED
/
RAO4	LAC	SYMEB1
	DAC	SYMEND
	LAC	PTBBSE	/RESET BEGINNING OF PATCH TABLE
	DAC	PTBX1
	LAC	(SKDATA)	/SET UP SEEK DATA POINTER
	DAC	SDPTR
	LAC	FITX1R	/RESET REMAINING HOLES LIST INDEX
	DAC	FITX1
	LAC	(002000)/WRITE LINK HEADER RECORD
	DAC	OUTBUF
	LAC	(100000)
	DAC	OUTBUF+2
	LAC	LNKNUM
	DAC	OUTBUF+3
	JMS	WOB
	LAC	LDLMT
	DAC	LDLMT2
	LAC	RAOX
RAOFCN	JMS	FETLDT	/FETCH COMPONENT LDT ENTRY
	LAC	LDTETY	/NEXT LINK DESCRIPTION?
	AND	(001)
	SZA		/NO -- RELOCATE OR MAKE DUMMY SYMTAB ENTRY
	JMP	RAOCUD	/YES -- CLOSE FILE ON USER'S DEV
/
	LAC	LDTETY+1 /SET FILE NAME IN SEEK DATA AND IN
	DAC	SKDATA	/SYM1 & SYM2 (RADIX50).
	JMS	CTR50
	DAC	SYM1
	LAC	LDTETY+2
	DAC	SKDATA+1
	JMS	CTR50
	DAC	SYM2
	SNA
	JMP	.+4
	LAC	SYM1
	XOR	(400000)
	DAC	SYM1
	LAC	LDTETY	/WAS THIS ROUTINE FLAGED AS RESIDING IN
	AND	(020)	/IN A LIBRARY?
	SNA
	JMP	RAORAO	/NO -- RELOCATE AND OUTPUT
	LAC	(677777)/YES -- MAKE DUMMY SYMBOL TABLE ENTRY
	DAC	SYMDEF	/TO INSURE LOADING DURING LIBRARY SEARCH
	JMS	DEFSYM	/EVEN IF ROUTINE IS NOT CALLED OR CALLING
	JMP	RAOAUX	/ROUTINE(S) FOLLOW THIS ROUTINE IN LIBRARY.
/
RAORAO=.			/(MJH-85)
	.IFDEF	RSX
	CAL	CLOUD	/CLOXE INPUT USER'S DEVICE
	.ENDC
	LAW	UD	/'SEEK' A FILE ON THE USER'S DEVICE
	JMS	SEEK
	.IFDEF	RSX
	JMP	ER700	/FILE NOT FOUND I/O ERROR
	.ENDC
	LAW	UD
	JMS	LDPROG
/
RAOAUX	LAC	RAOX	/AUGMENT RAOX
	TAD	LDTESZ
	DAC	RAOX
	JMP	RAOFCN
	.EJECT
/
/ TRIM THE SYMBOL TABLE BACK IF NECESSARY
/
MV.BLK	0
	LAC	SAFLAG	/SINGLE ALLOCATION OF COMMON BLOCKS?
	SNA
	JMP	RAO4A	/NO -- TRIM SYMBOL TABLE BACK TO RESIDENT CODE ENTRIES ONLY (MJH-85)
	LAC	SYMEB1	/YES -- PACK COMMON BLOCK DEFINITIONS (CODE=3) ADJACENT
RAO1	DAC	SYMWD1	/TO ENTRIES MADE BY RESIDENT CODE, AND TRIM
	DAC	SYMPTR	/SYMBOL TABLE TO INCLUDE RESIDENT CODE ENTRIES
	JMS	FINDCOD /AND SAVED COMMON BLOCK DEFINITIONS.
	300000
	JMP*	MV.BLK
	JMS MVCTOR		/(RCHM-158) MOVE ENTRY TO RESIDENT CODE
				/(RCHM-158) SECTION.
	JMP RAO1		/(RCHM-158) GO GET NEXT ENTRY.
/
/ SAC NOT SET, CHECK FOR ANY NEW RES COMMON BLOCKS.
/
RAO4A	LAC NCL.BS		/(RCHM-158) CHECK TO SEE IF ANY NCL EXISTS.
	SAD RCLBSE		/(RCHM-158) RCL BS IS TOP OF NCL.
	JMP* MV.BLK		/(RCHM-158) NO NCL, GO UPDATE RES AREA.
	LAC SYMEB1		/(RCHM-158) BEGIN SEARCH BELOW RESIDENT
				/(RCHM-158) CODE.
RAO4B	DAC SYMWD1		/(RCHM-158) PRIME FINDCOD AND MVCTOR.
	DAC SYMPTR		/(RCHM-158) SET UP SYMPTR.
RAO4C	JMS FINDCOD		/(RCHM-158) SEARCH REMAINING SYMTAB FOR
	300000			/(RCHM-158) DEFINED COMMONS.
	JMP* MV.BLK		/(RCHM-158) ALL DONE, QUIT.
	LAC SYMPTR		/(RCHM-158) FETCH POINTER TO BEGINNING OF SYMBOL.
	AAC -1			/(RCHM-158) ADDRESS OF FIRST THREE CHARACTERS.
	DAC SYM1		/(RCHM-1589 SAVE FOR A MINUTE.
	AAC -1			/(RCHM-158) ADDRESS OF SECOND THREE CHARACTERS.
	DAC SYM2		/(RCHM-158) SAVE FOR A MINUTE.
	LAC* SYM1		/(RCHM-158) FETCH CHARACTERS.
	DAC SYM1		/(RCHM-158) SET UP SEARCH.
	LAC* SYM2		/(RCHM-158) FETCH OPTIONAL CHARACTERS.
	DAC SYM2		/(RCHM-158) SAVE CHARACTERS.
	JMS NCL.SC		/(RCHM-158) SCAN NC.
	JMP RAO4D		/(RCHM-158) ENTRY NOT FOUND.
	ISZ NCL.PT		/(RCHM-158) CHECK TO SEE IF RES SELECTED.
	LAC* NCL.PT		/(RCHM-158) FETCH RES SWITCH.
	SMA			/(RCHM-158) RES ON?
	JMP RAO4D		/(RCHM-158) NO.
	JMS MVCTOR		/(RCHM-158) MOVE ENTRY.
	JMP RAO4B		/(RCHM-158) TRY NEXT ENTRY.
RAO4D	JMS NXNTRY		/(RCHM-158) ADVANCE TO NEXT SYMTABLE ENTRY.
	JMP RAO4C		/(RCHM-158) PROCESS NEXT ENTRY.
	.EJECT
/
/ ROUTINE TO MOVE COMMON BLOCK ENTRY FROM NON-RESIDENT CODE TO RESIDENT
/ CODE. RETURNS NEW STARTING ADDRESS IN AC. SYMEB1 IS UPDATED. THIS
/ ROUTINE IS USED WHEN EITHER THE SAC SWITCH IS SET OR A DEFINED COMMON
/ IS FLAGGED AS RES.
/
/ GLEANED FROM CHAIN 170 *********************
/
/
MVCTOR	XX			/(RCHM-158) ROUTINE ENTRY POINT.
	LAC*	SYMPTR
	DAC	TEMP1
	JMS	DECSPT
	LAC*	SYMPTR
	DAC	TEMP2
	JMS	DECSPT
	LAC	TEMP2
	SMA
	JMP	RAO2
	LAC*	SYMPTR
	DAC	TEMP3
	JMS	DECSPT
RAO2	JMS	DECSPT
	LAC*	SYMPTR
	DAC	TEMP4
	JMS	DECSPT
	LAC	SYMPTR
	DAC	TEMP5
/
	LAC	SYMEB1
	DAC	SYMPTR
	LAC	TEMP1
	DAC*	SYMPTR
	JMS	DECSPT
	LAC	TEMP2
	DAC*	SYMPTR
	JMS	DECSPT
	LAC	TEMP2
	SMA
	JMP	RAO3
	LAC	TEMP3
	DAC*	SYMPTR
	JMS	DECSPT
RAO3	DZM*	SYMPTR
	JMS	DECSPT
	LAC	TEMP4
	DAC*	SYMPTR
	JMS	DECSPT
	LAC	SYMPTR
	DAC	SYMEB1
	LAC	TEMP5
	JMP* MVCTOR		/(RCHM-158) RETURN TO USER.
	.EJECT
/
/ ALL ROUTINES FROM USER'S DEVICE HAVE BEEN RELOCATED
/
RAOSAG	LAW	-3		/(MJH-85) RESET LIB PTR
	TAD	SDPTR		/(MJH-85)
	DAC	SDPTR		/(MJH-85)
	JMP	RAOCUE		/(MJH-85) RESCAN LIB
/
	.IFUND	RSX
RAOCUD	.CLOSE	UD	/CLOSE FILE ON USER'S DEVICE
	.ENDC
	.IFDEF	RSX
RAOCUD	CAL	CLOUD
	.ENDC
	JMS	VIRTUAL	/ARE THERE ANY UNRESOLVED GLOBALS?
	JMP	TROR	/NO -- TERMINATE RELOCATED OUTPUT RECORD
	LAC	SDPTR
	AAC	3	/(MJH-85)
	DAC	SDPTR
RAOCUE	DZM	RESG	/(MJH-85)
	.IFUND	RSX
	LAC*	DATP	/YES -- SCAN USER'S LIBRARY IF 
	TAD	(UL)	/A DEVICE IS ASSIGNED
	DAC	TEMP1
	LAC*	TEMP1
	SNA
	JMP	RAOSSL	/(NO USER'S LIB, SCAN SYS LIB)
	.ENDC
	LAW	UL
	JMS	LIBRARY
	.IFDEF	RSX
	JMP	RAOSSL
	.ENDC
/
	JMS	VIRTUAL	/ARE THERE ANY UNRESOLVED GLOBALS?
	JMP	TROR	/NO -- TERMINATE RELOCATED OUTPUT RECORD
	LAC	RESG	/(MJH-85) WERE ANY GLOBALS RESOLVED?
	SZA		/(MJH-85)
	JMP	RAOCUE	/(MJH-85) YES -- RESCAN LIB
RAOSSL	LAC	SDPTR	/YES -- SCAN SYS LIB
	AAC	3	/(MJH-85)
	DAC	SDPTR
RAOSS1	DZM	RESG		/(MJH-85)
	LAW	SL
	JMS	LIBRARY
	.IFDEF	RSX
	NOP		/LIBRARY NOT FOUND -- GLOBALS WILL STILL BE UNRESOLVED
	.ENDC
/
	JMS	VIRTUAL	/ARE THERE ANY UNRESOLVED GLOBALS?
	JMP	TROR	/NO -- TERMINATE RELOCATED OUTPUT RECORD
	LAC	RESG		/(MJH-85) WERE  ANY GLOBALS RESOLVED?
	SZA			/(MJH-85)
	JMP	RAOSS1		/(MJH-85) YES -- SCAN LIB AGAIN
	LAC	RESGBL		/(MJH-85) NO -- SCAN SYS LIB
	SNA			/(MJH-85)
	JMP	UNRERR		/(MJH-85)
	DZM	RESGBL		/(MJH-85)
	JMP	RAOSAG		/(MJH-85)
UNRERR	JMS	TYPE	/YES -- TYPE OUT NAMES AND EXIT
	MES710
	DZM	EXT		/(MJH-85)
	JMS	SHTMAP	/SHORTEN MAP LINE AND SET MAP FLAG
GLBERR	JMS VIRTUAL	/ANY UNDEFINED GLOBALS?
	JMP	EXIT	/NO -- EXIT
	DZM* SYMWD1	/YES. KILL THE ENTRY IN THE SYMBOL TABLE
			/TO AVOID SEEING IT AGAIN.
	JMS NEXSYM	/PICK UP GLOBAL NAME
	DAC SYM1
	JMS NEXSYM
	DAC SYM2
	JMS	SYMMAP	/SET NAME IN MAP LINE
	JMS	TYPMAP	/TYPE MAP LINE
	JMP GLBERR	/CONTINUE UNTIL THEY'RE ALL DONE
/
TROR	JMS	FROP	/TERMINATE AND WRITE RELOCATED OUTPUT
			/RECORD.
/
/ RESOLVE UNDEFINED COMMON BLOCKS
/
	JMS	BEGSYM	/SCAN SYMBOL TABLE FOR UNDEFINED COMMON 
RCB1	SAD	SYMEND	/BLOCK ENTRIES (CODE=7). 
	JMP	OUTPTB
	LAC*	SYMWD1
	AND	(700000)
	SAD	(700000)
	JMP	RCB10
RCB2	JMS	NXNTRY
	JMP	RCB1
/
RCB10	LAC*	SYMPTR	/UNDEFINED COMMON BLOCK ENTRY FOUND
	AND	(077777)/SAVE BLOCK SIZE
	DAC	TEMP1
	TCA		/SAVE 2'S COMPL OF SIZE AND SET BLOCK FLAG (MJH-85)
	DAC	SIZE
	DAC	BLKFLG
	JMS	DECSPT	/GET NAME AND TEST FOR BLANK COMMON
	LAC*	SYMPTR	/DEFINITION (RADIX 50 FOR '.XX' IS 131330)
	SAD	(131330)
	JMP	RCB20
/
			/NAMED COMMON FOUND --
	DAC	SYM1	/SAVE NAME FOR MAP LINE
	SMA
	JMP	.+4
	JMS	DECSPT
	LAC*	SYMPTR
	DAC	SYM2
	JMS	RV.SET		/(MJH-85)
	JMS	FIT	/FIND CORE
	JMS	PRTPRG		/(MJH-85)
	LAC*	SYMWD1	/COMMON BLOCK IS NOW DEFINED, CHANGE SYMBOL
	AND	(377777)/TABLE CODE FROM 7 TO 3.
	DAC*	SYMWD1
	JMS	DECSPT	/SET BASE OF BLOCK (DEFINITION) IN
	JMS	DECSPT	/SYMBOL TABLE, AND LEAVE SYMPTR POINTING
	LAC	LOADADR	/TO THE SYMTAB CHAIN ADDRESS
	DAC*	SYMPTR
	ISZ	SYMPTR
/
	JMS	DEFCOM	/FOLLOW SYMBOL TABLE CHAIN MAKING PATCH
	JMP	RCB2	/TABLE ENTRIES (CODE=0) FOR EACH TRANSFER 
			/VECTOR  TO THIS NAMED COMMON BLOCK.
/
			/BLANK COMMON FOUND --
RCB20	LAC	TEMP1	/UPDATE LARGEST-BLANK-COMMON-BLOCK
	TCA		/IF NECESSARY. (MJH-85)
	TAD	MAX.XX
	SPA
	CLA
	TAD	TEMP1
	DAC	MAX.XX
/
	JMS	DECSPT	/FOLLOW SYMBOL TABLE CHAIN MAKING 
	LAC*	SYMPTR	/PATCH TABLE ENTRIES (CODE=2) FOR
			/EACH TRANSFER VECTOR TO BLANK COMMON
/
	DZM*	SYMPTR	/INDICATE NO STRING (FOR FUTURE ENTRIES)
RCB21	SNA
	JMP	RCB2
	DAC	SYMPTR
	JMS	DECSPT
	LAC*	SYMPTR
	AND	(077777)
	XOR	(200000)
	DAC	PTBW1
	JMS	DECSPT
	LAC*	SYMPTR
	DAC	PTBW2
	JMS	PTBENT
	ISZ	SYMPTR
	ISZ	SYMPTR
	LAC*	SYMPTR
	AND	(077777)
	JMP	RCB21
/
/ OUTPUT PATCH TABLE
/
OUTPTB	LAC	PTBBSE	/SETUP HEADER --
	TCA		/BITS 0-2 -- CODE 3  (MJH-85)
	TAD	PTBX1	/  BITS 3-17 -- WORD LENGTH OF PATCH TBL
	SNA
	JMP	OPTB4	/SPECIAL CASE: ZERO LENGTH PATCH TABLE
	RCR
	XOR	(300000)
	DAC	OUTBUF+2
	LAC	PTBBSE
	DAC	PTBX2
	LAC	OUTBEG
	TAD	(002)
	DAC	TEMP1
OPTB1	LAC	TEMP1
	DAC	TEMP2
	DZM	OUTBUF+3
	LAC	(002000)
	DAC	OUTBUF
OPTB2	LAC	PTBX2
	SAD	PTBX1
	JMP	OPTB3
	LAC*	PTBX2
	ISZ	PTBX2
	DAC*	TEMP2
	ISZ	TEMP2
	LAC*	PTBX2
	ISZ	PTBX2
	DAC*	TEMP2
	ISZ	TEMP2
	ISZ	OUTBUF+3
	LAC	OUTBUF
	TAD	(001000)
	DAC	OUTBUF
	SAD	(021000)
	SKP
	JMP	OPTB2
	JMS	WOB
	JMP	OPTB1
/
OPTB3	LAC	OUTBUF
	SAD	(002000)
	SKP
	JMS	WOB
	JMP	OPTB5
/
OPTB4	JMS	WNPPR	/WRITE NO PATCH PATCH-RECORD
/
OPTB5	JMS	PAUSX	/PAUSE IF PAUSE FLAG
/
	LAC	LDLMT	/UPDATE SUMATION OF CORE USED (DISK ALLOCATION
	TCA		/REQUIRED TO INSTAL TASK)  (MJH-85)
	TAD	LDLMT2
	TAD	SUMCOR
	DAC	SUMCOR
/
	JMP*	RAO	/EXIT RAO SUBROUTINE
	.TITLE *** PAUSE SUBROUTINE ***
/
/ PAUSX -- SUBROUTINE TO PAUSE AND TYPE OUT LINK NUMBER
/          IF PAUSE FLAG IS SET.
/
PAUSX	0
	LAC	PSFLAG	/IS PAUSE FLAG SET?
	SNA
	JMP*	PAUSX	/NO -- EXIT
	JMS	TYPE	/TYPE "PAUSE #XXX "
	MES610
	LAC	(PSNB+2)
	DAC	MAPX1
	LAC	LNKNUM
	JMS	ADROUT
	LAW	040
	DAC	PSNB+2
	LAW	043
	DAC	PSNB+3
	.IFUND	RSX
	.WRITE	TO,3,PSNB,0
	.ENDC
	.IFDEF	RSX
	CAL	WRTOC
	.ENDC
	JMS	WFCP	/WAIT FOR ^P
	JMP*	PAUSX	/EXIT
/
PSNB	004000
	.BLOCK 6
	040
/
	.TITLE *** LOAD PROGRAM ***
/ GLEANED FROM:
/ B/F .SYSLD V1A - 21 MAY 1969 - JEAN-CLAUDE P. PROTEAU
/
/ MAIN SUBROUTINE LDPROG: LOAD A PROGRAM UNIT VIA THE 'CAL .DAT SLOT' IN
/ AC.
/ WHEN RELOCATING FROM THE USER'S DEVICE, AND THERE IS NO OVERLAY
/ STRUCTURE (RESIDENT ONLY), RELOCATION PROCEDES UNTIL AN EOF IS
/ READ.  EXIT: JMP* LDPROG
/ WHEN RELOCATING FROM THE USER'S DEVICE, AND THERE IS AN OVERLAY
/ STRUCTURE, ONLY THE FIRST UNIT OF EACH FILE IS RELOCATED AND
/ OUTPUT.  EXIT: JMP* LDPROG
/ WHEN RELOCATING FROM A LIBRARY, ONLY ONE UNIT IS RELOCATED.
/ EXIT: JMP* LDPROG.  IF IN LIBRARY SEARCH AND AN EOF IS READ, EXIT
/ IS VIA: JMP  LIBCLOS.
/
IDX=ISZ
SET=ISZ
/
LDPROG	0		/CAL .DAT SLOT IS IN THE AC.
	AND (777
	DAC	READ1
	.IFUND	RSX
	DAC	WAIT1
	.ENDC
	LAC	SYMEND	/SAVE SYMEND TO BE RESTORED IF LIBRARY
	DAC	SYMEB2	/ROUTINE IS NOT RELOCATED
NXUN	DZM	DGSNB	/CLEAR DUPLICATE GLOBAL NAME INDICATION
	DZM	BLKFLG	/CLEAR BLOCK FLAG
	DZM	PRG1	/(MJH-85)
	DZM	BLKDSW	/(MJH-85)
BUFMPTY	LAC	(INBUF)
	DAC	BUFPTR
	.IFUND	RSX
READ1	.READ	0,0,INBUF,50
WAIT1	.WAIT	0
	.ENDC
	.IFDEF	RSX
	CAL	RDLU
	JMS	WFEV
	LAC	READ1	/LUN INCASE OF I/O ERROR
	.ENDC
/ TEST THE HEADER WORDS IN THE BUFFER JUST READ INTO.
 
	LAC* BUFPTR	/PICKUP HEADER WORD 1.
	AND	(017)	/MASK TO FUNCTION BITS
	SAD	(006)	/END OF MEDIUM?
	JMP PRTEOM
	SAD	(005)	/END-OF-FILE?
	SKP
	JMP	PCBX	/NO -- TEST FOR ERRORS
	LAC	LIBFLG	/YES -- LIBRARY SEARCH?
	SZA
	.IFUND	RSX
	JMP	LIBCLOS	/YES -- CLOSE LIBRARY
	.ENDC
	.IFDEF	RSX
	JMP	LIBC
	.ENDC
	JMP*	LDPROG	/NO -- EXIT LDPROG
/
PCBX	LAC* BUFPTR
	AND (60		/GET BITS 12 AND 13.
	SNA		/PARITY, CHECKSUM, BUFFER OVERFLOW?
	JMP	PLIT9
	LAC	(MES705)
	JMP	TERR
PLIT9	LAW -1000		/LAC (777000
	TAD* BUFPTR	/PICKUP WORD PAIR COUNT, SUBTRACT
	AND .-2		/1 FOR HEADER PAIR, MULTIPLY BY 2
	CLL!RAL		/TO GET WORD COUNT (IN BITS 0 THRU 8).
	DAC WRDCNT
 
/ HEADER IS OK. NOW UPDATE THE BUFFER POINTER TO 1ST DATA WORD - 1.
/ INITIALIZE CODE WORD COUNT SO 1ST WORD IS TAKEN TO BE A CODE WORD.
/ ISSUE NEXT READ.
 
	IDX BUFPTR
	LAW -1
	DAC CDWCNT
 
 
/ CHECK IF BUFFER IS EMPTY. RETURN HERE WHENEVER READY TO PROCESS
/ ANOTHER DATA WORD.
 
BUFCHK	IDX BUFPTR	/POINT TO NEXT BUFFER WORD.
	LAC WRDCNT	/IS BUFFER EMPTY?
	SNA
	JMP BUFMPTY	/YES. READ IN SOME MORE.
	TAD PLIT9		/(777000
	DAC WRDCNT	/SUBTRACT 1 FROM THE WORD COUNT.
	ISZ CDWCNT	/READY FOR NEXT CODE WORD?
	JMP GETCOD	/NO. THERE ARE MORE CODES LEFT IN OLD ONE.
	LAW -4		/YES. RESET COUNT FOR 3 CODES PER WORD.
	DAC CDWCNT
	LAC* BUFPTR	/GET NEXT CODE WORD.
	DAC CODEWD
	JMP BUFCHK
 
	.EJECT
/ UNPACK THE NEXT CODE.
 
GETCOD	LAC CODEWD	/SHIFT CODE WORD SO THAT NEXT CODE
	RTL		/IS IN LOW ORDER AC BITS (12 THRU 17).
	RTL
	RTL
	DAC CODEWD
	RAL
	AND (77
	DAC TEMP1	/SAVE CODE FOR TESTING.
 
	LAC LIBFLG	/IS LIBRARY SEARCH MODE IN EFFECT?
	SNA
	JMP LOADIT	/NO. ALL LOADER CODES ARE IN EFFECT.
 
/ WHILE LIBRARY SEARCH MODE IS IN EFFECT, EXAMINE ONLY SPECIFIC
/ LOADER CODES; IGNORE ALL OTHERS.
 
	LAC TEMP1
	SAD (001)	/CODE 1 - PROGRAM SIZE.
	JMP LOADIT
	SAD (7		/CODE 7 - SYMBOL (1ST 3 CHARS).
	JMP LOADIT
	SAD (10		/CODE 8 - SYMBOL (2ND 3 CHARS).
	JMP LOADIT
	SAD (012)	/CODE 10 - INTERNAL GLOBAL DEFINITION.
	JMP LOADIT
	SAD (27		/CODE 23 - END OF PROGRAM UNIT.
	JMP LOADIT
	SAD	(33	/(MJH-85) SOURCE EXTENTION
	JMP	LOADIT	/(MJH-85)
	SAD (13		/CODE 11 - BLOCK DATA SUBPROGRAM.
	SKP
	JMP BUFCHK	/IGNORE ALL OTHER CODES.
	DZM LIBFLG	/CLEAR SELECTIVE LOADING FLAG SO THAT
			/THIS BLOCKDATA SUBPROGRAM IN THE USER'S
			/LIBRARY WILL BE LOADED IN (A FEATURE!!)
 
/ CODE ACCEPTED FOR PROCESSING. PICKUP THE ASSOCIATED DATA WORD AND
/ JUMP TO THE APPROPRIATE DATA PROCESSING ROUTINE.
 
LOADIT	LAW -35		/-29 DECIMAL.
	TAD TEMP1
	SMA		/IS THIS CODE >28 DECIMAL?
	JMP ERR106	/YES. BAD CODE.
 
	TAD (CODTAB+35)
	DAC TEMP1		/SAVE DISPATCH ADDRESS.
	LAC* BUFPTR	/PICKUP DATA WORD.
	JMP* TEMP1	/PROCESS IT.
 
	.EJECT
/ DISPATCH TABLE TO CODE PROCESSING ROUTINES.
/ CODES 11 THRU 18, 20 AND 21 ARE GENERATED ONLY BY FORTRAN.
 
CODTAB	JMP ERR106	/CODE 0 IS ILLEGAL.
	JMP CODE1
	JMP CODE2
	JMP CODE3
	JMP CODE4
	JMP CODE5
	JMP CODE6
	JMP CODE7
	JMP CODE8
	JMP CODE9
	JMP CODE10
	JMP CODE11
	JMP CODE12
	JMP CODE8		/CODE 13 IS PROCESSED JUST LIKE CODE 8.
	JMP CODE14
	JMP CODE15
	JMP CODE16
	JMP CODE17
	JMP CODE18
	JMP CODE19
	JMP CODE20
	JMP CODE21
	JMP	BUFCHK	/CODE 22 IS IGNORED
	JMP CODE23
	JMP	BUFCHK	/CODE 24 IS IGNORED
	JMP	CODE25	/CODE 25 ENABLE BANK ADDRESSING
	JMP	CODE26	/CODE 26 DISABLE BANK ADDRESSING
	JMP	CODE27	/(MJH-85) SOURE EXTENSION
	JMP	CODE28	/(MJH-85) CORAL COMMON INIT
/
/ WHEN END OF MEDIUM IS DETECTED WHILE TRYING TO READ IN A PROGRAM,
/ TRANSFER HERE. PRINT ^P AND WAIT FOR THE USER TO TYPE CONTROL P.
 
PRTEOM	JMS	TYPE
	MES703
	JMS	WFCP	/WAIT FOR ^P
	JMP	READ1
	.EJECT
/ CODE 1 PROCESSOR: PROGRAM UNIT'S SIZE. COMPUTE LOAD ADDRESS AND
/ RELOCATION FACTORS.
/
/ GLEANED FORM CHAIN 170 *********************
/
 
CODE1	DZM CBSIZE		/(RCHM-163) CLEAR CORAL COMMON BLOCK SIZE.
	SPA!CMA!IAC		/(RCHM-163) ABSOLUTE OR RELOCATABLE PROGRAM.
	JMP ERR115	/ABSOLUTE.
	XCT SK.F01		/(RCHM-163) IS THIS THE FIRS 01 LOADER CODE?
	JMP CORALB		/(RCHM-163) NO, SHOULD BE A CORAL COMMON BLOCK INIT.
	DAC SIZE		/SAVE 2'S COMPLEMENT OF PROGRAM SIZE.
	LAC (NOP)		/(RCHM-163) DISABLE SKIP FOR NEXT 01 LOADER CODE.
	DAC SK.F01		/(RCHM-163)
 
/ IF IN LIBRARY SEARCH MODE, DON'T CHECK IF THIS PROGRAM UNIT CAN FIT
/ IN CORE UNTIL IT IS KNOWN THAT IT WILL BE LOADED (SEE CODE 10).
 
	LAC LIBFLG	/ARE WE IN LIBRARY SEARCH MODE?
	SZA
	JMP ABSOLU	/YES. DON'T CHECK FOR FIT YET.
 
/ SEE IF PROGRAM WILL FIT IN AVAILABLE CORE. COMPUTE THE PROGRAM'S
/ LOAD ADDRESS AND RELOCATION FACTOR.
 
	JMS FIT
	LAC GMFLAG		/(RCHM-168) PRINT FILE NAME IF GMFLAG IS SET.
	SNA			/(RCHM-168)
	JMP BUFCHK		/(RCHM-168)
	DZM EXT			/(RCHM-168) CLEAR EXT.
	JMS PRTPRG		/(RCHM-168) PRINT FILE NAME.
	JMP BUFCHK
 
ABSOLU	DZM RELOC		/0 THE RELOCATION FACTOR.
	JMP BUFCHK	/GO TO PROCESS THE NEXT DATA WORD.
/
CORALB	DAC CBSIZE		/(RCHM-163) SAVE CORAL COMMON BLOCK SIZE.
	JMP BUFCHK		/(RCHM-163) GO GET NEXT LOADER CODE.
 
	.EJECT
/
/ GLEANED FORM CHAIN 170 *********************
/
 
CODE2	SPA
	JMP ERR116		/(RCHM-158)
	DAC TEMP1		/(RCHM-163) SAVE OFFSET TEMPORARILY.
	TAD	RELOC
	DAC	LOADADR
	LAC TEMP1		/(RCHM-163) FETCH OFFSET.
	TAD SIZE		/(RCHM-163) SUBTRACT CURRENT SIZE.
	SPA!SNA			/(RCHM-163) OFFSET BIGGER THAN SIZE?
	JMP BUFCHK
ERR117	JMS ERROR4		/(RCHM-163) YES, PRINT ERROR AND EXIT.
	MES726			/(RCHM-163)
/ ***	ERROR4 DOES NOT RETURN   ***/
ERR116	LAC (MES725)		/(RCHM-158) FETCH MESSAGE NUMBER.
	JMP TERR		/(RCHM-158) PRINT TERMIAL ERROR.
 
/ CODE 3 PROCESSOR: RELOCATABLE INSTRUCTION.
 
/ CODE 4 PROCESSOR: A NON-MEMORY REFERENCING INSTRUCTION, A NON-
/ RELOCATABLE MEMORY REFERENCING INSTRUCTION, AN ABSOLUTE ADDRESS,
/ OR A CONSTANT.
 
CODE3	DAC	TEMP1	/ADD IN THE RELOCATION FACTOR
	LAC	RELOC	/(MODULO 13-BITS) TO THE ADDRESS
	AND	ADRMSK	/FIELD.
	TAD	TEMP1
CODE4	JMS STORE		/STORE THE WORD IN CORE.
	IDX LOADADR
	JMP	BUFCHK
 
/ CODE 5 PROCESSOR: RELOCATABLE PROGRAM ADDRESS (VECTOR).
 
CODE5	TAD RELOC		/ADD IN THE 15-BIT
	JMP CODE4		/RELOCATION FACTOR.
 
	.EJECT
/ CODE 6 PROCESSOR: NON-COMMON VARIABLE AND ARRAY STORAGE ALLOCATION.
 
CODE6	TAD LOADADR	/INCREASE THE PRESENT LOAD ADDRESS BY THE
	DAC	LOADADR	/STORAGE SIZE.
	JMP	BUFCHK
 
 
/ CODE 7 PROCESSOR: 1ST 3 CHARACTERS OF A SYMBOL.
 
CODE7	DAC SYM1		/SAVE RADIX 50 SYMBOL CODE.
	JMP BUFCHK
 
 
/ CODE 8 PROCESSOR: LAST 3 CHARACTERS OF A SYMBOL.
/ (CODE 13 ALSO STARTS HERE).
 
CODE8	DAC SYM2		/SAVE RADIX 50 SYMBOL CODE.
	JMP BUFCHK
 
 
/ CODE 9 PROCESSOR:  GLOBAL SYMBOL REFERENCE.
/ CONTAINS UNRELOCATED ADDRESS OF A TRANSFER VECTOR, WHICH
/ HAS BEEN SETUP TO POINT TO ITSELF.
 
CODE9	TAD RELOC		/ADD RELOCATION FACTOR,
	TAD (100000)		/ADD CODE (1) FOR A VIRTUAL GLOBAL,
	JMS SCAN		/SCAN THE SYMBOL TABLE TO SEE IF THIS SYMBOL
			/HAS ALREADY BEEN ENTERED.
	JMP CDE9A		/YES.
	JMS DEFSYM	/ENTER IN SYMTAB.
	LAC	SYMDEF
	AND	(077777)
 
/ GLOBAL SYMBOL IS  IN THE SYMBOL TABLE. IF UNRESOLVED, AC HAS
/ THE ADDRESS OF THE 1ST TRANSFER VECTOR IN THE CHAIN. IF RESOLVED,
/ AC HAS TRUE ADDRESS OF THE GLOBAL. IN EITHER CASE, STORE THIS
/ ADDRESS IN THE TRANSFER VECTOR.
/
CDE9A	DAC	PTBW2	/STORE 15-BIT DEFINITION IN A
	LAC	SYMDEF	/TRANSFER VECTOR IN THE PATCH TABLE
	AND	(077777)
	DAC	PTBW1
	JMS	PTBENT
	LAC* SYMWD1	/GET 1ST WORD OF GLOBAL ENTRY.
	SPA		/IS IT STILL VIRTUAL?
	JMP BUFCHK	/NO. PROCESS NEXT DATA WORD.
 
/ SINCE THE GLOBAL IS STILL VIRTUAL, ENTER THE ADDRESS OF THE LATEST
/ TRANSFER VECTOR INTO THE SYMBOL TABLE ENTRY FOR THE GLOBAL, THEREBY
/ RECLOSING THE CHAIN.
 
	LAC SYMDEF
	DAC* SYMWD1
	JMP BUFCHK
 
/ CODE 10 PROCESSOR:  GLOBAL SYMBOL DEFINITION -- AC  CONTAINS
/ THE UNRELOCATED DEFINITION (ADDRESS) OF THE LAST SYMBOL 
/ (CODES 7 & 8) ENCOUNTERED.
/
/ 1. IF THE SYMBOL HAS NOT BEEN REFERENCED (OR DEFINED), 
/    ENTER THE DEFINITION IN THE SYMBOL TABLE.
/    IF IN LIBRARY SEARCH AND THE ROUTINE IN NOT RELOCATED, 
/    THE END OF THE SYMBOL TABLE IS RETRACTED, EFFECTIVELY 
/    DELETING ANY DEFINITIONS MADE FOR THE ROUTINE THAT WAS
/    READ THRU BUT NOT RELOCATED.
/ 2. IF THE SYMBOL HAS BEEN REFERENCED, DEFINE SYMBOL AND 
/    RESOLVE ALL REFERENCES TO IT.  IF IN LIBRARY SEARCH, 
/    SETUP TO RELOCATE FROM LIBRARY (JMS SUTLFL).
/ 3. IF THE SYMBOL HAS BEEN DEFINED AND THE DEFINITION 
/    IS A LINK TABLE ENTRY, SET THE ACTUAL DEFINITION IN
/    THE LINK TABLE ENTRY.
/ 4. IF THE SYMBOL HAS BEEN DEFINED AND THE DEFINITION IS
/    NOT A LINK TABLE ENTRY, SAVE THE SYMBOL NAME TO FLAG
/    A DUPLICATE SYMBOL DEFINITION.  IF THE ROUTINE IS REL-
/    OCATED (NOT IN LIBRARY SEARCH, OR IN LIB SEARCH AND 
/    ANOTHER DEFINITION MATCHED AN UNRESOLVED REFERENCE), THE
/    SET DUPLICATE SYMBOL FLAG WILL RESULT IN A TERMINAL
/    ERROR. 
/
CODE10	TAD RELOC	/ADD RELOCATION FACTOR.
	DAC TEMP3
	AND	(700000	/(MJH-91)
	SZA		/(MJH-91)
	JMP	ERR117	/(MJH-91)
	LAC	TEMP3	/(MJH-91)
	TAD (500000)	/(500000 ADD CODE FOR DEFINED GLOBAL.
	JMS SCAN	/IS THERE A GLOBAL WITH THE SAME NAME
			/ALREADY IN THE SYMBOL TABLE?
	JMP INTABLE	/YES.
/ SYMBOL NOT IN TABLE -- ENTER DEFINITION (CODE 5).
/   IF IN LIB SEARCH AND ROUTINE IS NOT RELOCATED, THE ENTRY
/   WILL BE DELETED.
/   IF IN LIB SEARCH, AND THE ROUTINE IS LOADED, ANY GLOBAL
/   SYMBOL DEFINITIONS MADE WILL BE RELOCATED WHEN CORE FOR
/   THE ROUTINE IS ALLOCATED.
	JMS DEFSYM	/ENTER SYMBOL AND ITS DEFINITION.
/
/ GLOBAL DEF DOES NOT MATCH AN UNRESOLVED GLOBAL REF --
/ IF IN LIBRARY SEARCH, TEST FOR: GLOBAL SYMBOL DEF
/ MATCHING A DUMMY GLOBAL SYMBOL REF.  IF FOUND, SET UP TO
/ LOAD FROM LIBRARY (JMS SUTLFL)
/
	LAC	LIBFLG
	SNA
	JMP	BUFCHK
	LAC	(600000)
	JMS	SCAN
	JMS	SUTLFL
	JMP	BUFCHK
/
	.EJECT
/ GLOBAL ALREADY IN SYMBOL TABLE.
 
INTABLE	DAC TEMP4	/SAVE 15-BIT DEFINITION FROM SYMTAB ENTRY.
	LAC* SYMWD1	/IS IT ALREADY DEFINED?
	SPA!CLA
	JMP	LTBCHK	/YES
	SAD LIBFLG	/NO. ARE WE IN LIBRARY SEARCH MODE?
	JMP RESOLVE	/NO. DEFINE THE GLOBAL ENTRY.
	JMS	SUTLFL
	JMP	RESOLVE
 
/ LIBFLG ON MEANS THE LOADER IS SEARCHING THRU SOME LIBRARY FOR INTERNAL
/ (DEFINED) GLOBALS WHICH ARE REQUESTED IN THE SYMBOL TABLE. JUST FOUND
/ ONE. NOW TEST IF THIS LIBRARY PROGRAM WILL FIT IN AVAILABLE CORE AND
/ SETUP THE RELOCATION FACTOR. IF IT FITS,
/ CLEAR LIBFLG TO INDICATE THAT A GLOBAL WAS RESOLVED (SEE INSTRUCTIONS
/ AT NEXLIB) AND ALSO SO THAT THE REMAINDER OF THIS PROGRAM ( UP TO THE
/ END-OF-PROGRAM CODE (23) ) WILL BE LOADED IN (INCLUDING SUBSEQUENT
/ GLOBAL DEFINITIONS).
/
SUTLFL	0		/SET UP TO LOAD FROM LIBRARY
	JMS FIT		/TEST IF LIBRARY PROGRAM FITS IN CORE AND
			/COMPUTE LOAD ADDRESS AND RELOC FACTOR.
	DZM LIBFLG	/CLEAR LIBRARY MODE FLAG SO REST OF PROGRAM
			/WILL BE LOADED AND TO SIGNAL THAT IT WAS.
	LAC	GMFLAG	/(MJH-85) SHOULD GLOBALS BE PRINTED?
	SNA		/(MJH-85)
	JMP	SUTL0	/(MJH-85) NO
	DZM	EXT	/(MJH-85) YES -- CLEAR EXTENSION AND PREVIOUS PROG NAME
	DZM	PRG1	/(MJH-85)
	JMS	PRTPRG	/(MJH-85) PRINT GLOBAL
/
SUTL0	LAC	SYMPTR	/SCAN SYMBOL TABLE ENTERIES GENERATED  (MJH-85)
	DAC	TEMP10	/SINCE THIS LIB ROUTINE WAS FIRST ENCOUNTERED
	LAC	SYMWD1	/AND RELOCATE ANY GLOBAL SYMBOL DEFINITIONS
	DAC	TEMP11	/(SYMWD1 & SYMPTR WILL BE RESTORED)
	LAC	SYMEB2
	DAC	SYMWD1
SUTL1	SAD	SYMEND
	JMP	SUTL2
	LAC*	SYMWD1
	AND	(700000)
	SAD	(500000)
	SKP
	JMP	.+4
	LAC*	SYMWD1
	TAD	RELOC
	DAC*	SYMWD1
	JMS	NXNTRY
	JMP	SUTL1
SUTL2	LAC	(600000)/SCAN FOR A DUMMY GLOBAL SYMBOL ENTRY
	JMS	SCAN	/AND KILL IF FOUND.
	DZM*	SYMWD1
	LAC	TEMP10	/(RESTORE SYMWD1 & SYMPTR)
	DAC	SYMPTR
	LAC	TEMP11
	DAC	SYMWD1
	LAC TEMP3		/ADD RELOCATION FACTOR AGAIN (TO GLOBAL
	TAD RELOC		/ADDRESS) BECAUSE IT WAS 0 PREVIOUSLY.
	DAC TEMP3
	TAD (500000)	/(500000
	DAC SYMDEF	/SAVE FOR SYMBOL DEFINITION.
	LAC	SYM1	/IF '.RSXEX', SAVE ENTRY POINT IN 'EXECEP'
	SAD	(530743)
	SKP
	JMP*	SUTLFL
	LAC	SYM2
	SAD	(113340)
	SKP
	JMP*	SUTLFL
	LAC	SYMDEF
	AND	(077777)
	DAC	EXECEP
	JMP*	SUTLFL
/
/ GLOBAL SYMBOL ALREADY IN TABLE AND DEFINED!
/
LTBCHK	LAC	TEMP4	/IS THE DEFINITION A LINK TABLE ENTRY?
	TCA		/(MJH-85)
	TAD	LTBTAD
	SPA
	JMP	DUPGL1		/NO -- FLAG DUPLICATE GLOBAL SYMBOL  (MJH-85)
	LAC	LTBBAD
	TCA		/(MJH-85)
	TAD	TEMP4
	SPA
	JMP	DUPGL1	/NO -- FLAG DUPLICATE GLOBAL SYMBOL  (MJH-85)
	LAC	LIBFLG	/(MJH-85) ARE WE IN LIB SEARCH MODE?
	SZA		/(MJH-85)
	JMP	LTBLIB	/(MJH-85) YES
	LAC	SYM1	/YES -- ASSUME ROUTINE IS AN EXTERNAL LINK COMPONENT.
	SAD	FNM1	/THEREFORE GLOBAL NAME AND FILE NAME MUST BE
	SKP		/IDENTICAL.  ARE THEY?
	JMP	DUPGBL	/NO -- FLAG DUPLICATE GLOBAL SYMBOL
	SMA
	JMP	SLTEPO	/YES -- SET LINK TABLE ENTRY POINT-PLUS-ONE
	LAC	SYM2
	SAD	FNM2
	JMP	SLTEPO	/YES -- SET LINK TABLE ENTRY-POINT-PLUS-ONE
	JMP	DUPGBL	/NO -- FLAG DUPLICATE GLOBAL SYMBOL
/
SLTEPO	LAC	LTBTAD	/SET R-FLAG TO INDICATE THAT THIS
	TCA		/COMPONENT HAS BEEN RELOCATIED, SET ENTRY (MJH-85)
	TAD	LTBTOP	/POINT, AND ENTRY POINT PLUS ONE,
	TAD	TEMP4	/IN THE APPROPRIATE LINK TABLE ENTRY.
	AAC	5	/(MJH-85)
	DAC	TEMP5
	LAC*	TEMP5	/FLAG DUPLICATE GLOBAL SYMBOL IF R-FLAG IS
	SZA		/ALREADY SET
	JMP	DUPGBL
	ISZ*	TEMP5	/(R-FLAG)
	ISZ	TEMP5
	LAC	TEMP3	/(ENTRY)
	DAC*	TEMP5
	ISZ	TEMP5
	IAC		/(ENTRY+1) (MJH-85)
	DAC*	TEMP5
	JMP	BUFCHK
/
LTBLIB	LAC	(600000	/IS THERE A CODE 6 ENTRY
	JMS	SCAN	/IN SYMBOL TABLE FOR THIS GLOBAL
	SKP		/SKIP IF THERE IS
	JMP	DUPGBL	/FLAG DUPLICATE SYMBOL
	DZM*	SYMWD1	/KILL ENTRY
	JMS	FIT	/SEE IF IT WILL FIT IN CORE AND COMPUTE
			/LOAD ADDRESS AND RELOCATION FACTOR
	JMS PRTPRG		/(RCHM-163) PRINT LOAD MAP.
	DZM	LIBFLG	/CLEAR FLAG SO REST OF PROGRAM WILL BE LOADED
	LAC	RELOC	/CALCULATE TRUE DEFINITION
	TAD	TEMP3
	DAC	TEMP3
	JMP	SLTEPO	/CKECK "R" FLAG ECT
/
DUPGL1	LAC	LIBFLG	/IN LIBRARY MODE
	SNA
	JMP DUPGBL	/NO -- GO FLAG DUPLICATE SYMBOL
	LAC	(600000	/IS THERE A CODE 6 ENTRY IN SYMBOL TABLE
	JMS	SCAN
	JMS	SUTLFL	/YES -- MAKE SURE WE GET ERROR
/
DUPGBL	LAC	SYM1	/FLAG DUPLICATE GLOBAL SYMBOL -- THIS WILL
	DAC	DGSNB	/RESULT IN A TERMINAL ERROR IF THE ROUTINE 
	LAC	SYM2	/IS RELOCATED
	DAC	DGSNB+1
	JMP	BUFCHK
/
	.EJECT
/ RESOLVE THE VIRTUAL GLOBAL ENTRY IN THE SYMBOL TABLE BY FOLLOWING THE
/ CHAIN (OF TRANSFER VECTORS POINTING TO OTHER TRANSFER VECTORS) AND
/ REPLACING EACH LINK WITH THE REAL DEFINITION.
 
RESOLVE	LAC*	SYMWD1	/SAVE TRANSFER VERTOR POINTER AND MAKE
	AND	(077777)	/DEFINITION ENTRY IN SYMBOL TABLE
	DAC	TEMP1
	LAC	SYMDEF
	DAC*	SYMWD1
	AND	(077777)	/SAVE 15-BIT DEFINITION
	DAC	TEMP3
/
RVPRS1	LAC	PTBBSE	/FOLLOW CHAIN OF TRANSFER VECTORS
	DAC	PTBX2	/(IN PATCH TABLE) REPLACING POINTERS
RVPRS2	LAC*	PTBX2
	SAD	TEMP1
	JMP	.+4
	ISZ	PTBX2
	ISZ	PTBX2
	JMP	RVPRS2
	ISZ	PTBX2
	LAC*	PTBX2
	DAC	TEMP2
	LAC	TEMP3
	DAC*	PTBX2
	LAC	TEMP2
	SAD	TEMP1
	JMP	BUFCHK
	DAC	TEMP1
	JMP	RVPRS1
/ CODE 11 PROCESSOR: BLOCK DATA SUBPROGRAM DECLARATOR.
/
/ GLEANED FORM CHAIN 170 *********************
/
CODE11	CMA!IAC			/(RCHM-167)
	DAC BLKDSW		/(RCHM-163) SET UP BLOCK DATA SWITCH.
	JMP BUFCHK	/SETS THE FLAG NON-ZERO.
	.EJECT
/
/ CODE 12 -- GLEANED FORM CHAIN 170 *********************
/
/
/ IF BLOCK DATA FLAG IS SET THEN THIS ROUTINE DISPATCHES TO THE CORAL COMMON
/ BLOCK DEFINITION CODE. ALL BLOCKS WILL BE HANDLED IN EXACTLY THE SAME FASHION.
/
CODE12	DAC TEMP1		/(RCHM-163) SAVE IN CASE WE HAVE TO BUILD NEW HEADER.
	CMA!IAC			/(RCHM-163) MAKE SIZE NEGATIVE.
	DAC TEMP2		/(RCHM-163) SAVE FOR SIZE TESTS.
	LAC BLKDSW		/(RCHM-163) GOING TO DEFINE THE NEW BLOCK?
	SZA			/(RCHM-163)
	JMP CD1228		/(RCHM-163) GO ENTER CODE28.
	LAC (300000)		/(RCHM-163) FETCH SCANNER CODE.
	JMS SCAN		/(RCHM-163) SCAN SYMBOL TABLE FOR COMMON BLOCK.
	SKP			/(RCHM-163) COMMON BLOCK FOUND.
	JMP CD12.1		/(RCHM-163) GO MAKE NEW COMMON ENTRY.
/
/ THE COMMON BLOCK HAS BEEN LOCATED IN THE SYMBLO TABLE. CHECK TO SEE IF IT
/ IS A DEFINED COMMON.
/
	DAC TEMP3		/(RCHM-163) CHECK FOR SIZE CHANGES LATER.
	LAC* SYMWD1		/(RCHM-165) FETCH BLOCK TYPE.
	AND (700000)		/(RCHM-163) CHECK FOR DEFINED/UNDEFINED.
	SAD (700000)		/(RCHM-163) IS IT UNDEFINED?
	JMP CD12.2		/(RCHM-163) YES.
/
/ DEFINED COMMON BLOCK HAS BEEN RETRIEVED. MAKE SURE THE NEW DEFINITION IS
/ NO BIGGER THAN THE OLD ONE.
/ AND SET UP COMCHN AND COMDEF FOR ANY PECULIAR PROCESSING WHICH CAN HAPPEN.
/ OUR WAY.
/
	JMS CD12.3		/(RCHM-163) CHECK FOR SIZE DIFFERENCE 
	JMP LCBSZE		/(RCHM-163) COMMON BLOCK SIZE DIFFERENCE.
	LAC SYMPTR		/(RCHM-163) FETCH ADDRESS BEFORE POINTERS.
	AAC -1			/(RCHM-163) POINT TO COMCHN.
	JMS CD12.4		/(RCHM-163) DEFIN COMCHN AND COMDEF.
	JMP BUFCHK		/(RCHM-163) GO GET NEXT LOADER CODE.
/
/ REGULAR COMMON NOT IN SYMBLO TABLE.
/
CD12.1	LAC TEMP1		/(RCHM-163) FETCH COMMON BLOCK SIZE
	AND (700000)		/(RCHM-163) CHECK RANGE.
	SZA			/(RCHM-163) CAN'T BE BIGGER THAN 32K.
	JMP CD28E4		/(RCHM-163) GO TO ERROR ROUTINE.
	LAC TEMP1		/(RCHM-163) PREPARE HEADER FOR SYMBLO TABLE ENTRY.
	XOR (700000)		/(RCHM-163) SET UP NEW UNDEFINED COMMON BLOCK.
	DAC SYMDEF		/(RCHM-163) SET UP CALL TO DEFSYM.
	JMS DEFSYM		/(RCHM-163) DEFIN NEW COMMON BLOCK.
	LAC SYMEND		/(RCHM-163) SET UP COMCHN AND COMDEF.
	JMS CD12.4		/(RCHM-163)
	DZM* SYMEND		/(RCHM-163) CLEAR COMMON CHAIN.
	JMS UPSYM		/(RCHM-163) MOVE END OF TABLE.
	DZM* SYMEND		/(RCHM-163) CLEAR LOAD ADDRESS.
	JMS UPSYM		/(RCHM-163) FINAL ADJUSTMENT OF BOTTOM.
	JMP BUFCHK		/(RCHM-163) FETCH NEXT    LOADER CODE.
/
/ STANDARD UNDEFINED COMMON BLOCK FOUND. UPDATE THE SIZE IF NECESSARY AND QUIT.
/
CD12.2	LAC SYMPTR		/(RCHM-163) FETCH CYMPTR.
	AAC -1			/(RCHM-165) AND DEFINE COMCHN AND COMDEF.
	JMS CD12.4		/(RCHM-163)
	JMS CD12.3		/(RCHM-163) CHECK SIZE.
	SKP			/(RCHM-163) NEW COMMON IS BIGGER.
	JMP BUFCHK		/(RCHM-163) FETCH NEXT LOADER CODE.
	LAC (700000)		/(RCHM-163) FETCH UNDEFINED COMMON CODE.
	XOR TEMP1		/(RCHM-163) FETCH NEW SIZE.
	DAC* SYMWD1		/(RCHM-163) UPDATE SYMBOL TABLE
	JMP BUFCHK		/(RCHM-163) GO GET NEXT LOADER CODE.
/
/ ROUTINE TO CHECK COMMON BLOCK SIZES AND SKIP A LOCATION IF NOE IS SMALLER.
/
CD12.3	XX			/(RCHM-163) ROUTINE ENTRY POINT.
	LAC TEMP1		/(RCHM-163) CHECK FOR VALID SIZE.
	AND (700000)		/(RCHM-163)
	SZA			/(RCHM-163)
	JMP CD28E4		/(RCHM-163) GIVE ERROR.
	LAC TEMP3		/(RCHM-163) FETCH OLD BLOCK SIZE.
	AND (77777)		/(RCHM-163) STRIP OUT SIZE.
	TAD TEMP2		/(RCHM-163) SUBTRACT NEW SIZE.
	SMA			/(RCHM-163) NEW ONE BIGGER?
	ISZ CD12.3		/(RCHM-163) NO.
	JMP* CD12.3		/(RCHM-163) RETURN TO USER.
/
/ ROUTINE TO DEFINE COMCHN AND COMDEF.
/
CD12.4	XX			/(RCHM-163) ROUTINE ENTRY POINT.
	DAC COMCHN		/(RCHM-163) INITIALIZE COMMON BLOCK CHAIN POINTER.
	AAC -1			/(RCHM-163) CALCULATE COMMON DEFINITION.
	DAC COMDEF		/(RCHM-163) INITIALIZE COMMON DEFINITION.
	JMP* CD12.4		/(RCHM-163) RETURN TO  CALLER.
/
/ LABELED COMMON BLOCK SIZE ERROR
/
LCBSZE	DZM	EXT		/(MJH-90)
	JMS	ERROR4		/(RCHM-158)
	MES707			/(RCHM-158)
/ ***	ERROR4 DOES NOT RETURN   *** /
COD12E	DZM	EXT		/(RCHM-158) PRINT ERROR MESSAGE
	JMS	ERROR4		/(MJH-900
	MES727			/(RCHM-158) ILLEGAL ATTEMPT AT INIT.
/ ***	ERROR4 DOES NOT RETURN   *** /
/ CODE 13 PROCESSOR: COMMON SYMBOL DEFINITION (ADDRESS RELATIVE TO THE
/ START OF THE COMMON BLOCK). USE SAME CODE AS CODE8.
/ (RELATIVE ADDRESS TO SYM2)
 
 
/ CODE 14 PROCESSOR: COMMON SYMBOL REFERENCE DEFINITION (UNRELOCATED
/ ADDRESS OF THE TRANSFER VECTOR).
 
CODE14	TAD RELOC		/ADD THE RELOCATION FACTOR TO
	AND	(077777)	/POINT TO WHERE THE TV IS NOW
	DAC	PTBW1	/SAVE TV ADR FOR POSSIBLE PATCH TBL ENTRY
	XOR	(400000)	/SAVE TV ADR FOR POSSIBLE SYMBOL TBL ENTRY
	DAC	SYM1
	LAC* COMDEF	/0 OR THE BLOCK'S BASE ADDRESS.
	TAD SYM2		/COMMON SYMBOL'S RELATIVE POSITION.
	DAC	PTBW2	/SAVE TV FOR POSSIBLE PATCH TBL ENTRY
	DAC	SYM2	/SAVE REL POS FOR POSSIBLE SYMBOL TBL ENTRY
	LAC* COMDEF	/IS THE BLOCK DEFINED?
	SZA
	JMP	CDE14A	/YES -- MAKE PATCH TABLE ENTRY
 
/ BLOCK IS NOT DEFINED. MAKE AN ENTRY IN THE SYMBOL TABLE AND INSERT
/ THE ENTRY IN THE COMMON CHAIN.
 
	LAC* COMCHN	/POINTER TO 1ST LINK IN CHAIN.
	TAD (400000	/TACK ON CODE 4.
	DAC SYMDEF
	LAC SYMEND	/END OF SYMBOL TABLE IS WHERE THE 1ST
			/WORD OF THIS ENTRY WILL GO.
	DAC* COMCHN	/MAKE THE NEW ENTRY BECOME THE 1ST LINK.
	JMS	DEFSYM	/MAKE 3-WORD ENTRY IN THE SYMBOL TABLE.
	JMP	BUFCHK
/
CDE14A	JMS	PTBENT	/MAKE PATCH TABLE ENTRY (CODE=0) FOR
	JMP	BUFCHK	/A REFERENCE TO A DEFINED COMMON BLOCK.
 
/ CODE 15 PROCESSOR: DATA INITIALIZATION CONSTANT (1ST WORD).
 
CODE15	DAC DATA1
	JMP BUFCHK
 
 
/ CODE 16 PROCESSOR: DATA INITIALIZATION CONSTANT (2ND WORD).
 
CODE16	DAC DATA2
	JMP BUFCHK
 
	.EJECT
/ CODE 17 PROCESSOR: DATA INITIALIZATION CONSTANT (3RD WORD).
 
CODE17	DAC DATA3
	JMP BUFCHK
 
 
/ CODE 18 PROCESSOR: DATA INITIALIZATION CONSTANT DEFINITION. 
/  BITS 1-2 INDICATE DATA TYPE (NUMBER OF WORDS) AND BITS 3-17 CONTAIN
/  THE LOCATION OF THE FIRST WORD OF THE CONSTANT RELATIVE TO THE
/  LOAD ADDRESS OF OF THE ROUTINE (RELOC) OR, IF BLOCK DATA, RELATIVE
/  TO THE BASE OF THE LAST COMMON BLOCK DEFINED (* COMDEF)
CODE18	DAC TEMP1		/SAVE DATA WORD.
	LAC	BLKDSW	/(MJH-85)
	SNA
	JMP	.+4
	LAC*	COMDEF
	AND	(077777)
	SKP
	LAC	RELOC
	TAD	TEMP1
	DAC	TEMP1	/DETERMINE 2S COMPLIMENT OF NUMBER
	RTL		/OF WORDS TO BE STORED FROM CODE BITS
	RTL		/IN THE ADDRESS WORD
	AND	(003)
	CMA
	SAD	(-4)
	LAW	-1
	DAC	TEMP10
	LAC	(DATA1)
	DAC	TEMP11
	LAC*	TEMP11
	DAC	ROPWB
	LAC	TEMP1
	JMS	ROP
	ISZ	TEMP1
	ISZ	TEMP11
	ISZ	TEMP10
	JMP	.-7
	JMP BUFCHK
 
	.EJECT
/ CODE 19 PROCESSOR: INTERNAL SYMBOL OR PROGRAM NAME
/
/ GLEANED FROM CHAIN 170 *********************
/
CODE19	AND	(400000)	/IGNORE INTERNAL SYMBOL
	SNA
	JMP	BUFCHK
	LAC BLKDSW		/(RCHM-166) BLOCK DATA SWITCH ON?
	SZA			/(RCHM-166) 0 => NO.
	JMP CD19.1		/(RCHM-163) YES.
	LAC SYM1		/(RCHM-163)
	DAC PRG1		/(RCHM-163)
	LAC SYM2		/(RCHM-163)
	DAC PRG2		/(RCHM-163)
	LAC	GMFLAG	/IGNORE  PROG NAME IF GLOBAL MAP FLAG
	SNA		/IS SET, OTHERWISE, SET NAME IN 
	JMS PRTPRG		/(RCHM-163) PRINT NAME.
	JMP	BUFCHK
/
CD19.1	LAC MAPBUF		/(RCHM-163) FETCH CURRENT MAP LENGTH
	DAC TEMP1		/(RCHM-163) SAVE MAP LENGTH
	LAC LMFLAG		/(RCHM-163) SEE IF MAP TO BE PRINTED.
	SNA			/(RCHM-163) NON-ZERO IF YES.
	JMP BUFCHK		/(RCHM-163) NO MAP, ALL DONE.
	JMS TYPE		/(RCHM-163) PRINT BLOCK DATA MESSAGE.
	MES728			/(RCHM-163)
	JMS SYMMAP		/(RCHM-163) EXPAND PROGRAM NAME.
	JMS SHTMAP		/(RCHM-163) SHORTEN MAP AND INSERT CR/LF.
	JMS TYPMAP		/(RCHM-163) PRINT MAP.
	LAC TEMP1		/(RCHM-163) FETCH PREVIOUS MAP LENGTH.
	DAC MAPBUF		/(RCHM-163) RESTORE MAP LENGTH.
	LAC (040)		/(RCHM-166) RESTORE BLANKS TO MAP BUFFER.
	DAC MAPFAD-1		/(RCHM-166)
	DAC MAPFAD		/(RCHM-166)
	JMP BUFCHK		/(RCHM-163) GO GET NEXT LOADER CODE.
	.EJECT
/ CODE 20 PROCESSOR: STRING CODE (FIRST HALF) - UNRELOCATED POINTER
/ TO AN INSTRUCTION WHOSE ADDRESS PART IS TO BE REPLACED (CODE 21).
 
CODE20	TAD RELOC		/ADD RELOCATION FACTOR.
	DAC STRING	/SAVE POINTER TO THE INSTRUCTION.
	JMP BUFCHK
 
/ CODE 21 PROCESSOR: STRING CODE (SECOND HALF) - UNRELOCATED ADDRESS
/ WHICH IS TO REPLACE THE ADDRESS PART OF AN INSTRUCTION (SEE CODE 20).
 
CODE21	TAD	RELOC	/MAKE PATCH TABLE ENTRY FOR
	AND	ADRMSK	/STRING CODE MODIFICATION
	DAC	PTBW2
	LAC	STRING
	XOR	(100000)
	DAC	PTBW1
	JMS	PTBENT
	JMP BUFCHK
/
/
/ CODE 23 PROCESSOR: END OF PROGRAM UNIT (PROGRAM START ADDRESS).
/
/ GLEANED FROM CHAIN 170 *********************
 
CODE23	DZM BLKDSW		/(RCHM-163) TURN OFF BLOCKDATA SUBPROGRAM FLAG
	DZM BLKFLG		/(RCHM-163) TURN OFF COMMON BLOCK FLAG ON GENERAL PRINCIPLES.
	DAC	TEMP1	/SAVE ENTRY POINT IN TEMP1
	LAC (SKP)		/(RCHM-163) REARM SKIP ON FIRST 01 LOADER CODE
	DAC SK.F01		/(RCHM-156) SWITCH.
	LAC	AMREST	/RESTORE RELOCATION MODE MASKS
	DAC	ADRMSK
	CMA
	DAC	OPCMSK
	LAC	LIBFLG	/WAS A ROUTINE RELOCATED?
	SZA
	JMP	CDE23A	/NO -- DELETE ANY SYM TAB ENTRIES MADE
	LAC	MAINEP	/YES -- HAS AN ENTRY POINT BEEN RECORDED?
	SMA
	JMP	CDE23E	/YES -- IGNORE ROUTINE ENTRY POINT
	LAC	TEMP1	/NO -- USE ROUTINE ENTRY POINT AS ENTRY TO
	TAD	RELOC	/OVERLAY SYSTEM
	AND	(77777)
	DAC	MAINEP
CDE23E	DZM EXT			/(RCHM-163) CLEAR EXTENSION FOR NEXT TIME.
	LAC	DGSNB	/WERE THERE ANY DUPL GLOBAL SYMBOL
	SZA		/NAMES DURING THIS ROUTINE?
	JMP	CDE23B	/YES -- TERMINAL ERROR
	LAC	SDPTR	/RELOCATION FROM A LIBRARY?
	SAD	(SKDATA)	/(RCHM-156)
	JMP	NXUN	/NO -- RELOCATE THRU EOF
	JMP*	LDPROG	/YES -- EXIT LDPROG
/
CDE23A	LAC	SYMEB2	/ROUTINE NOT LOADED, RESTORE SYMEND TO
	DAC	SYMEND	/VALUE BEFORE THIS ROUTINE WAS ENCOUNTERED
	JMP*	LDPROG
/
CDE23B	LAC	DGSNB	/EXIT TO MONITOR
	DAC	SYM1
	LAC	DGSNB+1
	DAC	SYM2
	JMS	ERROR4		/(RCHM-158) DUPLICATE GLOBALS FOUND -- TYPE
	MES721		/NAME OF LAST DUPLICATE FOUND AND
/ ***	ERROR4 DOES NOT RETURN  *** /
/
/ CODE 25 -- ENABLE BANK ADDRESSING
/ CODE 26 -- DISABLE BANK ADDRESSING
/
CODE25	LAC	(017777)	/SETUP FOR BANK RELOCATION
	SKP
CODE26	LAC	(007777)	/SETUP FOR PAGE RELOCATION
	DAC	ADRMSK
	CMA
	DAC	OPCMSK
	JMP	BUFCHK
/
/ CODE 27 -- GLENAED FROM CHAIN 170 *********************
/
CODE27	DAC EXT			/(RCHM-163) SET UP EXTENSION NAME.
	JMP BUFCHK		/(RCHM-163) GO GET NEXT LOADER CODE.
/ CODE 28 -- PROCESS CORAL COMMONS
/
/ GLEANED FROM CHAIN 170 *********************
/
/	LOADER CODE SEQUENCE FOR USING THE CORAL COMMON INITIALIZATION
/	PROCESSOR.
/
/	07		BLOCK NAME (NON-ZERO)
/	10		BLOCK NAME (OPTIONAL)
/	01		BLOCK SIZE (OPTIONAL)
/	34		ENTER INITIALIZATION MODE
/	.
/
/	.
/	.
/	07		BLOCK NAME (0)
/	34		LEAVE INITIALIZATION MODE
/
/
/ ENTRY POINT IN CASE BLOCK DATA IS ON AND A COMMON BLOCK IS PROCESSED.
/
CD1228	LAC TEMP2		/(RCHM-163) FETCH SIZE OF COMMON BLOCK (NEGATIVE)
	DAC CBSIZE		/(RCHM-163) SET UP CODE PROPERLY.
	JMP CD28.0		/(RCHM-163) ENTER CODE PROPERLY.
CODE28	LAC SYM1		/(RCHM-163) FETCH NAME OF SYMBOL
	SNA			/(RCHM-163) AC '= 0 => ABOUT TO ENTER COMMON
				/(RCHM-163) INITIALIZATION MODE.
	JMP CD28.7		/(RCHM-163) CLEAN UP CONTEXT.
	SAD (131330)		/(RCHM-163) CHECK FOR BLANK COMMON.
	JMP COD12E		/(RCHM-163) BLANK COMMON CANNOT BE INITIALIZED.
CD28.0	JMS NCL.SC		/(RCHM-163) CHECK THE NCL LIST.
	SKP			/(MJH-85)
	JMP COD12E		/(RCHM-163) YES, ERROR.
CD28.1	LAC SIZE		/(RCHM-163) SAVE CURRENT CONTEXT.
	DAC SAV.SZ		/(RCHM-163)
	LAC LOADADR		/(RCHM-163)
	DAC SAV.LD		/(RCHM-163)
	LAC RELOC		/(RCHM-163)
	DAC SAV.RL		/(RCHM-163)
	LAC BLKDSW		/(RCHM-163)
	DAC SAV.BD		/(RCHM-163)
	LAC (300000)		/(RCHM-163) SCAN SYMTAB FOR COMMON BLOCKS.
	JMS SCAN		/(RCHM-163)
	SKP			/(RCHM-163) FOUND
	JMP CD28.6		/(RCHM-163) NOT IN SYMBOL TABLE.
	DAC TEMP1		/(RCHM-163) SAVE COMMON BLOCK SIZE.
	LAC SYMEB1		/(RCHM-163) CHECK TO SEE IF COMMON BLOCK IS IN
	CMA!IAC			/(RCHM-163) RESIDENT CODE AREA (PERHAPS BECAUSE OF
	TAD SYMWD1		/(RCHM-163) SAC SWITCH).
	SMA!SZA			/(RCHM-163) COMMON ASSOCIATED WITH RESIDENT CODE?
	JMP COD12E		/(RCHM-163) YES, GO GIVE ERROR.
/
/ THE COMMON BLOCK TO BE INITIALIZED IS SO FAR:
/
/ 1.	NOT BLANK COMMON.
/ 2.	NOT IN THE NAMED COMMON LIST (NCL)
/ 3.	NOT ASSOCIATED WITH RESIDENT CODE, I.E. VIA EITHER THE SAC
/	SWITCH OR THE RES SWITCH.
/
	LAC* SYMWD1		/(RCHM-163) IF DEFINED THEN WE MAY WISH TO CHECK
	AND (700000)		/(RCHM-163) THE COMMON SIZES AGAINST EXPECTED
	SAD (700000)		/(RCHM-163) SIZES. COMMON ALREADY DEFINED?
	JMP CD28.4		/(RCHM-163) NOT YET.
/
/ THE COMMON BLOCK IS NOW KNOWN TO BE PREVIOUSLY DEFINED WITHIN THIS
/ LINK. WE MUST NOW CHECK AND SET UP THE VARIOUS SIZES AND POINTERS
/ REQUIRED FOR THE PROPER HANDLING OF CODE '02' AND '04' AND '05'.
/
	LAC CBSIZE		/(RCHM-163) DID A '01' CODE APPEAR FOR THIS COMMON
	SNA			/(RCHM-163)
	JMP CD28.2		/(RCHM-163) NO.
	TAD TEMP1		/(RCHM-163) ADD IN DEFINED COMMON SIZE.
	SPA			/(RCHM-163) IS THE NEW EXPECTED SIZE BIGGER?
	JMP LCBSZE		/(RCHM-163) YES, GO GIVE ERROR.
	JMP CD28.3		/(RCHM-163) NO, GO PICK UP RELOCATABLE ADDRESSES.
CD28.2	LAC TEMP1		/(RCHM-163) FETCH SIZE OF COMMON BLOCK.
	CMA!IAC			/(RCHM-163) CONVERT TO NEGATIVE NUMBER AS FROM
				/(RCHM-163) CODE '01' PROCESSING.
	DAC CBSIZE		/(RCHM-163) SET UP COMMON BLOCK SIZE.
CD28.3	JMS DECSPT		/(RCHM-163) MOVE POINTER TO COMMON CHAIN
	LAC SYMPTR		/(RCHM-163) FETCH POINTER TO COMCHN.
	JMS CD12.4		/(RCHM-163) SET UP IN CASE OF BLOCK DATA.
	JMS DECSPT		/(RCHM-163) MOVE POINTER TO LOAD ADDRESS.
	LAC* SYMPTR		/(RCHM-163) FETCH LOAD ADDRESS.
	DAC LOADADR		/(RCHM-163) SET UP LOAD ADDRESS
	DAC RELOC		/(RCHM-163) AND RELOCATION FACTOR.
	JMP BUFCHK		/(RCHM-163) GO GET NEXT LOADER CODE.
/
/ STANDARD UNDEFINED COMMON. SEEN PREVIOUSLY BUT NOT FITTED INTO CORE.
/
CD28.4	LAC CBSIZE		/(RCHM-163) CHECK FOR DEFINED COMMON BLOCK SIZE.
	SNA			/(RCHM-163) CHECK FOR UNSPECIFIED COMMON SIZE.
	LAW -1			/(RCHM-163) DEFAULT SIZE IS -1
	DAC CBSIZE		/(RCHM-163) UPDATE SIZE.
	TAD TEMP1		/(RCHM-163) CHECK AGAINST SIZE LISTED IN TABLE.
	SMA			/(RCHM-163) IS THIS BLOCK BIGGER?
	JMP CD28.5		/(RCHM-163) NO, USE SIZE FROM TABLE.
	LAC CBSIZE		/(RCHM-163) FETCH BLOCK SIZE.
	CMA!IAC			/(RCHM-163) MAKE POSITIVE.
	DAC TEMP1		/(RCHM-163) SAVE FOR LATER.
	AND (700000)		/(RCHM-163) CHECK FOR LENGTH VIOLATION.
	SZA			/(RCHM-163) CAN'T DEFINE BLOCK BIGGER THAN 32K-1.
	JMP CD28E4		/(RCHM-163) BLOCK SIZE ERROR.
	LAC TEMP1		/(RCHM-163) FETCH SIZE.
	XOR (700000)		/(RCHM-163) SET COMMON FLAG.
	DAC* SYMWD1		/(RCHM-163) SET UP NEW SIZE.
CD28.5	LAC* SYMWD1		/(RCHM-163) FETCH COMMON FLAG AND SIZE.
	AND (377777)		/(RCHM-163) MAKE IT A DEFINED COMMON BLOCK.
	DAC* SYMWD1		/(RCHM-163) SET UP NEW COMMON FLAG.
	AND (77777)		/(RCHM-163) STRIP OUT SIZE.
	CMA!IAC			/(RCHM-163) MAKE NEGATIVE.
	DAC CBSIZE		/(RCHM-163) SET UP CBSIZE.
	DAC SIZE		/(RCHM-163) SET UP SIZE
	DAC BLKFLG		/(RCHM-163) SET UP BLK FLAG.
	DAC BLKDSW		/(RCHM-163) NOT BLOCK DATA.
	JMS FIT			/(RCHM-163) FIT BLOCK.
	JMS PRTPRG		/(RCHM-163) PRINT BLOCK NAME.
	JMS DECSPT		/(RCHM-163) MOVE POINTER TO COMMON CHAIN.
	LAC SYMPTR		/(RCHM-163) SET UP COMCHN IN CASE BLOCK DATA.
	JMS CD12.4		/(RCHM-163)
	JMS DECSPT		/(RCHM-163) MOVE POINTER TO LOAD ADDRESS.
	LAC LOADADR		/(RCHM-163) FETCH LOAD ADDRESS.
	DAC* SYMPTR		/(RCHM-163) SET UP LOAD ADDRESS.
/
/ NO GO OFF AND DEFINE ALL COMMON CHAINS IN THIS ELEMENT.
/
	ISZ SYMPTR		/(RCHM-163) PREPARE TO RESOLVE CHAIN ENTRIES.
	JMS DEFCOM		/(RCHM-163) DEFINE ANY AND ALL CHAINED ELEMENTS.
	JMP BUFCHK		/(RCHM-163) GET NEXT LOADER CODE.
/
/ BRAND NEW COMMON BLOCK HAS BEEN ENTERED. SET UP AN ENTRY IN THE SYMBOL
/ TABLE AND GO DEFINE IT THROUGH THE PREVIOUS CODE.
/
CD28.6	LAC CBSIZE		/(RCHM-163) MAKE SURE CBSIZE IS OK.
	SNA!CMA!IAC		/(RCHM-163) CONVERT BACK TO POSITIVE NUMBER
	CLA!IAC			/(RCHM-163) DEFAULT BLOCK SIZE IS 1.
	DAC TEMP1		/(RCHM-163) SET UP FOR ABOVE.
	DAC SYMDEF		/(RCHM-163) BEGIN SETTING UP SYMBOL HEADER
	AND (700000)		/(RCHM-163) CHECK FOR BLOCK TOO BIG.
	SZA			/(RCHM-163) THIS HAD BETTER BE 0.
	JMP CD28E4		/(RCHM-163) BLOCK SIZE ERROR.
	LAC SYMDEF		/(RCHM-163) FETCH BLOCK SIZE
	XOR (700000)		/(RCHM-163) SET UNDEFINED.
	DAC SYMDEF		/(RCHM-163) SET UP SYMBOL HEADER.
	LAC SYMEND		/(RCHM-163) SET UP POINTER TO ENTRY START.
	DAC SYMWD1		/(RCHM-163)
	JMS DEFSYM		/(RCHM-163) DEFINE NEW COMMON BLOCK.
	DZM* SYMEND		/(RCHM-163) START COMMON CHAIN.
	JMS UPSYM		/(RCHM-163) MOVE TABLE BOTTOM.
	DZM* SYMEND		/(RCHM-163) CLEAR LOAD ADDRESS.
	JMS UPSYM		/(RCHM-163) MOVE TABLE BOTTOM
	LAC SYMEND		/(RCHM-163) FETCH END OF TABLE.
	AAC 3			/(RCHM-163) POINT TO END OF BLOCK NAME.
	DAC SYMPTR		/(RCHM-163) PRETEND JUST CALLED SCAN.
	JMP CD28.4		/(RCHM-163) GO DEFINE BLOCK.
/
/ RESTORE PREVIOUS CONTEXT.
/
CD28.7	LAC SAV.SZ		/(RCHM-163)
	DAC SIZE		/(RCHM-163)
	LAC SAV.LD		/(RCHM-163)
	DAC LOADADR		/(RCHM-163)
	LAC SAV.RL		/(RCHM-163)
	DAC RELOC		/(RCHM-163)
	LAC SAV.BD		/(RCHM-163)
	DAC BLKDSW		/(RCHM-163)
	JMP BUFCHK		/(RCHM-163)
/
/ ATTEMPT TO DEFINE COMMON BLOCK BIGGER THAN 32K.
/
CD28E4	JMS ERROR4		/(RCHM-163) PRINT ERROR MESSAGE.
	MES729			/(RCHM-163) COMMON BLOCK TOO BIG.
/ ***	ERROR4 CODES NOT RETURN   *** /
	.EJECT
/ SUBROUTINE FIT: DETERMINE IF PROGRAM SEGMENT WILL FIT INTO AVAILABLE
/ CORE AND COMPUTE THE LOAD ADDRESS AND RELOCATION FACTOR.
 
FIT	0
	LAC	BLKFLG		/(MJH-85) IS THIS A COMMON?
	SNA			/(MJH-85)
	JMP	FITBOT		/(MJH-85) NO -- FIT CODE BOTTOM UP
	LAC	BLKDSW		/(MJH-85) YES -- IS THIS COMMON INIT?
	SZA			/(MJH-85)
	JMP	FITBOT		/(MJH-85) YES -- FIT IT BOTTOM UP
	XCT	RES.SW		/(MJH-85) NO -- IS THIS COMMON RES'D?
	SKP			/(MJH-85)
	JMP	FITTOP		/(MJH-85) YES -- FIT TOP DOWN
	XCT	SIF.HM		/(MJH-85) NO -- DO UNINIT COMMONS GO HIGH?
	JMP	FITBOT		/(MJH-85) NO -- FIT BOTTOM UP
FITTOP	LAC	MAXREG		/(MJH-85) YES -- GET LOAD ADDRESS OF COMMON
	TAD	SIZE		/(MJH-85)
	IAC			/(MJH-85)
	DAC	LOADADR		/(MJH-85) SAVE LOAD ADDR
	DAC	RELOC		/(MJH-85)
	DAC	SLIMFA		/(MJH-85)
	PAL			/(MJH-85)
	LAC	MAXREG		/(MJH-85)
	DAC	SLIMLA		/(MJH-85)
	JMS	SLIM		/(MJH-85) SET UP MAP LINE
	PLA			/(MJH-85) RESET THE POINTER TO 1ST FREE ADDRESS
	AAC	-1		/(MJH-85) FOR TOP DOWN LOADING
	DAC	MAXREG		/(MJH-85)
	LAC	LDLMT2		/(MJH-85)
	AAC	-1		/(MJH-85)
	TCA			/(MJH-85)
	TAD	MAXREG		/(MJH-85)
	SPA			/(MJH-85) CHECK THAT WE HAVE NOT OVERFLOWED
	JMP	FIT99		/(MJH-85) OVERFLOW -- ERROR
	JMS	RES.OF		/(MJH-85) TURN OFF RES.SW ANS SHR.SW AND RETURN
	JMS	SHR.OF		/(MJH-85)
	JMP*	FIT		/(MJH-85)
/
FITBOT	LAC	SIZE	/RE-COMPLIMENT ROUTINE SIZE  (MJH-85)
	TCA		/(MJH-85)
	DAC	SIZE
	LAC	AMREST	/(MJH-95) IS TASK IN BANK OR PAGE?
	SAD	(7777	/(MJH-95)
	SKP!CLA		/(MJH-95) PAGE
	SKP!CLA		/(MJH-95)
	AAC	+4	/(MJH-95) PAGE SET CLTX2 TO END OF CLT
	TAD	(CLT+4	/(MJH-95) SET CLTX2 TO END OF CLT
	DAC	CLTX2
	LAC	(FITRHL)
	DAC	FITX2
/
FFT1	LAC	FITX2	/IS THERE ANY UNUSED CORE WITHIN THIS LINK
	SAD	FITX1	/AND BELOW LDLMT2 (HOLES) THAT HAS NOT BEEN 
			/CHECKED FOR POSSIBLE USE?
	JMP	FFT3	/NO -- RELOCATE ABOVE LDLMT2
	LAC*	FITX2	/YES -- WILL ROUTINE FIT IN HOLE?
	JMS	FFTX
	JMP	FFT10	/YES -- UPDATE HOLE LIMIT AND ASSIGN LOAD ADR
	ISZ	FITX2	/NO -- NEXT HOLE
	JMP	FFT1
/
FFT3	LAC	BLKFLG	/TEST FOR BLOCK DATA OR COMMON BLOCK FIT
	SZA		/REQUEST -- SKIP CORE BOUND TEST IF FOUND
	JMP	FFT20
        LAC     LDLMT2
        AND     (007777	/GET THE PAGE ADDRESS BITS
        AAC     -20	/SUBTRACT 20 TO SEE IF ROUTINE
			/MIGHT START BELOW THE FIRST
			/TWENTY LOCTIONS OF THE PAGE
        SMA
        JMP     .+5	/OK -- NOT IN 1ST TWENTY LOCATIONS
        LAC     LDLMT2	/NO GOOD -- IN 1ST TWENTY
        AND     (770000	/ADJUST THE ADDRESS
        AAC     20
        DAC     LDLMT2
        LAC     LDLMT2
        JMS     FFTX	/WILL THE ROUTINE FIT ABOVE LDLMT2 AND WITHIN
			/THIS CORE BANK OR PAGE?
	JMP	FFT20	/YES -- UPDATE LDLMT2 AND ASSIGN LOAD ADR
	LAC	LDLMT2	/NO -- LEAVE A HOLE
	AND	ADRMSK	/CHECK TO SEE IF LDLMT2 IS ON CORE BOUND
	SNA
	JMP	FFT4A	/YES DON'T LEAVE A HOLE
	LAC	LDLMT2	/YES LEAVE A HOLE 
	DAC*	FITX1
	ISZ	FITX1
FFT4	LAC	CLTX2	/MOVE LDLMT2 TO THE NEXT HIGHEST MEMORY BOUND
	SAD	(CLT)
	JMP	FIT99	/TERMINAL ERROR IF OUT OF CORE
	AAC	-1	/(MJH-85)
	DAC	CLTX2
	LAC	LDLMT2
	TCA		/(MJH-85)
	TAD*	CLTX2
	SPA
	JMP	FFT4
	LAC	BLKFLG	/AVOID AUTO INDEX REGISTERS UNLESS BLOCK DATA
	SNA		/OR COMMON BLOCK FIT REQUEST
	LAC	(020)
	IAC		/(MJH-85)
	TAD*	CLTX2
	DAC	LDLMT2
	JMP	FFT3
FFT4A	LAC	LDLMT2	/PREVENT SKIPPING A PAGE OR BANK BOUND WHEN
	AAC	-1	/UPDATING CORE LIMITS (MJH-85)
	DAC	LDLMT2
	JMP	FFT4	/UPDATE LDLMT2 BUT DON'T LEAVE A HOLE
/
FFT10	LAC*	FITX2	/UPDATE HOLE LIMIT
	DAC	FITT1
	TAD	SIZE
	DAC*	FITX2
	JMP	FFT30
/
FFT20	LAC	LDLMT2	/UPDATE LDLMT2
	DAC	FITT1
	TAD	SIZE
	DAC	LDLMT2
	LAC	BLKFLG	/(MJH-85) IS THIS A COMMON?
	SNA		/(MJH-85)
	JMP	FFT20A	/(MJH-85) NO
	LAC	BLKDSW	/(MJH-85) YES -- IS COMMON INIT?
	SZA		/(MJH-85)
	JMP	FFT20A	/(MJH-85) YES
	LAC	LDLMT2	/(MJH-85) NO -- CHECK FOR AN OVERFLOW
	AAC	-1	/(MJH-85) SEE IF MAXREG HAS PASSED LDLMT2
	TCA		/(MJH-85)
	TAD	MAXREG	/(MJH-85)
	SPA		/(MJH-85)
	JMP	FIT99	/(MJH-85) OVERFLOW -- ERROR
	JMP	FFT30	/(MJH-85)
FFT20A	LAC	LDLMT2	/(MJH-85) CODE OR INIT COMMON LOAED
	TAD	(-77777	/(MJH-85) BE SURE IT IS BELOW 32K
	SMA!SZA		/(MJH-85)
	JMP	FIT99	/(MJH-85) ABOVE 32K -- ERROR
/
FFT30	LAC	FITT1	/ASSIGN LOAD ADDRESS AND RELOCATION BIAS
	DAC	LOADADR
	DAC	RELOC
	DAC	SLIMFA	/SET LOAD LIMITS (AND SIZE) IN MAP LINE
	TAD	SIZE
	AAC	-1	/(MJH-85)
	DAC	SLIMLA
	JMS	SLIM
/
	LAC	SIZE	/RE-RE-COMPLIMENT ROUTINE SIZE
	TCA		/(MJH-85)
	DAC	SIZE
	JMS	RES.OF		/(MJH-85)
	JMS	SHR.OF		/(MJH-85)
	JMP*	FIT	/EXIT FIT ROUTINE
/
/ FFTX -- SUBROUTINE TO DETERMINE WHETHER FGD ROUTINE WILL FIT IN THE
/ REMAINDER OF A PAGE OR BANK.  THE FIRST AVAILABLE REGISTER IS IN AC AT
/ ENTRY.  RETURN AT JMS+1 IF FIT.  RETURN AT JMS+2 IF NO FIT.
/
FFTX	0
	DAC	FITT1
	AND	ADRMSK
	SNA	/IS LDLMT2 ON A CORE BOUND?
	JMP	FFTXA	/YES CAN'T FIT HERE
	TAD	SIZE
	AAC	-1	/(MJH-85)
	AND	OPCMSK
	SZA
FFTXA	ISZ	FFTX
	JMP*	FFTX
/
/
FITT1	0
FITTAD	0
FITRHL	.BLOCK 11	/REMAINING-HOLES-LIST (RHL)
FITX1	0	/RHL INDEX (POINTS TO NEXT ENTRY)
FITX1R	FITRHL	/RESET WORD FOR FITX1
FITX2	0	/RHL SCAN INDEX
/
FIT99	JMS	TYPE	/OUT OF CORE -- TYPE ERROR MESSAGE
	MES711		/AND EXIT TO MONITOR  (MJH-85)
	JMP	EXIT
/
	.EJECT
	.TITLE *** MISC SUBROUITNES ***
/
/ ROUTINE TO EXIT WITH MESSAGE AND PRINT CONTENTS OF SYM1 AND SYM2
/
ERROR4	0
	LAC*	ERROR4		/(MJH-85)
	DAC	.+2		/(MJH-85)
	JMS	TYPE		/(MJH-85)
	XX			/(MJH-85)
	JMS	SYMMAP		/(MJH-85)
	JMS	SHTMAP		/(MJH-85)
	JMS	TYPMAP		/(MJH-85)
	JMP	EXIT		/(MJH-85)
/+
/ NAMED COMMON LIST (NCL) SCANNER. SCANS THE NCL FOR THE NAMED COMMON
/ APEARING IN SYM1 AND SYM2.
/
/ SYM1 ONE CONTAINS THE TWO WORD ENTRY BIT AND THE FIRST 3 CHARACTERS
/ OF THE COMMON NAME. SYM2 CONTAINS THE LAST THREE CHARACTERS OF THE
/ COMMON NAME, IF THE TWO WORD BIT IS SET. OTHERWISE, SYM2 CONTAINS
/ 0.
/
/ CALL:
/
/	...			/ SET UP SYM1 AND SYM2.
/	JMS NCL.SC		/ CALL SCANER.
/	JMP NOT.FN		/ NOT FOUND RETURN.
/-
/
/ GLEANED FROM CHAIN 170 *********************
/
NCL.SC	XX			/ NCL SCANNER ENTRY POINT.
	LAC NCL.BS		/ FETCH BASE ADDRESS OF NCL.
	DAC NCL.PT		/ SET UP FOR SCAN OF NCL.
NCL.S1	LAC NCL.PT		/ FETCH LIST POINTER.
	SAD RCLBSE		/ ARE WE AT THE END OF THE LIST? (MJH-85)
	JMP* NCL.SC		/ YES, TAKE NOT FOUND EXIT.
	LAC* NCL.PT		/ FETCH FIRST HALF OF LIST ENTRY.
	AND (577777)		/ EXTRACT PERTENENT INFORMATION.
	SMA!STL			/ SET NEXT CHECK BIT IN LINK.
	CLL			/ CLEAR LINK IF ONLY ONE WORD IN ENTRY.
	XOR SYM1		/ CHECK TO SEE IF IT EQUALS SYM1.
	SZA			/ DO WE MATCH THUS FAR?
	JMP NCL.S2		/ GO TO NEXT LIST ENTRY.
	SNL			/ MUST WE CHECK MORE?
	JMP NCL.S4		/ NO, RETURN TO CALLER.
	ISZ NCL.PT		/ CHECK NEXT ENTRY IN LIST.
	LAC* NCL.PT		/ FETCH LAST HALF OF ENTRY.
	AND	(177777		/(MJH-85)
	XOR SYM2		/ CHECK AGAINST SYM2.
	SZA			/ DOES IT MATCH?
	JMP NCL.S3		/ NO, GO TO NEXT LIST ENTRY.
	LAC NCL.PT		/ BACK UP FOUND POINTER.
	AAC -1			/ BY ONE.
	DAC NCL.PT		/ POINTER NOW JUSTIFIED PROPERLY.
NCL.S4	ISZ NCL.SC		/ BUMP RETURN POINTER TO INDICATE FOUND.
	JMP* NCL.SC		/ RETURN TO CALLER.
NCL.S2	ISZ NCL.PT		/ MOVE POINTER TO SECOND HALF OF LIST ENTRY.
NCL.S3	ISZ NCL.PT		/ MOVE POINTER TO NEXT LIST ENTRY.
	JMP NCL.S1		/ CHECK NEXT ENTRY.
	.EJECT
/
/ ROUTINE TO SET UP FLAGS FOR BLANK COMMON.
/
/ GLEANED FORM CHAIN 170 *********************
/
CK.XX	XX			/(RCHM-158) ROUTINE ENTRY POINT.
	LAC (131330)		/(RCHM-158) FETCH NAME.
	DAC SYM1		/(RCHM-158) SET UP NAME.
	DZM SYM2		/(RCHM-158) CLEAR 2ND HALF.
	JMS RV.SET		/(RCHM-158) SET UP RES AND SHR SWITCH.
	JMP* CK.XX		/(RCHM-158) RETURN TO CALLER.
/
/ SET UP RES.SW AND SHR.SW ACCORDING TO STATE OF NCL
/
/ GLEANED FROM CHAIN 170 *********************
/
RV.SET	XX			/(RCHM-158) ROUTINE ENTRY POINT.
	JMS SHR.OFF		/(RCHM-158) TURN SHR OFF.  (MJH-85)
	JMS RES.OFF		/(RCHM-158) TURN RES OFF.
RV.S1	JMS NCL.SC		/(RCHM-158) SCAN NCL FOR SYM1 AND SYM2.
	JMP* RV.SET		/(RCHM-158) NOT FOUND, RETURN.
	LAC* NCL.PT		/(RCHM-158) CHECK SHR SWITCH.
	RTL			/(RCHM-158)
	SZL			/(RCHM-158)
	JMS SHR.ON		/(RCHM-158) TURN ON SHR.  (MJH-85)
	ISZ NCL.PT		/(RCHM-158) POINT TO RES SWITCH.
	LAC* NCL.PT		/(RCHM-158) FETCH STATE OF RES SWITCH.
	SPA			/(RCHM-158)
	JMS RES.ON		/(RCHM-158) TURN ON RES.
	JMP* RV.SET		/(RCHM-158) RETURN.
	.TITLE ***  ROUTINES TO MANIPULATE SHR AND RES SWITCHES.
/+
/ THESE ROUTINES SET, RESET, AND INITIALIZE THE NCL, SHR, RES, AND
/ RCL LISTS AND SWITCHES.
/-
/
/ GLEANED FROM CHAIN 170 *********************
/
SHR.ON	XX			/ TURN SHR ON.
	LAC (SKP)		/ FETCH SHR ON FLAG.
	DAC SHR.SW		/ TURN ON SHR.
	JMP* SHR.ON		/ RETURN TO CALLER.
/
SHR.OFF	XX			/ TURN SHR OFF.
	LAC (NOP)		/ FETCH SHR OFF FLAG.
	DAC SHR.SW		/ TURN OFF SHR.
	JMP* SHR.OFF		/ RETURN TO CALLER.
/
RES.ON	XX			/ TURN RES ON.
	LAC (SKP)		/ FETCH RES ON FLAG.
	DAC RES.SW		/ TURN ON RES.
	JMP* RES.ON		/ RETURN TO CALLER.
/
RES.OFF	XX			/ TURN RESS OFF.
	LAC (NOP)		/ FETCH RES OFF FLAG.
	DAC RES.SW		/ TURN OFF RES
	JMP* RES.OFF		/ RETURN TO CALLER.
/
/ VIRTUAL -- SUBROUTINE TO SEARCH FOR AN UNRESOLVED GLOBAL
/            SYMBOL REFERENCE (CODES 1 OR 5) OR A DUMMY 
/	  GLOBAL SYMBOL ENTRY (CODE 6).
/
VIRTUAL	0
 
	JMS BEGSYM	/START AT BEG OF SYMTAB.
	JMS FINDCOD	/SEARCH FOR
	100000		/VIRTUAL GLOBAL ENTRY.
	JMP	.+3	/RETURN HERE IF NOT FOUND
	IDX VIRTUAL	/HERE IF FOUND.
	JMP* VIRTUAL
	JMS	BEGSYM	/START AT BEG OF SYMTAB
	JMS	FINDCOD	/SEARCH FOR
	600000		/DUMMY GLOBAL ENTRY
	JMP*	VIRTUAL	/RETURN HERE IF NOT FOUND
	IDX	VIRTUAL	/HERE IF FOUND
	JMP*	VIRTUAL
/
/ SUBROUTINE FINDCOD: STARTING AT THE CURRENT POSITION OF SYMWD1, SEARCH THRU
/ THE SYMBOL TABLE FOR AN ENTRY WHOSE CODE MATCHES THE CODE FOLLOWING THE
/ JMS FINDCOD. SKIP ON RETURN IF FOUND.
 
FINDCOD	0
 
	LAC SYMWD1	/ARE WE AT THE END OF
NEXCOD	SAD SYMEND	/THE SYMBOL TABLE?
	JMP NOFIND	/YES.
 
	LAC* SYMWD1	/GET 1ST WORD OF ENTRY IN SYMTAB.
	AND (700000)	/(700000 MASK TO CODE BITS.
	SAD* FINDCOD	/MATCH?
	JMP .+3		/YES.
 
NOMATCH	JMS NXNTRY	/MOVE POINTER TO THE NEXT ENTRY.
	JMP NEXCOD
 
FOUND	IDX FINDCOD
NOFIND	IDX FINDCOD
	JMP* FINDCOD
 
	.EJECT
/ LIBRARY SEARCH SUBROUTINE: LOAD IN ALL REQUESTED
/ LIBRARY ROUTINES.
 
LIBRARY	0
	AND (777
	DAC LIBCLOS		/SETUP LIBRARY .CLOSE.
	JMS	SEEK		/'SEEK' FILE ON DEVICE WHOSE
				/.DAT SLOT NUMBER IS IN AC
	.IFDEF	RSX
	JMP	NOLIB	/LIBRARY NOT FOUND CHECK FOR USER LIBRARY
	.ENDC
MORLIB	SET LIBFLG		/SET LIBR MODE FLAG FOR SELECTIVE
				/LOADING.
	JMS VIRTUAL		/ARE THERE ANY UNRESOLVED GLOBALS?
	.IFUND	RSX
	JMP	LIBCLOS	/NO.
	.ENDC
	.IFDEF	RSX
	JMP	LIBC
	.ENDC
 
NEXLIB	LAC	LIBCLOS		/GET CAL TO THE CORRECT DAT SLOT.
	JMS LDPROG		/LOAD IN LIBRARY SUBPROGRAM ONLY
				/IF IT IS REQUESTED IN THE SYMBOL
				/TABLE AS A VIRTUAL GLOBAL. IF
				/LIBRARY END OF FILE IS ENCOUN-
				/TERED, CONTROL IS RETURNED TO
				/LOCATION 'LIBCLOS'. IF THE NEXT
				/PROGRAM IN THE LIBRARY WAS
				/INDEED LOADED, LIBFLG WILL BE 0
				/ON RETURN.
	LAC LIBFLG		/WAS NEXT LIBR PROGRAM READ IN?
	SZA
	JMP NEXLIB		/NO. TRY NEXT SUBPROGRAM.
	JMP MORLIB		/YES. DO ANY MORE NEED TO BE READ IN?
 
/ IF SUBROUTINE LDPROG DETECTS THE LIBRARY END-OF-FILE,
/ IT WILL RETURN CONTROL HERE.
	.IFUND	RSX
 
LIBCLOS	.CLOSE 0			/.CLOSE THE LIBRARY FILE.
	.ENDC
	.IFDEF	RSX
LIBC	CAL	CLOLIB
	.ENDC
	DZM LIBFLG
	.IFDEF	RSX
	ISZ	LIBRARY
	.ENDC
	JMP*	LIBRARY
/
/
	.IFDEF	RSX
NOLIB	LAC	LIBCLOS	/LOOK TO SEE IF IT IS THE USER'S
	SAD	(UL)	/LIBRARY THAT IS WANTED
	SKP		/YES IGNORE REQUEST
	JMP	ER700	/NO ERROR NO SYSTEM LIBRARY
	JMP*	LIBRARY
	.ENDC
	.EJECT
 
/ SUBROUTINE DEFSYM: ENTER 3 WORDS INTO THE SYMBOL TABLE: SYMBOL
/ DEFINITION, SYMBOL 1, AND SYMBOL 2.
 
DEFSYM	0
 
	LAC SYMDEF	/1ST WORD IS THE DEFINITION.
	JMS ENTSYM
	LAC SYM1		/IF BIT0=1, THERE IS A SYM2.
	SMA
	JMP .+3		/SYMBOL NAME IS <4 CHARS.
	JMS ENTSYM	/ENTER 1ST HALF OF SYMBOL NAME.
	LAC SYM2		/2ND HALF OF SYMBOL NAME.
	JMS ENTSYM	/ENTER WORD2 OR WORD3.
	JMP* DEFSYM
 
/ SUBROUTINE ENTSYM: ENTER THE WORD IN THE AC AT THE END OF THE SYMBOL
/ TABLE AND MOVE THE POINTER TO THE END OF THE SYMBOL TABLE UP ONE.
 
ENTSYM	0
 
	DAC* SYMEND	/STORE DATA AT END OF TABLE.
	JMS UPSYM		/INDEX END POINTER.
	JMP* ENTSYM
 
/ SUBROUTINE UPSYM: INDEX POINTER TO END OF SYMBOL TABLE AND TEST
/ FOR OVERFLOW.
 
UPSYM	0
 
	LAW -1
	TAD SYMEND
	DAC SYMEND
	TCA		/(MJH-85)
	TAD PTBX1		/LOWEST REGISTER AVAILABLE TO SYMTAB.
	SPA!SNA		/OVERFLOW?
	JMP* UPSYM	/NO.
TBLOVL	LAC	(MES701)
	JMP	TERR
 
	.EJECT
/ SUBROUTINE NXNTRY: MOVE SYMBOL TABLE POINTERS OVER THE CURRENT ENTRY
/ TO THE BEGINNING OF THE NEXT ENTRY.
 
NXNTRY	0
 
	LAC SYMWD1	/POINTER TO 1ST WORD OF CURRENT ENTRY.
	DAC SYMPTR
	JMS NEXSYM	/GET 1ST HALF OF SYMBOL NAME.
	SPA		/IF BIT0=1, NAME IS 2 WORDS LONG.
	JMS DECSPT
	JMS DECSPT
 
	LAC* SYMWD1	/LOOK AT CODE BITS IN WORD 1.
	AND (300000	/LOOK FOR COMMON BLOCK CODE: 3 OR 7.
	SAD (300000	/COMMON BLOCK?
	SKP		/YES.
	JMP .+3		/NO.
	JMS DECSPT	/COMMON BLOCK ENTRY IS 2 WORDS LONGER
	JMS DECSPT	/THAN ALL OTHERS.
 
	LAC SYMPTR	/POINTING AT 1ST WORD OF NEXT ENTRY.
	DAC SYMWD1
	JMP* NXNTRY
 
/ SUBROUTINE NEXSYM: INDEX THE SYMBOL TABLE POINTER AND PICK UP THE
/ NEXT WORD.
 
NEXSYM	0
 
	JMS DECSPT
	LAC* SYMPTR
	JMP* NEXSYM
 
/ SUBROUTINE DECSPT:
 
DECSPT	0
 
	LAW -1
	TAD SYMPTR
	DAC SYMPTR
	JMP* DECSPT
 
/ SUBROUTINE BEGSYM:
 
BEGSYM	0
 
	LAC SYMBEG
	DAC SYMWD1
	DAC SYMPTR
	JMP* BEGSYM
 
	.EJECT
/ SCAN -- SUBROUTINE TO SCAN THE SYMBOL TABLE FOR THE NAME
/	IN SYM1 & SYM2 WITH THE SAME CODE BITS 1 & 2 AS THE
/	WORD IN AC.
/
/ IF FOUND -- RETURN AT JMS+1 WITH 15-BIT DEFINITION IN AC
/ IF NOT FOUND -- RETURN AT JMS+2 WITH ZERO IN AC
/
/ SEARCH FROM THE BEGINNING OF THE SYMBOL TABLE FOR:
/ A COMMON BLOCK NAME ENTRY (CODE 3 OR 7), A GLOBAL
/ SYMBOL ENTRY (CODE 1 OR 5), OR A DUMMY GLOBAL ENTRY (CODE 6)
/ WHOSE NAME MATCHES SYM1 AND SYM2. RETURN 0 IF NOT FOUND. RETURN
/ 15-BIT DEFINITION OF THE ENTRY IF FOUND.
/
/ WHEN A NAME MATCH IS FOUND, SYMPTR IS LEFT POINTING TO THE LAST WORD
/ OF THE NAME & SYMWD1 IS LEFT POINTING TO THE ID/BLOCK-SIZE WORD.
/
SCAN	0
	DAC	SYMDEF	/SAVE SYMBOL DEFINITION WITH CODE BITS
	JMS BEGSYM	/START AT BEGINNING OF SYMTAB.
NEXSCAN	SAD SYMEND	/END OF SYMBOL TABLE?
	JMP RTNZERO	/YES. NO MATCH. RETURN 0.
 
	LAC* SYMWD1	/PICKUP ENTRY'S 1ST WORD.
	XOR SYMDEF	/MATCH WITH SEARCH CODE BITS.
	AND (300000
	SZA		/SKIP IF PROPER CODE.
	JMP MORSCAN
 
	JMS NEXSYM	/GET 1ST HALF OF SYMBOL NAME.
	SAD SYM1		/MATCH?
	SKP		/YES.
	JMP MORSCAN	/NO.
 
	SMA		/IS NAME 2 WORDS LONG?
	JMP RTNDEF	/NO. ENTRY HAS BEEN FOUND.
 
	JMS NEXSYM	/GET 2ND HALF OF SYMBOL NAME.
	SAD SYM2		/MATCH?
	JMP RTNDEF	/YES. ENTRY HAS BEEN FOUND.
 
MORSCAN	JMS NXNTRY	/NO. SKIP TO BEGINNING OF NEXT ENTRY.
	JMP NEXSCAN
 
RTNZERO	CLA!SKP		/RETURN 0 IN AC WHEN NOT FOUND.
RTNDEF	LAC* SYMWD1	/RETURN 15-BIT DEFINITION OF THE ENTRY
	AND (77777	/WITHOUT THE CODE BITS.
	SNA		/0 RETURNED IN AC IF NOT FOUND.
	IDX SCAN		/NOT FOUND.
	JMP* SCAN		/FOUND.
	.EJECT
 
/ SUBROUTINE DEFCOM: GO THROUGH THE COMMON BLOCK CHAIN AND DEFINE
/ EACH MEMBER (IF ANY) OF THE COMMON BLOCK.
 
DEFCOM	0
 
	LAC*	SYMPTR	/GET STARTING ADDRESS OF THE CHAIN.
	DZM*	SYMPTR	/SET CHAIN WORD TO 0 TO INDICATE THAT
			/THERE ARE NO UNRESOLVED CHAIN MEMBERS.
 
DEFLOOP	SNA		/ARE THERE ANY MORE CHAIN MEMBERS?
	JMP* DEFCOM	/NO.
	DAC	SYMPTR	/FOLLOW SYMBOL TABLE CHAIN, MAKING
	JMS	DECSPT	/A PATCH TABLE ENTRY (CODE=0) FOR EACH
	LAC*	SYMPTR	/TRANSFER VECTOR TO THE DEFINED COMMON BLOCK.
	AND	(077777)
	DAC	PTBW1
	JMS	DECSPT
	LAC*	SYMPTR
	TAD	LOADADR
	DAC	PTBW2
	JMS	PTBENT
	ISZ	SYMPTR
	ISZ	SYMPTR
	LAC*	SYMPTR
	AND	(077777)
	JMP	DEFLOOP
/
ERR106	LAC	(MES706)
	JMP	TERR
ERR115	LAC	(MES715)
	JMP	TERR
	.TITLE *** MESSAGES ***
/
/ TELETYPE OUTPUT MESSAGES.  THE TWO WORDS PRECEDING EACH
/ MESSAGE ARE USED AS AN IOPS ASCII HEADER.  THE ONLY HEADER
/ REQUIREMENT FOR TTY OUTPUT IS A GREATER THAN ONE WORD-
/ PAIR COUNT.
/
	MES603-MES602/2*1000+1002
	0
MES602	.ASCII	/LINK TABLE/<015>
	MES604-MES603/2*1000+1002
	0
MES603	.ASCII	/RESIDENT CODE/<015>
	MES605-MES604/2*1000+1002
	0
MES604	.ASCII	/LINK -- /<175>
	MES610-MES605/2*1000+1002
	0
MES605	.ASCII	/BLANK COMMON/<015>
	MES620-MES610/2*1000+1002
	0
MES610	.ASCII	/PAUSE/<175>
	MES621-MES620/2*1000+1002
	0
MES620	.ASCII	/LOAD: /<175>
	MES690-MES621/2*1000+1002
	0
	.IFUND	RSX
MES621	.ASCII	/ & ^P /<175>
	.ENDC
	.IFDEF	RSX
MES621	.ASCII	/ & RESUME /<15>
	.ENDC
	MES700-MES690/2*1000+1002
	0
MES690	.ASCII	/CORE REQ'D/<015>
	.IFUND	RSX
MES700=.+1
	.ENDC
	.IFDEF	RSX
	MES701-MES700/2*1000+1002
	0
MES700	.ASCII	'I/O ERROR '<175>
	.ENDC
	MES702-MES701/2*1000+1002
MES701	.ASCII	/TABLE OVERLAP/<15>
	MES703-MES702/2*1000+1002
	0
MES702	.ASCII	/CORE OVERFLOW/<15>
	MES705-MES703/2*1000+1002
	0
	.IFUND	RSX
MES703	.ASCII	/EOM, ^P TO RESTART /<175>
	.ENDC
	.IFDEF	RSX
MES703	.ASCII	/EOM, RESUME TO RESTART /<175>
	.ENDC
	MES706-MES705/2*1000+1002
	0
MES705	.ASCII	/READ ERROR/<15>
	MES707-MES706/2*1000+1002
	0
MES706	.ASCII	/ILLEGAL LOADER CODE/<15>
	MES710-MES707/2*1000+1002
	0
MES707	.ASCII	/LABELED COMMON BLK SIZE ERR -- /<175>
	MES711-MES710/2*1000+1002
	0
MES710	.ASCII	/UNRESOLVED GLOBAL(S):/<15>
	MES715-MES711/2*1000+1002
	0
MES711	.ASCII	/TASK IS LARGER THAN PARTITION/<15>
	MES720-MES715/2*1000+1002
	0
MES715	.ASCII	/ABS PROG/<15>
	MES721-MES720/2*1000+1002
	0
MES720	.ASCII	/MISSING GLOBAL DEF -- /<175>
	MES722-MES721/2*1000+1002
	0
MES721	.ASCII	/DUPLICATE GLOBAL DEF -- /<175>
	MES723-MES722/2*1000+1002
	0
MES722	.ASCII "COMMON BLOCKS DECLARED RESIDENT"<15>
	MES724-MES723/2*1000+1002
	0
MES723	.ASCII "SHARED COMMON BLOCKS"<15>
	MES725-MES724/2*1000+1002
	0
MES724	.ASCII "MINIMUM EFFECTIVE PARTITION SIZE:"<175>
	MES726-MES725/2*1000+1002
	0
MES725	.ASCII "ABSOLUTE LOAD ADDRESS"<175>
	MES727-MES726/2*1000+1002
	0
MES726	.ASCII "GLOBAL SYMBOL TOO BIG --"<175>
	MES728-MES727/2*1000+1002
	0
MES727	.ASCII "ILLEGAL ATTEMPT TO INITIALIZE COMMON BLOCK --"<175>
	MES729-MES728/2*1000+1002
	0
MES728	.ASCII "*** BLOCK DATA SUBROUTINE --"<175>
	MES730-MES729/2*1000+1002
	0
MES729	.ASCII "COMMON BLOCK TOO BIG --"<175>
	MES731-MES730/2*1000+1002
	0
MES730	.ASCII "SPLIT, COMMONS TOP DOWN"<175>
	MES732-MES731/2*1000+1002
	0
MES731	.ASCII "BOTTOM UP, COMMONS LAST"<175>
	MES733-MES732/2*1000+1002
	0
MES732	.ASCII "BOTTOM UP"<175>
	MES734-MES733/2*1000
	0
MES733	.ASCII "ACTUAL PARTITION SIZE:"<175>
	MES735-MES734/2*1000+1002
	0
MES734	.ASCII "VIRTUAL PARTITION SIZE:"<175>
	MES736-MES735/2*1000+1002
	0
MES735	.ASCII "EFFECTIVE PARTITION SIZE:"<175>
	SIZE-MES736/2*1000+1002
	0
MES736	.ASCII "ALLOC. STRATEGY:"<175>
/
SIZE	0		/2'S COMPLEMENT OF PROGRAM SIZE.
WRDCNT	0		/IOPS BINARY BLOCK WORD COUNT.
CDWCNT	0		/CODE WORD BLOCK COUNTER.
CODEWD	0		/CODE WORD CONTAINS 3 LOADER CODES.
SYMDEF	0		/TEMP REGISTER FOR THE 1ST WORD OF A SYMTAB
			/ENTRY: CODE + DEFINITION.
SYM1	0		/1ST 3 CHARS OF A SYMBOL (RADIX-50)
SYM2	0		/2ND 3 CHARS OF A SYMBOL.
FNM1	0	/1ST THREE CHARS OF A FILE NAME (RADIX-50)
FNM2	0	/2ND THREE CHARS OF A FILE NAME
DATA1	0		/TEMP STORAGE FOR A DATA INITIALIZATION CONSTANT.
DATA2	0		/(DATA1, DATA2, & DATA3 MUST BE CONTIGUOUS
DATA3	0		/AND IN THIS ORDER)
DGSNB	.BLOCK 2		/DUPL GLOBAL SYMBOL NAME BUFFER
COMCHN	0
COMDEF	0
STRING	0
/
	.IFUND	RSX
DATP=.			/.DAT ZERO POINTER
	.IFDEF	DZP
	DZP
	.ENDC
	.IFUND	DZP
	123
	.ENDC
	.ENDC
	.TITLE *** MICS SUBROUTINES ***
/ SYMMAP -- SUBROUTINE TO CONVERT THE SYMBOL NAME IN SYM1 & SYM2
/           FROM RADIX 50 TO 7-BIT IMAGE ALPHA AND STORE THE
/           RESLUTING SIX WORDS IN MAPNAM THRU MAPNAM+5
/
SYMMAP	0
	LAC	(MAPNAM)
	DAC	MAPX1
	LAC	SYM1
	AND	(377777)
	JMS	CONVERT
	LAC	SYM1
	SMA
	DZM	SYM2
	LAC	SYM2
	AND	(377777)
	JMS	CONVERT
	LAC	BLKFLG		/(MJH-85)
	SZA			/(MJH-85)
	SKP!CLA			/(MJH-85)
	LAC	EXT		/(MJH-85)
	IDX	MAPX1		/(MJH-85)
	JMS	CONVERT		/(MJH-85)
	JMP*	SYMMAP
/
CONVERT	0
	JMS	DIVIDE
	-3100
	JMS	DIVIDE
	-50
	JMS	DIVIDE
	-1
	JMP*	CONVERT
	.EJECT
/
DIVIDE	0
	DZM	DIVQUO
DIVLP	DAC	DIVREM
	TAD*	DIVIDE
	SPA
	JMP	.+3
	ISZ	DIVQUO
	JMP	DIVLP
/
	LAC	DIVQUO
	SNA
	LAW -40
	SAD (33
	LAW -33
	SAD (34
	LAC (33
	SAD (47
	LAW -35
	AAC	-33		/(MJH-85)
	SPA
	AAC	55		/(MJH-85)
	AAC	56		/(MJH-85)
	DAC*	MAPX1
	ISZ	MAPX1
	LAC	DIVREM
	ISZ	DIVIDE
	JMP*	DIVIDE
/
DIVQUO	0
DIVREM	0
/
/ ADROUT -- SUBROUTINE TO CONVERT THE OCTAL ADDRESS (6-DIGITS)
/           IN AC TO IMAGE ALPHA AND STORE THE FIVE RESULTING
/           WORDS STARTING AT THE ADDRESS IN 'MAPX1'
/	  MAPX1 IS LEFT POINTING TO THE LAST CHARACTER
/	  ADDRESS PLUS TWO.
/
ADROUT	0
	RAL			/(MJH-85)
	DAC	CTRBF
	LAW	-6		/(MJH-85)
	DAC	CTRC1
ADROT1	LAC	CTRBF
	RAL
	RTL
	DAC	CTRBF
	AND	(007)
	XOR	(060)
	DAC*	MAPX1
	ISZ	MAPX1
	ISZ	CTRC1
	JMP	ADROT1
	ISZ	MAPX1
	JMP*	ADROUT
	.EJECT
/ CTR50 -- SUBROUTINE TO CONVERT THE THREE SIXBIT CHARACTERS IN
/          AC TO RADIX 50 AND LEAVE THE RESULT IN AC
/
CTR50	0
	DAC	CTRBF
	LAW	-3
	DAC	CTRC1
	DZM	CTRAC
CTRLOP	LAC	CTRBF
	RTL
	RTL
	RTL
	RAL
	DAC	CTRCB
	RAR
	DAC	CTRBF
	LAC	CTRCB	/PROCESS .SIXBT CHARACTER (BLANK=00)
	AND	(077)
	AAC	-33		/(MJH-85)
	SPA
	JMP	CTRAZB	/ A-Z  BLANK
	SAD	(23)
	LAC	(24)	/ .
	SAD	(12)
	LAC	(23)	/ %
	SAD	(10)
	LAC	(37)	/ #
	TAD	(-23)	/ 0-9  .  %  #
CTRAZB	TAD	(+33)	/ A-Z  BLANK  0-9  .  %  #
	TAD	CTRAC
	ISZ	CTRC1
	SKP
	JMP*	CTR50
	DAC	CTRAC
	LAW	-50
	DAC	CTRC2
	CLA
	TAD	CTRAC
	ISZ	CTRC2
	JMP	.-2
	DAC	CTRAC
	JMP	CTRLOP
/
CTRBF	0
CTRCB	0
CTRAC	0
CTRC1	0
CTRC2	0
	.EJECT
/ SEEK -- SUBROUTINE TO PREPARE A FILE TO BE READ.
/         IF FROM A FILE-ORIENTED DEVICE, SEEK FILE.
/         IOPS13 IF FILE NOT FOUND.
/         IF FROM A NON FILE ORIENTED DEVICE, THE REQ'D 
/         FILE NAME IS TYPED OUT, AND CHAIN WAITS FOR
/         A ^P BEFORE READING THE FILE.
/
SEEK	0		/ENTER WITH .DAT SLOT NO IN AC 
	AND	(0777)	/SET .DAT SLOT NOS IN CALLS
	.IFUND	RSX
	DAC	SKIT
	.ENDC
	DAC	SKSK
	.IFDEF	RSX
	LAC	SDPTR	/PICK UP THE POINTER TO THE FILE NAME
	DAC	LIBN+2	/SAVE IT TO MOVE FILE NAME
	LAC*	LIBN+2	/PICK UP THE FIRST WORD
	DAC	LIBN	/PUT IT TIN THE REQUEST
	ISZ	LIBN+2	/POINT TO THE NEXT WORD
	LAC*	LIBN+2	/PICK UP THE SECOND WORD
	DAC	LIBN+1	/SAVE IT
	ISZ	LIBN+2	/POINT TO THE LAST WORD
	LAC*	LIBN+2	/GET THE EXTENSION
	DAC	LIBN+2	/SAVE IT
/
	.ENDC
	LAC	SDPTR	/SAVE FILE NAME IN RADIX-50 (FNM1 & FNM2) AND
	DAC	TEMP11	/SIX-BIT (T6BW1 & T6BW2) FOR TYPE OUT IF A
	LAC*	TEMP11	/NON-FILE-ORIENTED DEVICE.
	DAC	T6BW1
	JMS	CTR50
	DAC	FNM1
	ISZ	TEMP11
	LAC*	TEMP11
	DAC	T6BW2
	JMS	CTR50
	DAC	FNM2
	SNA
	JMP	SKIT
	LAC	FNM1
	XOR	(400000)
	DAC	FNM1
/
	.IFUND	RSX
SKIT	.INIT	0,0,0	/INITIALIZE DEVICE HANDLER
	LAC	SKIT+3	/FILE ORIENTED DEVICE (BUF SIZE > 63)?
	AND	(700)
	SNA		/YES -- SEEK FILE 
	JMP	SKCP	/NO -- TYPE NAME & WAIT FOR ^P
SKSK	.SEEK	0,0	/SEEK FILE & EXIT
	.ENDC
	.IFDEF	RSX
SKIT	CAL	SEEKA
	JMS	WFENEV
	SKP
	JMP	ER700	/IO ERROR
	SAD	(-6)	/IS IT ILLEGAL FUNCTION
	JMP	SKCP
	SPA		/IS THERE STILL AN ERROR?
	JMP*	SEEK	/YES RETURN +1
	ISZ	SEEK	/NO RETUNR +2
	.ENDC
	JMP*	SEEK
	.IFUND	RSX
SDPTR=SKSK+2	/EXTERNALLY MODIFIED SEEK DATA POINTED IS
	.ENDC
		/WITHIN .SEEK MACRO.
/
SKCP	JMS	TYPE	/TYPE:
	MES620		/   LOAD XXXXX & ^P
	JMS	T6BN
	JMS	TYPE
	MES621
	JMS	WFCP	/WAIT FOR ^P
	ISZ	SEEK	/FINISHED RETURN +2
	JMP*	SEEK
/
/ SEEK DATA TABLE
SKDATA	.SIXBT /------BIN/	/NO INSERTION BETWEEN SEEK DATA TRIPLITS!!
ULLIBR	.SIXBT /.LIBR5BIN/
SLLIBR	.SIXBT	/.LI/
LIBNAM	.SIXBT	/XXXBIN/
	.TITLE *** BUFFERS ***
INBUF	.BLOCK 62
/
OUTBUF	021000
	.BLOCK 41
OUTEND	.
OUTBEG	OUTBUF+2
/
/
MAPBUF	017000	/(RCHM-163) MAP LINE HEADER -- WORD-PAIR COUNT IS SET 
	0	/TO 016 IF SIZE IS TO BE OUTPUT
MAPNAM	0		/NAME
	.REPT 12		/(RCHM-163)
	040
MAPFAD	0		/FIRST WORD ADDRESS
	.REPT 6			/(RCHM-158)
	055
	0		/LAST WORD ADDRESS
	.REPT 6			/(RCHM-158)
	040			/(RCHM-159)
	015			/(RCHM-159) SIZE IF SZFLAG IS SET.
	012			/(RCHM-159)
	.REPT 6			/(RCHM-159)
	015
	012
MAPX1	0	/MAP LINE INDEX
	.EJECT
/
/ SUBROUTINE TO PRODUCE A STRAIGHT FORWARD  MAP OUTPUT OF WHATEVER IS IN SYM1,
/ SYM2, WITH STARTING ADDRESS LOADADR AND SIZE SIZE.
/
/ GLEANED FROM CHAIN 170 *********************
/
PRTPRG	XX			/(RCHM-163) ROUTINE ENTRY POINT.
	JMS PSYMSW		/(RCHM-163) SWAP SYMBOLS MAYBE?
	JMS SYMMAP		/(RCHM-163) EXPAND SYM1 AND SYM2, PLUS EXT.
	LAC SIZE		/(RCHM-163) FETCH -SIZE.
	CMA			/(RCHM-163) PRODUCE SIZE -1.
	TAD RELOC		/(RCHM-163) FIGURE OUT LAST ADDRESS.
	DAC SLIMLA		/(RCHM-613) SET UP SLIM.
	LAC RELOC		/(RCHM-163) FETCH FIRST ADDRESS.
	DAC SLIMFA		/(RCHM-163) SET UP SLIM.
	JMS SLIM		/(RCHM-163) EXPAND ADDRESSES.
	JMS TYPMAP		/(RCHM-163) PRINT MAP.
	JMS PSYMSW		/(RCHM-163) SWAP THEM BACK.
	DZM PRG1		/(RCHM-163) DISARM SWAP.
	JMP* PRTPRG		/(RCHM-163) RETURN.
PSYMSW	XX			/(RCHM-163)
	LAC PRG1		/(RCHM-163)
	SNA			/(RCHM-163)
	JMP* PSYMSW		/(RCHM-163)
	LMQ			/(RCHM-163)
	LAC SYM1		/(RCHM-163)
	DAC PRG1		/(RCHM-163)
	LACQ			/(RCHM-163)
	DAC SYM1		/(RCHM-163)
	LAC PRG2		/(RCHM-163)
	LMQ			/(RCHM-163)
	LAC SYM2		/(RCHM-163)
	DAC PRG2		/(RCHM-163)
	LACQ			/(RCHM-163)
	DAC SYM2		/(RCHM-163)
	JMP* PSYMSW		/(RCHM-163)
PRG1	0			/(RCHM-163)
PRG2	0			/(RCHM-163)
EXT	0			/(MJH-85)
/
/ SLIM -- SUBROUTINE TO SET THE CORE LIMITS IN 'SLIMFA' & 'SLIMLA'
/	INTO THE LOAD MAP LINE BUFFER.  IF SZFLAG IS SET, THE
/	SIZE (SLIMLA-SLIMFA+1) IS ALSO SET IN THE MAP LINE.
/
SLIMFA	0	/FIRST WORD ADDRESS
SLIMLA	0	/LAST WORD ADDRESS
/
SLIM	0
	LAC	(MAPFAD)
	DAC	MAPX1
	LAC	SLIMFA
	JMS	ADROUT
	LAC	SLIMLA
	JMS	ADROUT
	LAC	SZFLAG
	SNA
	JMP*	SLIM
	LAC	SLIMFA
	CMA
	TAD	SLIMLA
	AAC	2		/(MJH-85)
	JMS	ADROUT
	JMP*	SLIM
/
	.EJECT
/
/ SUBROUTINE PRSTRA -- PRINT STRATEGY AND APS, VPS, AND EPS
/
PRSTRA	0			/(MJH-85)
	LAC	LMFLAG		/(MJH-85) SHOULD LOAD MAP BE PRINTED?
	SNA			/(MJH-85)
	JMP*	PRSTRA		/(MJH-85) NO -- RETURN
	JMS	CRTN		/(MJH-85) YES -- PRINT STRATEGY USED
	JMS	TYPE		/(MJH-85)
	MES736			/(MJH-85)
	LAC	STRATG		/(MJH-85)
	SAD	(1		/(MJH-85)
	JMP	PRSTR1		/(MJH-85)
	SAD	(2		/(MJH-85)
	JMP	PRSTR2		/(MJH-85)
	LAC	(MES730		/(MJH-85) STRATEGY 3
	SKP			/(MJH-85)
PRSTR2	LAC	(MES731		/(MJH-85) STRATEGY 2
	SKP			/(MJH-85)
PRSTR1	LAC	(MES732		/(MJH-85) STRATEGY 1
	DAC	.+2		/(MJH-85)
	JMS	TYPE		/(MJH-85)
	XX			/(MJH-85)
	JMS	CRTN		/(MJH-85)
	JMS	TYPE		/(MJH-85)
	MES733			/(MJH-85) PRINT APS
	LAC	APS		/(MJH-85)
	JMS	PONUM		/(MJH-85)
	JMS	TYPE		/(MJH-85)
	MES735			/(MJH-85) PRINT EPS
	LAC	EPS		/(MJH-85)
	JMS	PONUM		/(MJH-85)
	JMS	TYPE		/(MJH-89)
	MES734			/(MJH-89)
	LAC	VPS		/(MJH-89) PRINT VPS
	JMS	PONUM		/(MJH-89)
	JMS	CRTN		/(MJH-85)
	JMS	CRTN		/(MJH-85)
	JMP*	PRSTRA		/(MJH-85) RETURN
	.EJECT
/
/ SUBROUTINE TOCRQ0 __ PRINT RES'D OR SHARED COMMON BLOCKS
/
/ GLEANED FROM CHAIN 170 *********************
/
/
TOCRQ0	0			/(MJH-85)
	LAC	TOCRQX		/(MJH-94) HAS MV.BLK BEEN CALLED ALREADY?
	SAD	(XCT SHR.SW	/(MJH-94)
	SKP			/(MJH-94) YES -- DON'T CALL IT AGAIN
	JMS	MV.BLK		/(MJH-91)
TOCRQ1	JMS	BEGSYM		/(MJH-85) SET UP PTR TO SYMBOL TABLE
	DZM	PFLAG		/(MJH-85)
TOCRQ2	LAC	SYMPTR		/(MJH-85) DONE WITH SYMBOLS?
	SAD	SYMEB1		/(MJH-85)
	JMP*	TOCRQ0		/(MJH-85) YES -- RETURN
	LAC*	SYMPTR		/(MJH-85) NO -- GET SYMBOL TYPE
	AND	(300000		/(MJH-85) IS IT A COMMON?
	SAD	(300000		/(MJH-85)
	SKP			/(MJH-85)
	JMP	TOCRQ3		/(MJH-85) NO -- GET NEXT SYMBOL
	LAC*	SYMPTR		/(MJH-85) YES -- GET SIZE
	AND	(77777		/(MJH-85)
	TCA			/(MJH-85) NEGATE
	DAC	SIZE		/(MJH-85) SETUP TO CALL PRTPRG
	JMS	DECSPT		/(MJH-85) MOVE PTR TO NAME
	LAC*	SYMPTR		/(MJH-85) GET NAME
	DAC	SYM1		/(MJH-85)
	SMA			/(MJH-85) SET UP TO PRINT NAME
	JMP	.+4		/(MJH-85)
	JMS	DECSPT		/(MJH-85)
	LAC*	SYMPTR		/(MJH-85)
	DAC	SYM2		/(MJH-85)
	JMS	DECSPT		/(MJH-85)
	JMS	DECSPT		/(MJH-85)
	LAC	SYM1		/(MJH-95) IS THIS COMMON .XX?
	SAD	(131330		/(MJH-95)
	JMP	TOCRQ4		/(MJH-95) YES -- BASE AND SIZE ARE WRONG
	LAC*	SYMPTR		/(MJH-85)
	DAC	RELOC		/(MJH-85) SET BASE ADDR
TOCRQ5	JMS	RV.SET		/(MJH-95) SET SHR.SW OR RES.SW IF APPROPRIATE
TOCRQX	XX			/(MJH-85) XCT RES.SW OR XCT SHR.SW
	JMP	TOCRQ3		/(MJH-85) CHECK NEXT ENTRY IF NOT SHR OR RES
	LAC	PFLAG		/(MJH-85) PRINT HEADER?
	SZA			/(MJH-85)
	JMP	.+5		/(MJH-85) NO
	ISZ	PFLAG		/(MJH-85) YES
	JMS	CRTN		/(MJH-85)
	JMS	TYPE		/(MJH-85)
TOCRQM	XX			/(MJH-85)
	JMS	PRTPRG		/(MJH-85) PRINT COMMON NAME BASE AND TOP
TOCRQ3	JMS	NXNTRY		/(MJH-85) GO GET NEXT ENTRY
	JMP	TOCRQ2		/(MJH-85)
TOCRQ4	LAC	MAX.XX		/(MJH-95) GET SIZE OF BLANK COMMON
	TCA			/(MJH-95)
	DAC	SIZE		/(MJH-95) SAVE -SIZE OF .XX
	LAC	BSE.XX		/(MJH-95) GET BASE OF .XX
	DAC	RELOC		/(MJH-95)
	JMP	TOCRQ5		/(MJH-95)
	.EJECT
/
/ SUBROUTINE PONUM -- PRINT THE CONTENTS OF AC AS AN OCTAL NUMBER
/
/			RETURN AT JMS+1 UNCONDITIONALLY
/
/			ALL REGISTERS ARE MODIFIED
/
PONUM	0
	LMQ			/SAVE THE NUMBER TO BE PRINTED IN MQ
	LAW	-6		/SET UP DIGIT COUNTER
	DAC	PONV.1
	DZM	PONBUF+1	/ZERO CHECKSUM WORD IN BUFFER
	CLL
	LAC	(PONBUF+1	/INIT. X14
	DAC*	(X14
	CLA
	LLS	3		/SHIFT IN A DIGIT
	TAD	(60		/MAKE IT INTO ASCII
	DAC*	X14		/STORE IT IN BUFFER
	ISZ	PONV.1		/HAVE WE DONE 6 DIGITS?
	JMP	.-5		/NO
	.IFDEF	RSX
	CAL	PONWRT		/YES -- WRITE OUT THE BUFFER
	CAL	PONWTF
	.ENDC
	.IFUND	RSX
	LAC	(PONBUF
	DAC	.+3
	.WRITE	TO,3,XX,0
	.WAIT	TO
	.ENDC
	JMP*	PONUM
/
	.IFDEF	RSX
PONWRT	2700
	PONEV
	TO
	3
	PONBUF
/
PONWTF	20
	PONEV
	.ENDC
/
PONBUF	5000
	0
	.BLOCK 6
	15
	12
/
PONEV	0
PONV.1	0
/
	.EJECT
/ SHTMAP -- SUBROUTINE TO SET MAP FLAG AND
/           TO SHORTEN MAP LINE TO NAME ONLY
/
SHTMAP	0
	LAC	(007000)	/(MJH-85)
	DAC	MAPBUF
	DAC	LMFLAG
	LAC	(MAPFAD-1)	/(MJH-85)
	DAC	MAPX1
	LAC	(015)
	DAC*	MAPX1
	ISZ	MAPX1
	LAC	(012)
	DAC*	MAPX1
	JMP*	SHTMAP
/
/ TYPMAP -- SUBROUTINE TO TYPE A MAP LINE
/           IF MAP FLAG IS SET
/
TYPMAP	0
	LAC	LMFLAG
	SNA
	JMP*	TYPMAP
	.IFUND	RSX
TMAPZ	.WRITE	TO,3,MAPBUF,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
TMAPZ	CAL	WRTOD
	JMS	WFEV
	LAC	(TO)	/LUN IN CASE OF I/O ERROR
	.ENDC
	JMP*	TYPMAP
	.TITLE *** VARIABLES ***
/ POINTERS:
 
SYMBEG	0		/TO BEG OF SYMBOL TABLE.
SYMEND	0		/TO LAST SYMTAB REGISTER - 1.
SYMEB1	0		/SYMEND BUFFER (TO RESTORE SYMEND 
			/FOR A NEW LINK)
SYMEB2	0		/SYMEND BUFFER (TO RESTORE SYMEND
			/FOR NON-RELOCATED LIBRARY ROUTINE)
SYMWD1	0		/TO 1ST WORD OF A SYMTAB ENTRY.
SYMPTR	0		/TO SOMEWHERE WITHIN A SYMTAB ENTRY.
LOADADR	0		/PROGRAM'S LOAD ADDRESS.
LAST	0		/PROGRAM'S LAST REGISTER.
RELOC	0		/RELOCATION FACTOR.
BUFPTR	0		/TO LINE BUFFER #1 OR #2.
BSE.XX	0		/BASE OF BLANK COMMON (.XX)
 
/ FLAGS:
 
LIBFLG	0		/SET NON-0 WHEN IN LIBRARY SEARCH MODE.
BLKFLG	0		/SET NON-0 (WITH THE LOAD ADDRESS) WHEN
			/A BLOCKDATA SUBPROGRAM IS BEING LOADED.
BLKDSW	0		/(MJH-85)
SK.F01	SKP		/(MJH-85)
CBSIZE	0		/(MJH-85)
SAV.SZ	0		/(MJH-85)
SAV.LD	0		/(MJH-85)
SAV.RL	0		/(MJH-85)
SAV.BD	0		/(MJH-85)
	.TITLE *** SUBROUTINES ***
/ STORE -- SUBROUTINE TO EFFECT:  DAC*  LOADADR
/
STORE	0
	DAC	ROPWB
	LAC	LOADADR
	JMS	ROP
	JMP*	STORE
/
/ ROP --  SUBROUTINE TO OUTPUT THE RELOCATED WORD IN ROPWB
/	TO BE LOADED AT THE ADDRESS IN AC.
/
/	RECORD FORMAT:
/	    IOPS BINARY HEADER
/	    SUB-RECORD HEADER	(SUB-RECORDS ARE
/	    RELOCATED WORD(S)	BLOCKS OF CONTIGUOUS
/	    SUB-RECORD HEADER	CORE LOADINGS)
/	    RELOCATED WORD(S)
/	      .         .
/	      .         .
/	    END-OF-RECORD IND.
/	SUB-RECORD HEADER FORMAT:
/	    TYPE CODE (BITS 0-8) & WORD COUNT (BITS 9-17)   CODE=0
/	    LOAD ADDRESS OF FIRST WORD
/
ROP	0			/ENTER WITH ADDRESS IN AC
	DAC	ROPLA
	LAC	ROPFEF		/FIRST ENTRY TEST
	SZA
	JMP	ROP10
	ISZ	ROPFEF
	DZM	ROPBWC
	JMP	ROP35
ROP10	LAC	ROPLA		/BREAK IN ADDRESS SEQUENCE?
	SAD	ROPLLA
	JMP	ROP20		/NO -- SET WORD IN BUFFER
	LAC	OUTEND		/YES -- SET NEW SUB-HDR & WORD IN BUF
	CMA			/IS THERE ROOM IN BUFFER FOR FOUR
	AAC	4		/MORE WORDS (HDR,WORD, & END-OF REC)?  (MJH-85)
	TAD	ROPX1
	SMA
	JMP	ROP30		/NO -- END RECORD & SET WDS IN NEXT BUF
	JMP	ROP40		/YES -- SET THREE WORDS IN BUFFER
/
ROP20	LAC	OUTEND		/IS THERE ROOM IN BUFFER FOR TWO
	CMA			/MORE WORDS (WORD & END-OF-REC)?
	AAC	2		/(MJH-85)
	TAD	ROPX1
	SMA
	JMP	ROP30		/NO -- END RECORD & SET WORD IN NEXT BUF
	JMP	ROP50		/YES -- SET WORD IN BUFFER
/
ROP30	LAW	-1		/SET END-OF-RECORD INDICATOR (-1) IN
	JMS	ROPSW		/BUFFER AND OUTPUT
	JMS	ROPWOB		/WRITE OUTPUT BUFFER
/
ROP35	LAC	OUTBEG		/SETUP FOR NEW RECORD
	DAC	ROPX1
/
ROP40	LAC	ROPX1		/SET NEW SUB-RECORD HEADER IN BUFFER,
	DAC	ROPX2		/SAVE HEADER INDEX, & SET LAST-
	LAC	(200000)	/LOAD-ADR-PLUS-ONE
	JMS	ROPSW
	LAC	ROPLA
	DAC	ROPLLA
	JMS	ROPSW
/
ROP50	LAC	ROPWB		/SET RELOCATED WORD IN BUFFER, UPDATE
	JMS	ROPSW		/LAST-LOAD-ADR-PLUS-ONE, & AGUMENT SUB-
	ISZ	ROPLLA		/RECORD WORD COUNT
	ISZ*	ROPX2
/
	JMP*	ROP		/EXIT
/
ROPSW	0			/SET WORD SUBROUTINE
	DAC*	ROPX1
	ISZ	ROPX1
	ISZ	ROPBWC
	JMP*	ROPSW
/
ROPWOB	0
	LAC	ROPBWC
	AAC	3		/(MJH-85)
	JMS	LCS6
	RTL
	AND	(777000)
	DAC	OUTBUF
	JMS	WOB
	DZM	ROPBWC
	JMP*	ROPWOB
/
ROPLA	0			/LOAD ADDRESS
ROPLLA	-1			/LAST LOAD ADDRESS PLUS ONE
ROPFEF	0			/FIRST ENTRY FLAG
ROPX1	0			/BUF INX AT WHICH WORD IS TO BE STORED
ROPX2	0			/INDEX OF LAST SUB-RECORD HEADER
ROPBWC	0			/BUFFER WORD COUNT
ROPWB	0			/WORD BUFFERS
	.EJECT
/
/ FROP -- FINISH PARTIAL RECORD STARTED BY ROP
/
FROP	0
	LAC	ROPFEF
	SNA
	JMP*	FROP
	LAW	-1
	JMS	ROPSW
	JMS	ROPWOB
	DZM	ROPFEF
	JMP*	FROP
/
/ WNPPR -- SUBROUTINE TO WRITE A NO PATCH PATCH-RECORD
/
WNPPR	0
	LAC	(002000)
	DAC	OUTBUF
	LAC	(300000)
	DAC	OUTBUF+2
	DZM	OUTBUF+3
	JMS	WOB
	JMP*	WNPPR
/
/ WOB -- SUBROUTINE TO WRITE OUTPUT BUFFER
/
WOB	0
	.IFUND	RSX
WOB1	.WRITE RO,0,OUTBUF,0
	.WAIT  RO
	.ENDC
	.IFDEF	RSX
WOB1	CAL	WRRO
	JMS	WFEV
	LAC	(RO)	/LUN IN CASE OF I/O ERROR
	.ENDC
	JMP*	WOB
	.EJECT
/
/ PTBENT -- SUBROUTINE TO ENTER PTBW1 & PTBW2 IN THE PATCH TABLE
/
PTBW1	0	/BITS 0-2 CODE
		/BITS 3-17 ADDRESS
		/	CODE=0 -- STORE THE WORD IN PTBW2
		/		AT ADDRESS
		/	CODE=1 -- SET BITS 5=17 OF THE WORD IN
		/		IN PTBW2 IN BITS 5-17 AT ADDRESS
		/	CODE=2 -- ADD THE BASE OF BLANK COMMON
		/		TO THE WORD IN PTBW2 AND STORE
		/		AT ADDRESS
PTBW2	0	/WORD TO BE STORED PER CODE
		/ IF AN ENTRY FOR AN ADDRESS ALREADY EXISTS, IT
		/WILL BE WRITTEN OVER.
/
PTBENT	0
	LAC	PTBBSE	/SCAN PATCH TABLE FOR AN ENTRY FOR THE
PTBEN1	DAC	PTBX2	/ADDRESS IN PTBW1 BITS 3-17
	SAD	PTBX1
	JMP	PTBEN3	/ADR NOT FOUND (END OF TABLE)
	LAC*	PTBX2
	XOR	PTBW1
	AND	(077777)
	SNA
	JMP	PTBEN2	/ADDRESS FOUND
	LAC	PTBX2
	AAC	2		/(MJH-85)
	JMP	PTBEN1
/
PTBEN2	LAC	PTBW1	/ENTER PTBW1 & PTBW2 OVER PREVIOUS ENTRY
	DAC*	PTBX2	/FOR SAME ADDRESS
	ISZ	PTBX2
	LAC	PTBW2
	DAC*	PTBX2
	JMP*	PTBENT	/EXIT
/
PTBEN3	LAC	PTBW1	/ADD PTBW1 & PTBW2 TO PATCH TABLE
	DAC*	PTBX1
	ISZ	PTBX1
	LAC	PTBW2
	DAC*	PTBX1
	ISZ	PTBX1
	LAC	SYMEND	/DO SYMBOL AND PATCH TABLES OVERLAP?
	CMA
	TAD	PTBX1
	SPA!SNA
	JMP*	PTBENT	/NO -- EXIT
	LAC	(MES701)/YES -- TERMINAL ERROR
/
/ TERMINAL ERROR WHILE RELOCATING A ROUTINE -- TYPE OUT 
/  THE MESSAGE WHOSE ADDRESS IS IN AC.  FOLLOWED BY
/ A MAP LINE (IF MAP FLAG IS SET).
/ AND EXIT TO MONITOR
/
TERR	AAC	-2		/(MJH-85)
	.IFUND	RSX
	DAC	.+3
	.WRITE	TO,2,XX,0
	.WAIT	TO
	.ENDC
	.IFDEF	RSX
	DAC	WRTOA
	CAL	WRTOB
	JMS	WFEV
	LAC	(TO)	/LUN IN CASE OF I/O ERROR
	.ENDC
	JMS	TYPMAP
	.IFDEF	RSX
	LAC	(2)	/FORCE TDV TO BE CALLED
	DAC	TDVEV	/BE PUTTING A CR IN
	.ENDC
	JMP	EXIT
/
	.TITLE *** CPBS AND CPB SUBROUITNES Z***
/
	.IFDEF	RSX
/
/	RSX I/O CPB'S AND OTHER I/O REQUEST'S
/
CLOUD	3400	/CLOSE USER'S DEVICE
	0	/EVENT VARIABLE ADDRESS
	UD	/LUN
CLOSRO	3400	/CLOSE USER'S OUTPUT
	0	/EVENT VARIABLE ADDRESS
	RO	/LUN
/
PIFCPB	26	/PARTITION INFORMATION CPB
	PIFEV	/EVENT VARIABLE ADDRESS
PIFNAM	.SIXBT	/TDV@@@/	/NAME FOF PARTITION
	FDESB	/POINTER TO BASE AND SIZE
/
PARSIZ	27	/RAISE PARTITION BOUND TO TOP OF PARTITION
	ENDPAR	/EVENT VARIABLE ADDRESS
/
ENDPAR	0	/PARTITION END
/
TDVEV	0	/TDV EVENT VARIABLE
/
REQTDV	1	/TDV REQUEST
	0
	.SIXBT	'TDV...'
	0
/
/
PIFEV	0	/EVENT VARIABLE FOR PARTITION INFORMATION
/
WRTO	2700	/WRITE
	EV	/EVENT VARIABLE ADDRESS
	TO	/LUN
	3	/IMAGE ASCII
	T6BNB	/LINE BUFFER ADDRESS
WRTOD	2700	/WRITE
	EV	/EVENT VARIABLE ADDRESS
	TO	/LUN
	3	/IMAGE ASCII
	MAPBUF	/MAP BUFFER
WRTOB	2700	/WRITE REQUEST
	EV	/EVENT VARIABLE ADDRESS
	TO	/LUN
	2	/OPS ASCII
WRTOA	0	/BUFFER ADDRESS
DETDV	2500	/DETACH REQUEST
	EV	/ EVENT VARIABLE ADDRESS
DETLU	0	/LOGICAL UNIT NUMBER
WRTOC	2700	/WRITE
	EV	/EVENT VARIABLE ADDRESS
	TO	/LUN
	3	/IMAGE ASCII
	PSNB	/LINE BUFFER ADDRESS
RDLU	2600	/READ
	EV	/EVENT VARIABLE ADDRESS
READ1	0	/LOGICAL UNIT NUMBER
	0	/IOPS BINARY
	INBUF	/INPUT BUFFER ADDRESS
	62	/MAX WORD COUNT
CLOLIB	3400	/CLOSE LIBRARY
	0
LIBCLO	0	/LUN FOR CLOSE
SEEKA	3200	/SEEK FILE
	EV	/EVENT VARIABLE ADDRESS
SKSK	0	/LUN
LIBN	.BLOCK	3	/FILE NAME
WFEVA	20	/WAIT FOR EVENT VARIABLE
	EV	/EVENT VARIABLE ADDRESS
WRRO	2700	/WRITE
	EV	/EVENT VARIABLE ADDRESS
	RO	/LUN
	0	/IOPS BINARY
	OUTBUF	/OUTPUT BUFFER ADDRESS
EV	0	/EVENT VARIABLE
	.ENDC
	.EJECT
/
/
	.IFDEF	RSX
/
/	WAIT FOR IO COMPLETION
/
WFEV	0
	CAL	WFEVA
	LAC	EV
	SMA
	JMP*	WFEV
	XCT*	WFEV	/PICK UP THE LUN
WFEVLU	DAC	.	/SAVE IT
	LAC	EV	/PICK UP THE EVENT VARIABLE AGAIN
	JMS	IOERR	/ANNOUNCE I/O ERROR
	LAC	WFEVLU	/LUN FOR I/O ERROR
/
ER700	LAC	EV	/PICK UP THE BAD EVENT VARIABLE
	JMS	IOERR	/REPORT I/O ERROR
	LAC	SKSK	/LUN OF ERROR
/
ER701	JMS	IOERR	/ANNOUNCE I/O ERROR
	LAC	(RO)	/LUN OF ERROR
/
/
	.EJECT
/	I/O ERROR HAS OCCURRED OUTPUT TO USER
/		EDT-I/O ERROR LUN XX EVENT VARIABLE YYYYYY
/
IOERR	0
	TCA		/COMPLEMENT ERROR TO MAKE IT POSITIVE
	LMQ		/SAVE IT IN MQ
	LAW	-6	/DECODE 6 DIGITS
	DAC	PSWCH	/SAVE TEMPORARILY
	LAC	(IOER-1)	/SET UP MESSAGE POINTER
	DAC*	(X10)
DECOD	ECLA!LLS 3	/DECODE MQ - EVENT VARIABLE
	AAC	60	/ADD 60 TO DIGIT
DECODS	SAD	(60)	/IS IT A ZERO?
	JMP	NDECOD	/YES -- SUPPRESS LEADING ZEROES
	PAL		/SAVE AC
	LAC	DECRRA	/SET UP TO JUMP OVER ZERO SUPPRESS
	DAC	DECODS	/SET JUMP
	PLA		/RESTORE AC
DECODR	DAC*	X10	/STORE CHARACTER
	ISZ	PSWCH	/FINISHED?
	JMP	DECOD	/NO DECODE IT
	LAC	(IOERL-1)	/SET UP TO DECODE THE LUN
	DAC*	(X10)
	XCT*	IOERR	/PICK UP THE LUN SLOT
	IDIV		/DIVIDE BY 10 TO FIND DECIMAL LUN
	12
	PAX		/SAVE REMAINDER
	LACQ		/PICK UP QUOTENT
	AND	(17)	/MASK OF NUMBER
	AAC	60	/ADD 60
	DAC*	X10	/STORE IT
	PXA		/PICK UP REMAINDER AGAIN
	AND	(17)	/MASK IT OFF ALSO
	AAC	60	/ADD 60
	DAC*	X10	/STORE IT IN THE MESSAGE
	CAL	WRIOER	/WRITE ERROR ON OUTPUT TTY
	CAL	WFEVA	/WAIT FOR MESSAGE TO COMPLETE
	LAC	(2)	/FORCE TDV TO BE CALLED
	DAC	TDVEV
	JMP	EXIT	/EXIT MACRO
/
NDECOD	CLA		/SUPPRESS PRINTING
DECRRA	JMP	DECODR	/RETURN
/
/
IOERMS	ERMSE-IOERMS+1/2*1000+3
	0
	124	/T
	113	/K
	102	/B
	055	/-
	111	/I
	057	//
	117	/O
	040	/SP
	105	/E
	122	/R
	122	/R
	117	/O
	122	/R
	040	/SP
	114	/L
	125	/U
	116	/N
	040	/SP
IOERL	0	/LUN XX
	0
	040	/SP
IOER	.BLOCK	6	/EVENT VARIABLE
	000	/NULL
	015	/CR
ERMSE	012	/LF
/
WRIOER	2700	/WRITE I/O ERROR MESSAGE
	EV	/EVENT VARIABLE ADDRESS
	15	/OUTPUT DEVICE
	3	/IMAGE ASCII
	IOERMS	/BUFFER ADDRESS
	.EJECT
/
DETACH	0		/DETACH A DEVICE
	DAC	DETLU
	DAC	LIBCLO	/CLOSE FILE FIRST
	CAL	CLOLIB
	CAL	DETDV	/DETACH
	CAL	WFEVA
	JMP*	DETACH	/RETURN
/
PSWCH	0
/
/
WFENEV	0
	CAL	WFEVA
	LAC	EV
	SMA		/ERROR?
	JMP*	WFENEV	/NO
	SAD	(-6)	/ILLEGAL FUNCTION?
	JMP*	WFENEV	/YES MUST NOT BE FILE ORIENTED
	SAD	(-13)	/FILE NOT FOUND
	JMP*	WFENEV
	ISZ	WFENEV	/FILE NOT FOUND OR OTHER ERROR
	JMP*	WFENEV
/
ENDTKB	.SIZE
	.LTORG
SDPTR	0
/
	.ENDC
	.END	START
