	.TITLE	XVM/DOS SYSTEM GENERATOR - V1A000
/
/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 #039	JULY 17, 73
/EDIT #040	JULY 30, 73	UC15 SPOOLER AREA UPDATE
/EDIT #041	AUG 30, 73	UC15 SPOOLER AREA BUG FIX AT TAG A.5D1
/EDIT #042	NOV 12, 73	LA30 ON/OFF MOD
/EDIT #043	JUN 22, 74	SKIP IOT CHECK AND SPOOLER SIZE LOWER LIM
/EDIT #044	JUL 14, 74	CHANGE SIGNON NUMBER
/EDIT #045	RKH	22-JUL-74	CORRECT SETTING OF X4K AND UC BITS IN
/					.SCOM+20 AND GENERAL COMMENT CLEAN UP
/	046	SK	6-DEC-74	REMOVE QUERIES SPOOLER START BLOCK #
/					& SIZE + ADD QUERY POLLER ON/OFF?
/					V3B000
/	047	SK	20-DEC-74	SPR:15-E903 BUG FIX. CHANGE INST. AT
/					B.2TB+3 FROM LAC P2  TO  LAC P3
/	048	BLR	30-JUN-75	ADD HANDLERLESS DEVICE CAPABILITY
/	049	BLR	10-JUL-75	XVM UPGRADE
/	050	BLR	10-JUL-75	TAB,FILL,UC15,XVM ENTRIES ADDED,
/					X4K DELETED
/	051	BLR	11-JUL-75	BAD SKIP VS. BAD IOT CODE ADDED
/					COMMAND TABLE UPDATED
/	052	BLR	12-JUL-75	PCODE CHECK ADDED
/	053	BLR	12-JUL-75	MEMSIZ ADDED
/	054	BLR	13-JUL-75	QAREA SIZE CODE REWRITTEN
/	055	BLR	23-JUN-75	AUTO-DELETE OF SKIPLESS-HANDLERLESS DEV.
/	056	BLR	4-AUG-75	GIVE ERROR FOR UC15 OFF ON RK-BASED SYS
/	057	MJH	20-AUG-75	DISCLAIMER
/	058	GAR	3-OCT-75	CHANGE SO THAT THE SY AND CM HANDLERS
/					ARE SKIPPED OVER DURING ANY MODIFICATION
/					OPERATIONS IN THE SAME MANNER AS TTA.
/								/EAG:059
/ 059	9-OCT-75	EAG	DO .INIT TO .DAT -14 BEFORE	/EAG:059
/				POINTING ^C TRAP VECTOR TO	/EAG:059
/				OURSELVES, SO THAT IF AN IOPS12	/EAG:059
/				OCCURS BECAUSE OF UC15 OFF	/EAG:059
/				A ^C WILL SUCCESSFULLY EXIT	/EAG:059
/				TO THE NON-RESIDENT MONITOR.	/EAG:059
/ 060	10-OCT-75	BLR	FIX HANDLER NUMBER BUG IN FHAN
/
/	.DAT SLOT -14 MUST BE ASSIGNED TO THE SYSTEM DEVICE
/
/	INSTALL WITH THE FOLLOWING PATCH COMMAND
/	>READR 16122 SGEN
/
/	PARAMETER ASSIGNMENTS:
/	DEFINE BIN=0 FOR LINKING LOADER BINARY
/
.SCOM=100				/SYSTEM COMMUNICATION TABLE
	.IFDEF	BIN
	.IODEV	-14
	.ENDC
	.TITLE	INITIALIZATION
/
/
/
START	JMS	SECTN		/IDENTIFY ITSELF; STATE VERSION; SET ^P
	.SIXBT	'SGEN XVM V1A000<@'
	LAC*	(.SCOM+42	/CHECK IF LOGGED IN UNDER MIC
	SPA
	JMP	GUIC		/LOGGED IN UNDER MIC
	JMS	TERMER
	.SIXBT	'_SYSTEM PROTECTED<@'
GUIC	.USER	-14,IOS		/FOR USE IN DELETING HANDLER FILES
	.INIT	-14,0,0		/SET UP SKIP CHAIN ETC.
	.INIT -3,1,200000+ENDGEN	/ WIRE ^C TRAP VECTOR	/EAG:059
				/ TO OURSELVES SO WE CAN DELETE	/EAG:059
				/ TEMPORARY FILES AND THE LIKE	/EAG:059
				/ ON ^C'S.			/EAG:059
	LAC (A1)		/ PUT IN TRANSFER VECTOR FRESH
	DAC	DEVICE		/IN CASE OF ^P RETURN
	.FSTAT	-14,A1		/A1	.SIXBT	'DOSGENDMP'
UNIT=.-2
DEVICE=.-1			/PICK OUT UNIT # FROM CAL CODE AND
				/PICK DEVICE # FROM BITS 0-2
				/OF TRANSFER VECTOR TO FILE  NAME
	SNA			/IF FILE DOSGENDMP IS PRESENT DELETE IT
	JMP	STRTNP		/NOT PRESENT
	.DLETE	-14,A1		/DELETE DOSGEN DMP
	.EJECT
STRTNP	LAC	DEVICE		/UNPACK DEVICE # FROM .FSTAT
	AND	(700000		/BITS 0-2 ARE DEVICE #
	SAD	(200000		/RF DISK?
	JMP RFDSK	/YES. GO SETUP DEVICE CODE
	SAD (500000		/RK DISK?
	JMP RKDSK	/YES. SETUP DEVICE CODE
	SAD	(300000		/RP DISK?
	JMP RPDSK	/YES. SETUP DEVICE CODE
BADDEV	JMS	TERMER		/TERMINAL ERROR; INTEGRITY OF DISK
	.SIXBT	'.DAT -14 NOT XVM/DOS SYSTEM<@'	/SYSTEM IN DOUBT
RFDSK	LAC LDK	/STORE DK MNEMONIC
	JMP RKDSK+1
RPDSK	LAC LDP	/STORE DP MNEMONIC
	DAC LITDEV
	LAC DPMFD	/GET BLOCK '47040'
	JMP .+4
RKDSK	LAC LRK	/STORE RK MNEMONIC
	DAC LITDEV
	LAC RFMFD	/GET BLOCK '1777'
	JMS	TRANIN		/SUBROUTINE TO .TRAN INTO CORE 
	LAC	(SAT		/FIRST ADDRESS OF CORE BUFFER IS SAT
	LAC	SAT+2		/WORD 2 OF DISK BLOCK CONTAINS FIRST
	SAD	(-1		/BLOCK OF 3 BLOCK SEQUENCE OF SYSTEM
	JMP	BADDEV		/PARAMETER BLOCKS (SYSBLK-COMBLK
				/AND SGNBLK). IF -1 THEN DISK IS NOT
				/A SYSTEM DEVICE AND HAS NO SYSTEM
				/BLOCKS.  ANNOUNCE ERROR IF NOT SYSTEM.
	DAC	SYSBL1		/STORE BLOCK # OF SYSBLK
	IAC			/BUMP BLOCK # TO COMBLK (BR-049)
	DAC	COMBL1		/STORE BLOCK # OF COMBLK; ACTUALLY 
				/SYSBLK AND COMBLK BUILD TOWARD
				/EACH OTHER AND OCCUPY THE TWO BLOCKS
				/TOGETHER.
	IAC			/BUMP BLOCK # TO SGNBLK (BR-049)
	DAC	SGNBL1		/STORE AWAY FOR USE BY READ
				/ROUTINE TO INITIALIZE TEMPORARY SYSTEM
				/FILE TO STATE OF OLD SYSTEM.
	.EJECT
	DZM	NOSATB		/INITIALIZE ACCUMULATOR FOR #
				/SAT BLOCKS
	LAC*	(.SCOM+2	/ALLOCATE FREE CORE FOR SAT BLOCK TABLE
	DAC	SATABP
	DAC	BTABP
	DAC	BPTR
	LAC	SAT+3		/FIND FIRST BLOCK OF SAT FROM 4TH
	AND	(77777		/WORD OF MFD BITS 3-17
	SKP			/ENTER ALGORITHM IN MIDDLE
FSAT1	LAC	SAT+377		/FETCH NEXT BLOCK # OF SAT
	SAD	(-1		/IF NONEXISTENT THEN WE ARE THROUGH
	JMP	FSAT2		/FINISHED
	JMS	DACFRE		/STORE INTO SAT BLOCK TABLE
	BTABP			/AND CHECK FOR OVERFLOW OF FREE CORE
	ISZ	NOSATB		/INCREMENT # OF SAT BLOCKS IN SYSTEM
	JMS	TRANIN		/.TRAN IN SAT BLOCK FOR NEXT
	LAC	(SAT
	JMP	FSAT1		/ITERATE
FSAT2	LAC	NOSATB		/COMPUTE -# OF SAT BLOCKS
	TCA	
	DAC	DECT1
	AAC	-3		/SUBTRACT 3 (BR-049)
	DAC	ALCT1		/# OF BLOCKS OF DUMMY DUMP MODE FILE
	LAC	BTABP		/SET UP LOOP POINTERS
	DAC	P1
	TAD	NOSATB
	DAC	ODATB		/START OF OLD .DAT SLOT TABLE IN FREE
	DAC	ODATE		/CORE
	TCA	
	TAD*	(.SCOM+3	/DOES IT FIT
	SPA
	JMP	OVFLO1		/NO; ANNOUNCE TERMINAL ERROR
	.EJECT
/
/	WRITE DUMMY FILE TO CONTAIN SYSTEM INFORMATION
/UNTIL IT IS READY TO BE SUBSTITUTED FOR OLD SYSTEM INFORMATION.
/THIS IS DONE THIS WAY SO THAT IF A PERSON MAKES A MISTAKE
/WHILE SYSTEM GENERATING NO HARM WILL BE DONE UNLESS HE
/COMPLETES THE WHOLE PROCESS WITHOUT DISCOVERING HIS ERROR OR
/ABORTING THE OPERATION THROUGH SOME TERMINAL ERROR DISCOVERED
/BY THE SYSTEM GENERATOR.
/
	.INIT	-14,0,0		/.INIT DISK HANDLER 
	.ENTER	-14,A1		/WRITE FILE 'DOSGEN DMP'
				/SAT TO TEMPORARY FILE TO # OF SAT BLOCKS
PRE1	-14&777+4000		/.WRITE IN DUMP MODE
	11
	SAT			/ANY BUFFER WILL DO THAT IS LEGAL MEMORY
	-376			/ONE BLOCK
	ISZ	ALCT1		/COUNT UP TO # DESIRED
	JMP	PRE1		/ITERATE UNTIL DESIRED # OF BLOCKS WRITTEN
	.CLOSE	-14		/RECORD THE FILE IN THE DIRECTORY
	LAW	-1		/THIS SETS UP A COUNTER TO SIGNAL
	DAC	BCTR		/THAT THE SYSTEM BLOCKS ARE TO
				/READ AFTER THE SAT BLOCKS HAVE BEEN
				/RECORDED
	LAC	(NOP		/SET UP SWITCH
	DAC	PRE4
	.INIT	-14,0,0		/GET READY TO FIND OUT BLOCK NUMBERS
	.EJECT
	.FSTAT	-14,A1		/BY .FSTAT TO FILE AND TRANSFERING
	SNA			/SYSTEM BLOCKS AT THE SAME TIME
	JMP	BADDEV		/A 0 AC INDICATES THE FILE IS MISSING
				/WHICH MAKES NO SENSE; TERMINATE
	SKP			/JUMP INTO ALGORITHM WITH FIRST BLOCK
PRE3	LAC	ALFA		/THE LINK TO THE NEXT BLOCK THAT 
				/IS IN THE DUMMY FILE IS USED FOR THE
	DAC*	P1		/NEXT BLOCK OF THE BIT MAP AND RECORDED
	SAD	(-1		/CHECK FOR NON-EXISTENT BLOCK
	JMP	BADDEV		/BAD SYSTEM
	JMS	TRANIN		/IN THE BLOCK TABLE; THE BLOCK
	LAC	(SAT		/IS BROUGHT INTO CORE FOR THE LINK BLOCK
	LAC	SAT+377		/# WHICH IS SAVED IN ALFA AS BEFORE
	DAC	ALFA		/FOR USE LATER WHEN THE NEXT ITERATION
	LAC*	BPTR		/NEEDS A BLOCK; NOW THE NEXT BLOCK IS
	JMS	TRANIN		/BROUGHT INTO CORE AND WRITTEN ONTO
	LAC	(SAT		/THE DUMMY BLOCK FOUND LAST ITERATION
	LAC*	P1		/THIS IS STILL THE BLOCK
	JMS	TRANOT		/.TRAN OUT
	LAC	(SAT
	ISZ	BCTR		/A COUNT IS TAKEN OF THE BLOCKS WRITTEN
	JMP	PRE2		/AND ON THE FIRST BLOCK THE # BLOCKS
	LAC	SAT		/IN THE SYSTEM IS TAKEN FROM THE
	DAC	NOBSYS		/FIRST WORD OF THE SAT AND STORED
	LAC	SAT+1		/INTO NOBSYS; THE #BLOCKS IN EACH
	DAC	NOBPSB		/MAP IS RECORDED IN NOBPSB
	TCA			/AND COMPLEMENT
	DAC	CNOBPS		/IN CNOBPS
	DZM	SATMOD		/THE BLOCK IN CORE IS INDICATED AS
				/UNMODIFIED
PRE2	ISZ	P1		/BUMP DUMMY SAT BLOCK TABLE POINTER
	ISZ	BPTR		/BUMP THE SAT BLOCK TABLE POINTER
	ISZ	DECT1		/COUNT THE SAT BLOCKS UNTIL FINISHED
	JMP	PRE3		/NOT FINISHED; ITERATE
	.EJECT
PRE4	NOP			/USED AS SWITCH FOR SECOND SEQUENCE
				/WHEN SYSTEM BLOCKS BEING PUT INTO DUMMY
				/FILE
	LAC	(JMP	PRE5	/SET SWITCH SO THAT NEXT SEQUENCE FINISHES
	DAC	PRE4
	LAW	-3		/THERE ARE 3 SYSTEM BLOCKS TO BE TRANSFERED
	DAC	DECT1
	LAC	(SYSBL1		/SET UP THE POINTERS FOR THE SYSTEM BLOCKS
	DAC	BPTR		/POINTER TO ACTUAL SYSTEM BLOCKS
	LAC	(SYSBL2		/POINTER TO DUMMY SYSTEM BLOCK TABLE
	DAC	P1
	JMP	PRE3		/JMP BACK INTO ROUTINE AND REUSE
PRE5	JMS	BINSGK		/BRING IN SGNBLK TO CHECK DEVICE CODE
	LAC LITDEV	/IS THIS THE SYS DEV
	SAD	SDEV1		/IS THIS SYSTEM BLOCK APPROPRIATE
	SKP			/YES; CHECK IS SATISFIED
	JMP	BADDEV		/NO; SYSTEM INTEGRITY IN QUESTION
	DAC	PRE6		/PUT INTO INFORMATION MESSAGE
	IAC			/MAKE INTO A HANDLER NAME (BR-049)
	DAC	SYHAN		/AND PUT INTO WORD WHICH INSURES
				/THAT THIS HANDLER WILL NOT BE DELETED
	AAC	13		/COMPUTE DKL OR DPL (BR-049)
	DAC	LDKL		/AND STICK INTO .DAT SLOT CONSTANT
				/FOR .DAT-7
	LAC	UNIT		/COMPUTE UNIT # OF DISK IN QUESTION
	RCR			/MOVE 3 BITS TO THE RIGHT
	RTR
	AND	(070000		/CLEAN OFF UNIT #
	XOR	L0A		/PUT INTO INFORMATION MESSAGE
	DAC	PRE7
	JMS	QUERY		/STATE THE OPERATION BEING PERFORMED
	.SIXBT	'SYSTEM UPDATE ON '
PRE6	XX
PRE7	.SIXBT	'0<@'
	.EJECT
/
/	GET OLD .DAT SLOT CONTENTS AND COMPUTE DEVICE HANDLER NAMES
/SO THAT IF THE DEVICES ARE INSERTED AND NEW NUMBERS ARE
/ASSIGNED TO HANDLERS THE DEFAULT .DAT SLOT CONTENTS WILL BE PRESERVED
/
	LAC	SGNDAT		/PICK UP LIST HEAD FOR ITERATIVE
	DAC	P2		/ALGORITHM
PRE8	LAC	P2		/EXAMINE POINTER TO SEE IF THE TABLE
	SAD	SGNUFD		/HAS BEEN FULLY EXAMINED AND BUILT
	JMP	PRE10		/FINISHED WITH TRANSFER
	LAC*	P2		/PICK UP DEVICE # AND UNIT #
	SAD	(100000		/STORE AS IS IF SPECIAL SLOT
	JMP	PRE9		/SPECIAL SLOTS ARE NOT MODIFIED
				/BY THE SYSTEM GENERATOR
	AND	(77777		/CLEAN OFF UNIT #
	JMS	FIONM		/FIND CORRESPONDING HANDLER NAME
	JMP	BADDEV		/IF HANDLER MISSING THEN SYSTEM IS
				/SUSPECT
PRE9	JMS	DACFRE		/PLACE INTO TABLE AND INCREMENT
	ODATE			/END POINTER AND CHECK IF FREE
				/CORE IS OVERFLOWED
	ISZ	P2		/BUMP TABLE POINTER
	JMP	PRE8		/ITERATE UNTIL TABLE EXHAUSTED
PRE10	LAC	ODATE		/SET UP DELETED HANDLER TABLE POINTER
	DAC	DELPT1		/AND FALL INTO SECTION A
	.TITLE	A. ALTER SYSTEM PARAMETERS
/
/
/
A.0	JMS	SECTN		/PRINT SECTION HEAD QUESTION AND SET ^P
	.SIXBT	'A. ALTER SYSTEM PARAMETERS<@'
	LAC	(1
	JMS	YW0		/THE DEFAULT ANSWER TO ALL SECTION
	LAC	(1		/QUESTIONS IS NO
	JMP	A.0		/TYPE QUESTION OVER ON SYNTAX ERROR
	JMP	B.0		/NO; SKIP SECTION
	JMS	BINSGK		/YES; BRING IN SGNBLK AND SET TABLE 
				/POINTERS
/
/	API? (DOES SYSTEM HAVE API HARDWARE)
/
A.1	JMS	QUERY		/ASK QUESTION
	.SIXBT	'API<@'		/API? (X)
	LAC	SCOM4		/GET DEFAULT INTO ACCUMULATOR
	JMS	YW1		/FETCH ANSWER WHICH WILL SET BIT
				/TO 1 IF YES; THIS ROUTINE TYPES
				/OLD VALUE IN PARENTHESIS TO INDICATE
				/DEFAULT VALUE
	LAC	(400000		/BIT 0 OF .SCOM+4 CONTAINS API BIT
	JMP	A.1		/REPEAT QUESTION ON AN ERROR
	NOP			/NO; AC CONTAINS NEW .SCOM+4 CONTENTS
	DAC	SCOM4		/YES; STORE NEW .SCOM+4 CONTENTS
/
/	TAB SIM? (X) (DOES SYSTEM NEED TAB SIMULATION FOR DECWRITER AND ASR33
/			TYPE DEVICES) (BR-050)
/
A.2	JMS	QUERY		/ASK QUESTION FOLLOWING
	.SIXBT	'TAB SIMULATION<@'	/QUESTION (BR-050)
	LAC	SCOM4		/GET DEFAULT INTO AC FOR ANSWER RECEIVER
	JMS	YW0		/IF YES SET BIT TO 0 IN .SCOM+4
	LAC	(100000		/BIT 2
	JMP	A.2		/REPEAT ON BAD SYNTAX
	NOP			/NO; AC CONTAINS NEW CONTENTS OF .SCOM+4
	DAC	SCOM4		/YES; STORE NEW CONTENTS OF .SCOM+4
/
/	FILL CHARS. (X) (DOES SYSTEM NEED FILL CHARACTERS TO BUFFER CARRIAGE
/			RETURNS - FOR LA30 LIKE DEVICES) (BR-050)
/
A.2A	JMS	QUERY
	.SIXBT	/FILL CHARACTERS<@/	/(BR-050)
	LAC	SCOM4		/SET BIT 10 OF SCOM+4 TO 1 IF YES (BR-050)
	JMS	YW1
	LAC	(000200		/BIT 10 OF SCOM4 (BR-050)
	JMP	A.2A		/BAD SYNTAX
	NOP			/NO - NOTHING DONE (BR-050)
	DAC	SCOM4		/YES. SAVE (BR-050)
/
/	MIC? [XXX] (WHAT IS TO BE THE MONITOR IDENTIFICATION CODE?)
/
A.3	LAC	MIC		/PICK OUT OLD MIC FROM SGNBLK AND
	DAC	MIC1		/STORE IT INTO QUESTION AS DEFAULT
	JMS	QUERY		/ASK QUESTION: 'MIC[XXX]'
	.SIXBT	'MIC['
MIC1	XX
	.SIXBT	'] <@'
	CLA			/RECEIVE ANSWER WHICH IS NOT Y OR N
	JMS	ANS		/THIS ANSWER WILL BE A SINGLE
				/SYMBOL TERMINATED BY CARRIAGE RETURN
				/OR ALTMODE
	JMP	A.3		/REPEAT QUESTION IF BAD SYNTAX
	JMP	A.4		/DEFAULT MEANS DO NOTHING
	JMP	ALTBAD		/$ IS MEANINGLESS SO ANNOUNCE ERROR
	SKP			/SYMBOL IS ONLY MEANINGFUL ANSWER
	JMP	NUMBAD		/OCTAL # IS BAD SYNTAX
	SAD	(3		/MUST BE 3 CHARACTERS
	JMP	A.3A		/3 CHARACTERS
N3CHR	JMS	RERR		/ANNOUNCE ERROR
	.SIXBT	'NOT 3 CHAR<@'	/NOT EXACTLY 3 CHARACTERS
A.3A	LAC	ANSWER		/SYMBOLS ARE STORED IN ANSWER AND
	DAC	MIC		/ANSWER+1; PUT ANSWER IN MIC
/
/	DEFAULT # BUFFERS[XX] (DEFAULT # OF BUFFERS TO ASSIGN WHEN
/	USING EXECUTE OR THE LINKING LOADER)
/
A.4	JMS	QUERY		/ASK QUESTION
	.SIXBT	'DEFAULT # BUFFERS[<@'
	LAC	FILES		/PRINT OLD # FOR DEFAULT ANSWER
	JMS	NUMSUP		/SUPRESS LEADING ZEROES
	JMS	OUT		/TYPE FINAL CHARACTERS
	.SIXBT	'] <@'
	CLA			/ANSWER MUST BE SINGLE SYLABLE
	JMS	ANS		/MUST BE TERMINATED BY C.R. OR ALTMODE
	JMP	A.4		/REPEAT QUESTION ON SYNTAX ERROR
	JMP	A.5		/DEFAULT MEANS DO NOTHING
	JMP	ALTBAD		/$ IS UNDEFINED
	JMP	SYMBAD		/SYMBOL IS MEANINGLESS
	SPA			/NUMBER MUST BE POSITIVE
	JMP	ANBAD		/BAD NUMBER
	DAC	FILES		/STORE AWAY IN SGNBLK
	.EJECT
/
/	# OF WORDS/BUFFER (THE NUMBER OF WORDS IN OCTAL WHICH IS
/NEEDED TO DO SEQUENTIAL I/O ON A FILE ORIENTED MASS STORAGE DEVICE
/PER FILE
/
A.5	JMS	QUERY		/ASK QUESTION
	.SIXBT	'# WORDS/BUFFER[<@'
	LAC	X1		/TYPE OLD SYSTEM # AS DEFAULT
	JMS	NUMSUP		/SUPRESS LEADING ZEROES
	JMS	OUT		/TYPE REMAINING FEW CHARACTERS OF QUESTION
	.SIXBT	'] <@'
	CLA			/ANSWER MUST BE TERMINATED BY C.R. OR ALTMODE
	JMS	ANS		/RECEIVE ANSWER ROUTINE
	JMP	A.5		/REPEAT QUESTION ON BAD SYNTAX
	JMP	A.5B		/DEFAULT MEANS DO NOTHING
	JMP	ALTBAD		/$ IS MEANINGLESS
	JMP	SYMBAD		/SYMBOLS ARE MEANINGLESS
	TAD	(-440		/CHECK # FOR BEING LESS THAN 440 OCTAL
	SMA
	JMP	A.5A		/GOOD SIZED NUMBER
NUMSM	JMS	RERR
	.SIXBT	'IS TOO SMALL<@'
A.5A	LAC	NUMBER		/PUT NUMBER INTO SGNBLK (X1)
	DAC	X1
/
/	UC15 CONFIG?		COMMENT CHANGE - RKH 22-JUL-74  	
/
A.5B	JMS QUERY		/FIND OUT
	.SIXBT	'UC15 CONFIG<@'
	LAC SCOM4		/DEFAULT WORD (.SCOM+4) (BR-050)
	JMS YW1			/IF UC15 CONFIG BIT16 OF .SCOM+4 (BR-050)
	LAC (000002		/WILL BE SET TO 1 (BR-050)
	JMP A.5B		/BAD SYNTAX
	SKP 			/NO. 	CORRECT UC BIT SETTING - RKH - 22-JUL-74
	JMP	A.5C		/YES - SAVE IT (BR-056)
	DAC	SCOM4		/SAVE (BR-050)
	LAC	LITDEV		/GET SYSTEM DEVICE CODE (BR-056)
	SAD	LRK		/IS IT AN RK SYSTEM (BR-056)
	SKP			/YES - GIVE AN ERROR(BR-056)
				/SINCE RK BASED SYS MUST HAVE UC15 (BR-056)
	JMP	A.7		/SKIP OVER POLLER QUESTION (BR-050)
	JMS	OUT		/PRINT ERROR MESSAGE (BR-056)
	.SIXBT	'>@>(INVALID REPLY FOR RK BASED UC15 SYSTEM)<@'
	JMP	A.5B		/GO TRY AGAIN (BR-056)
/
/IF UC15 CONFIG., FIND OUT: POLLER ON/OFF?
/
A.5C	DAC	SCOM4		/SAVE IT (BR-056)
	JMS QUERY		/END OF UC BIT FIX - RKH - 22-JUL-74 	
	.SIXBT	'POLLER<@'	/POLLER? (X)
	LAC	SCOM4		/GET DEFAULT INTO AC (BR-050)
	JMS	YW1		/FETCH ANSWER WHICH WILL SET BIT TO 1
				/IF YES; THIS ROUTINE TYPES OLD VALUE IN
				/PARAENTHESIS TO INDICATE DEFAULT VALUE
	LAC	(000004		/BIT 15 OF SCOM4 CONTAINS POLLER FLAG (BR-050)
	JMP	A.5C		/REPEAT QUESTION ON ERROR
	NOP			/NO. AC CONTAINS NEW VALUE OF .SCOM+4
	DAC	SCOM4		/SAVE IN SGNBLK (BR-050)
/
	.EJECT
/
/	DEFAULT PROTECT CODE[X] (RECEIVE THE DEFAULT PROTECT
/CODE FOR DISK FILES) :
/	1	UNPROTECTED
/	2	READ/NO WRITE
/	3	NO READ/ NO WRITE
/
/THIS ROUTINE WILL ACCEPT 1 DIGIT ONLY; IT WILL CHECK  (BR-052)
/TO SEE THAT THE NUMBER IS ONE OF THE 3 LEGAL DIGITS
/
A.7	JMS	QUERY		/ASK QUESTION
	.SIXBT	'DEFAULT FILES PROTECTION CODE[<@'
	LAC	PROTCT		/TYPE OLD VALUE AS DEFAULT
	JMS	NUMSUP		/SUPRESS LEADING ZEROES
	JMS	OUT		/TYPE REMAINING PORTION OF QUESTION
	.SIXBT	'] <@'
	CLA			/SINGLE ANSWER TERMINATED BY CAR. RET
	JMS	ANS		/OR ALT MODE
	JMP	A.7		/REPEAT QUESTION IF BAD SYNTAX
	JMP	A.8		/DEFAULT MEANS DO NOTHING
	JMP	ALTBAD		/$ UNDEFINED
	JMP	SYMBAD		/SYMBOL MEANINGLESS
	LAC	NUMBER		/GET VALUE OF NEW PCODE (BR-052)
	SAD	(1		/IS IT ONE (BR-052)
	JMP	A.7A		/YES-PUT INTO SGNBLK (BR-052)
	SAD	(2		/NO-IS IT TWO (BR-052)
	JMP	A.7A		/YES-PUT INTO SGNBLK (BR-052)
	SAD	(3		/NO-IS IT THREE (BR-052)
	JMP	A.7A		/YES-PUT INTO SGNBLK (BR-052)
	JMS	RERR		/NOT A VALID PCODE;RECOVERABLE ERROR (BR-052)
	.SIXBT	'INVALID P-CODE: USE 1,2 OR 3<@'	/(BR-052)
A.7A	DAC	PROTCT		/SAVE IN PCODE SLOT OF SGNBLK (BR-052)
	.EJECT
/
/	RESIDENT PATCH AREA SIZE[XX] (THIS QUESTION ALLOWS THE
/USER TO SPECIFY A SMALL AREA IN THE RESIDENT MONITOR PORTION OF 
/THE SYSTEM FOR HIS OWN RESIDENT MONITOR PATCH AREA. THIS AREA
/IS OF SIGNIFICANT SIZE AND IS POINTED TO BY THE REGISTER 101
/IN THE CORE IMAGE OF .SYSLD EXAMINED BY PATCH.  IF THE USER
/INDICATES A NUMBER OF REGISTERS HE MAY START PATCHING THE
/SYSTEM LOADER BEGINNING WITH THIS FIRST WORD AND ENDING WHEN HE
/EXHAUSTS HIS SPECIFIED PATCH AREA.  SYSTEMS FROM THE LIBRARY
/HAVE NO PATCH AREA OF THIS KIND SPECIFIED.
/
A.8	JMS	QUERY		/ASK QUESTION
	.SIXBT	'RESIDENT PATCH AREA SIZE[<@'
	LAC	PCHSZ		/PRINT OLD VALUE AS DEFAULT
	JMS	NUMSUP		/SUPRESS LEADING ZEROES
	JMS	OUT		/TYPE REMAINDER OF QUESTION
	.SIXBT	'] <@'
	CLA			/SINGLE ANSWER ENDING IN 
				/CAR. RET. OR ALTMODE
	JMS	ANS		/RECIEVE ANSWER
	JMP	A.8		/BAD SYNTAX MEANS REPEAT QUESTION
	JMP	A.9		/DEFAULT MEANS CHANGE NOTHING
	JMP	ALTBAD		/$ IS MEANINGLESS
	JMP	SYMBAD		/SYMBOLS ARE MEANINGLESS
	SPA			/NUMBER MUST BE POSITIVE
	JMP	NUMSM		/NUMBER IS TOO SMALL
	TAD	(-5001
	SPA
	JMP	A.8A		/5000(8) REGISTERS IS MAXIMUM
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS >> 5000<@'
A.8A	LAC	NUMBER		/PUT NEW PATCH AREA NUMBER IN SGNBLK
	DAC	PCHSZ
	.EJECT
/
/	PAGE MODE SYSTEM (DOES THE SYSTEM START OUT IN PAGE MODE
/OR BANK MODE)
/
A.9	JMS	QUERY		/ASK QUESTION
	.SIXBT	'PAGE MODE SYSTEM<@'
	LAC	SCOM4		/FETCH DEFAULT FROM SGNBLK
	JMS	YW0		/YES WHEN BIT IS 0
	LAC	(100		/BIT 11 IS BIT IN .SCOM+4
	JMP	A.9		/REPEAT QUESTION ON SYNTAX ERROR
	NOP			/NO; NEW .SCOM+4 IN AC
	DAC	SCOM4		/YES; STORE INTO .SCOM+4 CONTENTS IN 
				/SGNBLK
/
/	XVM MODE SYSTEM? (X) (WILL USER PROGRAMS RUN IN XVM MODE)
/
A.9A	JMS	QUERY		/ASK QUESTION (BR-050)
	.SIXBT	'XVM MODE SYSTEM<@'	/(BR-050)
	LAC	SCOM4		/BIT 17 OF SCOM4 CONTAINS XVM MODE BIT (BR-050)
	JMS	YW1		/YES SETS BIT TO 1 (BR-050)
	LAC	(000001		/INDICATE BIT 17 TO YW1 ROUTINE (BR-050)
	JMP	A.9A		/ERROR - BAD SYNTAX (BR-050)
	NOP			/NO (BR-050)
	DAC	SCOM4		/YES - SAVE RESULT (BR-050)
/
	.EJECT
/
/	MEMORY SIZE ? (X) MUST BE LEQ 128K AND GEQ 24K
/			  ANSWER IN FORM NNNK
/
A.9B	LAC	SCOM20		/GET SYSTEM MEMORY SIZE (BR-053)
	IAC			/SYSTEM MEM SIZE IS NNNK-1 SO ADD 1 TO 
				/SO ADD 1 TO MAKE IT EVEN K (BR-053)
	JMS	MAKEK		/PRODUCE DECIMAL NR IN K (BR-053)
	DAC	MSZ1		/PUT IT IN QUESTION (BR-053)
	JMS	QUERY		/ASK ABOUT SYSTEM MEMORY SIZE (BR-053)
	.SIXBT	'SYSTEM MEMORY SIZE  ['
MSZ1	XX			/SLOT FOR MEMSIZ NR. (BR-053)
	.SIXBT	'K] <@'		/END OF MESSAGE (BR-053)
	CLA			/REQUEST SINGLE ANSWER WITH CR.  (BR-053)
	JMS	ANS		/ASK FOR ANSWER (BR-053)
	JMP	A.9B		/BAD SYNTAX - TRY AGAIN (BR-053)
	JMP	A.10		/DEFAULT - DO NOTHING (BR-053)
	JMP	ALTBAD		/ALT NOT ALLOWED (BR-053)
	JMP	A.9B1		/SYMBOL (NNNK) ONLY GOOD ANSWER (BR-053)
	JMP	KBAD		/OCTAL NUMBER - NO GOOD (BR-053)
A.9B1	AAC	-5		/TEST NR. OF CHAR FOR MAX OF 4 (BR-053)
	SMA			/SKIP IF LEQ 4 (BR-053)
	JMP	KBAD		/ERROR-TOO MANY CHAR (BR-053)
	JMS	KTOOCT		/CONVERT ANSWER,ANSWER+1 TO BIN K NR.(BR-053)
	AAC	-30		/TEST FOR NR. LESS THAN 24K (BR-053)
	SPA			/SKIP IF GEQ 24 (BR-053)
	JMP	KBAD1		/LESS THAN 24K - ERROR (BR-053)
	AAC	30		/RESTORE NUMBER (BR-053)
	CLL			/SET UP SHIFT (BR-053)
	ALS	12		/MULT BY 1024 (BR-053)
	AAC	-1		/PRODUCE NNNK-1 (BR-053)
	DAC	SCOM20		/SAVE IN SCOM (BR-053)
	JMP	A.10		/CONTINUE (BR-053)
	.EJECT
/
/	ROUTINE TO TAKE SIXBT NNNK AND PRODUCE OCTAL NUMBER IN AC
/	NNNK FOUND IN ANSWER,ANSWER+1
/	VALUE CHECKED FOR MULT OF 8K AND LEQ 128K
/	ERROR RETURNS USE RECOVERABLE ERROR  EXITS TO LAST QUERY
/
KTOOCT	0			/ENTRY TO NNNK TO OCTAL K ROUTINE (BR-053)
	DZM	OLDVAL		/CLEAR INITIAL OLD VALUE (BR-053)
	DZM	ANSCNT		/INITIALIZE ANSGET ROUTINE (BR-053)
LOOPKO	JMS	ANSGET		/GET CHARACTER FROM ANSWER,ANSWER+1 (BR-053)
	AAC	-60		/TEST FOR DECIMAL DIGIT (BR-053)
	DAC	TEMP		/SAVE POSSIBLE DIGIT (BR-053)
	SPA			/SKIP IF STILL POSSIBLE (BR-053)
	JMP	NOTNR		/NOT A DECIMAL DIGIT - END LOOP (BR-053)
	AAC	-13		/CHECK IF TOO LARGE A CHAR (BR-0539
	SMA			/SKIP IF DECIMAL DIGIT (BR-053)
	JMP	NOTNR		/NOT A DECIMAL DIGIT - END LOOP (BR-053)
	LAC	OLDVAL		/GET OLD VALUE (BR-053)
	MUL			/MULTIPLY BY TEN (BR-053)
	12			/(BR-053)
	LACQ			/GET RESULT (BR-053)
	TAD	TEMP		/ADD IN NEW DIGIT (BR-053)
	DAC	OLDVAL		/AND SAVE (BR-053)
	AAC	-201		/TEST FOR LARGER THAN 128K (BR-053)
	SMA			/SKIP IF LESS THAN 128K - VALUE OK (BR-053)
	JMP	KBAD2		/ERROR - VALUE TOO LARGE (BR-053)
	JMP	LOOPKO		/GET NEXT POSSIBLE DIGIT (BR-053)
NOTNR	LAC	TEMP		/GET CHARACTER-60 (BR-053)
	SAD	(-45		/IS CHAR 'K' (BR-053)
	SKP		/YES - CONTINUE PROCESSING (BR-053)
	JMP	KBAD		/NO - ERROR (BR-053)
	LAC	OLDVAL		/GET NUMBER (BR-053)
	CLL			/SET UP IDIV (BR-0539
	IDIV			/TEST FOR A MULT OF 8K (BR-053)
	10			/(BR-053)
	SZA			/SKIP IF NO REMAINDER - THUS MULT OF 8K (BR-053)
	JMP	KBAD3		/NOT A MULT OF 8K - ERROR (BR-053)
	LAC	OLDVAL		/RELOAD AC WITH NUMBER (BR-053)
	JMP*	KTOOCT		/RETURN TO CALLER (BR-053)
	.EJECT
/
/	ROUTINE TO TAKE OCTAL NUMBER AND PRODUCE SIXBT DECIMAL NR
/	IN AC - NUMBER MUST BE INTEGER AND LEQ THREE DIGITS X 1024
/	RESULT IS NUMBER/1024
/
MAKEK	0			/ENTRY FOR OCTAL TO DECIMAL K ROUTINE (BR-053)
	CLL			/SET UP SHIFT (BR-053)
	LRS	12		/DIVIDE BY 1024 (BR-053)
	IDIV			/GET ONE'S VALUE (BR-053)
	12			/(BR-053)
	AAC	60		/REMAINDER IS ONE'S - MAKE SIXBT (BR-053)
	DAC	TEMP		/SAVE CHAR (BR-053)
	LACQ			/GET TEN'S,HUNDRED'S (BR-053)
	IDIV			/GET TEN'S (BR-053)
	12			/(BR-053)
	AAC	60		/REMAINDER IS TEN'S - MAKE SIXBT (BR-053)
	CLL			/SET UP SHIFT (BR-053)
	ALS	6		/POSITION CHAR (BR-053)
	TAD	TEMP		/COMBINE CHARS (BR-053)
	DAC	TEMP		/SAVE (BR-053)
	LACQ			/GET HUNDREDS (BR-053)
	SNA			/SKIP IF ANY HUNDRED'S (BR-053)
	LAW	-20		/IF ZERO THEN MAKE CHAR A BLANK (BR-053)
	AAC	60		/MAKE SIXBT CHAR (BR-053)
	CLL			/SET UP SHIFT (BR-053)
	ALS	14		/POSITION CHAR (BR-053)
	TAD	TEMP		/PRODUCE 3 CHAR RESULT (BR-053)
	JMP*	MAKEK		/RETURN TO CALLER (BR-053)
	.EJECT
/	60 CPS? (X) (IS THE LINE VOLTAGE 60 CYCLES OR 50 CYCLES)
/THIS QUESTION IS NEEDED FOR THE CLOCK IN THE RESIDENT MONITOR
/WHICH KEEPS TIME
/
A.10	JMS	QUERY		/ASK QUESTION
	.SIXBT	'60 CPS<@'
	LAC	CLKCON		/COMPUTE DEFAULT
	SAD	(-74		/60 CPS?
	CLA			/YES; CLEAR AC
	JMS	YW0		/AC IS STILL MINUS IF 50 CPS
	LAC	(400000		/AC SIGN INDICATES DEFAULT
	JMP	A.10		/REPEAT QUESTION ON BAD SYNTAX
	JMP	A.10A		/NO MEANS 50 CPS
	LAC	(-74		/- # OF TICKS IN SECOND FOR 60 CPS
	SKP
A.10A	LAC	(-62		/- # OF TICKS IN SECOND FOR 50 CPS
	DAC	CLKCON		/STORE AWAY INTO SGNBLK
A.11	JMS	POTSGK		/SAVE SGNBLK
	.TITLE	B. ALTER I/O DEVICES AND HANDLERS
/
/
/
B.0	JMS	SECTN		/ANOUNCE SECTION QUESTION AND SET ^P
	.SIXBT	'B. ALTER I/O DEVICES OR HANDLERS<@'
	LAC	ODATE		/CLEAR OUT LIST OF DELETED HANDLERS
	DAC	DELPT1		/ON A ^P OR INITIALLY
	LAC	(1
	JMS	YW0		/DEFAULT ANSWER IS NO
	LAC	(1
	JMP	B.0		/REPEAT IF BAD SYNTAX
	JMP	C.0		/IGNORE SECTION IF NO
	JMS	BINSGK		/BRING IN SGNBLK
	LAC	CMD		/(GAR-058) (.SIXBT	'CMD')
	JMS	FHAN		/GO PAST PERMANENT ENTRIES IN SGNBLK
	JMP	BADDEV		/(GAR-058) CMD PSEUDO-DEVICE CAN NOT BE MISSING
				/DISK SYSTEM INTEGRITY IN QUESTION
	.EJECT
/
/	DELETE DISCARDED HANDLERS? (Y) (THIS QUESTION ALLOWS
/THE USER TO DELETE ANY UNNEEDED HANDLERS FROM THE SYSTEM AUTOMATICLY
/WHEN HE DELETES THEM FROM THE LEGAL DEVICE HANDLER TABLE.
/THE DEFAULT ANSWER IS YES BECAUSE ONE WOULD NORMALLY WANT TO DO THIS.
/
B.0A	JMS	QUERY		/ASK QUESTION
	.SIXBT	'DELETE DISCARDED HANDLERS<@'
	LAC	(1
	JMS	YW1		/DEFAULT ANSWER YES
	LAC	(1
	JMP	B.0A		/REPEAT ON BAD SYNTAX
	JMP	B.0B		/NO
	LAC	(SKP		/YES
	SKP
B.0B	LAC	(NOP
	DAC	SKPDEL		/SKP IF DELETE FLAG
	.EJECT
/
/	SECTION TO GO THROUGH SGNBLK AND MODIFY DEVICE TABLE
/
	JMS	QUERY		/ANNOUNCE SEQUENCE OF QUESTIONS
	.SIXBT	'TO BE KEPT:_<@'	/Y MEANS KEEP IN SYSTEM
B.2A0	JMS	NHAN		/GET FIRST HANDLER WHICH MAY BE DELETED
	JMP	B.4		/NO HANDLERS THAT CAN BE DELETED
B.2A1	LAC	P1		/PUT ADDRESS OF FIRST HANDLER NAME
B.2A	DAC	P2		/INTO POINTER P2 
	LAW	17700		/FETCH DEVICE CODE FOR THIS HANDLER
	AND*	P2		/BY STRIPPING OFF HANDLER LETTER
	SNA			/SKIP IF NOT START OF SKIPS (BR-048)
	JMP	B.2B00		/JUMP TO HANDLER LESS ROUTINE (BR-048)
	DAC	B.2B		/DEPOSIT IN QUESTION; USED LATER ALSO
B.2C	JMS	QUERY		/DT? ($) EXAMPLE; DEFAULT IS $
B.2B	.SIXBT	'@@@<@'
	JMS	ALTMOD		/$ DEFAULT
	JMP	B.2C		/REPEAT ON BAD SYNTAX
	JMP	B.2B1		/$ MEANS GO TO NEXT DEVICE
				/AND LEAVE THIS DEVICE UNALTERED
	JMP	B.2BNO		/NO; SET FLAG
	LAC	(SKP		/YES; SET FLAG TO SKP
	JMP	B.2BYS
B.2BNO	LAC	B.2B		/CANNOT DELETE SYSTEM DEVICE
	SAD	SDEV1
	SKP
	JMP	B.2BN1		/NOT SYSTEM DEVICE
	JMS	OUT		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"_>@>(CAN'T DELETE SYSTEM DEVICE)<@"
	JMP*	BADSYN
B.2B00	LAC	P2		/UPDATE P3 TO FAKE OUT NORMAL ACTION (BR-048)
	DAC	P3		/USING P2 (BR-048)
	JMS	QUERY		/ASK IF ANY ACTION TO TAKE (BR-048)
	.SIXBT	'HANDLERLESS DEVICE<@'		/(BR-048)
	JMS	ALTMOD		/ALLOW ALT AS DEFAULT (BR-048)
	JMP	B.2B00		/SYNTAX ERROR (BR-048)
	JMP	B.2B01		/DEFAULT-GO TO NEXT ITEM (BR-048)
	JMP	B.2P		/DELETE -GET RID OF THIS DEVICE (BR-048)
	JMP	B.2L1		/EXAMINE SKIPS (BR-048)
B.2B01	LAC	P2		/FAKE OUT NHAN ROUTINE (BR-048)
	AAC	-1		/BY POINTING TOO FAR BACK (BR-048)
	DAC	P1		/USING P1 (BR-048)
	JMP	B.2A0		/ENTER NORMAL NEXT ITEM STREAM (BR-048)
	.EJECT
B.2BN1	LAC	(NOP		/SET FLAG TO NOP
B.2BYS	DAC	B.2KEF		/STORE IN FLAG TO SKP IF DETAILED QUESTIONS
	LAC	P2		/START GOING THROUGH HANDLERS
	DAC	P3		/BUT SAVE ORIGIN OF ENTRY FOR LATER
				/TESTS FOR COMPLETE DELETION OF DEVICE
B.2D1	LAC*	P2		/GET NEXT HANDLER FROM TABLE
	DAC	B.2E		/STORE IN QUESTION
	SAD	SYHAN		/KEEP IF THIS HANDLER SYSTEM HANDLER
	JMP	B.2H		/TO KEEP HANDLER WITHOUT QUESTION
B.2KEF	XX			/SKP TO ASK QUESTION
	JMP	B.2F1		/AUTOMATICLY DELETE ALL HANDLERS
B.2D2	JMS	QUERY		/ASK QUESTION ABOUT HANDLER
B.2E	.SIXBT	'@@@<@'		/EX. DTA? (Y)
	LAC	(1
	JMS	YW1		/DEFAULT ANSWER IS Y (KEEP HANDLER)
	LAC	(1
	JMP	B.2D2		/REPEAT ON SYNTAX ERROR
	JMP	B.2F1		/DELETE HANDLER
B.2H	ISZ	P2		/GO TO NEXT HANDLER AND SAVE PREVIOUS
B.2H1	LAW	17700		/TEST WHETHER HANDLER IS THERE
	AND*	P2		/BY CHECKING IF FIRST 2 CHARACTERS PRESENT
	SZA
	JMP	B.2D1		/NON-ZERO MEANS NOT DEFAULT FILES
	.EJECT
/
/	ASK FOR NEW HANDLERS
/
B.2M	XCT	B.2KEF		/IF DELETING DEVICE OMIT ASKING FOR NEW
	JMP	B.2L		/HANDLERS
B.2M1	JMS	QUERY		/ANOUNCE SECTION FOR NEW HANDLER INPUT
	.SIXBT	'NEW HANDLERS:_<@'
B.2K	CLC			/FETCH HANDLERS SEPERATED BY 
	JMS	MULANS		/COMMA, ALTMODE OR CR
	JMP	MULBAD		/DO NOT RETYPE HEAD QUESTION ON SYNTAX
				/ERROR
	JMP	B.2L		/STOP ADDING HANDLERS WHEN RECEIVE DEFAULT
				/ANSWER
	JMP	ALTBAD		/$ UNDEFINED
	JMP	B.2ON		/SYMBOL ONLY LEGAL ANSWER
	JMP	NUMBAD		/OCTAL # IS BAD
B.2K1	CLC			/MAY BE MORE ON LINE
	JMS	MORANS		/FETCH NEXT NEW HANDLER ON LINE
	JMP	MULBAD		/SYNTAX ERROR
	JMP	MULBAD
	JMP	MULBAD
	JMP	B.2ON		/SYMBOL ONLY LEGAL ANSWER
	JMP	NUMBAD		/# ILLEGAL
B.2ON	SAD	(3		/# OF CHARACTERS MUST BE 3
	JMP	B.2O2		/QUALIFIES
B.2O3C	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T 3 CHAR<@"
B.2O2	JMS	DELIM		/CHECK FOR LEGAL DELIMITER
	0			/CARRIAGE RETURN OR ALT MODE
	JMP	B.2O1
	JMS	DELIM
	54			/COMMA
	JMP	B.2O1
	JMP	OPBAD		/ILLEGAL DELIMITER
B.2O1	LAW	17700		/CHECK IF SAME DEVICE CODE AS DEVICE
	AND	ANSWER
	SAD	B.2B
	JMP	B.2KA		/SAME DEVICE CODE
B.2BDC	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'HAS BAD DEVICE CODE<@'
B.2KA	LAC	ANSWER		/3RD CHAR MAY NOT BE OCTAL #
	AND	(70		/OR IT WILL BE CONFUSED WITH UNIT #
	SAD	(60
	SKP			/ERROR; THIRD CHARACTER OCTAL #
	JMP	B.2KA1		/GOOD SO FAR
	JMS	RERR		/ANNOUNCE RECOVERABLE SYNTAX ERROR
	.SIXBT	'HAS 3RD CHAR OCTAL #<@'
B.2KA1	LAC	ANSWER		/IS HANDLER NAME ALREADY PRESENT
	JMS	FHAN
	JMP	B.2KC		/NO; ADD TO TABLE
B.2HAP	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS NOT NEW<@'
B.2KC	LAC	ENDSBK		/ADD TO TABLE BY MOVING REST DOWN 1
	DAC	P1
	ISZ	ENDSBK		/FIRST FREE WORD IN SGNBLK INCREMENTED
	AAC	-1		/SET UP POINTERS FOR MOVE (BR-049)
	DAC	P4
B.2I	LAC	P1		/CHECK FOR END OF ITERATION
	SAD	P2
	JMP	B.2J		/FINISHED MOVING REST DOWN
	LAC*	P4		/MOVE NEXT ENTRY
	DAC*	P1		/WORD
	LAC	P4		/MOVE POINTERS UP ONE
	DAC	P1
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P4
	JMP	B.2I
B.2J	LAC	ANSWER		/PUT IN NEW DEVICE HANDLER NAME
	DAC*	P2
	ISZ	P2		/BUMP PAST NAME
	JMS	DELIM		/BRANCH ON DELIMITER
	0
	JMP	B.2K		/GO GET ANOTHER ENTRY
	JMP	B.2K1		/GO GET ANOTHER HANDLER ON SAME LINE
B.2F1	LAC	P2		/DELETE HANDLER
	DAC*	(11		/SET UP AUTO INCREMENT REGISTER TO
	AAC	-1		/MOVE REST OF TABLE UP (BR-049)
	DAC*	(10
	LAW	-1		/FIRST FREE WORD IN SGNBLK COMES UP 1 TOO
	TAD	ENDSBK
	DAC	ENDSBK
B.2G	LAC*	(11		/MOVE ENTRIES UP
	SAD	ENDSBK		/FINISHED?
	JMP	SKPDEL		/YES; SHOULD HANDLER BE DELETED
	LAC*	11		/FROM THE SYSTEM; MOVE ENTRY UP
	DAC*	10
	JMP	B.2G		/ITERATE UNTIL FINISHED
SKPDEL	XX			/SKP IF DELETE HANDLER FILE
	JMP	B.2H1		/DON'T DELTE FILE
	LAC	B.2E		/ADD TO DELTE HANDLER LIST
	JMS	DACFRE		/IN FREE CORE AND CHECK FOR OVERFLOW
	DELPT1
	JMP	B.2H1		/GO BACK FOR MORE 
B.2B1	LAC	P2		/GO TO NEXT DEVICE
	DAC	P1
B.2B2	JMS	NHAN		/GO TO NEXT HANDLER
	JMP	B.4		/NONE LEFT IN SYSTEM
	LAW	17700		/CHECK DEVICE CODE
	AND*	P1
	SAD	B.2B		/NEW DEVICE CODE
	JMP	B.2B2		/NO ITERATE
	JMP	B.2A1		/YES; PROCESS NEW DEVICE
B.2L	LAC	P2		/ARE THERE ANY HANDLERS LEFT FOR DEVICE?
	SAD	P3
	JMP	B.2P		/NO; DELETE DEVICE SKIPS ALSO
	DAC	P3		/SAVE FOR LATER
B.2L1	LAC*	P2		/GET # OF SKIPS IN OLD ENTRY (BR-048)
	CMA			/COMPUTE -#-1
	DAC	MCTR1		/DEPOSIT IN COUNTER
B.2T	ISZ	MCTR1		/IS THIS LAST OLD SKIP?
	JMP	B.2TS		/NO
	JMP	B.2U		/YES; ACCEPT NEW SKIPS
B.2TS	LAC	P3		/UNSAVE P2 TO EXTRACT NEXT SKP
	DAC*	(10		/PUT INTO AUTOINCREMENT REGISTER
	LAC*	10		/PUT SKIP MNEMONIC INTO QUESTION
	DAC	B.2TA
	LAC*	10
	DAC	B.2TA+1
	.EJECT
/
/	ASK ABOUT OLD SKIPS
/
	JMS	QUERY		/ASK QUESTION ABOUT SKIPS
B.2TA	.SIXBT	'@@@@@@=<@'
	LAC*	10		/IF IOT IS POSITIVE THEN IT IS TO BE 
	SPA			/ONE'S COMPLEMENTED AND PRECEEDED BY -
	JMP	B.2TA1		/NEGATIVE
	CMA			/ONE'S COMPLEMENT
	DAC	NUMOUT		/STORE TEMPORARILY
	LAW	55		/PRINT MINUS
	JMS	KLPUT		/PACK INTO BUFFER
	LAC	NUMOUT		/UNSAVE IOT
B.2TA1	JMS	NUMOUT		/DO NOT SUPPRESS LEADING ZEROES
	LAC	(1
	JMS	YW1		/DEFAULT ANSWER IS YES
	LAC	(1
	JMP	B.2TS		/REPEAT ON BAD SYNTAX
	JMP	B.2TB		/NO; DELETE IOT FROM SGNBLK
	LAC	P3		/YES; KEEP SKIP AND GO TO NEXT
	AAC	3		/ENTRY IN TABLE FOR CURRENT DEVICE (BR-049)
	DAC	P3		/BY UPDATING POINTER TO NEXT SKIP
	JMP	B.2T		/ITERATE
B.2TB	LAW	-1		/DELETE THIS SKIP
	TAD*	P2		/BY SUBTRACTING FROM # OF SKIPS
	DAC*	P2		/FOR THIS ENTRY
	LAC	P3		/SK:047**SPR:15-E903**AND MOVING REST OF TABLE UP 3
	DAC*	(10		/AUTOINCREMENT REGISTER 10
	AAC	3		/ADD 3 (BR-049)
	DAC*	(11
B.2TB1	LAC*	(11		/DONE?
	IAC			/COMPENSATE FOR AUTOINCREMENT (BR-049)
	SAD	ENDSBK		/BY LOOKING FOR END OF SGNBLK
	JMP	B.2TB2		/YES; UPDATE NEW END OF TABLE
	LAC*	11
	DAC*	10
	JMP	B.2TB1		/ITERATE
B.2TB2	LAC*	(10		/NEW END OF SGNBLK
	IAC		/ADD 1 (BR-049)
	DAC	ENDSBK
	JMP	B.2T		/GO TO NEXT SKIP
	.EJECT
/
/	ASK FOR NEW SKIPS
/
B.2U	JMS	QUERY		/ASK FOR NEW SKIPS TO BE ADDED
	.SIXBT	'NEW SKIPS:_<@'	/JUST HEADER FOR MULTILINE SEQUENCE
B.2U1	CLC			/NOT JUST SIMPLE ANSWER
	JMS	MULANS		/EX. SKPDC=702103
	JMP	MULBAD		/DO NOT RETYPE FOR ERRORS IN MULTILINE
				/SEQUENCE
	JMP	B.2S		/DEFAULT ADDS NOTHING
	JMP	ALTBAD		/$ UNDEFINED
	JMP	B.2U2		/SYMBOL IS ONLY ACCEPTABLE ANSWER
	JMP	NUMBAD		/OCTAL # IS ILLEGAL
B.2U3	CLC			/MAY BE MORE ON LINE
	JMS	MORANS		/FETCH NEXT MNEMONIC ON SAME LINE
	JMP	MULBAD		/SYNTAX ERROR
	JMP	MULBAD
	JMP	MULBAD
	JMP	B.2U2		/SYMBOL ONLY LEGAL ANSWER
	JMP	NUMBAD		/# ILLEGAL
B.2U2	JMS	DELIM		/TEST FOR LEGAL DELIMITER
	75			/=
	SKP			/DELIMITER IS =
	JMP	OPBAD		/OTHER DELIMITERS ARE SYNTAX ERRORS
	JMS	FSKPM		/TEST WHETHER IOT IS NEW
	JMP	B.4H		/NEW; OK
B.4J	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS USED MNEMONIC<@'
B.4H	JMS	SAVANS		/PUT ANSWER AWAY FOR SAFE KEEPING
	CLC			/MAY BE MORE ON LINE
	JMS	MORANS		/OR ALT MODE
	JMP	MULBAD		/MULTILINE RECOVERY FOR SYNTAX ERRORS
	JMP	CRBAD		/NO DEFAULT CASE
	JMP	ALTBAD		/$ UNDEFINED
	JMP	SYMBAD		/SYMBOL ILLEGAL HERE
	SMA			/# MUST BE 1'S COMPLEMENT IF POSITIVE
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	SKPIOT		/SAVE AWAY
	SMA			/CHECK IF # IS IOT
	CMA			/NEGATIVE SKIPS MUST BE COMPLEMENTED
	AND	(770011		/MASK OFF INSTRUCTION BITS AND 
				/SKP AND AC CLEAR BITS (BR-43)
	SAD	(700001		/SKIP IOT ? (BR-43)
	JMP	B.4H1		/YES
	AND	(770010		/TEST FOR ILLEGAL IOT (BR-051)
	SAD	(700000		/SKIP IF NOT LEGAL IOT (BR-051)
	JMP	B.4H1A		/LEGAL IOT - BAD SKIP (BR-051)
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ILLEGAL IOT<@"	/NOT IOT OR CLEAR AC BIT SET (BR-051)
SKPIOT	0			/NEW SKIP IOT
B.4H1	JMS	DELIM		/CHECK FOR LEGAL DELIMITER
	0			/CARRIAGE RETURN OR ALT MODE
	JMP	B.4I
	JMS	DELIM
	54			/COMMA
	JMP	B.4I
	JMP	OPBAD		/ILLEGAL DELIMITER
B.4I	LAC	SKPIOT		/IS IT OLD SKP?
	JMS	FSKPN
	JMP	B.4I1		/NO; OK
	JMS	RERR		/YES; ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS USED SKIP IOT<@'
B.4I1	ISZ*	P2		/ADD NEW SKIP INTO COUNT FOR 
				/FOR THIS DEVICE
	LAC	ENDSBK		/ADD 3 TO SIZE OF SGNBLK
	AAC	3		/ADD 3 (BR-049)
	DAC	ENDSBK
B.4I2	AAC	-1		/PUSH EVERYTHING 3 DOWN (BR-049)
	DAC	P1		/UPDATE PUSH POINTERS
	AAC	-3		/3 WORD DIFFERENCE (BR-049)
	DAC	P4
	SAD	P2		/ARE WE AT THE END?
	JMP	B.4I3		/YES
	LAC*	P4		/PUSH NEXT WORD DOWN
	DAC*	P1
	LAC	P1		/GET POINTER INTO AC FOR UPDATE
	JMP	B.4I2		/ITERATE
B.4I3	LAC	P2		/ADD SKIP TO TABLE
	DAC*	(10		/AUTOINCREMENT REGISTER
	LAC	ANSTMP		/SKIP MNEMONIC
	DAC*	10
	LAC	ANSTMP+1
	DAC*	10
	LAC	SKPIOT		/SKIP IOT
	DAC*	10
	LAC	P3		/GO TO NEXT SKIP
	AAC	3		/ADD 3 (BR-049)
	DAC	P3
	JMS	DELIM		/GO TO APPROPRIATE PLACE FOR NEXT 
	0			/SKIP IOT
	JMP	B.2U1		/READ ANOTHER LINE
	JMP	B.2U3		/KEEP GOING ON SAME LINE
/
/
B.4H1A	JMS	OUT		/SAY BAD SKIP (BR-051)
	.SIXBT	'>NOT A STANDARD SKIP IOT<@'	/BIT 17 NOT SET (BR-051)
	JMS	QUERY		/ASK IF ACCEPT ANYWAY (BR-051)
	.SIXBT	'DO YOU WISH IT ACCEPTED<@'
	JMS	NO		/NO IS THE DEFAULT (BR-051)
	JMP	B.4H1A		/SYNTAX ERROR (BR-051)
	JMP	ALTBAD		/ALTMODE BAD ANSWER (BR-051)
	JMP	B.2U1		/DUMP IT (BR-051)
	JMP	B.4H1		/USE IT (BR-051)
/
/
/	DELETE DEVICE
/
B.2P	LAC*	P2		/COMPUTE # OF WORDS TO BE DELETED
	RCL			/MULTIPLY BY 3
	TAD*	P2
	IAC			/AND ADD 1 FOR WORD CONTAINING # OF SKIPS (BR-049)
	TAD	P2		/ADD TO BEGINNING OF SKIP TABLE
	DAC	P4
B.2Q	LAC	P4		/TEST IF FINISHED
	SAD	ENDSBK
	JMP	B.2R		/YES; FINISHED
	LAC*	P4		/MOVE ENTRY UP
	DAC*	P2
	ISZ	P4
	ISZ	P2
	JMP	B.2Q		/BUMP TO NEXT ENTRY AND ITERATE
B.2R	LAC	P2		/UPDATE ENDSBK (END OF SGNBLK)
	DAC	ENDSBK		/FIRST FREE ADDRESS IN SGNBLK
	CLA!SKP
B.2S	LAC	(1		/IS THIS LAST SKIP IN SGNBLK
	TAD	P3		/P3 IS COMPENSATED FOR AUTOINCREMENT
	SAD	ENDSBK
	JMP	B.4		/YES; GO TO NEXT SECTION
	JMP	B.2A		/NO; ITERATE
B.4	LAC	CMD		/START SEARCH FOR HANDLRLSS DEV AT CMD (BR-055)(GAR-058)
	JMS	FHAN		/FIND CMD (BR-055)(GAR-058)
	JMP	BADDEV		/FATAL ERROR - IF NO CMD (BR-055) (GAR-058)
LOOP	JMS	NHAN		/FIND NEXT HANDLER (BR-055)
	JMP	B.5		/NO MORE HANDLERS - DONE (BR-055)
	LAC	P1		/GET ADDRESS OF FIRST HANDLER LOC (BR-055)
	DAC	P2		/SAVE IN POINTER (BR-055)
	LAW	17700		/SET UP TEST FOR HANDLERLESS DEV (BR-055)
	AND*	P2		/IS IT A HANDLERLESS DEVICE (BR-055)
	SZA			/SKIP IF A HANDLERLESS DEV (BR-055)
	JMP	LOOP		/GET NEXT HANDLER AND TRY AGAIN (BR-055)
	LAC*	P2		/GET SKIP COUNT (BR-055)
	SZA			/SKIP IF NO SKIPS (BR-055)
	JMP	B.4Z1		/IT HAS SKIPS - GO TO NEXT HANDLER (BR-055)
	LAC	P2		/GET POINTER TO FIRST HANDLER ENTRY (BR-055)
	IAC			/POINT TO START OF NEXT HANDLER (BR-055)
	DAC	P4		/SAVE POINTER (BR-055)
LOOP1	LAC	P4		/GET POINTER TO NEXT ENTRY TO MOVE UP (BR-055)
	SAD	ENDSBK		/ARE WE DONE MOVING UP (BR-055)
	JMP	B.4Z		/YES - SET UP TO GET NEXT HANDLER (BR-055)
	LAC*	P4		/GET NEXT TABLE ENTRY (BR-055)
	DAC*	P2		/MOVE IT UP ONE (BR-055)
	ISZ	P2		/POINT TO NEXT ENTRY (BR-055)
	ISZ	P4		/POINT TO NEXT SOURCE (BR-055)
	JMP	LOOP1		/MOVE NEXT WORD UP (BR-055)
B.4Z	LAC	ENDSBK		/GET END OF SGNBLK POINTER (BR-055)
	AAC	-1		/PUSH IT UP ONE ENTRY (BR-055)
	DAC	ENDSBK		/AND SAVE IT (BR-055)
B.4Z1	LAC	P1		/GET POINTER TO DELETED DEV (BR-0559
	AAC	-1		/DECREMENT (BR-055)
	DAC	P1		/SAVE - THIS CAUSES SEARCH TO FIND NEXT DEVICE
				/WHICH HAS BEEN MOVED UP ONE (BR-055)
	JMP	LOOP		/GO FIND DEVICE (BR-055)
B.5	JMS	POTSGK		/RECORS SGNBLK IN DUMMY BLOCK (BR-055)
	.TITLE	C. ADD NEW DEVICE
/
/
/
C.0	JMS	SECTN		/ANOUNCE NEW SECTION AND SET ^P ADDRESS
	.SIXBT	'C. ADD NEW DEVICE<@'
	LAC	(1
	JMS	YW0		/DEFAULT NO
	LAC	(1
	JMP	C.0		/REPEAT IF SYNTAX ERROR
	JMP	C.6		/NO; SKIP SECTION
	JMS	BINSGK		/YES; BRING IN SGNBLK
/
/	ASK FOR DEVICE CODE FOR NEW HANDLER
/
C.1	JMS	QUERY		/ASK QUESTION
	.SIXBT	'DEVICE CODE[] <@'
	CLA			/REPLY IS SINGLE SYMBOL ENDED BY CAR. RET
	JMS	ANS		/OR ALT MODE
	JMP	C.1		/REPEAT QUESTION IF SYNTAX ERROR
	JMP	CRBAD		/NO DEFAULT CASE
	JMP	ALTBAD		/$ UNDEFINED
	JMP	C.2		/SYMBOL IS ONLY LEGAL REPLY
	JMP	NUMBAD		/# IS MEANINGLESS
C.2	SAD	(2		/MUST BE EXACTLY 2 CHARACTERS
	JMP	C.3
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T 2 CHAR<@"
C.3	LAC	ANSWER		/PUT DEVICE CODE IN QUESTION TO
	JMS	FDEV		/FAKE OUT SECTION B ROUTINES
	JMP	C.5		/AND CHECK WHETHER DEVICE IS NEW
	JMS	RERR		/DEVICE SAME AS OLD ONE; ANNOUNCE ERROR
	.SIXBT	"ISN'T NEW DEVICE<@"
C.5	LAC	ENDSBK		/ADD TO END OF SGNBLK TABLE
	DAC	P2
	DZM	P3		/ZAP P3 TO ALLOW HANDLERLESS DEV. (BR-048)
	ISZ	ENDSBK		/PUT IN # OF SKIPS; 0 HANDLERS
	DZM*	P2
	JMP	B.2M1		/JMP INTO SECTION B CODE
C.6	JMS	BINSGK		/BRING IN SGNBLK TO ANNOUNCE MISSING
	LAC	CMD		/(GAR-058) HANDLERS; GO PAST PERMANENT HANDLER
	JMS	FHAN
	JMP	BADDEV		/(GAR-058) CMD PSEUDO-DEVICE MUST BE THERE
	CLC			/PRINT HEADING ONCE ONLY IF NEEDED
	DAC	CSW
CSW	XX			/PUTS ITSELF INTO AC
C.7	JMS	NHAN		/GET NEXT HANDLER
	JMP	D.0		/NONE LEFT
	AND	(17700
	SNA
	JMP	C.71
	LAC*	P1
	DAC	I.2DEL		/STORE INTO FILE NAME
	DAC	C.7CK		/STORE INTO MESSAGE
	.FSTAT	-14,I.2DEL	/CHECK IF ON SYSTEM
	SZA			/THERE
	JMP	C.7		/ITERATE
	ISZ	CSW		/CHECK SWITCH
	JMP	C.8		/ALREADY PRINTED HEADIN
	JMS	QUERY		/PRINT HEADING
	.SIXBT	'MISSING HANDLERS:<@'
C.8	JMS	QUERY		/PRINT ERROR LINE
C.7CK	.SIXBT	'@@@.<@'
	JMP	C.7
C.71	LAC	P1
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P1
	JMP	C.7
	.TITLE	D. CHANGE SKIP CHAIN
/
/
/
D.0	JMS	SECTN		/ANOUNCE SECTION HEAD AND SET ^P ADDRESS
	.SIXBT	'D. CHANGE SKIP CHAIN<@'
	LAC	(1
	JMS	YW0		/DEFAULT NO
	LAC	(1
	JMP	D.0		/REPEAT ON BAD SYNTAX
	JMS	SUPSEC		/NO TAKE DEFAULT ANSWERS AND SUPRESS
				/QUESTIONS
/
/	DISPLAY SKIP CHAIN? (Y) (TYPE SKIP CHAIN
/IN DEFAULT ORDER) THE SKIP CHAIN IS ORDERED IN THIS SECTION.  WHILE
/IT IS BEING ORDERED THEY CAN OF COURSE BE OUTPUT TO THE TELETYPE.
/OLD PERMANENT SKIPS CORRESPONDING TO THE PSEUDO HANDLER NONE ARE
/KEPT ONLY IF THEY WERE IN THE OLD SKIP CHAIN.  THEY MAY BE ADDED
/AT ANY TIME INTO A NEW SKIP CHAIN WITHOUT HAVING TO SPECIFY THEM
/FOR A DEVICE.
/
D.1	JMS	QUERY		/ASK QUESTION
	.SIXBT	'DISPLAY SKIP CHAIN<@'
	LAC	(1
	JMS	YW1		/DEFAULT YES
	LAC	(1
	JMP	D.1		/REPEAT FOR SYNTAX ERROR
	JMS	SUPSEG		/NO; SEGMENT SUPRESSION; SEGMENT
				/SUPRESSION MEANS THAT AS SOON AS
				/THE ORDERING OF THE SKIP CHAIN IS
				/THROUGH ALL FURTHER TELETYPE I/O
				/WILL BE OUTPUT PROVIDING SECTION
				/SUPRESSION IS NOT IN FORCE
	JMS	BINSGK		/YES; BRING IN SGNBLK
	LAC	SGNSKP		/GO THROUGH OLD SKIP CHAIN AND
	DAC	P2		/RETAIN ALL SKIPS FOR UNDELETED DEVICES
	JMS	QUERY		/STATE THE FOLLOWING IS A LIST OF SKIPS
	.SIXBT	'DEFAULT SKIP CHAIN ORDER:<@'
D.2	LAC	P2		/IS THIS THE LAST ENTRY
	SAD	DEVSBK		/
	JMP	D.3		/YES
	LAC*	P2		/PICK UP SKIP
	JMS	FSKPN		/FIND IN TABLE
	JMP	D.2D		/NOT IN TABLE; DELETE
D.2M	LAC*	P1		/FOUND IT; KEEP IN CHAIN AND PRINT
	DAC	D.2DIS		/IN TABLE OF SKIPS
	ISZ	P1
	LAC*	P1		/PICK UP SECOND HALF OF MNEMONIC
	DAC	D.2DIS+1
	ISZ	P2		/BUMP PAST SKIP
D.2L	JMS	QUERY		/PRINT SKIP MNEMONIC
D.2DIS	.SIXBT	'@@@@@@<@'
	JMP	D.2		/GO BACK FOR MORE
D.2D	LAC	P2		/SET UP LOOP TO MOVE REST OF SGNBLK UP
	DAC*	(10
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(11
D.2DL	LAC*	(10		/FINISHED MOVING?
	IAC			/ADD 1 (BR-049)
	SAD	ENDSBK
	JMP	D.2DF		/YES
	LAC*	10
	DAC*	11		/MOVE WORD
	JMP	D.2DL		/ITERATE
D.2DF	AAC	-1		/UPDATE DEVICE TABLE END AND BEGINNING (BR-049)
	DAC	ENDSBK		/POINTERS
	LAC	DEVSBK
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	DEVSBK
	JMP	D.2		/ITERATE
	.EJECT
/
/	LOOK THROUGH DEVICE TABLE FOR SKIPS NOT YET IN SKIP CHAIN
/
D.3	LAW	-1		/INITIALIZE NSKP TO LOOK THROUGH
	DAC	SKPC		/DEVICE TABLE FOR SKIPS NOT IN CHAIN
	LAC	CMD		/(GAR-058) YET AND PUT THEM IN LAST;
	JMS	FHAN		/SKIP OVER PERMANENT SKIPS
	JMP	BADDEV		/(GAR-058) CMD PSEUDO-DEVICE MISSING INDICATES 
				/(GAR-058) SYSTEM PROBLEM
D.3N	JMS	NSKP		/FIND NEXT SKIP
	JMP	D.4		/NONE LEFT
	DAC	ANSTMP		/TEMPORARILY STORE SKIP IOT
	LAC	SGNSKP		/CHECK IF ALREADY IN CHAIN
	DAC	P3
D.3L	LAC	P3		/HAVE WE EXHAUSTED THE CURRENT LIST
	SAD	DEVSBK		/OF SKIPS IN CHAIN
	JMP	D.3S		/YES; PUT IN NEW SKIP
	LAC*	P3		/FETCH SKIP
	SAD	ANSTMP		/IS THIS SKIP THE SAME?
	JMP	D.3N		/YES; IGNORE THIS SKIP
	ISZ	P3		/MOVE DOWN SKIP CHAIN
	JMP	D.3L		/ITERATE FOR NEXT SKIP
D.3S	LAC	ENDSBK		/MOVE DEVICE TABLE DOWN 1 TO FIT NEW
	IAC			/SKIP IN CHAIN (BR-049)
	DAC	ENDSBK
D.3SL	AAC	-1		/START FROM END (BR-049)
	DAC	P3		/UPDATE POINTERS
	SAD	DEVSBK		/FINISHED?
	JMP	D.3SF		/YES; PUT IN NEW IOT
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P4
	LAC*	P4		/MOVE WORD DOWN
	DAC*	P3		/ONE
	LAC	P3		/ITERATE
	JMP	D.3SL
D.3SF	LAC	ANSTMP		/PUT IOT IN PLACE
	DAC*	P3
	ISZ	DEVSBK		/INCREMENTEND OF SKIP TABLE POINTER
	ISZ	P1		/INCREMENT PLACE IN DEVICE TABLE
	LAC	P1		/GET MNEMONIC AND PRINT
	DAC*	(10
	LAC*	P1		/FETCH FIRST WORD
	DAC	D.3DIS
	LAC*	10
	DAC	D.3DIS+1	/SECOND WORD
	JMS	QUERY		/PRINT MNEMONIC
D.3DIS	.SIXBT	'@@@@@@<@'
	JMP	D.3N
	.EJECT
/
/D.4 CHANGE SKIP CHAIN ORDER
/
D.4	LAC	(SKP		/REMOVE SEGMENT SUPRESSION
	DAC	IOSEG
	SAD	IOSEC		/SECTION SUPRESSION?
	SKP
	JMP	D.4K		/YES; OMIT SECTION
	JMS	CRLF
	JMS	QUERY		/ASK USER TO TYPE SKIP CHAIN
	.SIXBT	'SKIP MNEMONICS IN ORDER:_<@'
	LAC	SGNSKP
	DAC	P2
D.4H	CLC			/MNEMONICS SEPERATED BY COMMAS
	JMS	MULANS		/BY CAR. RET. OR ALT MODE
	JMP	MULBAD		/BAD SYNTAX DOES NOT REPEAT SECTION HEAD
	JMP	D.4T		/DEFAULT TERMINATES BUILDING OF SKIP CHAIN
	JMP	D.4A		/$ MEANS TAKE NEXT SKIP IN DEFAULT ORDER
	JMP	D.4H2		/SYMBOL IS APPROPRIATE
	JMP	NUMBAD		/# ILLEGAL AS SKIP MNEMONIC
D.4H1	CLC			/FETCH NEXT SKIP ON LINE
	JMS	MORANS
	JMP	MULBAD		/BAD SYNTAX
	JMP	MULBAD
	JMP	MULBAD
	JMP	D.4H2		/SYMBOL APPROPRIATE
	JMP	NUMBAD		/# ILLEGAL
D.4H2	JMS	DELIM		/CHECK DELIMITERS
	0			/CARRIAGE RETURN OR ALTMODE
	JMP	D.4H3
	JMS	DELIM
	54			/COMMA
	JMP	D.4H3
	JMP	OPBAD		/ILLEGAL DELIMITER
D.4H3	JMS	FSKPM		/FIND SKIP IN DEVICE TABLE
	JMP	D.4M		/IF NOT THERE ANOUNCE ERROR
	DAC	ANSTMP		/SAVE
	JMP	D.4N
D.4M	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T SKIP MNEMONIC<@"
D.4N	LAC	SGNSKP		/HAS SKIP BEEN PUT INTO CHAIN ALREADY
	DAC	P3
D.4NL	LAC	P3		/ARE WE TO THE NEW SECTION YET
	SAD	P2
	JMP	D.4NE		/NOT IN BUILT CHAIN YET
	LAC*	P3		/EXAMINE THIS SKIP
	ISZ	P3		/BUMP TO NEXT
	SAD	ANSTMP		/IS IT THE SAME AS CURRENT ENTRY
	SKP			/YES
	JMP	D.4NL		/NO; ITERATE
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS REPEAT<@'
D.4NE	SAD	DEVSBK		/IS SKIP IN CHAIN AT ALL?
				/THE REST OF THE CHAIN IS TENTATIVE
				/AND REPRESENTS THE DEFAULT FOR
				/THE $ COMMAND.  THE SKIP SPECIFIED
				/COULD BE A REPEAT OF PERMANENT SKIPS
				/ELIMINATED FROM THE SKIP CHAIN BY A 
				/PREVIOUS SYSTEM GENERATION;  IF SO
				/THEY WILL BE PUT INTO THE CHAIN AND
				/THE REST OF SGNBLK MOVED DOWN.
	JMP	D.4NO		/NO; PUT INTO SKIP CHAIN
	LAC*	P3		/EXAMINE ENTRY
	SAD	ANSTMP		/IS IT THE SAME AS CURRENT ANSWER
	JMP	D.4YES		/YES; MOVE INTERVENING DOWN
	ISZ	P3		/NO; MOVE TO NEXT ENTRY
	LAC	P3
	JMP	D.4NE		/ITERATE
D.4YES	LAC	P3		/MOVE EVERYTHING DOWN ONE UP UNTIL
				/THIS ENTRY AND INSERT THIS ENTRY
				/NEXT IN CHAIN
	SAD	P2		/HAVE ALL ENTRIES BEEN MOVED
	JMP	D.4Y1		/YES; PUT IN SKIP NOW
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P4
	LAC*	P4		/MOVE THIS WORD DOWN
	DAC*	P3
	LAC	P3		/MOVE POINTERS UP ONE
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P3
	JMP	D.4YES		/AND ITERATE
D.4Y1	LAC	ANSTMP		/INSERT SPECIFIED SKIP NOW
	DAC*	P3
D.4HS	ISZ	P2		/BUMP END OF ESTABLISHED CHAIN ONE
	JMS	DELIM		/DISPATCH ON DELIMITER
	0			/CARRIAGE RETURN OR ALTMODE
	JMP	D.4H		/ITERATE
	JMP	D.4H1		/READ ON SAME LINE
D.4NO	LAC	ENDSBK		/MOVE DEVICE TABLE DOWN 1
	IAC			/IN ORDER TO INSERT PERMANENT SKIP (BR-049)
	DAC	ENDSBK
D.4NOL	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P3
	SAD	DEVSBK		/FINISHED?
	JMP	D.4NOE		/YES; INSERT SKIP AT 
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P4
	LAC*	P4		/MOVE WORD DOWN
	DAC*	P3
	LAC	P3		/CHECK FOR COMPLETION
	JMP	D.4NOL		/AND ITERATE
D.4NOE	LAC	ANSTMP		/PUT SKIP IN AT END OF TABLE AND THEN
	DAC*	P3		/GO THROUGH PROCESS AS IF ALWAYS THERE
	ISZ	DEVSBK		/NEW BEGINNING OF DEVICE TABLE
	JMP	D.4N		/TRY AGAIN
D.4A	LAC	P2		/ARE THERE ANY MORE SKIPS TO ADD?
	SAD	DEVSBK
	JMP	D.4T		/NO; GO ON TO NEW SECTION
	LAC*	P2		/PRINT OUT SKIP MNEMONIC TO 
	JMS	FSKPN		/DECLARE THE SKIP OBTAINED
	JMP	BADDEV		/PROGRAM ERROR OR HARDWARE FAILURE
				/AS THE SKIP SHOULD BE THERE
	LAC	P1		/FETCH MNEMONIC
	DAC*	(10
	LAC*	P1
	DAC	D.4DIS		/FIRST WORD
	LAC*	10
	DAC	D.4DIS+1	/SECOND WORD
	JMS	OUT
D.4DIS	.SIXBT	'@@@@@@_<@'
	ISZ	P2		/BUMP PAST CURRENT ADDITION TO CHAIN
	JMP	D.4H		/GO BACK FOR MORE
	.EJECT
D.4T	LAC	DEVSBK		/TERMINATE BUILDING OF SKIP CHAIN
	DAC	P4		/AND MOVE ANY DELETED ENTRIES OUT
	LAC	P2		/CHANGE BEGINNING OF DEVICE
	SAD	SGNSKP		/DO NOT ALTER SKIP CHAIN IF NO 
	JMP	D.4K		/SKIPS SPECIFIED FOR SKIP CHAIN
	SAD	DEVSBK		/TABLE TO REFLECT ANY DELETED SKIPS
	JMP	D.4K		/NO DELETED SKIPS
	DAC	DEVSBK
D.4TL	LAC	P4		/MOVE DEVICE TABLE UP TO FILL
	SAD	ENDSBK		/IN VACANT ENTRIES
	JMP	D.4TLF		/FINISHED
	LAC*	P4		/MOVE WORD UP
	DAC*	P2
	ISZ	P4		/BUMP POINTERS
	ISZ	P2
	JMP	D.4TL		/ITERATE
D.4TLF	LAC	P2		/NEW END OF SGNBLK
	DAC	ENDSBK
D.4K	JMS	POTSGK		/OUTPUT SGNBLK TO DUMMY BLOCK
	.TITLE	E. ALTER SPECIAL DEVICE PARAMETERS
/
/
/
E.0	JMS	SECTN		/ANNOUNCE SECTION HEAD AND SET ^P
	.SIXBT	'E. ALTER DEVICE PARAMETERS<@'
	LAC	(1
	JMS	YW0		/DEFAULT NO
	LAC	(1
	JMP	E.0		/BAD SYNTAX
	JMS	SUPSEC		/NO; TAKE DEFAULT ANSWERS
	JMS	BINSGK		/YES; BRING IN SGNBLK
E.1	LAC	LMT		/(.SIXBT 'MT' ; DOES SYSTEM HAVE
	JMS	FDEV		/MAGNETIC TAPE?
	JMP	E.1B		/NO; IGNORE QUESTION AND CLEAR BITS
E.1A	JMS	QUERY		/ASK QUESTION
	.SIXBT	'7 CHANNEL MAGTAPE<@'
	LAC	SCOM4		/DEFAULT IS OLD VALUE
	JMS	YW0		/7 CHANNEL IS ASSUMED IF BIT
	LAC	(4000		/6 IS 1
	JMP	E.1A		/REPEAT FOR BAD SYNTAX
	NOP			/NO; ANSWER IS IN AC
	JMP	E.1C		/YES; NEW .SCOM+4 CONTENTS IN AC
E.1B	LAC	SCOM4		/CLEAR OUT BIT 6 OF .SCOM+4
	AND	(773777
E.1C	DAC	SCOM4		/DEPOSIT NEW VALUE OF .SCOM+4
E.2	LAC	LLP		/(.SIXBT 'LP' DOES SYSTEM HAVE 
	JMS	FDEV		/A LINE PRINTER?
	JMP	E.2B		/NO; CLEAR OUT BITS FOR LINE PRINTER
	LAC	SCOM4		/OLD VALUE IN .SCOM+4
	RTR			/BITS 12,13; RIGHT ADJUST INTO AC
	RTR			/BITS 16,17
	AND	(3		/CLEAN
	SNA			/0 MEANS NO DEFAULT VALUE
	JMP	E.2Q		/NO DEFAULT VALUE
	TAD	(LAC LVT	/MAKE INSTRUCTION TO FETCH DEFAULT 
	DAC	.+1		/MESSAGE
	XX
	DAC	E.2DEF		/PUT DEFAULT MESSAGE INTO REPORT
E.2Q	JMS	QUERY		/ASK QUESTION
	.SIXBT	'LINE PRINTER LINE SIZE(80,120, OR 132)['
E.2DEF	.SIXBT	'@@@] <@'
	CLA			/ANSWER IS ALONE ON LINE AND TERMINATED
	JMS	ANS		/BY A CAR. RET. OR ALT MODE
	JMP	E.2Q		/REPEAT ON SYNTAX ERROR
	JMP	E.3		/DEFAULT  ACCEPTS OLD ANSWER
	JMP	ALTBAD		/$ UNDEFINED
	NOP			/SYMBOL
	LAC	ANSWER+1	/#; MUST BE ONLY 3 OR FEWER CHARACTERS
	SZA
	JMP	ANBAD		/MORE THAN THREE CHARACTERS
E.2A	LAC	ANSWER		/CHECK THAT ANSWER IS ONE OF 3
	SMA			/ALL ANSWERS ARE MINUS
	JMP	ANBAD
	SAD	LS80		/80?
	LAC	(20		/YES; BIT 13 ON ONLY
	SAD	LS120		/120?
	LAC	(40		/YES; BIT 12 ON ONLY
	SAD	LS132		/132?
	LAC	(60		/YES; BITS 12,13 ON
	SPA
	JMP	ANBAD		/NOT ONE OF 3 POSSIBLE ANSWERS
	SKP
E.2B	CLA			/CLEAR BITS
	XOR	SCOM4		/PUT INTO .SCOM+4
	AND	(60
	XOR	SCOM4		/BITS 12,13
	DAC	SCOM4
E.3	LAC	LVT		/(.SIXBT 'VT'; DOES SYSTEM HAVE
	JMS	FDEV		/A VT SCOPE
	JMP	E.3C		/NO; CLEAR BITS
	.EJECT
E.3A	JMS	QUERY		/ASK QUESTION
	.SIXBT	'VT ON<@'
	LAC	SCOM33		/.SCOM+33 BIT 2 = 1 WHEN YES
	JMS	YW1		/IS GIVEN
	LAC	(100000
	JMP	E.3A		/REPEAT ON BAD SYNTAX
	NOP			/NO; ANSWER IN AC
	DAC	SCOM33		/YES; NEW CONTENTS OF .SCOM+33 IN AC
E.3D	JMS	QUERY		/ASK QUESTION
	.SIXBT	'HALF ON<@'
	LAC	SCOM33		/.SCOM+33 BIT 0=1 WHEN YES
	JMS	YW1		/IS GIVEN
	LAC	(400000
	JMP	E.3D		/REPEAT IF BAD SYNTAX
	NOP			/NO; ANSWER IN AC
	DAC	SCOM33		/YES; ANSWER IN AC (NEW .SCOM+33
	JMP	E.4
E.3C	DZM	SCOM33		/ZERO .SCOM+33 IF NO VT
E.4	JMS	POTSGK		/RECORD NEW SGNBLK
	.TITLE	F. ALTER .DAT SLOTS
/
/
/
F.0	JMS	SECTN		/ANNOUNCE SECTION HEAD AND SET ^P
	.SIXBT	'F. ALTER .DAT SLOTS<@'
	LAC	(1
	JMS	YW0		/DEFAULT NO
	LAC	(1
	JMP	F.0		/BAD SYNTAX CAUSES REPEAT
	JMS	SUPSEC		/NO; TAKE DEFAULT
	JMS	BINSGK		/YES; BRING IN SGNBLK
	LAC	SGNDAT		/UPDATE DEFAULT CONTENTS OF .DAT
	DAC	P3
	LAC	ODATB		/REFER TO LIST IN FREE CORE OF OLD NAMES
	DAC	P4
F.0A	LAC	P3		/GO THROUGH LIST AND GET NEW HANDLER
				/NUMBERS FOR OLD NAMES
	SAD	SGNUFD		/DONE?
	JMP	F.1		/YES
	LAC*	P3		/COMPUTE NEXT HANDLER NUMBER
	SAD	(100000		/DO NOTHING IF PERMANENT SLOT
	JMP	F.0B		/PERMANENT SLOT
	LAC*	P4		/GET NAME AND CONVERT
	JMS	FHAN
	JMP	F.0A1		/IF NAME GONE, CHANGE TO NONE
	XOR*	P3		/LEAVE UNIT NUMBERS THE SAME
	AND	(77777		/BY MERGING WITH OLD CONTENTS
	XOR*	P3
	SKP
F.0A1	CLA			/0 IS NONE
	DAC*	P3		/STORE BACK INTO SGNBLK
F.0B	ISZ	P4		/BUMP TO NEXT SLOT
	ISZ	P3
	JMP	F.0A		/ITERATE
/
/	FIND # OF POSITIVE .DAT SLOTS
/
F.1	JMS	QUERY		/ASK QUESTION
	.SIXBT	'# OF POSITIVE .DAT SLOTS[<@'
	LAC	NODAT		/PRINT OLD #
	RCR			/DIVIDE BY 2
	AAC	-16		/SUBTRACT NEGATIVE AND 0 (BR-049)
	DAC	ONPDAT		/STORE FOR FUTURE
	JMS	NUMSUP		/PRINT WITH 0 SUPRESSION
	JMS	OUT		/PRINT REMAINDER OF MESSAGE
	.SIXBT	'] <@'
	CLA			/ANSWER IS ALONE AND TERMINATED
	JMS	ANS		/BY CAR. RET OR ALT MODE
	JMP	F.1		/REPEAT IF BAD SYNTAX
	JMP	F.2		/IGNORE IF DEFAULT; (SAME)
	JMP	ALTBAD		/$ ILLEGAL
	JMP	SYMBAD		/SYMBOL ILLEGAL
	SPA!SNA			/# MUST BE POSITIVE AND NOT =0
	SKP
	JMP	F.1A		/POSITIVE #
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T POSITIVE, NONZERO #<@"
F.1A	AAC	-100		/IS IT TOO LARGE? (BR-049)
	SPA
	JMP	F.1B		/NO
	JMS	RERR		/YES; ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T << 100<@"
F.1B	LAC	ONPDAT		/DECIDE WHETHER NEW NUMBER IS GREATER
	TCA			/THAN OLD NUMBER BECAUSE TWO DIFFERENT
	TAD	NUMBER		/ALGORITHMS ARE NEEDED
	SNA			/CATCH THE CASE WHEN SAME
	JMP	F.2		/IN WHICH CASE DO NOTHING
	SMA			/LARGER?
	JMP	F.1G		/YES
	.EJECT
/
/	.DAT SLOTS ILLIMINATED FROM SYSTEM
/
	TAD	SGNUFD		/FEWER; COMPUTE NEW SGNUFD
	DAC	P3		/SAVE
	TAD	NUMBER		/COMPUTE BEGINNING OF SKIP TABLE
	AAC	16		/INCLUDING .UFD ENTRIES FOR NEGATIVE (BR-049)
				/AND 0 SLOTS
	DAC	P4		/SAVE
	LAC	SGNUFD		/MOVE REST OF TABLE UP
	DAC	P2
	LAC	P3		/PUT IN NEW BEGINNING OF UFD TABLE
	DAC	SGNUFD
F.1L1	LAC	P3		/FINISHED?
	SAD	P4
	JMP	F.1C		/YES
	LAC*	P2		/MOVE ENTRY UP
	DAC*	P3
	ISZ	P3		/UPDATE TO NEW ENTRY
	ISZ	P2		/OVERLAYING OLD DELETED .DAT SLOTS
	JMP	F.1L1		/ITERATE
F.1C	LAC	SGNSKP		/IGNORE DELETED .UFD SLOTS
	DAC	P2
	LAC	P3		/UPDATE BEGINNING OF SKIP TABLE
	DAC	SGNSKP
	TAD	NOSKP		/UPDATE BEGINNING OF DEVICE TABLE
	DAC	DEVSBK
F.1L2	LAC	P2		/MOVE UP REST OF SGNBLK
	SAD	ENDSBK		/END OF TABLE REACHED?
	JMP	F.1D		/YES
	LAC*	P2		/MOVE ENTRY
	DAC*	P3
	ISZ	P3		/BUMP TO NEXT ENTRY
	ISZ	P2
	JMP	F.1L2		/ITERATE
F.1D	LAC	P3		/UPDATE NEW END OF DEVICE TABLE
	DAC	ENDSBK
	JMP	F.2		/GO TO NEXT PART
	.EJECT
/
/	.DAT SLOTS ADDED TO SYSTEM
/
F.1G	DAC	ANSTMP		/SAVE
	RCL			/MULTIPLY BY 2
	DAC	ANSTMP+1	/SAVE
	TAD	ENDSBK		/COMPUTE NEW END OF DEVICE TABLE
	DAC	P4		/SAVE
F.1L3	LAC	ENDSBK		/LAST ENTRY MOVED?
	SAD	SGNSKP
	JMP	F.1H		/YES
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	ENDSBK		/NEXT ENTRY IN SKIP OR DEVICE TABLE
	TAD	ANSTMP+1	/BUMP TO NEW LOCATION
	DAC	P3
	LAC*	ENDSBK		/MOVE ENTRY
	DAC*	P3
	JMP	F.1L3		/ITERATE
F.1H	TAD	ANSTMP		/COMPUTE NEW BEGINNING OF SKIP TABLE
	DAC	P3		/START OF NEW PART OF .UFD SLOTS
	TAD	ANSTMP
	DAC	P5		/NEW BEGINNING OF SKIP TABLE
F.1L4	LAC	ENDSBK		/MOVE .UFD TABLE DOWN
	SAD	SGNUFD		/FINISHED?
	JMP	F.1I		/YES
	AAC	-1		/UPDATE TO NEXT ENTRY (BR-049)
	DAC	ENDSBK	
	TAD	ANSTMP
	DAC	DEVSBK
	LAC*	ENDSBK		/MOVE .UFD ENTRY DOWN
	DAC*	DEVSBK
	JMP	F.1L4		/ITERATE
F.1I	TAD	ANSTMP		/UPDATE NEW START OF .UFD TABLE
	DAC	SGNUFD
F.1L5	LAC	ENDSBK		/CHECK FOR LAST ADDED SLOT
	SAD	SGNUFD		/THIS IS NOT LAST+1
	JMP	F.1L6		/THIS IS LAST +1; END OF LOOP
	DZM*	ENDSBK		/ASSIGN 'NONE' TO ADDED SLOT
	ISZ	ENDSBK		/BUMP TO NEXT SLOT
	JMP	F.1L5		/ITERATE UNTIL DONE
F.1L6	LAC	P3		/IS THIS THE LAST ADDED .UFD ENTRY
	SAD	P5		/NO
	JMP	F.1I2		/YES; TERMINATE PROCESS
	LAC	LUIC		/(.SIXBT 'UIC'
	DAC*	P3		/SET UP .UFD ENTRY
	ISZ	P3		/BUMP TO NEXT SLOT
	JMP	F.1L6		/ITERATE
F.1I2	DAC	SGNSKP		/NEW BEGINNING OF SKIP TABLE
	TAD	NOSKP		/AND DEVICE TABLE START
	DAC	DEVSBK		/AND
	LAC	P4
	DAC	ENDSBK		/END
	.EJECT
/
/	DISPLAY .DAT SLOTS? (Y)
/
F.2	JMS	QUERY		/ASK QUESTION
	.SIXBT	'DISPLAY .DAT SLOTS<@'
	LAC	(1
	JMS	YW1		/DEFAULT YES
	LAC	(1
	JMP	F.2		/BAD SYNTAX
	JMP	F.3		/NO DOES NOTHING
	LAW	-15		/YES; START WITH .DAT -15
	DAC	NUMBER
	LAC	SGNDAT		/POINTER TO CORRESPONDING .DAT SLOT
	DAC	P2		/CONTENTS IN SGNBLK
	LAC	SGNUFD		/CORRESPONDING .UFD SLOT
	DAC	P3
	JMS	OUT		/PRINT HEADING
	.SIXBT	'_>.DAT>DEVICE>UIC_<@'
F.2L	JMS	OUT		/TAB
	.SIXBT	'><@'
	LAC	NUMBER		/PRINT .DAT SLOT NUMBER
	JMS	SOCT		/AS A SIGNED OCTAL NUMBER
	LAC	NUMBER		/CHECK IF IT IS SPECIAL CASE
	SAD	(-7		/.DAT -7
	JMP	F.2M7		/YES
	SAD	(-3
	JMP	F.2M3		/.DAT-3
	SAD	(-2		/.DAT-2?
	JMP	F.2M3
	LAC*	P2		/PRINT DEVICE HANDLER
	SNA			/SPECIAL CODE FOR NONE
	JMP	F.2M4
	AND	(77777
	JMS	FIONM		/GET NAME FROM NUMBER IN AC
	JMP	BADDEV		/MISSING INDICATES BAD DISK
	DAC	F.2OUT		/STORE TEMPORARILY
	LAC*	P2
	RTR			/COMPUTE UNIT #
	RAR			/GET INTO PLACE
	AND	(070000		/CLEAN
	SNA			/SPECIAL CODE FOR UNIT 0
	JMP	F.2M5
	XOR	L0R		/COMBINE WITH REST OF MESSAGE
F.2C	DAC	F.2OUT+1
	LAC*	P3		/PUT IN UIC
	DAC	F.2OUT+2
	JMS	OUT
	.SIXBT	'>'		/TAB
F.2OUT	.SIXBT	'@@@@@@@@@_<@'
F.2B	ISZ	P2		/BUMP TO NEW SLOT
	ISZ	P3
	ISZ	NUMBER
	SKP			/NOT .DAT 0
	JMP	F.2B		/IGNORE .DAT 0
	LAC	P2		/END
	SAD	SGNUFD
	JMP	F.3		/YES
	JMP	F.2L		/NO; ITERATE
F.2M7	LAC	LDKL		/(.SIXBT 'DKL'
F.2M2	DAC	F.2OUT		/STICK INTO MESSAGE
F.2M5	LAC	LR		/(.SIXBT '>'
	JMP	F.2C
F.2M3	LAC	LTTA		/(.SIXBT 'TTA'
	JMP	F.2M2
F.2M4	LAC	LNONE		/PRINT 'NONE' FOR NONE
	DAC	F.2OUT
	LAC	LET		/(.SIXBT 'E>'
	JMP	F.2C
LET	.SIXBT	'E>'
LR	.SIXBT	'>'
	.EJECT
/
/	F.3	ALTER .DAT SLOTS:
/
F.3	JMS	QUERY		/MAKE STATEMENT
	.SIXBT	'NEW ASSIGNMENTS:_<@'
F.3A	CLC			/MORE ON LINE MAYBE
	JMS	MULANS		/MULTILINE ANSWER HANDLER
	JMP	EXAM		/BAD SYNTAX YIELDS EXAMPLE
	JMP	F.4		/DEFAULT GOES ON
	JMP	ALTBAD		/$ UNDEFINED
	SKP			/SYMBOL ONLY LEGAL ANSWER
	JMP	F.3A1		/# BAD
	LAC	ANSWER		/CHECK FOR COMMAND .SIXBT 'A'
	SAD	(10000
	JMP	F.3B		/YES; GOOD SO FAR
F.3A1	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	/ISN'T 'A'<@/
F.3B	JMS	DELIM		/DELIMITER MUST BE SPACE
	40
	JMP	F.3C		/GOOD
	JMP	OPBAD		/BAD OPERATOR
F.3W	JMS	DELIM		/<?
	74
	JMP	F.3D		/YES
	JMP	OPBAD		/BAD OPERATOR
F.3C	LAC	(NOP		/INITIALIZE SKP ON DEVICE
	DAC	SKPDEV		/SPECIFIED FLAGS AND
	DAC	SKPUIC		/SKIP ON UIC SPECIFIED FLAG
	CLC			/COULD BE MORE ON LINE STILL
	JMS	MORANS		/FETCH CONTINUATION
	JMP	EXAM
	JMP	EXAM		/NO DEFAULT
	JMP	EXAM		/$ ILLEGAL
	JMP	F.3F		/SYMBOL LEGAL
	JMP	ANBAD		/NUMBER IS BAD ANSWER
F.3F	SAD	(2		/NUMBER OF CHARACTERS DETERMINES
	JMP	F.3G		/THE EXACT NATURE OF THE CHECKS MADE
	SAD	(3		/3 CHARACTERS?
	JMP	F.3I		/YES
	SAD	(4		/4 CHARACTERS?
	JMP	F.3N		/YES
F.3Z	SZA			/0 CHARACTERS?
	JMP	ANBAD		/EVERYTHING ELSE IS BAD
	JMS	DELIM		/MUST BE <
	74
	JMP	F.3D		/GOOD
	JMP	OPBAD
ANBAD	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS BAD<@'
F.3G	LAC	ANSWER
	IAC			/A HANDLER IMPLIED (BR-049)
F.3K	DZM	ANSTMP+1	/0 UNIT IMPLIED
F.3M	JMS	FHAN		/FIND HANDLER #
	SKP
	JMP	F.3S		/THERE
F.3NIS	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T IN SYSTEM<@"
F.3S	LAC	HANNO		/MERGE HANDLER AND UNIT #
	SZA			/OMIT UNIT ON NONE
	XOR	ANSTMP+1
	DAC	ANSTMP		/SAVE IT
	LAC	(SKP		/SET SKIP ON DEVICE SPECIFIED
	DAC	SKPDEV
F.3U	JMS	DELIM		/CHECK FOR SPACE
	40
	JMP	F.3V		/YES
	JMP	F.3W
F.3I	LAC	ANSWER		/UNIT #
	AND	(60		/WILL BE 60 WHEN MASKED IF OCTAL DIGIT
	SAD	(60
	JMP	F.3L		/YES; OCTAL DIGIT
	LAC	ANSWER		/UNIT ASSUMED 0
	JMP	F.3K
F.3L	LAC	ANSWER		/HANDLER ASSUMED A VERSION
	AND	(777700
	IAC			/MAKE A VERSION (BR-049)
F.3P	DAC	ANSTMP		/STORE AWAY
	LAC	ANSWER		/FETCH UNIT # AND PUT INTO RIGHT BITS
	RTR
	RTR
	AND	(700000		/CLEAN
	DAC	ANSTMP+1	/STORE AWAY
	LAC	ANSTMP		/GET HANDLER INTO AC
	JMP	F.3M
F.3N	LAC	ANSWER		/CHECK ANSWER FOR NONE
	SAD	LNONE		/CHECK?
	JMP	F.3K		/YES
	LAC	ANSWER+1	/ONLY OTHER POSSIBILITY
	AND	(600000		/IS UNIT NUMBER FOR 4TH CHARACTER
	SAD	(600000		/OCTAL DIGIT?
	JMP	F.3T		/YES
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"DOESN'T HAVE OCTAL UNIT #<@"
F.3T	LAC	ANSWER+1	/PUT UNIT # IN PLACE
	RTL
	RAL
	AND	(700000		/CLEAN
	DAC	ANSTMP+1	/STORE
	LAC	ANSWER
	JMP	F.3M
F.3D	CLC			/MORE ON LINE
	JMS	MORANS		/FETCH UIC
	JMP	EXAM		/BAD SYNTAX GETS EXAMPLE
	JMP	EXAM		/NO DEFAULT
	JMP	EXAM		/$ UNDEFINED
	NOP			/SYMBOL
	LAC	CNTCHR		/#
	SAD	(3		/MUST BE 3 CHARACTERS EXACTLY
	JMP	F.3X
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T 3 CHAR UIC<@"
F.3X	LAC	ANSWER		/PUT UIC AWAY
	SAD	(-1		/.SIXBT '???' ; -1 IS ILLEGAL UIC
	SKP			/BECAUSE HANDLER USES IT AS FLAG
	JMP	F.3X1		/NOT -1
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T LEGAL UIC<@"
F.3X1	DAC	ANSTMP+1
	LAC	(SKP		/SET SKIP IF UIC SPECIFIED FLAG
	DAC	SKPUIC
	JMS	DELIM		/IS DELIMITER >
	76
	JMP	F.3Y		/YES
	JMP	OPBAD
F.3V	CLC			/MAY BE MORE ON LINE
	JMS	MORANS		/FETCH SOME MORE 
	JMP	EXAM
	JMP	EXAM
	JMP	EXAM
	JMP	F.3Z		/SYMBOL
F.3AF	AAC	15		/#; ADD MAXIMUM NEGATIVE (BR-049)
	DAC	P3
	SMA			/MUST BE POSITIVE OR ILLEGAL .DAT SLOT
	JMP	F.3AA
BSN	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS BAD SLOT #<@'
F.3AA	TAD	SGNDAT		/COMPUTE TRANSFER VECTOR TO SGNBLK WORD
	DAC	P2
	LAC	SGNUFD		/COMPUTE TRANSFER VECTOR TO UFD WORD
	TAD	P3
	DAC	P3
	TCA			/COMPUTE WHETHER TOO LARGE
	TAD	SGNSKP
	SPA!SNA
	JMP	BSN		/ILLEGAL .DAT SLOT
SKPDEV	NOP			/SKIP IF DEVICE SPECIFIED
	JMP	SKPUIC		/DEVICE NOT SPECIFIED
	LAC*	P2		/IS SLOT MODIFIABLE
	SAD	(100000
	SKP			/NO
	JMP	F.3AC		/YES
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T MODIFIABLE SLOT<@"
F.3AC	LAC	ANSTMP		/PUT INTO .DAT SLOT
	DAC*	P2
SKPUIC	NOP			/SKIP IF UIC SPECIFIED
	JMP	F.3AB		/NOT SPECIFIED
	LAC	ANSTMP+1	/PUT INTO .UFD SLOT
	DAC*	P3
F.3AB	JMS	DELIM		/CHECK DELIMITER
	0			/CARRIAGE RETURN
	JMP	F.3A		/GO BACK TO BEGINNING
	JMS	DELIM
	54			/, COMMA READ ANOTHER SLOT
	JMP	F.3Y
	JMS	DELIM
	57			/ '/' READ ANOTHER DEVICE OR UIC
	JMP	F.3C
	JMP	OPBAD		/BAD OPERATOR
F.3Y	CLC			/MORE ON LINE
	JMS	MORANS		/FETCH ANOTHER SYLLABLE
	JMP	EXAM
	JMP	EXAM
	JMP	EXAM
	JMP	SYMBAD
	JMP	F.3AF		/# IS ONLY LEGAL SYNTAX HERE
EXAM	JMS	OUT		/TYPE EXAMPLE
	.SIXBT	'_>@>EX:_>@>@>>A DK<<UIC>> 7,10/TTA 4<@'
	JMP	MULBAD
F.4	JMS	POTSGK		/PUT OUT SGNBLK
	LAC	DELPT1		/CLEAR TABLE OF CHANGED SYS FILES
	DAC	CGEND
	.TITLE	G. CHANGE SYS FILES
/
/
/
G.0	JMS	SECTN		/ANNOUNCE NEW SECTION AND SET ^P
	.SIXBT	'G. CHANGE SYS FILES<@'
	JMS	RESTOR		/RESTORE PREVIOUS STATE OF BITMAPS
	LAC	(1		/ON A ^P
	JMS	YW0		/DEFAULT NO
	LAC	(1
	JMP	G.0		/REPEAT ON SYNTAX ERROR
	JMP	H.0		/GO TO NEXT SECTION ON NO
	JMS	BINSBK		/YES; BRING IN SYSBLK
/
/	NUMBER OF BLOCKS IN ^Q AREA
/
G.1	LAC	QBLK+1		/# OF BLOCKS IN OLD ^Q AREA
	DAC	P6
	SZA!CLL			/TEST IF THERE IS A ^Q AREA
	JMP	G.1B		/^Q AREA PRESENT
	LAC	LNONE		/(.SIXBT 'NONE'
	DAC	G.1D
	LAC	LNONE+1
	DAC	G.1D+1
	JMP	G.1A
G.1B	RTR			/DIVIDE BY 16
	RTR
	AAC	-4		/IS ^Q AREA IN LEGAL RANGE (BR-049)
	SPA
	JMP	BADDEV		/NO; MUST BE BAD DEVICE
	AAC	-41		/SUBTRACT 5 (BR-049)
	SMA
	JMP	BADDEV		/NO; MUST BE BAD DEVICE
	LAC	QBLK+1		/GET # OF BLOCKS IN OLD Q AREA (BR-054)
	CLL			/SET UP SHIFT (BR-054)
	ALS	10		/CONVERT # BLOCKS INTO # OF WORDS (BR-054)
	JMS	MAKEK		/MAKE DECIMAL SIXBT (BR-054)
	DAC	G.1D		/STORE IN QUESTION (BR-054)
	LAC	LKSPC		/GET 'K] ' AND STORE IN QUESTION (BR-054)
	DAC	G.1D+1		/IN CASE OF RESTART (^P) (BR-054)
G.1A	JMS	QUERY		/ASK QUESTION
	.SIXBT	'^Q AREA SIZE(NONE,NNNK)['	/(BR-054)
G.1D	.SIXBT	'@@@K] <@'	/TO BE FILLED IN ABOVE (BR-054)
G.1C	CLA			/ALONE ON LINE
	JMS	ANS		/ANSWER TERMINATED BY CAR. RET. OR 
				/ALT MODE
	JMP	G.1A		/BAD SYNTAX REPEAT
	JMP	G.2		/DEFAULT MEANS LEAVE SAME
	JMP	ALTBAD		/$ UNDEFINED
	SKP			/SYMBOL 'NNNK' ONLY GOOD NEW REPLY (BR-054)
	JMP	KBAD		/OCTAL # NO GOOD (BR-054)
	LAC	ANSWER		/GET FIRST 3 CHAR (BR-054)
	SAD	LNONE		/IS IT 'NON' (BR-054)
	SKP			/SKIP IF 'NON' - POSSIBLE 'NONE' (BR-054)
	JMP	G.1E		/NOT 'NON'-TRY NNNK (BR-054)
	LAC	ANSWER+1	/TEST FOR 'E  ' (BR-054)
	SAD	LNONE1		/SKIP IF NOT 'E  ' (BR-054)
	SKP!CLA			/SKIP AND CLEAR AC IF 'NONE' (BR-054)
G.1E	JMS	KTOOCT		/CONVERT ANSWER,ANSWER+1 TO OCTAL K (BR-054)
	SZA			/SKIP IF NO QAREA (BR-054)
	JMP	G.1I		/NON-ZERO=QAREA (BR-054)
	DZM	QBLK+1		/ZERO BLOCKS IN QAREA (BR-054)
	DZM	QSZE		/ZERO MEMORY TO BE DUMPED (BR-054)
	JMP	G.1F		/DEALLOCATE IF NEEDED (BR-054)
G.1I	CLL			/SET UP MULTIPLY (BR-054)
	RTL			/CONVERT K TO BLOCKS (BR-054)
	SAD	QBLK+1		/SAME AS OLD ENTRY? (BR-054)
	JMP	G.2		/YES - DO NOTHING (BR-054)
	DAC	QBLK+1		/NO - UPDATE NR OF BLOCKS (BR-054)
	CLL			/SET UP SHIFT (BR-054)
	ALS	10		/MAKE INTO WORD COUNT (BR-054)
	AAC	-5		/WORDS 0-4 NOT DUMPED (BR-054)
	DAC	QSZE		/SAVE IN WORD COUNT (BR-054)
G.1F	LAC	P6		/DEALLOCATE OLD ^Q AREA
	SZA			/UNLESS IT IS NONEXISTENT
	JMS	DEALOC
	LAC	QBLK
	LAC	QBLK+1		/ALLOCATE NEW ^Q AREA
	SNA			/ONLY IF THERE IS ONE
	JMP	G.1H
	JMS	ALLOC
	JMP	DSKFUL		/ERROR; DISK FULL
G.1H	DAC	QBLK		/STORE INTO ^Q AREA FIRST BLOCK
	JMP	G.2		/PROCEEED ON
DSKFUL	JMS	OUT
DSKFL2	.SIXBT	'>@>(NO DISK SPACE)<@'
	JMP*	CNTLP		/GO TO ^P ADDRESS
	.EJECT
/
/	TO BE KEPT:
/
G.2	JMS	QUERY		/MAKE STATEMENT
	.SIXBT	'TO BE KEPT:_<@'
	LAC	COMBK1		/BEGIN AT TOP OF COMBLK AND WORK DOWN
	SKP			/JMP INTO MIDDLE OF LOOP
G.2A	LAC	P3		/GO TO ANOTHER ENTRY
	DAC	P2
	SAD	(ENDCOM		/FINISHED WITH COMBLK
	JMP	G.END		/YES
	DAC*	(17
	TAD*	P2		/SET UP FOR NEXT ENTRY NOW
	DAC	P3		/SAVE
	LAC*	P2		/SAVE # OF WORDS IN ENTRY
	DAC	G.2TP
	LAC*	17		/PUT NAME OF ENTRY IN DISPLAY WORDS
	DAC	G.2DP
	LAC*	17
	DAC	G.2DP+1
G.2B	JMS	QUERY		/MAKE QUESTION
G.2DP	.SIXBT	'@@@@@@<@'
	JMS	ALTMOD		/DEFAULT $
	JMP	G.2B		/BAD SYNTAX
	JMP	G.2A		/$ MEANS KEEP ALL SAME
	JMP	G.2D		/NO; DELETE EVERYTHING
G.2G	LAC*	17		/YES; GET NEXT OVERLAY
	DAC	G.2DS		/PUT INTO DISPLAY
	AND	(770000		/IS IT OVERLAY NAME OR DEFAULT BUFFS
	SNA
	JMP	G.3		/DEFAULT BUFFS COMMAND TERMINATES
				/OVERLAY NAEMS
	LAC*	17		/PICK UP SECOND HALF OF NAME
	DAC	G.2DS+1
G.2F	JMS	QUERY		/ASK QUESTION ABOUT OVERLAY
G.2DS	.SIXBT	'@@@@@@<@'
	LAC	(1
	JMS	YW1		/DEFAULT YES
	LAC	(1
	JMP	G.2F		/REPEAT ON SYNTAX ERROR
	SKP			/NO
	JMP	G.2G		/YES; MOVE TO NEXT OVERLAY
	LAC*	(17		/MOVE PRECEEDING PART OF COMBLK DOWN
G.2H	DAC	P4
	AAC	-2		/2 WORDS DOWN (BR-049)
	DAC	P5
	IAC			/ADD 1 (BR-0499
	SAD	COMBK1		/FINISHED
	JMP	G.2I		/YES
	LAC*	P5		/MOVE WORD
	DAC*	P4		/DOWN
	LAW	-1
	TAD	P4		/MOVE TO PREVIOUS ENTRY
	JMP	G.2H		/ITERATE
G.2I	AAC	2		/NEW BEGINNING OF COMBLK (BR-049)
	DAC	COMBK1
	ISZ	P2
	ISZ	P2
	LAW	-2
	TAD*	P2
	DAC*	P2		/MODIFY # OF WORDS IN CURRENT COMBLK ENTRY
	JMS	DELSYS		/DELETE UNNEEDED SYS FILES FROM SYSTEM
	JMP	G.2G		/ITERATE
	.EJECT
/
/	DELETE PROGRAM FROM COMBLK
/
G.2D	LAC	P2		/MOVE ALL PREVIOUS ENTRIES DOWN
	SAD	COMBK1		/FINISHED MOVE
	JMP	G.2ER		/CAN'T REMOVE XVM/DOS
G.2C	SAD	COMBK1		/REAL LOOP TERMINATION TEST
	JMP	G.2J		/YES; FINISHED MOVE
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P5
	TAD	G.2TP		/# OF WORDS IN ENTRY
	DAC	P4
	LAC*	P5
	DAC*	P4		/MOVE NEXT WORD
	LAC	P5		/ITERATE
	JMP	G.2C
G.2J	LAC	P4		/UPDATE BEGINNING OF COMBLK
	DAC	COMBK1
	JMS	DELSYS		/DELETE UNEEDED SYS FILES
	JMP	G.2A		/ITERATE
G.2ER	JMS	OUT		/CAN'T DELETE XVM/DOS
	.SIXBT	"_>@>(DOS15 CAN'T BE DELETED)<@"
	JMP*	BADSYN
G.2TP	0			/# OF WORDS IN CURRENT COMBLK ENTRY
	.EJECT
/
/	OVERLAY NAME
/
G.3	JMS	QUERY		/ASK QUESTION
	.SIXBT	'OVERLAY NAME[] <@'
	CLA			/ONE SYLABLE ENDING IN CAR. RET OR 
	JMS	ANS		/ALTMODE
	JMP	G.3		/BAD SYNTAX
	JMP	G.4		/DEFAULT MEANS GO ON
	JMP	ALTBAD		/$ UNDEFINED
	SNA			/SYMBOL
	JMP	NUMBAD		/# BAD
	JMS	MATCH		/MUST BE UNIQUE
	JMS	SAVANS		/SAVE ANSWER TEMPORARILY
	LAC	(ANSWER		/SEE IF ALREADY IN SYSBLK
	JMS	FSYSK
	SKP			/NOT IN SYSBLK YET
	JMP	G.3A		/ALREADY IN SYSBLK
	LAC	ENDSYS		/PUT IN NEW ENTRY INTO SYSBLK
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(15
	AAC	10		/ADD 10 (BR-049)
	DAC	ENDSYS		/NEW END OF SYSBLK
	JMS	SYSOVF		/IS THIS TOO MUCH TO ADD
	LAC	ANSTMP		/PUT IN NEW NAME
	DAC*	15
	LAC	ANSTMP+1
	DAC*	15
	.EJECT
/
/	NUMBER OF BLOCKS
/
G.3B	JMS	QUERY		/ASK QUESTION
	.SIXBT	'# OF BLOCKS[] <@'
	CLA			/SINGLE SYLABLE ENDING IN CAR. RET.
	JMS	ANS		/OR ALT MODE
	JMP	G.3B		/REPEAT IF SYNTAX ERROR
	JMP	CRBAD		/NO DEFAULT ANSWER
	JMP	ALTBAD		/$ UNDEFINED
	JMP	SYMBAD		/SYMBOL ILLEGAL
	SPA!SNA			/# MUST BE POSITIVE AND NONZERO
	JMP	ANBAD
	JMS	ALLOC		/ALLOCATE DISK SPACE
	SKP			/NO ROOM
	JMP	G.3C		/ROOM AVAILABLE
G.3BS	JMS	OUTP		/NO DISK SPACE
	LAC	(DSKFL2
	JMP*	BADSYN		/BAD SYNTAX
G.3C	DAC*	15		/FB
	LAC	NUMBER		/NB
	DAC*	15
	.EJECT
/
/	PUT INTO COMBLK BY MOVEING TOP UP
/
G.3A	LAC	COMBK1		/INITIALIZE LOOP
	AAC	-2		/SUBTRACT 2 (BR-049)
	DAC	COMBK1		/UPDATE BEGINNING OF COMBLK
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(14
	AAC	2		/ADD 2 (BR-049)
	DAC*	(13
	JMS	SYSOVF		/CHECK FOR OVERFLOW OF COMBLK
G.3E	LAC*	(13		/FINISHED?
	IAC			/ADD 1 (BR-049)
	SAD*	(17
	JMP	G.3D		/YES
	LAC*	13
	DAC*	14		/MOVE WORD
	JMP	G.3E
G.3D	LAC	ANSTMP		/PUT NAME IN COMBLK
	DAC*	14
	LAC	ANSTMP+1
	DAC*	14
	LAW	-2		/BEGINNING OF ENTRY HAS CHANGED
	TAD	P2
	DAC	P2
	LAC*	P2		/ADD 2 TO ENTRY SIZE
	AAC	2		/ADD 2 (BR-049)
	DAC*	P2
	JMP	G.3		/ASK FOR MORE
	.EJECT
/
/	BUFFS[XX]
/
G.4	JMS	QUERY		/ASK QUESTION
	.SIXBT	'BUFFS[<@'
	LAC	G.2DS		/OLD # BY DEFAULT
	JMS	NUMSUP		/PRINT DEFAULT
	JMS	OUT		/FINISH QUESTION
	.SIXBT	'] <@'
	CLA			/SINGLE SYLABLE ANSWER ENDING IN 
	JMS	ANS		/CAR. RET. OR ALT MODE
	JMP	G.4		/BAD SYNTAX
	JMP	G.5		/DEFAULT MEANS CONTINUE
	JMP	ALTBAD		/$ UNDEFINED
	JMP	SYMBAD		/SYNBOL MEANINGLESS
	AND	(770000		/# MUST NOT BE TOO LARGE
	SZA
	JMP	NUMBIG		/TOO BIG
	LAC*	(17		/COMPUTE POSITION TO PUT BUFFS #
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(14
	LAC	NUMBER
	DAC*	14		/PUT IN NEW BUFFS COMMAND #
	.EJECT
/
/	.DAT SLOTS FOR CUSP
/
G.5	LAC*	(17		/FETCH NEXT .DAT SLOT
	IAC			/COMPENSATE FOR AUTOINCREMENT (BR-049)
	SAD	P3		/EXHAUSTED?
	JMP	G.6		/YES; ACCEPT NEW SLOTS
	LAC*	17		/GET NEXT .DAT SLOT
	DAC	P7		/SAVE
	SAD	(-1		/ALL?
	JMP	G.5E		/YES
	AND	(400
	SZA
	777000
	XOR	P7
	DAC	P7
	JMS	LEGAL		/LEGAL .DAT SLOT?
	JMP	G.5B		/NO; DELETE SLOT AUTOMATICALLY
G.5A	JMS	QUERY		/ASK QUESTION
	.SIXBT	'.DAT SLOT <@'
	LAC	P7		/PRINT SLOT IN OCTAL WITH 0 SUPRESSION
	JMS	SOCT		/WITH - SIGN IF NEGATIVE
	LAC	(1
	JMS	YW1		/DEFAULT YES
	LAC	(1
	JMP	G.5A		/BAD SYNTAX
	JMP	G.5B		/NO
	JMP	G.5		/YES; FETCH NEXT SLOT
G.5B	LAC*	(17		/DELETE SLOT BE MOVING TABLE DOWN
G.5C	DAC	P4
	SAD	COMBK1		/END?
	JMP	G.5D		/YES
	AAC	-1		/COMPUTE POINTERS TO NEXT WORD (BR-049)
	DAC	P5
	LAC*	P5		/MOVE WORD
	DAC*	P4
	LAW	-1
	TAD	P4
	JMP	G.5C		/ITERATE
G.5D	ISZ	COMBK1		/ONE LESS WORD IN COMBLK
	ISZ	P2		/AND ENTRY
	LAW	-1
	TAD*	P2
	DAC*	P2
	JMP	G.5		/ITERATE
G.5E	JMS	QUERY		/SPECIAL QUERY FOR ALL POSITIVE
	.SIXBT	'ALL + .DAT SLOTS<@'
	JMS	YES		/DEFAULT YES
	JMP	G.5E		/SYNTAX ERROR
	JMP	ALTBAD		/$ UNDEFINED
	JMP	G.5B		/NO
	JMP	G.5		/YES
/
/	.DAT SLOTS:
/
G.6	JMS	QUERY		/ASK QUESTION
	.SIXBT	'.DAT SLOTS:_<@'
G.6F	CLC			/.DAT SLOT NUMBERS SEPERATED BY COMMA,
	JMS	MULANS		/CAR. RET. OR ALT MODE
	JMP	MULBAD		/MULTILINE ERROR RECOVERY
	JMP	G.2A		/DEFAULT MEANS GO ON
	JMP	ALTBAD		/$ UNDEFINED
	JMP	G.6A		/SYMBOL
G.6F2	JMS	LEGAL		/# MUST BE LEGAL .DAT SLOT
	JMP	G.6B		/NOT LEGAL SLOT
	LAC	NUMBER		/CLIP OF TOP HALF
	AND	(777
	DAC	NUMBER
	JMP	G.6C		/LEGAL SLOT
G.6B	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T LEGAL<@"
G.6F1	CLC			/FETCH NEXT SLOT ON LINE
	JMS	MORANS
	JMP	MULBAD		/BAD SYNTAX
	JMP	MULBAD
	JMP	MULBAD
	JMP	G.6A		/SYMBOL
	JMP	G.6F2		/#
	.EJECT
G.6C	JMS	DELIM		/CHECK DELIMITERS 
	0			/CARRIAGE RETURN OR ALTMODE
	JMP	G.6C1
	JMS	DELIM
	54			/COMMA
	JMP	G.6C1
	JMP	OPBAD		/ILLEGAL DELIMITER
G.6C1	LAC	COMBK1		/PUT INTO COMBLK
	AAC	-1		/BY MOVING FIRST PART UP 1 (BR-049)
	DAC	COMBK1		/UPDATE FIRST WORD POINTER
	DAC*	(13
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(14
	JMS	SYSOVF		/ERROR IF NO ROOM LEFT IN COMBLK
G.6D	LAC*	(13		/DONE?
	SAD*	(17
	JMP	G.6E		/YES
	LAC*	13		/MOVE WORD UP
	DAC*	14
	JMP	G.6D		/ITERATE
G.6E	LAC	NUMBER		/PUT IN .DAT SLOT
	DAC*	14		/STORE IN COMBLK
	LAW	-1		/INCREMENT # OF WORDS IN CURRENT ENTRY
	TAD	P2
	DAC	P2
	ISZ*	P2
	JMS	DELIM
	0			/CARRIAGE RETURN OR ALT MODE
	JMP	G.6F		/ITERATE AND READ IN ANOTHER LINE
	JMP	G.6F1		/CONTINUE READING ON SAME LINE
G.6A	SAD	(3		/CHECK FOR ALL +
	SKP
	JMP	SYMBAD		/NOT 3 CHARACTERS
	LAC	ANSWER
	SAD	LALL		/(.SIXBT 'ALL'
	SKP!CLC			/YES
	JMP	SYMBAD
	DAC	NUMBER
	JMP	G.6C
G.END	JMS	POTSBK		/SAVE SYSBLK
	.TITLE	H. ADD SYSTEM PROGRAMS
/
/
/
H.0	JMS	SECTN		/ANNOUNCE SECTION QUESTION AND SET ^P
	.SIXBT	'H. ADD SYS PROG<@'
	JMS	RESTOR		/RESTORE PREVIOUS STATE OF BITMAPS
	LAC	(1		/ON A ^P
	JMS	YW0		/DEFAULT NO
	LAC	(1
	JMP	H.0		/BAD SYNTAX
	JMP	I.0		/NO; CLEAN UP AND EXIT
	JMS	BINSBK		/YES; BRING IN SYSBLK
/
/	PROGRAM NAME
/
H.1	JMS	QUERY		/ASK QUESTION
	.SIXBT	'PROG NAME[] <@'
	CLA			/SINGLE SYLLABLE ENDING IN CAR. RET.
	JMS	ANS		/OR ALT MODE
	JMP	H.1		/BAD SYNTAX
	JMP	CRBAD		/NO DEFAULT
	JMP	ALTBAD		/$ UNDEFINED
	JMP	H.1A		/SYMBOL ONLY LEGAL ANSWER
	JMP	NUMBAD		/# ILLEGAL
H.1A	SNA			/MUST HAVE AT LEAST ONE CHARACTER
	JMP	ANBAD
	JMS	MATCH		/TEST TO MAKE SURE NO CONFLICTS
	JMS	SAVANS		/WITH OTHER NAMES IN SYSTEM
	LAC	(ANSWER		/SEE IF IN COMBLK
	JMS	FCOMK
	JMP	H.1B		/NOT IN COMBLK
	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS USED NAME<@'
	.EJECT
H.1B	LAC	(ANSWER		/IN SYSBLK?
	JMS	FSYSK
	JMP	H.1C		/NO
	JMP	H.1D		/YES
H.1C	LAC	ENDSYS		/PUT IN NEW SYSBLK ENTRY
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(15
	AAC	10		/ADD 10 (BR-049)
	DAC	ENDSYS		/NEW END OF SYSBLK
	JMS	SYSOVF		/CHECK FOR SYSBLK OVERFLOW
	LAC	ANSTMP		/PUT IN NAME
	DAC*	15
	LAC	ANSTMP+1
	DAC*	15
	.EJECT
/
/	ASK FOR # OF BLOCKS
/
H.1E	JMS	QUERY		/ASK QUESTION
	.SIXBT	'# OF BLOCKS[] <@'
	CLA			/SINGLE SYLLABLE ENDING IN CAR. RET.
	JMS	ANS		/OR ALT MODE
	JMP	H.1E		/BAD SYNTAX
	JMP	CRBAD		/NO DEFAULT
	JMP	ALTBAD		/$ UNDEFINED
	JMP	SYMBAD		/SYMBOL ILLEGAL
	SPA!SNA			/# MUST BE POSITIVE AND NONZERO
	JMP	ANBAD
	JMS	ALLOC		/ALLOCATE STORAGE
	JMP	G.3BS		/NO ROOM
	DAC*	15
	LAC	NUMBER		/PUT IN # OF BLOCKS
	DAC*	15
H.1D	LAC	COMBK1		/PUT INTO COMBLK
	AAC	-4		/SUBTRACT 4 (BR-049)
	DAC	COMBK1
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(14
	AAC	4		/ADD 4 (BR-049)
	DAC*	(13
	JMS	SYSOVF		/CHECK FOR OVERFLOW
H.1F	LAC*	(13		/IS THIS LAST ENTRY?
	IAC			/ADD 1 (BR-049)
	SAD	(ENDCOM
	JMP	H.1G		/YES
	LAC*	13		/MOVE COMBLK UP
	DAC*	14		/WORD
	JMP	H.1F		/ITERATE
H.1G	DAC	P3		/FOR SECTION G ROUTINE
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(17
	LAC	(4		/ENTRY SIZE
	DAC*	14
	LAC*	(14
	DAC	P2
	LAC	ANSTMP
	DAC*	14		/PUT IN NAME
	LAC	ANSTMP+1
	DAC*	14
	DZM*	14		/0 DEFAULT BUFFS COMMAND
	DZM	G.2DS		/FOR SECTION G ROUTINE DEFAULT BUFFS
	JMP	G.3		/FETCH OVERLAYS BY RENTERING SECTION G
	.TITLE	CLEANUP AND TERMINATION
/
/
/
I.0	DZM	CNTLP		/IGNORE ^P
	-3&777			/IGNORE ^C
	1
	200000
	0
	JMS	OUT		/ANNOUNCE SECTION IS CLEANUP AND
				/THAT CONTROL CHARACTERS ARE ILLEGAL
	.SIXBT	'_>@>MODIFYING SYSTEM(^P,^C IGNORED)_<@'
I.1	LAC	SATABP		/NEW SAT INTO PLACE
	DAC	BPTR
	LAC	NOSATB		/# OF SAT BLOCKS
	TCA
	DAC	DECT1
	LAC	BTABP
	DAC	P1
	LAC	(NOP
	DAC	I.1A
I.1B	LAC*	P1		/OUTPUT NEXT SAT BLOCK
	JMS	TRANIN
	LAC	(SAT
	LAC*	BPTR
	JMS	TRANOT
	LAC	(SAT
	ISZ	P1		/BUMP TO NEXT SAT BLOCK
	ISZ	BPTR
	ISZ	DECT1		/DONE?
	JMP	I.1B		/NO; ITERATE
I.1A	NOP			/SWITCH GETS SET TO JMP I.1C
	LAC	(JMP	I.1C	/DON'T DO THIS TWICE
	DAC	I.1A
	LAW	-3		/3 SYSTEM BLOCKS
	DAC	DECT1
	LAC	(SYSBL1
	DAC	BPTR
	LAC	(SYSBL2
	DAC	P1
	JMP	I.1B		/JMP INTO REUSED ROUTINE
I.1C	CLC			/SET ONCE ONLY TYPING OF DELETED
	DAC	CSW		/HANDLERS HEADING IF NEEDED
	LAC	ODATE		/POINTER TO BEGINNING OF LIST
	DAC	P2		/OF DELETED HANDLERS
I.10	LAC	P2		/FINISHED?
	SAD	DELPT1
	JMP	I.12		/YES
	LAC*	P2		/PICK UP HANDLER NAME
	ISZ	P2		/INCREMENT TO NEXT NAME
	DAC	I.2DEL		/STICK INTO FILE NAME
	DAC	I.10CK		/AND MESSAGE
	.FSTAT	-14,I.2DEL
	SNA
	JMP	I.10		/DO NOT DELETE IF NOT THERE
	ISZ	CSW		/PRINT HEADING?
	JMP	I.11		/ALREADY HAVE
	JMS	QUERY		/HEADING
	.SIXBT	'DELETED HANDLERS:<@'
I.11	JMS	QUERY		/PRINT HANDLER DELETED
I.10CK	.SIXBT	'@@@.<@'
	.DLETE	-14,I.2DEL
	JMP	I.10		/ITERATE
I.2DEL	.SIXBT	'@@@.@@BIN'
I.12	JMS	OUT		/ANOUNCE SGEN COMPLETE
	.SIXBT	'_>@>SGEN COMPLETE_<@'
	JMP	ENDGEN
	.TITLE	TELETYPE OUTPUT ROUTINE
/
/	ENTRY POINTS OUT AND OUTP
/THE FOLLOWING ILLUSTRATES THE USES OF THIS ROUTINE
/	JMS	OUT
/MESSAG	.SIXBT	'_>HOW ARE YOU<@'
/THIS PRINTS THE TEXT STRING HOW ARE YOU AND STOPS RETURNING 
/CONTROL TO THE POINT AFTER THE MESSAGE.  THE FOLLOWING ROUTINE
/ILLUSTRATES THE USE OF OUTP ENTRY:
/	JMS	OUTP
/	LAC	(MESSAG
/				/RETURN HERE ON COMPLETION
/BOTH THESE ROUTINES PERFORM EXACTLY THE SAME FUNCTION.  THE
/CHARACTERS '_','>', AND '<' WHEN NOT DOUBLED ARE INTERPRETED
/AS CARRIAGE RETURN, TAB (HORIZONTAL), AND END OF MESSAGE.  THE
/END OF MESSAGE CHARACTER MUST BE FOLLOWED BY AN @ SIGN.  IF THEY
/APPEAR DOUBLED THEY WILL BE PRINTED ONCE AND THE SECOND ONE
/IGNORED. QUADRUPLED WILL PRINT TWICE ETC.
/
OUTP	XX
	XCT*	OUTP		/FETCH TRANFER VECTOR TO MESSAGE
	DAC	OUT		/STORE IN OUT FOR MESSAGE PRINTING
	LAC	(JMP*	OUTP		/FETCH EXIT INSTRUCTION
	JMP	OUT1		/JUMP INTO OUT ROUTINE
KLCNT	0
TVCNT	0
LASCR	0			/PREVIOUS CHARACTER WHICH IS WAITING TO BE OUTPUT
KLCNTB	0
OUT	0			/POINTS TO FIRST WORD OF MESSAGE
	LAC	(JMP*	OUT	/FETCH RETURN INSTRUCTION
OUT1	DAC	OUTEX		/STORE AWAY RETURN INSTRUCTION
	DZM	LASCR		/PREVIOUS CHARACTER AT FIRST IS NULL
	LAW	-1		/SET UP FOR BEGINNING
	DAC	KLCNT
	DZM	KLPUT		/.INIT BUFFER
	JMS	OUTLIN
MSNXTC	ISZ	KLCNT		/IS THIS THE FIRST CHARACTER
	JMP	KLFSXT		/NO
	LAC*	OUT		/YES; FETCH NEW WORD
	ISZ	OUT		/BUMP POINTER
	DAC	TVCNT		/STORE
	LAW	-3		/3 CHAR. PER WORD
	DAC	KLCNT
KLFSXT	LAC	TVCNT		/FETCH OUTPUT
	RTL			/6 LEFT
	RTL
	RTL
	DAC	TVCNT		/STORE FOR NEXT CHAR
	RAL			/GET LINK INTO AC 17
	AND	(77		/CLEAN
	DAC	KLCNTB		/SAVE
	AND	(40
	SNA!STL			/IS CHAR. IN NEED OF 100?
	CLL
	LAC	KLCNTB
	SNL!SZA!CLL
	XOR	(100		/YES
	DAC	KLCNTB		/STORE AWAY TEMPORARILY
	SAD	LASCR		/IS THIS THE SAME AS THE LAST CHARACTER?
	STL			/YES; LINK IS 0 FROM ABOVE
	LAC	LASCR		/PRINT LAST CHARACTER
	SNL
	JMP	KLFS1		/NOT ONE OF THE SPECIAL CHARACTERS
	SAD	(137		/CHECK IF SPECIAL CHARACTER
	DZM	KLCNTB		/YES; PRINT ONCE AND STOP
	SAD	(76		/>
	DZM	KLCNTB
	SAD	(74		/<
	DZM	KLCNTB
	JMP	KLFS3		/OMIT CHECKING FOR SPECIAL CHARACTERS
KLFS1	SAD	(137		/_ MEANS CAR. RET. LF
	JMP	MSCRLF
	SAD	(74		/< MEANS END OF MESSAGE
	JMP	MPEND
	SAD	(76		/> MEANS TAB
	LAC	(11
KLFS3	SZA			/@ MEANS IGNORE
	JMS	KLPUT		/PUT IN OUTPUT BUFFER
KLFS2	LAC	KLCNTB		/PUT NEW CHARACTER INTO LAST CHARACTER
	DAC	LASCR
	JMP	MSNXTC		/GET ANOTHER CHARACTER
MSCRLF	JMS	OUTLIN		/OUTPUT LINE
	JMS	CRLF		/GIVE A CAR.RET.LF
	JMP	KLFS2		/START NEW LINE
MPEND	JMS	OUTLIN		/OUTPUT LINE IF NECESSARY
OUTEX	XX			/EXIT INSTRUCTION COMPUTED
	.EJECT
/
/IOPS ASCII PACKING ROUTINE
/
KLPUTP	0
KL57	0
KLCHR2	0
KLLIT	JMP	KLJ57
KLPUT	0
	AND	(177		/CLEAN OFF
	DAC	KLCHR2		/SAVE
	CLL
	LAC	KL57		/GET CHARACTER POSITION
	TAD	KLLIT		/COMPUTE JMP
	DAC	.+2
	LAC	KLCHR2
	XX			/MODIFIED JMP
KLJ57	JMP	KL571		/CHAR1
	JMP	KL572		/CHAR2
	JMP	KL573		/CHAR3
	JMP	KL574		/CHAR4
	JMP	KL575		/CHAR5
KL571	RTR			/8 RIGHT
	RTR
	RTR
	RTR
KL571A	DZM*	KLPUTP		/CLEAR WORD
	JMP	KLND57
KL572	RTL			/4 LEFT
	RTL
	JMP	KLND57
	.EJECT
KL573	RTR			/FIRST 4 CHAR
	RAR
	AND	(17		/CLEAN OFF
	XOR*	KLPUTP
	DAC*	KLPUTP
	ISZ	KLPUTP		/LAST WORD OF PAIR
	LAC	KLCHR2		/2ND HALF
	RTR			/4 RIGHT
	RTR
	AND	(700000
	JMP	KL571A
KL574	RTL			/8 LEFT
	RTL
	RTL
	RTL
	JMP	KLND57
KL575	RAL
	DZM	KL57		/START WITH NEW WORD PAIR
	SKP
KLND57	ISZ	KL57		/BUMP CHAR. POINTER
	XOR*	KLPUTP
	DAC*	KLPUTP
	LAC	KL57
	SNA
	ISZ	KLPUTP		/2ND WORD COMPLETE
	JMP*	KLPUT
	.EJECT
/
/OUTPUT A LINE IF NECESSARY
/
OUTLIN	0
	LAC	KLPUT		/HAS ANYTHING BEEN PACKED
	SNA
	JMP	OUTL		/NO EXIT
	LAC	(175		/PACK FINAL ALT MODE
	JMS	KLPUT
	DZM	KLPUT		/CLEAR PACKING FLAG
	JMS	IOSUP		/IS I/O SUPRESSION ON
	JMP	OUTL		/YES DO NOT OUTPUT
	CAL	2775		/.WRITE -3 IOPS ASCII
	11
TYOBFP	TYOBUF			/BUFFER ADDRESS
	-46
	.WAIT	-3		/WAIT FOR COMPLETION
OUTL	LAC	TYOBFP		/SET UP BUF POINTERS
	AAC	2		/ADD 2 (BR-049)
	DAC	KLPUTP
	DZM	KL57
	JMP*	OUTLIN
	.EJECT
/
/PRINT AC IN OCTAL WITH 0 SUPRESSION
/
NUMSUP	0
	DZM	SUP
	ISZ	SUP
	JMS	SUPOCT
	JMP*	NUMSUP
SUPOCT	0
	DAC	SUPO1		/SAVE AC
	LAW	-6		/6 DIGITS
	DAC	SUPO2
TYPE61	LAC	SUPO1		/UNSAVE #
	RTL			/ROTATE 3 LEFT
	RAL	
	DAC	SUPO1		/STORE FOR NEXT TRY
	RAL			/GET FROM LINK
	AND	(7		/CLEAN
	SNA
	JMP	.+3
	DZM	SUP		/FIRST NON-ZERO DIGIT
	SKP
	SAD	SUP		/SUPRESSION ON?
	JMP	TYPE62		/NO
	LAW	-1		/YES, LAST 0?
	SAD	SUPO2
	SKP!CLA			/YES PRINT
	JMP	.+3		/NO OMIT
TYPE62	XOR	(60
	JMS	KLPUT		/PACK
	ISZ	SUPO2		
	JMP	TYPE61
	JMS	OUTLIN		/OUTPUT NUMBER
	JMP*	SUPOCT
SUP	1
SUPO1	0
SUPO2	0
	.EJECT
/
/PRINT AC WITHOUT 0 SUPPRESSION
/
NUMOUT	0
	DZM	SUP
	JMS	SUPOCT
	JMP*	NUMOUT
/
/PRINT AC AS SIGNED NUMBER WITH 0 SUPPRESSION
/
SOCT	0
	SMA
	JMP	SOCT1
	TCA			/FORM TWO'S COMPLEMENT
	DAC	SUPOCT		/STORE TEMPORARILY
	LAW	55
	JMS	KLPUT		/STORE MINUS INTO OUTPUT BUFFER
	LAC	SUPOCT		/UNSAVE NUMBER
SOCT1	JMS	NUMSUP		/PRINT NUMBER WITH ZERO SUPRESSION
	JMP*	SOCT		/EXIT
	.TITLE	TABLE SEARCH ROUTINES
/
/
/	FIND	PROGRAM NAME IN COMBLK
/	AC	CONTAINS ADDRESS OF NAME
/	JMS	FCOMK
/	JMP	NOT IN COMBLK
/	JMP	THERE	/ADDRESS IN AC & P1
/
FCOMTP	0			/FIRST HALF OF NAME POINTER
FCOMT1	0			/SECOND HALF OF NAME POINTER
FCOMK	0
	DAC	FCOMTP		/FIRST HALF POINTER
	DAC	FCOMT1		/SECOND HALF POINTER
	ISZ	FCOMT1
	LAC	COMBK1
FCOM1	DAC	P1		/NEXT ENTRY
	SAD	(ENDCOM		/END?
	JMP*	FCOMK		/YES; UNSUCCESSFUL EXIT 1
	DAC*	(10
	LAC*	10		/FIRST HALF OF NAME
	SAD*	FCOMTP		/MATCH?
	SKP			/YES
	JMP	FCOM2		/NO
	LAC*	10		/SECOND HALF
	SAD*	FCOMT1		/MATCH?
	JMP	FCOM3		/YES; HIT
FCOM2	LAC	P1		/ITERATE FOR NEXT ENTRY
	TAD*	P1
	JMP	FCOM1
FCOM3	ISZ	FCOMK		/BUMP TO SUCCESSFUL RETURN
	LAC	P1		/ADDRESS IN AC
	JMP*	FCOMK
COMBK1	XX			/ADDRESS OF FIRST ENTRY IN COMBLK
	.EJECT
/
/	FIND PROGRAM NAME IN SYSBLK
/	AC CONTAINS ADDRESS OF NAME
/	JMS	FSYSK
/	FIRST RETURN	/MISSING FROM SYSBLK
/	SECOND RETURN	/AC CONTAINS ADDRESS OF ENTRY AND SO DOES
/			/P6
/
P6	0			/POINTER TO ENTRY IN SYSBLK
FSYSP1	0			/FIRST HALF OF NAME POINTER
FSYSP2	0			/SECOND HALF OF NAME POINTER
FSYSK	0
	DAC	FSYSP1		/FIRST WORD POINTER
	DAC	FSYSP2
	ISZ	FSYSP2		/SECOND WORD POINTER
	LAC	(SYSBLK+1	/START AT BEGINNING
FSYS1	DAC	P6		/POINTS TO ENTRY
	SAD	ENDSYS		/END?
	JMP*	FSYSK		/YES; UNSUCCESSFUL EXIT
	DAC*	(11
	LAC*	P6		/FIRST HALF NAME
	SAD*	FSYSP1		/MATCH?
	SKP			/YES
	JMP	FSYS2		/MISS
	LAC*	11		/SECOND HALF
	SAD*	FSYSP2		/MATCH?
	JMP	FSYS3		/SCORE
FSYS2	LAC	P6		/NEXT ENTRY
	AAC	7		/7 WORD ENTRIES (BR-049)
	JMP	FSYS1		/ITERATE
FSYS3	ISZ	FSYSK		/BUMP TO SUCCESSFUL EXIT
	LAC	P6		/AC CONTAINS ADDRESS OF ENTRY
	JMP*	FSYSK
ENDSYS	XX			/POINTER TO FIRST FREE WORD IN SYSBLK
	.EJECT
/
/	SUBROUTINE TO SEARCH SYSBLK FOR FILES WHICH DO NOT EXIST
/IN COMBLK AND DELETE THEM FROM THE SYSTEM.
/	JMS	DELSYS
/			/RETURN
/
DLTMP1	0			/FIRST HALF OF NAME BEING CONSIDERED
DLTMP2	0			/SECOND HALF OF NAME BEING CONSIDERED
DLTMP3	0			/FIRST BLOCK OF SYS FILE BEING CONSIDERED
DLTMP4	0			/# OF BLOCKS OF SYS FILE BEING CONSIDERED
P11	0			/POINTER TO COMBLK ENTRY
P10	0			/POINTER TO SYSBLK ENTRY
DELSYS	0
	LAC	(SYSBLK+26	/SKIP OVER PERMANENT ENTRIES
DL1	DAC	P10		/NEXT ENTRY IN SYSBLK
	SAD	ENDSYS		/END OF SYSBLK?
	JMP*	DELSYS		/YES; EXIT
	DAC*	(16
	LAC*	P10		/PUT NAME INTO NEW REGISTERS
	DAC	DLTMP1
	LAC*	16
	DAC	DLTMP2
	LAC*	16		/FB
	DAC	DLTMP3
	LAC*	16		/NB
	DAC	DLTMP4
	LAC	COMBK1
DL2	DAC	P11		/SEARCH COMBLK NEXT ENTRY
	SAD	(ENDCOM		/FINISHED?
	JMP	DL3		/YES; DELETE ENTRY FROM SYSBLK
	DAC*	(15
DL6	LAC*	15
	SAD	DLTMP1		/MATCH FIRST WORD
	JMP	DL4		/YES
	AND	(770000		/NO; IS IT BUFFS COMMAND
	SNA
	JMP	DL5		/YES; GO TO NEXT ENTRY
	LAC*	15		/IGNORE SECOND WORD
	JMP	DL6		/ITERATE
DL4	LAC*	15		/DOES SECOND WORD MATCH?
	SAD	DLTMP2
	JMP	DL7		/MATCH; ENTRY IS GOOD
	JMP	DL6		/NO; ITERATE
DL5	LAC	P11		/GO TO NEXT ENTRY IN COMBLK
	TAD*	P11
	JMP	DL2
DL3	LAC	P10		/DELETE SYS FILE FROM SYSBLK
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC*	(15
	AAC	7		/ADD 7 (BR-049)
	DAC*	(14
DL8	LAC*	(14		/FINISHED
	IAC			/ADD 1 (BR-049)
	SAD	ENDSYS
	JMP	DL9		/YES
	LAC*	14		/MOVE WORD
	DAC*	15
	JMP	DL8		/ITERATE
DL9	AAC	-7		/UPDATE END OF SYSBLK POINTER (BR-049)
	DAC	ENDSYS
	LAC	DLTMP4		/DELETE FILE FROM SAT
	JMS	DEALOC
	LAC	DLTMP3		/FB
	LAC	P10
	JMP	DL1
DL7	LAC	P10		/GO TO NEXT SYS FILE
	AAC	7		/ADD 7 (BR-049)
	JMP	DL1
	.EJECT
/
/	ROUTINE TO CHECK FOR OVERFLOW OF SYSBLK-COMBLK
/	JMS	SYSOVF
/			/RETURN
/
SYSOVF	0
	LAC	ENDSYS
	TCA	
	TAD	COMBK1
	SMA
	JMP*	SYSOVF
	JMS	OUT
	.SIXBT	'>@>(SYSBLK OVERFLOW)<@'
	JMP*	CNTLP		/GO TO ^P ADDRESS
	.EJECT
/
/	GET HANDLER NAME FROM HANDLER NUMBER
/	LAC	NO		/PUT NUMBER IN AC
/	JMS	FIONM		/FETCH NAME
/	JMP	TOO BIG		/NUMBER IS TOO BIG
/	JMP	NAME		/NAME IS IN AC
/
FIONM	0
	DAC	HANNO		/STORE
	CMA
	DAC	HANNAM
	LAW	-1
	TAD	DEVSBK
	DAC	P1
FIO1	JMS	NHAN		/GET NEXT HANDLER
	JMP*	FIONM		/RUN OUT OF HANDLERS
	ISZ	HANNAM		/COUNT?
	JMP	FIO1		/NO; NEXT
	ISZ	FIONM		/YES; THIS IS IT
	JMP*	FIONM		/EXIT WITH NAME IN AC
/
/	FIND DEVICE IN DEVICE TABLE
/	LAC	DEVICE CODE (S .SIXBT CHARACTERS LEFT JUSTIFIED
/	JMS	FDEV
/	JMP	NEW		/NOT IN TABLE
/	JMP	OLD		/IN TABLE
/
FDEV	0
	DAC	B.2B		/DEVICE QUESTION
	LAW	-1		/SET UP NHAN
	TAD	DEVSBK
	DAC	P1
FDL	JMS	NHAN		/GET NEXT HANDLER
	JMP*	FDEV		/NONE LEFT
	AND	(777700		/EXTRACT DEVICE CODE
	SZA			/SKIP IF HANDLERLESS (BR-048)
	JMP	FDL1		/NOT HANDLERLESS (BR-048)
	LAW	-1		/FAKE OUT P1 SO THAN NHAN WILL WORK (BR-048)
	TAD	P1		/MAKE IT POINT 1 BACK (BR-048)
	DAC	P1		/SAVE IT (BR-048)
	JMP	FDL		/AND GO TO NEXT (BR-048)
FDL1	SAD	B.2B		/SAME? (BR-048)
	SKP			/YES; SCORE
	JMP	FDL		/NO ITERATE
	ISZ	FDEV		/BUMP FOR SUCCESSFUL EXIT
	JMP*	FDEV		/EXIT
	.EJECT
/
/	ROUTINE TO CHECK PROGRAM NAMES IN ANSWER AND ANSWER+1
/FOR MATCHES TO MONITOR OR PATCH COMMANDS
/	JMS	MATCH
/				/RETURN IF NO MATCH
/
P7	0			/POINTER TO SYSTEM COMMAND TABLE ENTRY
MATCH	0
	LAC	(FULCMD		/MONITOR COMMAND TABLE
	DAC	P7
MAT1	LAC*	P7		/NEXT COMMAND
	SNA
	JMP	MAT2		/FIRST 0 MEANS END OF ABREVIATIONS
	AND	(770000		/MATCH FIRST LETTER
	SAD	ANSWER
	JMP	MATAB		/YES
	LAC*	P7		/MATCH WHOLE
	ISZ	P7		/BUMP BEFORE TEST
	SAD	ANSWER
	JMP	MAT3		/YES; TRY FOR MORE
	JMP	MAT4		/NO
MAT3	LAC*	P7		/SECOND WORD
	SAD	ANSWER+1
	JMP	MATM		/MATCH
MAT4	ISZ	P7
	ISZ	P7		/BUMP TO NEXT COMMAND
	JMP	MAT1		/ITERATE
MATAB	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS ABREV. FOR MONITOR COMMAND<@'
MATM	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	'IS MONITOR COMMAND<@'
MAT2	ISZ	P7		/END OF ABREVIATIONS
MAT6	LAC	P7		/NEXT ENTRY
	SAD	(PATCOM		/END?
	JMP	MAT5		/END OF OTHER MONITOR COMMANDS
	LAC*	P7		/DOES FIRST WORD MATCH
	ISZ	P7		/INCREMENT BEFORE TEST
	SAD	ANSWER
	JMP	MAT7		/YES
	JMP	MAT8		/NO
MAT7	LAC*	P7		/SECOND WORD?
	SAD	ANSWER+1
	JMP	MATM
MAT8	ISZ	P7
	JMP	MAT6		/ITERATE
MAT5	LAC	P7		/PATCH COMMANDS
	SAD	(PATND		/FINISHED?
	JMP*	MATCH		/YES; NO MATCH
	LAC*	P7		/FIRST WORD
	ISZ	P7		/INCREMENT BEFORE TEST
	SAD	ANSWER
	JMP	MAT9		/YES
	JMP	MAT10
MAT9	LAC*	P7
	SAD	ANSWER+1
	JMP	MATP		/MATCH
MAT10	ISZ	P7
	JMP	MAT5		/ITERATE
MATP	JMS	RERR		/ANNOUNCE ERROR
	.SIXBT	'IS PATCH COMMAND<@'
	.TITLE	SYSTEM COMMAND TABLES
/
/	MONITOR COMMAND TABLE
/
FULCMD	.SIXBT	'LOG@'
	0
	.SIXBT	'LOGW@'
	0
	.SIXBT	'SCOM@'
	0
	.SIXBT	'INSTRUCT@'
	.SIXBT	'REQUEST@'
	.SIXBT	'ASSIGN@'
	.SIXBT	'PROTECT@'
	.SIXBT	'KEEP@'
	0
	.SIXBT	'DATE@'
	0
	.SIXBT	'TIME@'
	0
	.SIXBT	'QDUMP@'
	0
	.SIXBT	'HALT@'
	0
	.SIXBT	'GET@'
	0
	.SIXBT	'LOGIN@'
	0
	.SIXBT	'GETP@'
	0
	.SIXBT	'GETT@'
	0
	.SIXBT	'GETS@'
	0
	.SIXBT	'PUT@'
	0
	.SIXBT	'LOGOUT@'
	.SIXBT	'MICLOG@'
	.SIXBT	'HALF@'
	0
	.SIXBT	'VT@@'
	0
	.SIXBT	'LP@@'
	0
	.SIXBT	'TAB@'		/(BR-051)
	0
	.SIXBT	'API@'
	0
	.SIXBT	'BATCH@'
	0
	.SIXBT	'BANK@'
	0
	.SIXBT	'PAGE@'
	0
	.SIXBT	'MODE@'		/(BR-051)
	0
	.SIXBT	'POLLER@'	/(BR-051)
	.SIXBT	'XVM@'		/(BR-051)
	0
	.SIXBT	'FILL@'		/(BR-051)
	0
	.SIXBT	'MEMSIZ@'	/(BR-051)
	.SIXBT	'UC15@'		/(BR-051)
	0
	.EJECT
	.SIXBT	'BUFFS@'
	0
	.SIXBT	'CHANNEL@'
	.SIXBT	'TIMEST@'
	.SIXBT	'EXECUT@'
	0			/END OF ONE LETTER COMMANDS
/
/	FOLLOWING COMMANDS TAKE UP T2 WORDS APIECE
/
	.SIXBT	'FOCAL@'
	.SIXBT	'LOAD@'
	.SIXBT	'GLOAD@'
	.SIXBT	'DDT@'
	.SIXBT	'DDTNS@'
	.SIXBT	'USER@'
	.SIXBT	'ERRORS'
	.EJECT
/
/	LIST OF PERMANENT PATCH COMMANDS (2 WORD APIECE)
/
PATCOM	.SIXBT	'B'
	0
	.SIXBT	'B+'
	0
	.SIXBT	'B-'
	0
	.SIXBT	'L'
	0
	.SIXBT	'LR'
	0
	.SIXBT	'READ'
	.SIXBT	'READR'
	.SIXBT	'EXIT'
	.SIXBT	'FB'
	0
	.SIXBT	'NB'
	0
	.SIXBT	'FA'
	0
	.SIXBT	'PS'
	0
	.SIXBT	'SA'
	0
PATND=.				/END OF PATCH COMMAND TABLE
	.EJECT
/FIND HANDLER IN AC
/	JMS	FHAN
/	NOT IN TABLE RETURN
/	IN TABLE RETURN
/	HANNO CONTAINS HANDLER #
/	P1 POINTS TO ENTRY
/
DEVSBK	0			/FIRST ENTRY IN DEVICE TABLE
ENDSBK	0			/FIRST FREE ENTRY WORD IN SBNBLK
HANNO	0
HANNAM	0
FHAN	0
	DAC	HANNAM		/SAVE HANDLER NAME
	LAC	DEVSBK		/SET UP NHAN
	AAC	-1		/SUBTRACT 1 (BR-049)
	DAC	P1
	DZM	HANNO
FHAN1	JMS	NHAN		/GET NEXT HANDLER
	JMP*	FHAN		/END REACHED - NOT THERE
	SAD	HANNAM		/IS THIS THE ONE
	JMP	FHEXIT		/YES
	AND	(777700		/IS THIS A HANDLER LESS DEVICE? (BR-060)
	SZA			/SKIP IF HANDLERLESS (BR-060)
	JMP	FHAN2		/REAL HANDLER - TRY AGAIN (BR-060)
	LAC	P1		/GET CURRENT ITEM POINTER (BR-060)
	AAC	-1		/AND BACK IT UP ONE (BR-060)
	DAC	P1		/AND SAVE IT (BR-060)
	SKP			/DON'T INCREMENT HANO. (BR-060)
FHAN2	ISZ	HANNO		/INCREMENT HANDLER NR. (BR-060)
	JMP	FHAN1
FHEXIT	ISZ	FHAN		/BUMP RETURN
	LAC	HANNO		/PUT # IN AC
	JMP*	FHAN		/EXIT
P1	0			/GET NEXT HANDLER
NHAN	0			/GO TO NEXT REG.
	DZM	SKPFLG		/ZAP SET OF SKIPS COUNTER (BR-048)
NHAN2	ISZ	P1		/GO TO NEXT REG.
	LAC	P1
	SAD	ENDSBK		/END?
	JMP*	NHAN		/YES
	LAC*	P1		/BEGINNING OF SKIPS
	AND	(777700
	SNA
	JMP	NHAN1		/YES
	LAC*	P1		/NO EXIT
	ISZ	NHAN
	JMP*	NHAN
NHAN1	LAC	SKPFLG		/GET NUMBER OF SKIP SET COUNTER (BR-048)
	SZA			/SKIP IF THIS IS THE FIRST SET (BR-048)
	JMP	NHAN3		/SECOND SET-HANDLERLESS DEVICE (BR-048)
	ISZ	SKPFLG		/FIRST SET - SET ONCE ONLY SWITCH (BR-048)
	LAC*	P1		/MUL. BY 3
	RCL
	TAD*	P1
	TAD	P1		/SKIP OVER SKIPS
	DAC	P1
	JMP	NHAN2
NHAN3	ISZ	NHAN		/POINT TO NORMAL EXIT (BR-048)
	JMP*	NHAN
SKPFLG	0			/COUNTER FOR SETS OF SKIPS IN A ROW (BR-048)
	.EJECT
/
/FIND SKIP IN TABLE COR. TO SYMBOL IN ANSWER
/AND ANSWER +1
/	JMS	FSKPM
/	MISSING RETURN
/	FOUND RETURN (WITH IOT IN AC)
/
SKPC	0
FSKPM	0
	JMS	INSKP		/SET UP NSKP ROUTINE
FSKP1	JMS	NSKP		/GET NEXT SKIP
	JMP*	FSKPM		/END OF TABLE - MISSING
	LAC*	P1		/DOES IT COMPARE
	SAD	ANSWER
	SKP
	JMP	FSKP1		/NO
	LAC	P1
	DAC*	(16
	LAC*	16
	SAD	ANSWER+1
	SKP			/YES
	JMP	FSKP1		/NO
	ISZ	FSKPM		/BUMP EXIT
	LAC*	16		/PUT IOT IN AC
	JMP*	FSKPM
/
/INITIALIZE NSKP
/
INSKP	0
	LAW	-3
	TAD	DEVSBK
	DAC	P1
	LAW	-1
	DAC	SKPC
	JMP*	INSKP
	.EJECT
/
/	FIND SKIP FROM IOT
/	JMS FSKPN WITH IOT IN AC
/	NOT IN TABLE RETURN (WITH IOT IN AC
/	AND P1 POINTING TO MNEMONIC)
/
FSKPN	0
	DAC	FSKPM
	JMS	INSKP		/INITIALIZE SKIP SEARCH
FSKPN1	JMS	NSKP		/FIND NEXT SKIP
	JMP*	FSKPN		/LAST ENTRY - NOT HERE
	SAD	FSKPM		/IS ENTRY EQUAL TO IOT
	SKP			/YES
	JMP	FSKPN1		/NO - ITERATE
	ISZ	FSKPN		/BUMP POINTER
	JMP*	FSKPN
/
/FIND NEXT SKIP IN TABLE
/	JMS	NSKP
/	END OF TABLE RETURN
/	SUCCESSFUL RETURN
/	(RETURNS WITH IOT IN AC AND P1
/	POINTING TO ENTRY FOUND)
/
NSKP	0
	LAC	P1		/GO TO NEXT POSSIBLE ENTRY
	AAC	3		/ADD 3 (BR-049)
	DAC	P1
NSKP4	ISZ	SKPC		/ARE THERE ANY MORE SKIPS
				/FOR THIS DEVICE
	JMP	NSKP1		/YES
NSKP3	LAC	P1		/NO; HAVE WE REACHED END OF
	SAD	ENDSBK		/TABLE
	JMP*	NSKP		/YES EXIT
	LAW	17700		/IS THIS ENTRY A HANDLER NAME?
	AND*	P1
	SNA
	JMP	NSKP2		/NO
	ISZ	P1		/YES; GO PAST
	JMP	NSKP3		/TRY AGAIN
NSKP2	LAC*	P1		/GET # OF SKIPS
	CMA			/NEGATE AND SUBTRACT 1
	DAC	SKPC		/STORE COUNTER
	ISZ	P1		/GO PAST # TO FIRST SKIP ENTRY
	JMP	NSKP4
NSKP1	LAC	P1		/FOUND SKIP - GET IOT (3RD WORD)
	IAC			/ADD 1 (BR-049)
	DAC*	(16
	LAC*	16
	ISZ	NSKP		/BUMP EXIT
	JMP*	NSKP
	.TITLE	DISK I/O ROUTINES
/
/	ALL DISK I/O IN SGEN GOES TO .DAT -14 AND CONSISTS OF 
/.TRANS.  A TRAN OUT ALWAYS IS READ CHECKED BY THE HANDLER.
/EACH .TRAN IS FROM OR TO THE 256 WORD BLOCK NUMBER IN THE AC.  THE
/FOLLOWING ARGUMENT (TO  JMS TRANIN OR JMS TRANOT) IS AN 
/INSTRUCTION TO LOAD THE FIRST ADDRESS OF THE CORE AREA INVOLVED
/INTO THE AC.
/	CALLING SEQUENCE:
/	LAC	BLKNO		/LOAD BLOCK #
/	JMS	TRANIN		/OR JMS TRANOT
/	LAC	(FIRST		/FIRST CORE LOCATION
/				/RETURN
/
TRANIN	0
	DAC	BLKIN		/STORE AWAY BLOCK 3 IN MACRO
	XCT*	TRANIN		/PICK UP THE FIRST CORE LOCATION
	DAC	FRADIN		/STORE AWAY IN .TRAN MACRO
	-14&777+10000		/.INIT TO READ CHECK
	1
	0
	0
	-14&777			/.TRAN IN
	13
BLKIN	XX			/BLOCK #
FRADIN	XX			/FIRST CORE ADDRESS
NWDIN	-400			/256 WORDS
	.WAIT	-14
	JMP*	TRANIN		/EXIT
TRANOT	0
	DAC	BLKOT		/STORE AWAY BLOCK # IN MACRO
	XCT*	TRANOT		/PICK UP FIRST CORE ADDRESS
	DAC	FRADOT
	-14&777+11000		/.INIT TO WRITE CHECK
	1
	0
	0
	-14&777+1000		/TRAN OUT -14
	13
BLKOT	XX			/BLOCK #
FRADOT	XX			/FIRST ADDRESS
NWDOT	-400			/256 WORDS
	.WAIT	-14
	JMP*	TRANOT
	.TITLE	BLOCK ALLOCATION ROUTINES
/
/
/	IMPORTANT VARIABLES
/
BMASK	0		/ALL 0'S EXCEPT A 1 WHERE BLOCK IS IN BITMAP
SATWP	0		/POINTER TO WORD IN SAT IN CORE
NBLOCK	0		/CORRESPONDING BLOCK NUMBER
SATBLP	0		/BLOCK # OF SAT IN CORE
SATMOD	0		/0 IF SAT IN CORE NOT MODIFIED
NOBPSB	0		/# OF BLOCKS REPRESENTED IN EACH SAT BLOCK
CNOBPS	0		/-# OF BLOCKS REPRESENTED IN EACH SAT BLOCK
NOBSYS	0		/# OF BLOCKS IN SYSTEM
ALNB	0		/# OF BLOCKS TO BE ALLOCATED
ALCT2	0		/-# OF BLOCKS TO BE ALLOCATED
ALFB	0		/FIRST BLOCK OF ALLOCATED AREA
ALCT1	0		/-# OF FREE BLOCKS MORE NEEDED
/
/	LAC	NB		/AC NUMBER OF BLOCKS
/	JMS	ALLOC		/TO BE ALLOCATED
/	JMP	NORUM		/NO ROOM FOR IMAGE
/	DAC	FB		/AC CONTAINS FIRST BLOCK #
/
ALLOC	XX
	DAC	ALNB		/SAVE NB
	TCA			/COMPUTE -#
	DAC	ALCT1		/SAVE
	DAC	ALCT2
	CLA
	JMS	FINDB		/FIND FIRST BLOCK
	JMP*	ALLOC		/NO ROOM
	JMP	ALLOC2
ALLOC1	JMS	FNB		/FIND NEXT BLOCK
	JMP*	ALLOC		/NO ROOM
ALLOC2	SNA			/FREE?
	JMP	ALLOC3		/YES
	LAC	ALCT2		/TAKEN; START ALL OVER
	DAC	ALCT1
	JMP	ALLOC1
ALLOC3	ISZ	ALCT1		/IS THIS THE LAST
	JMP	ALLOC1		/NO
	LAC	NBLOCK		/COMPUTE FIRST BLOCK
	TAD	ALCT2
	IAC			/ADD 1 (BR-049)
	DAC	ALFB		/SAVE
	LAC	ALNB		/ALLOCATE THE STORAGE
	JMS	XORSAT
	SNA			/ALLOCATE
	LAC	ALFB		/FIRST BLOCK
ALLOC4	ISZ	ALLOC		/BUMP RETURN
	JMP*	ALLOC		/FIRST BLOCK IN AC
	.EJECT
/
/	LAC	NB		/AC CONTAINS NUMBER OF BLOCK TO BE
/	JMS	DEALOC		/DEALLOCATED
/	LAC	FB		/FIRST BLOCK
/				/RETURN
/
DEFB	XX			/FIRST BLOCK TO BE DEALOCATED
DENB	XX			/NUMBER OF BLOCKS TO BE DEALLOCATED
DEALOC	0
	DAC	DENB		/SAVE
	XCT*	DEALOC		/PICK UP TEST
	DAC	DEFB
	LAC	DENB		/FLIP BITS IN MAP
	JMS	XORSAT
	SZA			/SHOULD BE CLEARED
	LAC	DEFB
	JMP*	DEALOC
/
/	ROUTINE TO RESTORE TEMPORARY SAT TO CONDITION WHEN SECTION
/BEGAN.
/	JMS	RESTOR
/
/	A TABLE IS BUILT IN FREE CORE BEGINNING AT THE ADDRESS STORED
/IN DELPT1 CORRESPONDING TO ADDED OR DELETED SYS FILES.
/EACH ENTRY CONSISTS OF 2 WORDS. THE SECOND ENTRY WORD CONTAINS
/THE FIRST BLOCK OF THE FILE AND THE FIRST ENTRY CONTAINS THE NUMBER
/OF BLOCKS IN THE FILE.  CGEND POINTS TO THE FIRST FREE WORD IN THE
/TABLE.
RESTOR	XX
	LAC	DELPT1		/FIRST ENTRY POINTER
	DAC	P5
REST1	SAD	CGEND		/END?
	JMP	REST2		/YES
	LAC*	P5		/DELETE NEXT
	ISZ	P5		/BUMP
	JMS	XORSAT		/XOR BITS
	SKP			/IGNORE TEST
	LAC*	P5		/FIRST BLOCK
	ISZ	P5
	LAC	P5		/ITERATE
	JMP	REST1
REST2	LAC	DELPT1		/CLEAR LIST
	DAC	CGEND
	JMP*	RESTOR		/EXIT
	.EJECT
/
/	ROUTINE TO XOR BIT IN SAT
/	LAC	NB		/PUT NUMBER OF BLOCKS IN AC
/	JMS	XORSAT		/CALL XORSAT
/	XX			/TEST INSTRUCTION WHICH SKIPS
/				/WHEN STATE OF BIT IS CORRECT
/				/SKP WHEN DON'T CARE
/				/SNA WHEN ALLOCATING
/				/SZA WHEN DEALLOCATING
XORCT	XX			/-# OF BLOCKS TO BE ALLOCATED OR
				/DEALOCATED
FB1	XX			/FIRST BLOCK TO BE ALLOCATED OR 
				/DEALLOCATED
NB1	XX			/# OF BLOCKS TO BE ALLOCATED OR
				/DEALLOCATED
XORSAT	XX
	DAC	NB1		/SAVE
	TCA			/COMPUTE -NB
	DAC	XORCT
	LAC*	XORSAT		/PICK UP TEST INSTRUCTION
	ISZ	XORSAT		/BUMP TO NEXT ARGUMENT
	DAC	XORIN
	LAC*	XORSAT		/PICK UP INSTRUCTION
	DAC	.+1
	XX			/PICK UP FIRST BLOCK
	DAC	FB1		/FIRST BLOCK  SAVE
	LAC	(SKP		/IF PUTTING THINGS BACK DON'T MESS
	SAD	XORIN		/WITH TABLE OF CHANGES
	JMP	XORS1
	LAC	NB1		/ADD TO TABLE
	JMS	DACFRE
	CGEND
	LAC	FB1
	JMS	DACFRE
	CGEND
XORS1	LAC	FB1		/FIND FIRST BLOCK
	JMS	FINDB
	JMP	MAPER		/NON-EXISTENT
	JMP	XORS3		/JMP INTO MIDDLE OF ALGORTHM
XORS2	JMS	FNB		/FIND NEXT BLOCK
	JMP	MAPER		/NON-EXISTENT
XORS3	JMS	XORB		/XOR BIT FOR BLOCK
XORIN	XX			/TEST IF BIT MAP CORRECT
	JMP	MAPER		/ERROR
	ISZ	XORCT		/DONE?
	JMP	XORS2		/NO; ITERATE
	JMS	WBWN		/WRITE OUT BLOCK IF MODIFIED
	JMP*	XORSAT		/EXIT
MAPER	JMS	TERMER		/TERMINAL ERROR; BIT MAP CONTAMINATED
	.SIXBT	'BAD SAT<@'
	.EJECT
/
/	FIND	NEXT BLOCK ALGORTHM
/	JMS	FNB
/				/RETURN
/				/RETURN SUCCESSFUL WITH AC 
/				/CONTAINING BIT FROM MAP
/
FNB	0
	ISZ	NBLOCK		/BUMP BLOCK COUNT
	LAC	NBLOCK
	JMS	FINDB		/FIND BLOCK
	JMP*	FNB		/NON-EXISTENT
	ISZ	FNB		/BUMP TO SUCCESSFUL
	JMP*	FNB		/EXIT
	.EJECT
/
/	FIND BLOCK IN AC
/	LAC	BLOCKNO
/	JMS	FINDB
/			/RETURN NON-EXISTENT BLOCK
/			/RETURN AC CONTAINS SAT BIT
BCTR	XX			/COUNTER
WPTR	XX			/WORD IN SAT STARTING FROM 0
BPTR	XX			/# OF SAT BLOCK STARTING FROM 0
FINDB	XX
	DAC	NBLOCK
	DZM	BPTR
	TCA			/TEST FOR LEGAL BLOCK #
	TAD	NOBSYS		/# OF BLOCKS IN SYSTEM
	SPA!SNA			/BLOCK # TOO HIGH?
	JMP*	FINDB
	LAC	NBLOCK
	ISZ	FINDB		/BUMP TO SUCCESSFUL EXIT
FIN1	TAD	CNOBPS		/COMPUTE BIT MAP
	SPA
	JMP	FIN2		/FOUND
	ISZ	BPTR		/NEXT BIT MAP
	JMP	FIN1		/ITERATE
FIN2	TAD	NOBPSB		/FIND WORD
	DZM	WPTR		/FIRST WORD
FIN3	AAC	-22		/18 BITS PER WORD (BR-049)
	SPA
	JMP	FIN4
	ISZ	WPTR
	JMP	FIN3		/ITERATE
FIN4	DAC	BCTR		/CALCULATE MASK OF BIT IN SAT
	CLA!STL
	RAL
	ISZ	BCTR
	JMP	.-2
	DAC	BMASK		/STORE MASK
	LAC	(SAT+3
	TAD	WPTR
	DAC	SATWP		/POINTER TO WORD FOR BLOCK IN QUESTION
	LAC	BTABP
	TAD	BPTR
	SAD	SATBLP		/BLOCK ALREADY IN CORE
	JMP	FIN5		/YES
	JMS	WBWN		/WRITE OUT OLD BLOCK IF CHANGES
	LAC	BTABP		/CALCULATE BLOCK POINTER FOR RIGHT
				/SAT BLOCK IN DUMMY TABLE
	TAD	BPTR
	DAC	SATBLP
	LAC*	SATBLP		/BRING IN BLOCK
	JMS	TRANIN
	LAC	(SAT
FIN5	LAC*	SATWP		/EXIT WITH WORD IN AC
	AND	BMASK		/CONTAINING BIT IN MAP
	JMP*	FINDB		/EXIT
/
/	WRITE OUT SAT BLOCK IF MODIFIED
/	JMS	WBWN
/			/RETURN
/
WBWN	0
	ISZ	SATMOD		/BLOCK MODIFIED
	JMP*	WBWN		/NO
	LAC*	SATBLP		/OUTPUT BLOCK
	JMS	TRANOT
	LAC	(SAT
	JMP*	WBWN		/EXIT
/
/	XOR BIT IN SAT
/
XORB	0
	LAW	-1
	DAC	SATMOD		/SAT MODIFIED
	LAC*	SATWP		/FIP BIT
	XOR	BMASK		/BY XORING
	DAC*	SATWP		/STORE BACK INTO SAT
	AND	BMASK		/CLEAN OFF
	SZA!CLC			/COMPUTE WHETHER BLOCK ADDED OR DELETE
	LAC	(1
	TAD	SAT+2
	DAC	SAT+2
	LAC*	SATWP
	AND	BMASK		/LEAVE WITH BIT MASKED IN AC
	JMP*	XORB
	.EJECT
/
/	DEPOSIT INTO FREE CORE AND INCREMENT FREE CORE POINTER
/	JMS	DACFRE
/	POINTER			/TV CONTAINING ADDRESS OF FREE CORE 
/				/POINTER
/	AC RESTORED ON EXIT
/
DACTV	0
DACTMP	0
DACFRE	0
	DAC	DACTMP		/SAVE AC
	LAC*	DACFRE
	DAC	DACTV		/PERFORM 1 LEVEL OF INDIRECTION
	LAC*	DACTV		/PICK UP CONTENTS
	ISZ*	DACTV		/INCREMENT CONTENTS
	DAC	DACTV		/PERFORM ANOTHE LEVEL OF INDIRECTION
	TCA	
	TAD*	(.SCOM+3	/CHECK FOR OVERFLOW OF FREE CORE
	SMA
	JMP	DACF1		/OK
OVFLO1	JMS	TERMER		/ANNOUNCE TERMINAL ERROR
	.SIXBT	'NO CORE<@'
DACF1	LAC	DACTMP		/PUT INTO TABLE
	DAC*	DACTV
	ISZ	DACFRE		/BUMP TO EXIT
	JMP*	DACFRE		/EXIT
	.TITLE	SAVE AND REFRESH SYSTEM BLOCKS ROUTINES
/
/	ROUTINES TO BRING IN SYSBLK-COMBLK AND SGNBLK
/
/	BRING IN SYSBLK
/	JMS	BINSBK
/			/RETURN
/
BINSBK	XX
	LAC	SYSBL2		/DUMMY SYSBLK
	JMS	TRANIN		/.TRAN IN
	LAC	(SYSBLK
	LAC	COMBL2		/COMBLK
	JMS	TRANIN
	LAC	(SYSBLK+400
	LAC	(SYSBLK
	TAD	SYSBLK
	DAC	ENDSYS		/FIRST FREE WORD IN SYSBLK
	LAC	(SYSBLK
	TAD	COMBLK
	DAC	COMBK1		/BEGINNING OF COMBLK
	JMP*	BINSBK
/
/	PUT OUT SYSBLK
/	JMS	POTSBK
/			/RETURN
/
POTSBK	0
	LAC	DELPT1		/NULL PREVIOUS TABLE
	DAC	CGEND
	LAC	(SYSBLK
	TCA	
	TAD	ENDSYS
	DAC	SYSBLK		/UNRELOCATED FREE REG. IN SYSBLK
	LAC	(SYSBLK
	TCA	
	TAD	COMBK1
	DAC	COMBLK		/UNRELOCATED BEG. OF COMBLK
	LAC	SYSBL2		/.TRAN OUT SYSBLK-COMBLK
	JMS	TRANOT
	LAC	(SYSBLK
	LAC	COMBL2
	JMS	TRANOT
	LAC	(SYSBLK+400
	JMP*	POTSBK		/EXIT
	.EJECT
/
/	BRING IN SGNBLK
/
BINSGK	XX
	LAC	SGNBL2		/.TRAN IN SGNBLK
	JMS	TRANIN
	LAC	(SGNBLK
	LAC	NOPAR
	TAD	(NOPAR
	DAC	SGNDAT		/FIRST ENTRY .DAT AND .UFD TABLE
	TAD	NODAT
	DAC	SGNSKP		/FIRST ENTRY SKIP CHAIN ORDER
	TAD	NOSKP
	DAC	DEVSBK		/FIRST ENTRY DEVICE TABLE
	LAC	SGNBLK
	TAD	(SGNBLK
	DAC	ENDSBK		/FIRST FREE ENTRY IN SGNBLK
	LAC	NODAT
	RCR
	TAD	SGNDAT
	DAC	SGNUFD		/FIRST ENTRY IN .UFD TABLE
	JMP*	BINSGK		/EXIT
	.EJECT
/
/	PUT OUT SGNBLK
/	JMS	POTSGK
/				/RETURN
/
POTSGK	XX
	LAC	(SGNBLK
	TCA	
	TAD	ENDSBK
	DAC	SGNBLK		/UNRELOCATED FIRST FREE ADRESS IN SGNBLK
	TAD	(-401		/TOO BIG
	SPA
	JMP	POT1		/NO
	JMS	OUT		/ANNOUNCE ERROR
	.SIXBT	'>@>(SGNBLK TOO BIG)<@'
	JMP*	CNTLP		/GO TO ^P ADDRESS
POT1	LAC	SGNSKP
	TCA	
	TAD	DEVSBK
	DAC	NOSKP		/# SKIP IOTS IN SKIP CHAIN
	LAC	SGNDAT
	TCA	
	TAD	SGNSKP
	DAC	NODAT		/# OF ENTRIES IN .DAT AND .UFD TABLES
	LAC	(NOPAR
	TCA	
	TAD	SGNDAT
	DAC	NOPAR		/# OF PARAMETERS
	LAC	SGNBL2		/.TRAN OUT SGNBLK
	JMS	TRANOT
	LAC	(SGNBLK
	JMP*	POTSGK		/.EXIT
	.TITLE	IMPORTANT VARIABLES AND CONSTANTS
/
/
/
SYSBL1	XX			/BLOCK # OF SYSBLK IN SYSTEM
COMBL1	XX			/BLOCK # OF COMBLK IN SYSTEM
SGNBL1	XX			/BLOCK # OF SGNBLK IN SYSTEM
SYSBL2	XX			/BLOCK # OF DUMMY SYSBLK
COMBL2	XX			/BLOCK # OF DUMMY COMBLK
SGNBL2	XX			/BLOCK # OF DUMMY SGNBLK
RFMFD	1777			/BLOCK # OF RF MASTER FILE DIRECTORY
DPMFD	47040			/BLOCK # OF DP MASTER FILE DIRECTORY
SATABP	XX			/POINTER TO LIST OF SAT BLOCKS IN 
				/FREE CORE
BTABP	XX			/POINTER TO SAT BLOCK LIST IN CORE(DUMMY)
NOSATB	XX			/# OF SAT BLOCKS
LITDEV	XX	/STORAGE FOR SYS DEV MNEMONIC
SYHAN	0			/SYSTEM A HANDLER NAME
ODATB	0			/HANDLER NAMES FOR OLD .DAT SLOTS TABLE
				/POINTER
ODATE	0			/DELETED HANDLER NAME BEGINNING POINTER
DELPT1	0			/ADDED OR DELETED SYS FILES SINCE
				/LAST REFRESHMENT OF SYBLK-COMBLK
				/TABLE POINTER
CGEND	0			/END OF ABOVE TABLE
ONPDAT	0			/OLD # OF POSITIVE .DAT SLOTS
P2	0			/POINTER
P3	0			/POINTER
P4	0			/POINTER
P5	0			/POINTER
ALFA	0			/NEXT BLOCK #
MCTR1	0			/COUNTER
DECT1	0			/COUNTER
SGNDAT	0			/POINTER TO .DAT SLOT TABLE IN 
				/SGNBLK
SGNSKP	0			/POINTER TO SKIP CHAIN TABLE IN
				/SGNBLK
SGNUFD	0			/POINTER TO .UFD SLOT TABLE IN
				/SGNBLK
TEMP	0
OLDVAL	0			/LAST CALCULATED VALUE OF NNNK (BR-053)
	.EJECT
/
/	.SIXBT	CONSTANTS
/
CMD	.SIXBT	'CMD'		/(GAR-058)
LTTA	.SIXBT	'TTA'
LDONE	.SIXBT	'DONE'
A1	.SIXBT	'DOSGENDMP'
LDP	.SIXBT	'DP'
LDK	.SIXBT	'DK'
LRK	.SIXBT	'RK'
L0A	.SIXBT	'0<@'
LMT	.SIXBT	'MT'
LLP	.SIXBT	'LP'
LVT	.SIXBT	'VT'
LS80	.SIXBT	'80'
LS120	.SIXBT	'120'
LS132	.SIXBT	'132'
LUIC	.SIXBT	'UIC'
L0R	.SIXBT	'0>'
LDKL	.SIXBT	'DKL'
LNONE	.SIXBT	'NONE] '	/TABLE
L16K	.SIXBT	'16K'
L20K	.SIXBT	'20K'
L24K	.SIXBT	'24K'
L28K	.SIXBT	'28K'
L32K	.SIXBT	'32K'	/END OF TABLE
LALL	.SIXBT	'ALL'
LKSPC	.SIXBT	'K] '		/SECOND HALF OF QAREA MESSAGE (BR-054)
LNONE1	.SIXBT	'E@@'		/USED TO COMPARE FOR 'NONE' (BR-054)
	.TITLE	YES, NO, AND $ ANSWER ROUTINES
/
/	THE YES NO TYPE OF QUESTION IN SGEN HAS BEEN DIVIDED UP INTO
/5 ROUTINES FOR TYPING THE ENDING QUESTION MARK, THE DEFAULT ANSWER
/IN PARENTHESIS, AND WAITING FOR THE REPLY.  CARRIAGE RETURN
/PRECEEDED ONLY BY SPACES MEANS TO ACCEPT THE DEFAULT ANSWER AS DOES
/THE FACT THAT I/O SUPRESSION HAS BEEN PUT INTO AFFECT.  A ALT MODE
/ALONE ON A LINE OR PRECEEDED ONLY BY SPACES IS ECHOED AS '$'
/AND SIGNIFIES THE ANTIDEFAULT CASE WHEN DEFINED FOR A YES NO
/QUESTION.  THIS DOES NOT NECESSARYILY AND USUALLY DOES NOT MEAN
/A SIMPLE YES OR NO, BUT SIGNIFIES AN ALTERNATIVE PROCEEDURE TO 
/FOLLOW(Q.V. SGEN OPERATING MANUAL).  MANY YES NO QUESTIONS
/IN SGEN RESULT IN THE SETTING OF A BIT IN AN .SCOM REGISTER.  TO
/FACILITATE THIS TYPE OF OPERATION THE TWO SUBROUTINE ENTRIES
/YW0 AND YW1 HAVE BEEN INSTITUTED.  THE AC ON ENTRY CONTAINS THE 
/.SCOM WORD FROM THE SYSTEM BEING UPDATED, AND THE FIRST
/ARGUMENT IS AN INSTRUCTION TO LOAD THE ACUMULATOR WITH A WORD
/WITH ALL ZERO BITS ACCEPT THE BIT POSITION TO BE SET BY THE
/QUESTION.  ON EXIT THE NEW WORD TO BE PLACED IN THE .SCOM REGISTER
/IS IN THE AC.  THE ROUTINES PRINT '? (X) ' AND WAIT FOR AN ANSWER.
/THE X STANDS FOR THE STATE OF THE SYSTEM AS INDICATED BY THE
/AC ON ENTRY.  IF I/O SUPRESSION EXISTS THE WORD WILL BE UNCHANGED
/ON EXIT AND ALL I/O IS NATURALLY AVOIDED.  TYPING AN $ IS BAD
/SYNTAX IN THESE QUESTIONS AND RESULTS IN A LIST OF THE PROPER
/RESPONES TO THE TELETYPE(CONSOLE) .  THE FIRST EXIT IS TAKEN IN CASE
/BAD SYNTAX IS FOUND. THE NEXT EXIT IF FOR A 'N' ANSWER AND
/THE LAST FOR A 'Y' ANSWER.  THE FOLLOWING IS AN EXAMPLE:
/	LAC	SCOM4		/LOAD AC WITH WORD TO BE ALTERED
/	JMS	YW0		/THE RESPONSE IS YES WHEN THE BIT IS 0
/	LAC	(1000		/THE BIT IS BIT 8
/	JMP	REPEAT		/BAD SYNTAX CAUSES QUESTION TO BE REPEATED
/	JMP	NO		/ANSWER IS NO; AC CONTAINS NEW WORD
/	JMP	YES		/ANSWER IS YES; AC CONTAINS NEW WORD
/
/	ABVIOUSLY IF A BIT IS NOT INVOLVED, THESE ROUTINES ARE NOT
/OPTIMAL AND THE FOLLOWING ROUTINE ENTRIES ARE USED;
/	JMS	YES		/DEFAULT ENTRY IS YES
/	JMS	NO		/DEFAULT ENTRY IS NO
/	JMS	ALTMOD		/DEFAULT ENTRY IS $
/
/THESE ROUTINES HAVE 4 EXITS INSTEAD OF 3.  THE FOLLOWING IS AN EXAMPLE:
/	JMS	YES		/POWER OF POSITIVE THINKING
/	JMP	REPEAT		/BAD SYNTAX
/	JMP	ALTMOD		/TAKE ANTIDEFAULT ROUTE
/	JMP	NO		/ANSWER IS NO
/	JMP	YES		/ANSWER IS YES
/
/	ALL THESE ROUTINES TAKE A COMPUTED EXIT WHEN THE ANSWER
/IS CARRIAGE RETURN PRECEEDED ONLY BY SPACES; THEREFORE A DEFAULT
/EXIT IS NOT EXPLICITLY GIVEN.  THE ROUTINE ENTRY POINTS SHOW THE
/DEFAULT EXIT PLAINLY AS ABOVE.  THE ROUTINES PRINT THE DEFAULT
/ANSWER EXACTLY AS DO THE 2 .SCOM BIT COMPUTATION ENTRIES.
/
YWTMPS	XX			/STATE WHEN YES
YWTMP	XX			/BIT AFFECTED BY THE ROUTINES
YWTMP1	XX			/WORD TO BE CHANGED IF NECESSARY
YW1	XX			/YES WHEN ONE; YES WHEN BIT IS 1 ENTRY
	DAC	YWTMP1		/STORE WORD TO BE CHANGED
	XCT*	YW1		/PICK UP BIT TO BE CHANGED
	DAC	YWTMPS		/STORE THIS AWAY TOO
	LAC	YW1		/PICK UP RETURN PC AND PUT INTO YW0
	DAC	YW0
	JMP	YW01		/JMP INTO ROUTINE
YW0	XX			/YES WHEN 0; YES WHEN BIT IS 0
	DAC	YWTMP1		/STORE ARGUMENT 1
	DZM	YWTMPS		/0 WHEN YES
YW01	XCT*	YW0		/PICK UP BIT AFFECTED
	DAC	YWTMP		/STORE TEMPORARILY
	ISZ	YW0		/BUMP TO BAD SYNTAX RETURN
	LAC	SYNCON		/OMIT ERROR MESSAGE ON BAD SYNTAX
	DAC	SYNER		/THIS EFFECTIVELY REMOVES THE ERROR
				/MESSAGE IN THE MORE BASIC ROUTINES
				/TO BE USED WHICH ACCEPT ALL ANSWERS
	LAC	YWTMP		/COMPUTE OLD STATE
	AND	YWTMP1
	SAD	YWTMPS		/IS DEFAULT ANSWER YES?
	JMP	YWYES		/YES!
	JMS	NO		/NO!
	JMP	BADSY		/BAD SYNTAX EVEN HERE
	JMP	BADSY		/EVEN ALT MODE IS BAD SYNTAX
	JMP	ANNO		/NO RETURN
	JMP	ANYES		/YES RETURN
ANNO	LAC	YWTMP		/COMPLEMENT STATE WHEN YES TO MAKE
	XOR	YWTMPS		/STATE WHEN NO
	DAC	YWTMPS
	JMP	ANNO1		/TAKE COMMON EXIT
YWYES	JMS	YES		/DEFAULT ANSWER IS YES
	JMP	BADSY		/BAD SYNTAX
	JMP	BADSY		/BAD SYNTAX ALSO
	JMP	ANNO		/NO
ANYES	ISZ	YW0		/BUMP EXIT TO YES RETURN
ANNO1	LAC	YWTMP		/MASK OFF OLD BIT
	CMA
	AND	YWTMP1
	XOR	YWTMPS		/PUT IN NEW
	ISZ	YW0		/BUMP PAST BAD SYNTAX
	DAC	YWTMP1		/SAVE
	JMP	YW02		/GO TO EXIT
BADSY	JMS	OUT		/OUTPUT ERROR MESSAGE
	.SIXBT	'_>@>(Y-N-C.R.)<@'
YW02	LAC	CRER		/PUT BACK ERROR MESSAGE IN BASIC ROUTINE
	DAC	SYNER
	LAC	YWTMP1		/RESTORE ANSWER TO AC
	JMP*	YW0		/EXIT
ALTMOD	0			/BASIC ROUTINE WHEN ANSWER DEFAULT IS $
	JMS	OUT
	.SIXBT	'? ($) <@'	/PRINT DEFAULT ANSWER
	LAC	ALTMOD
	DAC	YES		/STICK EXIT PC IN YES
	LAC	(JMP	YNALT	/COMPUTED DEFAULT INSTRUCTION
	JMP	YNENT		/JMP INTO MIDDLE OF YES
NO	0			/BASIC ROUTINE ENTRY WHEN DEFAULT IS NO
	JMS	OUT
	.SIXBT	'? (N) <@'	/DEFAULT ANSWER IS NO
	LAC	NO		/STICK RETURN PC IN YES
	DAC	YES
	LAC	(JMP	NO1	/ANSWER IS DEFAULT NO
	JMP	YNENT		/JMP INTO MIDDLE OF YES
YES	0			/DEFAULT ANSWER IS YES
	JMS	OUT		/TYPE DEFAULT ANSWER
	.SIXBT	'? (Y) <@'	/DEFAULT ANSWER IS YES
	LAC	(JMP	YES1	/COMPUTED DEFAULT INSTRUCTION
YNENT	DAC	YNDEF		/STICK AWAY DEFAULT INSTRUCTION
	LAC	YES		/SYNTAX ERROR RETURN PC
	DAC	BADSYN
	JMS	IOSUP		/I/O SUPPRESSION IN FORCE?
	JMP	YNDEF		/YES; TAKE DEFAULT ANSWER
	JMS	BATCH		/BATCH MODE?
	SKP			/YES
	JMP	YNNON1		/NO; READ IN IMAGE
	CLA			/BATCH MODE READ WITH NO MORE ON LINE
	JMS	ANS		/ACCEPT ANSWER
	JMP	SYNER		/SYNTAX ERROR
	JMP	YNDEF		/DEFAULT ANSWER
	JMP	YNALT		/$ ANSWER
	SKP			/SYMBOL IS ONLY OTHER LEGAL EXIT
	JMP	SYNER		/NUMBER IS BAD SYNTAX
	SAD	(1		/# OF CHARACTERS MUST BE 1
	SKP
	JMP	SYNER		/SYNTAX ERROR
	LAC	ANSWER		/TEST ANSWER
	SAD	(310000		/Y?
	JMP	YES1
	SAD	(160000		/N?
	JMP	NO1
	JMP	SYNER		/MUST BE Y OR N
YNNON1	JMS	TYIMG		/READ IN IMAGE
	JMP	SYNER		/SYNTAX ERROR
	JMP	YNDEF		/DEFAULT (C.R.)
	JMP	YNALT		/ALT MODE $
	JMP	NO1		/NO
YES1	ISZ	YES		/YES
NO1	ISZ	YES		/NO
YNALT	ISZ	YES		/$
SYNCON	JMP*	YES		/EXIT
SYNER	JMS	OUT
	.SIXBT	'_>@>(Y-N-$-C.R.)<@'	/BAD SYNTAX
	JMP*	BADSYN
YNDEF	XX			/DEFAULT INSTRUCTION COMPUTED FROM ENTRY
	.EJECT
/
/	SUBROUTINE TO READ TELETYPE IN IMAGE MODE IN ORDER TO SPEAD
/UP USE OF SYSTEM GENERATOR IN NON BATCH MODE.  LEADING SPACES WILL
/BE IGNORED.
/	CALLING SEQUENCE
/	JMS	TYIMG			/ACCEPT ANSWER IN IMAGE
/	JMP	REPEAT			/REPEAT MESSAGE
/	JMP	DEFAULT		/DEFAULT ANSWER
/	JMP	ALTMOD		/ANTIDEFAULT ANSWER $
/	JMP	NO		/NO
/	JMP	YES		/YES
/
TYIMG	0
TYI1	CAL	3776		/.READ -2 IN IMAGE .ASCII
	10
	TYIBUF
	-3
	.WAIT	-3
	LAC	TYIBUF+2
	AND	(177		/PICK UP FIRST CHARACTER
	SAD	(40		/IS IT SPACE
	JMP	TYI1		/YES; IGNORE
	SAD	(116		/IS IT N?
	JMP	TYIN		/YES TAKE APPROPRIATE EXIT
	SAD	(131		/IS IT Y?
	JMP	TYIY		/YES TAKE APPROPRIATE EXIT
	SAD	(175		/IS IT ALT MODE?
	JMP	TYDOL		/YES TAKE APPROPRIATE ACTION
	SAD	(44		/$
	JMP	TYDOL1
	SAD	(33		/ANOTHER LEGAL CODE FOR ALTMODE
	JMP	TYDOL		/TYPE $
	SAD	(176		/ANOTHER LEGAL CODE FOR ALTMODE
	JMP	TYDOL		/TYPE $ AND EXIT
	SAD	(15		/CARRIAGE RETURN?
	JMP	TYCR		/TAKE DEFAULT EXIT
	SAD	(137		/_
	ISZ	TYIMG
	JMS	CRLF		/NO; BAD SYNTAX; GIVE C.R. LF
	JMP*	TYIMG		/TAKE DBAD SYNTAX EXIT
TYIY	ISZ	TYIMG
TYIN	ISZ	TYIMG
	JMS	CRLF		/ECHO CRLF TO KEEP THINGS THE SAME
TYDOL1	ISZ	TYIMG		/IN NON-BATCH MODE
TYCR	ISZ	TYIMG
	JMP*	TYIMG		/EXIT
TYDOL	JMS	OUT
	.SIXBT	'$<@'		/ECHO $ FOR ALTMODE
	JMP	TYDOL1
	.EJECT
/
/	SUBROUTINE TO CHECK WHETHER IN BATCH MODE
/	JMS	BATCH
/	JMP	YES
/	JMP	NO
/
BAT1	0
BATCH	XX
	DAC	BAT1		/SAVE AND RESTORE AC
	LAC	17777
	SMA
	ISZ	BATCH		/SKIP IF NONBATCH MODE
	LAC	BAT1
	JMP*	BATCH		/EXIT WITH AC RESTORED
	.TITLE	FETCH ANSWER ROUTINE
/
/	FETCH ANSWER HAS 3 ENTRY POINTS (ANS,MULANS,MORANS).  
/A ZERO AC FILTERS OUT ANSWERS WHICH DO NOT CONSIST OF A
/SYLABLE ENDING WITH CARRIAGE RETURN OR ALTMODE
/OTHER TERMINATORS ARE '<','>','/',',','=', AND SPACE.
/THE TERMINATOR IN .ASCII WILL BE STORED IN OP.  THE ANSWER WILL BE
/STORED AS 6 .SIXBT CHARACTER PADDED WITH @ INTO ANSWER AND 
/ANSWER +1.  AN OCTAL NUMBER WILL BE STORED INTO NUMBER.  A MINUS
/SIGN ENCOUNTERED ANYWHERE IN AN OCTAL NUMBER WILL NEGATE THE
/NUMBER (2'S COMPLEMENT).  A + SIGN IN A NUMBER WILL BE IGNORED.
/IF THE ANSWER IS AN OCTAL NUMBER, THE CONTENTS OF ANSWER AND
/ANSWER+1 SHOULD BE IGNORED.  IF THE ANSWER IS A ALT MODE
/PRECEEDED BY 0 OR MORE SPACES, A $ WILL BE ECHOED ON THE TELETYPE
/AND A SPECIAL EXIT TAKEN.  $ ITSELF IS EQUIVALENT TO ALT MODE
/ITSELF IN ORDER TO AVOID CONFUSION.  IF THE ANSWER IS A CARRIAGE RETURN
/OR _ PRECEEDED ONLY BY 0 OR MORE SPACES THEN A SPECIAL EXIT IS TAKEN
/(THE DEFAULT EXIT).  IF THE ANSWER IS NOT A LEGAL OCTAL
/NUMBER, THE SYMBOL EXIT WILL BE TAKEN.  IF THE ANSWER IS A LEGAL
/OCTAL NUMBER, THE NUMBER EXIT WILL BE TAKEN.  THE ROUTINE CHECKS
/FOR ANSWERS THAT ARE TOO LONG OR WHICH CONTAIN ILLEGAL .ASCII
/CHARACTERS AND OUTPUTS AN APPROPRIATE MESSAGE.  ALL BAD SYNTAX
/ERRORS TAKE THE SAME EXIT.  MULANS IS USED TO FETCH THE NEXT
/ANSWER IN A MULTILINE ANSWER SEQUENCE.  MORANS IS USED
/TO FETCH THE NEXT ANSER ON THE SAME INPUT LINE.  ALL INPUT IS IN
/IOPS .ASCII.  IF NO MORE INPUT IS PRESENT ON THE LINE, MORANS TAKE
/THE BAD SYNTAX EXIT OR $ EXIT OR DEFAULT EXIT.  THE AC ON A SYMBOL
/EXIT CONTAINS THE NUMBER OF NON-NULL CHARACTERS IN THE SYMBOLIC ANSWER
/THE AC ON OCTAL NUMBER EXIT CONTAINS THE OCTAL NUMBER.  IF 
/NEGFLG IS NON-ZERO, THE NUMBER INPUT CONTAINED A MINUS SIGN.  THE
/NUMBER OF DIGITS INPUT IS STORED IN CNTDIG.  THE NUMBER OF CHARACTERS
/IN A SYMBOLIC ANSWER IS CONTAINED IN CNTCHR.  NUMFLG IS ZERO, IF 
/THE INPUT WAS AN OCTAL NUMBER.
/	CALLING SEQUENCE:
/	CLC			/OR CLA; CLA TO LOCK OUT TERMINATORS
/				/INDICATING MORE ON LINE
/	JMS	ANS		/OR MULANS OR MORANS
/	JMP	QUES		/BAD SYNTAX
/	JMP	DEFALT		/DEFAULT ANSWER
/	JMP	ALTMOD		/ANTIDEFAULT ANSWER
/	JMP	SYMBOL		/SYMBOLIC ANSWER
/	JMP	NUMBR		/OCTAL NUMBER ANSWER
/
ANS	0
	DAC	OPFLG		/STORE FLAG INDICATING MORE ON LINE
	LAC	ANS
	JMP	ANSENT		/JMP INTO ROUTINE
MULANS	0			/ENTRY INDICATING MULTILINE SEQUENCE
	DAC	OPFLGS		/STORE INTO TEMPORARY FOR MORE ON LINE
MULBAD	JMS	OUT		/OUTPUT GO AHEAD
	.SIXBT	'_>@>><@'
	LAC	OPFLGS		/PUT MORE ON LINE FLAG INTO SAVE REGISTER
	DAC	OPFLG
	LAC	MULANS		/GET RETURN PC
ANSENT	DAC	ANS		/STORE RETURN PC INTO ANS
	DAC	BADSYN		/FIRST EXIT IS BAD SYNTAX
	ISZ	ANS		/BUMP PAST BAD SYNTAX
	JMS	IOSUP		/I/O SUPPRESSION?
	JMP*	ANS		/YES; TAKE DEFAULT EXIT
	LAC	(TYIBUF+2	/UNPACK ANSWER
	DAC	ANSP1
	CAL	2776		/.READ -2 IN IOPS .ASCII
	10
	TYIBUF
	-46
	.WAIT	-2
	LAW	-1		/SET UP TO START UNPACKING FROM
	DAC	KLGET5		/THE BEGINNING
	JMP	MULSKP
MORANS	0			/ENTRY POINT TO BEGIN UNPACKING
	DAC	OPFLG		/FROM WHERE LEFT OFF ON LINE
	LAC	MORANS		/STICK RETURN PC INTO ANS
	DAC	ANS
	DAC	BADSYN		/BAD SYNTAX EXIT
	ISZ	ANS		/BUMP TO DEFAULT EXIT
	JMS	IOSUP		/I/O SUPRESSION?
	HLT			/THIS PART OF SGEN SHOULD NEVER BE REACHED
	LAC	OP
	SNA			/IS THERE MORE ON LINE
	JMP*	BADSYN		/NO; BAD SYNTAX
MULSKP	DZM	CNTCHR		/# OF CHARACTERS SET ORIGINALLY TO 0
	DZM	CNTDIG		/# OF OCTAL DIGITS ALSO
	DZM	NEGFLG		/# NOT NEGATED
	DZM	NUMBER		/# ORIGINALLY 0
	DZM	NUMFLG		/# IS A NUMBER TO START WITH
	DZM	OP		/ OPERATOR IS CARRIAGE RETURN OR ALT MODE
				/UNLESS FOUND TO THE CONTRARY
	DZM	ANSWER		/ANSWER IS ORIGINALLY NOT THERE
	DZM	ANSWER+1	/ALSO SECOND HALF
	LAC	(ANSWER		/SET UP TO GET FIRST HALF OF ANSWER
	DAC	ANS1
ANS2	LAW	-3		/ANSWER IS TO BE PACKED IN .SIXBT
	DAC	SIXTMP		/SET UP TO PUT IN FIRST CHARACTER
ANS17	ISZ	KLGET5		/IS THIS THE BEGINNING OF A 5/7 PAIR
	JMP	KL5GET		/NO; UNPACK ANOTHER
	LAC*	ANSP1		/GET NEXT PAIR
	DAC	KLWD1
	ISZ	ANSP1
	LAC*	ANSP1
	DAC	KLWD2
	ISZ	ANSP1
	LAW	-5		/SET UP TO UNPCK ANOTHER FIVE
	DAC	KLGET5
KL5GET	LAW	-10		/SHIFT WORD PAIR 7 TIMES
	DAC	KLWD3
KL6GET	LAC	KLWD2		/STANDARD UNPACKING ROUTINE
	RAL
	ISZ	KLWD3
	SKP
	JMP	KL6G1
	DAC	KLWD2
	LAC	KLWD1
	RAL
	DAC	KLWD1
	JMP	KL6GET
KL6G1	AND	(177		/CLEAN
	DAC	KLWD4		/SAVE
	AND	(170		/LEGAL OCTAL DIGIT
	SAD	(60
	SKP			/YES
	JMP	KL6G2		/NO
	ISZ	CNTDIG		/COUNT DIGITS IN NUMBER
	LAC	NUMBER		/MULTIPLY PREVIOUS VALUE BY 8
	RCL
	RTL
	XOR	KLWD4		/MERGE DIGIT INTO LAST POSITION
	AND	(777770
	XOR	KLWD4
	DAC	NUMBER
	JMP	ANS3		/GO PUT INTO SYMBOL ALSO JUST IN CASE
KL6G2	LAC	KLWD4		/TEST FOR SPECIAL CHARACTER
	SAD	(55		/-?
	JMP	ANS7		/YES NEGATE NUMBER
	SAD	(40		/SPACE
	JMP	ANS16S		/YES; IGNORE IF LEADING
	SAD	(137		/_
	JMP	ANS40
	SAD	(74		/<?
	JMP	ANS16L		/SPECIAL OPERATOR
	SAD	(76		/>/
	JMP	ANS16G
	SAD	(54		/,?
	JMP	ANS16
	SAD	(53		/+?
	JMP	ANS3
	SAD	(175		/ALTMODE
	JMP	ANS8
	SAD	(15		/C.R.?
	JMP	ANS9R
	SAD	(75		/=?
	JMP	ANS16
	SAD	(57		/'/'?
	JMP	ANS16
	SAD	(44		/$
	JMP	ANS99
ANS100	ISZ	NUMFLG
	AND	(77
	DAC	KLCNTB		/COMPUTE IF CHARACTER IS LEGAL IN .SIXBT
	AND	(40
	SNA!STL
	CLL
	LAC	KLCNTB
	SNL!SZA
	XOR	(100
	SAD	KLWD4
	JMP	ANS3		/LEGAL
CRER	JMS	OUT		/ILLEGAL
	.SIXBT	'>@>(NON-PRINTING CHAR)<@'
	JMP*	BADSYN		/BAD SYNTAX
ANS7	ISZ	NEGFLG		/SET NEGATE FLAG
ANS3	LAC	KLWD4		/GET CHARACTER
	AND	(77		/STRIP TO .SIXBT
	ISZ	CNTCHR		/COUNT CHARACTERS IN SYMBOL
	ISZ	SIXTMP		/DETERMINE WHETHER SYMBOL IS FIRST
	JMP	ANS4		/SECOND OR THIRD IN .SIXBT WORD
	XOR*	ANS1		/THIRD
	DAC*	ANS1		/STORE AWAY
	ISZ	ANS1		/START WITH NEXT WORD
	JMP	ANS2		/GO FOR MORE
ANS4	ISZ	SIXTMP		/TEST AGAIN
	JMP	ANS12		/LAST CHARACTER
	CLL
	RTL			/SECOND CHARACTER
	RTL
	RTL
	XOR*	ANS1
	DAC*	ANS1
	LAW	-1		/LAST CHARACTER NEXT
	JMP	ANS2+1
ANS12	LAC	CNTCHR		/FIRST CHARACTER; TEST WHETHER LEGAL
	AAC	-7		/IS THE NUMBER OF CHARACTERS 7 (BR-049)
	SMA
	JMP	ANS2		/YES; IGNORE FURTHER CHARACTERS
	LAC	KLWD4		/PICK UP CHARACTER
	AND	(77		/CLEAN TO .SIXBT
	RCR
	RTR
	RTR
	RTR
	DAC*	ANS1		/FIRST WORD IGNORES PREVIOUS CONTENTS
	LAW	-2
	JMP	ANS2+1		/SECOND CHARACTER NEXT
ANS16	DAC	OP		/STORE OPERATOR OR DELIMITER
	AND	(77		/CLEAN OFF TO .SIXBT
ANS16I	DAC	OP1		/STORE IN BAD OPERATOR MESSAGE
ANS16T	LAC	OPFLG		/TEST IF THIS KIND OF DELIMITER
	SZA			/IS GOOD SYNTAX HERE
	JMP	ANS9		/YES
OPBAD	JMS	OUT		/BAD DELIMITER
	.SIXBT	'>@>("'
OP1	XX
	.SIXBT	'" IS BAD DELIMITER)<@'
	JMP*	BADSYN		/BAD SYNTAX
ANS16L	DAC	OP		/SPECIAL DELIMITERS IN THAT THEY
	LAC	LESTH		/MUST BE DOUBLED IN ORDER TO PRINT
	JMP	ANS16I
ANS16G	DAC	OP
	LAC	GRTH
	JMP	ANS16I
LESTH	.SIXBT	'<<'
GRTH	.SIXBT	'>>'
LSALT	.SIXBT	'ALT'
LSCRT	.SIXBT	'CR'
ANS8	LAC	CNTCHR		/IS ALT MODE ALONE?
	SNA
	JMP	ANS10		/YES; ECHO $ AND TAKE $ EXIT
	JMS	CRLF		/GIVE CARRIAGE RETURN LINE FEED
	LAC	LSALT		/INDICATE ALT MODE AS DELIMITER
	SKP
ANS9CR	LAC	LSCRT		/INDICATE CARRIAGE RETURN AS DELIMITER
	DAC	OP1
ANS9	LAC	NUMFLG		/EXIT; IS THE NUMBER LEGAL
	SNA
	JMP	ANSNM1		/YES
ANSYM	LAC	CNTCHR		/SYMBOL TOO LARGE?
	AAC	-7		/SUBTRACT 7 (BR-049)
	SPA
	JMP	ANSSOK		/NO
	JMS	OUT		/SYMBOL TOO LARGE
	.SIXBT	'>@>(SYMBOL >> 6 CHAR)<@'
	JMP*	BADSYN		/BAD SYNTAX
ANS99	LAC	CNTCHR		/HAVE ANY CHARACTERS PRECEEDED
	SNA
	JMP	ANS15		/NO; TREAT LIKE DEFAULT
	LAC	KLWD4		/YES
	JMP	ANS100
ANSSOK	LAC	ANSWER		/CHECK FOR DONE
	SAD	LDONE		/(.SIXBT 'DONE'
	SKP
	JMP	ANSOK7		/NO MATCH
	LAC	ANSWER+1	/SECOND WORD
	SAD	LDONE+1
	JMP*	ANS		/MATCH; DEFAULT EXIT
ANSOK7	LAC	CNTCHR		/PUT # OF CHARACTERS IN AC
ANSOK1	ISZ	ANS		/BUMP FOR SYMBOL EXIT
ANS15	ISZ	ANS		/BUMP FOR $ ANSWER
	JMP*	ANS		/EXIT
ANSNM1	LAC	CNTDIG		/ARE DIGITS ENOUGH
	SNA
	JMP	ANSYM		/NO; MUST BE SYMBOL
	AAC	-7		/TOO MANY DIGITS (BR-049)
	SPA
	JMP	ANSNOK		/NO; EXIT
	JMS	OUT		/YES
	.SIXBT	'>@>(# >> 6 DIGITS)<@'
	JMP*	BADSYN		/BAD SYNTAX
ANSNOK	LAC	NEGFLG		/IS NUMBER TO BE NEGATED
	SNA			/SKIP IF # NEGATIVE
	JMP	ANSNK1		/NUMBER NOT PRECEEDED BY MINUS SIGN
	LAC	NUMBER		/FORM TWO'S COMPLEMENT OF NUMBER
	TCA	
	DAC	NUMBER		/AND STORE BACK IN NUMBER
ANSNK1	LAC	NUMBER		/PUT # IN AC ON EXIT
	ISZ	ANS		/BUMP TO NUMBER RETURN
	JMP	ANSOK1
ANS10	JMS	OUT		/ALT MODE ALONE; ECHO $
	.SIXBT	'$<@'
	JMP	ANS15
ANS40	LAC	CNTCHR		/IF ALONE INDICATES DEFAULT
	SNA
	JMP*	ANS		/DEFAULT EXIT
	LAC	LAR
	DAC	OP1
	JMP	OPBAD		/BAD OPERATOR
LAR	.SIXBT	'__'
ANS16S	DAC	OP		/STORE AWAY OPERATOR
	DAC	OP1
	LAC	CNTCHR		/IGNORE LEADING SPACES
	SZA
	JMP	ANS16T
	DZM	OP
	JMP	ANS17		/SPACES ARE NOT OPERATORS WHEN LEADING
ANS9R	LAC	CNTCHR		/CARRIAGE RETURN IS DEFAULT ONLY
	SZA			/WHEN ALONE
	JMP	ANS9CR		/NOT ALONE; PROCESS AS USUAL
	JMP*	ANS		/TAKE DEFAULT EXIT
SYMBAD	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T OCTAL #<@"
KBAD	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR:NR NOT NNNK (BR-053)
	.SIXBT	'IS BAD ENTRY - MUST BE OF FORM NNNK<@'	/(BR-053)
KBAD1	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR:NR LESS 24K (BR-053)
	.SIXBT	'TOO SMALL - MUST BE GEQ 24K<@'	/(BR-053)
KBAD2	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR:NR GTR 128K (BR-053)
	.SIXBT	'TOO LARGE - MUST BE LEQ 128K<@'	/(BR-053)
KBAD3	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR:NOT MULT 8K (BR-053)
	.SIXBT	'NOT MULTIPLE OF 8K<@'	/(BR-053)
NUMBIG	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR : TO BIG (BR-053)
	.SIXBT	'NUMBER TOO BIG<@'	/(BR-053)
NUMBAD	JMS	RERR		/ANNOUNCE RECOVERABLE ERROR
	.SIXBT	"ISN'T SYMBOL<@"
ALTBAD	JMS	OUT		/ALT MODE NONACCEPTABLE ANSWER
	.SIXBT	'_>@>("$" BAD HERE)<@'
	JMP*	BADSYN		/BAD SYNTAX
CRBAD	JMS	OUT		/DEFAULT CASE IS ILLEGAL
	.SIXBT	'>@>(NO DEFAULT CASE)<@'
	JMP*	BADSYN		/BAD SYNTAX
	.TITLE	SMALL SUBROUTINES
/
/	ROUTINE TO CHECK THAT # IN AC CORRESPONDS TO LEGAL .DAT SLOT
/	JMS	LEGAL
/	JMP	NO
/	JMP	YES	/LEGAL
/
LEGAL	0
	SAD	(-7		/PERMANENT SLOTS
	JMP*	LEGAL
	SAD	(-3
	JMP*	LEGAL
	SAD	(-2
	JMP*	LEGAL
	SNA			/0 NOT LEGAL .DAT SLOT
	JMP*	LEGAL
	AAC	15		/ADD 15 (BR-049)
	SPA			/TOO NEGATIVE
	JMP*	LEGAL		/YES
	TAD	SGNDAT
	TCA	
	TAD	SGNUFD
	SPA!SNA
	JMP*	LEGAL		/TOO BIG
	ISZ	LEGAL		/LEGAL .DAT SLOT
	JMP*	LEGAL
/
/	SUPPRESS SEGMENT
/	JMS	SUPSEG
/
SUPSEG	XX
	LAC	(NOP
	DAC	IOSEG
	JMP*	SUPSEG
/
/	SUPPRESS SECTION
/	JMS	SUPSEC
/
SUPSEC	XX
	LAC	(NOP
	DAC	IOSEC
	JMP*	SUPSEC
	.EJECT
/
/	START NEW SECTION AND SET ^P
/	JMS	SECTN
/	.SIXBT 'MESSAGE<@'
/
SECTN	XX
	JMS	RIOSUP		/REMOVE ALL I/O SUPRESSION
	LAW	-1		/COMPUTE ^P ADDRESS
	TAD	SECTN
	AND	(77777
	DAC	CNTLP
	JMS	CRLF		/.INIT -3
	JMS	CRLF
	JMS	OUTP		/TYPE MESSAGE
	LAC	SECTN
	JMP*	OUT		/EXIT RIGHT AFTER MESSAGE
/
/	ASK QUESTION OR MAKE STATEMENT
/	JMS	QUERY
/	.SIXBT	'MESSAGE<@'
/
QUERY	XX
	JMS	OUT
	.SIXBT	'_><@'
	JMS	OUTP
	LAC	QUERY
	JMP*	OUT		/EXIT RIGHT AFTER MESSAGE
/
/	SAVE CONTENTS OF ANSWER TEMPORARILY
/	JMS	SAVANS
/
ANSTMP	0			/ANSWER SAVED HERE
	0
SAVANS	XX
	LAC	ANSWER
	DAC	ANSTMP
	LAC	ANSWER+1
	DAC	ANSTMP+1
	JMP*	SAVANS
	.EJECT
/
/	SUBROUTINE TO TEST IF OP EQUAL TO FOLLOWING LOCATION
/	CALLING SEQUENCE:
/	JMS	DELIM
/	OPERATOR		/CONTENTS OF FOLLOWING LOCATION 
/				/IS THE OPERATOR IN .ASCII
/	JMP	YES		/MATCH EXIT
/	JMP	NO		/NO MATCH EXIT
/				/RESTORES AC ALWAYS
/
DELIM	0			/TEST IF DELIMITER IS CORRECT
	DAC	SAVAC		/WITHOUT ALTERING THE AC
	LAC	OP
	SAD*	DELIM		/TEST
	SKP			/SKIP IF OK
	ISZ	DELIM		/BUMP OVER MATCH EXIT
	ISZ	DELIM
	LAC	SAVAC
	JMP*	DELIM
/
/	SUBROUTINE TO PRINT SYMBOL IN ANSWER
/	JMS	PANS
/
PANS	0
	JMS	OUT
	.SIXBT	'>@>("'
ANSWER	0
	0
	.SIXBT	'" <@'
	JMP*	PANS
	.EJECT
/
/	SUBROUTINE TO FETCH CHARACTERS ONE AT A TIME FROM ANSWER,ANSWER+1
/
/	INITIALIZE WITH DZM ANSCNT
/
/	SIXBT CHARACTER RETURNED: STARTING LEFT TO RIGHT ANSWER,ANSWER+1
/
/	CALLING SEQUENCE :  JMS ANSGET
/	RESULT IN AC
/
ANSGET	0			/ENTRY-GET NXT CHAR FROM ANSWER ROUTINE (BR-053)
	LAC	ANSWER+1	/GET ANSWER+1 (BR-053)
	LMQ			/PUT IN MQ REGISTER (BR-0539
	LAC	ANSCNT		/GET CHAR COUNTER (BR-053)
	AAC	-6		/TEST IF 6 CHAR ALREADY SENT (BR-053)
	SMA!CLA			/SKIP IF LESS THAN 6 SENT (BR-053)
	JMP*	ANSGET		/RETURN TO USER WITH 0 IN AC (BR-053)
	LAC	ANSCNT		/RESTORE ANSCNT (BR-053)
	TAD	(SHFTAB		/COMPUTE SHIFT INSTRUCTION ADR (BR-053)
	DAC	SHFTAD		/SAVE ADDRESS (BR-053)
	LAC	ANSWER		/LOAD AC WITH ANSWER
				/AC=ANSWER,MQ=ANSWER+1 (BR-053)
	XCT*	SHFTAD		/EXECUTE SHIFT (BR-053)
	AND	(000077		/MAKE SINGLE SIXBT CHAR (BR-053)
	ISZ	ANSCNT		/INCREMENT CHAR COUNTER (BR-053)
	JMP*	ANSGET		/RETURN TO CALLER (BR-053)
SHFTAD	SHFTAB			/ADDRESS OF SHIFT INSTRUCTION (BR-053)
SHFTAB	LRS	14		/FIRST CHAR (BR-053)
	LRS	6		/SECOND CHAR (BR-053)
	NOP			/THIRD CHAR (BR-053)
	LLS	6		/FOURTH CHAR (BR-053)
	LLS	14		/FIFTH CHAR (BR-053)
	LLS	22		/SIXTH CHAR (BR-053)
ANSCNT	0			/CHAR SENT COUNTER (BR-053)
	.EJECT
/
/	SUBROUTINE TO PRINT NUMBER 
/
NUMBER	0
PNUM	0
	JMS	OUT
	.SIXBT	'>@>("<@'
	LAC	NEGFLG		/WAS THE NUMBER NEGATED ON INPUT
	SNA
	JMP	PNUM1		/NO; DO NOT OUTPUT EVER AS NEGATIVE
	LAC	NUMBER		/YES; IS NUMBER NEGATIVE?
	SPA
	JMP	PNUM2		/YES; OUTPUT AS SIGNED NEGATIVE #
	LAW	55		/NO; OUTPUT AS POSITIVE # PRECEEDED 
	JMS	KLPUT		/BY MINUS SIGN
	LAC	NUMBER
	TCA	
	JMP	PNUM3
PNUM1	LAC	NUMBER		/IS # NEGATIVE NOW
	SMA
	JMP	PNUM3		/NO; OUTPUT WITH ZERO SUPRESSION
	JMS	NUMOUT		/YES; OUTPUT WITHOUT ZERO SUPRESSION
	SKP
PNUM2	JMS	SOCT		/OUTPUT AS SIGNED OCTAL # WITH ZERO SUP
	SKP
PNUM3	JMS	NUMSUP
	JMS	OUT
	.SIXBT	'" <@'
	JMP*	PNUM
	.EJECT
/
/	TEMPORARY STORAGE
/
KLGET5	0
KLWD1	0
KLWD2	0
KLWD3	0
KLWD4	0
OP	0			/CURRENT OPERATOR IN EXPRESSION
ANS1	0			/POINTER TO WORD IN ANSWER RECEIVING CHARACTERS
NEGFLG	0			/0 WHEN # BEING ACCUMULATED WAS NOT PRECEEDED
				/BY A MINUS SIGN
NUMFLG	0			/0 WHEN SYLABLE CURRENTLY BEING FORMED IS OCTAL #
OPFLG	0			/0 WHEN CURRENT SYLABLE MUST END WITH CAR. RET.
				/OR ALT MODE
OPFLGS	0			/TEMPORARY STORAGE OF OPFLG IN MULTILINE SEQUENCE
BADSYN	0			/CONTAINS PC FOR BAD SYNTAX RETURNS FROM ANSWER
				/ROUTINES
ANSP1	0
CNTCHR	0			/ACCUMULATOR FOR # OF CHARACTERS IN SYLLABLE
CNTDIG	0			/ACCUMULATOR FOR # OF OCTAL DIGITS IN #
SIXTMP	0			/COUNTER
SAVAC	0			/SAVE LOCATION FOR AC
/
/	SUBROUTINE TO GIVE A CARRIAGE RETURN LINE FEED ON TELETYPE
/IF I/O SUPRESSION IS NOT IN FORCE
/
CRLF	XX
	JMS	IOSUP
	JMP*	CRLF		/EXIT IF I/O SUPRESSION
	CAL	775		/.INIT -3
	1
CNTLP	XX			/CONTROL P ADDRESS
	0
	.WAIT	-3
	JMP*	CRLF
	.EJECT
/
/	SUBROUTINE TO CHECK FOR I/O SUPRESSION.  AC,L NOT TOUCHED
/	JMS	IOSUP
/
IOSUP	XX
IOSEG	SKP			/NOP IF SUPRESSION ON A SEGMENT
	JMP*	IOSUP
IOSEC	SKP			/NOP IF SUPRESSION ON A SECTION BASIS
	JMP*	IOSUP
	ISZ	IOSUP
	JMP*	IOSUP
/
/	TERMINAL ERROR ROUTINE
/
TERMER	0
	JMS	RIOSUP		/LIFT I/O SUPRESSION ON TERMINAL ERROR
	JMS	OUTP		/OUTPUT ERROR MESSAGE ARGUMENT
	LAC	TERMER		/POINTED TO BY ROUTINE
	JMS	OUT
	.SIXBT	' ABORT_<@'
ENDGEN	.INIT	-14,0,0
	.FSTAT	-14,A1
	SNA
	JMP	TERM1		/FILE NOT PRESENT
	.DLETE	-14,A1
TERM1	.EXIT
	.EJECT
/
/	RECOVERABLE ERROR
/	JMS	RERR
/	.SIXBT	'MESSAGE<@'
/
RERR	0
	LAC	NUMFLG		/IS IT #
	SNA
	JMP	.+3		/YES; NUMBER
	JMS	PANS		/SYMBOL
	SKP
	JMS	PNUM
	JMS	OUTP		/PRINT ERROR MESSAGE
	LAC	RERR
	JMS	OUT		/PRINT ENDING
	.SIXBT	')<@'
	JMP*	BADSYN		/GO BACK TO SYNTAX EXIT
/	REMOVE I/O SUPRESSION
/
RIOSUP	0
	LAC	(SKP
	DAC	IOSEG
	DAC	IOSEC
	JMP*	RIOSUP
/
	.TITLE	BUFFERS
	.LTORG
PATCH	.BLOCK	50		/PATCH AREA
TYOBUF	23000			/OUTPUT BUFFER
	0
TYIBUF=.+44
	.TITLE	SGNBLK
/
/	THIS SECTION IS NOT PART OF THE CORE IMAGE.  IT DEFINES
/THE LOCATION OF SGNBLK AND VARIOUS PARAMETERS IN IT.
/SGNBLK IS NEVER IN CORE THE SAME TIME AS SYSBLK-COMBLK AND
/IT OCUPIES THE SAME CORE LOCATIONS.
/
SGNBLK=TYIBUF+50	/END OF I/O DEVICE TABLE
NOPAR=SGNBLK+1		/# OF SYSTEM PARAMETERS
NODAT=SGNBLK+2		/# OF .DAT SLOTS * 2
NOSKP=SGNBLK+3		/# OF SKIPS IN SKIP CHAIN
SDEV1=SGNBLK+4		/SYSTEM DEVICE CODE
SCOM4=SGNBLK+5		/.SCOM+4 DEFAULT CONTENTS
SCOM20=SGNBLK+6		/.SCOM+20 DEFAULT CONTENTS
X1=SGNBLK+7		/# WORDS/FILES BUFFER
FILES=SGNBLK+10		/DEFAULT BUFFS COMMAND FOR LINKING LOADER AND
			/EXECUT
MIC=SGNBLK+11		/MONITOR IDENTIFICATION CODE
SCOM33=SGNBLK+12	/CONTENTS OF .SCOM+33
PROTCT=SGNBLK+13	/DEFAULT FILES PROTECTION CODE (.SCOM+54)
PCHSZ=SGNBLK+14		/SIZE OF RESIDENT MONITOR PATCH AREA
CLKCON=SGNBLK+15	/-# OF TICKS IN SECOND
/
/(GAR-058)	DELETED UNUSED DIRECT ASSIGNMENTS:
/(GAR-058)		SCOM76=SGNBLK+16
/(GAR-058)		SCOM77=SGNBLK+17
/
	.TITLE	SYSBLK-COMBLK
/
/	THIS TABLE CONTAINS SYSBLK-COMBLK.  IT OVERLAPS SGNBLK
/TABLE AS THEY NEVER COEXIST IN CORE.
/
SYSBLK=SGNBLK		/POINTER TO FIRST FREE WORD IN SYSBLK
E1=SYSBLK+1
E2=E1+7
E3=E2+7
QBLK=E3+2		/FIRST BLOCK OF ^Q AREA
QSZE=E3+5		/SIZE IN WORDS OF ^Q AREA
COMBLK=SYSBLK+777	/POINTER TO FIRST WORD OF COMBLK
ENDCOM=COMBLK
	.TITLE	SAT
/
/	THIS IS THE BUFFER FOR THE STORAGE ALLOCATION TABLE
/
SAT=SGNBLK+1000
SATND=SAT+400		/SATND SHOULD EQUAL 17637
	.IFDEF	BIN
	.LOC	SATND
	.ENDC
/
	.END	START
