/ MULTI SECTION 4   V 0.85
/ BEGIN SECTION 4 LISTING CONTROL
	IFNZRO LIST&20 <XLIST>
	FIELD 2
/	FIELD 2 GOODIES THAT GET SWAPPED DOWN
/	TO FIELD 0 FOR EXECUTION
	*0
	0
	JMP I .+1
	INTRPT
UMODE,	1		/USER MODE = 1
			/TASK MODE =0
NJOBS,	0
	*10
XR10,	0		/DSKQ, DKNEXT, RUNIT
XR11,	0		/CDQ, CDQKBD
XR12,	0		/
XR13,	0		/REBOOT
XR14,	0		/
SWPGET,	0
SWPPUT,	0
STACKP,	J0STAK+1
JOBSTS,	JOBTBL
JOB,	0
OJOB,	0
NEWJOB,	0
NJBPTR,	JOBTBL+1
/ MORE PSEUDO INSTRUCTIONS
PUSHJ=	JMS I .;	PUSHJX
POPJ=	JMP I .;	POPJX
PUSHAC=	DCA I	STACKP
POPAC=	JMS I .;	POPX
/
L1DIS=	JMP I .;	TSKCHK
L2DIS=	JMP I .;	NXTTSK
L2QIN=	JMS I .;	L2QPUT
L2QOUT=	JMS I .;	L2QGET

L0001,	1
L0002,	2
L0004,	4
L0010,	10
L0020,	20
L0040,	40
L0100,	100
L0200,	200
L0400,	400
L1000,	1000
L2000,	2000
L7,	7
L70,	70
L77,	77
L215,	215
L7400,	7400
L7600,	7600
LM1,	-1
LCDF,	CDF
CDQSTS,	0	/ THESE CDQ ARGS ALL USED AT LEVEL 2 !!!
CDQPT1,	0
CDQPT2,	0
CDQPT3,	0
CDQPT4,	0
CDQPT5,	0
QJOB,	0

	*200
INTRPT,	DCA I	(INTAC		/SAVE AC
	RAR
	DCA I	(INTLNK		/AND LINK
	RIB
	AND	L70
	TAD	(CIF
	DCA I	(INTCIF
	RIB
	AND	L7
	CLL RTL
	RAL
	TAD	LCDF
	DCA I	(INTCDF
DSKSKP,	DSKE			/THIS CHANGES IF DIFFERENT DISK ***
	SKP CLA
	JMP I	(RK8ERR
	DSKD			/THIS CHANGES IF DIFFERENT DISK ***
	SKP CLA
	JMP I	(RKDSKD
	CALL	(COSDPY
	JMP I	TTYINT		/CHECK TTY'S BEFORE LPT
LPTSKP,	LSF
	SKP CLA
	JMP I	(LPTSRV
LPTERR,	LSE			/SKIP ON LPT ERROR (LP08 ONLY)
	JMP	PTRSKP
	6667			/DISABLE LPT  INTERRUPT (LP08 ONLY)
	LCF			/AND CLEAR FLAG
	L1DIS
PTRSKP,	RSF			/READER?
	JMP	PTPSKP
	TAD	(PTRL2		/QUEUE READER SERVICE
	L2QIN
	DCA I	(PTRWAT		/SHOW CHAR RECIEVED
	RRB			/READ CHAR AND CLEAR FLAG
	JMP	PTSHR
PTPSKP,	PSF
	L1DIS			/UNIDENTIFIED INTERRUPT?????
	PCF
	TAD	(PTPL2
PTSHR,	L2QIN
	L1DIS
RK5INT,	RK5SRV&177+DKSTRT
RF8BAD,	RF8ERR&177+DKSTRT
RF8INT,	RF8SRV&177+DKSTRT
TTYINT,	TTYSRV

/ REBOOTSTRAP ROUTINE
/ LOADS THE RESIDENT STAND ALONE MONITOR INTO FIELD
/ TWO LOCATIONS 25000-27600, SWAPS IT DOWN, AND THEN JUMPS
/ TO 07600 TO RELOAD THE EDITOR.  THE TRICK IS TO DO THIS
/ WHEN THERE ARE NO MORE DISK REQUESTS PENDING.  ROUTINE
/ MUST RESIDE BELOW 5000.
	IFNZRO REBOOT&4000 <^^^ BOOT ^^^>
REBOOT,	IOF
	AC7777
	DCA I	(DKPNDG		/SET PENDING DISK REQUESTS TO 1
	TAD	(-JOBMAX+1	/NOW SET ALL JOBS EXCEPT 0 TO STOP STATUS
	DCA	REBCNT
	TAD	(JOBTBL
	DCA	XR13
	AC2000			/OFFBIT
	DCA I	XR13
	ISZ	REBCNT
	JMP	.-3
	TAD	(-JOBMAX	/NOW CHECK TO SEE IF THERE REALLY WERE
	DCA	REBCNT		/ANY DISK REQUESTS PENDING
	TAD	(JOBTBL-1
	DCA	XR13
REBTST,	TAD I	XR13		/ IS + IF REQUEST IN QUEUE
	AND	DDDBIT
	SZA CLA
	JMP	WIPOUT		/FOUND REQUEST, MUST WAIT FOR COMPLETION
	ISZ	REBCNT
	JMP	REBTST
REBCON,	DCA	JOB		/FALL THROUGH IF NO REQUESTS, OK TO PROCEED
	DCA I	(JOBTBL		/SET JOB TO 0, STATUS TO RUN
	TAD	(JOBTBL
	DCA	JOBSTS
	DCA I	(DKPNDG
	TAD	(REBPRM-1	/FEED PARAMETERS TO DSKQ
	JMS I	(DSKQ
	TAD I	(QUETBL		/HOW DID IT GO?
	SPA CLA
	JMP	REBCON	/ERROR?

REBSWP,	IOF			/GET HERE TO SWAP DOWN MONITOR
	CDF 20
	TAD I	REBPNT
	CDF 00
	DCA I	REBPNT
	ISZ	REBPNT
	ISZ	REBCTX
	JMP	REBSWP		/UNTIL
	AC4000
DSKBIT,	DLDCX			/CLEAR INT ENABLE BITS IN RK01
	JMP I	L7600
REBPNT,	6000
REBCTX,	-TXTEND+6000
ERSTAT,				/SOMETIMES CONTAINS DISK ERROR STATUS
REBCNT,	0
WIPOUT,	ION			/HERE TO WAIT FOR COMPLETION OF 'LAST' 
	TAD I	(DKPNDG		/DISK REQUEST.  DKPNDG GOES TO 0 ON COMPLETION
	SZA CLA
	JMP	.-2
	IOF
	JMP	REBCON
REBPRM,	4000
	1020
	6000
	0000
/
	PAGE

TTYSRV,	TAD	(TTLIST-1	/SET POINTER TO LIST OF IOT'S
	DCA	XR10
TTYLOP,	TAD I	XR10		/PICK UP NEXT IOT
	SNA			/ZERO ENDS LIST
	JMP	KBDSRV
	DCA	TTYTSF		/TRY IT OUT
TTYTSF,	HLT
	JMP	TTYLOP		/NO SKIP, KEEP TRYING
	TAD	TTYTSF		/EUREKA! IT DID SOMETHING
	IAC
	DCA	TTYTCF
TTYTCF,	0
	TAD	(TTYL2		/QUEUE THE UNPACKER
	L2QIN
	TAD	XR10		/WHICH WILL CLEAR I/O WAIT
	TAD	(-TTLIST
	L2QIN
	L1DIS

KBDSRV,	TAD I	XR10		/KEYBOARD IOT'S MUST FOLLOW PRINTER
	SNA
	JMP I	(LPTSKP		/NOT ANY OF US
	DCA	KBDKSF
KBDKSF,	HLT			/TRY IT ON FOR SIZE
	JMP	KBDSRV		/DIDN'T DO MUCH FOR ME
	TAD	(KBDL2		/GOT A SKIP SO QUEUE THE PACKING ROUTINE
	L2QIN
	TAD	XR10
	TAD	(-KBLIST	/AND THE JOB NUMBER
	L2QIN
	TAD	KBDKSF		/COMPUTE THE KRB CODE
	TAD	(5
	DCA	.+1
	HLT			/READ THE CHAR
	L2QIN			/SAVE FOR PACKER
	L1DIS

TTYL2,	L2QOUT			/LEVEL 2 TASK TO FETCH NEXT CHAR TO BE PRINTED
	DCA	TTYL2J		/STORE JOB NUMBER
	TAD	TTYL2J		/FIRST CLEAR I/O WAIT FOR THE POOR USER
	TAD	(JOBTBL
	DCA	TTYL2P
	TAD	TTOBIT
	CMA
	AND I	TTYL2P
	DCA I	TTYL2P
	TAD	TTYL2J		/TEST FOR OUTPUT REQUEST
	TAD	(QUETBL
	DCA	TTYL2P
	TAD	TTOBIT		/BIT 0=1 INDICATES CDQ REQUEST ON
	AND I	TTYL2P
	SZA CLA
	JMP	TTYL2G		/SO UNPACK THE NEXT CHAR
	TAD	TTYL2J		/NO CDQ REQUEST, MAYBE NULLS OR LF
	TAD	(TTARGS
	DCA	TTYL2P
	TAD I	TTYL2P
	SNA
	L2DIS			/JUST PLAIN NOTHING GOING ON
	SPA CLA			/FOUND ARG, + MEANS PRINT IT
	JMP	TTYL2N
	TAD	(-NULCNT	/ALWAYS FOLLOW LF WITH NULLS
	DCA I	TTYL2P
	TAD	(212
	JMP	TTYL2J-1	/PRINT IT
TTYL2N,	ISZ I	TTYL2P		/HERE ON NULLS, HOW MANY LEFT
	JMP	TTYL2J-1	/ENOUGH
	L2DIS			/NO MO
TTYL2G,	TAD	TTYL2J		/HERE TO UNPACK NEXT CHAR
	CALL	(QPTRST
	CALL	(QGETC
	JMS	TTYCR		/HERE ON END OF RECORD
	CALL	(PRINTC
TTYL2J,	0
	L2DIS
TTYL2P,	0

TTYCR,	0
	AC0001
	TAD	TTYCR
	DCA	TTYCRP
	TAD I	TTYCRP
	TAD	(TTARGS		/JOB # PLUS ARGS LIST OFFSET
	DCA	TTYCRP
	TAD	(212		/STORE LF IN ARGS LIST
	DCA I	TTYCRP
	TAD	(QUETBL-TTARGS	/RESET POINTER TO QUEUE STATUS LIST
	TAD	TTYCRP
	DCA	TTYCRP
	TAD	TTOBIT		/SEE IF TTY REQUEST WAS PENDING
	AND I	TTYCRP
	SZA CLA			/AND IF IT WAS, CLEAR IT
	DCA I	TTYCRP		/CLEAR QUEUE REQUEST
	TAD	L215		/RETURN WITH CR TO BE PRINTED
	EXIT	TTYCR
TTYCRP,	0
/
	PAGE

/ ROUTINE TO PRINT CHARACTER
/ CALL WITH CHAR IN AC.  CHECKS FOR CTRL/O AND IF ON, THROWS
/ THE CHAR AWAY AND QUEUES THE TTYL2 ROUTINE IN PLACE OF TTYSRV
/ SETS TTY OUTPUT WAIT IN JOBSTATUS
/
PRINTC,	0
	DCA	PRICHR		/ENTERED WITH CHAR IN AC
	TAD I	PRINTC
	TAD	(JOBTBL		/SET UP VECTOR TO JOB STATUS
	DCA	PRIPTR
	TAD	TTOBIT
	TAD I	PRIPTR		/SET TTY ACTIVE
	DCA I	PRIPTR
	TAD I	PRINTC		/PICK UP JOB NUMBER
	TAD	(TMNLTB
	DCA	PRIPTR		/VECTOR TO TERMINAL STATUS TABLE
	AC0001			/LOOK AT CTRL/O BIT
	AND I	PRIPTR
	SZA CLA
	JMP	PRIL2Q		/BIT IS ON, CHUCK THE OUTPUT
	TAD I	PRINTC
	TAD	(TTLIST		/NOW FIND THE IOT
	DCA	PRIPTR
	TAD I	PRIPTR
	TAD	(5		/TO MAKE A TLS
	DCA	PRIPTR
	TAD	PRICHR
PRIPTR,	0
	CLA
	JMP	PRIEXT
PRIL2Q,	TAD	(TTYL2		/HERE TO QUEUE THE UNPACKER
	IOF
	L2QIN			/WHEN THERE WILL BE NO INTERRUPT
	TAD I	PRINTC
	L2QIN			/JOB #
	ION
PRIEXT,	ISZ	PRINTC
	EXIT	PRINTC
PRICHR,	0

/ ROUTINE TO PACK CHARACTERS READ BY KBDSRV AND STORED ON THE LEVEL
/ TWO QUEUE.  ROUTINE TESTS TO SEE IF INPUT QUEUE REQUEST IS
/ ACTIVE AND IF NOT STORES CHAR IN INPUT BUFFER.  IF INPUT REQUEST IS PENDING,
/ CHARACTER IS PACKED IN THE USER DATA AREA BY QPUTC AND ECHOED IF NECESSARY.
/ IF NO MORE INPUT IS NEEDED TO SATISFY THE INPUT REQUEST, KEYBOARD WAIT
/ IS CLEARED IN THE JOB STATUS WORD
KBDL2,	L2QOUT			/GET TERMINAL (JOB) NUMBER
	DCA	KBDJBN
	L2QOUT
	DCA	KBDCH1		/STORE WHILE SOME TESTS GO ON
	TAD	KBDJBN		/FIRST TEST FOR INPUT REQUEST
	TAD	(QUETBL
	DCA	KBDPT4
	TAD	TTIBIT
	AND I	KBDPT4
	SNA CLA
	JMP	KBDBUF		/ NO REQUEST SO BUFFER THE CHAR
	TAD	KBDCH1		/NOW TAKE CARE OF CTRL/O ETC.
	CALL	(CNOCHK
KBDJBN,	0
	L2DIS			/FUNNY CHARACTER, ALREADY PROCESSED
	DCA	KBDCH1
	TAD	KBDJBN
	CALL	(QPTRST
	TAD	KBDCH1
	CALL	(QPUTC
	SKP			/RECORD OVERFLOW OR SOMETHING - LET USER WORRY ABOUT IT
	L2DIS			/MORE INPUT NEEDED, LEAVE KBDBIT SET
KBDDUN,	TAD	KBDJBN		/CLEAR KEYBOARD WAIT TO SHOW INPUT READY
	TAD	(JOBTBL
	DCA	KBDPT4
	TAD	TTIBIT
	CMA
	AND I	KBDPT4		/CLEAR THE BIT
	DCA I	KBDPT4
	L2DIS

KBDBUF,	TAD	KBDJBN		/SEE IF THE CHAR IS WORTH ANYTHING
	DCA	KBDPT4
	TAD	KBDCH1
	CALL	(CNOCHK		/HAVE TO DO THIS SEPARATELY DUE TO I/O WIAT
KBDPT4,	0
	L2DIS			/OOO, A STRANGE ONE. ALREADY PROCESSED
	DCA	KBDCH1		/A REAL CHAR OF SOME KIND
	TAD	KBDJBN		/HERE TO PACK THE CHARACTER FOR LATER USE
	CLL RAL
	TAD	KBDJBN		/FIND INPUT ARGS LIST ENTRY
	TAD	(KBDTBL
	DCA	KBDPT4
	AC7777
	TAD I	KBDPT4
	TAD	(TTISIZ		/IS THERE IS ROOM
	SPA
	L2DIS			/FORGET IT
	TAD	(-TTISIZ
	DCA I	KBDPT4
	ISZ	KBDPT4
	ISZ	KBDPT4		/TO GET INPUT POINTER
	TAD I	KBDPT4
	DCA	KBDPT5
	TAD I	KBDPT5		/END OF BUFFER YET?
	SPA
	JMP	.-3		/NO, RESET POINTER
	CLA IAC
	TAD	KBDPT5
	DCA I	KBDPT4
	TAD	KBDCH1
	DCA I	KBDPT5		/AND FINALLY STORE CHARACTER
	JMP	KBDDUN
KBDPT5,	0
KBDCH1,	0
/
	PAGE

QPUTC,	0
	DCA	QPTCDF
	TAD I	CDQPT2		/PICK UP CDF
	DCA	QPTCDF+1
	TAD I	CDQPT3		/AND BYTE DISPLACEMENT
	CLL RAR
	CLL
	TAD I	CDQPT4		/ADD TO BUFFER BASE ADDR
	DCA	QPTPTR
	SNL			/SET IF FIELD OVERFLOW
	JMP	.+4
	TAD	L0010
	TAD	QPTCDF+1
	DCA	QPTCDF+1
	TAD	QPTCDF
	TAD	(-15
	SNA
	JMP	QPUTND
	TAD	(215-232		/CTRL/Z?
	SNA
	JMP	QPUTCZ
	TAD	(232-225
	SZA
	JMP	NOTCTU
	CALL	(QPCRLF
	TAD I	CDQPT5		/RESTORE COUNT FROM LENGTH
	DCA I	CDQPT1
	DCA I	CDQPT3		/ZERO BYTE POINTER
	JMP	NOTCTX
NOTCTU,	TAD	(225-237
	SPA SNA
	JMP	NOTCTX
	DCA	QPTCHR
	ISZ I	CDQPT1
	SKP			/NORMAL
	JMP	QPUTOV

	JMS	QPUTIT
	CALL	(QECHO		/IS THIS THE KEYBOARD?
	JMP	NOTCTX		/NO, DONT ECHO
	TAD	QJOB
	DCA	.+4
	TAD	QPTCHR
	TAD	(237		/RESTORE TO ASCII
	CALL	(PRINTC
	0
NOTCTX,	CLA
	ISZ	QPUTC
	JMP I	QPUTC
QPUTIT,	0
	AC0001
	AND I	CDQPT3
	CLL RAR		/NOW GET EVEN OR ODD BYTE FLAG
	JMS	QPTCDF
	TAD	QPTCHR
	AND	L77
	SZL
	JMP	.+5
	RTL
	RTL
	RTL
	SKP
	TAD I	QPTPTR		/GET OLD CHARACTER IF ANY
	DCA I	QPTPTR
	CDF 00
	ISZ I	CDQPT3		/UPDATE BYTE POINTER
	EXIT	QPUTIT

QPTCDF,	0
	0
	JMP I	QPTCDF
QPUTOV,	AC0001
QPUTCZ,	CMA			/FAKE OUT MATH BELOW
	DCA I	CDQPT3		/ZERO WORD COUNT ON CTRL/Z
	AC4000
QPUTND,	DCA	QPTTMP		/STORE ERROR STATUS (0 OR -)
	CALL	(QPCRLF
	TAD	QJOB		/COMPUTE QUE TABLE ENTRY
	TAD	(QUETBL
	DCA	QPTCDF
	TAD	QPTTMP
	DCA I	QPTCDF
	CMA
	TAD I	CDQPT4		/GET POINTER TO WORD COUNT
	DCA	QPTTMP
	DCA	QPTCHR
	TAD I	CDQPT3		/USE BYTE POINTER TO SET WORD COUNT
	SNA CLA
	JMS	QPUTIT		/INSERT BLANK IF NULL RECORD
	TAD I	CDQPT3
	CMA			/CHECK FOR -1 (CTRL/Z)
	SNA
	JMP	.+3		/AVOID EMBARRASING ARITHMETIC
	IAC
	STL RAR			/DIVIDE BY TWO
	JMS	QPTCDF
	DCA I	QPTTMP
	CDF 00
	JMP I	QPUTC
QPTTMP,	0
QPTCHR,	0
QPTPTR,	0
/
	PAGE

/ CALL QPTRST WITH JOB NUMBER IN AC TO SETUP CDQPT1-CDQPT5
/ EACH TO POINT TO THE FIVE WORD BLOCK DESCRIBING CURRENT QUEUE
/ REQUEST FOR THIS JOB.
/
/ WORDS IN THE QUEUE REQUEST BLOCK ARE:
/
/	COUNT		;DETERMINED FROM WC IN RECORD ON OUTPUT
/	CDF		;FIELD IN WHICH DATA RESIDES
/	BYTE PTR	;BYTE DISPLACEMENT FROM RECORD HEAD
/	BUFR		;FIRST WORD (WC) OF RECORD
/	LENGTH		;SAME AS FIELD 1 VALUE FOR INPUT
/
QPTRST,	0
	DCA	QJOB
	TAD	QJOB
	CLL RTL
	TAD	QJOB
	TAD	(CDQTBL
	DCA	CDQPT1
	IAC
	TAD	CDQPT1
	DCA	CDQPT2
	IAC
	TAD	CDQPT2
	DCA	CDQPT3
	IAC
	TAD	CDQPT3
	DCA	CDQPT4
	CLL IAC			/CLL FOR BENEFIT OF CALL AT LPUNKL
	TAD	CDQPT4
	DCA	CDQPT5
	JMP I	QPTRST

/ ROUTINE TO QUEUE A CDOIO TYPE REQUEST.
/ CALL:
/	TAD	BUFRADDR
/	PUSHJ
/	CDQ
/
/ EXPECTS TO BE CALLED FROM FIELD 1 WITH SECOND ARG
/ (FIELD+DEVICE #) IN DEVNUM.
/ QUEUE BLOCK IS SET UP, QUEUE REQUEST BITS ARE TURNED ON,
/ AND THE APPROPRIATE STARTUP ROUTINE IS SELECTED.
CDQ,	IAC			/BUFFER ADDR -1 IN AC
	DCA	CDQTM1
	CDF 10			/GET OTHER ARG
	TAD I	(DEVNUM		/PICK UP OTHER ARG
	DCA	CDQTM2
	CDF 00
	TAD	JOB		/SET UP POINTER TO QUEUE REQUEST BLOCK
	CLL RTL
	TAD	JOB		/FIVE ENTRIES PER BLOCK
	TAD	(CDQTBL-1
	DCA	XR11
	TAD	JOB
	TAD	(QUETBL		/COMPUTE VECTOR TO QUE STATUS TABLE
	DCA	CDQSTS
	TAD	CDQTM2		/GET FIELD FOR DATA
	AND	L70
	TAD	(CDF
	DCA	CDQCDF		/USE TO GET WC (IF ANY)
CDQCDF,	0
	TAD I	CDQTM1		/PICK UP FIRST WORD
	CDF 00			/WILL BE WC ON OUTPUT
	CLL RAL			/CHANGE TO BYTE COUNT
	TAD	LM1		/PLUS (MINUS) ONE TO MAKE SKIP WORK OUT
	DCA I	XR11		/STORE IN REQUEST BLOCK
	TAD	XR11
	DCA	CDQTM3		/WILL NEED BELOW
	TAD	CDQCDF		/STORE CDF IN REQUEST BLOCK
	DCA I	XR11
	DCA I	XR11		/STORE BYTE POINTER
	AC0001			/WORD ADDRESS OF FIRST BYTE
	TAD	CDQTM1		/AND RECORD ADDRESS
	DCA I	XR11
	AC0001
	AND	CDQTM2		/READ OR WRITE?
	SZA CLA
	JMP	CDQCON		/WRITE
	CDF RSFLD		/GET MAX LENGTH FOR INPUT
	TAD I	(LENGTH
	CDF 00
	CLL RAL			/CHANGE TO BYTES
	TAD	LM1		/MAKES ISZ WORK RIGHT
	DCA I	CDQTM3
	TAD I	CDQTM3
	DCA I	XR11
CDQCON,	TAD CDQTM2		/GET DEVICE # TO DETERMINE DISPATCH
	AND	L7		/ADDRESS
	TAD	(JMP I	CQDEVS	/GET THE RIGHT STARTUP ROUTINE
	DCA	CDQTM1		/AND GO TO IT
CDQTM1,	0
CQDEVS,	CDQKBD
	CDQTTY
	CDQCDR
	CDQPTP
	CDQPTR
	CDQLPT
CDQTM2,	0
CDQTM3,	0
CDQCDR,	HLT

CDQTTY,	TAD	TTOBIT		/SHOW TTY OUTPUT PENDING
	DCA I	CDQSTS
	TAD	JOB
	DCA	CDQTTJ
	DCA	UMODE		/LEVEL TWO CAN STEP ON YOU (HO,HO)
	TAD	JOB
	CALL	(QPTRST		/FETCH THE FIRST CHAR
	CALL	(QGETC
	CALL	(TTYCR		/GLURCH, A NULL RECORD
	CALL	(PRINTC
CDQTTJ,	0
	ISZ	UMODE
CDQTTS,	PUSHJ
	SLEEP			/PRINTC SET THE TTO BITS
	POPJ			/BACK TO THE USER WHEN ALL I/O DONE

PTUNLK,	JMS	PTRELS		/CALLED TO POSSIBLY UNLOCK PTR AND PTP
	IAC
	JMS	PTRELS
	TAD	JOB		/ALSO DELETE ANY PENDING CDQ REQUESTS
	TAD	(QUETBL
	DCA	PTRUNL
	DCA I	PTRUNL
	AC2000			/SAY 'GOODBYE' DICK
	JMP	CDQTTS
PTRELS,	0		/TEST FOR INIT BY JOB AND CLEAR IF TRUE
	TAD	(PTPJOB		/AC MAY NOT BE 0 ON ENTRY
	DCA	PTRUNL		/POINTER TO INIT WORD
	TAD I	PTRUNL
	CIA
	TAD	JOB		/THIS ONE?
	SZA CLA
	EXIT	PTRELS		/NO, HANDS OFF
	AC4000			/YES, FREE UP
	DCA I	PTRUNL		/IS NOT RUNNING OR WE WOULDN'T BE HERE
	EXIT	PTRELS
PTRUNL,	0
/
	PAGE

KBDSET,	0
	TAD	JOB
	CLL RAL			/FIND INPUT BUFFER POINTERS AND COUNT
	TAD	JOB		/JOB # TIMES 3
	TAD	(KBDTBL
	DCA	KBDPTR
	IOF
	TAD I	KBDPTR		/COUNT
	SZA CLA			/ANY CHARACTERS?
	ISZ	KBDSET
	JMP I	KBDSET
KBDFCH,	0
	IAC
	TAD	KBDPTR		/PICK UP FETCH POINTER
	DCA	KBDPT2
	ISZ I	KBDPT2
KBDRST,	TAD I	KBDPT2
	DCA	KBDPT1
	TAD I	KBDPT1
	SMA
	JMP	.+3
	DCA I	KBDPT2		/END OF BUFFER, RESET FETCH POINTER
	JMP	KBDRST		/BETTER LUCK NEXT TIME
	ISZ I	KBDPTR		/SHOW A CHARACTER GONE
	NOP			/SHOULD SKIP PRETTY OFTEN
	EXIT	KBDFCH

CDQKBD,	TAD	TTIBIT		/SHOW KEYBOARD INPUT ACTIVE
	DCA I	CDQSTS
CDQK1,	JMS	KBDSET		/TEST FOR CHARS IN BUFFER AND SET PTRS
	JMP	KBDWT		/NOTHING THERE
KBDLP,	JMS	KBDFCH		/GET A CHARACTER
	ION
	DCA	KBDPT1		/STORE CHARACTER
	DCA	UMODE
	TAD	JOB
	CALL	(QPTRST
	TAD	KBDPT1
	CALL	(QPUTC		/STORE CHARACTER
	JMP	KBDWT2		/END OF RECORD SOMEHOW
	ISZ	UMODE		/LET THE WORLD GO ON
	PUSHJ
	SLEEP
	JMP	CDQK1		/ECHO SHOULD BE FINISHED
KBDWT,	TAD	TTIBIT		/SET KEYBOARD WAIT
KBDWT2,	ISZ	UMODE		/NO UMODEEE, NO TIMESHAREEE
	PUSHJ
	SLEEP
	POPJ			/HERE WHEN DONE, STATUS IN QUETBL
KBDPT1,	0
KBDPT2,	0
KBDPTR,	0

CDQPTP,	TAD	PTPBIT		/HERE TO START UP THE PUNCH
	DCA I	CDQSTS
	DCA	UMODE		/STOP LEVEL 2 TO SHARE UNPACKERS
	TAD	JOB
	CALL	(QPTRST
	CALL	(QGETC
	CALL	(PTPCR		/NULL RECORD
	IOF
	PLS
	CLA
	TAD	PTPBIT
	JMP	KBDWT2		/SAVE A COUPLE WORDS
CDQPTR,	TAD	PTRBIT
	DCA I	CDQSTS		/SHOW PTR WAIT
	IOF
	RFC			/START READER
	ISZ I	(PTRWAT
	TAD	PTRBIT
	JMP	KBDWT2

TTICHR,	JMS	KBDSET		/CALL WITH PUSHJ FOR SINGLE CHARACTER
	JMP	TTIWT		/NOBODY HOME
	JMS	KBDFCH
	TAD	L0200
	POPJ			/EXIT WITH ANY OLD CHAR IN AC
TTIWT,	TAD	TTIBIT
	PUSHJ
	SLEEP
	JMP	TTICHR
NULLS,	DCA	NULTM		/CALL WITH PUSHJ TO PRINT STRANGE THINGS FOLLOWED 
	TAD	JOB
	TAD	(TTARGS
	DCA	TTOCJB
	TAD	(-NULCNT
	DCA I	TTOCJB
	SKP			/FALL INTO TTOCHR
TTOCHR,	DCA	NULTM		/CALL WITH PUSHJ TO PRINT SINGLE CHAR
	TAD	JOB
	DCA	TTOCJB
	DCA	UMODE
	TAD	NULTM
	CALL	(PRINTC
TTOCJB,	0
	ISZ	UMODE
	PUSHJ
	SLEEP
	POPJ
NULTM,	0

QPCRLF,	0
	JMS	QECHO		/IS THIS KEYBOARD INPUT?
	JMP I	QPCRLF		/NOPE
	TAD	QJOB
	DCA	QPCRJB
	CALL	(TTYCR
	CALL	(PRINTC
QPCRJB,	0
	EXIT	QPCRLF
QECHO,	0
	TAD	QJOB
	TAD	(QUETBL
	DCA	QPCRJB
	TAD	TTIBIT
	AND I	QPCRJB
	SZA CLA
	ISZ	QECHO		/TAKE SKIP RETURN IF KBD
	JMP I	QECHO
/
	PAGE

PTPJOB,	4000
PTRJOB,	4000		/MUST BE AT PTPJOB+1
PTPL2,	TAD	PTPFG		/WHY THE INTERRUPT?
	SZA CLA
	JMP	PTPLF		/END OF RECORD ACTION
	TAD	PTPJOB		/MUST BE MORE DATA
	CALL	(QPTRST
	CALL	(QGETC
	JMS	PTPCR		/RETURN HERE ON END OF RECORD
PTPGO,	PLS
	L2DIS
PTPLF,	ISZ	PTPFG		/PUNCH LF OR TURN OFF
	JMP	PTPLFD
	TAD	PTPJOB
	TAD	(JOBTBL		/ABOUT TO TURN OFF I/O WAIT
	DCA	PTPSHR
	TAD	PTPBIT
	JMP	PTRCX
PTPLFD,	CMA			/SET TO DISMIS ON NEXT INTERRUPT
	DCA	PTPFG
	TAD	(212
	JMP	PTPGO
PTPFG,	0		/ =0 - IDLE
			/ >0 - PRINT LINE FEED THIS TIME
			/ <0 - CLEAR I/O WAIT AND DISMIS
PTPSHR,	0
PTPCR,	0
	TAD	PTPJOB
	TAD	(QUETBL
	DCA	PTPSHR
	DCA I	PTPSHR		/CLEAR QUEUE STATUS WORD
	ISZ	PTPFG		/SET FLAG FOR LINE FEED
	TAD	L215
	JMP I	PTPCR

PTRL2,	DCA	PTRCLK		/CLEAR TIMEOUT CLOCK
	TAD	PTRJOB
	CALL	(QPTRST
	L2QOUT
	AND	(177		/LOSE THE PARITY
	CALL	(QPUTC		/PACK CHARACTER
	JMP	PTRCLR		/RECORD DONE
	RFC			/NEED MORE
	ISZ	PTRWAT		/SHOW READER ACTIVE
	DCA	PTRCLK		/SET TIMER TO 4096 COSDPY'S
	L2DIS
PTRCLR,	TAD	PTRJOB
	TAD	(JOBTBL		/ON END OF RECORD, CLEAR I/O WAIT
	DCA	PTPSHR
	TAD	PTRBIT
PTRCX,	CMA
	AND I	PTPSHR
	DCA I	PTPSHR
	L2DIS
PTRWAT,	0			/NON-ZERO MEANS CHAR WAS RFC'D
PTRCLK,	0			/USED FOR TIMEOUT ON PTR
COSDPY,	0		/FRILL TO DISPLAY ANY LOCATION IN FLD 0
	LAS		/ADDRESS INDICATED BY SWITCHES
	DCA	COSDP
	TAD I	COSDP
	MQL
	CLA
	TAD	PTRWAT		/IS THE PTR WAITING FOR NEXT CHAR?
	SZA CLA
	ISZ	PTRCLK		/IF SO, HOW LONG HAS IT BEEN?
	EXIT	COSDPY		/NOT WAITING OR NOT LONG ENOUGH
	DCA	PTRWAT		/TOO LONG, MUST BE OUT OF TAPE
	TAD	(PTRL2		/SO PUT SERVICE RTN ON L2Q
	L2QIN			/CALL WITH IOF, REMEMBER
	TAD	("Z&277		/SUPRISE!! A CTRL/Z!
	L2QIN
	EXIT	COSDPY
COSDP,	0

/SCAN BITMAP TO FIND A FREE SEGMENT, MARK IT AS USED (CLEAR THE BIT)
/AND RETURN WITH SEGMENT # IN AC.
/BITMAP IS SET UP AS:
/	BIT 0 = 1	;END OF BITMAP TABLE
/	BITS 4-11	;CORRESPOND TO EIGHT SEGMENTS
/			;BIT 11 CORRESPONDS TO SEGMENT N
/			;BIT 4 CORRESPONDS TO SEGMENT N+8
/			;IF THE BIT IS ON, THE SEGMENT IS FREE
/			;BITS 1-3 OF EACH WORD ARE UNUSED
GETSEG,	0
	JMS	CHKBIT
FREONE,	DCA	GSEGT
	AC7777
	TAD I	BITPTR		/TURN OFF THE RIGHTMOST BIT
	AND I	BITPTR		/(COURTESY OF THE WIZARD)
	DCA I	BITPTR
	TAD I	BITPTR
	CMA
	AND	GSEGT		/NOW ISOLATE THAT BIT
RARBIT,	CLL RAR
	ISZ	THI		/BUMP SEGMENT # AS WE ROTATE THE BIT
	NOP			/(LPSTRT MAY HAVE BEEN 7777!)
	SZA			/UNTIL THE BIT GOES AWAY
	JMP	RARBIT
	TAD	THI		/THIS NOW = THE SEGMENT # THAT WE FOUND TO BE FREE
	JMP I	GETSEG
OVRFLO,	TAD	JOB
	TAD	(QUETBL-4000	/AC=4000 ON ENTRY
	DCA	THI
	AC4000
	DCA I	THI		/SET "XMIT ERROR"
	AC0001
	DCA	UMODE		/WE MAY HAVE CLEARED THIS SO WE COULD USE QPTRST
	POPJ			/RETURN TO WHERE CDQ WAS CALLED FROM
CHKBIT,	0
	CDF 0			/SELF-PRESERVATION
	TAD	(BITMAP
	DCA	BITPTR
	TAD I	(LPSTRT		/STARTING SEGMENT # OF LOGICAL UNIT
GETX,	DCA	THI
	TAD I	BITPTR
	SPA			/HAVE WE REACHED END OF BITMAP?
	JMP	OVRFLO		/YES - GUY IS UP THE CREEK
	SZA			/AC NON-0 MEANS A FREE SEGMENT...
	JMP I	CHKBIT		/FIGURE OUT EXACTLY WHICH
	ISZ	BITPTR		/GO TO NEXT SET OF BITS
	TAD	THI		/BUMP SEGMENT #
	TAD	L0010		/BY 8
	JMP	GETX		/AND LOOK AT NEXT SET OF BITS
THI,	0
BITPTR,	0
GSEGT,	0
/
	PAGE

/QUEUEING DISK HANDLER FOR COS 300 FOREGROUND/BACKGROUND
/CALL DSKQ TO QUEUE A REQUEST.
/
/CALL:
/	TAD	(PARAM-1		PARAM,	LOW BLOCK #
/	CDF	CURRENT				R/W,LEN,F,U
/	CIF	DSKQ FIELD			ADDR
/	IOF					HIGH BLOCK #
/	JMS	DSKQ
/	(RETURN)	;REQUEST STATUS IN QUETBL
DSKQ,	0
	IOF
	DCA	XR10		/SAVE PTR TO PARAMS
	RDF			/GET PARAMS CDF
	TAD	LCDF
	DCA	DKARGF
	CDF 00
	AC0002			/FORM CIF CDF
	TAD	DKARGF		/FIX UP OUR GETAWAY ROUTE
	PUSHAC
	TAD	DSKQ
	PUSHAC
	TAD	(-4
	DCA	DKCNT
	AC7777
	TAD	DKPNDG
	DCA	DKPNDG		/BUMP COUNT OF PENDING REQUESTS
	TAD	JOB		/COMBINE JOB # WITH FIRST ARG
DKNCTR,
DKARGF,	0			/CDF ARG FIELD
	TAD I	XR10		/GET AN ARG
	CDF	00
	DCA I	DKQPUT		/ADD ARG TO THE QUEUE
	ISZ	DKQPUT		/AND BUMP QUEUE PTR
	ISZ	DKCNT		/GOTTEN ALL ARGS?
	JMP	DKARGF		/NOPE
	TAD	JOB
	TAD	(QUETBL
	DCA	DKNEXT
	TAD	DDDBIT
	DCA I	DKNEXT		/SET "OPERATION IN PROGRESS" FOR THIS JOB
	TAD I	DKQPUT		/RESET BUFFER POINTER
	DCA	DKQPUT
CKPNDG,	TAD	DKPNDG		/CHECK ON PENDING REQUESTS
	CMA			/MAKE -1 A 0
	SZA CLA			/IF ONLY ONE REQUEST PENDING, IT'S THE
	JMP	.+3		/REQUEST WE JUST PUT ON THE QUEUE
	JMS	DKNEXT		/SO IF THAT'S THE CASE, GET IT OFF
	JMS I	(DKSTRT		/AND START IT GOING
	TAD	DDDBIT
	PUSHJ
	SLEEP
	POPJ			/RETURN TO USER

/THIS ROUTINE GETS THE NEXT REQUEST FROM THE DSK QUEUE AND
/MAKES IT THE "CURRENT REQUEST" IN LOCATIONS DKARG1-DKARG4.
/IT ALSO SETS THE MAGIC ERROR COUNTER RETRY.
DKTMP,
DKCNT,
DKNEXT,	0
	TAD	(DKARG1-1
	DCA	XR10
	TAD	(-4
	DCA	DKNCTR
DKNLP,	TAD I	DKQGET
	DCA I	XR10
	ISZ	DKQGET		/BUMP TO NEXT
	ISZ	DKNCTR
	JMP	DKNLP
	AC7775
	DCA	DKTRY
	TAD I	DKQGET		/RESET PTR
	DCA	DKQGET
	EXIT	DKNEXT

/COME HERE ON DISK ERRORS, OR ON DISK DONE
DKERR,	CLL CML
DKDONE,	TAD	DKJOB		/LINK = 0 IF ENTRY AT DKDONE
	TAD	(QUETBL
	DCA	DKTMP
	RAR			/0 IF OK OR 4000 IF ERROR
	DCA I	DKTMP		/SET JOB'S PENDING WORD
	TAD	DKJOB
	TAD	(JOBTBL
	DCA	DKTMP
	TAD	DDDBIT
	CMA
	AND I	DKTMP
	DCA I	DKTMP		/CLEAR MASS-STORAGE WAIT BIT FOR THIS JOB
BMPNDG,	ISZ	DKPNDG		/ARE THERE MORE REQUESTS IN THE QUEUE?
	SKP
	L1DIS
	JMS	DKNEXT		/GET NEXT REQUEST FROM THE QUEUE
DKRETR,	JMS I	(DKSTRT		/AND START IT GOING
	L1DIS
/
DKQPUT,	DKQBEG			/DSK QUEUE "PUT" PTR
DKPNDG,	0			/THE NUMBER OF PENDING DSK REQUESTS FROM ALL JOBS
DKJOB,	0			/THE JOB # OF THE CURRENT REQUEST
DKTRY,	0
DKSTAT,	0			/FOR RECALIBRATION PURPOSES
DKQGET,	DKQBEG			/DSK QUEUE "GET" PTR
DKARG1,	0			/THE "CURRENT JOB" PARAMETERS
DKARG2,	0
DKARG3,	0
DKARG4,	0
DKBLOC,	0			/BLOCK # BEING TRANSFERRED
DKCORE,	0			/CORE ADDR IT'S GOING INTO

QGETC,	0
	ISZ I	CDQPT1		/ANY MORE CHARACTERS IN RECORD?
	SKP
	JMP I	QGETC		/NO, TAKE NON SKIP RETURN
	TAD I	CDQPT2		/PICK UP CDF
	DCA	QGTCDF
	TAD I	CDQPT3
	CLL RAR
	CLL			/ADD BYTE DISPLACEMENT TO RECORD ADDR
	TAD I	CDQPT4
	DCA	QGTCHR		/POINTER TO PACKED WORD
	SZL			/CARRY IF CROSSED A FIELD BOUNDARY
	TAD	L0010
	TAD	QGTCDF
	DCA	QGTCDF
	AC0001
	AND I	CDQPT3		/LOOK AT EVEN OR ODD BYTE SWITCH
	CLL RAR
QGTCDF,	0
	TAD I	QGTCHR
	CDF 00
	ISZ I	CDQPT3		/BUMP BYTE POINTER
	SZL
	JMP	.+4
	RTR
	RTR
	RTR
	AND	L77
	SZA			/ANYBODY HOME?
	ISZ	QGETC		/YES, SKIP RETURN
	SZA			/PREVENT GARBAGE
	TAD	(237
	JMP I	QGETC
QGTCHR,	0
/
	PAGE

/***** THIS PAGE MAY CHANGE *****
DKSTRT,
RK01,	0			/CODE FOR RK05 OR RF08 MAY BE MOVED TO HERE
	TAD I	(DKARG1
	AND	L7
	DCA I	(DKJOB		/THE JOB # THE CURRENT OPERATION BELONGS TO
	TAD I	(DKARG1
	AND	L7400
	DCA I	(DKBLOC
	TAD I	(DKARG2
	AND	L7
	TAD I	(DKARG2
	AND	L77
	TAD	(7000		/MAGIC BITS TO ENABLE INTERRUPT
	DLDCX
	TAD I	(DKARG2
	RAL			/WATCH R/W BIT IN LINK
	AND	L7600
	SZA			/PRESERVE LINK THRU THIS CIA
	CIA
	DLWC
	RTL
	TAD	(DLDR		/FORM READ OR WRITE
	DCA	RKINST
	DCA I	(DKSTAT		/CLEAR "STATUS" KLUDGE FOR RECALIBRATES
	AC7777
	TAD I	(DKARG3
	DLCAX			/CURRENT ADDRESS-1
	DCLS
	TAD I	(DKBLOC
	CLL RAL
	TAD I	(DKARG4
	RTL
	RTL
RKINST,	0			/GO!
	EXIT	RK01		/AND LET IT DO ITS THING

/CODE TO HANDLE RK8 INTERRUPT
RK8ERR,	DRDS			/GET STATUS
	AND	L0004
	SZA CLA			/CHECK FOR TRACK OVERFLOW ERROR
	JMP	RKOVRF		/THAT'S IT - RESET TRACK ADDRESS
	ISZ I	(DKTRY		/SOMETHING ELSE - HAVE WE TRIED 3 TIMES?
	JMP I	(DKRETR		/NOT YET - GIVE IT ANOTHER SHOT
	DRDS			/GET STATUS OF THE THING - WE GOT PROBLEMS
	DCA I	(ERSTAT
	DRDS
	AND	L0040
	DCLS
	SNA CLA			/IS IT A TRACK SEEK ERROR?
	JMP I	(DKERR		/NO - WE REALLY LOST IT
	ISZ I	(DKSTAT		/SIGNAL WE'RE DOING A RECALIBRATE
	DCLA			/ZAP!
	L1DIS			/COME BACK WHEN THE FLAG DOES
RKDSKD,	DCLS
	TAD I	(DKSTAT
	SZA CLA			/WERE WE DOING A RECALIBRATE?
	JMP I	(DKRETR		/YES - REPEAT OPERATION
	JMP I	(DKDONE
RKOVRF,	DCLS			/COME HERE FOR TRACK OVERFLOWS
	TAD	RKINST
	DCA	RKOP2
	DRDA
	AND	(7760
	TAD	L0020
RKOP2,	0
	L1DIS
/
	PAGE

TSKCHK,	TAD	UMODE		/WERE WE IN USER MODE AT THE LAST INTERRUPT?
	SNA CLA
	JMP	INTDIS		/NO, SO SIMPLY DISMIS
	TAD	INTAC		/YES SO SAVE USER CONTEXT IN CASE SOMETHING
	DCA	USRAC		/GOT PUT ON THE LEVEL 2 QUEUE
	TAD	INTLNK
	DCA	USRLNK
	TAD	INTCDF
	DCA	USRCDF
	TAD	INTCIF
	DCA	USRCIF
	TAD	0
FAKINT,	DCA	USRRTN
	DCA	UMODE		/SET TASK LEVEL
NXTTSK,	IOF			/WITHOUT TRUST THERE IS NOTHING
	CALL	(COSDPY		/THE WORLD IS BASED ON TRUST
	TAD	L2QPTI		/COMPARE L2Q POINTERS
	CIA
	TAD	L2QPTO
	SNA CLA
	JMP	USRDIS		/EQUAL MEANS NO TASKS ON L2Q
	L2QOUT			/FIRST ITEM ON QUEUE IS ROUTINE ADDRESS
	DCA	0		/SET UP PHONEY INTERRUPT RETURN
	JMP	DISPCH		/AND DISPATCH TO TASK

USRDIS,	ISZ	UMODE		/HERE WHEN NO MORE TASKS (ALAS POOR USER)
	TAD	USRLNK
	CLL RAL
	TAD	USRAC
USRCDF,	HLT
USRCIF,	HLT
	ION
	JMP I	USRRTN
USRRTN,	0
USRAC,	0
USRLNK,	0
INTDIS,	TAD 	INTLNK
	CLL RAL
	TAD	INTAC
INTCDF,	0
INTCIF,	0
DISPCH,	ION
	JMP I	0
INTAC,	0
INTLNK,	0
FAKEY,	DCA	USRAC		/CLEAR OUT OLD STATE
	DCA	USRLNK
	DCA	USRCIF		/EL CHEAPO NOP'S
	DCA	USRCDF
	TAD	(SCHEDR		/RETURN VECTOR
	JMP	FAKINT

/ CALL TO STORE AC ON LEVEL TWO QUEUE.  CALL WITH IOF OR
/ YOU MAY NEVER BE HEARD FROM AGAIN
/
L2QPUT,	0
	DCA I	L2QPTI
	ISZ	L2QPTI
	TAD	L2QPTI
	TAD	(-L2QEND
	SZA CLA
	JMP I	L2QPUT		/HAVEN'T REACHED END YET
	TAD	(LEVL2Q		/RESET FILL POINTER TO BEGINNING OF QUEUE
	DCA	L2QPTI
	EXIT	L2QPUT
L2QPTI,	LEVL2Q			/FILL POINTER
L2QPTO,	LEVL2Q			/FETCH POINTER
L2QTMP,	0
L2QGET,	0			/CALL TO GET NEXT ITEM FROM QUEUE
	TAD I	L2QPTO
	DCA	L2QTMP
	ISZ	L2QPTO
	TAD	L2QPTO		/END OF BUFFER YET?
	TAD	(-L2QEND
	SZA CLA
	JMP	.+3		/STILL MORE TO GO
	TAD	(LEVL2Q		/MUST RESET
	DCA	L2QPTO
	TAD	L2QTMP
	EXIT	L2QGET

/ PUSHJ TO SLEEP TO UNSCHEDULE THE CURRENT JOB. HAVE REASON WHY
/ (BITS) IN AC.  MAY BE CALLED WITH AC=0 FOR RELEASE REQUEST OR
/ WHEN INSTRUCTION COUNT OVERFLOWS.  SCHEDULER RUNS UNTIL RUNNABLE
/ JOB IS FOUND.  SWAPPING OCCURS IF NEW JOB IS DIFFERENT THAN
/ OLD JOB.
SLEEP,	IOF			/PREVENT KILLER INTERRUPT
	TAD I	JOBSTS		/BITS IN AC (MAYBE)
	DCA I	JOBSTS
	AC2000			/DID WE JUST TURN THIS GUY OFF?
	AND I	JOBSTS
	SNA CLA
	JMP	SCHED		/NO
	ISZ	NJOBS		/YES, DECREMENT # USERS
	JMP	SCHED
	TAD I	(LPQCNT
	SNA CLA			/LPT REQUESTS PENDING?
	JMP I	(REBOOT		/REBOOT IF NO MORE
SCHED,	TAD	JOB		/DEACTIVATE JOB
	DCA	OJOB
	AC4000
	DCA	JOB		/SHOW SCHEDULAR RUNNING
SCHEDL,	IOF
	CALL	(COSDPY
	TAD	L2QPTI		/THERE MIGHT BE SOMETHING ON LEVEL 2
	CIA
	TAD	L2QPTO		/IMPOSSIBLE YOU SAY? (THINK ABOUT IT)
	SZA CLA
	JMP	FAKEY		/IF THERE IS, SIMULATE USER MODE INTERRUPT
SCHEDR,	ION			/NOTHING THERE, CHECK THE USERS
	TAD I	NJBPTR		/LOOK AT NEXT ENTRY IN JOB STATUS TABLE
	ISZ	NJBPTR
	SMA			/END OF TABLE?
	JMP	.+3		/NO
	DCA	NJBPTR		/YUP
	JMP	SCHEDR
	AND	(7770		/IGNORE LOGICAL NUMBER BITS
	SZA CLA			/RUNNABLE?
	JMP	SCHEDL		/NOPE
	TAD	NJBPTR		/YES WOW
	TAD	(-JOBTBL-1	/WHICH ONE?
	DCA	NEWJOB		/ME! ME! ME!
	TAD	NEWJOB		/WHO THE HELL IS MEMEME?
	CIA
	TAD	OJOB		/SAME AS OLD ONE?
	SNA CLA
	JMP I	(SCHEDX		/YES, SUPER
	JMP I	(SCHEDY		/NOPE, DO A SWAP FIRST
/
	PAGE

SCHEDY,	TAD	OJOB		/SWAP OUT THE OLD DIRTY ONE
	JMS	SWAPO
STARTM,	TAD I	(NEWJOB
	JMS	SWAPI		/GET IN A NICE NEW CLEAN ONE
SCHEDX,	TAD I	(NEWJOB
	IOF
	DCA	JOB
	CALL	(COSDPY		/ONE LAST CHANCE TO PEEK AT JOB #
	POPJ
SWAPO,	0			/CALL WITH JOB # TO SWAP OUT
	DCA	SWPJOB
	CALL	(STKCHK		/TOO MUCH ON THE STACK?
	TAD	SWPJOB		/RETURN HERE REGARDLESS
	TAD	(STKTBL
	DCA	SWPT2
	TAD	STACKP		/SAVE USERS STACK POINTER
	DCA I	SWPT2
	JMS	JOBLOC		/NOW FIND CDF AND WORD ADDR OF JOB AREA
	DCA	SWPT2
	CMA
	TAD I	SWPGET
	DCA	SWPPUT
	TAD	(SWPBEG-1
	DCA	SWPGET			/START AT WORD 0
	TAD	(SWPBEG-SWPEND-SWPSTK
	JMS	SWAPIT
	CDF RSFLD
SWPT2,	0
	JMP I	SWAPO

SWAPI,	0			/CALL WITH JOB # TO SWAP IN
	DCA	SWPJOB
	TAD	SWPJOB
	TAD	(STKTBL		/GET STACK POINTER
	DCA	SWPT2
	TAD I	SWPT2
	DCA	STACKP
	TAD	SWPJOB		/AND SET POINTER TO JOB STATUS
	TAD	(JOBTBL
	DCA	JOBSTS
	JMS	JOBLOC
	DCA	SWPT3
	CMA
	TAD I	SWPGET
	DCA	SWPGET
	TAD	(SWPBEG-1
	DCA	SWPPUT
	TAD	(SWPBEG-SWPEND-SWPSTK
	JMS	SWAPIT
SWPT3,	0
	CDF RSFLD
	JMP I	SWAPI
SWPJOB,	0
JOBLOC,	0
	TAD	SWPJOB
	CLL RAL
	TAD	(BASTBL-1
	DCA	SWPGET
	TAD I	SWPGET
	JMP I	JOBLOC

LPFT,
SWAPIT,	0
	DCA	SWPCNT
	TAD I	SWAPIT
	SNA			/IF NO ARGS THEN USE OLD VALUES
	JMP	SWPFG-1
	DCA	SWPFG
	ISZ	SWAPIT
	TAD I	SWAPIT
	DCA	SWPFP
	ISZ	SWAPIT
SWPFG,	0
	TAD I	SWPGET
SWPFP,	0
	DCA I	SWPPUT
	ISZ	SWPCNT
	JMP	SWPFG
	CDF 00
	JMP I	SWAPIT
SWPCNT,	0

/ROUTINE TO FINI THE LPT FOR A PARTICULAR JOB.
/IT WRITES AN EOF (WC = 0) IN JOB'S $LPTSP FILE AND THEN
/WRITES THE PARTIAL BLOCK.
LPTFIN,	CIF CDF 10
	JMP I	(LPKLG2
LPUNK2,	IOF			/THE COWARD'S WAY OUT
	TAD I	(LPQCNT
	SZA			/HAS LPTSPL BEEN STARTED YET?
	JMP	NOGOAD		/YUP - LET IT DO ITS OWN THING
	TAD	LPTBIT
	CMA
	AND I	(LPTJOB		/IF NOT, PROD IT INTO ACTION
	DCA I	(LPTJOB		/BY CLEARING LPT WAIT BIT
NOGOAD,	TAD	(LPQSIZ
	SMA SZA CLA		/IS THERE ROOM IN LPTSPL QUEUE?
	JMP	LPQOK		/SURE IS
	PUSHJ
	SLEEP			/MAKE A NOISE LIKE A COAT HOOK AND HANG AROUND A WHILE
	JMP	LPUNK2		/...THEN TRY OUR LUCK AGAIN
LPQOK,	AC7777
	IOF			/?
	TAD I	(LPQCNT		/BUMP COUNT OF PENDING LPTSPL REQUESTS
	DCA I	(LPQCNT
	TAD	JOB		/COMPUTE OFFSET INTO TABLE
	TAD	(LPFILE
	DCA	LPFT
	TAD I	LPFT		/STARTING BLOCK, THIS GUY'S CURRENT $LPTSP FILE
	DCA I	LPQPUT		/PUT IN THE LPTSPL QUEUE
	ISZ	LPQPUT
	TAD	LPQPUT
	AND	(-LPQSIZ-1	/DO THE BUFFER WRAP-AROUND THING
	DCA	LPQPUT
	ION
	CIF CDF 10
	JMP I	(ILOOP		/"WHEN YOU DON'T KNOW WHAT TO DO, JUNP TO ILOOP"
LPQPUT,	LPTQ
/
	PAGE

/ ROUTINE TO CHECK CHARACTERS FOR CTRL/C, CTRL/N, AND CTRL/O.  IF
/ CTRL/C IS FOUND THE SYSTEM IS SHUT DOWN IF THE TERMINAL LOGICAL JOB # = 0,
/ OR THE JOB IS TURNED OFF IN THE JOBSTATUS TABLE IF JOB # = N.
/ IF CTRL/N IS ENABLED, THE KEYPAD SUBSTITUTION IS MADE HERE.
/
/CALLING SEQUENCE:
/
/	TAD	CHAR
/	CALL	(CNOCHK
/	(JOB #)
/	<CTRL/C,N,O RETURN>	/AC=0
/	<NORMAL RETURN>		/AC=CORRECTED CHARACTER
CNOCHK,	0
	AND	(177
	DCA	CNOTM0		/CALL ON KEYBOARD CHARACTER TO CHECK
	TAD I	CNOCHK		/GET JOB #
	TAD	(JOBTBL		/SET TO STATUS WORD FOR PROPER JOB
	DCA	CNOTMP
	TAD	(-17		/OK
	TAD	CNOTM0		/WAS THE CHARACTER CTRL/O?
	SNA
	JMP CNOCTO		/YES
	IAC			/ CTRL/N?
	SNA
	JMP	CNOCTN		/YES
	TAD	(13		/CTRL/C?
	SZA CLA
	JMP	CNOEND		/NONE OF THE ABOVE
	TAD I	CNOTMP		/OH, OH. HOW IMPORTANT IS THIS GUY?
	AND	L7
	SNA CLA
	JMP I	(REBOOT		/IMPORTANT ENOUGH! RELOAD
	TAD I	CNOCHK		/PREPARE A NASTY LITTLE SUPRISE
	CALL	(SHIFT		/FOR HIM THE NEXT TIME HE RUNS
	STOP			/AND MAKE SURE HE WILL RUN
	JMP	CNOXT

CNOCTO,	JMS	CNOPTR		/FIND THE TERMINAL STATUS WORD
	RAR
	CML RAL			/COMPLEMENT BIT 11 (CTRL/O)
	JMP CNOCON
CNOCTN,	JMS	CNOPTR		/FIND THE TERMINAL STATUS WORD
	RAL			/COMPLEMENT BIT 0
	CML
	RAR
CNOCON,	DCA I	CNOTMP
	JMP	CNOXT
CNOTMP,	0
CNOTM0,	0
CNOPTR,	0
	TAD I	CNOCHK
	TAD	(TMNLTB
	DCA	CNOTMP
	TAD I	CNOTMP
	JMP I	CNOPTR

CNOEND,	JMS	CNOPTR		/TEST FOR CTRL/N TURNED ON
	SMA CLA
	JMP	CNNXT
	TAD	(CTNLST		/SET UP FOR SEARCH
	DCA	CNOTMP
CTNLOP,	TAD  I	CNOTMP
	ISZ	CNOTMP
	SNA			/END OF LIST?
	JMP	CNNXT
	TAD	CNOTM0		/SAME AS CHARACTER?
	SZA CLA
	JMP	CTNLOP		/NO, TRY NEXT
	TAD	CNOTMP		/FIGURE NUMBER
	TAD	(-CTNLST+57
	SKP
CNNXT,	TAD	CNOTM0		/NORMAL EXIT WITH NORMAL CHAR
	ISZ	CNOCHK
CNOXT,	ISZ	CNOCHK
	EXIT	CNOCHK

STKCHK,	0			/CALLED BY SWAPO TO MAKE SURE
	CDF RSFLD		/HE ISN'T OVER THE STACK LIMIT
	TAD I	(PDL
	CDF 00
	TAD	(-PDLEND
	SPA SNA CLA
	EXIT	STKCHK
	DCA	UMODE		/AHA, YOU GREEDY USER
	TAD I	(SWPJOB		/REMEMBER SHIFT IS CALLED FROM LEVEL 2
	CALL	(SHIFT
	PSHERR			/MAKE HIM RETURN TO ERROR IN FIELD 1
	CDF RSFLD		/RESET HIS PDL SO HE WONT GET OVERFLOW
	TAD	(PDLBEG		/ALONG WITH THE ERROR MESSAGE
	DCA I	(PDL
	CDF 00
	ISZ	UMODE		/THAT WILL TEACH HIM TO USE SUBROUTINES
	EXIT	STKCHK

POPJX,	DCA	PPAC		/RETURN TO SENDER
	POPAC			/ADDRESS
	DCA	PUSHJX
	POPAC			/AND FIELD
	DCA	POPCDF
	TAD	PPAC		/EVEN THE AC
POPCDF,	0
	ION			/UP, UP, AND AWAY
	EXIT	PUSHJX
POPX,	0			/CALL TO POP AN AC FROM THE FIELD ZERO STACKS
	TAD	STACKP		/AUTO INDEX!!
	DCA	TPOP
	CMA CML
	TAD	STACKP
	DCA	STACKP
	TAD I	TPOP
	EXIT	POPX		/WHAT A STRUGGLE
PUSHJX,	0			/CAN BE CALLED FROM ANY FIELD
	DCA	PPAC		/PROBABLY NEED THIS
	TAD I	PUSHJX		/GET ADDRESS OF FIELD ZERO ROUTINE
	DCA	TPOP
	RDF			/DATA FIELD TELLS WHERE WE CAME FROM
	TAD	(CDF CIF	/PREPARE DISMIS
	CDF 00
	PUSHAC			/STORE ON USER STACK
	TAD	PUSHJX
	IAC			/RETURN ADDRESS PLUS ONE
	PUSHAC			/TO GET PAST ADDRESS VECTOR IN CALL
	TAD	PPAC
	EXIT	TPOP		/OFF WE GO
TPOP,	0
PPAC,	0
/
	PAGE

RUNIT,	TAD I	(JOBTBL
	AND	TTOBIT
	SZA CLA
	JMP	RUNIT
	TAD	NJOBS
	DCA	RUNCTR
	TAD	(BASTBL-1
	DCA	XR10
	TAD	(STKTBL-1
	DCA	XR11
	JMS	RUNITL
	ISZ	RUNCTR		/KEEP GOING FOR # OF REAL JOBS
	JMP	.-2
LPTRUN,	JMP I	(STARTM		/IF LPT, THIS GETS ZAPPED
	TAD	L7
	DCA	RUNJOB
	TAD	(BASTBL-1+16
	DCA	XR10
	TAD	(STKTBL-1+7
	DCA	XR11
	JMS	RUNITL		/CALL IT ONE MORE TIME FOR LPTSPL JOB (#7)
	JMP I	(STARTM
RUNITL,	0
	TAD	RUNJOB
	TAD	(JOBTBL
	DCA	RUNPTR
	AC5777
	AND I	RUNPTR
	DCA I	RUNPTR
	TAD I	XR10
	CDF RSFLD
	DCA I	(USRFLD
	DCA I	(W0		/ZERO OUT LOADER FILE GORP
	CDF 00
	TAD I	XR10
	CDF RSFLD
	DCA I	(USRBAS
	TAD I	(USRBAS
	DCA	RUNPTR
	TAD	(-JOBSAV
	DCA	RUNCTX		/ZERO OUT JOB SAVE AREA
	TAD I	(USRFLD
	DCA	.+1
	HLT
	DCA I	RUNPTR
	ISZ	RUNPTR
	ISZ	RUNCTX
	JMP	.-3
	CDF 00
	TAD I	XR11
	DCA	STACKP
	TAD	RUNJOB
	CALL	(SWAPO
	TAD	(DEFAUL-1
	DCA	SWPGET		/PREPARE TO MOVE UP DEFAULT I/O
	TAD	(FARRAY+6-BARRAY
	TAD	SWPPUT
	DCA	SWPPUT
	AC7776
	CALL	(SWAPIT
	0
	ISZ	RUNJOB
	JMP I	RUNITL
RUNCTR,	0
RUNPTR,	0
RUNJOB,	0
COPPTR,			/SHARED BY COPOUT
RUNCTX,	0

COPOUT,	0		/CALLED FROM RSFLD TO UNDO THE CDF
	TAD I	(W0	/INCREMENT JUST DONE BY FLDOVR IF BUFFER WAS LAST BLOCK IN FIELD
	SMA CLA		/MUST RESET PUTCDM OR GETCDF IF WRITE OR READ
	TAD	(GETCDF-PUTCDM
	TAD	(PUTCDM
	DCA	COPPTR
	TAD	(-10
	TAD I	COPPTR		/CDF IS STILL RSFLD
	DCA I	COPPTR
	CIF RSFLD
	EXIT	COPOUT

LPRELS,	0			/MARK A SEGMENT AS "FREE" IN BITMAP
	TAD I	(LPSTRT		/GET STARTING SEG-1 OF LOGICAL UNIT
	CMA
	TAD I	(GLPTHI		/GET OFFSET OF SEGMENT FROM BEGINNING OF FILE
	DCA	LPTT3
	TAD	LPTT3
	CLL RAR
	RTR
	AND	(1777		/DIVIDE BY 8, GET OFFSET INTO BITMAP
	TAD	(BITMAP
	DCA	LPTT
	TAD	LPTT3
	AND	L7		/GET DIVISION BY 8 REMAINDER
	CMA CLL CML
	DCA	LPTT2
	RAL
	ISZ	LPTT2
	JMP	.-2		/ROTATE A BIT TO CORRECT SPOT
	TAD I	LPTT		/TO TURN ON BIT IN BITMAP
	DCA I	LPTT
	JMP I	LPRELS
LPTT,	0
LPTT2,	0
LPTT3,	0
/
	PAGE

/ ROUTINE TO DIVERT USER RESTART TO SOME HANDY ERROR TRAP.
/ CALL WITH ACALL AS:
/	TAD	JOB		;AC = JOB #
/	CALL	(SHIFT
/	(ADDR)			;DESIRED FIELD ONE RETURN ADDRESS
/	<RETURN>		;JOB STATUS WORD SET TO RUN
SHIFT,	0			/ONCE UPON A TIME THIS ROUTINE HAD A DIFFERENT NAME
	DCA	SHFTJB		/STORE THE NUMBER OF THE LUCKY FELLOW
	TAD	SHFTJB		/IS IT THE CURRENT JOB
	CIA
	TAD	JOB		/IF SO THEN NEED TO SET UP USER RETURN
	SZA CLA
	JMP	SHFTNC		/NOT THE CURRENT JOB, FIX UP HIS STACK INSTEAD
	TAD	(CIF CDF RSFLD	/MAKE THE TEENSYEST MODS TO HIS
	DCA I	(USRCIF		/RETURN ADDRESS VECTOR
	TAD I	SHIFT
	ISZ	SHIFT
	DCA I	(USRRTN		/SO WHEN THE LEVEL 2 STUFF IS DONE, WHAMMO!
	EXIT	SHIFT
SHFTNC,	TAD	(JOBTBL		/FIRST SET STATUS WORD TO RUN
	TAD	SHFTJB		/WE WOULDN'T WANT HIM TO MISS THIS
	DCA	SHFTJB
	IOF			/DON'T WANT I/O TO COMPLETE WHILE WE'VE
	TAD	TTIBIT		/GOT HIS PANTS DOWN - 
	CMA			/BUT CLEAR KEYBOARD WAIT IF THAT'S WHATS
	AND I	SHFTJB		/HOLDING THINGS UP - PRESERVE OFFBIT IF NOT OFF
	DCA I	SHFTJB
	ION
	TAD	(STKTBL-JOBTBL	/NOW PREPARE A BRAND SHINY NEW RETURN
	TAD	SHFTJB		/VECTOR SO WHEN WE WAKE HIM UP
	DCA	SHFTJB		/AND DO THE POPJ - BOOM
	AC7777			/NEED STACK POINTER - 2
	TAD I	SHFTJB
	DCA	SHFTJB
	TAD	(CDF CIF RSFLD
	DCA I	SHFTJB
	ISZ	SHFTJB
	TAD I	SHIFT		/GET ADDR OF DESIRED FINALE
	ISZ	SHIFT
	DCA I	SHFTJB
	EXIT	SHIFT
SHFTJB,	0
/
	PAGE

	*5000
/ JOB STATUS TABLE
/
/	JOB IS RUNNABLE WHEN STATUS WORD = 000N
/
/	BIT ASSIGNMENTS:
/	0	;UNUSED (MARKS END OF TABLE)
/	1	;JOB ACTIVE (1 IS OFF)
/	2	;DISK I/O WAIT
/	3	;LPT WAIT
/	4	;CDR WAIT
/	5	;PTP WAIT
/	6	;PTR WAIT
/	7	;TTY WAIT
/	8	;KBD WAIT
/	9-11	;LOGICAL TERMINAL NUMBER
/
JOBTBL,	0
	OFFBIT+1
	OFFBIT+2
	OFFBIT+3
	OFFBIT+4
	OFFBIT+5
	OFFBIT+6
LPTJOB,	OFFBIT+7	/THE LPT SPOOLER MAY TAKE OVER THIS JOB
	JOBTBL
/ JOB STACK POINTER STORAGE AREA
/
STKTBL,	J0STAK+1
	J1STAK+1
	J2STAK+1
	J3STAK+1
	J4STAK+1
	J5STAK+1
	J6STAK+1
	J7STAK+1
/ TABLE OF RECORD LOCK TABLE POINTERS
/
JBRCLK,	J0RCLK
	J1RCLK
	J2RCLK
	J3RCLK
	J4RCLK
	J5RCLK
	J6RCLK
	J7RCLK

/ QUEUE STATUS TABLE
/	STATUS ASSIGNMENTS:
/	0	;LAST REQUEST SUCCESSFUL
/	10	;KEYBOARD RECORD INPUT
/	20	;TELETYPE (VT05) RECORD OUTPUT
/	40	;PAPER TAPE READER RECORD INPUT
/	100	;PAPER TAPE PUNCH RECORD OUTPUT
/	200	;CARD READER RECORD INPUT
/	1000	;DISK BLOCK INPUT OR OUTPUT
/	-	;ERROR IN LAST OPERATION
/
QUETBL,	ZBLOCK JOBMAX
	/
	/
/ TABLE OF JOB BASE ADDRESSES
/ 	STORED AS:
/
/	000N
/	NNNN
/
BASTBL,	ZBLOCK JOBMAX^2
	/
	/
/ TABLE OF BUFFER AREAS BY JOB 
/	STORED AS:
/
/	BITS 0-4	;CORE ADDR OF FIRST BUFFER
/	BITS 6-8	;FIELD 
/
BFRTBL,	ZBLOCK JOBMAX
	/
	/

/ TABLE OF PRINTER IOT SKIP CODES
/ MUST BE TERMINATED WITH 0 AND FOLLOWED BY KBLIST
/
TTLIST,	TSF0
	TSF1
	TSF2
	TSF3
	TSF4
	TSF5
	TSF6
	TSF7
	0
/ LIST OF KEYBOARD SKIP CODES
/ MUST BE TERMINATED WITH 0 AND MUST FOLLOW TTLIST
/
KBLIST,	KSF0
	KSF1
	KSF2
	KSF3
	KSF4
	KSF5
	KSF6
LPTKSF,	KSF7
	0
/	TERMINAL STATUS TABLE
/
/	BIT 0  = CTRL/N - 1 MEANS KEVPAD ENABLED
/	BIT 11 = CTRL/O - 1 MEANS NO ECHO
/
TMNLTB,	ZBLOCK JOBMAX
	/
	/
/
/ TABLE OF PRINTER OUTPUT ARGUEMENTS
/	ARG=0 - INACTIVE TABLE ENTRY
/	ARG>0 - PRINT LINE FEED NEXT
/	ARG<0 - NUMBER OF NULLS TO BE PRINTED
/
TTARGS,	ZBLOCK JOBMAX
	/
	/

/	KEYBOARD INPUT ARGUEMENT LIST
/
/	COUNT	FETCH-POINTER	STORE-POINTER
/
KBDTBL,	0;	IBUF0-1;	IBUF0
	0;	IBUF1-1;	IBUF1
	0;	IBUF2-1;	IBUF2
	0;	IBUF3-1;	IBUF3
	0;	IBUF4-1;	IBUF4
	0;	IBUF5-1;	IBUF5
	0;	IBUF6-1;	IBUF6
	0;	IBUF7-1;	IBUF7
/	KEYBOARD INPUT BUFFERS
/
IBUF0,	ZBLOCK TTISIZ;	IBUF0
IBUF1,	ZBLOCK TTISIZ;	IBUF1
IBUF2,	ZBLOCK TTISIZ;	IBUF2
IBUF3,	ZBLOCK TTISIZ;	IBUF3
IBUF4,	ZBLOCK TTISIZ;	IBUF4
IBUF5,	ZBLOCK TTISIZ;	IBUF5
IBUF6,	ZBLOCK TTISIZ;	IBUF6
IBUF7,	ZBLOCK TTISIZ;	IBUF7

/ JOB STACK AREAS
/
J0STAK,	CDF CIF RSFLD		/JOB STACK AREAS
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J1STAK,	CDF CIF RSFLD
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J2STAK,	CDF CIF RSFLD
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J3STAK,	CDF CIF RSFLD
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J4STAK,	CDF CIF RSFLD
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J5STAK,	CDF CIF RSFLD
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J6STAK,	CDF CIF RSFLD
	ILOOPS
	ZBLOCK STKSIZ-2
	/
	/
J7STAK,	CDF CIF RSFLD		/MAY CHANGE TO:	CIF CDF 0
J7STKX,	ILOOPS			/		LPTSPL
	ZBLOCK STKSIZ-2
	/
	/

/THE DISK QUEUE; 6 SLOTS + CURRENT OPERATION
/MEANS QUEUE CAN NEVER OVERFLOW (SPACE FOR 1 REQUEST BY 7 JOBS)
/
	DKQBEG=	.
	ZBLOCK 4
	IFZERO DKQMAX-2&4000	<.+1;ZBLOCK 4>
	IFZERO DKQMAX-3&4000	<.+1;ZBLOCK 4>
	IFZERO DKQMAX-4&4000	<.+1;ZBLOCK 4>
	IFZERO DKQMAX-5&4000	<.+1;ZBLOCK 4>
	IFZERO DKQMAX-6&4000	<.+1;ZBLOCK 4>
	IFZERO DKQMAX-7&4000	<.+1;ZBLOCK 4>
	IFZERO DKQMAX-10&4000	<.+1;ZBLOCK 4>
	DKQBEG
/ THE TABLE FOR CDOIO TYPE REQUESTS.  FIVE WORDS PER JOB CONTAINING;
/
/	COUNT		;DETERMINED FROM WC IN RECORD ON OUTPUT
/	CDF		;FIELD IN WHICH DATA RESIDES
/	BYTE PTR	;BYTE DISPLACEMENT FROM BEGINNING OF RECORD
/	BUFR		;FIRST WORD (WC) OF RECORD
/	LENGTH		;ALLOWED LENGTH FOR INPUT RECORD
/
CDQTBL,	ZBLOCK JOBMAX^5
	/
	/

/ THE LEVEL 2 QUEUE.  TASKS TO BE EXECUTED WITH ION.  QUEUE CONTAINS
/ ADDRESS OF THE ROUTINE FOLLOWED BY ANY ARGUEMENTS REQUIRED.  WHEN QUEUE
/ IS EMPTY, USER LEVEL PROCESSING RESUMES.  BASED ON TSS/8 AND SUGGESTED
/ FOR MULTI-DIBOL BY THE MASTER.  REQUESTS ARE RING BUFFERED FOR
/ FIRST-IN, FIRST-OUT.
/
LEVL2Q,	ZBLOCK L2QSIZ
	/
	L2QEND=.
	IFNZRO LPTBUF-L2QEND&4000 <???> /OVERLAP!
	*LEVL2Q
MOVDWN,	IOF		/OVERLAYED BY LEVEL 2 QUEUE FOLLOWING EXECUTION
	CDF 20
	TAD I	MOV1
	CDF 00
	DCA I	MOV1
	ISZ	MOV1
	ISZ	MOV2
	JMP	MOVDWN+1
	CIF CDF 10
	JMP I	.+1
	LOADER
MOV1,	0
MOV2,	-TXTEND
/
	PAGE

/ LINE PRINTER SPOOLER BUFFER
/ ALSO USED BY LOADER
/
LPTBUF,	ZBLOCK 400		/USED TO READ BLOCKS FROM $LPTSP
LPRING,	ZBLOCK 377;	LPRING	/USED TO ACTUALLY PRINT CHARS FROM
					/LPTBUF AND LPRING MUST EACH BE 400 WORDS LONG
					/OR MORE BECAUSE THEY ARE USED FOR
					/DISK I/O BUFFERS AT STARTUP
	IFZERO LPRING&4000 <???>	/ERROR! MUST BE ABOVE *4000
/
	PAGE

/ROUTINE TO GET STUFF OUT OF $LPTSP FILE AND PRINT IT.
/ENTER AT "LPTSPL"
TMPCHR,
GETWRD,	0
	TAD	PERBLK		/# OF WORDS PER BLOCK
	SNA CLA			/ANY LEFT?
	JMS	GETBLK		/NOPE - GET A NEW BLOCK
	ISZ	PERBLK
LP212,	212			/MAY SKIP - IGNORE THAT FACT
	TAD I	LPWDPT		/GET A WORD FROM THE BLOCK
	ISZ	LPWDPT
	SZA			/0000 ANYPLACE IS EOF
	JMP I	GETWRD		/OTHERWISE, RETURN IT
LPTDUN,	TAD	GLPTLO
	SZA CLA
	CALL	(LPRELS		/RELEASE THE SEGMENT FROM THE "USED" STUFF IN BITMAP
	ISZ	LPQCNT		/IS THERE MORE STUFF PENDING?
	JMP	LPTSPL		/YUP - GO GET 'EM!
	TAD	LPTBIT
	PUSHJ			/IF NOT, GO AWAY UNTIL THERE IS
	SLEEP
LPTSPL,	ISZ	LPQGET		/BUMP THE QUEUE GETTER POINTER
	TAD	LPQGET
	AND	(-LPQSIZ-1	/TAKE CARE OF THE "RING" PART OF RING BUFFER
	DCA	LPQGET
	TAD I	LPQGET		/GET THE REQUEST
	DCA	GLPTHI		/WHICH IS SIMPLY THE STARTING SEGMENT TO PRINT
/	TAD	L0400		/DON'T TRY TO PRINT THE LABEL!
	DCA	GLPTLO
	DCA	WRDCNT
	JMS	GETBLK
NXTWRD,	TAD	WRDCNT
	CLL RAR			/SEE WHAT THE RECORD WORDCOUNT IS		
	SNA CLA			/0000 = EOF, 0001 IS "FORMS"
	JMP	WCKLUG		/IN EITHER CASE, DO SOMETHING GOOD
	JMS	GETWRD
	DCA	TMPCHR
	TAD	TMPCHR
	CLL RTR			/GET LEFT CHAR
	RTR
	RTR
	AND	L77
	SNA			/SELF-PRESERVATION - SHOULDN'T HAPPEN
	JMP	SPLKIL		/A MISS IS AS GOOD AS A MILE - SIMULATE DISK ERROR
	TAD	(237		/MAKE COSCII INTO ASCII
	JMS I	(LPOCHR		/CHUG
	TAD	TMPCHR
	AND	L77		/NOW THE RIGHT HALF
	SNA			/THIS IS LEGIT 0 SOMETIMES
	JMP	LPWCBP		/...SUCH AS THIS TIME
	TAD	(237
	JMS I	(LPOCHR		/CHUG

LPWCBP,	ISZ	WRDCNT		/BUMP WC OF RECORD WE'RE PRINTING
	JMP	NXTWRD		/(REMEMBER, A "RECORD" EQUALS A LINE)
	TAD	L215		/AND ON END-OF-LINE,
	JMS I	(LPOCHR		/WE DO A CRLF
	TAD	LP212
LPTOUT,	JMS I	(LPOCHR
	JMP	NXTWRD		/DIDDLE THEM BITS! WEAR OUT THEM RIBBONS!
WCKLUG,	SZL			/SEE IF WC WAS 0000 (END OF RECORD) OR +1 (FORMS STATEMENT)
	JMP	LPFORM
	JMS	GETWRD		/PICK UP WORD COUNT
WCCALL,	DCA	WRDCNT		/AND SAVE FOR NEXT LINE
	JMP	NXTWRD
LPFORM,	DCA	WRDCNT
	JMS	GETWRD
	JMP	LPTOUT		/IF WC = 0001, FOLLOWING WORD IS A SINGLE ASCII CHAR
GETBLK,	0
	TAD	(GLPTLO-1
	JMS I	GSPLDV		/CALL THE HANDLER
	TAD	GLPTLO
	CLL
	TAD	L0400
	DCA	GLPTLO
	SNL			/NEW SEGMENT?
	JMP	NOTSEG		/NOPE
	CALL	(LPRELS		/RELEASE THE SEG WE JUST PRINTED
	TAD I	(LPTBUF+377	/IF YES, PICK UP SEGMENT LINK
	DCA	GLPTHI		/AND SAVE AS SEG #
	AC0001
NOTSEG,	TAD	L7400
	DCA	PERBLK		/ALL BLOCKS IN SEG HAVE 400 WORDS, EXCEPT THE LAST ONE
	TAD I	(QUETBL+7	/HOW DID THE I/O WORK OUT?
	SMA CLA
	JMP	SETLPB		/OK, PROCEED NORMALLY
SPLKIL,	TAD	(WCCALL		/OOO, BAD. PREPARE PHONEY RETURN
	DCA	GETBLK
	DCA	GLPTLO		/GET RID OF BAD SEGMENT
	TAD	(LPTMSG-LPTBUF	/WITH PHONEY MESSAGE (INCL EOF)
SETLPB,	TAD	(LPTBUF
	DCA	LPWDPT
	JMP I	GETBLK

GLPTLO,	0			/KEEP
GLPTCT,	0			/THESE
	LPTBUF			/FOUR
GLPTHI,	0			/TOGETHER!
WRDCNT,	0			/THE RECORD WORD COUNT OF RECORD WE'RE PRINTING
PERBLK,	0			/COUNTER FOR WORDS LEFT IN BUFFER BLOCK
LPWDPT,	0			/POINTER INTO THE BLOCK TO GET THE WORDS
GSPLDV,	0			/ADDR OF DEVICE HANDLER FOR $LPTSP FILE
LPSTRT,	0			/STARTING SEGMENT # OF $LPTSP LOGICAL UNIT
LPQGET,	LPTQ-1
LPQCNT,	0
CTNLST,	-115		/ M=0
	-112		/ J=1
	-113		/ K=2
	-114		/ L=3
	-125		/ U=4
	-111		/ I=5
	-117		/ O=6
	0
/
	PAGE

	LPQSIZ=	20		/MUST BE POWER OF 2 !!!
LPTQ,	ZBLOCK LPQSIZ			/WHERE PRINT REQUESTS GO
	IFNZRO LPQSIZ^2-1&LPTQ <???>	/ERROR! LPTQ MUST BE ON BOUNDARY 2*LPQSIZ
LPOCHR,	0
	AND	(377		/SELF-PRESERVATION
	DCA I	LPPUTP		/PUT THE CHAR IN THE BUFFER
	AC0001
	LIE
	TAD	LPCHCT
	TAD	LPSIZE		/SEE IF MORE ROOM IN RING BUFFER
	SZA CLA
	JMP	LPOK		/THERE IS, SO KEEP GOING
	TAD	LPTBIT		/IF NOT,
	PUSHJ			/GO AWAY UNTIL THERE IS
	SLEEP
LPOK,	CIF 0			/"IOF" IN DISGUISE
	AC7777 CLL
	TAD	LPCHCT
	DCA	LPCHCT
	TAD I	LPPUTP
	SNL			/FIRST CHAR?
	LLS			/IF SO, GOAD THE LPT INTO ACTION
	SZL CLA
	ISZ	LPPUTP		/AND IF NOT, SHOW WE PUT IT IN THE BUFFER
	TAD I	LPPUTP
	SPA			/DO THE WRAP-AROUND FOR THE RING BUFFER
	DCA	LPPUTP
	CLA
	JMP I	LPOCHR
LPPUTP,	LPRING+1
LPGETP,	LPRING
LPCHCT,	0
LPSIZE,	376

/LPT INTERRUPT SERVICE
LPTSRV,	LCF
	TAD	LPCHCT		/SEE IF INTERRUPT IS OF SIGNIFICANCE
	SMA CLA
	L1DIS			/??? WE CAN IGNORE THAT ONE
	ISZ	LPCHCT
	JMP	LPMORE
	TAD I	(LPQCNT
	SZA CLA			/SEE IF MORE REQUESTS PENDING
	JMP	LPCLR		/IF SO, KEEP DOING THE THING
	TAD	NJOBS		/IF NOT, SEE IF ANY OTHER JOBS ACTIVE
	SNA CLA
	JMP I	(REBOOT		/IF NO OTHER JOBS, AND NO LPT REQUESTS, GO AWAY
	L1DIS			/GO PROCESS OTHER JOBS
LPCLR,	TAD	LPTBIT		/IF BUFFER WENT EMPTY,
	CMA			/"THIS WILL ALWAYS WORK." - E.S.
	AND I	(LPTJOB		/WAKE UP JOB 7
	DCA I	(LPTJOB		/SO IT CAN FILL THE BUFFER AGAIN
	L1DIS			/ALSO IF LPCHCT GOES TO 0
LPMORE,	ISZ	LPGETP
	TAD I	LPGETP		/GET CHAR - MAYBE
	SPA			/IT MAY BE WRAP-AROUND POINTER
	DCA	LPGETP
	SNA			/SAVE TWO CYCLES (SGW)
	TAD I	LPGETP		/GET CHAR FOR SURE THIS TIME
	LLS
	CLA
	LSF			/CHECK FOR INSTANT INTERRUPT
	L1DIS			/NOPE - GO AWAY
	JMP	LPTSRV		/KEEP THROWING THEM OUT
BITMAP,	377		/ARBITRARY # OF 377'S
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	377;377;377
	MAXU2=	.-BITMAP^10	/COMPUTE # OF SEGMENTS BITMAP CAN HANDLE
	4000		/AND END WITH 4000
/TABLE OF STARTING SEGMENT #S FOR EACH JOB'S CURRENT $LPTSP FILE
LPFILE,	ZBLOCK	JOBMAX
/
	PAGE

/CDQLPT FILLS IN THINGS POINTED TO BY CDQPT1-CDQPT5
/OF INTEREST TO US IS THE BYTE COUNT.  CDQ WILL CONVERT 7776
/TO 7773 = 7774-1, ETC.  ALSO, A WORD COUNT OF 0000 COMES OUT AS
/A BYTE COUNT OF -1, AND A WORD COUNT OF +1 COMES OUT AS A BYTE
/COUNT OF +1.  THEN CDQLPT CONVERTS NEGATIVE BYTE COUNTS BACK TO
/WORD COUNTS AND CONVERTS +1'S TO -2'S BECAUSE A "FORMS" STATEMENT
/OUTPUTS A WC OF +1 FOLLOWED BY A SINGLE ASCII CHARACTER.
/TRUST IN ME, HAVE FAITH, AND WATCH THE WORLD COME UNGLUED.
CDQLPT,	DCA I	CDQSTS		/CLEAR ANY ERROR BITS
	CDF 10
	TAD I	(LPTHI		/SEE IF WE'VE LOOKED UP A STARTING SEG YET
	SNA
	TAD I	(LPTLO		/IF EITHER OF THESE IS NON-0, IT'S NOT THE FIRST
	CDF 0
	SZA CLA
	JMP	NTFRST		/SURE HAVE - NO NEED TO DIDDLE LPFILE TABLE
	JMS I	(GETSEG
	CDF 10
	DCA I	(LPTHI
/	TAD	L0400		/SKIP FIRST BLOCK OF LOGICAL UNIT
	DCA I	(LPTLO
/	TAD	L0400
	DCA I	(SEGSUM		/FIX VERY ELUSIVE BUGS
	TAD	L7400
	DCA I	(CHRPTR		/SET OUTPUT BLOCK EMPTY
	TAD	JOB
	TAD	(LPFILE
	DCA	LPQT2
	TAD I	(LPTHI
	CDF 0
	DCA I	LPQT2		/PUT STARTING SEG OF THIS JOB'S $LPTSP FILE IN THE TABLE
NTFRST,	DCA	UMODE		/*** PERMIT SHARING OF L2 STUFF
	TAD	JOB
	CALL	(QPTRST		/SET UP CDQPT1-CDQPT5 FOR CURRENT JOB
	TAD I	CDQPT1		/GET THIS MAGIC BYTE COUNT
	SMA			/SPECIAL HACK NECESSARY?
	CLL CMA RAL		/YES - CONVERT +1 TO -4, 0 TO -2
	CLL CML RAR		/THEN DIVIDE BY 2
	DCA I	CDQPT1		/THIS IS # OF WORDS TO MOVE NOW
	TAD I	CDQPT1
	CLL CIA
	CDF 10
	TAD I	(SEGSUM		/BEFORE WE DO IT, SEE IF WE FIT IN SEGMENT
	CDF 0
	SZL CLA			/SKIP IF WE DO
	JMS I	(CHKBIT		/IF NOT, SEE IF WE CAN GET ANOTHER WHEN WE NEED TO
	CLA			/WE RETURN IF WE CAN WITH SOMETHING IN AC
LPTCHR,	TAD I	CDQPT2		/GET CDF OF RECORD
	DCA	LPTRCD
	AC7777
	TAD I	CDQPT4		/GET RECORD PTR
	DCA	LPQT
LPQT3,
LPTRCD,	0			/RECORD CDF
	TAD I	LPQT		/GET A WORD OF THE RECORD
	CDF 0
	DCA I	CDQPT5		/SAVE IT TEMPORARILY WHILE WE
	ISZ I	CDQPT4		/BUMP THE RECORD POINTER AND
	JMP	REPUT
	TAD	LPTRCD
	TAD	L0010
	DCA I	CDQPT2
REPUT,	CDF 10
	ISZ I	(SEGSUM		/SEE IF MORE SPACE IN SEGMENT
	SKP
	JMP	NEWSEG		/NOPE - ALLOCATE ANOTHER
	TAD I	(CHRPTR
	SNA CLA			/MORE SPACE IN THIS BLOCK?
	JMP	NEWBLK		/NOPE - WRITE IT OUT
REPUT2,	TAD I	(CHRPTR
	TAD	L0400		/MAKE THE COUNT THE OFFSET
	TAD I	(LPTADR		/FROM THE START OF THE BUFFER
	DCA	LPQT
	ISZ I	(CHRPTR
CQL377,	377
	CDF 0
	TAD I	CDQPT5		/GET WORD OF RECORD BACK AGAIN
	JMS	LPBCDF		/CDF USER'S BUFFER
	DCA I	LPQT
	CDF 0
	ISZ I	CDQPT1		/MORE WORDS IN RECORD?
	JMP	LPTCHR		/YUP - KEEP MOVING THEM OVER
	ISZ	UMODE		/RESTORE TIMESHARING
	POPJ

NEWSEG,	JMS I	(GETSEG		/BECAUSE OF CODE BEFORE LPTCHR, THIS WILL ALWAYS SUCCEED
	DCA	LPQT2		/SAVE THE VALUE FOR THE LINK
	CDF 10
	TAD	CQL377		/THE LINK GOES IN THE LAST WORD OF THE BUFFER
	TAD I	(LPTADR
	DCA	LPQT
	TAD	LPQT2		/GET THE VALUE FOR THE LINK
	JMS	LPBCDF
	DCA I	LPQT		/AND PUT IT IN THE BUFFER
	CDF 10
NEWBLK,	TAD	L7400		/COME HERE WITH DF = 10
	DCA I	(CHRPTR		/RESET THE COUNTER-OFFSET
CDLCDF,	CDF 0
	ISZ	UMODE		/LET OTHER PEOPLE RUN WHILE WE'RE AWAY
	TAD	LPQT2
	PUSHAC			/WE MAY SWAP!
	CIF CDF 10
	JMP I	(LPKLUG		/IS THIS EVER SICKENING
LPUNKL,	POPAC
	DCA	LPQT2
	DCA	UMODE		/ME FIRST! ME FIRST!
	TAD	JOB
	CALL	(QPTRST		/RESET POINTERS, AS WE MAY HAVE SWAPPED
	TAD	L0400		/RETURN LINK = 0
	CDF 10
	TAD I	(LPTLO
	DCA I	(LPTLO		/BUMP LOW BLOCK #
	SNL			/DID WE OVERFLOW A SEGMENT?
	JMP	REPUT2		/NOT YET
	TAD	LPQT2
	DCA I	(LPTHI
	JMP	REPUT
LPBCDF,	0			/CHANGE TO DATA FIELD OF USER'S LPT BUFFER
	DCA	LPQT3
	CDF 10
	TAD I	(LPTCTL
	AND	L70
	TAD	CDLCDF
	DCA	.+1
	0
	TAD	LPQT3
	JMP I	LPBCDF
LPQT,	0
LPQT2,	0

/
	PAGE

/ERROR MESSAGES IN PACKED -237 ASCII
/PRECEDED BY THE LENGTH OF THE MESSAGE
EOFMSG,	-6		/BAD PROGRAM
	4342;4501;6163
	6050;6342;5600
PDLMSG,	-11		/PUSHDOWN OVERFLOW
	6166;6451;4560
	7057;0160;6746
	6347;5560;7000
DKEMSG,	-5		/DISK ERROR
	4552;6454;0146
	6363;6063
RETMSG,	-12		/RETURN WITHOUT CALL
	6346;6566;6357
	0170;5265;5160
	6665;0144;4255
	5500
D0MSG,	-6		/ZERO DIVISOR
	7346;6360;0145
	5267;5264;6063

SSMSG,	-11		/SUBSCRIPT TOO BIG
	6466;4364;4463
	5261;6501;6560
	6001;4352;5000
SYSMSG,	-4		/NO FILE
	5760;0147;5255
	4600
P2MSG,	-11		/ILLEGAL SUBSTRING
	5255;5546;5042
	5501;6466;4364
	6563;5257;5000
LTLMSG,	-7		/LINE TOO LONG
	5552;5746;0165
	6060;0155;6057
	5000
A2DMSG,	-5		/BAD DIGIT
	4342;4501;4552
	5052;6500

INIMSG,	-14		/DIBOL FILE NUMBER IN USE
	4552;4360;5501
	4752;5546;0157
	6656;4346;6301
	5257;0166;6446
BUFMSG,	-10		/NO BUFFERS LEFT
	5760;0143;6647
	4746;6364;0155
	4647;6500
XMIMSG,	-16		/DIBOL FILE NUMBER NOT INITED
	4552;4360;5501
	4752;5546;0157
	6656;4346;6301
	5760;6501;5257
	5265;4645
NUMMSG,	-10		/NUMBER TOO LONG
	5766;5643;4663
	0165;6060;0155
	6057;5000

BR0MSG,	-15		/END OF FILE OR LOCK ERROR
	4657;4501;6047
	0147;5255;4601
	6063;0155;6044
	5401;4663;6360
	6300
RAMSG,	-7	/ILLEGAL DEVICE
	5255;5546;5042
	5501;4546;6752
	4446
RECMSG,	-7	/ILLEGAL RECORD
	5255;5546;5042
	5501;6346;4460
	6345
CDINMS,	-7	/DEVICE IN USE
	4546;6742;4446
	0152;5701;6664
	4600
NOIMSG,	-6	/NO INIT DONE
	5760;0152;5752
	6501;4560;5746
LOKMSG,	-7		/TOO MANY LOCKS
	6560;6001;5642
	5772;0155;6044
	5464

BADMSG,	-7	/SEQ. # TOO BIG
	6446;6217;0104
	0165;6060;0143
	5250
FINMSG,	-11	/FINI ERROR ON LPT
	4752;5752;0146
	6363;6063;0160
	5701;5561;6500
FRMMSG,	-6	/FORMS ERROR
	4760;6356;6401
	4663;6360;6300
PSHMSG,	-7	/STACK OVERFLOW
	6465;4244;5401
	6067;4663;4755
	6070

LPTMSG,	0001;0215	/SPECIAL WEIRD MESSAGE FOR DYING LPT JOB
	0001;0212
	-16	/* * * FATAL DISK ERROR * * *
	1301;1301;1301
	4742;6542;5501
	4552;6454;0146
	6363;6063;0113
	0113;0113
	0001;0215
	0001;0212
	0001;0214		/GIVE A BIG SENDOFF
	0000		/DUMMY EOF
	TXTEND=.
	IFZERO TXTEND+4&4000 <^^^ FIELD OVERFLOW ^^^>

	FIELD 2
/ END SECTION 4 LISTING CONTROL
	IFNZRO LIST&20 <XLIST>
////////////////////////////////
/			       /
/	END OF MULTI4.PA       /
/			       /
////////////////////////////////

////////////////////////////
/			   /
/	END OF MULTI       /
/			   /
////////////////////////////
	$-$-$