	.TITLE	XVM/DOS:UC-15 SPOOLER INITIATION ROUTINE - 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
/
/
/COPYRIGHT 1974,75 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/	.DAT SLOT -14 MUST BE ASSIGNED TO THE SYSTEM DEVICE
/
/	PARAMETER ASSIGNMENTS:
/	DEFINE BIN=0 FOR LINKING LOADER BINARY
BIN=0
/
.SCOM=100				/SYSTEM COMMUNICATION TABLE
SIOA=706001				/UC15 SKIP INSTR.
LIOR=706006				/UC15 SEND TCB INSTR.
	.IFDEF	BIN
	.IODEV	-14
	.ENDC
/	EDITS	1-154	SK	THRU 1-AUG-74	OLD VERSION-DISCARDED
/	EDIT	155	BLR	16-DEC-74	PUT DISK BUFFER INTO COMMON MEMORY
/	EDIT	156	BLR	22-DEC-74	CLEAN UP DEFAULT RK AND MESSAGES
/	EDIT	157	BLR	29-DEC-74	FIX MISTYPE IN RTRANO AND COMMENT
/	EDIT	158	BLR	7-JAN-75	FIX BAD ERROR MESSAGE IN YES/NO
/	EDIT	159	BLR	18-JUN-75	XVM UPGRADE
/	EDIT	160	BLR	19-JUL-75	CHECK FOR DISK ON .DAT-14
/	EDIT	161	BLR	18-AUG-75	FIX SPLSIZ BUG
/	EDIT	162	MJH	20-AUG-75	DISCLAIMER
/	EDIT	163	BLR	09-NOV-75	FIX NON SYS DISK BUG
/	EDIT	164	BLR	30-NOV-75	FIX UNIT # IN NO SP AREA MSG
/
/
/		SPOL15 (SPOOL) IS USED TO LOAD THE SPOOLER (SPOL11) FROM THE
/	SYSTEMS DEVICE (RK0 OR DK0 OR DP0) AND CONNECT IT TO PIREX AFTER
/	MOVING IT INTO LOCAL PDP 11 MEMORY. IT IS ALSO USED TO DISCONNECT THE
/	SPOOLER FROM PIREX AND TERMINATE SPOOLING.
/		SPOL15 (SPOOL) DETERMINES IF THE SPOOLER IS RUNNING. IF
/	THE SPOOLER IS RUNNING THEN SPOL15 ASKS "END" . IF THE REPLY IS YES
/	THEN A TERMINATE SPOOLING DIRECTIVE IS SENT AND THE SPOOLER IS DISABLED.
/	IF THE SPOOLER IS NOT RUNNING THEN SPOL15 ASKS ON WHICH RK DRIVE
/	THE USER WISHES TO BEGIN SPOOLING. SPOOLING MAY BE DONE ON ANY RK UNIT
/	THAT HAS A CARTRIDGE THAT HAS BEEN INITIALIZED WITH A SPOOLER AREA
/	BY THE SPLGEN PROGRAM.IF THE CARTRIDGE HAS A SPOOLER AREA AND
/	IF THERE IS ROOM IN THE PDP-11 LOCAL MEMORY-THEN THE SPOOLER
/	IS READ FROM THE SYSTEM DISK (DP0,DF0,RK0) AND TRANSFERED INTO LOCAL 
/	11 - MEMORY AND STARTED.NOTE THE QUESTIONS "RK UNIT #" AND "BEGIN"
/	MUST BE ANSWERED DURING THIS PROCESS.
/		NOTE THAT ALL QUESTIONS HAVE DISPLAYED DEFAULT REPLIES
/	,THESE REPLIES MAY BE SELECTED BY ENTERING A CARRIAGE RETURN.
/	THE OPTIONS ON YES/NO QUESTIONS ARE "Y" OR "N".
/	THE DEFAULT VALUE FOR THE RK UNIT IS THE UNIT UPON WHICH SPOOLING
/	WAS DONE PREVIOUSLY (OR UNIT 0 IF PIREX WAS JUST LOADED).
/
/
/
	.TITLE	INITIALIZATION
/
/
/
START	JMS	SECTN		/IDENTIFY ITSELF; STATE VERSION; SET ^P
	.SIXBT	'SPOOL XVM V1A000_<@'
	LAC*	(.SCOM+4	/GET ENABLE WORD (BR-159)
	AND	(000002		/TEST FOR UC15 ENABLE (BR-159)
	SZA			/SKIP IF NOT ENABLED (BR-159)
	JMP	GUIC		/ENABLED-CONTINUE (BR-159)
	JMS	TERMER		/FATAL ERROR-UC15 NOT ENABLED (BR-159)
	.SIXBT	'_>UC15 NOT ENABLED<@'
GUIC	LAC*	(.SCOM+100	/GET TCB TABLE ADDR.
	IAC			/POINT TO SECOND ITEM IN TABLE
	DAC	TCB#	/SAVE IT
	LAC*	TCB	/GET RK TCB POINTER
	SNA		/TEST FOR EXISTANCE OF TCB ENTRY
	JMP	NOTCB	/NO ENTRY - VERY FATAL ERROR -GOODBY
	DAC	TCB	/SAVE IT
	AAC	2		/GET EV POINTER
	DAC	EV#	/SAVE EV POINTER
	AAC	2	/COMPUTE SPLSW POINTER
	DAC	SPLSW#	/AND SAVE IT
LMSZ=SPLSW
	IAC		/POINT TO FIRST FREE LOC VALUE VIA CORTCB
	DAC	FADR#	/SAVE IT IN BSPTCB
	AAC	2	/COMPUTE SPUNIT POINTER
	DAC	SPUNIT#	/AND SAVE IT
FREEWD=SPUNIT
	IAC		/COMPUTE RKCS POINTER
	DAC	RKCS#	/AND SAVE IT
	IAC		/COMPUTE RKER POINTER
	DAC	RKER#	/AND SAVE IT
	IAC		/COMPUTE RKDS POINTER
	DAC	RKDS#	/AND SAVE IT
	LAC*	(.SCOM+2	/GET FIRST FREE LOC POINTER
	DAC	MOVBLK#		/SAVE IT FOR DISK BUFF PTR.
	IAC			/POINT TO SECOND WORD IN BUFFER
	DAC	MOVB1#		/SAVE POINTER
	TAD	(-37401		/TEST TO SEE IF ENTIRE BUFFER WILL FIT INTO
				/COMMON MEMORY (12 UC15 - WORST CASE)
	SMA			/SKIP IF OK
	JMP	BADBUF		/WONT FIT - DOS TOO BIG ???????
	.INIT	-14,0,0		/SET UP SKIP CHAIN ETC.
DEVICE=.-1			/BUFFER SIZE INDICATES DEVICE TYPE (BR-160)
	LAC	DEVICE		/GET BUFFER SIZE (BR-160)
	SAD	(376		/SKIP IF NOT A DISK (BR-160)
	JMP	GUIC1		/IT IS A DISK - CONTINUE (BR-160)
	JMS	TERMER		/NOT A DISK ON .DAT-14 - ERROR (BR-160)
	.SIXBT	'_>.DAT -14 DEVICE IS NOT A DISK<@'	/(BR-160)
GUIC1	LAC	(SPTCB	/GET ADR OF SPLR. STATUS TCB (BR-160)
	DAC	TASK#		/SET UP MOVE CALL
	LAW	-10		/SIZE OF SP TCB
	JMS	MOVTCB		/MOVE TCB TO MONITOR REGION
	JMS	TCBIO		/SEND TCB TO PIREX
	JMP	SDER		/ERROR RETURN - SOFTWARE DIR. FAILURE
	LAC*	SPLSW		/GET SPOLSW
	AND	(100000		/TEST FOR ACTIVE SPOOLER
	SZA			/SKIP IF SPOOLER NOT ACTIVE
	JMP	ENDSPL		/JUMP TO END SPOOLING ROUTINE
	LAC*	SPUNIT		/GET CURRENT SPOOLER UNIT
	DAC	RKUN#		/SAVE IT (BR-156)
	JMS	BINSBK		/BRING IN SYSBLK
	LAC	(SPLNAM		/GET ADR. OF SPOOL NAME
	JMS	FSYSK		/IS IT IN SYSBLK
	JMP	MSNGSB		/NO - GIVE FATAL ERROR
	AAC	2		/POINT TO FB
	DAC	TEMP		/SAVE POINTER
	LAC*	TEMP		/GET FB
	AAC	20	/POINT TO FIRST BLOCK OF SPOL11 CODE
	DAC	FB#	/SAVE VALUE
	JMS	TRANIN	/GET FIRST BLOCK
	LAC	MOVBLK		/GET BUFFER ADR.
	LAC*	MOVBLK	/GET SIZE OF SPOOLER (IN WORDS)
	SNA		/SKIP IF THERE IS AT LEAST A V3B VERSION OF
			/SPOL11 THERE (1 ST WORD NEQ 0)
	JMP	BADVER	/OLD VERSION - FATAL ERROR - SAY SO AND EXIT
	DAC	SIZE#	/STORE IT
	RCL		/DOUBLE IT
	DAC	LEN	/AND STORE ITIN CONTCB
	LAC*	MOVB1	/GET STARTING ADR OFFSET OF SPOOLER
	DAC	EPT		/SAVE IT 
	LAC	(CORTCB	/LOAD ADR OF CORE STATUS TCB
	DAC	TASK	/SET UP TCB CALL
	LAW	-10	/SIZE OF CORE STATUS TCB
	JMS	MOVTCB	/MOVE TCB INTO DOS MONITOR AREA
	JMS	TCBIO	/SEND TCB TO PIREX
	JMP	SDER	/ERROR - BAD SOFTWARE DIRECTIVE
	LAC	MOVBLK	/GET BUFFER ADR.
	RCL		/MAKE BYTE ADR.
	TAD*	LMSZ	/COMPUTE BYTE ADR. OF FROM BUFFER
	DAC	FROM	/PUT INTO MOVE TCB
	LAC*	FADR	/GET FIRST FREE ADR. IN 11
	DAC	FA	/PUT IN BSPTCB AS FIRST LOC OF SPOOLER (BR-161)
	DAC	TO	/PUT IN MOVE TCB AS STARTING ADR OF MOVE (BR-161)
	AND	(000001	/WAS FIRST ADR ODD (BR-161)
	SNA		/SKIP IF ODD (BR-160)
	JMP	GUIC.2	/NOT ODD-CONTINUE (BR-161)
	ISZ	LEN	/INC. LENGTH BY 1 EXTRA BYTE (BR-161)
	ISZ	TO	/INC. TO BY ONE BYTE-MOVE EVEN TO EVEN (BR-161)
GUIC.2	LAC	TO	/GET "TO" ADR. (BR-161)
	TAD	EPT	/COMPUTE ENTRY ADR. (BR-161)
	DAC	EPT	/SAVE (BR-161)
	LAC*	FREEWD	/GET ACTUAL NUMBER OF AVAILABLE 11 WDS. LEFT
	TCA		/NEGATE
	TAD	SIZE	/ADD SPOOLER SIZE TO TEST FOR ENOUGH ROOM
	SMA		/SKIP IF ENOUGH ROOM
	JMP	NOROOM	/FATAL - IF SPOOLER WONT FIT
	.TITLE	RK UNIT SELECTION
RKDSK	JMS	QUERY	/ASK FOR UNIT #
	.SIXBT	'RK UNIT # [<@'
	LAC	RKUN	/DEFAULT TO PREVIOUS SPOOLER DISK (BR-156)
	DAC	RKUNIT	/SAVE IT IN RKIO WORD (BR-156)
	DAC	NUMBER	/SAVE IT - FOR RETRY (BR-156)
	JMS	NUMSUP	/SUPRESS LEADING ZEROS
	JMS	OUT	/TYPE REST OF QUESTION
	.SIXBT	'] <@'	/BRACKET
	CLA		/ANS MUST TERM. WITH CR OR ALT
	JMS	ANS	/GET ANS
	JMP	RKDSK	/BAD SYNTAX
	JMP	A.2	/DEFAULT ANS
	JMP	ALTBAD	/ALT ONLY-IS BAD
	JMP	SYMBAD	/SYMBOL IS BAD
	SPA		/RANGE TEST (0-7) ONLY
	JMP	RANGE	/RANGE ERROR
	TAD	(-10)	/UPPER BOUND IS 7
	SMA		/TEST
	JMP	RANGE	/BAD
	LAC	NUMBER	/GET ANS
	DAC	RKUNIT	/SAVE IT
A.2	LAC	LRK	/SAVE  RK MNEMONIC
	DAC	LITDEV
DOMFD	LAC	RKMFD	/GET BLOCK '1777'
	JMS	RTRANI		/SUBROUTINE TO .TRAN INTO CORE 
	LAC	(MFD		/FIRST ADDRESS OF CORE BUFFER IS MFD
	LAC	MFD+374		/GET SPOOLER AREA SIZE FROM MFD
	AND	(177777		/CLEAR OUT CHECK BITS
	DAC	TEMP		/SAVE
	LAC	MFD+375		/GET SPOOLER AREA START BLOCK #
	AND	(177777		/CLEAR OUT CHECK BITS
	TAD	TEMP		/COMPUTE CHECK BITS - FOR VALIDITY CHECK
	IAC			/SO THAT 0 DOESNT VERIFY
	AND	(17		/CLEAR OUT UNWANTED BITS
	DAC	TEMP		/SAVE COMPUTED VALUE
	LAC	MFD+374		/GET SPOOLER AREA SIZE
	CLL			/CLEAR LINK FOR SHIFTS
	LRS	20		/GET CHECK BITS
	PAL			/SAVE THEM
	LAC	MFD+375		/GET SPOOLER AREA BLOCK #
	LRS	22		/SHIFT CHECK BITS INTO MQ
	PLA			/GET OTHER CHECK BITS
	LLS	2		/FORM 4 BIT CHECK SUM
	SAD	TEMP		/DO THE CHECK BITS VERIFY ?
	SKP			/YES - SKIP
	DZM	MFD+374		/ZAP SIZE - SO THAT SIZE QUESTION
				/PRINTOUT WILL BE CORRECT
	LAC	MFD+374		/GET VALUE OF SIZE
	AND	(177777		/CLEAR OUT POSSIBLE CHECK BITS
	DAC	SPSIZ		/SAVE IT
	LAC	MFD+375		/GET STARTING BLOCK #
	AND	(177777		/CLEAR OUT CHECK BITS
	DAC	SPSTRT		/SAVE IT
	LAC	SPSIZ		/GET SIZE OF SPOOLER AREA
	SNA			/SKIP IF THERE IS ONE
	JMP	NODSK		/NO AREA - RETRY FOR ANOTHER UNIT ?
	.TITLE	START SPOOLER
SBEGIN	JMS	QUERY		/ASK FOR BEGIN - YES OR NO
	.SIXBT	'BEGIN <@'
	JMS	YES		/GET ANS. - DEFAULT YES
	JMP	SBEGIN		/BAD SYNTAX
	JMP	ALTBAD		/DITTO
	JMP	SILLY		/NO MEANS DO NOTHING
LOOP	LAC	(400		/AMOUNT TO MOVE
LOOP1	DAC	WDCNT		/STORE IN MOVE TCB
	LAC	(MVTCB		/SET UP MOVE TCB
	DAC	TASK		/TO MOVE SPOOLER INTO PDP 11
	LAW	-7		/TCB SIZE IS 7
	JMS	MOVTCB		/MOVE TCB INTO DOS MONITOR AREA
	JMS	TCBIO		/SEND TCB TO PIREX
	JMP	SDER		/BAD SOFTWARE DIRECTIVE
	LAC	SIZE		/TEST FOR OUT OF WORDS TO MOVE
	SPA!SNA			/SKIP IF ANY LEFT
	JMP	CNCT		/DONE - GO FINISH UP
	ISZ	FB		/POINT TO NEXT DISK BLOCK
	LAC	FB		/GET BLOCK NUMBER
	JMS	TRANIN		/TRAN IN NEXT BATCH OF SPOOLER CODE
	LAC	MOVBLK		/POINT TO BUFFER FOR TRAN.
	LAC	TO		/GET TO MOVE ADR.
	TAD	(1000		/ADD 1000 BYTES
	DAC	TO		/PUT IT BACK IN MOVE TCB
	LAC	SIZE		/GET SPOOLER SIZE IN WORDS
	TAD	(-400		/SUBTRACT ONE BLOCK FROM REMAINING SIZE
	DAC	SIZE		/SAVE IT
	SMA			/LESS THAN 400 WORDS LEFT ?
	JMP	LOOP		/NO - MOVE 400 WORDS
	LAC	SIZE		/YES - MOVE SIZE WORDS
	TAD	(400		/MAKE IT POSITIVE AND CORRECT
	JMP	LOOP1		/THEN GO MOVE IT
CNCT	LAC	(CONTCB		/GET ADR. OF CONNECT TCB
	DAC	TASK		/SET UP TCB MOVE
	LAW	-11		/GET TCB SIZE
	JMS	MOVTCB		/MOVE TCB INTO DOS MONITOR AREA
	JMS	TCBIO		/SEND TCB TO PIREX
	JMP	SDER		/SOFTWARE DIRECTIVE ERROR RETURN
	LAC	(BSPTCB		/GET BSPTCB ADR.
	DAC	TASK		/SET UP TCB MOCE
	LAW	-11		/SIZE OF BEGIN SPOOLING TCB
	JMS	MOVTCB		/MOVE TCB INTO DOS MONITOR AREA
	JMS	TCBIO		/SEND BSPTCB TO PIREX
	JMP	SPDER		/SPOOLER TCB ERROR RETURN
	JMS	OUT		/DONE - SAY SO
	.SIXBT	'_>SPOOLING ENABLED_<@''
	JMP	TERM1		/EXIT
	.TITLE	END SPOOLING
ENDSPL	JMS	QUERY	/ASK END ?
	.SIXBT	'END <@'
	JMS	YES		/GET REPLY - DEFAULT IS YES
	JMP	ENDSPL		/SYNTAX ERROR - RETRY
	JMP	ALTBAD		/ALT NOT ALLOWED
	JMP	SILLY		/NO ACTION DESIRED
	LAC	(ESPTCB		/GET ADR. OF END SPOOLING TCB
	DAC	TASK		/SET UP MOVE
	LAW	-4		/GET SIZE OF TCB
	JMS	MOVTCB		/MOVE TCB INTO DOS AREA
	JMS	TCBIO		/SEND TCB TO PIREX
	JMP	SPDER		/ERROR - SPOOLER DIRECTIVE FAILURE
	JMS	OUT		/SAY GOODBY
	.SIXBT	'_>SPOOLING DISABLED_<@'
	.TITLE	ERROR MESSAGES
	JMP	TERM1		/EXIT
SPDER	JMS TERMER		/SPOOLER SOFTWARE DIRECTIVE FAILURE
	.SIXBT	'_>SPOOLER TCB ERROR<@'
SILLY	JMS	OUT	/SAY NOTHING DONE
	.SIXBT	'_>NO ACTION TAKEN_<@'
	JMP	TERM1		/EXIT
NODSK	LAC	RKUNIT		/GET OFFENDING UNIT # (BR-163)
	DAC	NUMBER		/SET UP ERROR MESSAGE WITH # (BR-163)
	JMS	RERR		/SAY NO SPOOLER AREA ON DISK (BR-163)
	.SIXBT	'HAS NO SPOOLER AREA <@'
NOROOM	JMS	TERMER		/SAY NO ROOM TO FIT SPOOL11
	.SIXBT	'INSUFFICIENT FREE LOCAL-11 MEMORY TO LOAD SPOOLER<@'
BADVER	JMS	TERMER		/VERSION OF SPOL11 NOT AT LEAST V3B000 DOS
	.SIXBT	'_>SPOL11 VERSION NOT AT LEAST DOS-15 V3B000<@'
BADBUF	JMS	TERMER	/DISK BUFF WONT FIT IN COMMON MEMORY
	.SIXBT	'>DISK BUFFER - NOT IN COMMON MEMORY<@'
	.EJECT
BADDEV	JMS	TERMER	/FATAL ERROR;INTEGRITY OF DAT -14
	.SIXBT	'>.DAT -14 SYSTEM FAILURE<@'	/IN DOUBT
	.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
	TAD	(2
	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	DISK I/O ROUTINES
/
/	STD. DISK I/O IN SPOL15 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
/
/
/
/	ALL RK SPOOLER ORRIENTED I/O USES DIRECT TCBS TO DO THE
/	RK DISK I/O. THIS SUBROUTINE SET PROVIDES VERY LIMITED
/	ERROR DETECTION AND CORRECTION.
/
/	ONLY WRITE PROTECT AND NON-EXISTENT DRIVE ERRORS ARE
/	RECOVERABLE - ALL OTER ERRORS ARE FATAL !
/
/	THE CALLING SEQUENCE IS IDENTICAL TO THAT OF THE STANDARD
/	DISK ROUTINES WITH RTRANI REPLACING TRANIN AND
/	RTRANO REPLACING TRANOT
/
/
RTRANI	0		/ENTRY POINT
	DAC	RBLKN	/STORE BLOCK NR IN TCB
	CLA!CLL		/CLEAR AC AND LINK
	AAC	4	/SET UP READ FCN.
	DAC	RFCN	/SAVE IN TCB
	XCT*	RTRANI	/PICK UP ADR. OF BUFFER
	JMS	RKIO	/DO THE I/O
	JMP*	RTRANI	/IF NO ERROR - RETURN TO CALLER
/
/
/
RTRANO	0		/ENTRY POINT
	DAC	RBLKN	/STORE BLOCK NR IN TCB
	CLA!CLL		/CLEAR AC AND LINK
	AAC	2	/SET UP WRITE FCN.
	DAC	RFCN	/SAVE IN TCB
	XCT*	RTRANO	/PICK UP ADR. OF BUFFER (BR-157)
	JMS	RKIO	/DO THE I/O
	JMP*	RTRANO	/IF NO ERROR - RETURN TO CALLER
/
/
/
RKIO	0		/ENTRY POINT OF RK DIRECT I/O VIA TCB HANDLER
	DAC	RKLSA	/STORE LSB OF BUFFER ADR. IN TCB
	LRS	20	/GET MSB OF BUFFER ADR.
	DAC	RKMSA	/STORE IN TCB
	LAC	RKUNIT	/GET UNIT NR.
	ALS	10	/POSITION IT
	TAD	RFCN	/ADD FUNCTION
	DAC	RFCN	/STORE IN TCB
	LAC	(RKTCB	/GET TCB ADR.
	DAC	TASK	/SET UP MOVE
	LAW	-13	/GET SIZE OF TCB
	JMS	MOVTCB	/MOVE TCB INTO DOS MONITOR BUFFER
	JMS	TCBIO	/SEND IT TO THE UC15
	NOP		/PIREX INDICATES ERRORS IN TCB - NOT VIA EV -WHEN
			/DOING DISK I/O
	LAC*	RKDS	/CHECK FOR WRITE PROTECTED DRIVE (BR-12)
	AND	(40	/BIT 5 IS WRITE PROT SW. STATUS (BR-12)
	SZA		/SKIP IF NOT WRITE PROTECTED (BR-12)
	JMP	WRTLK	/DRIVE PROTECTED - DO SOMETHING (BR-12)
	LAC*	RKCS	/GET RETURNED CONTROL REGISTER VALUE
	AND	(100000	/TEST FOR ANY ERROR
	SNA		/SKIP IF ERROR
	JMP*	RKIO	/OK - RETURN TO CALLER
	LAC*	RKER	/GET RK ERROR REGISTER COPY
	AND	(20000	/TEST FOR WRITE PROTECTED DRIVE
	SZA		/SKIP IF DRIVE NOT WRITE PROTECTED
	JMP	WRTLK	/DRIVE PROTECTED - DO SOMETHING
	LAC*	RKER	/GET RK ERROR REGISTER COPY
	AND	(200	/TEST FOR POSSIBLE NONEXISTENT DRIVE
	SZA		/SKIP IF DRIVE EXISTS
	JMP	NERK	/GO SEE IF IT REALY EXISTS
HDER	JMS	TERMER	/FATAL ERROR - SAY SO AND EXIT
	.SIXBT	'>FATAL RK DISK ERROR<@'
WRTLK	JMS	RESET	/CLEAN UP MESS
	JMS	RERR	/SAY WRITE PROTECTED AND RECOVER
	.SIXBT	'IS A WRITE PROTECTED UNIT<@'
NERK	LAC*	RKDS	/GET COPY OF RKDS
	AND	(4000	/TEST FOR RK05 DRIVE
	SZA		/SKIP IF NON-EXISTENT DRIVE
	JMP	HDER	/DRIVE EXISTS - HARD ERROR
	JMS	RESET	/CLEAN UP MESS
	JMP	RANGE	/AND GIVE RECOVERABLE ERROR MESSAGE
/
/
/
RESET	0		/ENTRY POINT
	LAC	RKUNIT	/GET UNIT NR. FOR ERROR MESSAGES
	DAC	NUMBER	/AND STORE IT
	LAC	(GUIC	/GET RECOVERY ADDRESS
	DAC	BADSYN	/AND STORE IT
	-3&777		/INIT .DAT -3 (TTY) FOR VECTORED CONTROL P,C
	1		/DITTO
	200000+TERM1	/DITTO
	0		/DITTO
	JMP*	RESET
/
/
/
	.TITLE	TABLE SEARCH ROUTINES
/
/
/
/	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
/
SPLNAM	.SIXBT	'SPOOL@'	/SPOL11
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
	DAC	TEMP		/AND SAVE POINTER (BR-163)
	LAC*	TEMP		/GET WORD 1 OF SYSBLK (BR-163)
	SAD	(220523		/IS IT "RES" (BR-163)
	SKP			/SKIP IF "RES" THUS SYSBLK (BR-163)
	JMP	MSNSYS		/NOT SYSBLK - GIVE FATAL ERROR (BR-163)
	LAC	TEMP		/GET SYSBLK+1 POINTER (BR-163)
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
	TAD	(7		/7 WORD ENTRIES
	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
/
/	ROUTINES TO BRING IN SYSBLK-COMBLK AND SGNBLK
/
/	BRING IN SYSBLK
/	JMS	BINSBK
/			/RETURN
/
BINSBK	XX
	LAC	(34		/DUMMY SYSBLK
	JMS	TRANIN		/.TRAN IN
	LAC	(SYSBLK
	LAC	(35		/COMBLK
	JMS	TRANIN
	LAC	(SYSBLK+400
	LAC	(SYSBLK
	TAD	SYSBLK
	DAC	ENDSYS		/FIRST FREE WORD IN SYSBLK
	LAC	(SYSBLK
	JMP*	BINSBK
/
/	PUT OUT SYSBLK
/	JMS	POTSBK
/			/RETURN
	.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
RKMFD	1777			/BLOCK # OF RK MASTER FILE DIRECTORY
DPMFD	47040			/BLOCK # OF DP MASTER FILE DIRECTORY
MFDABP	XX			/POINTER TO LIST OF MFD BLOCKS IN 
				/FREE CORE
BTABP	XX			/POINTER TO MFD BLOCK LIST IN CORE(DUMMY)
NOMFDB	XX			/# OF MFD 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
LRK	.SIXBT	'RK'
LDONE	.SIXBT	'DONE'
	.EJECT
/
	.TITLE	YES, NO, AND $ ANSWER ROUTINES
/
/	THE YES NO TYPE OF QUESTION IN SPOL15 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. SPOL15 OPERATING MANUAL).  MANY YES NO QUESTIONS
/IN SPOL15 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.)<@'	/(BR-158)
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?
	NOP			/THIS PART OF SPOL15 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
	TAD	(-7		/IS THE NUMBER OF CHARACTERS 7
	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?
	TAD	(-7
	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
	TAD	(-7		/TOO MANY DIGITS
	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 #<@"
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
SDER	JMS	TERMER		/ANNOUNCE FATAL SOFTWARE DIRECTIVE TCB ERROR
	.SIXBT	'>FATAL TCB ERROR ON SOFTWARE DIRECTIVE<@'
NOTCB	JMS	TERMER	/ANNOUNCE NO TCB FOR PIREX /SPOL15 USE
	.SIXBT	'>FATAL ERROR - DOS LACKS TCB AREA FOR SPOL15 USE<@'
RANGE	JMS	RERR		/RECOVERABLE ERROR - UNIT NR. OUT OF RANGE
	.SIXBT	'NON-EXISTENT RK UNIT # <@'
MSNGSB	JMS	TERMER	/SPOOL NOT IN SYSBLK - FATAL ERROR
	.SIXBT	'>SPOOL NOT ON .DAT -14 DEVICE<@'
MSNSYS	JMS	TERMER	/.DAT-14 NOT SYSTEM DISK (BR-163)
	.SIXBT	'>.DAT-14 NOT SYSTEM DISK<@'
	.TITLE	SMALL SUBROUTINES
/
/
/
/	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 PRINT SYMBOL IN ANSWER
/	JMS	PANS
/
PANS	0
	JMS	OUT
	.SIXBT	'>@>("'
ANSWER	0
	0
	.SIXBT	'" <@'
	JMP*	PANS
	.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
/
P1	0			/TEMP. LOC.
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_<@'
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
/
/
/	SUBROUTINE TO MOVE TCB FROM SPOL15 TO DOS MONITOR TCB AREA
/	CALL SEQUENCE:
/			LAC	(XXXX	/WHERE XXXX IS TCB ADR.
/			DAC	TASK
/			LAW	-NNN	/WHERE NNN IS THE SIZE OF THE TCB
/			JMS	MOVTCB
/
/
/	RETURN IS TO LOCATION FOLLOWING   JMS   MOVTCB
/
/
MOVTCB	0		/ENTRY POINT
	DAC	SIZ#	/SAVE -SIZE
	LAC	TCB	/GET DOS RK TCB SLOT ADR.
	DAC	TCBX#	/SAVE IT IN A TEMP
	LAC	TASK	/GET START OF TCB TO BE MOVED
	DAC	TASKX#	/SAVE IT IN A TEMP
LOOPMV	LAC*	TASKX	/GET ITEM
	DAC*	TCBX	/MOVE IT
	ISZ	TASKX	/INC. POINTER
	ISZ	TCBX	/INC. POINTER
	ISZ	SIZ	/DONE YET?
	JMP	LOOPMV	/NO
	JMP*	MOVTCB	/YES - RETURN TO CALLER
/
/
/	SUBROUTINE TO SEND TCB TO UC15 PIREX SYSTEM
/	CALL SEQUENCE:
/			JMS	TCBIO
/
/
/	RETURN IS TO LOCATION FOLLOWING JMS TCBIO IF AN ERROR IS DETECTED
/
/	RETURN IS TO LOCATION+1 FOLLOWING JMS TCBIO IF NO ERROR OCCURS
/
/
TCBIO	0		/ENTRY POINT
TCBIO1	DZM*	EV	/CLEAR THE EVENT VARIABLE
	LAC	TCB	/GET THE ADR. OF THE DOS RK TCB AREA
LOOPTC	SIOA	/IS THE UC15 BUSY?
	JMP	LOOPTC	/YES - KEEP TRYING
	LIOR		/NO - SEND ADR. OF TCB TO PIREX
LOOPTB	LAC*	EV	/GET THE EVENT VARIABLE
	SNA		/HAS IT BEEN SET BY PIREX YET?
	JMP	LOOPTB	/NO - KEEP LOOKING
	SAD	(177001	/TEST FOR PIREX TEMP. OUT OF NODE CONDITION
	JMP	TCBIO1	/OUT OF NODES OCCURED - TRY AGAIN
	AND	(100000	/SET UP TEST FOR ERROR EV
	SZA		/SKIP IF NO ERROR
	JMP*	TCBIO	/RETURN AT ERROR EXIT
	ISZ	TCBIO	/INC. RETURN TO GOOD EXIT
	JMP*	TCBIO	/RETURN AT OK EXIT
/
/
	.TITLE	TCB'S
/
/
/	TCBS FOR PIREX CONTROL
/
/
/		TCB FOR SPOOLER INFORMATION
/
SPTCB	0		/NO API
	601		/NO INT.
	0		/EV
	2000		/ASK FOR SPOOLER INFO
	0		/SPLSW
	0		/DEVARE
	0		/DEVSPL
	0		/SPUNIT
/
/		TCB FOR RK DISK I/O
/
RKTCB	0		/NO API
	602		/NO INT.
	0		/EV
RBLKN	0		/BLOCK NUMBER
RKMSA	0		/REL+MSA
RKLSA	0		/LSA
	-400		/WORD COUNT
RFCN	2		/UNIT,FUNCTION (DEFAULT READ)
	0		/RKCS
	0		/RKER
	0		/RKDS
/
/		TCB FOR CORE STATUS REPORT
/
CORTCB	0		/NO API
	601		/NO INT.
	0		/EV
	1000		/ASK FOR CORE STATUS
	0		/LOC MEM SIZE - BYTES
	0		/FIRST FREE ADR. - BYTES
	0		/UNUSED
	0		/NR. OF FREE WORDS IN UC15
/
/		TCB FOR TASK CONNECT (SPOOLER)
/
CONTCB	0		/NO API
	601		/NO INT.
	0		/EV
	407		/ASK TO CONNECT TASK #7 (SPOOLER)
	100000		/TASK WILL BE UC15 RESIDENT
	0		/UNUSED
EPT	0		/TASK ENTRY POINT (STARTING ADR.) - BYTES
LEN	0		/TASK SIZE - BYTES
	0		/PRIORITY
/
/		TCB FOR MOVE DIRECTIVE
/
MVTCB	0		/NO API
	601		/NO INT.
	0		/EV
	2400		/ASK FOR MOVE DIRECTIVE
FROM	0		/FROM ADR. - BYTES
TO	0		/TO ADR. - BYTES
WDCNT	0		/WORDS TO MOVE
/
/		TCB FOR SPOOLER BEGIN DIRECTIVE
/
BSPTCB	0		/NO API
	607		/NO INT.
	0		/EV
	0		/ASK TO BEGIN
SPSTRT	0		/STARTING BLOCK OF SPOOLER AREA
SPSIZ	0		/SIZE OF SPOOLER AREA
FA	0		/FIRST LOCATION IN 11 CORE OF SPOOLER
RKUNIT	0		/UNIT TO SPOOL ONTO
/
/		TCB FOR SPOOLER END DIRECTIVE
/
ESPTCB	0		/NO API
	607		/NO INT.
	0		/EV
	4		/ASK TO END SPOOLING
/
/
/
	.TITLE	BUFFERS
	.LTORG
PATCH	.BLOCK	50		/PATCH AREA
TYOBUF	23000			/OUTPUT BUFFER
	0
TYIBUF=.+44
/
	.TITLE	SYSBLK-COMBLK
/
/	THIS TABLE CONTAINS SYSBLK-COMBLK.  IT OVERLAPS SGNBLK
/TABLE AS THEY NEVER COEXIST IN CORE.
/
SYSBLK=TYIBUF+50		/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	MFD
/
/	THIS IS THE BUFFER FOR THE STORAGE ALLOCATION TABLE
/
MFD=COMBLK+1
MFDND=MFD+400		/MFDND SHOULD EQUAL 17637
	.IFDEF	BIN
	.LOC	MFDND
	.ENDC
/
	.END	START
