	FILE	MULTOS-8 HARDWARE PROCESSOR
	TITLE	HARDWARE PROCESSOR EDIT NUMBER
*
*       MULTOS was purchased in a group purchase and put into the
*       PUBLIC DOMAIN. It can be freely distributed.
*       WALLY KALINOWSKI  213 336-6940  
*       18925 Felbar
*       Torrance Cal.    90504
*	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.
*OSC CONTAINS THE HARDWARE INTERRUPT PROCESSOR
*
EDIT3	EQU	390		19 Aug 79
*
*	EDIT HISTORY
*
*EDIT	DATE		REASON
*311	24 SEP 78	CORRECT BUG IN DSKQCHK
*312	24 SEP 78	INCREASED TIME IN 'DTGO' TIMEOUT LOOP
*313	24 SEP 78	CHANGED 3 TO 4 FOR REVERSE DECTAPE AT 'D7A'
*314	28 SEP - 1 OCT 78	ADDED PERTEC DISK SUPPORT
*315	 2 OCT 78	ADDED NON-CONTIGUOUS MEMORY SUPPORT
*350	 4 OCT 78	ADDED DATA PRINTER V132 SUPPORT
*371	25 OCT 78	MAINTENANCE
*372	26 OCT 78	ADDED POWER UP PRINTER ENABLE CHARACTER
*373	 1 NOV 78	MAINTENANCE
*374	 2 NOV 78	MAINTENANCE
*376	 4 Nov 78	Maintenance
*378	 4 Nov 78	Added automatic memory size determination
*379	11 Nov 78	Maintenance
*380	17 Nov 78	Maintenance
*381	18 Nov 78	Maintenance
*382	24 Nov 78	Maintenance
*384	 4 Jan 79	Added '.END' Macro
*386	 7 Feb 79	Fixed bug re system halt for bad RK05 #0 sector.
*387	 9 Jun 79	Added clear printer keyboard flag instruction.
*388	12 Jul 79	Added extended time quantum for compute-bound jobs.
*389	13 Aug 79	Added support for 6 terminals.
*390	19 Aug 79	Ditto.
	TITLE	PAGE ZERO
*
	FIELD	1
	DSEC
*
QPCSV	DC	0		INTERRUPT PC BROUGHT UP FROM FIELD 0
	AS	6,KHLT		SAFETY AND ODT
*
NULLPTR	DC	0		USED BY NULL JOB
*
AXR	DC	0		AUTO-INDEX REGISTERS
AXR1	DC	0
AXR2	DC	0
AXR3	DC	0
AXR4	DC	0
DTADDR	DC	0		USED BY TD8E DECTAPE
AXR6	DC	0		USED BY RX8E FLOPPY ROUTINES
AXR7	DC	0		USED BY RX8E FLOPPY ROUTINES
*
JOB	DC	0		CURRENT JOB
INJOB	DC	0		JOB CURRENTLY SWAPPING INTO MEMORY
*
*	HARDWARE INTERRUPT REGISTER STORAGE
*
FLSV	DC	0		CPU FLAGS
ACSV	DC	0		AC
MQSV	DC	0		MQ
SCSV	DC	0		STEP COUNTER/EAE MODE FORMAT:
*				BITS 0-5 UNUSED
*				PDP-8/I FORMAT:
*				BITS 7-11 CONTAIN STEP COUNTER
*				PDP-8/E FORMAT:
*				BITS 6-10 CONTAIN STEP COUNTER
*				BIT 11 CONTAINS MODE:
*					(0=MODE B, 1=MODE A)
TEMP	DC	0		GENERAL PURPOSE TEMPORARY
CNTR	DC	0		GENERAL PURPOSE COUNTER
PNTR1	DC	0		GENERAL PURPOSE POINTERS
PNTR2	DC	0
PNTR3	DC	0
*
*	FIELD INFORMATION WORDS
*	THESE WORDS DESCRIBE THE ACTIVITY IN EACH MEMORY FIELD
*		BIT(S)	DESCRIPTION
*		0	THIS FIELD IS THE JOB'S INST FIELD
*		1	THIS FIELD IS THE JOB'S DATA FIELD
*		2	THIS FIELD IS LOCKED IN CORE (UNSWAPPABLE)
*		3	THIS FIELD DOES NOT EXIST
*		4-5	RESERVED FOR FUTURE EXPANSION
*		6-8	JOB'S RELATIVE FIELD NUMBER
*		9-11	JOB NUMBER
*

FPNTR	DC	0		POINTER TO ONE OF FIELD INFO WORDS
FIELD0	EQU	FPNTR		USED FOR REFERENCE PURPOSES ONLY
FPNTR2	DC	0		POINTER TO ONE OF FIELD INFO WORDS
FIELD1	EQU	FPNTR2		USED FOR REFERENCE PURPOSES ONLY
FIELD2	DC	0
FIELD3	DC	0
FIELD4	DC	0400		Set to indicate non-existence
FIELD5	DC	0400
FIELD6	DC	0400
FIELD7	DC	0400
*
	AIF	NO:PTR,.PTR
*
*	PR8-E STATUS REGISTERS
*	##########################################################
*	##	THE READER IS ASSIGNED TO A SPECIFIC JOB	##
*	##	AND CAN ONLY BE ACCESSED BY THAT JOB		##
*	##########################################################
*
READER	DC	0		NEGATED READER JOB NUMBER
RBF	DC	RB		READER BUFFER FILL POINTER
RCNTR	DC	-128		READER CHARACTER COUNTER
*
.PTR	ANOP
*
	AIF	NO:PTP,.PTP
*
*	PP8-E STATUS REGISTERS
*	##########################################################
*	##	THE PUNCH IS ASSIGNED TO A SPECIFIC JOB		##
*	##	AND CAN ONLY BE ACCESSED BY THAT JOB		##
*	##########################################################
*
PUNCH	DC	0		NEGATED PUNCH JOB NUMBER
PBE	DC	PB		PUNCH BUFFER EMPTY POINTER
PCNTR	DC	-128		PUNCH CHARACTER COUNTER
PMF	DC	0		PUNCH MOTION FLAG
*
.PTP	ANOP
*
*	LA8-E LINE PRINTER STATUS REGISTERS
*	##########################################################
*	##	THE LINE PRINTER IS ASSIGNED TO A SPECIFIC	##
*	##	JOB AND CAN ONLY BE ACCESSED BY THAT JOB	##
*	##########################################################
*
PRINTER	DC	0		NEGATED PRINTER JOB NUMBER
LBE	DC	LPB		LINE PRINTER BUFFER EMPTY POINTER
LCNTR	DC	-128		LINE PRINTER CHARACTER COUNTER
LMF	DC	0		LINE PRINTER MOTION FLAG
LEF	DC	0		LINE PRINTER SOFTWARE ERROR FLAG
*
	AIF	NO:MAGTAPE,.CONT
*
MTJOB	DC	0		HOLDS MAGTAPE JOB NUMBER (ALSO BUSY FLAG)
MTQE	DC	MTQB		MAGTAPE QUEUE BUFFER EMPTY POINTER
MTTRF	DC	0		MAGTAPE TRANSPORT READY FLAG
*
.CONT	ANOP
*
	AIF	NO:DECTAPE,.DECTAPE
*
DTJOB	DC	0		HOLDS DECTAPE JOB NUMBER (ALSO BUSY FLAG)
DTQE	DC	DTQB		DECTAPE QUEUE BUFFER EMPTY POINTER
DTERR	DC	0		ERROR RETRY COUNTER
DTFUNC	DC	0		FUNCTION WORD
DTBLOCK	DC	0		LOGICAL BLOCK NUMBER
DTFPNTR	DC	0		POINTER TO FIELD INFO WORD
*
	AIF	TD8E,.TD8E
*
	CLA HLT
*
	AGO	.DECTAPE
*
.TD8E	ANOP
*
DTCURB	DC	0		TD8E CURRENT BLOCK NUMBER
DTSUM	DC	0		CHECKSUM
DTPGCT	DC	0		PAGE COUNTER
DTWDCT	DC	0		PAGE WORD COUNTER
DTFLAG	DC	0		TD8E CLOCK TICK COUNTDOWN FLAG
DTCLOCK	DC	0		TD8E CLOCK TICK COUNTER
DTPNTR	DC	0		TD8E POINTER
DTCNTR	DC	0		TD8E COUNTER
DTTEMP	QUT	%*,*		TD8E TEMPORARY
DTCDF	HLT			'DF' TO TRANSFER FIELD
	HLT
	JMPI	DTCDF
*
.DECTAPE ANOP
*
*	DISK STATUS REGISTERS
*
DSKJOB	DC	0		CURRENT DISK JOB NUMBER
DQF	DC	DQB		DISK QUEUE BUFFER FILL POINTER
DQE	DC	DQB		DISK QUEUE BUFFER EMPTY POINTER
DSKFUN	DC	0		DISK FUNCTION WORD
DSKCOR	DC	0		DISK MEMORY ADDRESS
DSKBLK	DC	0		DISK BLOCK NUMBER
BLOCKS	DC	0		DISK ADDRESS
PAGES	DC	0		PAGE COUNT
	AIF	SYS:DISK.NE.PERTEC,.CONT
DSKCYL	QUT	%*,PAGES	PERTEC DISK CYLINDER ADDRESS
.CONT	ANOP
DSKCMD	DC	0		DISK COMMAND
DSKERR	DC	0		DISK ERROR COUNTER
DSKPNTR	DC	0		POINTS TO DISK JOB WAIT WORD
DSKTEM	DC	0		DISK TEMPORARY
*
	AIF	NO:FLOPPY,.CONT
*
*	RX8-E FLOPPY DISK STATUS REGISTERS
*	(BOTH FLOPPY DRIVES AND ALL 4 LOGICAL DEVICES
*		RXA0, RXA1, R0 AND R1 ARE ASSIGNED TO A SINGLE JOB.)
*
RXJOB	DC	0		FLOPPY JOB NUMBER (ALSO BUSY FLAG)
RXMDRW	DC	0		FLOPPY COMMAND WORD
RXQE	DC	RXQB		FLOPPY QUEUE EMPTY POINTER
RXERR	DC	0		RX8E ERROR COUNTER
RXTEM	DC	0		JUST A TEMP
RXTEM2	DC	0		DITTO
RXTEM3	DC	0		DITTO
RXTRACK	DC	0		COMPUTED TRACK ADDRESS
RXCNTR	DC	0		SECTOR DATA COUNTER
RXCONST	DC	0		12-BIT WORD OR 8-BIT BYTE COUNT
RXWC	DC	0		TRANSFER WORD COUNT
RXFUNC	DC	0		FUNCTION WORD
RXADDR	DC	0		TRANSFER MEMORY ADDRESS
RXLOGB	DC	0		LOGICAL BLOCK NUMBER
RXBLOCK	DC	0		LOGICAL BLOCK WORKING LOCATION
RXFPNTR	DC	0		POINTER TO FLOPPY FIELD INFO WORD
RXTBLK	EQU	*		USED BY RXST8 TO CALCULATE SECTOR
RXCDF	HLT			SUBR TO CHANGE DF TO TRANSFER FIELD
	HLT
	JMPI	RXCDF
*
.CONT	ANOP
*
*	EXECUTE ANY INSTRUCTION
*	(HAVING THIS ON PAGE ZERO REMOVES 'DF' SETTING PROBLEMS.)
*
ANY	HLT
QANY	HLT
	JMPI	ANY		NO SKIP
	INC	ANY		SKIP
	JMPI	ANY
*
*	NEW INSTRUCTIONS
*
PARAM	EQU	04400+*		GET A JOB PARAMETER
	QPARAM
*
QSUSP	DC	SCHEDULER		POINTER TO SCHEDULER
*
QXDISK	DC	QEXDISK		POINTER TO SCHEDULER
*	LOCATIONS USED BY QEXDISK
QFUNC	DC	0		FUNCTION WORD
QADDR	DC	0		CORE ADDRESS
QBLOCK	DC	0		DISK SECTOR ADDRESS
*
*	REGISTERS USED BY THE SCHEDULER
*
SKEDJOB	DC	0		LAST JOB CHECKED FOR 'RUNABILITY'
SKEDPTR	DC	0		POINTS TO USER STATUS INFO
SKEDCTR	DC	0		COUNTS THE JOBS
SKEDTEM	DC	0		SCHEDULER TEMPORARY
SKEDDW	DC	0		SCHEDULER DEVICE WAIT BITS
SKEDLW	DC	0		SCHEDULER LOGIC WAIT BITS
*
*	MISCELLANEOUS REGISTERS
*
TIME	AS	2		DOUBLE PRECISION TIME IN CLOCK TICKS
*
JTIME	DC	-QUANTUM	JOB TIME QUANTUM (IN NEGATIVE TICKS)
*
TTYNUM	DC	0		USED BY TTYRT
*
WTPNTR	DC	0		WAIT POINTER USED BY ALL IOF HARDWARE ROUTINES
*
	ALIGN
*
*	Copyright Notice embedded within the code makes it
*	illegal to reproduce the object code without authorization.
*
	TEXT	/COPYRIGHT (C) 1978, 1979 BY COMPUTER METHODS,/
	TEXT	/7822 OAKLEDGE ROAD, SALT LAKE CITY, UT 84121, USA@/
*
	ISEC	0
	ORG	BUFFEND
*
*	PARAMETER POINTER FETCH ROUTINE (IOF)
*
	PART
	ROOM	10
QPARAM	SUB
	CDF	%*
	SNA			USE CURRENT JOB ?
	TAD	JOB		YES
	MULT64
	TAD	=JOB1-USER:ST
	TADI	QPARAM		GET THE PARAMETER
	INC	QPARAM		BUMP RETURN
	DCA	PNTR1
	CDF	%TABLES
	RET	QPARAM
	TITLE	START OF INTERRUPT SKIP CHAIN
*
	PART
NTRRPT	DCA	ACSV		SAVE HARDWARE REGISTERS -- AC
	SWP
	DCA	MQSV		MQ
	GTF
	AND	=06177		STRIP OFF UNUSED HARDWARE FLAGS
	DCA	FLSV		FLAGS
	TADI	=PCSV		GET THE INTERRUPT PC
	DCA	QPCSV
	TITLE	POWER FAIL
*
KP8E	IOS	KP8,SPL		POWER LOW ?
	JMP	CHAIN		NO
	CDF	%PCSV
	TAD	=KCID+(%POWER:UP.LS.3)
	DCAI	=PCSV
	TAD	=POWER:UP
	DCAI	=PCSV+2
	AIF	NO:EAE,.EAE
	SCA			GET THE STEP COUNTER
	AIF	PDP8I,.PDP8I
	CLL RAL			LEAVE ROOM FOR MODE BIT
.PDP8I	ANOP
	DCA	SCSV		SAVE THE STEP COUNTER
	AIF	PDP8I,.EAE
	CAM
	DSI	DPSZ		WHICH EAE MODE ?
	HLT			MODE A
	INC	SCSV		MODE B
.EAE	ANOP
	HLT			STOP EVERYTHING !
	TITLE	POWER UP
*
	AIF	SYS:DISK.EQ.RK8E,.RK8E
	AIF	SYS:DISK.NE.RK8L,.RL01
.RK8E	ANOP
2H	IOT	DSK,DRST	READ DISK READY STATUS
	AGO	.POWER
.RL01	AIF	SYS:DISK.NE.RL01,.PERTEC
	NOTE:	RL01 DISK NOT SUPPORTED YET
	MONR			ABORT ASSEMBLY AND RETURN TO OS/8
	AGO	.POWER
.PERTEC	ANOP
2H	LDI	4
	AND	DSKFUN		GET THE L O BIT OF THE DRIVE NUMBER
	CLL RTR			RIGHT JUSTIFY
	DI	DLDC		SENSE/CLEAR ATTENTION FLAG
	CAL
	DI	DRST		GET THE DISK STATUS
.POWER	ANOP
POWER:UP QUT	%*,2B
	SZA CLA			IS IT UP TO SPEED YET ?
	JMP	2B		NO, WAIT FOR IT
	AIF	DKC8AA.EQ.0,.POWER
	IOT	KP8,CACL	CLEAR AC LOW FLAG ON PDP-8/A
.POWER	ANOP
	TAD	=INTERRUPT	RESET INTERRUPT VECTOR
	DCAX	PCSV+2
	AIF	NO:EAE,.EAE
	TAD	SCSV		GET THE STEP COUNTER AND EAE MODE
	AIF	PDP8I,.PDP8I
	CLL
	SPA			WHICH EAE MODE ?
	STL			MODE B
.PDP8I	ANOP
	CMA			THIS IS EAE MODE A CODE
	ROOM	4
	DCA	1F
	LDI	SCL		LOAD THE STEP COUNTER
	ERM
1H	HLT
	AIF	PDP8I,.PDP8I
	SZL			WHICH EAE MODE ?
	SWAB			MODE B
.EAE	ANOP
	TAD	DSKJOB		NOW CHECK THE DISK BUSY FLAG
	SNA			DISK TRANSFER IN PROGRESS WHEN POWER FAILED ?
	JMP	TIMESHARE	NO
	MQL			YES, SAVE THE JOB NUMBER TEMPORARILY
	DCA	DSKJOB		CLEAR THE BUSY FLAG
	TAD	=DISK2		INITIALIZE THE DISK CO-ROUTINES
	DCA	DSK:CO
	MQA			GET THE DISK JOB NUMBER
	.EXDISK			YES, DO THE TRANSFER AGAIN
TIMESHARE IOT	LA8,EIN		ENABLE LINE PRINTER
	AIF	V132.EQ.0,.CONT
	DI	LIP		INITIATE PRINTING
	DI	LRLC		REQUEST LOAD CYCLE
	DSI	LSSD		SKIP ON SEND DATA TRUE
	JMP	*-1
	LDI	1
	DI	LPBC
.CONT	AIF	UPCHAR.EQ.0,.CHAR
	TAD	=UPCHAR		BRING THE LINE PRINTER ON LINE
.CHAR	IOT	LA8,LS		START THE PRINTER
	CAL
	IOT	TTY1,LS		SET TTY #1 FLAG
	AIF	KL8A,.KL8A:TFL
	IOT	TTY2,LS		SET TTY #2 FLAG
	AIF	TERMS.EQ.2,.TERMS:TFL
	IOT	TTY3,LS		SET TTY #3 FLAG
	AIF	TERMS.EQ.3,.TERMS:TFL
	IOT	TTY4,LS		SET ALL TTY FLAGS
	AIF	TERMS.EQ.4,.TERMS:TFL
	IOT	TTY5,LS		SET TTY #5 FLAG
	AIF	TERMS.EQ.5,.TERMS:TFL
	IOT	TTY6,LS		SET TTY #6 FLAG
.TERMS:TFL AGO	.TIMESHARE
.KL8A:TFL ANOP
	IOT	KL8AX,XMIT	SET ALL KL8A OUTPUT FLAGS
	TAD	=0400
	IOT	KL8AX,XMIT
	CLL RAL
	IOT	KL8AX,XMIT
.TIMESHARE ANOP
	AIF	DK8EP.OR.DKC8AA,.ODD:CLOCK:UP
	IOT	DK8,CLEI	TURN ON THE CLOCK
	AGO	.CLOCK:UP
.ODD:CLOCK:UP ANOP
	AIF	DK8EP,.PROG:CLOCK:UP
	LDI	1
	IOT	DK8,CLLE	'CLLE' MAY NOT CLEAR AC
	AGO	.CLOCK:UP
.PROG:CLOCK:UP ANOP
	CAL			AC MAY NOT HAVE BEEN CLEAR
	TAD	=-1000		SET CLOCK COUNTER FOR 1000 COUNTS
	IOT	DK8,CLAB
	TAD	=ENABLE+1000	ENABLE INTERRUPTS, SET MODE & FREQ
	IOT	DK8,CLOE	'CLOE' DOES NOT CLEAR AC
.CLOCK:UP ANOP
	AIF	FLOPPY,.FLOPPY
	CAL			AC WAS NOT CLEAR
	AIF	NO:FLOPPY,.NO:FLOPPY
.FLOPPY	ANOP
	LDI	1
	IOT	RX8,INTR	TURN ON THE FLOPPY
	CAL			'INTR' DOES NOT CLEAR AC
.NO:FLOPPY ANOP
	AIF	NO:KL8A,.NO:KL8A
	WHAT POWER UP INITIALIZATION FOR KL8A ?
.NO:KL8A ANOP
	AIF	NO:DECTAPE,.DECTAPE
*	WHAT INITIALIZATION FOR DECTAPE ?
.DECTAPE ANOP
	AIF	NO:MAGTAPE,.MAGTAPE
	DI	CLF		CLEAR THE CONTROLLER AND MASTER
	DCA	MTJOB		AND THROW OUT THE MAGTAPE JOB
.MAGTAPE ANOP
.TIMESHARE:UP ANOP
	TITLE	INTERRUPT RETURN SEQUENCE
*
	PART
RETURN	EQU	*
*
	AIF	NO:TD8E,.TD8E
*
	LDI	1
	TAD	DTFLAG		GET THE TD8E COUNTDOWN FLAG
	SZA CLA			DOES THE TD8E NEED SERVICE ?
	JMP	1F		NO
	JMS	QTD8E		YES
	JMP	KP8E		CHECK ALL OTHER DEVICES
.TD8E	ANOP
1H	SRQ			ANOTHER INTERRUPT PENDING ?
	JMP	1F		NO
	JMP	KP8E		YES, START WITH POWER FAIL
1H	TAD	JOB
	SNA CLA			EXECUTE A JOB ?
	.SUSPEND		NOTHING TO DO, EXECUTE THE NULL JOB
	AIF	NO:EAE.AN.PDP8I,.MQ
	TAD	MQSV		RESTORE HARDWARE REGISTERS
	MQL
.MQ	ANOP
	TAD	FLSV
	AIF	PDP8I,.I
	ROOM	7
.I	ANOP
	RTF
	AIF	PDP8I,.I
	AND	=UM
	SNA CLA			DISABLE INTERRUPT SYSTEM ?
	IOF			YES
.I	ANOP
	TAD	ACSV		GET AC
	ERM
	JMPI	QPCSV		RUN CURRENT JOB
	TITLE	INTERRUPT SKIP CHAIN CONTINUATION
*
CHAIN	DC	PRKEY		CLEAR PRINTER KEYBOARD FLAG
	IOS	DK8,CLSK	A CLOCK TICK ?
	JMP	*+2		NO
	JMS	DK8E
	AIF	SYS:DISK.EQ.RK8E,.RK8E
	AIF	SYS:DISK.NE.RK8L,.RL01
.RK8E	IOS	DSK,SF		RK8E DISK COMPLETION ?
	AGO	.DISK
.RL01	AIF	SYS:DISK.NE.RL01,.PERTEC
	NOTE:	RL01 DISK NOT YET SUPPORTED
	MONR			ABORT ASSEMBLY AND RETURN TO OS/8
.PERTEC	ANOP
	DSI	DSAE		DISK COMPLETION ?
.DISK	ANOP
	JMP	*+2		NO
	JMS	QDISK
	AIF	NO:MAGTAPE,.CONT
	DSI	SKJD		TM8E TAPE JOB DONE ?
	JMP	*+2		NO
	JMS	TM8E
	DSI	SKEF		TM8E TAPE ERROR ?
	JMP	*+2		NO
	JMS	TM8E
	ISZ	MTTRF		WAITING FOR TRANSPORT READY FLAG ?
	JMP	*+2		NO
	JMP	TM8ETR		YES, NOW IT CAN BE SERVICED
	DCA	MTTRF		CLEAR THE TRANSPORT READY FLAG
.CONT	ANOP
	AIF	NO:FLOPPY,.CONT
	IOS	RX8,SDN		RX8E FLOPPY DONE ?
	JMP	*+2		NO
	JMS	RX8E
.CONT	ANOP
	AIF	NO:PTR,.PTR
	IOS	PR8,SF		PAPER TAPE READER ?
	JMP	*+2		NO
	JMS	PR8E
.PTR	ANOP
	AIF	NO:PTP,.PTP
	IOS	PP8,SF		PAPER TAPE PUNCH ?
	JMP	*+2		NO
	JMS	PP8E
.PTP	AIF	V132,.V132
LA8SE	IOS	LA8,SE		IS THE HARDWARE ERROR FLAG SET ?
	JMP	1F		NO
	INC	LEF		YES, SET THE SOFTWARE ERROR FLAG
	IOT	LA8,DIN		DISABLE LINE PRINTER INTERRUPTS
	TAD	=KNOP		REPLACE ERROR FLAG TEST INSTRUCTION
	DCA	LA8SE
1H	IOS	LA8,SF		LINE PRINTER ?
	JMP	*+2		NO
	JMS	LA8E
	AGO	.PRINT
*
.V132	ANOP
LA8SE	DSI	LSRF		IS PRINTER RUN FLAG SET ?
	LDI	1		NO, SET ERROR FLAG
	DCA	LEF
	DSI	LSPR		IS PRINTER READY FLAG SET ?
	JMP	*+2		NO
	JMS	QV132
.PRINT	ANOP
	LDI	1
	DCA	TTYNUM		INITIALIZE TTY NUMBER
	IOS	KEY1,SF		TERMINAL # 1 KEYBOARD ?
	JMP	*+2		NO
	JMS	TTYRT
	IOS	TTY1,SF		TERMINAL # 2 PRINTER ?
	JMP	*+2		NO
	JMS	TTYRT
	INC	TTYNUM
	AIF	KL8A,.KL8A:CHAIN
	IOS	KEY2,SF		TERMINAL # 2 KEYBOARD ?
	JMP	*+2		NO
	JMS	TTYRT
	IOS	TTY2,SF		TERMINAL # 2 PRINTER ?
	JMP	*+2		NO
	JMS	TTYRT
	AIF	TERMS.EQ.2,.TERMS:CHAIN
	INC	TTYNUM
	IOS	KEY3,SF		TERMINAL # 3 KEYBOARD ?
	JMP	*+2		NO
	JMS	TTYRT
	IOS	TTY3,SF		TERMINAL # 3 PRINTER ?
	JMP	*+2		NO
	JMS	TTYRT
	AIF	TERMS.EQ.3,.TERMS:CHAIN
	INC	TTYNUM
	IOS	KEY4,SF		TERMINAL # 4 KEYBOARD ?
	JMP	*+2		NO
	JMS	TTYRT
	IOS	TTY4,SF		TERMINAL # 4 PRINTER ?
	JMP	*+2		NO
	JMS	TTYRT
	AIF	TERMS.EQ.4,.TERMS:CHAIN
	INC	TTYNUM
	IOS	KEY5,SF		TERMINAL # 5 KEYBOARD ?
	JMP	*+2		NO
	JMS	TTYRT
	IOS	TTY5,SF		TERMINAL # 5 PRINTER ?
	JMP	*+2		NO
	JMS	TTYRT
	AIF	TERMS.EQ.5,.TERMS:CHAIN
	INC	TTYNUM
	IOS	KEY6,SF		TERMINAL # 6 KEYBOARD ?
	JMP	*+2		NO
	JMS	TTYRT
	IOS	TTY6,SF		TERMINAL # 6 PRINTER ?
	JMP	RETURN		NO
	JMS	TTYRT
.TERMS:CHAIN AGO .CHAIN:END
.KL8A:CHAIN ANOP
	WHAT DO I DO ?
.CHAIN:END ANOP
	JMP	RETURN		CHECK FOR ANOTHER INTERRUPT
	TITLE	HARDWARE SERVICE SUBROUTINES
*
	AIF	NO:PTR,.PTR
*
*	PR8-E PAPER TAPE READER
*
	PART
PR8E	SUB
	TAD	READER		GET NEGATED JOB NUMBER
	SZA			IS THE READER ASSIGNED ?
	JMP	1F		YES
	IOT	PR8,RRB		NO, CLEAR ITS FLAG
	CAL			THROW THE CHARACTER AWAY
	CDF	%*
	RET	PR8E		AND EXIT
*
1H	CIA
	.PARAM	DWAIT
	LDI	-(READW+1)	TEAR DOWN READER WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1		NEW JOB WAIT WORD
	LDI	04000		MAKE AC NON-ZERO
	IOT	PR8,RRB		GET THE READER CHARACTER
	CDF	%RB
	DCAI	RBF		STORE CHAR IN READER BUFFER
	LDI	1		UPDATE READER BUFFER FILL POINTER
	TAD	RBF
	AND	=0177
	TAD	=RB
	DCA	RBF
	ISZ	RCNTR		READER BUFFER FULL ?
	IOT	PR8,RFC		NO, FETCH ANOTHER CHARACTER
	RET	PR8E
*
.PTR	ANOP
*
	AIF	NO:PTP,.PTP
*
*	PP8-E PAPER TAPE PUNCH
*
	PART
PP8E	SUB
	CDF	%*
	IOT	PP8,CF		CLEAR THE PUNCH FLAG
	DCA	PMF		AND PUNCH MOTION FLAG
	TADI	PBE		GET A CHAR FROM BUFFER
	SNA			PUNCH BUFFER EMPTY ?
	RET	PP8E		YES, JUST RETURN
	IOT	PP8,LS		NO, PUNCH THE CHARACTER
	DCA	PMF		AND SET MOTION FLAG
	DCAI	PBE		CLEAR BUFFER POSITION
	TAD	PBE		UPDATE BUFFER POINTER
	IAC
	AND	=0177
	TAD	=PB
	DCA	PBE
	LDI	-1		BACK UP BUFFER COUNTER
	TAD	PCNTR
	DCA	PCNTR
	TAD	PCNTR		GET BUFFER COUNT
	TAD	=128-16
	SMA SZA CLA		LESS THAN 16 CHAR'S IN BUFFER ?
	RET	PP8E		NO, JUST RETURN
	TAD	PUNCH		YES, GET NEGATED PUNCH JOB NUMBER
	CIA
	.PARAM	DWAIT
	LDI	-(PUNW+1)	TEAR DOWN PUNCH WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1		NEW JOB WAIT WORD
	CDF	%*
	RET	PP8E
*
.PTP	ANOP
*
*	KL8-JA TELETYPE INTERFACES
*
	PART
TTYRT	SUB
	TAD	TTYNUM		GET INTERRUPT TTY NUMBER
	.PARAM	OUTIOT
	TADI	PNTR1		GET OUTPUT IOT FOR THIS TTY
	TAD	=-5		FORM A 'TSF' INSTRUCTION
	DCA	QANY		SAVE IT
	ROOM	3
	JMS	ANY		TERMINAL PRINTER OR KEYBOARD ?
	ERM
	JMP	TTYREC		KEYBOARD
	INC	QANY		FORM A 'TCF' INSTRUCTION
	JMS	ANY		CLEAR THE TERMINAL PRINTER FLAG
	INC	PNTR1		POINT TO TTY MOTION FLAG
	DCAI	PNTR1		CLEAR THIS TTY MOTION FLAG
	LDI	2
	TAD	PNTR1
	DCA	PNTR2		POINT TO OBE POINTER
	TADI	PNTR2		GET OBE POINTER
	DCA	PNTR3
	CDF	%BUFFERS
	TADI	PNTR3		LOOK IN THE OUTPUT BUFFER
	CDF	%TABLES
	SNA			ANYTHING TO PRINT ?
	RET	TTYRT		NO, FORGET IT
	INC	QANY		YES --
	INC	QANY			FORM A 'TLS' INSTRUCTION,
3H	JMS	ANY			PRINT THE CHARACTER
	DCAI	PNTR1			AND SET TTY MOTION FLAG
	CDF	%BUFFERS
	DCAI	PNTR3		CLEAR OUTPUT BUFFER POSITION
	CDF	%TABLES
	TAD	PNTR3		GET OUTPUT BUFFER EMPTY POINTER
	IAC
	AND	=0177
	MQL
	TAD	PNTR3
	AND	=07600
	MQA
	DCAI	PNTR2		SAVE UPDATED POINTER
	INC	PNTR2		POINT TO OUTPUT BUFFER CHAR COUNTER
	LDI	-1
	TADI	PNTR2		BACK UP CHARACTER COUNTER
	DCAI	PNTR2
	TADI	PNTR2
	TAD	=128-16
	SMA SZA CLA		BUFFER .LE. 16 CHARACTERS ?
	RET	TTYRT		NO
	TAD	=DWAIT-MF
	TAD	PNTR1
	DCA	PNTR1		POINT TO DEVICE WAIT WORD
	TAD	=-(TTYW+1)	CLEAR TTY WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1		NEW JOB DEVICE WAIT WORD
	RET	TTYRT
*
*	KEYBOARD HANDLER FOR ALL TTY'S
*
	PART
TTYREC	LDI	-3
	TAD	QANY		FORM A 'KRB' INSTRUCTION
	DCA	QANY
	JMS	ANY		READ THE KEYBOARD CHARACTER
	MQL
	MQA
	AND	=0177		STRIP PARITY BIT
	TAD	=-CTRLC
	SNA			IS IT A CONTROL/C ?
	JMP	NCTRLC		YES
	TAD	=CTRLC-CTRLH
	SNA			IS IT A CONTROL/H ?
	JMP	NCTRLH		YES, A LOG-ON CHARACTER
	TAD	=CTRLH-CTRLS
	SNA			IS IT A CONTROL/S ?
	JMP	NCTRLQS		YES
	IAC
	IAC
	SNA			IT IS A CONTROL/Q ?
	JMP	NCTRLQS		YES
	IAC
	SNA			IS IT A CONTROL/P ?
	JMP	NCTRLP		YES
	IAC
	SNA CLA			IS IT A CONTROL/O ?
	JMP	NCTRLO		YES
TTYREC2	TAD	=IBF-OUTIOT	NO, JUST A NORMAL CHARACTER
TTYREC4	TAD	PNTR1
	DCA	PNTR1		POINTING TO IBF POINTER
TTYREC3	TADI	PNTR1
	DCA	PNTR2		POINTING INTO INPUT BUFFER
	CDF	%BUFFERS
	TADI	PNTR2		CHECK THE INPUT BUFFER
	SZA CLA			IS IT FULL ?
	RET	TTYRT		YES, IGNORE THE CURRENT CHARACTER
	LDI	04000		NO, ENSURE THAT CHARACTER IS NON-ZERO
	MQA
	DCAI	PNTR2		STORE CHARACTER IN JOB INPUT BUFFER
	CDF	%TABLES
	LDI	1		UPDATE IBF
	TAD	PNTR2
	AND	=037
	MQL
	TAD	PNTR2
	AND	=07740
	MQA
	DCAI	PNTR1		NEW IBF POINTER
	TAD	=DWAIT-IBF
	TAD	PNTR1
	DCA	PNTR1		POINT TO JOB DEVICE WAIT WORD
	TAD	=-(KEYW+1)	CLEAR KEYBOARD WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1		NEW JOB DEVICE WAIT WORD
	RET	TTYRT
*
*	CONTROL/C HANDLER
*
	PART
NCTRLC	TAD	=LWAIT-OUTIOT
	TAD	PNTR1
	DCA	PNTR1
	LDI	HALTW
	ANDI	PNTR1
	SZA CLA			IS THE JOB HALTED ?
	RET	TTYRT		YES, FORGET IT
	MQA			GET THE CHARACTER
	DCA	TEMP		SAVE IT TEMPORARILY
	TAD	=IBF-LWAIT
	TAD	PNTR1
	DCA	PNTR2
	TADI	PNTR2		GET THE IBF POINTER
	AND	=07740
	MQL
	LDI	-1		BACK UP THE BUFFER POINTER
	TADI	PNTR2
	AND	=037
	MQA
	DCA	PNTR3
	CDF	%BUFFERS
	LDI	-CTRLC
	TADI	PNTR3
	AND	=0177
	SNA CLA			WAS LAST CHARACTER ALSO A CONTROL/C ?
	JMP	NCTRLH		YES, TREAT AS A LOG-ON
	JMS	CLEAR:ALL	NO, JUST A NORMAL CONTROL/C
	CDF	%TABLES
	TAD	PNTR2		RESET PNTR1 TO IBF
	DCA	PNTR1
	TAD	TEMP		GET THE CONTROL/C
	MQL
	JMP	TTYREC3		STORE IT IN THE INPUT BUFFER
*
*	CONTROL/H (LOG ON) HANDLER
*
	PART
NCTRLH	JMS	CLEAR:ALL	CLEAR ALL I/O BUFFERS ASSIGNED THIS JOB
	CDF	%*		RELEASE ALL MEMORY ASSIGNED THIS JOB, IF ANY
	TAD	TTYNUM
	CIA
	DCA	TEMP
	TAD	=FIELD2
	DCA	FPNTR
	TAD	=-6
	DCA	CNTR
1H	TADI	FPNTR		LOOK FOR FIELDS ASSIGNED THIS JOB
	AND	=07		KEEP ONLY JOB BITS
	TAD	TEMP
	SNA CLA			IS THIS FIELD ASSIGNED THIS JOB ?
	DCAI	FPNTR		YES, RELEASE IT
	INC	FPNTR		BUMP THE POINTER
	ISZ	CNTR		CHECKED ALL FIELD INFO WORDS ?
	JMP	1B		NO
	TAD	TTYNUM
	.PARAM	DWAIT
	DCAI	PNTR1		CLEAR ALL DEVICE WAIT BITS
	INC	PNTR1		POINT TO LOGIC WAIT WORD
	LDI	NRESW		SET NON-RESIDENT WAIT BIT
	DCAI	PNTR1		NEW JOB WAIT WORD
	TAD	=04400+(%OS8RES.LS.3)	FUNCTION WORD
	DCA	QFUNC
	TAD	=OS8RES		MEMORY ADDRESS
	DCA	QADDR
	TAD	TTYNUM		FIND THE JOB STARTING SWAP BLOCK
	.FINDB
	DCA	QBLOCK
	TAD	TTYNUM
	.EXDISK			WRITE THE OS/8 START BLOCK
	CDF	%TABLES
	TAD	TTYNUM		GET THE INTERRUPT JOB NUMBER
	CIA
	TAD	JOB
	SZA CLA			IS IT THE CURRENT JOB ?
	JMP	2F		NO
	DCA	JOB		YES, CLEAR THE CURRENT JOB
	DCAI	=UJOB		ALSO CLEAR THE USER JOB
2H	TAD	PNTR1
	DCA	AXR2
	LDI	UM		SET USER MODE
	DCAI	AXR2		SET RELATIVE 'IF' AND 'DF' = 0
	DCAI	AXR2		CLEAR USER PC
	RET	TTYRT
*
*	CONTROL/O HANDLER
*
NCTRLO	JMP	NCTRLC		JUST LIKE CONTROL/C EXCEPT CONTROL/O
*				IS RETURNED TO USER
*
*	CONTROL/P HANDLER
*
	PART
NCTRLP	TAD	TTYNUM		GET THE INTERRUPT TTY NUMBER
	.PARAM	LWAIT
	TADI	PNTR1		GET THE WAIT WORD
	AND	=ISUSPW
	SNA CLA			IS THE JOB INDEFINITELY SUSPENDED ?
	JMP	1F		NO, TREAT AS A NORMAL CHARACTER
	LDI	NRESW		SET NON-RESIDENT LOGIC WAIT BIT
	DCAI	PNTR1
	RET	TTYRT
*
1H	TAD	=IBF-LWAIT
	JMP	TTYREC4		JUST TREAT AS A NORMAL CHARACTER
*
*	CONTROL/Q AND CONTROL/S HANDLER
*
NCTRLQS	MQA			GET THE CHARACTER
	DCA	TEMP		SAVE IT TEMPORARILY
	TAD	=IBF-OUTIOT
	TAD	PNTR1
	DCA	PNTR1
	TADI	PNTR1		GET THE INPUT BUFFER FILL POINTER
	AND	=07740		SET IT TO THE BUFFER BEGINNING
	DCAI	PNTR1
	TAD	=-32		SET THE BUFFER CHARACTER COUNT
	MQL
	LDI	-1
	TADI	PNTR1
	.CLEAR			CLEAR THE JOB INPUT BUFFER
	CDF	%TABLES
	TAD	PNTR1		ALSO RESET THE INPUT BUFFER EMPTY POINTER
	DCA	AXR2
	TADI	PNTR1
	DCAI	AXR2
	TAD	TEMP		GET THE CONTROL CHARACTER
	MQL
	JMP	TTYREC3		STORE IT IN THE INPUT BUFFER
*
*	CLEAR ALL I/O BUFFERS ASSIGNED TO THIS JOB
*
	PART
CLEAR:ALL SUB
	TAD	=-32		SET UP TO CLEAR INPUT BUFFER
	MQL
	TAD	TTYNUM
	.PARAM	DWAIT
	LDI	DISKW
	ANDI	PNTR1		RETAIN ONLY THE DISK WAIT BIT, IF SET
	DCAI	PNTR1
	TAD	PNTR1		NOW POINT TO IBF
	TAD	=IBF-DWAIT
	DCA	PNTR1
	TADI	PNTR1
	AND	=07740
	TAD	=-1		BACK UP FOR INDEX
	.CLEAR			CLEAR IT
	CDF	%TABLES
	TADI	PNTR1		MAKE IBE = IBF
	INC	PNTR1
	DCAI	PNTR1
	INC	PNTR1		POINT TO OUTPUT IOT
	INC	PNTR1		POINT TO MF
	DCAI	PNTR1		CLEAR IT
	INC	PNTR1		POINT TO OBF
	TAD	=-128		SET UP TO CLEAR OUTPUT BUFFER
	MQL
	TADI	PNTR1
	AND	=07600
	TAD	=-1
	.CLEAR			CLEAR IT
	CDF	%TABLES
	TADI	PNTR1		MAKE OBE = OBF
	INC	PNTR1
	DCAI	PNTR1
	INC	PNTR1		POINT TO OBC
	MQA			(MQ) = -128
	DCAI	PNTR1
	TAD	TTYNUM
	TAD	PRINTER
	SZA CLA			PRINTER ASSIGNED TO THIS JOB ?
	JMP	1F		NO
	DCA	PRINTER		RELEASE PRINTER FROM THIS JOB
	TAD	=LPB-1		(MQ) = -128
	.CLEAR			CLEAR PRINTER BUFFER
	TAD	=LPB		SET PRINTER BUFFER POINTERS
	DCA	LBE
	TAD	LBE
	DCAX	LBF
	MQA			(MQ) = -128
	DCA	LCNTR
	AIF	NO:PTR,.PTR
1H	TAD	TTYNUM
	TAD	READER
	SZA CLA			READER ASSIGNED TO THIS JOB ?
	JMP	1F		NO
	DCA	READER		RELEASE READER FROM THIS JOB
	TAD	=RB-1		(MQ) = -128
	.CLEAR			CLEAR READER BUFFER
	TAD	=RB		SET READER BUFFER POINTERS
	DCA	RBF
	TAD	RBF
	DCAX	RBE
	MQA			(MQ) = -128
	DCA	RCNTR
.PTR	AIF	NO:PTP,.PTP
1H	TAD	TTYNUM
	TAD	PUNCH
	SZA CLA			PUNCH ASSIGNED TO THIS JOB ?
	JMP	1F		NO
	DCA	PUNCH		RELEASE PUNCH FROM THIS JOB
	TAD	=PB-1		(MQ) = -128
	.CLEAR			CLEAR PUNCH BUFFER
	TAD	=PB		SET PUNCH BUFFER POINTERS
	DCA	PBE
	TAD	PBE
	DCAX	PBF
	MQA			(MQ) = -128
	DCA	PCNTR
.PTP	AIF	NO:DECTAPE,.DECTAPE
1H	TAD	TTYNUM
	CIA
	TAD	DTJOB
	SZA CLA			IS THIS ALSO THE DECTAPE JOB ?
	RET	CLEAR:ALL	NO
	CDF	%*
	DCA	DTJOB		CLEAR DECTAPE JOB BUSY FLAG
	AIF	TD8E,.TD8E
	HLT			STOP TC08 DECTAPE
	AGO	.DECTAPE
.TD8E	DCA	DTFLAG		CLEAR DECTAPE COUNTDOWN FLAG
	DCA	D6A		CLEAR TD8E INITIALIZATION LOCATIONS
	DCA	D4A
	TAD	=TD8E2		RESET TD8E CO-ROUTINE
	DCA	TD:CO
	LDI	6
	AND	DTFUNC		EXTRACT TD8E CHASSIS NUMBER
	CLL RTL
	CIA
	TAD	=SDRC		FORM AN 'SDRC' INSTRUCTION
	DCA	2F		PUT IT IN THE CODING LINE
	TAD	2F
	DCA	3F
	LDI	SDLC-SDRC
	TAD	2F
	DCA	4F
2H	HLT			READ THE TD8E COMMAND REGISTER
	AND	=01000
	SNA CLA			IS TAPE IN MOTION ?
	RET	CLEAR:ALL	NO
3H	HLT			READ THE TD8E COMMAND REGISTER
	AND	=06000		REMOVE 'GO' AND 'WRITE' BITS
4H	HLT			STOP THE TAPE
	RET	CLEAR:ALL
.DECTAPE ANOP
1H	RET	CLEAR:ALL
	TITLE	REAL TIME CLOCK HARDWARE SUBROUTINE
*
	PART
DK8E	SUB
	CDF	%*
	TAD	LEF		GET THE LINE PRINTER SOFTWARE ERROR FLAG
	SNA CLA			DID AN ERROR PREVIOUSLY EXIST ?
	JMP	1F		NO
	AIF	V132,.V132
	IOS	LA8,SE		DOES IT STILL EXIST ?
	JMP	*+2		NO, IT IS NOW CLEARED
	JMP	1F		YES
	TAD	=06663		REPLACE THE SKIP CHAIN INST
	DCA	LA8SE
	IOT	LA8,EIN		RE-ENABLE LINE PRINTER INTERRUPTS
	DCA	LEF			AND CLEAR SOFTWARE ERROR FLAG
	TAD	LMF		GET PRINTER MOTION FLAG
	SZA CLA			WAS THE PRINTER IN MOTION ?
	IOT	LA8,LS		YES, RE-START IT
	AGO	.PRINT
.V132	DSI	LSRF		IS THE RUN FLAG NOW SET ?
	JMP	1F		NO
	DCA	LEF		YES, CLEAR SOFTWARE ERROR FLAG
	JMS	V132			AND START PRINTER
.PRINT	ANOP
1H	JMS	DKSERV		UPDATE THE TIME AND DATE
	AIF	NO:TD8E,.TD8E
	TAD	DTFLAG		CHECK THE TD8E COUNTDOWN FLAG
	ROOM	4
	SZA CLA			DOES A COUNTDOWN EXIST ?
	ISZ	DTFLAG		YES, BUMP THE COUNT
	JMP	2F		NO OVERFLOW
	JMS	QTD8E		SERVICE THE TD8E
.TD8E	ANOP
2H	TAD	JOB		GET THE JOB NUMBER
	SNA CLA			IS IT THE NULL JOB ?
	.SUSPEND		YES, RUN THE SCHEDULER
	ISZ	JTIME		HAS TIME QUANTUM EXPIRED ?
	RET	DK8E		NO
	LDI	1		Set extended time quantum bit.
	MQL			...
	TADI	=ULOCK		YES, CHECK ON USER IOT LOCK ?
	SNA CLA			SIMULATING IOT'S ?
	.SUSPEND		NO, SUSPEND THE JOB
	DCA	JTIME		YES, SET THE TIME QUANTUM UP FLAG
	RET	DK8E
*
*	CLOCK SERVICE SUBROUTINE
*
	PART
DKSERV	SUB			UPDATE THE TIME AND DATE
	AIF	DKC8AA.EQ.0,.CONT
	IOT	DK8,CLCL	Clear the DKC8AA clock flag
.CONT	AIF	DK8EP.EQ.0,.CONT
	IOT	DK8,CLSA	CLEAR THE PROGRAMMABLE CLOCK FLAG
.CONT	CAL			THROW THE OVERFLOW BIT (BIT 0) AWAY
	ISZ	TIME+1		BUMP LOW ORDER TIME
	JMP	DK:OK		NO OVERFLOW
	ISZ	TIME		BUMP HIGH ORDER TIME
	JMP	DK:OK		IT ISN'T MIDNIGHT
*
2H	TAD	=MMIDNHO	IT IS NOW MIDNIGHT -- RESET THE TIME
	DCA	TIME
3H	TAD	=MMIDNLO
	DCA	TIME+1
	TAD	OSDATEL		GET THE L O DATE WORD
	DCA	TEMP		SAVE IT TEMPORARILY
MIDNITE	TAD	=1.LS.3		BUMP THE DAY
	TAD	OSDATEL
	MQL
	MQA
	DCA	OSDATEL
	MQA
	AND	=037.LS.3	EXTRACT THE DAY
	SNA			A VALID DAY ?
	JMP	MIDNITE		NO, BUMP AGAIN
	DCA	PNTR2		PERHAPS -- SAVE IT
	MQA
	AND	=017.LS.8	EXTRACT THE MONTH
	RAR6
	CLL RTR
	DCA	PNTR3		STORE MONTH TEMPORARILY
	TAD	PNTR3		GET THE MONTH
	TAD	=DAYTAB
	DCA	PNTR1		POINT TO ITS TABLE ENTRY
	CDF	%DAYTAB
	TADI	PNTR1
	CDF	%*
	TAD	PNTR2
	SPA SNA CLA		A VALID DAY ?
	JMP	2F		YES
	MQA
	AND	=07407		MASK OFF DAY
	TAD	=(1.LS.8)+(1.LS.3)	BUMP THE MONTH AND SET DAY TO 1
	DCA	OSDATEL
	INC	PNTR3		BUMP THE MONTH
2H	TAD	PNTR3		GET THE MONTH
	TAD	=-12
	SPA SNA CLA		A VALID MONTH ?
	JMP	DK:OK		YES
	TAD	OSDATEL		GET THE DATE BACK AGAIN
	AND	=07		SAVE YEAR
	IAC			BUMP YEAR
	MQL
	MQA
	AND	=07		LOOK AT L O YEAR BITS
	SZA CLA			WAS A H O BIT PRODUCED ?
	JMP	3F		NO
	MQL
	CDF	%OSDATEH
	TAD	=1.LS.7		BUMP H O YEAR BITS
	TADI	=OSDATEH
	DCAI	=OSDATEH
	TADI	=OSDATEH
	AND	=0670		EXTRACT YEAR AND MEMORY SIZE BITS
	DCAI	=CORINFO	SET CORE INFO WORD IN TIMESHARE OS/8
3H	CDF	%*
	MQA			GET THE YEAR
	TAD	=(1.LS.8)+(1.LS.3)	SET MONTH AND DAY TO 1
	DCA	PNTR2
	TAD	PNTR2
	DCA	OSDATEL		STORE THE NEW DATE
DK:OK	LDI	-JOBS		CHECK ALL JOB REAL TIME WAITS
	DCA	CNTR
	TAD	=JOB1+LWAIT
	DCA	PNTR1
	CDF	%TABLES
1H	TADI	PNTR1		LOOK AT THE LOGIC WAIT WORD
	AND	=REALW
	SNA CLA			IS THE REAL TIME WAIT BIT SET ?
	JMP	2F		NO
	TAD	=RESTART-LWAIT
	TAD	PNTR1
	DCA	PNTR2
	ISZI	PNTR2		TIME TO RESTART ?
	JMP	2F		NO
	INC	PNTR2		PERHAPS
	ISZI	PNTR2		TIME TO RESTART ?
	JMP	2F		NO
	TADI	PNTR1		YES, GET THE WAIT WORD
	AND	=-(REALW+1)	REMOVE THE REAL TIME WAIT BIT
	DCAI	PNTR1
2H	TAD	PNTR1		SET POINTER TO NEXT TERMINAL WAIT WORD
	TAD	=USER:ST
	DCA	PNTR1
	ISZ	CNTR		CHECKED ALL TERMINALS YET ?
	JMP	1B		NO
	RET	DKSERV
	AIF	V132,.V132
*
*	LA8-E LINE PRINTER
*
	PART
LA8E	SUB
	CDF	%*
LA8E2	IOT	LA8,CF		CLEAR PRINTER FLAG
	DCA	LMF		CLEAR PRINTER MOTION FLAG
	IOS	LA8,SE		ERROR FLAG SET ?
	JMP	1F		NO
	LDI	1		YES, SET SOFTWARE ERROR FLAG
	DCA	LEF
	RET	LA8E		AND EXIT
*
1H	TADI	LBE		GET A CHARACTER FROM BUFFER
	SNA			BUFFER EMPTY ?
	JMP	LA8E3		YES, FORGET IT
	IOT	LA8,LS		No, print it
	LDI	1		and set motion flag
	DCA	LMF
	DCAI	LBE		CLEAR BUFFER POSITION
	LDI	1		UPDATE PRINTER BUFFER EMPTY POINTER
	TAD	LBE
	AND	=0177
	TAD	=LPB
	DCA	LBE
	LDI	-1		BACK UP BUFFER COUNTER
	TAD	LCNTR
	DCA	LCNTR
	IOS	LA8,SF		IS PRINTER FLAG UP AGAIN ?
	JMP	2F		NO
	JMP	LA8E2		YES, OUTPUT NEXT CHARACTER
2H	TAD	LCNTR		GET BUFFER COUNT
	TAD	=128-16
	SMA SZA CLA		LESS THAN 16 CHARACTERS ?
	RET	LA8E		NO
LA8E3	TAD	PRINTER		GET PRINTER JOB NUMBER
	SNA			IS THE PRINTER ASSIGNED ?
	RET	LA8E		NO
	CIA
	.PARAM	DWAIT
	LDI	-(LPTW+1)	REMOVE LPT WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1		NEW JOB LOGIC WAIT WORD
	RET	LA8E
*
	AGO	.PRINT
.V132	ANOP
*
*	DATA PRINTER V132 LINE PRINTER
*
	PART
QV132	SUB
	CDF	%*
	DI	LCPF		CLEAR PRINTER FLAG
	DSI	LSRF		IS THE RUN FLAG SET ?
	RET	QV132		NO
QV:CO	SUB	QVX		USE CO-ROUTINES
	RET	QV132
*
QVX	TAD	LMF		GET THE PRINTER MOTION FLAG
	SNA			IS IT A CONTROL CHARACTER ?
	JMP	2F		NO
	TAD	=-04101		YES
	SZA CLA			A FORM FEED ?
	JMP	1F		NO, A LINE FEED
	LDI	03777
	AND	LMF		GET FORM FEED CONTROL CODE
	DI	LPBC		LOAD PRINTER BUFFER
	LDI	1		SET MOTION FLAG FOR LINE FEED
	DCA	LMF
1H	DI	LIP		LINE FEED
	DI	LRLC		REQUEST LOAD CYCLE
	ROOM	2
	JMS	QV:CO		WAIT FOR PRINTER FLAG
	LDI	1
	DI	LPBC		LOAD PRINTER BUFFER
	DCA	LMF		CLEAR PRINTER MOTION FLAG
2H	TADI	LBE		GET A CHAR FROM PRINTER OUTPUT BUFFER
	SNA			IS THE BUFFER EMPTY ?
	JMP	4F		YES
	MQL			STORE IT TEMPORARILY
	DCAI	LBE		CLEAR THE BUFFER POSITION
	LDI	1		UPDATE PRINTER OUTPUT BUFFER
	TAD	LBE
	AND	=0177
	TAD	=LPB
	DCA	LBE
	LDI	-1		RESET BUFFER CHARACTER COUNTER
	TAD	LCNTR
	DCA	LCNTR
	MQA			GET THE CHARACTER
	SMA			IS IT A CONTROL CHARACTER ?
	JMP	3F		NO
	DI	LIP		YES, INITIATE PRINTING
	DCA	LMF
	DI	LRLC		REQUEST LOAD CYCLE
	ROOM	2
	JMS	QV:CO
	JMP	QVX
*
3H	DI	LPBC		LOAD PRINTER BUFFER
	JMP	2B		GET NEXT CHARACTER
*
4H	TAD	PRINTER		RESTART JOB
	SNA			A VALID JOB NUMBER ?
	RET	QV132		NO
	CIA
	.PARAM	DWAIT
	LDI	-(LPTW+1)
	ANDI	PNTR1		REMOVE LINE PRINTER WAIT
	DCAI	PNTR1
	RET	QV132
*
.PRINT	ANOP
*
	AIF	NO:MAGTAPE,.NO:MAGTAPE
*
*	TM8-E MAGTAPE
*
	PART
TM8UN	DI	CLT		CLEAR THE CONTROLLER AND EXIT
TM8E	SUB
	TAD	MTJOB		GET THE MAGTAPE JOB NUMBER
	SNA CLA			IS THE MAGTAPE ASSIGNED ?
	JMP	TM8UN		NO, IT'S UNASSIGNED
	CDF	%*
	DI	RCMR		READ THE HARDWARE COMMAND REGISTER
	AND	=070		EXTRACT ONLY THE FIELD
	SNA			WAS THIS A READ/COMPARE/WRITE ?
	JMP	0F		NO
	CLL RAR			YES, COMPUTE ITS FIELD INFO WORD ADDRESS
	RTR
	TAD	=FIELD0
	DCA	FPNTR
	TADI	FPNTR
	AND	=-(LOCK+1)	REMOVE THE 'LOCK' BIT
	DCAI	FPNTR
0H	TAD	MTJOB		GET THE MAGTAPE JOB NUMBER
	.PARAM	MTWC-1		FIRST, SAVE THE STATUS REGISTERS
	TAD	PNTR1		USE INDEX
	DCA	AXR2
	DI	RWCR		GET THE HARDWARE WORD COUNT
	DCAI	AXR2
	DI	RCAR		GET THE HARDWARE CURRENT ADDRESS
	DCAI	AXR2
	DI	RMSR		GET THE HARDWARE MAIN STATUS
	DCAI	AXR2
	DI	RFSR		GET THE HARDWARE FUNCTION AND 2ND STATUS
	DCAI	AXR2
	TAD	=DWAIT-MTFN
	TAD	AXR2
	DCA	PNTR1		POINT TO WAIT WORD
	LDI	-(MTAW+1)
	ANDI	PNTR1		TEAR DOWN THE MAGTAPE WAIT BIT
	DCAI	PNTR1
	CDF	%*
	DCA	MTJOB		CLEAR THE BUSY FLAG
	DI	CLT		CLEAR THE CONTROLLER
	TADI	MTQE		CHECK THE MAGTAPE QUEUE
	SNA			ANYTHING ON THE QUEUE ?
	RET	TM8E		NO
	DCA	MTJOB		YES, SET THE BUSY FLAG
	LDI	1		UPDATE THE MAGTAPE QUEUE EMPTY POINTER
	TAD	MTQE
	AND	=3
	TAD	=MTQB
	DCA	MTQE
TM8ETR	TAD	MTJOB
	.PARAM	AC
	TADI	PNTR1		GET THE MAGTAPE JOB'S FUNCTION/GO WORD
	AND	=07000		EXTRACT THE FUNCTION
	CLL RTL			ROTATE TO BITS 9 - 11
	RTL
	TAD	=-4
	SNA			IS IT A WRITE FUNC ?
	JMP	1F		YES
	IAC
	SNA			IS IT A READ/COMPARE FUNC ?
	JMP	1F		YES
	IAC
	SZA CLA			IS IT A READ FUNC ?
	JMP	2F		NO
1H	TAD	=MTCM-AC
	TAD	PNTR1
	DCA	PNTR2		POINT TO MAGTAPE COMMAND
	TAD	=077		SET FIELD SEARCH MASK
	MQL
	TADI	PNTR2		GET THE MAGTAPE COMMAND
	AND	=070		EXTRACT DESIRED TRANSFER FIELD
	TAD	MTJOB		GET THE MAGTAPE JOB NUMBER
	.FINDF
	SNA			IS IT RESIDENT ?
	JMP	TM8E2		NO
	DCA	FPNTR		YES, SAVE ITS FIELD INFO WORD ADDRESS
	TADI	FPNTR		GET THE FIELD INFO WORD
	AND	=-(LOCK+1)	REMOVE THE 'LOCK' BIT, IF SET
	TAD	=LOCK		NOW SET THE 'LOCK'
	DCAI	FPNTR
	TAD	FPNTR		NOW COMPUTE PHYSICAL FIELD
	TAD	=-FIELD0
	CLL RAL
	RTL
2H	MQL
	DSI	SKTR		IS THE CONTROLLER READY ?
	LDI	-1		NO, SET TRANSPORT NOT READY FLAG
	DCA	MTTRF
	DSI	SKTR		IS THE CONTROLLER READY ?
	RET	TM8E		JUST WAIT FOR ANY INTERRUPT
	CDF	%TABLES
	TADI	PNTR2		GET THE COMMAND WORD AGAIN
	INC	PNTR2		POINT TO WORD COUNT
	AND	=07407		STRIP OFF PARITY AND INTERRUPT ENABLES
	TAD	=0300		ENABLE INTERRUPT ON ERROR OR JOB DONE
	MQA			BRING UP THE HARDWARE FIELD
	DI	LCMR		LOAD THE COMMAND REGISTER
	TADI	PNTR2		GET THE WORD COUNT
	INC	PNTR2		POINT TO CURRENT ADDRESS
	DI	LWCR		LOAD THE WORD COUNT REGISTER
	TADI	PNTR2		GET THE CURRENT ADDRESS
	DI	LCAR		LOAD IT
	TADI	PNTR1		GET THE FUNCTION/GO WORD
	DI	LFGR		START THE TRANSPORT
	JMP	TM8E3		CLEAR USER AC AND EXIT
*
TM8E2	CDF	%TABLES
	LDI	DWAIT-AC
	TAD	PNTR1
	DCA	PNTR1		POINT TO WAIT WORD
	LDI	-(MTAW+1)
	ANDI	PNTR1		REMOVE MT WAIT BIT
	DCAI	PNTR1
	INC	PNTR1		BUMP TO JOB PC
	INC	PNTR1
	LDI	-1		NOW BACK UP USER PC FOR ANOTHER TRY
	TADI	PNTR1
TM8E3	DCAI	PNTR1
	RET	TM8E
*
.NO:MAGTAPE ANOP
*
	AIF	SYS:DISK.EQ.RK8E,.RK8E
	AIF	SYS:DISK.NE.RK8L,.RL01
.RK8E	ANOP
*
*	RK8-E DISK SYSTEM
*
*	THE FORMAT ON THE DISK QUEUE IS:
*		JOB NUMBER
*		FUNCTION WORD
*			BIT(S)	PURPOSE
*			0	0=READ; 1=WRITE
*			1-5	PAGES IN TRANSFER
*			6-8	MEMORY FIELD
*			9-10	DISK DRIVE
*			11	HIGH ORDER DISK ADDRESS
*		CORE ADDRESS
*		DISK BLOCK NUMBER
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		0
*	(L)	ANYTHING		UNDEFINED
*	(AC)	0000			0000
*	(MQ)	ANYTHING		UNCHANGED
*
	PART
QDISK	SUB
	CDF	%*
	IOT	DSK,DRST	GET DISK STATUS
	CLL RAL
	SZA CLA			IS ALL WELL ?
	JMP	DISKERR		NO
	IOT	DSK,CF		YES, CLEAR INTERRUPT
DSK:CO	SUB	DISK2		CO-ROUTINE ENTRY
	RET	QDISK
*
DISK2	DCA	DSKJOB		CLEAR THE DISK BUSY FLAG
	TADI	DQE		LOOK AT THE DISK QUEUE
	SMA SZA CLA		IS THE QUEUE EMPTY ?
	JMP	1F		NO
	ROOM	2
	JMS	DSK:CO		RETURN
	JMP	DISK2
*
1H	TADI	DQE		GET THE CURRENT DISK JOB NUMBER AGAIN
	DCA	DSKJOB			AND SET THE DISK BUSY FLAG
	TAD	DSKJOB		COMPUTE ITS WAIT WORD ADDRESS
	MULT64
	TAD	=JOB1-USER:ST+DWAIT
	DCA	DSKPNTR
	LDI	04000
	TAD	DSKJOB
	DCAI	DQE		SET THE 'ENTRY REMOVED' FLAG
	INC	DQE		BUMP THE POINTER
	LDI	DISKW		SET THE DISK WAIT BIT
	JMS	DISK9
	TADI	DQE		GET FUNCTION WORD
	INC	DQE
	DCA	DSKFUN
	TADI	DQE		GET CORE ADDR
	INC	DQE
	DCA	DSKCOR
	TADI	DQE		GET DISK ADDR
	DCA	DSKBLK
	LDI	1		UPDATE QUEUE BUFFER EMPTY POINTER
	TAD	DQE
	AND	=077
	TAD	=DQB
	DCA	DQE
	LDI	-3		SET THE ERROR COUNT
	DCA	DSKERR
DISK5	TAD	DSKCOR		GET CORE ADDR
	IOT	DSK,DLCA	LOAD CURRENT ADDR
	TAD	DSKBLK		GET DISK ADDR
	DCA	BLOCKS
	TAD	DSKFUN		GET FUNCTION WORD
	AND	=03700		PAGES TO TRANSFER
	SNA			40(8) PAGES ?
	LDI	04000		YES
	DCA	PAGES
	TAD	DSKFUN		GET FUNCTION WORD
	AND	=04077		R/W + FIELD + DRIVE + H.O.
	TAD	=0400		SET INTERRUPT BIT
	DCA	DSKCMD		PARTIAL DISK COMMAND
	CLL
DISK6	TAD	PAGES
	AND	=07600
	SNA CLA			HALF BLOCK ?
	TAD	=01000		YES
	RAR			'ALL' BIT IN LINK
	RTR
	TAD	DSKCMD		GET REST OF COMMAND
	IOT	DSK,DLDC	LOAD DISK COMMAND
	TAD	BLOCKS		GET BLOCK NUMBER
	IOT	DSK,DLAG	LOAD DISK ADDR AND WAIT
	ROOM	2
	JMS	DSK:CO			FOR COMPLETION FLAG
	TAD	PAGES
	SNA			TRANSFER COMPLETE ?
	JMP	DISK2		YES
	TAD	=-0200		SUBTRACT ONE PAGE
	SPA SNA			FINISHED TRANSFER ?
	JMP	DISK8		YES
	DCA	PAGES		KEEP PAGE COUNT
	TAD	BLOCKS
	CLL CMA
	AND	=037
	SZA CLA			NEXT BLOCK ON NEW CYLINDER ?
	STL			YES, SET LINK AS 'ALL' FLAG
	ISZ	BLOCKS		BUMP BLOCK COUNTER
	JMP	DISK6		SET UP NEXT TRANSFER
	INC	DSKCMD		IN CASE BLOCKS = 7777(8)
	JMP	DISK6		SET UP NEXT TRANSFER
*
	PART
DISK8	CAL			ALL TRANSFERS COMPLETE
	DCA	PAGES
	JMS	DSKQCHK		CHECK FOR MORE OF THIS JOB'S ENTRIES
	JMP	DISK2		CHECK FOR MORE ON QUEUE
*
*	CHECK THE DISK QUEUE FOR ADDITIONAL ENTRIES
*	FOR THE DISK REQUEST JUST COMPLETED
*
	PART
DSKQCHK	SUB
	TAD	DQF		CHECK FOR MORE OF THIS JOB'S ENTRIES ON QUEUE
	CLL CIA
	TAD	DQE
	SNA			ANY PENDING DISK QUEUE ENTRIES ?
	JMP	2F		NO
	SZL			IS FILL POINTER GREATER THAN EMPTY POINTER ?
	TAD	=-0100		NO, FAKE IT
	STL IAC RTR		COUNT THE ENTRIES
	DCA	DSKCOR
	TAD	DQE		GET THE CURRENT QUEUE EMPTY POINTER
	DCA	BLOCKS
	TAD	DSKJOB
	CIA
	DCA	DSKJOB
1H	TADI	BLOCKS		GET AN ENTRY
	TAD	DSKJOB		COMPARE WITH CURRENT DISK JOB
	SNA CLA			IS IT THE SAME JOB ?
	RET	DSKQCHK		YES, DON'T REMOVE DISK WAIT BIT
	LDI	4		BUMP POINTER TO NEXT ENTRY
	TAD	BLOCKS
	AND	=077
	TAD	=DQB
	DCA	BLOCKS
	ISZ	DSKCOR		CHECKED ALL REMAINING DISK QUEUE ENTRIES ?
	JMP	1B		NO
2H	JMS	DISK9		YES, MAKE THE JOB RUNNABLE
	RET	DSKQCHK
*
*	SUBROUTINE TO SET/CLEAR DISK WAIT BIT
*
	PART
DISK9	SUB			MAKE JOB RUNNABLE
	TAD	=KNOP		WILL BE EITHER 'NOP' OR 'IAC'
	DCA	1F
	LDI	-(DISKW+1)
	CDF	%TABLES
	ANDI	DSKPNTR		CLEAR THE DISK WAIT BIT
1H	HLT			RESET OR LEAVE IT CLEARED
	DCAI	DSKPNTR
	CDF	%*
	RET	DISK9
*
*	DISK ERROR ROUTINE
*
	PART
DISKERR	IOT	DSK,CF		TRY TO CLEAR DISK
	LDI	2
	IOT	DSK,CF		RE-CALIBRATE DISK
	TAD	=-25
	DCA	DSKCMD		USED AS A COUNTER
	DCA	PAGES		USED AS A COUNTER
	ROOM	17
1H	ISZ	PAGES
	JMP	2F
	ISZ	DSKCMD		TIMEOUT ?
	JMP	2F		NO
	JMP	4F		YES
*
2H	IOS	DK8,CLSK	DID THE CLOCK TICK ?
	JMP	3F		NO
	JMS	DKSERV		YES, SERVICE IT
3H	IOS	DSK,SF		DID THE DISK FLAG SET ?
	ERM
	JMP	1B		NO
4H	ISZ	DSKERR		3 ERRORS YET ?
	JMP	DISKTRY		NO
	IOT	DSK,DLDC	YES, CLEAR DISK COMMAND REGISTER
	IOT	DSK,CF		CLEAR THE DISK FLAG
	LDI	6
	AND	DSKFUN		EXTRACT THE RK05 DRIVE NUMBER
	SZA CLA			IS IT THE SWAPPING DISK ?
	JMP	5F		NO
	LDI	1
	AND	DSKFUN		GET THE H O SECTOR BIT
	SZA CLA			IS IT A SWAPPING SECTOR ?
	JMP	5F		NO
	TAD	BLOCKS		POSSIBLY--GET THE BLOCK NUMBER
	TAD	=-SWAP
	SNL			IS IT A SWAPPING SECTOR ?
	JMP	5F		NO
	TAD	=-JOBS*128
	SZL CLA			IS IT A SWAPPING SECTOR ?
	JMP	6F		YES
5H	CAL			AC MAY NOT BE CLEAR
	DCA	PAGES		NO, BUT WE TRIED & FAILED !
	JMS	DSKQCHK		CHECK THE DISK QUEUE
	LDI	3		POINT TO JOB PC
	TAD	DSKPNTR
	DCA	DSKPNTR
	CDF	%TABLES
	LDI	-1		BACK UP JOB PC TO ERROR RETURN
	TADI	DSKPNTR
	DCAI	DSKPNTR
	CDF	%*
	JMP	DISK2		CHECK FOR ANOTHER QUEUE ENTRY
*
6H	LDI	1		THERE IS A BAD SECTOR ON THE SWAPPING DISK
	AND	DSKFUN		GET THE H O BIT
	RAR			ROTATE IT TO THE LINK
	TAD	=KHLT		SET UP FOR POSSIBLE POWER FAILURE
	CDF	%PCSV
	DCAI	=PCSV
	TAD	BLOCKS		GET THE BAD BLOCK NUMBER
	HLT				AND HALT
	JMPX	OS8DEST		RETURN TO STANDALONE OS/8
*
DISKTRY	IOS	DSK,SF		DID THE DISK FLAG SET ?
	JMP	DISKERR		NO
	IOT	DSK,CF		YES, CLEAR IT
	IOT	DSK,DRST	GET THE DISK STATUS
	CLL RAL
	SNA CLA			DID IT RE-CALIBRATE OK ?
	JMP	DISK5		YES, TRY THE TRANSFER AGAIN
	JMP	DISKERR		NO, TRY TO RE-CALIBRATE AGAIN
*
	AGO	.END:DISKS
*
.RL01	AIF	SYS:DISK.NE.RL01,.PERTEC
*
	NOTE:	RL01 DISK NOT YET SUPPORTED
	MONR			ABORT ASSEMBLY AND RETURN TO OS/8
*
.PERTEC	AIF	SYS:DISK.NE.PERTEC,.END:DISKS
*
*	PERTEC DISK SYSTEM
*
*	THE FORMAT ON THE DISK QUEUE IS:
*		JOB NUMBER
*		FUNCTION WORD
*			BIT(S)	PURPOSE
*			0	0=READ; 1=WRITE
*			1-5	PAGES IN TRANSFER
*			6-8	MEMORY FIELD
*			9-10	DISK DRIVE
*			11	HIGH ORDER DISK ADDRESS
*		CORE ADDRESS
*		DISK BLOCK NUMBER
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		0
*	(L)	ANYTHING		UNDEFINED
*	(AC)	0000			0000
*	(MQ)	ANYTHING		UNDEFINED
*
	PART
QDISK	SUB
	CDF	%*
	DI	DLDC		SENSE STATUS
	DI	DRST		GET DISK STATUS
DSK:CO	SUB	DISK2		CO-ROUTINE ENTRY
	RET	QDISK
*
DISK2	SZA CLA			IS THE DISK STATUS OK ?
	JMP	DISKERR		NO
	DCA	DSKJOB		YES, CLEAR THE DISK BUSY FLAG
	TADI	DQE		LOOK AT THE DISK QUEUE
	SMA SZA CLA		IS THE QUEUE EMPTY ?
	JMP	1F		NO
	ROOM	2
	JMS	DSK:CO		RETURN
	JMP	DISK2
*
1H	TADI	DQE		GET THE CURRENT JOB NUMBER AGAIN
	DCA	DSKJOB			AND SET THE DISK BUSY FLAG
	TAD	DSKJOB		COMPUTE ITS WAIT WORD ADDRESS
	MULT64
	TAD	=JOB1-USER:ST+DWAIT
	DCA	DSKPNTR
	LDI	04000
	TAD	DSKJOB
	DCAI	DQE		SET THE 'ENTRY REMOVED' FLAG
	INC	DQE		BUMP THE POINTER
	LDI	DISKW		SET THE DISK WAIT BIT
	JMS	DISK9
	TADI	DQE		GET FUNCTION WORD
	INC	DQE
	DCA	DSKFUN
	TADI	DQE		GET CORE ADDR
	INC	DQE
	DCA	DSKCOR
	TADI	DQE		GET DISK ADDR
	DCA	DSKBLK
	LDI	1		UPDATE QUEUE BUFFER EMPTY POINTER
	TAD	DQE
	AND	=077
	TAD	=DQB
	DCA	DQE
	LDI	-3		SET THE ERROR COUNT
	DCA	DSKERR
DISK4	LDI	-1
	TAD	DSKCOR		GET CORE ADDR -1
	CDF	%DSKCA
	DCAI	=DSKCA		SET THE MEMORY ADDRESS
	TAD	DSKFUN		GET THE FUNCTION WORD
	AND	=03700		EXTRACT THE PAGE COUNT
	CLL RAL
	CIA
	DCAI	=DSKWC		STORE THE WORD COUNT
	LDI	1
	AND	DSKFUN		GET THE H O DISK ADDRESS BIT
	RAR			ROTATE TO LINK
	TAD	DSKBLK		GET THE OS/8 BLOCK NUMBER
	AND	=07740		EXTRACT THE L O CYLINDER BITS
	RAR			RIGHT JUSTIFY CYLINDER BITS
	RTR
	RTR
	DCA	DSKCYL		SAVE CYLINDER ADDRESS
	LDI	2
	AND	DSKFUN		GET L O BIT OF DRIVE NUMBER
	RTL			ROTATE TO POSITION
	RTL
	DCA	BLOCKS		STORE IT TEMPORARILY
	TAD	DSKBLK		GET THE OS/8 BLOCK NUMBER
	AND	=037		EXTRACT THE SURFACE/SECTOR ADDRESS
	TAD	BLOCKS		ADD THE H O HEAD BIT
	DCA	BLOCKS		SAVE THE HEAD/SECTOR ADDRESS
	TAD	BLOCKS
1H	DI	DLHS		LOAD THE HEAD/SECTOR ADDRESS
	CAL
	TAD	DSKCYL		GET THE CYLINDER ADDRESS
	DLCY			LOAD IT
	CAL
	TAD	=01400		FORM A 'POSITION ACCESS' COMMAND
	DI	DLDC		LOAD DISK COMMAND REGISTER
	LDI	04000
	TAD	DSKFUN		GET THE FUNCTION WORD
	AND	=070		R/W BIT TO LINK, FIELD IN AC 6-8
	SNL			A READ OR WRITE ?
	TAD	=0400		READ
	TAD	=0400		WRITE
	DI	DLDC		LOAD THE DISK COMMAND REGISTER
	CAL
	ROOM	2
	JMS	DSK:CO		AND WAIT FOR COMPLETION
	SNA			ANY ERRORS ?
	JMP	DISK5		NO
	AND	=07737		REMOVE END-OF-CYLINDER ERROR BIT
	SZA CLA			ANY OTHER ERRORS ?
	JMP	DISKERR		YES
	CDF	%DSKWC
	TADI	=DSKWC		GET THE WORD COUNT
	SNA CLA			DID THE TRANSFER COMPLETE ?
	JMP	DISK5		YES, THE TRANSFER WAS OK
	INC	DSKCYL		NO, BUMP THE CYLINDER NUMBER
	TAD	BLOCKS		GET THE HEAD/SECTOR ADDRESS
	AND	=040		EXTRACT THE H O HEAD BIT
	JMP	1B
*
	PART
DISK5	CAL			ALL TRANSFERS COMPLETE
	DCA	PAGES
	JMS	DSKQCHK		CHECK FOR MORE OF THIS JOB'S DISK REQUESTS
	JMP	DISK2		CHECK FOR MORE ON QUEUE
*
*	CHECK THE DISK QUEUE FOR ADDITIONAL ENTRIES
*	FOR THE DISK REQUEST JUST COMPLETED
*
	PART
DSKQCHK	SUB
	TAD	DQF		CHECK FOR MORE OF THIS JOB'S ENTRIES ON QUEUE
	CLL CIA
	TAD	DQE
	SNA			ANY PENDING DISK QUEUE ENTRIES ?
	JMP	2F		NO
	SZL			IS FILL POINTER GREATER THAN EMPTY POINTER ?
	TAD	=-0100		NO, FAKE IT
	STL IAC RTR		COUNT THE ENTRIES
	DCA	DSKCOR
	TAD	DQE		GET THE CURRENT QUEUE EMPTY POINTER
	DCA	BLOCKS
	TAD	DSKJOB
	CIA
	DCA	DSKJOB
1H	TADI	BLOCKS		GET AN ENTRY
	TAD	DSKJOB		COMPARE WITH CURRENT DISK JOB
	SNA CLA			IS IT THE SAME JOB ?
	RET	DSKQCHK		YES, DON'T REMOVE DISK WAIT BIT
	LDI	4		BUMP POINTER TO NEXT ENTRY
	TAD	BLOCKS
	AND	=077
	TAD	=DQB
	DCA	BLOCKS
	ISZ	DSKCOR		CHECKED ALL REMAINING DISK QUEUE ENTRIES ?
	JMP	1B		NO
2H	JMS	DISK9		YES, MAKE THE JOB RUNNABLE
	RET	DSKQCHK
*
*	SUBROUTINE TO SET/CLEAR DISK WAIT BIT
*
	PART
DISK9	SUB			MAKE JOB RUNNABLE
	TAD	=KNOP		WILL BE EITHER 'NOP' OR 'IAC'
	DCA	1F
	LDI	-(DISKW+1)
	CDF	%TABLES
	ANDI	DSKPNTR		CLEAR THE DISK WAIT BIT
1H	HLT			RESET OR LEAVE IT CLEARED
	DCAI	DSKPNTR
	CDF	%*
	RET	DISK9
*
*	DISK ERROR ROUTINE
*
	PART
DISKERR	ISZ	DSKERR		3 ERRORS YET ?
	JMP	DISK4		NO, TRY THE TRANSFER AGAIN
	LDI	4
	AND	DSKFUN		EXTRACT THE H O DRIVE NUMBER L O BIT
	SNA CLA			IS IT THE SWAPPING DISK ?
	JMP	5F		YES, GIVE UP !
	DCA	PAGES		NO, BUT WE TRIED & FAILED !
	JMS	DSKQCHK		CHECK THE DISK QUEUE
	LDI	3		POINT TO JOB PC
	TAD	DSKPNTR
	DCA	DSKPNTR
	CDF	%TABLES
	LDI	-1		BACK UP JOB PC TO ERROR RETURN
	TADI	DSKPNTR
	DCAI	DSKPNTR
	CDF	%*
	JMP	DISK2		CHECK FOR ANOTHER QUEUE ENTRY
*
5H	LDI	1		THERE IS A BAD SECTOR ON THE SWAPPING DISK
	AND	DSKFUN		GET THE H O BIT
	RAR			ROTATE IT TO THE LINK
	TAD	=KHLT		SET UP FOR POSSIBLE POWER FAILURE
	CDF	%PCSV
	DCAI	=PCSV
	TAD	BLOCKS		GET THE BAD BLOCK NUMBER
	HLT				AND HALT
	JMPX	OS8DEST		RETURN TO STANDALONE OS/8
*
.END:DISKS ANOP
*
	AIF	NO:FLOPPY,.FLOPPY
*
*	RX8-E FLOPPY DISK SYSTEM
*
	PART
RX8E	SUB
	CDF	%*
RX:CO	SUB	RX82		CO-ROUTINES FOR EFFICIENT FLOPPY OPERATIONS
	RET	RX8E		YES, SERVICE THEM
*
RX82	CDF	%*		SAFETY
	TADI	RXQE		LOOK IN THE FLOPPY QUEUE BUFFER
	SZA			ANYTHING THERE ?
	JMP	1F		YES
	DCA	RXJOB		NO, CLEAR BUSY FLAG AND EXIT
	JMS	RX:CO
	JMP	RX82
*
1H	DCA	RXJOB		SAVE THE JOB NUMBER
	DCAI	RXQE		REMOVE THE ENTRY
	INC	RXQE		BUMP THE BUFFER POINTER
	TADI	RXQE		GET THE FUNCTION WORD
	INC	RXQE
	DCA	RXFUNC
	TADI	RXQE		GET THE MEMORY ADDRESS
	INC	RXQE
	DCA	RXADDR
	TADI	RXQE		GET THE RX LOGICAL BLOCK NUMBER
	DCA	RXLOGB		RX8E LOGICAL BLOCK
	LDI	1		UPDATE THE FLOPPY BUFFER EMPTY POINTER
	TAD	RXQE
	AND	=017
	TAD	=RXQB
	DCA	RXQE
	LDI	-3		SET THE ERROR RETRY COUNT
	DCA	RXERR
	LDI	04000
	TAD	RXFUNC		READ/WRITE BIT TO LINK
	CLA CML RTL		COMPLEMENT OF R/W BIT TO BIT 10
	DCA	RXMDRW
	LDI	3
	AND	RXFUNC		EXTRACT THE MODE AND DRIVE NUMBER
	RTR
	SPA CLA			WHICH DRIVE ?
	TAD	=020		DRIVE 1
	SZL			WHICH MODE ?
	TAD	=0100		8-BIT
	TAD	RXMDRW		ADD IN R/W BIT
	DCA	RXMDRW		SET THE MODE-DRIVE-READ/WRITE WORD
	TAD	=077		MASK FOR .FINDF
	MQL
	TAD	RXFUNC		GET THE FUNCTION WORD
	AND	=070		EXTRACT THE USER RELATIVE FIELD
	TAD	RXJOB		ADD THE JOB NUMBER
	.FINDF
	SZA			IS THE FIELD RESIDENT ?
	JMP	3F		YES
2H	.FINDM
	SZA			ANY MEMORY AVAILABLE ?
	JMP	3F		YES
	JMS	RXWAIT		WASTE SOME TIME
	JMP	2B		KEEP WAITING FOR MEMORY
*
3H	DCA	RXFPNTR		SAVE FIELD INFO WORD POINTER
	TAD	RXFPNTR		COMPUTE THE PHYSICAL FIELD
	TAD	=-FIELD0
	CLL RAL
	RTL
	TAD	=KCDF
	DCA	RXCDF+1		SET THE 'RXCDF' SUBROUTINE
	TADI	RXFPNTR		GET THE FIELD INFO WORD
	SZA			IS THE TRANSFER FIELD RESIDENT ?
	JMP	5F		YES
	TAD	RXFUNC		GET THE RX FUNCTION WORD
	AND	=070		EXTRACT THE RELATIVE FIELD
	TAD	RXJOB		ADD THE JOB NUMBER
	TAD	=LOCK		ADD THE LOCK-IN-MEMORY BIT
	DCAI	RXFPNTR		SET THE FIELD INFO WORD
	TAD	RXFPNTR		GET THE FIELD INFO WORD ADDRESS
	DCA	FPNTR
	.SWAPF			READ IN THE TRANSFER FIELD
4H	JMS	RXWAIT		WASTE SOME TIME WHILE WAITING
	TAD	RXJOB		GET THE FLOPPY JOB NUMBER
	.PARAM	DWAIT
	LDI	DISKW
	ANDI	PNTR1		GET THE SWAP DISK WAIT BIT
	SZA CLA			IS THE FIELD LOADED YET ?
	JMP	4B		NO, WASTE SOME MORE TIME
	CDF	%*
	JMP	6F
*
5H	TAD	=LOCK		SET THE FIELD LOCK-IN-CORE BIT
	DCAI	RXFPNTR
6H	TAD	RXJOB		POINT TO THE JOB'S WAIT WORD
	MULT64
	TAD	=JOB1-USER:ST
	DCA	RXTEM
	LDI	2		YES, GET THE MODE
	AND	RXFUNC
	SZA CLA			WHICH MODE ?
	TAD	=-64		8-BIT
	TAD	=-64
	DCA	RXCONST
RXMAIN	LDI	-1		GET THE TRANSFER MEMORY ADDRESS -1
	TAD	RXADDR			FOR INDEX USE
	DCA	AXR6
	TAD	RXLOGB		GET THE LOGICAL BLOCK NUMBER
	DCA	RXBLOCK		STORE IT IN WORKING LOCATION
	LDI	2
	AND	RXFUNC		GET THE MODE
	RTR			MODE BIT TO LINK
	TAD	RXFUNC		GET THE FUNCTION WORD
	AND	=03700		EXTRACT THE PAGE BITS
	SNL			WHICH MODE ?
	RAL			12-BIT -- FORM A WORD COUNT
	SNA			A FULL FIELD TRANSFER ?
	RAR			YES (FOR 8 BIT MODE: THIS IS DOUBLE WORD COUNT)
	CIA
	DCA	RXWC		STORE THE WORD COUNT
	TAD	RXFUNC		GET THE FUNCTION WORD
	SPA CLA			READ OR WRITE ?
	JMP	RXWR		WRITE
	PART
RXRD	JMS	RXST		LOAD SECTOR/TRACK AND WAIT FOR DONE FLAG
	TAD	RXCONST		SET THE SECTOR UNLOADING COUNTER
	DCA	RXCNTR
	TAD	RXMDRW		GET THE COMMAND WORD
	IOT	RX8,LCD		LOAD FLOPPY COMMAND REGISTER
	JMS	RXCDF		CDF TO TRANSFER FIELD
	LDI	2		CHECK THE MODE
	AND	RXFUNC
	SZA CLA			8- OR 12-BIT MODE ?
	JMP	RXRD8		8-BIT MODE
1H	IOS	RX8,STR		TRANSFER READY FLAG UP ?
	JMP	1B		NOT YET -- WAIT FOR IT
	IOT	RX8,XDR		YES, TRANSFER THE DATUM
	DCAI	AXR6		PUT IN USER CORE
	ISZ	RXWC		FINISHED THE ENTIRE TRANSFER ?
	NOP
	ISZ	RXCNTR		FINISHED TRANSFERRING A FLOPPY SECTOR ?
	JMP	1B		NO, GET NEXT DATUM
	ROOM	2
	JMS	RX:CO		WAIT FOR DONE FLAG (PROCESS OTHER INTERRUPTS)
	TAD	RXWC		LOOK AT TOTAL WORD COUNT
	SZA CLA			FINISHED ENTIRE TRANSFER ?
	JMP	RXRD		NO, SET UP TO GET NEXT FLOPPY SECTOR
	JMP	RXRET		YES
*
	PART
RXRD8	JMS	RXCDF		CDF TO TRANSFER FIELD
1H	JMS	RXFER		GET A BYTE
	DCA	RXTEM		STORE IT TEMPORARILY
	JMS	RXFER		GET NEXT BYTE
	DCA	RXTEM2		STORE IT TEMPORARILY
	JMS	RXFER		GET THIRD BYTE
	RTL			SHIFT 4 LEFT
	RTL
	MQL
	MQA
	AND	=07400		H O 4 BITS ONLY
	TAD	RXTEM		ADD L O 8 BITS
	DCAI	AXR6		FIRST WORD NOW COMPLETE
	MQA
	RTL
	RTL
	AND	=07400		H O 4 BITS ONLY
	TAD	RXTEM2		ADD L O 8 BITS
	DCAI	AXR6		SECOND WORD NOW COMPLETE
	ISZ	RXWC		ENTIRE TRANSFER FINISHED ?
	JMP	1B		NO
	TAD	RXCNTR		YES, CHECK THE FLOPPY BYTE COUNTER
	SNA CLA			SECTOR END ?
	JMP	RXRET		YES, EXIT
2H	IOS	RX8,STR		FLUSH OUT THE REMAINDER OF SECTOR
	JMP	2B
	IOT	RX8,XDR
	ISZ	RXCNTR		FINISHED ?
	JMP	2B		NO
	CAL			YES, CLEAR THE AC
	ROOM	2
	JMS	RX:CO		WAIT FOR THE DONE FLAG
	JMP	RXRET		AND EXIT
*
*	WASTE TIME WHILE WAITING FOR A DISK TRANSFER
*
	PART
RXWAIT	SUB
	LDI	07775		NO, GET MODE, DRIVE AND R/W WORD
	AND	RXMDRW		MASK OUT R/W BIT
	TAD	=5.LS.1		JUST EXECUTE A READ STATUS COMMAND
	IOT	RX8,LCD		(TAKES ABOUT 250 MILLISECONDS)
	ROOM	2
	JMS	RX:CO
	RET	RXWAIT
*
*	THIS SUBROUTINE READS BYTES FROM THE FLOPPY SECTOR BUFFER
*
	PART
RXFER	SUB
1H	IOS	RX8,STR		IS THE TRANSFER READY FLAG UP ?
	JMP	1B		NO, WAIT FOR IT
	IOT	RX8,XDR		READ THE BYTE IN AC(4-11)
	ISZ	RXCNTR		IS THIS THE SECTOR END ?
	RET	RXFER		NO
	DCA	RXTEM3		YES, SAVE THE BYTE
	ROOM	2
	JMS	RX:CO		WAIT FOR DONE FLAG (PROCESS OTHER INTERRUPTS)
	JMS	RXST		SET NEXT TRACK AND SECTOR ADDRESS
	JMS	RXCDF		'DF' TO USER BUFFER FIELD
	TAD	RXCONST		RESET THE SECTOR WORD/BYTE COUNTER
	DCA	RXCNTR
	TAD	RXFUNC
	SMA CLA			READ OR WRITE SECTOR ?
	JMP	2F		READ
	TAD	RXWC		CHECK WORD COUNT
	IAC
	SNA CLA			NEXT TO LAST WORD ?
	JMP	3F		YES
2H	TAD	RXMDRW		GET FLOPPY COMMAND WORD
	IOT	RX8,LCD		'EMPTY BUFFER' OR 'WRITE SECTOR'
3H	TAD	RXTEM3		GET THE LAST BYTE READ
	RET	RXFER
*
	PART
RXWR	TAD	RXMDRW		GET THE COMMAND WORD
	IOT	RX8,LCD		LOAD THE FLOPPY COMMAND REGISTER
	TAD	RXCONST		GET THE WORD/BYTE COUNT
	DCA	RXCNTR
	JMS	RXCDF		CDF TO TRANSFER FIELD
	LDI	0100		CHECK THE MODE
	AND	RXMDRW
	SZA CLA			WHICH MODE ?
	JMP	RXWR8		8-BIT
1H	TADI	AXR6		GET A 12-BIT DATUM
2H	IOS	RX8,STR		TRANSFER READY FLAG UP ?
	JMP	2B		NOT YET -- WAIT FOR IT
	IOT	RX8,XDR		YES, TRANSFER THE DATUM
	CAL
	ISZ	RXWC		FINISHED ENTIRE TRANSFER ?
	NOP
	ISZ	RXCNTR		FINISHED FILLING SECTOR BUFFER ?
	JMP	1B		NO, GET ANOTHER DATUM
	ROOM	2
	JMS	RX:CO		WAIT FOR DONE FLAG (PROCESS OTHER INTERRUPTS)
	JMS	RXST		LOAD SECTOR AND TRACK AND WRITE SECTOR
	TAD	RXWC		GET THE WORD COUNT
	SZA CLA			FINISHED ENTIRE TRANSFER ?
	JMP	RXWR		NO, CONTINUE
	JMP	RXRET		YES
*
	PART
RXWR8	TADI	AXR6		GET A 12-BIT DATUM
	JMS	RXFER		TRANSFER L O 8 BITS TO SECTOR BUFFER
	AND	=07400		EXTRACT 4 H O BITS
	DCA	RXTEM2		SAVE THEM
	TADI	AXR6		GET SECOND 12-BIT DATUM
	JMS	RXFER		TRANSFER L O 8 BITS TO SECTOR BUFFER
	AND	=07400		EXTRACT 4 H O BITS
	CLL RTR			AND ROTATE RIGHT 4 BITS
	RTR
	TAD	RXTEM2		GET H O 4 BITS OF FIRST WORD
	CLL RTR			ROTATE COMBINATION RIGHT 4 BITS
	RTR
	JMS	RXFER		TRANSFER TO SECTOR BUFFER
	CAL
	ISZ	RXWC		END OF TRANSFER ?
	JMP	RXWR8		NO, CONTINUE
	TAD	RXCNTR		YES
	TAD	=128
	SNA CLA			DID SECTOR BUFFER EXACTLY FILL?
	JMP	2F		YES
1H	IOS	RX8,STR		NO, FILL OUT REMAINDER WITH ZEROES
	JMP	1B
	IOT	RX8,XDR
	ISZ	RXCNTR		FINISHED ?
	JMP	1B		NO
	ROOM	2
	JMS	RX:CO		WAIT FOR DONE FLAG
	JMS	RXST		LOAD SECTOR AND TRACK AND WRITE SECTOR
2H	TAD	=0130
	IOT	RX8,LCD		THIS IS A FAKE COMMAND TO GET DONE FLAG
RXRET	CDF	%*
	TADI	RXFPNTR		GET THE FIELD INFO WORD
	AND	=-(LOCK+1)	REMOVE LOCK-IN-MEMORY FLAG
	DCAI	RXFPNTR
	TAD	RXJOB		POINT TO THE JOB WAIT WORD
	.PARAM	DWAIT
	LDI	-(FLOPW+1)	TEAR DOWN FLOPPY WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1		NEW JOB DEVICE WAIT WORD
	JMP	RX82		CHECK ON NEXT QUEUE ENTRY
*
	PART
RXST	SUB			CALCULATE SECTOR AND TRACK,
	LDI	4
	TAD	RXMDRW		FORM 'READ' OR 'WRITE' SECTOR BUFFER
	IOT	RX8,LCD		LOAD THEM INTO FLOPPY AND WAIT FOR DONE FLAG
	DCA	RXTRACK		CLEAR TRACK NUMBER
	LDI	0100		CHECK THE MODE
	AND	RXMDRW
	SZA CLA			8- OR 12-BIT MODE ?
	JMP	RXST8		8-BIT MODE
	STL			CALCULATE THE TRACK NUMBER WITH SECTOR AS
	TAD	RXBLOCK		RESIDUE
RXCALT	SZL
	INC	RXTRACK
	TAD	=-13
	SMA
	JMP	RXCALT
	CML RAL
	TAD	=27		SECTOR ADDRESS NOW IN AC
	JMP	RXST8E		TRANSFER SECTOR & TRACK TO FLOPPY
*
*	DIVIDE CONSTANTS USED BELOW
*
DIVT	DC	-26*64,-26*32,-26*16,-26*8,-26*4,-26*2,-26,0
*
RXST8	CLL
	TAD	RXBLOCK		GET THE LOGICAL BLOCK NUMBER
	DCA	RXTBLK
	TAD	=DIVT-1
	DCA	AXR7
	CDF	%*
RXST8L	DCA	RXTRACK		CLEAR OR UPDATE TRACK NUMBER
	TADI	AXR7		GET A DIVIDE CONSTANT
	SNA			END OF TABLE ?
	JMP	1F		YES
	TAD	RXTBLK
	SZL
	DCA	RXTBLK		UPDATE RESULT
	CLA
	TAD	RXTRACK
	RAL
	JMP	RXST8L		KEEP LOOPING
1H	TAD	RXTBLK		GET THE RESIDUE
	MQL
	DCA	RXTBLK		CLEAR THE TEMP LOCATION
	MQA
2H	TAD	=-13		NOW COMPUTE SECTOR WITHIN THE TRACK
	INC	RXTBLK
	SMA			FINISHED ?
	JMP	2B		NO
	TAD	=13		YES, RESTORE RESULT
	CLL RAL			DOUBLE IT (SECTOR INTERLACE FACTOR = 2)
	TAD	RXTBLK
RXST8E	IOS	RX8,STR		TRANSFER READY FLAG UP ?
	JMP	RXST8E		NO, WAIT FOR IT
	IOT	RX8,XDR		TRANSFER THE SECTOR NUMBER
	CAL			'XDR' DOES NOT CLEAR AC
	TAD	RXTRACK		GET COMPUTED TRACK NUMBER
3H	IOS	RX8,STR		TRANSFER READY FLAG UP ?
	JMP	3B		NO, WAIT FOR IT
	IOT	RX8,XDR		TRANSFER THE TRACK NUMBER
	CAL
	INC	RXBLOCK		BUMP LOGICAL BLOCK NUMBER
	ROOM	2
	JMS	RX:CO		RETURN AND WAIT FOR DONE FLAG
	IOS	RX8,SER		ANY ERRORS ?
	RET	RXST		NO
*
*	FLOPPY ERROR ROUTINE
*
	PART
RXERROR	ISZ	RXERR		3 ERRORS YET ?
	JMP	1F		NO, TRY AGAIN
	TAD	RXJOB		YES, GET THE JOB NUMBER
	.PARAM	PC
	LDI	-1		MAKE JOB PC POINT TO ERROR RETURN
	TADI	PNTR1
	DCAI	PNTR1
	INC	PNTR1		POINT TO JOB AC
	LDI	04000		AC ERROR VALUE
	DCAI	PNTR1
	JMP	RXRET		MAKE JOB RUNNABLE
*
1H	LDI	1		RE-INITIALIZE THE FLOPPY
	IOT	RX8,INTR
	CLA			'INTR' DOES NOT CLEAR THE AC
	JMS	RX:CO		WAIT FOR THE INTERRUPT
	JMP	RXMAIN			AND TRY THE TRANSFER AGAIN
*
.FLOPPY	ANOP
*
	AIF	NO:DECTAPE,.DECTAPE
*
	AIF	TD8E,.TD8E
*
QTC08	CLA HLT
*
	AGO	.DECTAPE
*
.TD8E	ANOP
*
*	TD8E DECTAPE
*
	PART
QTD8E	SUB
	CDF	%*		NEXT 2 INSTRUCTIONS REMOVE TIME DELAY ERROR
D6A	NOP			SDRC -- READ THE TD8E COMMAND REGISTER
D4A	NOP			SDLC -- LOAD THE TD8E COMMAND REGISTER
TD:CO	SUB	TD8E2		CO-ROUTINES MAKE IT EASY
	TAD	DTCLOCK		GET THE CLOCK TICK COUNTER
	SNA			ANY TICKS DURING TD8E SERVICING ?
	RET	QTD8E		NO
	CIA			YES, NEGATE
	DCA	DTCLOCK
	ROOM	6
1H	JMS	DKSERV		SERVICE THE CLOCK
	ISZ	DTCLOCK		FINISHED ?
	JMP	1B		NO
	RET	QTD8E
*
TD8E2	CDF	%*		LOOK IN THE DECTAPE QUEUE BUFFER
	TADI	DTQE
	SZA			ANYTHING THERE ?
	JMP	1F		YES
	DCA	DTJOB		NO, CLEAR THE BUSY FLAG
	DCA	DTFLAG			AND TD8E COUNTDOWN FLAG
	ROOM	2
	JMS	TD:CO			AND EXIT
	JMP	TD8E2
*
1H	DCA	DTJOB		SAVE THE JOB NUMBER
	DCAI	DTQE		REMOVE THE ENTRY FROM THE QUEUE
	INC	DTQE		BUMP THE POINTER
	TADI	DTQE		GET THE FUNCTION WORD
	INC	DTQE
	DCA	DTFUNC
	LDI	-1		GET THE MEMORY ADDRESS -1
	TADI	DTQE			FOR INDEXING
	INC	DTQE
	DCA	DTADDR
	TADI	DTQE		GET THE DECTAPE LOGICAL BLOCK NUMBER
	DCA	DTBLOCK
	LDI	1		UPDATE THE DECTAPE QUEUE EMPTY POINTER
	TAD	DTQE
	AND	=017
	TAD	=DTQB
	DCA	DTQE
	LDI	-3		SET THE ERROR RETRY COUNT
	DCA	DTERR
	LDI	6
	AND	DTFUNC		GET THE TD8E DECTAPE PAIR NUMBER
	CLL RTL
	CIA
	TAD	=SDSS		FORM THE 'SDSS' INSTRUCTION
	DCA	DTTEMP		STORE TEMPORARILY
	TAD	=DTIOT-1	SET UP THE PROPER IOT'S FOR THIS TRANSPORT
	DCA	AXR
	TAD	=-7
	DCA	DTCNTR
2H	TADI	AXR		GET A TABLE ADDRESS
	DCA	AXR1
3H	TADI	AXR1		GET AN ADDRESS
	SNA			END OF TABLE ?
	JMP	4F		YES
	DCA	DTPNTR		NO, SAVE IT
	TAD	DTTEMP		GET THE IOT
	DCAI	DTPNTR		STORE IT
	JMP	3B		GET NEXT ADDRESS
*
4H	INC	DTTEMP		BUMP TO GET THE NEXT TD8E DECTAPE IOT
	ISZ	DTCNTR		STORED ALL IOT'S ?
	JMP	2B		NO
	TAD	=077		MASK FOR .FINDF
	MQL
	TAD	DTFUNC		GET THE FUNCTION WORD
	AND	=070		EXTRACT THE USER RELATIVE FIELD
	TAD	DTJOB		ADD THE JOB NUMBER
	.FINDF
	SZA			IS THE FIELD RESIDENT ?
	JMP	TD8E3		YES
5H	.FINDM			NO
	SZA			ANY MEMORY AVAILABLE ?
	JMP	TD8E3		YES
	JMS	DTWAIT		WAIT 100 MILLISECONDS
	JMP	5B		CHECK FOR MEMORY AVAILABILITY
*
	PART
TD8E3	DCA	DTFPNTR		SAVE THE FIELD INFO WORD POINTER
	TAD	DTFPNTR		COMPUTE THE PHYSICAL FIELD
	TAD	=-FIELD0
	CLL RAL
	RTL
	TAD	=KCDF
	DCA	DTCDF+1		STORE IT IN A SPECIAL SUBROUTINE
	TADI	DTFPNTR		GET THE FIELD INFO WORD
	SZA			IS THE TRANSFER FIELD RESIDENT ?
	JMP	2F		YES, DON'T SWAP IT INTO MEMORY
	TAD	DTFUNC		GET THE FUNCTION WORD
	AND	=070		EXTRACT USER RELATIVE TRANSFER FIELD
	TAD	DTJOB		ADD THE JOB NUMBER
	TAD	=LOCK		ADD THE LOCK-IN-MEMORY BIT
	DCAI	DTFPNTR		SET THE FIELD INFO WORD
	TAD	DTFPNTR		GET THE FIELD INFO WORD ADDRESS
	DCA	FPNTR
	.SWAPF			READ IN THE TRANSFER FIELD
1H	JMS	DTWAIT		WAIT 100 MILLISECONDS
	TAD	DTJOB		GET THE DECTAPE JOB NUMBER
	.PARAM	DWAIT
	LDI	1
	ANDI	PNTR1		GET THE SWAP DISK WAIT BIT
	SZA CLA			IS THE FIELD LOADED YET ?
	JMP	1B		NO, WASTE ANOTHER 100 MILLISECONDS
	CDF	%*
	JMP	3F
2H	TAD	=LOCK		ADD THE LOCK-IN-MEMORY BIT
	DCAI	DTFPNTR
3H	DCA	DTSUM		CLEAR THE DECTAPE CHECKSUM
	TAD	DTFUNC		GET THE FUNCTION WORD
	AND	=03700		EXTRACT THE PAGE COUNT
	SNA			A FULL FIELD TRANSFER ?
	LDI	04000		YES
	RAR6			ROTATE TO L O BITS
	CIA
	DCA	DTPGCT		SAVE THE PAGE COUNT
	LDI	1
	AND	DTFUNC		GET THE TD8E UNIT
	RTR			ROTATE TO BIT 0
D4B	DI	KHLT		SDLC -- LOAD THE TD8E COMMAND REGISTER
D6B	DI	KHLT		SDRC -- READ THE TD8E COMMAND REGISTER
	AND	=0100
	SZA CLA			A SELECT ERROR ?
	JMP	DTTRYS		YES
	TAD	DTFUNC		GET THE FUNCTION WORD
	AND	=07		EXTRACT THE TRANSPORT NUMBER
	TAD	=DTBTAB		ADD DECTAPE BLOCK NUMBER TABLE ADDRESS
	DCA	DTPNTR		POINT TO THIS TRANSPORT'S CURRENT BLOCK
	CDF	%DTBTAB
	TADI	DTPNTR		GET THE CURRENT BLOCK NUMBER
	CDF	%*
	TAD	=10		ADD 10 TO IT
	CLL CIA
	TAD	DTBLOCK		SET LINK IF DESIRED BLOCK IS 10 OR MORE
	JMP	DTGO			AHEAD TO START TAPE FORWARD
DTTRYS	LDI	-1		FAKE OUT ERROR COUNTER
	DCA	DTERR
*
	PART
DTTRY3	CAL			COME HERE ON DECTAPE ERROR
	ISZ	DTERR		TRIED 3 TIMES YET ?
	JMP	1F		NO
	JMP	DTRET
1H	TAD	DTADDR		BACK UP DECTAPE CURRENT ADDRESS
	TAD	=-0200
	DCA	DTADDR
	CAL			CLEAR LINK FOR REVERSE TAPE MOTION
	JMP	DTGO		AND TRY AGAIN
*
DTERROR	EQU	*
	ROOM	4
D2A	DSI	KHLT		SDST -- TIME ERROR ?
	SZA CLA			WRITE LOCK OR CHECKSUM ERROR ?
	ERM
	JMP	DTTRY3		YES
D6C	HLT			SDRC -- READ THE TD8E COMMAND REGISTER
	AND	=07000		TURN OFF WRITE HEAD (IF IT WERE ON)
D4C	HLT			SDLC -- LOAD THE TD8E COMMAND REGISTER
	INC	DTBLOCK		BUMP THE DECTAPE LOGICAL BLOCK NUMBER
	LDI	-1		SET THE TD8E SERVICE FLAG
	DCA	DTFLAG
	ROOM	2
	JMS	TD:CO		SERVICE OTHER INTERRUPTS
	ISZ	DTPGCT		ALL PAGES TRANSFERRED ?
	JMP	DTGOF		NO
DTRET	LDI	1
	AND	DTFUNC		GET THE TD8E UNIT NUMBER
	RTR			ROTATE TO BIT 0
D4D	DI	KHLT		SDLC -- STOP THE TAPE
	PART
DTFIN	TADI	DTFPNTR		GET THE FIELD INFO WORD
	AND	=-(LOCK+1)	REMOVE LOCK-IN-CORE FLAG
	DCAI	DTFPNTR		RELEASE THE PHYSICAL MEMORY FIELD FROM TD8E
	TAD	DTJOB
	.PARAM	DWAIT
	LDI	-(DTAW+1)	TEAR DOWN THE DECTAPE WAIT BIT
	ANDI	PNTR1
	DCAI	PNTR1
	TAD	DTFUNC		GET THE FUNCTION WORD
	AND	=07		EXTRACT THE TRANSPORT NUMBER
	TAD	=DTBTAB		POINT INTO TRANSPORT CURRENT BLOCK TABLE
	DCA	DTPNTR
	TAD	DTBLOCK		STORE THE CURRENT BLOCK
	DCAI	DTPNTR
	TAD	DTERR
	SZA CLA			DID AN ERROR OCCUR ?
	JMP	1F		NO
	LDI	3		YES, MOVE POINTER TO USER PC
	TAD	PNTR1
	DCA	PNTR1
	LDI	-1		BACK UP USER PC
	TADI	PNTR1
	DCAI	PNTR1
	INC	PNTR1		BUMP POINTER TO USER AC
	LDI	04000
	DCAI	PNTR1		SET ERROR RETURN AC
1H	CDF	%*
	DCA	D6A		RESET TD8E ENTRY INITIALIZATION
	DCA	D4A
	JMP	TD8E2		CHECK FOR ANOTHER QUEUE ENTRY
*
DTGOF	TAD	DTBLOCK		GET THE NEXT BLOCK NUMBER
	TAD	=-737*2
	SMA CLA			IS IT A LEGAL DECTAPE BLOCK NUMBER ?
	JMP	DTTRYS		NO, TAKE ERROR EXIT
	LDI	-3		RESET ERROR FLAG
	DCA	DTERR		(ALSO SETS LINK FOR FORWARD TAPE MOTION)
DTGO	CLA CML IAC		REVERSE DIRECTION BIT (IN LINK); SET AC = 1
	AND	DTFUNC		ADD THE TD8E UNIT BIT
	RTR			MOVE EVERYTHING TO ITS PROPER PLACE
	TAD	=01000		ADD 'GO' BIT
D4E	DI	KHLT		SDLC -- LOAD THE TD8E COMMAND REGISTER
	TAD	=-10		SET H O TIMEOUT
	DCA	DTCNTR		ALLOW FOR SLOW STARTING DECTAPES
1H	ISZ	DTTEMP		TIMEOUT ?
	JMP	2F		NO
	ISZ	DTCNTR		TIMEOUT ?
	JMP	2F		NO
	JMP	DTTRYS		YES, AN ERROR
2H	IOS	DK8,CLSK	DID THE CLOCK TICK ?
	JMP	D1A		NO
	AIF	DK8EP.EQ.0,.CONT
	IOT	DK8,CLSA	CLEAR CLOCK FLAG
	CLA
.CONT	INC	DTCLOCK		COUNT THE CLOCK TICKS
D1A	DSI	KHLT		SDSS -- SINGLE LINE FLAG SET ?
	JMP	1B		NO
DTPSRCH	JMS	DTR4		YES, WAIT FOR 8 LINES TO PASS
	JMS	DTR4
	PART
	ROOM	9
DTSRCH	IOS	DK8,CLSK	DID THE CLOCK TICK ?
	JMP	D1B		NO
	AIF	DK8EP.EQ.0,.CONT
	IOT	DK8,CLSA	CLEAR THE CLOCK FLAG
	CLA
.CONT	INC	DTCLOCK		COUNT THE CLOCK TICKS
D1B	DSI	KHLT		SDSS -- SINGLE LINE FLAG SET ?
	ERM
	JMP	DTSRCH		NO, WAIT FOR IT
D6D	DI	KHLT		SDRC -- READ TD8E COMMAND REGISTER
	RTL			DIRECTION BIT TO LINK
	AND	=077.LS.2	EXTRACT MARK TRACK CODE
	TAD	=-(022.LS.2)
	SNA			END ZONE ?
	JMP	DTENDZ		YES
	TAD	=-(4.LS.2)
	SZA CLA			BLOCK MARK ?
	JMP	DTSRCH		NO, KEEP SEARCHING
D7A	DI	KHLT		SDRD -- GET THE BLOCK NUMBER
	SZL			IS TAPE MOVING IN REVERSE ?
	TAD	=4		YES, LOOK FOR 4 BEFORE ACTUAL TARGET BLOCK
	DCA	DTCURB		SAVE IT
	TAD	DTCURB
	CMA
	TAD	DTBLOCK
	CMA
	SNA			IS THIS THE BLOCK ?
	JMP	DTFOUND		YES
	SZL CLA			IS TAPE HEADING IN RIGHT DIRECTION ?
	JMP	1F		YES
DTENDZ	EQU	*
D6E	DI	KHLT		SDRC -- READ THE TD8E COMMAND REGISTER
	RTL			DIRECTION BIT TO LINK
	JMP	DTGO		REVERSE TAPE DIRECTION
*
1H	TAD	DTCURB		GET THE CURRENT TD8E DECTAPE BLOCK NUMBER
	CMA
	TAD	DTBLOCK
	SNA			WITHIN 2 DECTAPE BLOCKS ?
	JMP	DTSRCH		YES, DON'T LEAVE UNTIL TRANSFER IS COMPLETE
	AIF	DK8EC.EQ.0,.CONT
	CLL RAR			DIVIDE THE DIFFERENCE BY 2
.CONT	SMA
	CMA
	DCA	DTFLAG		SET THE TD8E COUNTDOWN FLAG
	ROOM	2
	JMS	TD:CO		SERVICE OTHER INTERRUPTS
	JMP	DTPSRCH		CONTINUE SEARCHING
*
	PART
DTFOUND	SZL CLA			IS TAPE MOVING IN RIGHT DIRECTION ?
	JMP	DTGO		NO, REVERSE AND TRY AGAIN
	ROOM	9
1H	IOS	DK8,CLSK	DID THE CLOCK TICK ?
	JMP	D1C		NO
	AIF	DK8EP.EQ.0,.CONT
	IOT	DK8,CLSA	CLEAR THE CLOCK FLAG
	CLA
.CONT	INC	DTCLOCK
D1C	DSI	KHLT		SDSS -- SINGLE LINE FLAG SET ?
	ERM
	JMP	1B		NO, WAIT FOR IT
D6F	DI	KHLT		SDRC -- READ THE TD8E COMMAND REGISTER
	AND	=077		EXTRACT MARK TRACK CODE
	TAD	=-032
	SZA CLA			FOUND REVERSE GUARD YET ?
	JMP	D1C		NO, KEEP LOOKING
	TAD	=-128		YES, SET WORD COUNTER
	DCA	DTWDCT
	TAD	DTFUNC		GET THE FUNCTION WORD
	SMA CLA			READ OR WRITE REQUEST ?
	JMP	DTREAD		READ
	PART
DTWRITE	EQU	*
D6G	DI	KHLT		SDRC -- READ THE TD8E COMMAND REGISTER
	AND	=0200		EXTRACT WRITE LOCK BIT
	SZA CLA			IS THE TRANSPORT WRITE LOCKED ?
	JMP	DTTRYS		YES
	JMS	DTR4		SKIP ONE DECTAPE 12-BIT WORD
	LDI	1
	AND	DTFUNC		GET THE TD8E UNIT NUMBER
	RTR			UNIT NUMBER TO BIT 0
	TAD	=01400		SET COMMAND FOR FORWARD, GO AND WRITE
D4F	DI	KHLT		SDLC -- LOAD THE TD8E COMMAND REGISTER
	LDI	07777
	JMS	DTW4		7777 IN REVERSE CHECKSUM
	LDI	07777		AND ALSO TAPE CHECKSUM
	DCA	DTSUM
	JMS	DTCDF		'DF' TO TRANSFER FIELD
DTWL	TADI	DTADDR		GET A 12-BIT DATUM
	JMS	DTW4		WRITE IT TO TAPE
	ISZ	DTWDCT		FINISHED WRITING A DECTAPE BLOCK ?
	JMP	DTWL		NO
	JMS	DTW4		A 129TH WORD OF ZERO
	JMS	DTGCHK		GET 6-BIT CHECKSUM
	JMS	DTW4		WRITE IT TO TAPE
	JMS	DTW4		LET CHECKSUM FINISH
	JMP	DTERROR		CHECK FOR ERRORS AND CONTINUE
*
	PART
DTREAD	JMS	DTR4		SKIP TWO 6-BIT CONTROL WORDS
	JMS	DTR4
	JMS	DTR4
	AND	=077		EXTRACT THE CHECKSUM
	TAD	=07700
	DCA	DTSUM
	JMS	DTCDF		'DF' TO TRANSFER FIELD
DTRL	JMS	DTR4		GET A 12-BIT DATUM FROM TAPE
	JMS	DTCKSM		ADD INTO CHECKSUM
	DCAI	DTADDR		STORE IN USER BUFFER
	ISZ	DTWDCT		FINISHED READING THIS DECTAPE BLOCK ?
	JMP	DTRL		NO
	JMS	DTR4		129TH WORD
	JMS	DTCKSM		ADD INTO CHECKSUM
	JMS	DTR4
	AND	=07700
	JMS	DTCKSM
	JMS	DTGCHK		COMPARE TAPE AND CALCULATED CHECKSUMS
	JMP	DTERROR		CHECK FOR ERRORS AND CONTINUE
*
*	TD8E DECTAPE SUBROUTINES
*
*	READ 4 DECTAPE LINES
*
	PART
DTR4	SUB
	ROOM	9
1H	IOS	DK8,CLSK	DID THE CLOCK TICK ?
	JMP	D3A		NO
	AIF	DK8EP.EQ.0,.CONT
	IOT	DK8,CLSA	CLEAR THE CLOCK FLAG
	CLA
.CONT	INC	DTCLOCK		COUNT THE CLOCK TICKS
D3A	DSI	KHLT		SDSQ -- QUAD LINE FLAG SET ?
	ERM
	JMP	1B		NO, WAIT FOR IT
D7B	DI	KHLT		SDRD -- READ THE TD8E DATA REGISTER
	RET	DTR4
*
*	WRITE 4 LINES TO DECTAPE
*
	PART
DTW4	SUB
	JMS	DTCKSM		ADD TO DECTAPE CHECKSUM
	DCA	DTTEMP		STORE DATUM TEMPORARILY
	ROOM	9
1H	IOS	DK8,CLSK	DID THE CLOCK TICK ?
	JMP	D3B		NO
	AIF	DK8EP.EQ.0,.CONT
	IOT	DK8,CLSA	CLEAR THE CLOCK FLAG
	CLA
.CONT	INC	DTCLOCK		COUNT THE CLOCK TICKS
D3B	DSI	KHLT		SDSQ -- QUAD LINE FLAG SET ?
	ERM
	JMP	1B		NO, WAIT FOR IT
	TAD	DTTEMP		GET DATUM
D5A	DI	KHLT		SDLD -- LOAD THE TD8E DATA REGISTER
	CLA			SDLD DOES NOT CLEAR AC
	RET	DTW4
*
*	COMPUTE EQUIVALENCE CHECKSUM
*
DTCKSM	SUB
	CMA
	DCA	DTTEMP		ACTUALLY CHECKSUMS ON DECTAPE ARE
	TAD	DTTEMP		EQUIVALENCE OF ALL WORDS IN A RECORD
	AND	DTSUM		SIX BIT AT A TIME.  SINCE EQUIVALANCE
	CIA			IS ASSOCIATIVE, WE DO IT TWELVE AT A TIME
	CLL RAL			AND CONDENSE LATER.
	TAD	DTTEMP		IDENTITIES USED ARE:
	TAD	DTSUM		A+B=(A.XOR.B)+2*(A.AND.B)
	DCA	DTSUM		A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
	TAD	DTTEMP		A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
	CMA
	RET	DTCKSM
*
*	FORM A 6-BIT CHECKSUM
*
DTGCHK	SUB
	CLA
	TAD	DTSUM
	CLL CMA RTL
	RTL
	RTL
	JMS	DTCKSM
	CLA STL
	TAD	DTSUM
	AND	=07700
	RET	DTGCHK
*
*	WAIT 100 MILLISECONDS
*
DTWAIT	SUB
	CAL
	TAD	=-TICKS/10	WASTE 100 MILLISECONDS
	DCA	DTFLAG
	ROOM	2
	JMS	TD:CO
	RET	DTWAIT
*
*	TD8E IOT TABLES
*
DTIOT	DC	D1-1,D2-1,D3-1,D4-1,D5-1,D6-1,D7-1
*
D1	DC	D1A,D1B,D1C,0
D2	DC	D2A,0
D3	DC	D3A,D3B,0
D4	DC	D4A,D4B,D4C,D4D,D4E,D4F,0
D5	DC	D5A,0
D6	DC	D6A,D6B,D6C,D6D,D6E,D6F,D6G,0
D7	DC	D7A,D7B,0
*
.DECTAPE ANOP
	TITLE	SPECIAL EXECUTIVE ROUTINES AND SUBROUTINES
*
*	.CLEAR
*	CLEAR A FIELD 1 BUFFER
*
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		%BUFFERS
*	(L)	ANYTHING		UNCHANGED
*	(AC)	BUFFER ADDRESS -1	0000
*	(MQ)	-(BUFFER SIZE)		UNCHANGED
*	MODIFIED: AXR2, CNTR
*
	PART
QCLEAR	SUB			CLEAR A FIELD 1 BUFFER
	DCA	AXR2
	MQA			GET THE WORD COUNT
	DCA	CNTR
	CDF	%BUFFERS
1H	DCAI	AXR2		CLEAR THE BUFFER
	ISZ	CNTR		FINISHED ?
	JMP	1B		NO
	RET	QCLEAR
*
*	THE EXECUTIVE DISK ROUTINE.  THIS SUBROUTINE MANAGES
*	THE SYSTEM DISK.  ALL SYSTEM DISK DATA TRANSFERS MUST PASS
*	THROUGH THIS SUBOURTINE.  THE FORMAT ON THE QUEUE IS:
*		JOB NUMBER
*		FUNCTION WORD
*			BIT(S)	PURPOSE
*			0	0=READ; 1=WRITE
*			1-5	PAGES IN TRANSFER
*			6-8	MEMORY FIELD
*			9-10	DISK DRIVE
*			11	HIGH ORDER DISK ADDRESS
*		CORE ADDRESS
*		DISK BLOCK NUMBER
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	RETURN FIELD		SAME
*	(L)	ANYTHING		UNDEFINED
*	(AC)	0000 OR JOB NUMBER	0000
*	(MQ)	ANYTHING		UNDEFINED
*
	PART
	ROOM	3
QEXDRET	CID	%*
QEXDISK	SUB
	SNA			WAS A JOB SPECIFIED ?
	TAD	JOB		NO, USE CURRENT JOB
	MQL
	RDF			COMPUTE RETURN FIELD
	TAD	=KCID
	CDF	%*
	DCA	QEXDRET
	TADI	DQF
	SMA SZA CLA		IS THE DISK QUEUE FULL ?
	HLT			YES, AN UNLIKELY STATE OF AFFAIRS !
	MQA
	DCAI	DQF		PUT JOB # ON QUEUE
	INC	DQF		BUMP THE POINTER
	TAD	QFUNC		GET FUNCTION WORD
	DCAI	DQF
	INC	DQF
	TAD	QADDR		GET MEMORY ADDRESS
	DCAI	DQF
	INC	DQF
	TAD	QBLOCK		GET DISK SECTOR ADDRESS
	DCAI	DQF
	LDI	1		UPDATE THE QUEUE FILL POINTER
	TAD	DQF
	AND	=077
	TAD	=DQB
	DCA	DQF
	MQA			GET THE JOB NUMBER
	MULT64
	TAD	=JOB1-USER:ST+DWAIT	COMPUTE ITS STATUS AREA ADDRESS
	DCA	WTPNTR
	CDF	%TABLES
	LDI	-(DISKW+1)	REMOVE DISK WAIT BIT, IF SET
	ANDI	WTPNTR
	IAC			NOW SET DISK WAIT BIT
	DCAI	WTPNTR		NEW JOB WAIT WORD
	TAD	DSKJOB		GET DISK BUSY FLAG
	SNA CLA			IS THE DISK BUSY ?
	JMS	QDISK		NO, START IT
	JMP	QEXDRET
*
*	.SUSPEND
*	THIS IS THE JOB SCHEDULER.  IT USES A STANDARD ROUND ROBIN
*	ALGORITHM FOR SCHEDULING ALL ACTIVE JOBS IN THE SYSTEM.
*
	PART
SCHEDULER DCA	SKEDDW		SAVE DEVICE WAIT BIT(S) IF ANY
	MQA
	DCA	SKEDLW		SAVE LOGIC WAIT BIT(S) IF ANY
	CDF	%TABLES
	TAD	JOB
	SZA			IS THE NULL JOB RUNNING ?
	JMP	CJOB		NO
SKED2	CDF	%TABLES
	DCA	JOB		CLEAR THE CURRENT JOB
	DCAI	=UJOB		ALSO CLEAR THE USER JOB
	TAD	INJOB
	SNA			IS A JOB PRESENTLY LOADING INTO CORE ?
	JMP	SKED4		NO
	MULT64
	TAD	=JOB1-USER:ST+DWAIT
	DCA	NULLPTR
	LDI	DISKW
	ANDI	NULLPTR		GET THE DISK WAIT BIT
	SNA CLA			HAS IT COMPLETELY LOADED YET ?
	JMP	SKED5		YES, SEE IF IT CAN BE STARTED
NULL	CAL
	DCA	JOB		JUST IN CASE IT WASN'T ALREADY CLEARED
	DCAX	UJOB		ALSO CLEAR THE USER JOB
	AIF	NO:TD8E,.TD8E
	LDI	1
	TAD	DTFLAG		GET THE TD8E SERVICE FLAG
	SNA CLA			IS IT SET ?
	JMP	RETURN		YES, SERVICE IT
.TD8E	ION
	TAD	TIME		JUST DISPLAY THE TIME IN THE MQ,AC
	MQL
	TAD	TIME+1
	ROOM	2		INSURE JUMP IS TO THIS LOCATION ONLY
	JMP	*
*
	PART
SKED5	LDI	-1		BACK UP THE INJOB NUMBER BY 1
	TAD	INJOB
	DCA	SKEDJOB		SO IT WILL BE CHECKED NEXT
	DCA	INJOB		CLEAR THE INJOB
SKED4	LDI	-JOBS		SET UP TO CHECK ALL JOB WAIT WORDS
	DCA	SKEDCTR
1H	LDI	1-JOBS
	TAD	SKEDJOB
	SMA SZA CLA		LOOKED AT HIGHEST NUMBERED JOB ?
	DCA	SKEDJOB		YES, START OVER AGAIN WITH JOB # 1
	INC	SKEDJOB		BUMP THE JOB NUMBER
	TAD	SKEDJOB		GET THE NEW JOB NUMBER
	MULT64
	TAD	=JOB1-USER:ST+DWAIT
	DCA	SKEDPTR		POINT TO DEVICE WAIT BIT WORD
	TADI	SKEDPTR		GET IT
	SZA			IS IT RUNNABLE ?
	JMP	2F		NO
	INC	SKEDPTR		PERHAPS, CHECK THE LOGIC WAITS
	LDI	07776		Set AC to mask all except extended quantum.
	ANDI	SKEDPTR		...
	SNA			IS IT RUNNABLE ?
	JMP	SKEDX		YES, ABSOLUTELY
	JMP	SKED3		PERHAPS

2H	CLL RAR			ROTATE DISK WAIT BIT TO LINK
	SZA CLA			ANY OTHER WAIT BITS SET ?
	JMP	SKED6		YES, FORGET IT
	TAD	INJOB		CHECK FOR A LOADING JOB
	SZA CLA			IS A JOB PRESENTLY LOADING INTO MEMORY ?
	JMP	SKED6		YES, TAKE NO FURTHER ACTION
	TAD	SKEDJOB		NO, MAKE THIS THE NEXT JOB EXECUTED
	DCA	INJOB
	JMP	SKED2
*
SKED6	CAL			MAY BE GARBAGE IN THE AC
	ISZ	SKEDCTR		CHECKED ALL JOBS ?
	JMP	1B		NO
	JMP	NULL		YES, JUST RUN THE NULL JOB
*
	PART
SKED3	MQL			SAVE THE LOGIC WAIT BITS
	MQA
	AND	=HALTW+REALW
	SZA CLA			A HALT OR REAL TIME WAIT ?
	JMP	SKED6		YES, FORGET IT
	MQA
	CLL RTL			CHECK NON-RESIDENT WAIT
	SZL			A NON-RESIDENT WAIT ?
	JMP	NRJOB		YES
	CLL RAL			CHECK EXECUTIVE WAIT
	SZL			A SPECIAL EXEC WAIT ?
	JMP	CIFJOB		YES
	CLL RAL			CHECK JMS WAIT
	SZL CLA			A JMS WAIT ?
	LDI	-1		YES
SKEDX	DCA	SKEDTEM		SET/CLEAR THE JMS FLAG
	TAD	SKEDPTR		SCHEDULE THIS JOB FOR EXECUTION NOW
	DCA	AXR2
	JMS	GETREG		GET THE HARDWARE REGISTERS
	LDI	1		Set AC to look at extended time quantum bit.
	ANDI	SKEDPTR		Get the extended time quantum bit.
	SZA CLA			Is it set ?
	TAD	=QUANTUM-500	Yes, give this job a long time slice next time.
	TAD	=-QUANTUM	SET THE TIME QUANTUM
	DCA	JTIME
	TAD	SKEDJOB		GET THE JOB NUMBER
	DCA	JOB		MAKE IT THE CURRENT JOB
	TAD	JOB
	CDF	%UJOB		ALSO SET USER INTERRUPT
	DCAI	=UJOB			PROCESSOR JOB NUMBER
	ISZ	SKEDTEM		A JMS WAIT ?
	JMP	RETURN		NO, START THE JOB
	TAD	=JMSPC-SC
	TAD	AXR2
	DCA	PNTR1
	TAD	FLSV		GET THE USER FLAGS
	AND	=070		EXTRACT THE PHYSICAL 'IF'
	TAD	=KCDF		COMPUTE A 'CDF'
	ROOM	5
	DCA	1F		PUT IT IN THE CODING LINE
	TADI	PNTR1		GET THE RETURN PC
	ERM
1H	HLT			'CDF' TO 'JMS' FIELD
	DCAI	QPCSV		STORE THE RETURN PC
	CDF	%TABLES
	TAD	PNTR1
	TAD	=LWAIT-JMSPC
	DCA	PNTR1
	DCAI	SKEDPTR		CLEAR 'JMS' WAIT (THE ONLY REMAINING WAIT)
	ISZ	QPCSV		BUMP THE PC
	JMP	RETURN
	JMP	RETURN		SAFETY
*
	PART
CIFJOB	CAL			RESTART 'CIF' SIMULATIONS
	TADI	SKEDPTR		GET JOB LOGIC WAIT BITS
	AND	=-(EXECW+1)	REMOVE SPECIAL EXEC WAIT BIT
	DCAI	SKEDPTR
	TAD	SKEDPTR
	DCA	AXR2
	TADI	AXR2		GET JOB FLAGS
	DCAI	=UFLSV
	TADI	AXR2		GET JOB PC
	DCAI	=UPCSV
	TADI	AXR2		GET JOB AC
	DCAI	=UACSV
	TADI	AXR2		GET JOB MQ
	DCAI	=UMQSV
	TADI	AXR2		GET JOB SC
	AIF	NO:EAE,.EAE
	SPA			WHICH EAE MODE ?
	STL			MODE 'B'
	CMA
	ROOM	4
	DCA	1F
	DI	SCL		LOAD THE SC
	ERM
1H	HLT
	AIF	PDP8I,.EAE
	SZL			WHICH MODE ?
	SWAB			MODE 'B'
.EAE	ANOP
	INCI	=ULOCK
	TAD	=JMSAVE-SC-1
	TAD	AXR2
	DCA	AXR
	TADI	AXR		GET THE RETURN ADDRESS
	DCA	PNTR1
1H	TADI	AXR		GET THE ITEMS TO BE RESTORED TO
	DCA	PNTR2			USER INTERRUPT PROCESSOR
	TADI	AXR
	SNA			END OF LIST ?
	JMP	2F		YES
	DCAI	PNTR2
	JMP	1B
*
2H	TAD	=-QUANTUM	SET TIME QUANTUM
	DCA	JTIME
	TAD	SKEDJOB		GET THE SCHEDULER JOB NUMBER
	DCA	JOB		MAKE IT THE CURRENT JOB
	TAD	JOB
	DCAI	=UJOB		ALSO MAKE IT THE USER INTERRUPT JOB
	ROOM	3
	CIF	%KM8E
	ERM
	JMPI	PNTR1		RESTART THE JOB
*
	PART
NRJOB	LDI	1		JOB IS NON-RESIDENT
	TAD	SKEDPTR
	DCA	PNTR1		POINT TO JOB FLAGS
	TADI	PNTR1		GET THEM
	RAR
	RTR
	AND	=07		EXTRACT RELATIVE 'IF'
	CIA
	TADI	PNTR1
	AND	=07
	SZA CLA			IS 'IF' = 'DF' ?
	LDI	1		NO, TWO PHYSICAL FIELDS REQUIRED
	DCA	SKEDTEM		SAVE INFO TEMPORARILY HERE
	TAD	SKEDTEM		GET FIELD REQUIREMENTS (0=1 FIELD; 1=2 FIELDS)
	.AVMEM			IS SUFFICIENT MEMORY AVAILABLE ?
	JMP	NRJOB2		NO
NRJOBM	.FINDM			YES, FIND AN AVAILABLE MEMORY FIELD
	DCA	FPNTR		SAVE ADDRESS OF FIELD INFO WORD
	TAD	FPNTR		COMPUTE PHYSICAL FIELD NUMBER
	TAD	=-FIELD0
	CLL RAL
	RTL
	DCA	QFUNC
	CDF	%TABLES
	TADI	PNTR1		GET JOB RELATIVE FLAGS
	CDF	%*
	MQL
	MQA
	AND	=070		EXTRACT RELATIVE 'IF'
	TAD	=IF		ADD 'IF' RESIDENCY BIT
	TAD	SKEDJOB		ADD JOB NUMBER
	DCAI	FPNTR		SET THE FIELD INFO WORD
	MQA			GET JOB RELATIVE FLAGS AGAIN
	AND	=06107		EXTRACT LINK, 'GT' AND 'UM', & REL 'DF'
	TAD	QFUNC		ADD PHYSICAL FIELD NUMBER
	DCA	FLSV		PARTIAL JOB FLAGS
	DCA	QADDR		ZERO MEMORY ADDRESS
	MQA			GET JOB RELATIVE FLAGS
	AND	=070		EXTRACT JOB RELATIVE 'IF'
	TAD	SKEDJOB		ADD JOB NUMBER
	.FINDB			FIND THE DISK SWAP BLOCK
	DCA	QBLOCK
	TAD	SKEDJOB
	.EXDISK			QUEUE THE REQUEST
	TAD	SKEDTEM		GET THE NUMBER OF FIELDS REQUIRED
	SNA CLA			WERE TWO FIELDS REQUIRED ?
	JMP	1F		NO
	.FINDM			FIND A PHYSICAL FIELD
	DCA	FPNTR
	TAD	FPNTR		COMPUTE PHYSICAL FIELD NUMBER
	TAD	=-FIELD0
	CLL RAL
	RTL
	DCA	QFUNC
	TAD	FLSV
	AND	=07		EXTRACT RELATIVE 'DF'
	CLL RAL
	RTL
	TAD	SKEDJOB
	DCAI	FPNTR		SET THE FIELD INFO WORD
	TAD	FPNTR
	TAD	=-FIELD0	COMPUTE PHYSICAL FIELD
	MQL
	TAD	FLSV
	AND	=07770		REMOVE RELATIVE 'DF'
	MQA			BRING UP PHYSICAL 'DF'
	DCA	FLSV
	TADI	FPNTR		GET THE RELATIVE 'DF' AND JOB NUMBER
	.FINDB			FIND THE DISK SWAP BLOCK
	DCA	QBLOCK
	TAD	SKEDJOB
	.EXDISK			QUEUE THE REQUEST
	JMP	2F
*
1H	TAD	FLSV		GET JOB PARTIAL FLAGS
	AND	=07770		REMOVE RELATIVE 'DF'
	MQL
	MQA
	AND	=070		EXTRACT PHYSICAL 'IF'
	CLL RAR
	RTR
	MQA
	SKP
2H	TAD	FLSV		ADD JOB PARTIAL FLAGS
	CDF	%TABLES
	DCAI	PNTR1		NEW JOB FLAGS
	LDI	-(NRESW+1)	REMOVE NON-RESIDENT WAIT BIT
	ANDI	SKEDPTR
	DCAI	SKEDPTR
	CDF	%*
	LDI	DF		SET THE 'DF' RESIDENCY BIT
	TADI	FPNTR
	DCAI	FPNTR
	TAD	SKEDJOB		GET THE JOB NUMBER AND SET
	DCA	INJOB			JOB LOADING FLAG
	JMP	NULL			AND WAIT FOR SWAP COMPLETION
*
	PART
NRJOB2	TAD	=FIELD2
	DCA	FPNTR
	TAD	=-6
	DCA	CNTR
1H	TADI	FPNTR		GET A FIELD INFO WORD
	SNA			IS THIS FIELD IN USE ?
	JMP	2F		NO
	AND	=IF+DF+LOCK+N:EXIST
	SZA CLA			IS THIS A JOB'S 'IF', 'DF' OR LOCKED ?
	JMP	2F		YES, IGNORE IT
	LDI	04000
	.SWAPF			SWAP THE FIELD OUT TO DISK
	DCAI	FPNTR		CLEAR THE FIELD INFO WORD
2H	INC	FPNTR		BUMP FIELD INFO WORD POINTER
	ISZ	CNTR		CHECKED ALL FIELDS ?
	JMP	1B		NO, KEEP LOOKING
	TAD	SKEDTEM		GET THE FIELD REQUIREMENTS
	.AVMEM			SUFFICIENT MEMORY AVAILABLE NOW ?
	JMP	NRJOB3		NO
	JMP	NRJOBM		YES, SET UP TO SWAP INTO MEMORY
*
	PART
NRJOB3	TAD	=FIELD2
	DCA	FPNTR
	TAD	=-6
	DCA	CNTR
1H	CDF	%*		SAFETY
	TADI	FPNTR		GET A FIELD INFO WORD
	SNA			IS THIS FIELD IN USE ?
	JMP	4F		NO
	MQL
	MQA
	AND	=LOCK+N:EXIST
	SZA CLA			IS IT LOCKED IN MEMORY OR NON-EXISTANT ?
	JMP	4F		YES, LEAVE IT ALONE
	MQA			GET THE FIELD INFO WORD AGAIN
	AND	=07		EXTRACT JOB NUMBER
	MULT64
	TAD	=JOB1-USER:ST+LWAIT
	DCA	PNTR2		POINT TO JOB WAIT WORD
	CDF	%TABLES
	LDI	-(NRESW+1)	REMOVE NON-RESIDENT BIT, IF SET
	ANDI	PNTR2
	TAD	=NRESW		NOW SET IT
	DCAI	PNTR2		NEW JOB WAIT WORD
	INC	PNTR2		POINT TO JOB FLAGS
	MQA
	AND	=IF		EXTRACT 'IF' RESIDENCY BIT
	SNA CLA			IS THIS THE JOB'S 'IF' ?
	JMP	2F		NO
	MQA
	AND	=070		EXTRACT JOB RELATIVE FIELD
	DCA	TEMP
	TADI	PNTR2		GET JOB FLAGS
	AND	=07707		REMOVE PHYSICAL 'IF'
	TAD	TEMP		ADD RELATIVE 'IF'
	DCAI	PNTR2
2H	MQA
	AND	=DF		EXTRACT 'DF' RESIDENCY BIT
	SNA CLA			IS THIS THE JOB'S 'DF' ?
	JMP	3F		NO
	MQA
	AND	=070		EXTRACT RELATIVE 'DF'
	CLL RAR
	RTR
	DCA	TEMP
	TADI	PNTR2		GET JOB FLAGS
	AND	=07770		REMOVE PHYSICAL 'DF'
	TAD	TEMP		ADD RELATIVE 'DF'
	DCAI	PNTR2
3H	CDF	%*		SAFETY
	LDI	04000
	.SWAPF			SWAP THE FIELD TO DISK
	DCAI	FPNTR		RELEASE MEMORY
4H	INC	FPNTR		Bump field info word pointer
	ISZ	CNTR		CHECKED ALL FIELDS ?
	JMP	1B		NO
	TAD	SKEDTEM		GET FIELD REQUIREMENTS
	.AVMEM			SUFFICIENT MEMORY AVAILABLE NOW ?
	JMP	NULL		NO
	JMP	NRJOBM		YES, SET UP TO SWAP INTO MEMORY
*
	PART
CJOB	DCA	SKEDJOB		MAKE IT THE LAST JOB CHECKED
	TAD	SKEDJOB
	MULT64
	TAD	=JOB1-USER:ST+DWAIT
	DCA	SKEDPTR		DEVICE WAIT WORD ADDRESS COMPUTED
	TADI	SKEDPTR		GET PREVIOUS DEVICE WAIT BITS
	MQL
	TAD	SKEDDW		GET NEW DEVICE WAIT BITS
	MQOR
	DCAI	SKEDPTR		STORE NEW COMBINED DEVICE WAIT BITS
	TAD	SKEDLW		GET NEW LOGIC WAIT BIT(S)
	MQL
	INC	SKEDPTR		POINT TO OLD LOGIC WAIT BIT(S)
	TADI	SKEDPTR		GET THEM
	MQOR			BRING UP NEW WAIT BITS
	DCAI	SKEDPTR		SAVE NEW COMBINED LOGIC WAIT BIT(S)
	MQA			GET LOGIC WAIT BITS AGAIN
	SMA CLA			IS THE HALT WAIT BIT SET ?
	JMP	1F		NO
	LDI	-TERMS
	TAD	JOB
	SPA SNA CLA		IS THIS AN EXECUTIVE TASK ?
	JMP	1F		NO
	TAD	FLSV		YES, GET ITS FLAGS
	AND	=07		EXTRACT ITS PHYSICAL 'DF'
	TAD	=FIELD0		COMPUTE ADDRESS OF ITS FIELD INFO WORD
	DCA	FPNTR
	CDF	%*
	DCAI	FPNTR		RELEASE THE MEMORY WITHOUT SWAPPING OUT
	JMP	SKED2
*
1H	TAD	SKEDPTR
	DCA	AXR2
	JMS	SAVREG		SAVE THE HARDWARE REGISTERS
	TAD	SKEDLW		GET THE CURRENT LOGIC WAIT BITS
	RAL
	SMA SNL CLA		IS 'HALTW' OR 'NRESW' SET ?
	JMP	SKED2		NO
	PART
SWAPJ	CDF	%*
	TAD	JOB		ALWAYS THE CURRENT JOB NUMBER
	CIA
	DCA	TEMP
	TAD	FLSV		GET INTERRUPT FLAGS
	AND	=RELBIT
	SZA CLA			IS THE RELATIVE FIELDS BIT SET ?
	JMP	1F		YES
	TAD	FLSV		GET INTERRUPT FLAGS
	MQL
	MQA
	AND	=070		EXTRACT PHYSICAL FIELD
	CLL RAR			ROTATE TO BITS 9-11
	RTR
	TAD	=FIELD0
	DCA	FPNTR
	TADI	FPNTR		GET FIELD INFO WORD
	AND	=070		EXTRACT USER FIELD NUMBER
	SWP			GET JOB FLAGS
	AND	=07707		MASK OUT 'IF'
	MQA			BRING UP USER RELATIVE 'IF'
	MQL
	MQA
	AND	=07		EXTRACT PHYSICAL 'DF'
	TAD	=FIELD0
	DCA	FPNTR
	TADI	FPNTR		GET FIELD INFO WORD
	AND	=070		EXTRACT USER 'DF'
	CLL RAR			ROTATE TO BITS 9-11
	RTR
	SWP			GET JOB FLAGS
	AND	=07770		MASK OUT PHYSICAL 'DF'
	MQA			BRING UP USER RELATIVE 'DF'
	INC	SKEDPTR		POINT TO JOB FLAGS
	CDF	%TABLES
	DCAI	SKEDPTR		STORE THE FLAGS
	CDF	%*
1H	TAD	=FIELD2
	DCA	FPNTR
	TAD	=-6
	DCA	CNTR
2H	TADI	FPNTR		GET A FIELD INFO WORD
	AND	=07		EXTRACT ONLY THE JOB NUMBER
	TAD	TEMP		COMPARE WITH THIS JOB NUMBER
	SZA CLA			IS IT THIS JOB ?
	JMP	3F		NO
	LDI	04000		YES
	.SWAPF			WRITE THE FIELD TO SWAP TRACKS
	DCAI	FPNTR		RELEASE MEMORY
3H	INC	FPNTR		BUMP THE FIELD INFO WORD POINTER
	ISZ	CNTR		LOOKED AT ALL FIELD INFO WORDS ?
	JMP	2B		NO
	JMP	SKED2		CHECK ON NEXT JOB
*
*	GET THE HARDWARE REGISTERS
*	ENTER WITH AXR2 SET TO LOC -1 AND 'DF' = 'TABLES
*
	PART
GETREG	SUB
	TADI	AXR2		GET THE FLAGS
	DCA	FLSV
	TADI	AXR2		GET THE PC
	DCA	QPCSV
	TADI	AXR2		GET THE AC
	DCA	ACSV
	TADI	AXR2		GET THE MQ
	DCA	MQSV
	TADI	AXR2		GET THE SC
	AIF	NO:EAE,.EAE
	AIF	PDP8I,.PDP8I
	CLL
	SPA			WHICH MODE ?
	STL			MODE B
.PDP8I	ANOP
	CMA
	ROOM	4
	DCA	1F
	DI	SCL		LOAD THE STEP COUNTER
	ERM
1H	HLT
	AIF	PDP8I,.EAE
	SZL			WHICH EAE MODE ?
	SWAB			MODE B
.EAE	RET	GETREG
*
*	SAVE THE HARDWARE REGISTERS
*	ENTER WITH AXR2 SET TO LOC -1 AND 'DF' = 'TABLES'
*
	PART
SAVREG	SUB
	TAD	FLSV		GET THE FLAGS
	DCAI	AXR2
	TAD	QPCSV		GET THE PC
	DCAI	AXR2
	TAD	ACSV		GET THE AC
	DCAI	AXR2
	TAD	MQSV		GET THE MQ
	DCAI	AXR2
	AIF	NO:EAE,.EAE
	AIF	PDP8I,.PDP8I
	MQL			INSURE MQ IS CLEAR
	ROOM	4
	DSI	DPSZ		WHAT IS EAE MODE ?
	SKP CLA			MODE 'A'
	LDI	04000		SET MODE 'B' FLAG
	DI 	SWBA		INSURE MODE IS NOW 'A'
.PDP8I	DI 	SCA		GET THE SC
	DCAI	AXR2
.EAE	RET	SAVREG
*
*	.AVMEM
*	CHECK FOR AVAILABLE MEMORY
*
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		%*
*	(L)	ANYTHING		UNCHANGED
*	(AC)	FIELDS NEEDED -1	0000
*	(MQ)	ANYTHING		UNCHANGED
*	MODIFIED: TEMP, CNTR, AXR2
*	IF MEMORY IS NOT AVAILABLE, RETURN IS TO CALL +1;
*		OTHERWISE TO CALL +2.
*
	PART
QAVMEM	SUB
	CDF	%*
	CMA
	DCA	TEMP		SAVE COMPLEMENTED FIELD COUNT
	TAD	=-6
	DCA	CNTR
	TAD	=FIELD1
	DCA	AXR2
1H	TADI	AXR2		LOOK AT A FIELD INFO WORD
	SZA CLA			THIS FIELD AVAILABLE ?
	JMP	2F		NO
	ISZ	TEMP		YES, FOUND NEEDED MEMORY ?
	JMP	2F		NO
	INC	QAVMEM		YES, BUMP RETURN POINTER
	RET	QAVMEM
*
2H	ISZ	CNTR		CHECKED ALL FIELD INFO WORDS ?
	JMP	1B		NO
	RET	QAVMEM
*
*	.FINDM
*	FIND AN AVAILABLE MEMORY FIELD
*
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		%*
*	(L)	ANYTHING		UNCHANGED
*	(AC)	0000			0000 IF NO MEMORY AVAILABLE
*					ADDR OF FIELD INFO IF MEMORY AVAILABLE
*	(MQ)	ANYTHING		UNCHANGED
*	MODIFIED: AXR2, CNTR
*
	PART
QFINDM	SUB
	CDF	%*
	TAD	=FIELD1		INITIALIZE
	DCA	AXR2
	TAD	=-6
	DCA	CNTR
1H	TADI	AXR2		LOOK FOR AN AVAILABLE FIELD
	SNA CLA			FOUND ONE YET ?
	JMP	2F		YES
	ISZ	CNTR		LOOKED AT ALL FIELDS YET ?
	JMP	1B		NO
	RET	QFINDM		YES, NO MEMORY AVAILABLE
*
2H	TAD	AXR2		GET THE ADDRESS OF THE FIELD INFO WORD
	RET	QFINDM
*
*	.FINDF
*	FIND A FIELD FROM INFO CONTAINED IN THE AC AND MQ
*
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		%*
*	(L)	ANYTHING		UNDEFINED
*	(AC)	MATCH BIT PATTERN	0000 IF NO MATCH FOUND
*					ADDR OF FIELD INFO IF MATCH FOUND
*	(MQ)	MATCH MASK		UNCHANGED
*	MODIFIED: AXR2, TEMP, CNTR
*
	PART
QFINDF	SUB
	CIA
	DCA	TEMP		SAVE NEGATED MATCH BIT PATTERN
	CDF	%*
	TAD	=FIELD1
	DCA	AXR2
	TAD	=-6
	DCA	CNTR
1H	MQA			GET THE MASK
	ANDI	AXR2		MASK THE FIELD INFO WORD
	TAD	TEMP
	SNA CLA			A MATCH ?
	JMP	2F		YES
	ISZ	CNTR		CHECKED ALL FIELD INFO WORDS ?
	JMP	1B		NO
	RET	QFINDF		YES
*
2H	TAD	AXR2		GET THE ADDR OF THE FIELD INFO WORD
	RET	QFINDF
*
*	.FINDB
*	FIND A DISK SWAP BLOCK BASED ON INFO IN AC
*
*	     -- ENTERING --	     -- EXITING --
*	(INT)	OFF			OFF
*	(DF)	ANYTHING		%*
*	(L)	ANYTHING		UNCHANGED
*	(AC)	BITS:	INFO:		DISK SWAP BLOCK NUMBER
*		 0-3	MEM ADDR
*		 6-8	USER FIELD
*		9-11	JOB NUMBER
*	(MQ)	ANYTHING		0000
*	MODIFIED: TEMP
*
	PART
QFINDB	SUB
	CDF	%*
	TAD	=-1		BACK UP JOB TO CREATE OFFSET
	MQL
	MQA
	AND	=07		EXTRACT MAJOR OFFSET
	RAR6
	DCA	TEMP
	MQA
	AND	=070		EXTRACT USER FIELD
	TAD	TEMP		ADD MAJOR OFFSET
	CLL RAL
	SWP
	AND	=07400		EXTRACT MEMORY ADDRESS INFO
	CLL RTR			ROTATE TO BITS 8-11
	RAR6
	MQA			RELATIVE SWAP SECTOR NOW COMPUTED
	TAD	=SWAP		ADD SWAP SECTOR BIAS
	RET	QFINDB
*
*	.SWAPF
*	SWAP A FIELD TO/FROM DISK SWAP BLOCKS
*
*	     -- ENTERING --	     -- EXITING  --
*	(INT)	OFF			OFF
*	(DF)	CALLING FIELD		UNCHANGED
*	(L)	ANYTHING		UNDEFINED
*	(AC)	0000 IF READ		0000
*		4000 IF WRITE
*	(MQ)	ANYTHING		QUEUE JOB NUMBER
*	FPNTR	ADDR OF AFFECTED
*		    FIELD INFO WORD
*	MODIFIED: QFUNC, QADDR, QBLOCK
*
	PART
	ROOM	3
QSWAPFR	CID	%*
QSWAPF	SUB
	DCA	QFUNC		STORE THE READ/WRITE BIT (BIT 0)
	RDF			COMPUTE RETURN FIELD
	TAD	=KCID
	CDF	%*
	DCA	QSWAPFR
	TAD	FPNTR
	TAD	=-FIELD0	COMPUTE PHYSICAL FIELD NUMBER
	CLL RAL			ROTATE TO BITS 6-8
	RTL
	TAD	QFUNC		ADD READ/WRITE BIT
	DCA	QFUNC		FUNCTION WORD NOW COMPLETE
3H	LDI	-1
	TADI	FPNTR		GET FIELD INFO WORD
	AND	=07		EXTRACT MAJOR OFFSET
	MULT64
	DCA	QBLOCK		SAVE TEMPORARILY
	TADI	FPNTR
	AND	=070		EXTRACT USER FIELD NUMBER
	TAD	QBLOCK		ADD MAJOR OFFSET
	CLL RAL
4H	TAD	=SWAP		ADD IN SWAP TRACK BIAS
	DCA	QBLOCK		SET DISK SECTOR ADDRESS
	DCA	QADDR		SET MEMORY ADDRESS
	TADI	FPNTR		GET FIELD INFO WORD
	AND	=07		EXTRACT JOB NUMBER
	.EXDISK			QUEUE THE DISK REQUEST
	JMP	QSWAPFR
	AIF	PDP8E.OR.(PDP8I.AN.NO:EAE),.MQ
*
*	SOFTWARE SIMULATION OF CERTAIN 'MQ' FUNCTIONS
*
QMQOR	SUB			'OR' AC WITH 'MQ'
	DCA	CPU:TEM		STORE AC TEMPORARILY
	TAD	CPU:MQ
	CMA
	AND	CPU:TEM
	TAD	CPU:MQ
	RET	QMQOR
*
QCAM	SUB			CLEAR AC AND 'MQ'
	CLA
	DCA	CPU:MQ
	RET	QCAM
*
QSWP	SUB			'SWP' AND AND 'MQ'
	DCA	CPU:TEM		SAVE AC TEMPORARILY
	TAD	CPU:MQ
	DCA	CPU:AC
	TAD	CPU:TEM
	DCA	CPU:MQ
	TAD	CPU:AC
	RET	QSWP
*
.MQ	ANOP
*
*	Compute highest address used in this field.
*
	.END

