Directory of image this file is from
This file as a plain text file

	FILE	MULTOS-8 MISCELLANEOUS
	TITLE	MISC EDIT NUMBER
*
*       The rights to this software were purchased in a group purchase
*       and the software is now in the public domain. It can be freely
*       copied.
*            AEROSPACE CORP.  
*            WALLY KALINOWSKI M2/276
*            P. O. BOX 92957
*            L. A. CALIFORNIA      90006
*                                            phone:  213 336-6940
*
*
*	Copyright (C) 1978, 1979 by Computer Methods
*					7822 Oakledge Road
*					Salt Lake City, UT 84121
*					Phone 801-942-2300
*
*	Unauthorized reproduction in whole or in part
*	by any means whatsoever without written authorization
*	from Computer Methods is strictly prohibited by law.
*
	FREE	1		FOR PATCHING
*
*EDIT	EQU	797		14 JUL 1978
*SPLIT THE SOURCE FILE INTO SEVERAL SMALLER FILES.
*OSD CONTAINS ALL REMAINING CODE (INITIALIZATION AND SPOOLER)
*
EDIT4	EQU	224		23 Aug 79
*
*	EDIT HISTORY
*
*EDIT	DATE		REASON
*192	30 SEP 78	ADDED PERTEC DISK SUPPORT
*193	3 OCT 78	ADDED TIMEOUT LOOP PRIOR TO 'CAF'
*195	5 OCT 78	CHANGED DEVICE TYPE NUMBERS
*196	23 OCT 78	CAUSE INITIALIZATION TO SET RTS/8 BIT IN 07777
*197	24 OCT 78	CORRECT BUG IN RTS/8 BIT
*198	24 OCT 78	CHANGED 'MULTOS-8' TO 'MULTOS/8'
*199	25 OCT 78	REMOVED TRANSMISSION OF ENABLE CHAR TO LINE PRINTER
*200	25 OCT 78	MAINTENANCE
*203	4 Nov 78	Added automatic memory size determination
*205	17 Nov 78	Maintenance
*207	18 Nov 78	Maintenance
*213	23 Nov 78	Maintenance
*214	24 Nov 78	Maintenance
*215	 4 Jan 79	Added '.END' Macro
*218	18 Jan 79	Reduced SPOOLER suspend time for busy printer.
*219	28 Jan 79	Changed SPOOLER page line count from 88 to 100.
*220	 8 Feb 79	Changed CORINFO format in initialization and removed
*			edit # 219 changes.
*221	 9 Jun 79	Changed phone number in initialization.
*222	13 Aug 79	Added support for 6 terminals.
*223	19 Aug 79	Ditto.
*224	23 Aug 79	Maintenance.
*225	 2 JUL-81	ADDED CODE TO KILL THE BATCH FLAG IF ACTIVE
*			ON START UP
*226	 4 JAN 82	CHANGED LPT SPOOLER SO THAT THE EMPTY POINTER
*			VALUE IS CHECKED BEFOR ACCESSING THE QUE NOT AFTER
*			ADDED SEQUENCE NUMBER TO LINE PRINTER LISTING
*
	TITLE	INITIALIZATION
*
	ISEC	0
	FIELD	2
	DSEC
*
	AS	2,KHLT
*
INITEND	JMP	1F		DESTROY INITIALIZATION CODE
	CID	%TIMESHARE
	JMPI	*+1		START THE TIMESHARING
	DC	TIMESHARE
*
1H	DCAI	F2XR
2H	JMP	INITEND
*
F2XR	DC	*
F2XR1	DC	0
F2XR2	DC	0
F2XR3	DC	DCWK-1		DEVICE CONTROL WORD CONSTANT POINTER
F2XR4	DC	DN:TAB-1	DEVICE NAME TABLE POINTER
F2XR5	DC	BUFFERS-1	I/O BUFFER CLEARING POINTER
F2XR6	DC	BUFFERS-BUFFEND	I/O BUFFER CLEARING COUNTER
F2XR7	DC	DA:TAB-1	DEVICE ADDRESS TABLE POINTER
*
DIGITS	AS	6
*
HOTIME	QUT	%*,DIGITS	H O TIME
LOTIME	QUT	%*,DIGITS+1	L O TIME
*
F2PNTR	DC	0
F2CNTR	DC	-13		FOR COUNTING DEVICES
*
MINUTE	DC	0		STORE MINUTE DURING TIME INPUT
MULTCTR	DC	0		USED IN MULTIPLICATIONS
*
PWCTR	DC	-TERMS		USED BY PASSWORD INITIALIZATION
PWPTR1	DC	PWFILE		POINTER INTO PASSWORD FILE '      .PW'
PWPTR2	DC	PASSPNTR	POINTER TO PASSWORD LIST TABLE
PWPTR3	DC	PASSWORDS	POINTER TO PASSWORDS
PWC	DC	0		TEMPORARY USED BY 'PWCHAR'
*
TO1	DC	-20		H O TIMEOUT PRIOR TO 'CAF'
TO2	DC	0		L O TIMEOUT
*
CORLOC	DC	07577		Location to test in each memory field
FIELDS	DC	FIELD4		Points to field information word
FCOUNT	DC	-4		Counter for memory size determination
*
F2PTR	DC	0		Initialization pointer.
F2CTR	DC	0		Initialization counter.
*
	ALIGN
*
OS8RET	CID	0		AN ERROR RETURN
	JMPI	=OS8DEST	RETURN TO STANDALONE OS/8
*
*	TIME SHARE SYSTEM INITIALIZATION
*
	PART
INITIALIZE CAF			THE REAL INITIALIZATION !
	IOT	TTY1,LS		SET TTY FLAG
	CDF	%OSDATEL
	TADI	=OSDATEL	GET THE STANDALONE DATE
	SZA CLA			DOES A DATE EXIST ?
	JMP	1F		YES
	CDF	%*
	.OUTEXT	< >
	.OUTEXT	< >
	.OUTEXT	<FIRST ENTER THE DATE, THEN TRY AGAIN !>
	.OUTEXT	< >
	.OUTEXT	< >
	JMP	OS8RET		NO, DON'T START THE SYSTEM
*
1H	CDF	%INITN
	TAD	=KHLT
	DCAI	=INITN
	TAD	=KHLT
	DCAI	=INITC
	CDF	%OSDATEH	SET THE DATA FIELD TO 10
	TADI	=OSDATEH	GET THE BATCH FLAG WORD
	AND	=03777		MASK OFF THE BATCH FLAG
	DCAI	=OSDATEH	RETURN IT TO MEMORY
	TADI	=OSDATEH	GET HIGH ORDER DATE WORD
	AND	=0600		MASK ONLY H O DATE BITS
	TAD	=RTS8+010	SET RTS/8 BACKGROUND BIT AND CORE = 1
	CDF	%CORINFO
	DCAI	=CORINFO
2H	CDF	4		Test for Fields 4 through 7
	LDI	-1
	DCAI	CORLOC
	TADI	CORLOC
	SNA CLA			Does Field 4 exist ?
	JMP	3F		No
	CDF	%FIELD4
	DCAI	FIELDS
	CDF	%MEMORY
	INCI	=MEMORY		Count the swapping fields
3H	TAD	2B		Bump CDF
	TAD	=010
	DCA	2B
	INC	FIELDS		Bump pointer
	ISZ	FCOUNT		Count the fields
	JMP	2B		Look at next field
	CDF	%*
	JMSX	USR		CALL THE USR AND LOCK IT IN MEMORY
	DC	USRIN
	LDI	1
	JMSX	USRRES
	DC	LOOKUP
	DC	DATESV
	DC	0
	SKP			'DATE.SV' FILE NOT FOUND
	JMP	DATEOK		IT'S ALREADY ON THE DISK
	LDI	1
	JMSX	USRRES
	DC	ENTER		OPEN AN OUTPUT FILE
1H	DC	DATESV
2H	DC	0
	JMP	ISYSERR		A SYSTEM DEVICE ERROR
	TAD	=(((DATEND-DATBEG+0377).AN.07400).RS.8)+1
	TAD	2B
	SZL CLA			SUFFICIENT ROOM FOR 'DATE.SV' FILE ?
	JMP	DATEOK		NO, FORGET THE DATE FILE
	TAD	1B		GET THE FIRST OUTPUT BLOCK NUMBER
	DCA	3F
	CIF	0
	JMS	$07607		CALL THE SYSTEM DEVICE HANDLER
	DC	04100+(%DATECCB.LS.3)	WRITE 1 PAGE
	DC	DATECCB
3H	HLT
	JMP	ISYSERR
	LDI	1
	TAD	1B		GET THE NEXT BLOCK NUMBER
	DCA	4F
	CIF	0
	JMS	$07607
	DC	04000+(((DATEND-DATBEG+0177).AN.07600).RS.1)+(%TIMEOUT.LS.3)
	DC	DATBEG
4H	HLT
	JMP	ISYSERR
	LDI	1
	JMSX	USRRES
	DC	CLOSE
	DC	DATESV
	DC	(((DATEND-DATBEG+0377).AN.07400).RS.8)+1
	JMP	ISYSERR
	JMP	DATEOK
*
ISYSERR	.OUTEXT	<SYSTEM DEVICE ERROR>
	JMP	OS8RET		RETURN TO STANDALONE OS/8
*
DATESV	TEXT	\DATE@@SV\
	PART
DATEOK	LDI	1		SET SYSTEM DEVICE
	JMSX	USRRES
	DC	LOOKUP
2H	DC	PASSWD		LOOK UP THE PASSWORD FILE IF IT EXISTS
	DC	0		LENGTH WORD (NOT USED)
	JMP	PWOK		THERE IS NO PASSWORD FILE
	TAD	2B		GET PASSWORD FILE BLOCK NUMBER
	DCA	3F		STORE IT FOR CALL TO SYSTEM DEV HANDLER
	CIF	0
	JMS	$07607		GO GET THE PASSWORD FILE
	DC	0200+(%*.LS.3)	NO MORE THAN 2 PAGES LONG ALLOWED
	DC	PWFILE
3H	HLT			PASSWORD BLOCK NUMBER
	JMP	ISYSERR		SYSTEM DEVICE ERROR
4H	CDF	%PASSPNTR
	TAD	PWPTR3		SET A PASSWORD POINTER TABLE ENTRY
	TAD	=-OS8RES	COMPENSATE FOR OBJECT TIME EXECUTION
	DCAI	PWPTR2
	INC	PWPTR2
5H	CDF	%*
	JMS	PWCHAR		GET A PASSWORD CHARACTER
	CDF	%PASSWORDS
	DCAI	PWPTR3		STORE THE CHARACTER
	INC	PWPTR3		BUMP THE POINTER
	SNL			END OF PASSWORD ?
	JMP	5B		NO, GET NEXT CHARACTER
	ISZ	PWCTR		YES, STORED ALL PASSWORDS ?
	JMP	4B		NO
	JMP	PWFIN		YES
*
*	SUBROUTINE TO FETCH PASSWORD CHARACTERS
*
	PART
PWCHAR	SUB			COROUTINES USED FOR EFFICIENCY
PWC2	SUB	PWC3
	AND	=0177		STRIP PARITY AND GARBAGE
	SNA			A NULL CHARACTER ?
	JMP	PWC2-1		YES, FETCH NEXT CHARACTER
	TAD	=-LF
	SNA			A LINE FEED ?
	JMP	PWC2-1		YES, IGNORE
	TAD	=LF-CR
	SZA			A CARRIAGE RETURN ?
	JMP	1F		NO
	STL			YES, SET THE LINK AS A FLAG
	RET	PWCHAR
*
1H	TAD	=CR-CTRLA
	SNA			AN ICE CORRECTION FLAG ?
	JMP	PWC2-1		YES, IGNORE
	TAD	=CTRLA-CTRLZ
	SNA			END-OF-FILE ?
	JMP	PWC5		YES
	TAD	=CTRLZ		NO, RESTORE THE CHARACTER
	CLL
	RET	PWCHAR
*
PWC3	TADI	PWPTR1		GET FIRST WORD OF A PAIR
	JMS	PWC2
	TADI	PWPTR1
	INC	PWPTR1
	AND	=07400		EXTRACT H O BITS OF THIRD CHARACTER
	DCA	PWC		STORE TEMPORARILY
	TADI	PWPTR1		GET SECOND WORD OF PAIR
	JMS	PWC2
	TADI	PWPTR1
	INC	PWPTR1
	AND	=07400		EXTRACT L O BITS OF THIRD CHARACTER
	CLL RTR
	RTR
	TAD	PWC		ADD H O BITS
	RTR
	RTR
	JMS	PWC2
	JMP	PWC3
*
PWC4	TAD	PWPTR3		SET THE NEXT PASSWORD POINTER
	TAD	=-OS8RES	COMPENSATE FOR OBJECT TIME EXECUTION
	DCAI	PWPTR2
	INC	PWPTR2		BUMP THE POINTER
PWC5	DCAI	PWPTR3		FAKE END OF PASSWORD
	ISZ	PWCTR		ALL PASSWORDS PROCESSED ?
	JMP	PWC4		NO
PWFIN	CDF	%*
	TAD	PWPTR3
	TAD	=-(OS8RES+01000)
	SPA CLA			ARE ONE OR MORE PASSWORDS TOO LONG ?
	JMP	PWOK		NO
	.OUTEXT	<PASSWORD FILE TOO LARGE -- RETURNING TO STANDALONE OS/8.>
	JMP	OS8RET		ABORT TIMESHARING
*
	PART
PWOK	.OUTEXT	< >
	.OUTEXT	< >
	.OUTEXT	<        HELLO !>
	.OUTEXT	< >
	.OUTEXT	<THIS IS THE MULTOS/8 MULTI-USER OS/8 TIMESHARING SYSTEM>
	.OUTEXT	<CREATED BY COMPUTER METHODS>
	.OUTEXT	<           7822 OAKLEDGE ROAD>
	.OUTEXT	<           SALT LAKE CITY, UTAH 84121, USA>
	.OUTEXT	<           PHONE 801-942-8000>
	.OUTEXT	< >
	JMP	5F		GET FIRST DEVICE NAME
DH:LOOP	JMSX	USRRES		CALL THE USR
	  INQUIRE
1H	  DC	0
2H	  DC	0
3H	  DC	0
	  JMP	4F		DEVICE NOT IN SYSTEM
	TAD	2B		GET DEVICE NUMBER
	MQL
	MQA
	TAD	=DEV:TAB-1
	DCA	F2PNTR
	TADI	F2XR7		GET EXEC DEVICE HANDLER ADDRESS
	CDF	%DEV:TAB
	DCAI	F2PNTR
	MQA
	TAD	=DCWTAB-1
	DCA	F2PNTR
	CDF	%*
	TADI	F2XR3		GET DEVICE CONTROL WORD
	CDF	%DCWTAB
	DCAI	F2PNTR		PLACE IT IN RESIDENT OS/8 DCW TABLE
	TADI	F2PNTR		GET CONTROL WORD BACK AGAIN
	SMA CLA			IS IT A FILE STRUCTURED DEVICE ?
	JMP	5F		NO
	MQA
	TAD	=DHRTAB-1
	DCA	F2PNTR
	MQA
	TAD	=07606		BIAS INTO HANDLER CALL AREA
	CDF	%DHRTAB
	DCAI	F2PNTR		STORE IN RESIDENT OS/8 DEV HAND RES TABLE
	JMP	5F
*
4H	INC	F2XR7		BUMP INDEXES
	INC	F2XR3
5H	CDF	%*
	TADI	F2XR4		SET UP NEXT DEVICE NAME
	SNA			END OF DEVICE HANDLERS ?
	JMP	6F		YES
	DCA	1B
	TADI	F2XR4		GET SECOND HALF OF DEVICE NAME
	DCA	2B
	DCA	3B
	JMP	DH:LOOP
*
6H	CDF	%*
	JMSX	USRRES		THROW OUT THE USR
	DC	USROUT
	CDF	%BUFFERS	CLEAR THE I/O BUFFERS
7H	DCAI	F2XR5		CLEAR BUFFERS IN FIELD 1
	ISZ	F2XR6		FINISHED ?
	JMP	7B		NO
	PART
INITM	CDF	%*
	AIF	NO:SPOOL,.SPOOL
	TAD	=TERMS*128+SWAP	SET UP TO WRITE SPOOLER TO ITS SWAP TRACK
	DCA	1F
	CIF	0
	JMS	$07607		WRITE THE SPOOLER TO DISK
	  DC	04000+(%SPOOLER.LS.3)
	  DC	0
1H	  DC	0
	  HLT			ERROR RETURN
.SPOOL	ANOP
	.OUTEXT	< >
	.OUTEXT	<PLEASE INPUT TIME IN 24-HOUR FORMAT>
	.OUTEXT	<(E.G. 0925 FOR 9:25 AM AND 1935 FOR 7:35 PM):>
	JMS	READKY		GET A CHAR FROM KEYBOARD
	CLL RAL			MULT BY 10
	DCA	DIGITS
	TAD	DIGITS
	CLL RTL
	TAD	DIGITS
	DCA	DIGITS
	JMS	READKY		GET NEXT CHAR
	TAD	DIGITS
	DCA	DIGITS
	TAD	DIGITS
	TAD	=-24
	SMA CLA			IS IT LESS THAN 24 ?
	JMP	INITM		NO, ERROR -- RE-START
	TAD	DIGITS		GET THE HOUR
	DCA	LOTIME		SAVE IT
	JMS	READKY		GET NEXT CHAR
	CLL RAL			MULT BY 10
	DCA	DIGITS
	TAD	DIGITS
	CLL RTL
	TAD	DIGITS
	DCA	DIGITS
	JMS	READKY		GET LAST CHAR
	TAD	DIGITS
	DCA	DIGITS
	TAD	DIGITS
	TAD	#-60
	SMA CLA			IS IT LESS THAN 60 ?
	JMP	INITM		NO, ERROR -- RE-START
	TAD	DIGITS		GET THE MINUTE
	DCA	MINUTE		SAVE IT
	DCA	HOTIME
	TAD	=60		CONVERT HOURS TO MINUTES
	JMS	MULT
	TAD	MINUTE		ADD IN THE MINUTE
	TAD	LOTIME
	DCA	LOTIME		(NO CARRY POSSIBLE)
	TAD	=60		CONVERT MINUTES TO SECONDS
	JMS	MULT
	TAD	=TICKS		CONVERT THE SECONDS TO CLOCK TICKS
	JMS	MULT
	TAD	LOTIME		YES, COMPUTE THE NEGATIVE OF THE
	TAD	=MMIDNLO		NUMBER OF TICKS TO MIDNIGHT
	CDF	%TIME
	DCAI	=TIME+1		SET L O EXEC TIME
	RAL
	TAD	HOTIME
	TAD	=MMIDNHO
	DCAI	=TIME		SET H O EXEC TIME
	CDF	%*
	.OUTEXT	< >
	.OUTEXT	< >
	.OUTEXT	<THANK YOU !>
	.OUTEXT	< >
	.OUTEXT	<THE SYSTEM IS NOW  TIMESHARING>
	.OUTEXT	< >
	.OUTEXT	< >

ONMES	.OUTEXT	<TYPE CONTROL/H TO LOG ON.>

*ONMES	.OUTEXT	<AREOSPACE   PDP-8 SYSTEM IS NOW AVAILABLE FOR LOGIN>
	.OUTEXT	< >
	TAD	=ONMES
	DCA	F2XR4
	TAD	=JOB2OB
	DCA	F2PTR
.TERMS	DCA	F2CNTR		CLEAR FOR COUNTING THE OUTPUT CHARACTERS
1H	CDF	%*
	TADI	F2XR4		GET A MESSAGE CHARACTER
	SNA			END OF MESSAGE ?
	JMP	2F		YES
	MQL
	LDI	-(TERMS-1)
	DCA	F2CTR
	CDF	%BUFFERS
9H	MQA
	DCAI	F2PTR
	TAD	F2PTR
	TAD	=128
	DCA	F2PTR
	ISZ	F2CTR
	JMP	9B
	TAD	F2PTR
	TAD	=1-((TERMS-1)*128)
	DCA	F2PTR
.TERMS	INC	F2CNTR		COUNT THE OUTPUT CHARACTERS
	JMP	1B		GET NEXT CHARACTER
*
2H	CDF	%TABLES
	TAD	=JOB2+OBF
	DCA	F2PNTR
	TAD	F2CNTR
	TADI	F2PNTR
	DCAI	F2PNTR
	LDI	OBC-OBF
	TAD	F2PNTR
	DCA	F2PNTR
	TAD	F2CNTR
	TADI	F2PNTR
	DCAI	F2PNTR
	TAD	F2PNTR
	TAD	=USER:ST+OBF-OBC
	DCA	F2PNTR
	AIF	TERMS.LT.3,.CONT
	TAD	F2CNTR
	TADI	F2PNTR
	DCAI	F2PNTR
	LDI	OBC-OBF
	TAD	F2PNTR
	DCA	F2PNTR
	TAD	F2CNTR
	TADI	F2PNTR
	DCAI	F2PNTR
	AIF	TERMS.LT.4,.CONT
	TAD	F2PNTR
	TAD	=USER:ST+OBF-OBC
	DCA	F2PNTR
	TAD	F2CNTR
	TADI	F2PNTR
	LDI	OBC-OBF
	TAD	F2PNTR
	DCA	F2PNTR
	TAD	F2CNTR
	TADI	F2PNTR
	DCAI	F2PNTR
.CONT	ANOP
	CDF	%*
5H	ISZ	TO2		ALLOW TIMEOUT PRIOR TO 'CAF'
	JMP	5B
	ISZ	TO1
	JMP	5B
	CAF
	JMP	INITEND		END THE INITIALIZATION
*
*	INITIALIZATION SUBROUTINES
*
*	MULTIPLY HOTIME,LOTIME BY NUMBER IN AC
*
	PART
MULT	SUB
	CLL CIA			NEGATE MULTIPLIER
	DCA	MULTCTR
	TAD	HOTIME		FIRST STORE THE TIME
	DCA	DIGITS+2
	TAD	LOTIME
	DCA	DIGITS+3
	DCA	HOTIME		NOW CLEAR THE TIME
	DCA	LOTIME
1H	TAD	DIGITS+3
	TAD	LOTIME
	DCA	LOTIME
	RAL
	TAD	DIGITS+2
	TAD	HOTIME
	DCA	HOTIME
	ISZ	MULTCTR		FINISHED ?
	JMP	1B		NO
	RET	MULT
*
*	CONSOLE KEYBOARD INPUT ROUTINE
*
READKY	SUB
	IOS	KEY1,SF
	JMP	*-1
	IOT	KEY1,LS		GET THE CHAR
	AND	=0177
	MQL			SAVE CHAR IN MQ
	MQA
	TAD	=-3
	SNA			RETURN TO OS/8 ?
	JMP	OS8RET		RETURN TO STANDARD OS/8
	TAD	=3		RESTORE ORIGINAL CHARACTER
	JMS	WRITTY		PRINT IT
	MQA
	TAD	=-060
	SPA			A DIGIT ?
	JMP	INITM		NO, RE-START
	TAD	=-9		MAYBE
	SMA SZA			A DIGIT ?
	JMP	INITM		NO, RE-START
	TAD	=9		YES, A DIGIT
	RET	READKY
*
*	CONSOLE OUTPUT ROUTINE
*
	PART
	PART
WRITTY	SUB
	IOS	TTY1,SF
	JMP	*-1
	IOT	TTY1,LS
	CLA
	RET	WRITTY
*
*	TEXT OUTPUT ROUTINE
*
	ROOM	4
OUTEXT	SUB
1H	TADI	OUTEXT		GET A CHAR
	SNA			END OF TEXT ?
	RET	OUTEXT		YES
	INC	OUTEXT		BUMP POINTER
	JMS	WRITTY		PRINT THE CHAR
	JMP	1B		GET NEXT CHAR
*
*	VARIOUS TABLES USED IN INITIALIZATION
*
DA:TAB	QUT	%*,*
	AIF	NO:RKO5,.RK05
	DC	RKA1		DEVICE HANDLER ADDRESS TABLE
	DC	RKB1
	DC	RKA2
	DC	RKB2
	DC	RKA3
	DC	RKB3
*
.RK05	AIF	NO:DECTAPE,.DECTAPE
*
	DC	DTA0		DTA0-7
	DC	DTA1
	DC	DTA2
	DC	DTA3
	DC	DTA4
	DC	DTA5
	DC	DTA6
	DC	DTA7
*
.DECTAPE ANOP
*
	AS	8		MTA0-7
*

	AIF	NO:FLOPPY,.FLOPPY
*
	DC	RXA0
	DC	RXA1
	DC	R0
	DC	R1
*
.FLOPPY	ANOP
*
	AS	5		PTP, PTR, LPT, TTY & DUMP
*
	DC	J1		J1-6 (JOBS 1-6)
	DC	J2
	DC	J3
	DC	J4
	DC	J5
	DC	J6
*
*	DEVICE CONTROL WORD CONSTANTS TABLE
*
DCWK	QUT	%*,*
	AIF	NO:RKO5,.RK05
	AS	6,04230		RKA1-3, RKB1-3
.RK05	AIF	NO:TC08,.TC08
	AS	8,04160		DTA0-7
.TC08	AIF	NO:TD8E,.TD8E
	AS	8,04210		TD8E DTA0-7
.TD8E	AS	8,00200		MTA0-7
	AIF	NO:FLOPPY,.FLOPPY
	AS	2,04250		RXA0-1
	AS	2,04420		R0-1
.FLOPPY	DC	01020		PTP
	DC	02010		PTR
	DC	01040		LPT
	DC	0		TTY
	DC	01360		DUMP
	AS	6,04560		J1-6
*
*	DEVICE NAME TABLE
*
DN:TAB	QUT	%*,*
	AIF	NO:RKO5,.RK05
	TEXT	\RKA1\
	TEXT	\RKB1\
	TEXT	\RKA2\
	TEXT	\RKB2\
	TEXT	\RKA3\
	TEXT	\RKB3\
.RK05	AIF	NO:DECTAPE,.DECTAPE
	TEXT	\DTA0\
	TEXT	\DTA1\
	TEXT	\DTA2\
	TEXT	\DTA3\
	TEXT	\DTA4\
	TEXT	\DTA5\
	TEXT	\DTA6\
	TEXT	\DTA7\
.DECTAPE TEXT	\MTA0\
	TEXT	\MTA1\
	TEXT	\MTA2\
	TEXT	\MTA3\
	TEXT	\MTA4\
	TEXT	\MTA5\
	TEXT	\MTA6\
	TEXT	\MTA7\
	AIF	NO:FLOPPY,.FLOPPY
	TEXT	\RXA0\
	TEXT	\RXA1\
	TEXT	\R0@@\
	TEXT	\R1@@\
.FLOPPY	TEXT	\PTP@\
	TEXT	\PTR@\
	TEXT	\LPT@\
	TEXT	\TTY@\
	TEXT	\DUMP\
	TEXT	\J1@@\
	TEXT	\J2@@\
	TEXT	\J3@@\
	TEXT	\J4@@\
	TEXT	\J5@@\
	TEXT	\J6@@\
	DC	0		END OF DEVICES SENTINEL
*
*	PASSWORD FILE DEFINITIONS
*
PASSWD	TEXT	\      PW\	THAT SHOULD BE SUFFICIENTLY CONFUSING !
*
PWFILE	AS	0400		PASSWORD FILE BUFFER
*
	DC	CTRLZ		SAFETY
*
*	'DATE.SV' CORE CONTROL BLOCK
*
DATECCB	DC	-1
	DC	KCID		STARTING FIELD 'CID'
	DC	0200		STARTING ADDRESS
	DC	07400		JSW
	DC	0200		LOAD ADDRESS
	DC	((DATEND-DATBEG+0177).AN.07600).RS.1
*
	ORG	(*+0177).AN.07600	ALIGN TO PAGE BOUNDARY
	ISEC	0
*
DATBEG	EQU	*
*
MIN	EQU	TICKS/2*60		TICKS PER MINUTE DIV BY 2
*
	AIF	TICKS.NE.50,.TICKS
*
HRHO	EQU	025		TICKS PER HOUR DIV BY 2
HRLO	EQU	07620
*
.TICKS	AIF	TICKS.NE.100,.TICKS
*
HRHO	EQU	053		TICKS PER HOUR DIV BY 2
HRLO	EQU	07440
*
.TICKS	AIF	TICKS.NE.120,.TICKS
*
HRHO	EQU	064		TICKS PER HOUR DIV BY 2
HRLO	EQU	05700
*
.TICKS	ANOP
*
CURTIM	EQU	020		DOUBLE PRECISION TIME STORED HERE
DQUOT	EQU	022		QUOTIENT
DDIVSOR	EQU	023		DOUBLE PRECISION DIVISOR
LOPNTR	EQU	025		POINTER TO L O DIVISOR
DDIGIT	EQU	026		DECIMAL DIGIT STORAGE
DDTEMP	EQU	027		DECIMAL DIGIT TEMPORARY
*
	PART
TIMEOUT	CAL			ENTRY FROM '.R DATE' COMMAND
	DSI	TSS		RUNNING UNDER TIMESHARING ?
	JMP	$07605		NO, FORGET IT
	LDI	04000
	ROOM	3
	DI	TOD		GET THE TIME-OF-DAY FROM MULTOS/8
	DC	CURTIM		TOD STORAGE POINTER
	JMS	DOUTXT,'T,'I,'M,'E,':,' ,' ,0	'TIME:  '
	TAD	CURTIM
	CLL RAR			DIVIDE THE TIME BY 2
	DCA	CURTIM		(THIS PREVENTS HAVING A MINUS NUMBER IN CURTIM)
	TAD	CURTIM+1
	RAR
	DCA	CURTIM+1
	ROOM	4
	JMS	DATDIV
	DC	HRHO
	DC	HRLO
	JMS	DOUT2		OUTPUT THE HOUR
	JMS	DCOLON		':'
	ROOM	4
	JMS	DATDIV
	DC	0
	DC	MIN
	JMS	DOUT2		OUTPUT THE MINUTE
	JMS	DCOLON		':'
	ROOM	4
	JMS	DATDIV
	DC	0
	DC	TICKS/2
	JMS	DOUT2		OUTPUT THE SECONDS
	JMS	DOUTXT,015,012,0	JUST A CR/LF COMBO
	JMP	$07605		BACK TO TIMESHARE OS/8
*
*	TIME-OF-DAY SUBROUTINES
*
	PART
DATDIV	HLT			DIVIDE CURTIM BY CONTENT OF ENTERING AC
	LDI	1
	TAD	DATDIV
	DCA	LOPNTR		FORM POINTER TO L O DIVISOR
	TADI	LOPNTR		GET L O DIVISOR
	CLL CIA
	DCA	DDIVSOR+1
	CML RAL
	TADI	DATDIV		GET H O DIVISOR
	CIA
	DCA	DDIVSOR
	DCA	DQUOT		CLEAR THE QUOTIENT
1H	CAL			LINK MUST BE CLEAR
	TAD	DDIVSOR+1
	TAD	CURTIM+1
	DCA	CURTIM+1
	RAL
	TAD	DDIVSOR
	TAD	CURTIM
	DCA	CURTIM
	TAD	CURTIM
	SPA CLA			FINISHED DIVISION ?
	JMP	2F		YES
	INC	DQUOT
	JMP	1B
2H	CAL
	TADI	LOPNTR		RESTORE DIVIDEND
	TAD	CURTIM+1
	DCA	CURTIM+1
	RAL
	TADI	DATDIV
	TAD	CURTIM
	DCA	CURTIM
	INC	LOPNTR
	TAD	DQUOT		GET THE QUOTIENT
	JMPI	LOPNTR
*
	PART
DOUTXT	HLT			OUTPUT TEXT FOLLOWING CALL
1H	TADI	DOUTXT		GET A CHARACTER
	INC	DOUTXT		BUMP THE POINTER
	SNA			END OF TEXT ?
	JMPI	DOUTXT		YES
	JMS	DOUT
	JMP	1B		GET NEXT CHARACTER
*
DOUT	HLT			PRINT A CHARACTER
	IOT	TTY1,LS
	CAL
	JMPI	DOUT
*
	PART
DOUT2	HLT			OUTPUT TWO DECIMAL DIGITS
	DCA	DDTEMP		STORE THE BINARY TEMPORARILY
	DCA	DDIGIT		CLEAR THE DIGIT
	TAD	DDTEMP
1H	TAD	=-10
	SPA
	JMP	2F
	INC	DDIGIT
	JMP	1B
2H	TAD	=10
	DCA	DDTEMP
	TAD	DDIGIT
	TAD	='0.AN.0177
	JMS	DOUT		PRINT THE FIRST DIGIT
	TAD	DDTEMP
	TAD	='0.AN.0177
	JMS	DOUT		PRINT THE SECOND DIGIT
	JMPI	DOUT2
*
DCOLON	HLT			PRINT A COLON
	TAD	=':.AN.0177
	JMS	DOUT
	JMPI	DCOLON
*
DATEND	EQU	*		USED FOR BLOCK AND PAGE COMPUTATIONS
*
	DSEC
*
*	Compute highest address used in this field.
*
	.END
	TITLE	EXECUTIVE TASKS
*
*	NOTE: DO NOT USE THE MQ IN THESE TASKS !!!!!
*
	FIELD	3
	DSEC
*
*	ENTRY POINTS FOR EXECUTIVE TASKS
*
	AIF	NO:SPOOL,.NO:SPOOL
*
SPLINIT	JMPI	ZSPOOL		PRINT SPOOLER STARTING ADDRESS
*
.NO:SPOOL ANOP
*
	AS	010-*,KHLT		ONLY THE SPOOLER EXISTS PRESENTLY
*
*	INDEX REGISTERS
*
ZXR	DC	0		'Z' REFERS TO THE SPOOLER JOB
ZXRMES	DC	0		USED BY 'ZMES' SUBROUTINE
ZXR2	DC	0
ZXR3	DC	0
ZXR4	DC	0
ZXR5	DC	0
ZXR6	DC	0
ZXR7	DC	0
*
	AIF	NO:SPOOL,.NO:SPOOL
*
ZJOB	DC	0		CONTAINS 'SPLJOB' BROUGHT UP FROM FIELD 0
ZFILE	AS	4		FILE NAME STORAGE (8 6-BIT CHARACTERS)
SPLAC	DC	0		TEMP FOR AC
ZPNTR	DC	0		GENERAL PURPOSE POINTERS
ZCNTR1	DC	0		GENERAL PURPOSE COUNTERS
ZCNTR2	DC	0
ZCNTR3	DC	0
ZTEMP	DC	0		A TEMPORARY
ZINFO	DC	0		NUMBER OF ADDITIONAL INFO WORDS IN DIRECTORY
ZLEN	DC	0		ACCUMULATED LENGTH OF EACH DIRECTORY ENTRY
ZCOL	DC	0		COUNTS PRINTER COLUMNS
ZW1	DC	0		OS/8 DOUBLE WORD/TRIPLE CHAR STORAGE
ZW2	DC	0
ZCHAR	DC	0		LAST CHARACTER SENT TO PRINTER
ZLCHAR	DC	0		NEXT TO LAST CHARACTER SENT TO PRINTER
ZSPOOL	DC	SPOOLER		ENTRY ADDRESS POINTER
*
*	READ A SECTOR FROM A FILE STRUCTURED DEVICE
*
ZREAD	HLT
	DI	FSD		FILE STRUCTURED HANDLER IOT
ZDEV	DC	0		SPOOL FILE DEVICE NUMBER
	DC	*+1		ARGUMENT LIST POINTER
	DC	0200		TWO PAGES INTO THIS FIELD
	DC	ZBUFF		MEMORY ADDRESS
ZBLOCK	DC	0		BLOCK NUMBER
	JMPI	*+2		A DEVICE ERROR OCCURRED
	JMPI	ZREAD
	DC	ZDEVER
*
	AIF	FFNPL.EQ.0,.NO:SPOOL
*
ZLINES	DC	0		OUTPUT PAGE LINE COUNTER
*
.NO:SPOOL ANOP
*
	ALIGN
*
	AIF	NO:SPOOL,.NO:SPOOL
*
*	NEW INSTRUCTIONS
*
*	CHANGE THE 'DF' TO HARDWARE FIELD 0
*
CDF0	HLT			'CDF' TO PHYSICAL FIELD 0
	DI	CUF		SET EXEC MODE AND TURN OFF INTERRUPTS
ZCDF	CDF	%SPLJOB
	JMPI	CDF0
*
*	CHANGE THE 'DF' BACK TO THE CURRENT HARDWARE FIELD
*
CDFCUR	HLT			'CDF' TO CURRENT PHYSICAL FIELD
	DCA	SPLAC		SAVE ENTERING AC
	RIF			GET THE PHYSICAL 'IF'
	TAD	ZCDF
	DCA	*+1
	HLT			SET 'DF' = 'IF'
	ION
	DI	SUF
	TAD	SPLAC		RESTORE ENTERING AC
	JMPI	CDFCUR
*
*	PRINT SPOOLER MESSAGES
*
ASTER	TEXT	\****@\
*
MLPS	TEXT	\MULTOS/8 PRINT SPOOLER TASK  --  JOB @\
*
FILMES	TEXT	\  FILE: @\
*
LPSEQ	TEXT	\LINE PRINTER JOB NO. \
*
NFSD	TEXT	\SPOOL ERROR:  NOT A FILE STRUCTURED DEVICE@\
*
SDE	TEXT	\SPOOL DEVICE ERROR:  SPOOL ABORTED@\
*
CFRSF	TEXT	\SPOOL ERROR:  CANNOT FIND THE REQUESTED SPOOL FILE@\
*
	ISEC	0
*
SPOOLER	CAL			IT MIGHT BE NON-ZERO
	.F0			MUST ACCESS HARDWARE FIELD 0
SPL2	TADI	=SPLQCTR	GET THE QUEUE COUNT
	SZA CLA			ANYTHING ON THE QUEUE ?
	JMP	0F		YES
	CDF	%PRINTER	NO, RELEASE THE PRINTER
	DCAI	=PRINTER
	CDF	%SPLJOB			AND CLEAR SPOOLER BUSY FLAG
	DCAI	=SPLJOB
	.CUR			THEN JUST HALT
	HLT
*
0H	CDF	%PRINTER	CHECK THE PRINTER
	TADI	=PRINTER
	TADI	=JOB
	SNA CLA			IS IT ALREADY ASSIGNED TO THIS JOB ?
	JMP	2F		YES
	DCA	ZINFO		USED AS A TEMPORARY
1H	CDF	%PRINTER
	TADI	=PRINTER
	SNA CLA			IS THE PRINTER AVAILABLE ?
	JMP	2F		YES
	.CUR
	TAD	=TICKS*5	Set low order suspend time = 5 seconds
	DCA	ZW2		...
	DCA	ZW1		Set high order suspend tick count
	DI	STM		Suspend for a 5 seconds
	JMP	SPOOLER		and try to access the printer again
*
2H	TADI	=JOB		GET PRINT SPOOLER JOB NUMBER
	CIA
	DCAI	=PRINTER	ASSIGN THE PRINTER TO IT
	CDF	%SPLQE
	TADI	=SPLQE		GET THE SPOOL QUEUE EMPTY POINTER
	DCA	ZXR
	TAD	ZXR		CHECK THE SPOOLER EMPTY POINTER !
	TAD	=-(SPLQ+(32*5)+1)
	SPA CLA			IF POSITIVE POINTER IS AT THE END
	JMP 7F			OF THE QUE
	TAD	=-32*5
	TAD	ZXR		RESET THE POINTER
	DCAI	=SPLQE
	TAD	=SPLQE
	DCA	ZXR		POINTER NOW RESET !
7H	CDF	%SPLQ		MUST ACCESS THE QUEUE DIRECTLY
	TADI	ZXR		GET THE DEV/JOB
	DCA	ZJOB
	TADI	ZXR		GET THE FILE NAME
	DCA	ZFILE
	TADI	ZXR
	DCA	ZFILE+1
	TADI	ZXR
	DCA	ZFILE+2
	TADI	ZXR
	DCA	ZFILE+3
	TAD	ZJOB
	CDF	%SPLJOB
	DCAI	=SPLJOB		SET THE SPOOL BUSY FLAG
	TAD	ZXR		/NOW RESET THE SPOOLER POINTER
	TAD 	=-(SPLQ+(32*5)+1)
	SMA CLA
	TAD	=-32*5
	TAD	ZXR
	DCAI	=SPLQE		SAVE THE RESET POINTER
	TAD	ZJOB
	SMA			HAS THIS ENTRY BEEN DE-QUEUED ?
	JMP	3F		NO
	LDI	-1		YES, JUST IGNORE IT
	TADI	=SPLQCTR	BACK UP THE QUEUE COUNTER
	DCAI	=SPLQCTR
	DCAI	=SPLJOB		CLEAR THE SPOOL BUSY FLAG
	JMP	SPL2		AND CHECK FOR MORE ENTRIES ON QUEUE
*
3H	RAR6			DEVICE NUMBER TO RIGHT BYTE
	AND	=017		EXTRACT DEVICE NUMBER
	DCA	ZDEV
	TAD	ZDEV
	TAD	=DCWTAB-1
	DCA	ZPNTR
	CDF	%DCWTAB
	TADI	ZPNTR		GET THE DEVICE CONTROL WORD
	.CUR
	SPA CLA			IS IT A FILE STRUCTURED DEVICE ?
	JMP	4F		YES
	JMS	SPACES
	JMS	SPACES
	TAD	=NFSD-1		'NOT A FILE STRUCTURED DEVICE'
	JMS	ZMES
ZEXIT	JMS	ZCRLF		Output a CR/LF combo to complete a line
	TAD	=FF		EJECT A PAGE
	JMS	PRINTC
	LDI	-1		BACK UP THE QUEUE COUNTER
	.F0
	TADI	=SPLQCTR
	DCAI	=SPLQCTR
	JMP	SPOOLER		CHECK FOR MORE QUEUE ENTRIES
*
4H	TAD	ZJOB		GET THE JOB INFO
	AND	=07
	TAD	=04000
	DI	TASK		STORE THE JOB NUMBER IN THE EXECUTIVE
	DCA	ZBLOCK		ZERO THE BLOCK NUMBER (WILL BE BUMPED LATER)
	TAD	=-5		OUTPUT 5 LINE FEEDS
	DCA	ZCNTR1
5H	JMS	ZCRLF		Output CR/LF combo's
	ISZ	ZCNTR1		FINISHED ?
	JMP	5B		NO
	JMS	SPACES
	TAD	=ASTER-1	'****'
	JMS	ZMES
	JMS	SPACES
	TAD	=MLPS-1		'MULTOS/8 PRINT SPOOLER TASK -- JOB '
	JMS	ZMES
	TAD	ZJOB
	AND	=07		GET THE JOB NUMBER
	TAD	='0.AN.0177	ADD ASCII BIAS
	JMS	PRINTC		PRINT THE REQUESTING JOB NUMBER
	TAD	=FILMES-1	'  FILE: '
	JMS	ZMES
	TAD	ZFILE		GET FILE NAME
	JMS	ZNAME			AND PRINT IT
	TAD	ZFILE+1
	JMS	ZNAME
	TAD	ZFILE+2
	JMS	ZNAME
	TAD	='..AN.0177	PRINT A PERIOD
	JMS	PRINTC
	TAD	ZFILE+3		GET THE FILE NAME EXTENSION
	JMS	ZNAME		PRINT IT
	JMS	SPACES
	TAD	=ASTER-1	'****'
	JMS	ZMES
	JMS	ZCRLF		Output a CR/LF Combo
	JMS	ZCRLF		Output a CR/LF Combo
	JMS	ZCRLF		Output a CR/LF Combo
	JMS	SPACES
	TAD	=ASTER-1
	JMS	ZMES
	JMS	SPACES
	TAD	=LPSEQ-1
	JMS	ZMES		OUTPUT THE SEQUENCE NO TEXT
*	CDF	%SPLQE		SET THE DATA FIELD 
	.F0			MUST ACCESS HARDWARE FIELD 0
	INCI	=LPTCNT		INCREMENT THE COUNTER
	TADI	=LPTCNT		GET THE LPT SEQ CNTR
	.CUR			RESET THE DATA FIELD
	DCA	DPRREG		SAVE THE NO TO BE PRINTED
	TAD	DPRINS
	DCA	DPRPTP
	TAD	M4
	DCA	DPRFAC
	DCA	DPRFL
	DCA	DPRFIG
DPRSUB	CLL
	TAD	DPRREG
DPRPTP	TAD	DPRTEN
	SNL
	JMP	DPR
	DCA	DPRREG
	ISZ	DPRFIG
	JMP	DPRSUB
DPR	CLL CLA
	TAD	DPRFIG
	SNA
	JMP	DPRZRO
DPRIN	TAD	='0.AN.0127	ADD IN ASCII BIAS
	ISZ	DPRFL
DPRIN1	TAD	=' .AN.0177	MAKE A SPACE
	JMS	PRINTC
	INC	DPRPTP
	ISZ	DPRFAC
	JMP	DPRSUB-1
	JMP	6F		CONTINUE ON
*
DPRZRO	CLL CLA IAC
	TAD	DPRFAC		IS THIS THE LAST DIGIT
	SNA CLA
	CLL CLA IAC
	RAR			ROTATE INTO THE LINK
	TAD	DPRFL
	SZA CLA
	JMP	DPRIN
	SNL			CHECK THE LINK...IF SET = LAST DIGIT SO PRINT 0
	JMP	DPRIN1
	JMP	DPRIN
*
DPRREG	DC	0		TEMP FOR NUMBER
DPRFL	DC	0
DPRINS	TAD	DPRTEN
DPRFAC	DC	0
DPRFIG	DC	0
DPRTEN	DC	O'6030'		-1000
DPRTEA	DC	O'7634'		- 100
DPRTEB	DC	O'7766'		-  10
DPRTEC	DC	O'7777'		-   1
M4	DC	-4
6H	JMS	SPACES
	TAD	=ASTER-1
	JMS	ZMES
	TAD	=FF		EJECT THE PAGE
	JMS	PRINTC
*
	PART
DIRL	INC	ZBLOCK		BUMP THE DIRECTORY SEGMENT BLOCK NUMBER
	JMS	ZREAD		GET A DIRECTORY SEGMENT
	TAD	=ZBUFF-1	INITIALIZE TO LOOK AT DIRECTORY SEGMENT
	DCA	ZXR
	TADI	ZXR		GET NUMBER OF ENTRIES IN THIS SEGMENT
	DCA	ZCNTR1
	LDI	3
	TAD	ZXR
	DCA	ZXR
	TADI	ZXR		GET NEGATED NUMBER OF ADDITIONAL INFO WORDS
	CIA			MAKE IT POSITIVE
	DCA	ZINFO
	DCA	ZLEN		CLEAR LENGTH WORD
1H	TADI	ZXR		GET FIRST WORD OF A DIRECTORY ENTRY
	SZA			IS THIS AN EMPTY ?
	JMP	2F		NO
DIRL2	TADI	ZXR		YES, GET ITS LENGTH
	TAD	ZLEN			AND ADD IT INTO THE RUNNING TOTAL
	DCA	ZLEN
	ISZ	ZCNTR1		LOOKED AT ALL ENTRIES IN THIS SEGMENT ?
	JMP	1B		NO
	TAD	ZBUFF+2		YES
	SZA CLA			IS THIS THE LAST DIRECTORY SEGMENT ?
	JMP	DIRL		NO
	JMS	SPACES
	JMS	SPACES
	TAD	=CFRSF-1	'CANNOT FIND REQUESTED SPOOL FILE'
	JMS	ZMES
	JMP	ZEXIT		EXIT
*
2H	CIA			NEGATE THE PARTIAL FILE NAME
	TAD	ZFILE
	SZA CLA			A MATCH ?
	JMP	3F		NO
	TADI	ZXR		TRY NEXT CHARACTER PAIR
	CIA
	TAD	ZFILE+1
	SZA CLA			A MATCH ?
	JMP	4F		NO
	TADI	ZXR		TRY NEXT CHARACTER PAIR
	CIA
	TAD	ZFILE+2
	SZA CLA			A MATCH ?
	JMP	5F		NO
	TADI	ZXR		TRY LAST CHARACTER PAIR
	CIA
	TAD	ZFILE+3
	SZA CLA			A MATCH ?
	JMP	6F		NO
	JMP	FOUND		YES
*
3H	IAC			COMPUTE FILE LENGTH ADDRESS
4H	IAC
5H	IAC
6H	TAD	ZINFO		ADD IN THE ADDITIONAL INFO WORDS
	TAD	ZXR
	DCA	ZXR
	JMP	DIRL2
*
	PART
FOUND	TAD	ZLEN		GET THE NEGATED SUM OF ALL FILE LENGTHS
	CMA			WILL BE BUMPED LATER (BY READ/PRINT LOOP)
	TAD	ZBUFF+1		ADD THE BLOCK NUMBER OF FIRST FILE
	DCA	ZBLOCK		USE IT TO INITIALIZE THE READ ROUTINE
	TAD	ZINFO
	TAD	ZXR
	DCA	ZXR
	TADI	ZXR		GET NEGATED LENGTH OF THIS FILE
	DCA	ZLEN		SAVE IT
	DCA	ZCOL		CLEAR THE COLUMN NUMBER COUNTER
FOUNDL	INC	ZBLOCK		BUMP THE FILE BLOCK NUMBER
	JMS	ZREAD		GET A BLOCK OF THE FILE
	TAD	=-128		INITIALIZE PARAMETERS
	DCA	ZCNTR1
	TAD	=ZBUFF-1
	DCA	ZXR
1H	TADI	ZXR		GET FIRST WORD OF TWO WORD OS/8 TRIPLE
	DCA	ZW1
	TADI	ZXR		GET SECOND WORD
	DCA	ZW2
	TAD	ZW1
	JMS	ZOUT		OUTPUT FIRST OF THREE CHARACTERS
	TAD	ZW2
	JMS	ZOUT		OUTPUT SECOND
	TAD	ZW2
	AND	=07400
	CLL RTR
	RTR
	DCA	ZTEMP
	TAD	ZW1
	AND	=07400
	TAD	ZTEMP
	CLL RTR
	RTR
	JMS	ZOUT		OUTPUT THIRD
	ISZ	ZCNTR1		EMPTIED BUFFER ?
	JMP	1B		NO
	.F0
	TADI	=SPLJOB		GET THE SPOOLER BUSY FLAG
	.CUR
	SMA CLA			WAS THE ABORT BIT SET ?
	JMP	2F		NO
	TAD	=DEL		CLEAR THE PRINTER BUFFER
	JMS	PRINTC
	JMP	ZEXIT		AND EXIT
*
2H	ISZ	ZLEN		YES, PRINTED ENTIRE FILE ?
	JMP	FOUNDL		NO
	JMS	ZCRLF		Yes, output a CR/LF to complete the line
	JMP	ZEXIT		and exit
*
*	PRINT SPOOLER SUBROUTINES
*
*	OUTPUT A CHARACTER TAKEN FROM SPOOL FILE
*
	PART
ZOUT	SUB
	AND	=0177		STRIP PARITY
	TAD	=-ESC
	SNA			AN ESCAPE CHARACTER ?
	TAD	=DOLLAR-ESC	YES, CHANGE IT TO '$'
	IAC
	SNA			AN END-OF-FILE MARKER ?
	JMP	ZEXIT		YES, EXIT
	TAD	=CTRLZ-CR
	SZA			A CARRIAGE RETURN ?
	JMP	3F		NO
	TAD	=CR
1H	JMS	PRINTC
2H	DCA	ZCOL		YES, CLEAR COLUMN COUNTER
	RET	ZOUT
*
3H	IAC
	SZA			A FORM FEED ?
	JMP	4F		NO
	JMS	ZCRLF		Output a CR/LF combo to complete the line
	TAD	=FF		EJECT THE PAGE
	JMP	1B
*
4H	TAD	=FF-TAB
	SZA			A TAB ?
	JMP	6F		NO, JUST A NORMAL CHARACTER
	TAD	ZCOL		GET THE COLUMN COUNT
	AND	=07
	TAD	=-8		YES
	DCA	ZCNTR2
5H	TAD	=SPACE		OUTPUT SPACES
	JMS	PRINTC
	ISZ	ZCNTR2		FINISHED TABBING ?
	JMP	5B		NO
	DCA	ZCOL
	RET	ZOUT
*
6H	TAD	=TAB		RESTORE THE CHARACTER
	JMS	PRINTC
	TAD	ZCHAR		GET LAST CHARACTER PRINTED
	AND	=07740
	SNA CLA			WAS IT A CONTROL CHARACTER ?
	JMP	2B		YES
	ISZ	ZCOL		NO, JUST COUNT THE COLUMNS
	RET	ZOUT
	RET	ZOUT		SAFETY
*
*	PRINT A SINGLE CHARACTER
*
	PART
PRINTC	SUB
	AND	=0177		STRIP PARITY
	DCA	ZCHAR		SAVE THE CHARACTER FOR LATER CHECKING
	LDI	02000
	AND	ZJOB
	SNA CLA			CHECK FOR FOLDING LOWER CASE TO UPPER CASE ?
	JMP	1F		NO
	TAD	ZCHAR		YES, GET THE CHARACTER
	TAD	=-0140
	SPA CLA			IS IT LOWER CASE ?
	JMP	1F		NO
	TAD	ZCHAR		YES, FOLD IT TO UPPER CASE
	TAD	=-040
	DCA	ZCHAR
1H	TAD	ZCHAR
	TAD	=-LF
	ROOM	6
	SZA			IS IT A LINE FEED ?
	JMP	3F		NO
	AIF	FFNPL.EQ.0,.CONT
	ISZ	ZLINES		YES, COUNT THE LINES
	NOP			SAFETY IN EVENT NO FORM FEEDS
.CONT	TAD	=LF		SEND THE LINE FEED
	JMS	ZPRINT		TRANSMIT THE LINE FEED
	AIF	LFNUL.EQ.0,.CONT
	LDI	LFNUL
	JMS	ZNULL		TRANSMIT NULLS
.CONT	JMP	7F
*
3H	TAD	=LF-FF
	SNA CLA			IS THIS CHARACTER A FORM FEED ?
	JMP	4F		YES
	TAD	ZCHAR
	JMS	ZPRINT		PRINT THE CHARACTER
	JMP	7F
*
4H	TAD	ZLCHAR		GET THE LAST CHARACTER PRINTED
	TAD	=-FF
	SNA CLA			WAS IT ALSO A FORM FEED ?
	RET	PRINTC		YES, IGNORE THIS ONE
	TAD	=CR		Output a CR/LF combo
	JMS	ZPRINT			to complete the line
	TAD	=LF
	JMS	ZPRINT
	TAD	ZCHAR		NO, EJECT THE PAGE
	JMS	ZPRINT		TRANSMIT THE FORM FEED
	AIF	FFNPL.EQ.0,.CONT
	TAD	ZLINES		GET THE LINE COUNT
	TAD	=-88		ASSUME 88 LINES PER PAGE
	SMA			MODULATE WITH 88
	JMP	*-2
	DCA	ZLINES
5H	LDI	FFNPL
	JMS	ZNULL		TRANSMIT NULLS
	ISZ	ZLINES		FINISHED ?
	JMP	5B		NO
.CONT	ANOP
7H	CAL
	TAD	ZCHAR		MAKE THIS CHARACTER THE LAST CHARACTER
	DCA	ZLCHAR
	RET	PRINTC
*
*	PRINT A CHARACTER
*
	PART
ZPRINT	SUB
	IOT	LA8,LS
	CAL
	RET	ZPRINT
*
*	OUTPUT NULLS
*	ENTER WITH NULL COUNT IN AC
*
	PART
ZNULL	SUB
	CIA
	DCA	ZCNTR3
1H	IOT	LA8,LS		TRANSMIT A NULL
	ISZ	ZCNTR3		FINISHED ?
	JMP	1B		NO
	RET	ZNULL
*
*	PRINT TWO CHARACTERS OF FILE NAME
*
	PART
ZNAME	SUB
	DCA	ZTEMP
	TAD	ZTEMP
	RAR6
	JMS	1F		PRINT FIRST CHARACTER
	TAD	ZTEMP
	JMS	1F		PRINT SECOND CHARACTER
	RET	ZNAME
*
*	BIAS AND PRINT A CHARACTER OF FILE NAME
*
1H	SUB
	AND	=077		EXTRACT THE CHARACTER
	SNA			END OF NAME ?
	RET	ZNAME		YES
	TAD	=-SPACE
	SPA			ALPHABETIC OR NUMERIC ?
	TAD	=0100		ALPHABETIC
	TAD	=SPACE		NUMERIC
	JMS	PRINTC
	RET	1B
*
*	Output a CR/LF combination
*
ZCRLF	SUB
	TAD	=CR		Get carriage return character
	JMS	ZPRINT		Output it
	TAD	=LF		Get line feed character
	JMS	ZPRINT		Output it
	RET	ZCRLF		Return
*
*	OUTPUT A PRINT SPOOLER MESSAGE TO THE LINE PRINTER
*
	PART
ZMES	SUB
	DCA	ZXRMES
2H	TADI	ZXRMES		GET A CHARACTER PAIR
	DCA	ZTEMP
	TAD	ZTEMP
	RAR6
	JMS	3F		OUTPUT A CHARACTER
	TAD	ZTEMP
	JMS	3F		OUTPUT NEXT CHARACTER
	JMP	2B		GET ANOTHER CHARACTER PAIR
*
*	INTERPRET AND PRINT A CHARACTER
*
3H	SUB
	AND	=077
	SNA			END OF MESSAGE ?
	RET	ZMES		Yes
	TAD	=-SPACE
	SPA			ALPHABETIC OR NUMERIC ?
	TAD	=0100		ALPHABETIC
	TAD	=SPACE		NUMERIC
	JMS	PRINTC		PRINT THE CHARACTER
	RET	3B
*
*	PRINT 4 SPACES
*
	PART
SPACES	SUB
	TAD	=-4
	DCA	ZCNTR2
1H	TAD	=SPACE
	JMS	PRINTC
	ISZ	ZCNTR2		FINISHED ?
	JMP	1B		NO
	RET	SPACES
*
	PART
ZDEVER	JMS	SPACES
	JMS	SPACES
	TAD	=SDE		'SPOOL DEVICE ERROR'
	JMS	ZMES
	JMP	ZEXIT		EXIT
*
	DSEC
*
ZBUFF	AS	0400,KHLT	SPOOLER READ BUFFER
*
*END OF PRINT SPOOLER
*
.NO:SPOOL ANOP
*
*	Compute highest address used in this field.
*
	.END