/ROUTINE TO HANDLE EASY DECTAPE STUFF
/LIKE DTSF AND DTRB
/DTSF ALWAYS SKIPS

UDTRBS,	ISZ	L2SV0		/BUMP HIS PC
PTRACA,	L2SA			/TRICKY, TRICKY
UDTRB,	GETJTW			/GET LAST VALUE OF STATUS B
	JOBSTB
	DCA	L2SA		/GIVE IT TO USER
	UUOEXT

C4000,	4000
MCSCQ,	-4044			/COVERS BOTH ^Q AND ^S

CONSQ,	0
	ISZ	CONDBA		/POINT TO OUTPUT SIDE IN DEVTBL
	TAD	TTCHAR
	CLL RTR
	TAD	MCSCQ		/CHECK FOR ^Q AND ^S
	SZA CLA
	JMP I	CONSQ		/NEITHER
	TAD I	CONDBA
	SNA
	JMP I	CONSQ		/DOESN'T HAVE AN OUTPUT DDB - SO ^S/^Q MEANS NOTHING
	DCA	WS2		/ADDRESS OF OUTPUT DDB
	TAD I	WS2
	AND	C3777		/CLEAR THE BIT FIRST
	SNL			/NOW WHICH WAS IT?
	TAD	C4000		/^S - SET THE BIT TO INHIBIT HIS/HER TTY FROM PRINTING
	DCA I	WS2		/SAVE UPDATED STATUS
	SZL			/WHICH WAS IT AGAIN?
	JMS	TYPE		/^Q - START HIM/HER TYPING IF [S]HE HAS ANYTHING TO TYPE
	JMP I	.+1		/TAKE SUCCESSFUL EXIT THROUGH "KEY"
	KBDXIT
/MULTI-FIELD ROUTINE TO OUTPUT TO A TTY, PTP, OR LPT
/CALL:	CONDBA CONTAINS POINTER TO POSITION IN DEVTBL
/	TTCHAR CONTAINS CHARACTER TO BE OUTPUT
/	PRINT
/	NO ROOM IN OUTPUT BUFFER
/	OK

PRINT0,	0
	RDF
	TAD	C6203
	DCA	PRINTX		/REMEMBER FROM WHENCE WE CAME
	DCA	EMPTY		/CLEAR EMPTY BUFFER INDICATOR
PRINT1,	DATFLD
	TAD I	CONDBA		/GET ADDRESS OF DDB
	SNA
	JMP	PRINT2
	STORE			/STASH THE CHARACTER IN HIS BUFFER
	OUTSIZ			/ADDRESS OF SIZE CHECK ROUTINE FOR OUTPUT
	JMP	PRINTX		/WOULDN'T FIT
	ISZ	PRINT0		/OK - SKIP ON RETURN
	TAD	EMPTY		/WAS THE BUFFER EMPTY?
	SZA CLA
	JMS	TYPE		/YES - BETTER START THE HARDWARE
PRINTX,	.-.			/FIELD SELECT
	JMP I	PRINT0		/AND BACK
PRINT2,	TAD	CONDBA		/NO BUFFER SETUP YET
	CDF
	GETBLK			/CREATE A PSEUDO DDB
	JMP	PRINTX		/NO BLOCKS AVAILABLE
	JMP	PRINT1
TTOFLB,	TTOFLG

CORSR4,
TYPE,	0
	TAD	CONDBA		/DEVTBL POINTER
	TAD	OUTOFF		/MINUS DIF.
	CLL RAR			/DIVIDE BY 2
	DCA	OUTSIZ		/ = OUTREG POINTER
	CIF			/NO INTERRUPTS
	TAD I	OUTSIZ
	AND	C4001
	SZA CLA			/CHECK SERVICE AND CHARACTER FLAGS
	JMP I	TYPE		/CHARACTER WILL BE TAKEN BY AN INTERRUPT
	STL RAR
	TAD I	OUTSIZ		/SET THE SERVICE FLAG
	DCA I	OUTSIZ
	CDF
	DCA I	TTOFLB		/SCHEDULE LEVEL 2 TO PRINT IT
	JMP I	TYPE
CORSR2,
OUTSIZ,	0
	DCA	TYPE		/SAVE POINTER TO CHARACTER COUNT
	TAD I	TYPE		/CURRENT COUNT
	SPA			/DOES IT INCLUDE A FILLER CHARACTER COUNT
	AND	C0377		/YES - DISREGARD IT
	DCA	TYPE		/THE ACTUAL COUNT TO COMPARE WITH
	TAD	PRINTX
	AND	C0070
	SZA CLA
	JMP	OUTSI1		/CALLED FROM SI
	TAD	CONDBA
	CLL
	TAD	LPTSIZ		/ALLOW LINE PRINTER BUFFER TO GOBBLE UP ABOUT 40% OF FREE CORE
	AND	FRECNT
	AND	C0400		/DON'T LOOK AT TOO MUCH FREE CORE
	SNA
	TAD	FRECNT
	SZL
	CLL RTL			/THE LINE PRINTER GETS 4 TIMES AS MUCH
	CIA
OUTSI2,	TAD	TYPE		/CURRENT COUNT
	TAD	OUTLIM
	SPA CLA
	ISZ	OUTSIZ		/STILL ROOM
	JMP I	OUTSIZ
OUTSI1,	TAD	C7366
	JMP	OUTSI2

C4001,	4001
C7366,	7366
OUTLIM,	25
LPTSIZ,	-DEVTBE-3
OUTOFF,	-OUTDIF
/SEARCH FOR JOB IN CORE
/CALL	TAD JOB #
/	JMS CORSRC
/	MASK
/	NOT THERE, AC:=0
/	THERE, SAVE FIELD IN AC


/THESE TWO WORDS MUST IMMEDIATELY PRECEDE CORSRC
/THEY MUST ALSO BE ORIGINED AT CORSRC-2
*CORSRC-2

CORCNT,	0			/INIT TO -NUMBER OF USER FIELDS
CORTBE,	0			/INIT TO -((END OF CORTBL)+1)

CORSRC,	0			/ENTER WITH BIT PATTERN TO MATCH
	AND I	CORSRC		/MASK AS SPECIFIED
	CIA
	DCA	CORSR4		/-WHAT WE WANT
	RDF			/FIGURE OUT WHENCE WE CAME
	TAD	C6203
	DCA	CORSR3		/SO WE CAN RETURN
	TAD I	CORSRC		/GET THE MASK
	DCA	CORSR2		/SAVE IT
	ISZ	CORSRC		/SKIP PAST MASK IN CALL
	CDF
	TAD	CORCNT		/-# ENTRIES TO CHECK
	DCA	AXS1		/USED AS COUNTER
CORSR1,	ISZ	CORTBP		/INCREMENT TABLE POINTER
	TAD	CORTBP		/ARE WE AT END OF TABLE?
	TAD	CORTBE
	SPA CLA
	JMP	CORSR5		/NO
	STL RTL
	TAD	CORTBA		/YES, START ALL OVER AT FIELD 2
	DCA	CORTBP
CORSR5,	TAD I	CORTBP		/GET TABLE ENTRY
	AND	CORSR2		/MASK IT
	TAD	CORSR4		/COMPARE WITH DESIRED ENTRY
	SNA CLA
	JMP	CORSR6		/FOUND IT!
	ISZ	AXS1		/NOT YET
	JMP	CORSR1		/KEEP GOING
CORSR3,	0			/RETURN WITH AC=0
	JMP I	CORSRC
CORSR6,	TAD	CORTBA		/WE HAVE IT; GET CORTBL INDEX
	CIA
	TAD	CORTBP
	DCA	AXS1		/FIELD #
	TAD	CORSR4		/WE HAVE TO SET MODE BIT APPROPRIATELY
	CIA			/RECOMPLEMENT CALLING JOB #
	AND	C0600		/A PHANTOM?
	SNA CLA			/EXEC MODE?
	TAD	C0010		/NO - SET USER MODE BIT
	TAD	AXS1		/SET UP SAVE FIELD
	CLL RTL			/SHIFT AND ADD DATA FIELD
	RAL
	TAD	AXS1
	ISZ	CORSRC		/SKIP TO INDICATE SUCCESS
	JMP	CORSR3		/BACK
CORTBP,	CORTBL+1		/ "ROUND-ROBIN" POINTER

/WHEN THE USER EXECUTES A "SEA" IOT,
/WE MUST DO TWO THINGS:
/	1) SET THE ERROR ENABLE BIT IN STR0
/	2) SAVE THE USER'S AC IN THE JOB DATA AREA
/		JSEREN IS SET HERE
/	WE GO TO USEA1 TO SAVE THE ERROR ADDRESS
/JSEREN MAY BE CLEARED BY .RUN, START, OR
/A USER EXECUTING A "CLEAR STATUS" IOT.

USEA,	DATFLD			/SET JSEREN WHEN USER EXECUTES SEA
	TAD I	CJOBDA		/POINTS TO WORD 0 OF JOB DATA AREA
	IAC			/POINTS TO STR0
	IOR			/OR IN JSEREN
	JSEREN
	CDF
	JMP I	.+1
	USEA1			/GO PICK UP ERROR ADDRESS

/GET A BUFFER FROM FREE LIST
/CALL	TAD (ADDRESS TO STORE LINK)
/	GETBLK
/	NONE AVAILABLE
/	OK WITH LINK STORED

GETB,
GETDB2,	0
	DCA	GETBT		/SAVE ADDRESS TO SAVE PTR
	RDF			/SAVE CALLING FIELD
	TAD	C6203
	DCA	GETB1		/SO WE CAN GET BACK
	DATFLD
	TAD	FREE		/ANY BUFFERS LEFT?
	SNA
	JMP	GETB1		/NONE LEFT
	DCA I	GETBT		/STORE LINK IN ADDRESS SPECIFIED
	STA			/NOW WE'LL BE GOOD GUYS
	TAD	FREE		/AND PREPARE TO CLEAR THE BUFFER
	DCA	AXS1
	TAD I	FREE		/REMOVE FROM FREE LIST
	DCA	FREE		/SET NEW POINTER TO FREE LIST
	ISZ	GETB		/INDICATES SUCCESS
	STA			/DECREMENT FREE COUNT
	TAD	FRECNT
	DCA	FRECNT
	TAD	C7770		/8 WORDS TO ZERO
	DCA	GETBT
	DCA I	AXS1
	ISZ	GETBT		/DONE?
	JMP	.-2		/NO
GETB1,	0			/RETURN
	JMP I	GETB

USTM,	TAD	L2SA		/GET UNITS OF TIME IN AC
	DCA	USTM1		/SAVE IT
	DCA	L2SA		/ZERO USER'S AC
	TAD	USTM1
	SNA			/ANY TIME SPECIFIED?
	UUOEXT			/NO, SO DON'T SLEEP
	JMP I	USTM2		/YES, GO PUT TO SLEEP
USTM2,	DOUSTM
/GET A DATA BLOCK
/CALL	TAD LINK
/	GETDDB
/	NONE AVAILABLE
/	OK


GETDB0,
DEVWT0,	0
	DCA	GETDB1		/ADDRESS OF DDB POINTER (USUALLY IN DEVTBL)
	RDF
	TAD	C6203
	DCA	GETDB5		/SAVE CALLING FIELD SO WE CAN GET OUT
	CDF
	TAD	GETDB1		/GET A BUFFER FROM FREE CORE
	GETBLK
	JMP	GETDB5		/SORRY
	DATFLD
	ISZ	GETDB0		/SUCCESSFUL RETURN
	TAD I	GETDB1
	TAD	C0003
	DCA	GETDB1		/SAVE IT
	TAD	CLK1		/GET LOW ORDER CLOCK
	RTL			/AND SHIFT BITS 0-2 INTO AC 9-11
	RTL
	AND	C0007		/GET MOST SIGNIFICANT BITS FROM LOW ORDER
	DCA	GETDB2		/SAVE THEM
	TAD	CLK2		/GET HIGH ORDER TIME
	RTL			/SHIFT LEFT 3 PLACES
	RAL
	AND	C7770		/KEEP BITS 0-8
	TAD	GETDB2		/ADD COMPONENT DERIVED FROM CLK1
	DCA I	GETDB1		/SAVE IN DDB
GETDB5,	0			/RETURN
	JMP I	GETDB0



CTIMER,	-5
TIMCOA,	TIMCON
CONJMS,	JMSTIM
TTIMEB,	TTIMER
L2OUT,	TAD	CTIMER		/AC=-5
	DCA I	TIMCOA		/RESET THE OUTPUT MASTER TIMER
	TAD	CONJMS
	DCA I	TTIMEB		/PLACE THE TIMER "HOOK" IN CONOUT
	DCA I	TTOFLC		/SCHEDULE CONOUT FOR LEVEL 2
/BEFORE DISMISSING BACK TO USER JOB, IT IS A GOOD IDEA TO CHECK AND SEE IF ANY OTHER
/LEVEL 2 PROCESSING HAS BEEN SCHEDULED WHILE WE WERE WORKING ON THE LAST REQUEST
/WE CAN ASCERTAIN IF THIS IS THE CASE BY COMPARING THE L2QUE EMPTY AND
/FILL POINTERS -- IF THEY ARE EQUAL, THEN WE'RE DONE, AND CAN GO TO L2EX1,
/WHERE BOTH POINTERS ARE RESET.	IF UNEQUAL, WE GET THE NEXT ENTRY POINTED
/TO BY L2QE, AND DISPATCH TO IT LEAVE LEVEL 2

L2EXIT,	CDF
	IOF			/NO INTERRUPTS WHILE CHECKING L2QUE STATUS
	CLA
	TAD I	L2KEY
	SZA CLA
	JMP I	CONINP		/KEYBOARDS NEED SERVICE - TAKE CARE OF THEM FIRST
L2EX0,	TAD	L2Q		/ARE FILL AND EMPTY POINTERS EQUAL?
	CIA
	TAD	L2QE		/-FILL PTR + EMPTY PTR
	SNA CLA
	JMP	L2EX1		/YES - WE ARE CAUGHT UP
	TAD I	L2QE		/NO; GET ADDRESS FROM L2QUE
	DCA	JOBSWA
	ION			/INTERRUPT BACK ON
	JMP I	JOBSWA		/DISPATCH

L2EX1,	TAD	L2QTA
	DCA	L2QE
	TAD	L2QTA
	DCA	L2Q		/RESET FILL POINTER
	TAD I	TTOFLC
	SNA CLA
	JMP I	CONOUA		/PRINTERS NEED SERVICE
	TAD	L2SFA
	JMP I	.+1		/NOW BACK TO WORK
	RESTOR

TTOFLC,	TTOFLG
CONOUA,	CONOUT
L2QTA,	L2QTB-1
L2KEY,	KEYC
CONINP,	CONIN
L2SFA,	L2SF
KBDJOA,	DEVJOB
GETDB1,
CLST0,
KBDDLM,	0			/ROUTINE TO SET DELIMITER FLAG IN STR1
	TAD	CONDDB
	JMS I	KBDJOA		/GET JOB #
	DCA	BONUS		/GIVE HIM/HER HIGHEST SCHEDULER PRIORITY
	TAD	C0100		/JSDEL
	JMS I	SETFLG		/SET HIS/HER DELIMITER BIT
	JMP I	KBDDLM		/AND BACK

GETBT,
USTM1,
CLSTR1,	0			/ROUTINE TO CLEAR BITS IN STR1
	CMA			/ENTER WITH BITS TO CLEAR IN AC
	DCA	CLST0		/SAVE MASK OF BITS TO SAVE
	CDF
	GETJTW			/GET CURRENT SETTING OF STR1
	JOBSTS+1
	AND	CLST0		/CLEAR SELECTED BITS
	DATFLD
	DCA I	JOBSWA		/SAVE CLEARED STATUS REGISTER
	JMP I	CLSTR1		/RETURN

URK050,	TAD	C0005
UDTXA0,	TAD	C0002
	CLL RAR
	CIF DATFLD-1		/FIELD 1 DTA UUO SERVICE
	JMP I	.+1
	UUDTRK
*FISUBL+1202
/BLOCK TRANSFER
/CALL	BLT
/	62S1	SELECT SOURCE DATA FIELD
/	SOURCE
/	62D1	SELECT DESTINATION DATA FIELD
/	DESTINATION
/	-NUMBER WORDS
/	RETURN
BLT0,
RUNTDB,	0
	TAD I	BLT0		/GET SOURCE FIELD SELECT
	DCA	BLT1		/SAVE
	ISZ	BLT0		/POINTS TO SOURCE ADDRESS
	STA
	TAD I	BLT0		/CORE ADDRESS -1 OF SOURCE
	DCA	AXS1		/AUTO INDEX
	ISZ	BLT0		/POINTS TO DESTINATION FIELD SELECT
	TAD I	BLT0		/GET DESTINATION SELECT
	DCA	BLT2		/SAVE
	ISZ	BLT0		/POINTS TO DEST. ADD
	STA
	TAD I	BLT0		/DEST. ADD-1
	DCA	AXS2		/AUTO INDEX
	ISZ	BLT0		/POINTS TO -WORD COUNT
	TAD I	BLT0
	DCA	BLTC		/SAVE
	ISZ	BLT0		/RETURN ADDRESS
	RDF
	TAD	C6203
	DCA	BLTF		/SAVE RETURN FIELD SELECT
BLT1,	0			/SELECT SOURCE DATA FIELD
	TAD I	AXS1
BLT2,	0			/SELECT DESTINATION DATA FIELD
	DCA I	AXS2
	ISZ	BLTC		/DONE?
	JMP	BLT1		/NO
BLTF,	0			/RETURN
	JMP I	BLT0

/TEST JOB FOR RUNNABILITY
/CALL	TAD JOB #
/	RUNABL
/	NOT RUNNABLE
/	RUNNABLE

BLTC,
RUNTST,	0			/COME HERE WITH JOB # IN AC
	TAD	JOBTBA		/TO GET JOBTABLE ADDRESS
	GETJTI			/GET STR0
	JOBSTS
	SMA			/RUN BIT ON?
	JMP	RUNTS3		/NO
	DATFLD			/YES, SEE IF IT RAN AS A COMPUTE BOUND JOB LAST TIME
	AND	C1000		/IS BIT 1000 ON SHOWING THAT IT WAS A COMPUTE BOUND JOB?
	SNA			/SNA
	JMP	RUNTS2		/NO, IT MAY BE READY TO RUN - TEST FURTHER
	CMA			/LAST TIME IT WAS COMPUTE BOUND, SKIP THIS TURN
	AND I	JOBSWA		/CLEAR THE BIT 1000, SO THAT IT WILL RUN NEXT TIME
	DCA I	JOBSWA
	JMP	RUNTS1		/RETURN BY NOT RUNNABLE EXIT
RUNTS2,	ISZ	JOBSWA		/GET THE ADDRESS OF STR1
	TAD I	JOBSWA
	ISZ	JOBSWA
	ISZ	JOBSWA		/POINT TO WAIT MASK 1
	AND I	JOBSWA		/ANY STR1-MASK1 MATCHES?
	SZA CLA
	ISZ	RUNTST		/YES
RUNTS1,	CDF			/NO
	JMP I	RUNTST
RUNTS3,	AND	RC0147
	SNA			/FIP REQUEST STILL PENDING? OR ANY ERRORS SINCE HE STOPPED?
	JMP I	RUNTST		/NONE
	AND	C0007		/IS IT FOR FIP OR SI?
	SNA CLA
	JMP	RUNTS1-1	/FIP - LET HIM FINISH UP SO WE DON'T LOSE A FREE CORE BLOCK
	DATFLD
	CLL CMA RTR
	AND I	JOBSWA		/CLEAR HIS ERROR ENABLE
	DCA I	JOBSWA
	JMP	RUNTS1-1	/ERROR - LET SI REPORT IT NOW

RC0147,	JSIOT JSIOTC UUOERF SWPRER SWPWER DSKERR HUNGDV
SIWAIT,	0


L2SI,	TAD	SIWAIT		/NUMBER OF SI COMMANDS IN "WAIT"
	TAD	COMCNT		/PLUS NEW COMMANDS
	DCA	COMCNT		/NOW THEY'RE ALL BACK ON-LINE
	DCA	SIWAIT		/NONE NOW IN WAIT STATE
	EXIT
/SET SYSTEM ERROR CODE
/CALL	TAD JOB #
/	JMS SYSERR
/	ERROR CODE
/	NORMAL RETURN


SYSERR,	0
	AND	C0037		/JOB # ONLY
	SNA			/IS IT JOB 0?
	JMP	SYSER1-1	/YES, RETURN
	TAD	JOBTBA		/POINTER TO JOBTBL
	GETJTI			/GET CURRENT VALUE OF STR0
	JOBSTS
	AND	C0007		/EXTRACT ANY ERROR CODE IN THERE
	SZA CLA			/ANY OLD BITS?
	JMP	SYSER1		/YES; DON'T CONFUSE THE ISSUE
	TAD I	SYSERR		/GET THE ERROR CODE SUPPLIED
	DATFLD
	TAD I	JOBSWA		/ADD IT TO OLD VALUE OF STR0
	DCA I	JOBSWA		/SAVE THE WHOLE MESS
	ISZ	JOBSWA
	TAD	JOBSWA		/POINTS TO STR1
	IOR			/SET THE "ERROR HAS OCCURRED" BIT IN STR1
	JSERR
	CDF
SYSER1,	ISZ	SYSERR		/SKIP ARGUMENT IN CALL
	JMP I	SYSERR		/RETURN
/SKIP IF DISK NOT ACTIVE
/CALL	TAD FIELD #
/	JMS DSKACT
/	ACTIVE
/	NOT ACTIVE

DSUSTA,
DAUTBL,	DSUTBL-1

DSKACT,	0
	CLL RTL			/FIELD # *4 IS MAJOR INDEX IN DSUTBL
	TAD	DAUTBL		/START OF TABLE -1
	DCA	AXS1		/AUTO INDEX
	DATFLD
	TAD I	AXS1		/FILE 1 BUSY?
	TAD I	AXS1		/ "	2	"
	TAD I	AXS1		/ "	3	"
	TAD I	AXS1		/ "	4	"
	CDF
	SNA CLA			/IF ANY ONE WAS BUSY, AC.NE.0
	ISZ	DSKACT		/NO ACTIVITY; INDEX RETURN
	JMP I	DSKACT		/AND OFF
/START USER DISC REQUEST FROM QUEUE
/IF THIS ROUTINE IS CALLED, THERE HAD
/BETTER BE SOMETHING IN SQREQ OR DSUTBL
/FOR IT TO FIND. IT WON'T STOP LOOKING!
/CALL	JMS DSUSER
/	RETURN

DSUSER,	0
	TAD	SQREQ		/IS A SWAP REQUESTED?
	SZA CLA
	JMP	DSUSR5		/YES, DO IT FIRST
	DATFLD
DSUSR4,	TAD I	DSKPTR		/GET ENTRY FROM DSUTBL
	SNA			/IS IT A REQUEST?
	JMP	DSUSR4		/NO - CHECK NEXT POSITION
	CMA
	SNA			/END OF LIST?
	JMP	DSUSR2		/YES
	CMA			/REAL REQUEST FLIP IT BACK AGAIN
	CDF
	DSGO			/YES, START IT UP
	JMP I	DSUSER		/AND BACK
DSUSR5,	JMS I	SWPIOA		/START A SWAP DISK I/O
	JMP I	DSUSER		/RETURN BACK


DSUSR2,	TAD	DSUSTA		/START OF DSU TABLE +7
	TAD	C0007
	DCA	DSKPTR
	JMP	DSUSR4
*2000

/KEYBOARD SERVICE
/ENTERED WHENEVER CHARACTER IS RECEIVED. --==-- HIGHEST PRIORITY ON LEVEL 2

BELL=1000
KLOST,	0	/NUMBER OF CHARACTERS LOST BECAUSE OF OVERFLOW SINCE THE SYSTEM WAS LAST STARTED
TYPEA,	TYPE
KEYB,	RINGIN			/POINTER TO INPUT RING BUFFER
KEYCNT,	-INPUTS
KEYA,	KEYC
KEYSIZ,	-INPUTS			/SIZE OF KEYBOARD INPUT RING BUFFER
CONIN,	DCA I	SETFLG		/CLEAR THE SCHEDULER REQUEST FLAG
CONIN3,	STA
	CDF
	IOF
	TAD I	KEYA
	SMA			/ARE WE FINISHED?
	JMP	CONIN4		/NO
CONEXT,	CDF
	AND I	SETFLG		/DID WE AROUSE ANYONE?
	SZA CLA
	RSCHED			/IF NULL JOB IS RUNNING WE MAY TERMINATE IT
	EXIT

CONIN4,	DCA I	KEYA		/DECREMENTED COUNT
	TAD I	KEYA		/CHECK FOR OVERFLOW
	TAD	KEYSIZ
	SMA SZA CLA
	JMP	CONIN0		/OVERFLOW - SKIP AROUND TO THE FIRST ENTRY
	DATFLD
	TAD I	KEYB		/GRAB A CHARACTER FROM THE RING BUFFER
	DCA	TTCHAR
	ISZ	KEYB
	ION
	TAD I	KEYB		/LINE NUMBER
	SPA
	JMP	HIPTR		/HIGH SPEED READER
	CLL RAL			/TIMES 2
	TAD	DEVTBA
	DCA	CONINA		/POSITION IN DEVICE TABLE
	TAD I	CONINA
	SZA CLA
	JMP	CONIN1
	TAD	CONINA		/NO DDB SETUP YET
	CDF
	GETBLK			/ESTABLISH A PSEUDO DDB FOR THE TIME BEING
	JMP	CONIN2		/NONE AVAILABLE - DON'T BOTHER WITH BELLS
	DATFLD
	TAD I	CONINA
	IOR
	DSI			/SET NEW CONSOLE IN SI MODE
CONIN1,	CDF
	KEY			/PROCESS THIS CHARACTER
CONINA,	.-.
	SKP			/NO ROOM - RING BELL
	JMP	CONIN2
	DATFLD
	TAD I	CONDBA		/POINTS TO OUTPUT SIDE
	SNA
	JMP	CONIN2		/NO DDB DON'T BOTHER WITH BELLS
	IOR
	BELL			/RING-A-DING TOO BAD!!
	JMS I	TYPEA		/REMEMBER WE WANT TO RING HIS/HER CHIME
	JMP	CONIN2
CONIN0,	ISZ	KLOST		/COUNT A LOST CHARACTER
KEYBA,	RINGIN			/NOP
	ISZ	KEYB
CONIN2,	ISZ	KEYB
	ISZ	KEYCNT		/END OF RING BUFFER?
	JMP	CONIN3		/NO
	TAD	KEYBA
	DCA	KEYB		/RESET POINTER
	TAD	KEYSIZ
	DCA	KEYCNT		/AND THE COUNT
	JMP	CONIN3

PTRPTR,	DEVTBE
HIPTR,	AND I	PTRPTR		/GET DDB ADDRESS OF PTR
	SNA
	JMP	CONIN2		/OOPS - [S]HE RELEASED IT
	STORE			/STASH ITS CHARACTER AWAY
	PTRSIZ			/SIZE CHECK ROUTINE
	SKP
	JMP	CONIN2		/ALL IS WELL
	CDF			/OOPS! - RAN OUT OF FREE CORE
	IOF
	ISZ I	KEYA		/UN-COUNT THE CHARACTER
	STA
	TAD	KEYB
	DCA	KEYB		/BACK UP THE RING BUFFER POINTER
	JMP I	.+1		/AND BACK TO THE REMAINDER OF L2 SERVICE
	L2EX0			/JUST PAST THE HI-PRIORITY CHECK POINT
/CHECK DEVICE ASSIGNMENT AND ASSIGN IF AVAILABLE
/CALLING SEQUENCE:
/	JMS	DEVCHK
/	DEVTBL ADDRESS FOR THE DESIRED DEVICE
/	RETURN - IF OK TO USE
/		 IF NOT OK THE RETURN IS THROUGH "UUOERR"
DEVCHK,	0
	TAD I	DEVCHK		/GET DEVTBL POINTER
	ISZ	DEVCHK		/INDEX PAST PARAMETER
	DCA	WS2		/DEVTBL ADDRESS
	RDF			/THE FIELD FROM WHERE WE CAME
	TAD	C6203
	DCA	DEVEXT
	DATFLD
	TAD I	WS2		/DDB ADDRESS
	SZA			/IN USE?
	JMP	DEVCH1		/YES
	TAD	WS2
	CDF
	GETDDB			/GET DATA BLOCK
	REDO
	DATFLD
	TAD I	WS2		/ADDRESS OF DDB
	DCA	WS1
	TAD	WS2		/DEVTBE+UNIT#
	TAD	DEVCH0		/-DEVTBE

	DCA I	WS1		/SAVE IN WORD 0 OF DDB
	ISZ	WS1		/POINTS TO JOB # IN DDB
	TAD	JOB
	AND	C0037
	DCA I	WS1		/SAVE OWNER JOB
DEVEXT,	0
	JMP I	DEVCHK		/RETURN

DEVCH1,	DCA	AXS1		/NOW POINTS TO WORD 0 OF DDB
	TAD	JOB
	CIA
	TAD I	AXS1		/DOES THIS JOB OWN DEVICE?
	SNA CLA
	JMP	DEVEXT
	JMP I	.+1
	UUOERR
DEVCH0,	-DEVTBE


UUOCAL=WS0
UUOADD=WS1

/ SAVE MACHINE STATUS WHEN USER EXECUTES IOT
/WE MUST CHECK USER IOT FLAG BEFORE ANYTHING ELSE, EVEN CLOCK FLAG
/IF WE DON'T, AND CLOCK INTERRUPTS WITHIN 8 MICROSECONDS AFTER USER
/EXECUTES IOT, THEN WE WOULD TRIP ON CLOCK FLAG, AND NOT BE ABLE TO
/FIGURE OUT WHAT IOT THE USER EXECUTED.

UUO0,	DCA	L2SA		/WE MUST HAVE BEEN IN USER MODE WHEN INTERRUPT OCCURRED!
	RAR			/SAVE LINK
	DCA	L2SVLK
	TAD	0
	DCA	L2SV0		/SAVE PC
	RIB
	DCA	L2SF		/SAVE FIELDS AND MODE
	CINT			/CLEAR FLAG
	ION
	STA
	TAD	L2SV0		/BACK UP USER PC TO POINT TO IOT IN QUESTION
	DCA	UUOADD
	UDF			/SELECT USER DATA FIELD
	TAD I	UUOADD		/GET THE IOT THAT CAUSED ENTRY HERE
	DCA	UUOCAL
	CDF
	TAD	UUOTBA		/START SCANNING THE IOT TABLE
	DCA	AXS1
	TAD	UUOCAL
	AND	C7770		/GET DEVICE CODE
	CIA
	DCA	UUOC77		/SAVE-CODE
	JMS	UUOSR		/FIRST SEE IF IT IS MICRO-CODED
	JMP	UUO22
UUO3,	TAD	AXS1		/YES, NOW COMPUTE ADDRESS OF SERVICE ROUTINE
	TAD	UUOTLL		/OFFSET BETWEEN IOT TABLE AND DISPATCH TABLE
	DCA	UUOC77		/POINTS TO DISPATCH ENTRY
	TAD I	UUOC77		/GET DISPATCH ADDRESS
	DCA	UUOC77		/SAVE IT
	JMP I	UUOC77		/AND JUMP TO IT
UUO7,	JMS	UUOSR		/CHECK FOR NON-RESIDENT IOTS WHICH RETURN ARGUMENTS
	UUOEXT			/UNDEFINED
	JMP	UUO8		/FIND # OF ARGUMENTS TO SEND TO FIP
UUO22,	TAD	UUOCAL		/IS IT AN IOT AT ALL?
	AND	C1000
	SZA CLA
	JMP I	UHALTA		/IT'S A HLT, OSR, OR SOME COMBINATION
	TAD	UUOCAL		/IT'S NOT MICROCODED
	CIA
	DCA	UUOC77		/-IOT CAUSING INTERRUPT
	JMS	UUOSR		/CHECK FOR NON-MICRO-CODED RESIDENT IOTS
	SKP
	JMP	UUO3		/FOUND ONE; NOW GO GET DISPATCH ADDRESS AND AWAY---
	JMS	UUOSR		/SEARCH FOR SHORT NON-RESIDENT IOTS
	JMP	UUO7
UUO6,	TAD	UUOCAL		/THROW AWAY BITS 0-2 OF IOT
	AND	C0377
	DCA	UUOCAL		/AND SAVE IT
UUO8,	TAD	AXS1		/NOW FIND NUMBER OF ARGUMENTS
	TAD	UUOTLL		/THIS POINTS TO # IN UUOTBL
	JMS	GETUSP		/GET USER PARAMENTERS
UFILE4,	TAD	CJOBDA		/GET POINTER TO STR0
	GETJTA
	JOBSTS
	DATFLD			/OR IN "NON-RESIDENT IOT" BIT
	IOR			/SO FIP WILL RUN IN PLACE OF THIS JOB
	JSIOT
	TAD	FIPJOB		/ANYTHING CURRENTLY SCHEDULED?
	SZA CLA
	WAIT			/YES - FIP WILL PICK US UP LATER
	TAD	JOB
	DCA	FIPJOB		/SO THE SCHEDULER WILL TAKE US AS SOON AS POSSIBLE
	WAIT			/AND WAIT FOR FIP

UUOSR,	0			/SEARCH FOR MATCH
	TAD I	AXS1		/GET ENTRY FROM TABLE
	SNA			/LAST ENTRY?
	JMP I	UUOSR		/YES, RETURN
	TAD	UUOC77		/NO, CHECK FOR MATCH
	SZA CLA			/MATCH?
	JMP	.-5		/NO, KEEP GOING
	ISZ	UUOSR		/YES, SKIP
	JMP I	UUOSR		/AND RETURN

UHALTA,	UHALT
UUOTBA,	UUOTBL-1
UUOTLL,	UUODTB-UUOTBL
/THIS ROUTINE COPIES THE PARAMETERS SUPPLIED BY THE
/USER PROGRAM INTO *BLOCK IN FREE CORE, WHICH IS POINTED
/TO BY JOBLNK.
/THE IOT ITSELF IS SAVED IN THE FIRST WORD OF THE PARAMETER BLOCK
/IF NO ARGUMENTS ARE REQUIRED, JOBLNK CONTAINS THE IOT,
/RATHER THAN A POINTER TO THE IOT PARAMETER BLOCK.
/FIP CAN TELL BY EXAMINING BITS 0-3 OF JOBLNK; IF THEY ARE
/NON-ZERO, JOBLNK IS AN ADDRESS; IF ZERO, JOBLNK IS THE IOT ITSELF.
/NOW YOU KNOW WHY THE START OF THE FREE CORE LIST MUST ALWAYS BE
/ON OR AFTER 400 OCTAL IN FIELD ONE?

UUODAC,	DSKACT

GETUSP,	0			/ENTER WITH PTR -# ARGUEMTS TO GET
	DCA	UUOC77		/SAVE IT
	CDF
	TAD	CJOBDA		/OK - NOW GET PTR TO JOBLNK
	GETJTA
	JOBLNK
	DCA	UUOLNK		/AND SAVE IT
	TAD I	UUOC77
	SNA			/ANY ARGUMENTS?
	JMP	GETUS1		/NO - JUST SAVE IOT IN JOBLNK
	CDF
	DCA	UUOC77		/YES. SAVE # ARGUMENTS
	CLL CLA CMA RAL		/CAN WE GET PARAMETER BLOCKS?
	TAD	FRECNT
	SPA SNA CLA
	REDO			/NO - TRY LATER
	TAD	UUOLNK		/PUT ADDRESS OF LINKAGE BLOCK IN UUOLNK
	GETBLK			/GET A FREE BLOCK
	HLT			/WHAT? "FRECNT" SAID THERE WERE PLENTY!!
	DATFLD
	TAD I	UUOLNK		/GET ADDRESS OF PARAMETER BLOCK
	CDF
	DCA	UUOLNK		/SAVE IT IN BLT CALLING SEQUENCE
	STA			/GET POINTER TO USER PARAMETERS-1
	TAD	L2SA
	DCA	UUSRC		/SAVE FOR BLT CALL
	TAD	UUDF		/MOVE USER PARAMETERS TO LINKAGE AREA IN DATFLD
	DCA	.+2
	BLT
	0			/SOURCE FIELD SELECT
UUSRC,	0			/SOURCE ADDRESS
	DATFLD			/DESTINATION FIELD SELECT
UUOLNK,	0			/DESTINATION ADDRESS
UUOC77,	0			/-#WORDS
GETUS1,	TAD	UUOCAL		/NOW GET IOT
	DATFLD
	DCA I	UUOLNK		/AND SAVE IT IN APPROPRIATE PLACE
	CDF
	JMP I	GETUSP		/RETURN
/STASH LEVEL 2 REQUESTS FROM FIELD 1


QUEUE0,	0
	DCA I	L2Q		/QUEUE REQUEST FROM FIELD 1
	CIF	DATFLD
	JMP I	QUEUE0		/AND BACK

L2689,
IFNZRO D689 <
	CIF	DATFLD
	JMP I	.+1		/TO FIELD 1 689 CARRIER SERVICE
	DFCARR	>
IFNZRO DC08A <*2364
T8OUT,	CLA			/DC08A CODE CALLED FROM "CONOUT"
	TAD	T8OBF2		/FIND ACTIVE OUTPUT REGISTER
	TAD	WS0
	DCA	UUOSR
	TAD	TTCHAR		/CHARACTER TO BE OUTPUT
	CLL RAL
	TAD	T8STOP
	DCA I	UUOSR		/STASH IT COMPLETE WITH STOP & START BITS
	JMP I	.+1
	CONTLS+1
T8OBF2,	SKPTBL-OUTREG+1
T8STOP,	3000	>
IFNZRO CPU&7776 <*2360
KLEN,	SKPTBL-1
KDEV,	SKPTBL-1
TIMER4,	CLA
	TAD	KDEV		/END OF LIST; RE-SET THE POINTER
	DCA	KLEN
L2TIME=.
	ISZ	KLEN		/MAKE SURE THAT THE KL8E'S STAY ENABLED
	DATFLD
	TAD I	KLEN
	CDF
	SMA
	JMP	TIMER4		/END OF LIST, RESET POINTER FOR NEXT TIME
	TAD	C0004		/CONSTRUCT A "KIE"
	DCA	.+2
	IAC
	.-.
	CLA	>
*2400
IFZERO CPU&7776 <L2TIME=.>
L2TIM2,	ISZ	CLK1		/UPDATE LOW ORDER DAY CLOCK
	JMP	L2TIM3		/NOTHING UNUSUAL
	ISZ	CLK2		/UPDATE HIGH ORDER TIME. WOW!
	JMP	L2TIM3
	ISZ	DATE		/WOULD YOU BELIEVE IT'S MIDNIGHT!
	TAD	ICLK2		/REINITIALIZE THE CLOCK FOR ANOTHER
	DCA	CLK2		/24 HOURS WORTH OF TICKS
	TAD	ICLK1		/AND BUMP THE DATE ONE
	DCA	CLK1		/(EVERY MONTH HAS 31 DAYS FOR OUR PDP-8)
L2TIM3,	CIF DATFLD		/DECREMENT TIMERS
	JMS I	TIMERA		/ROUTINE TO RUN TIMERS
TIMCON,	-5			/TIMES OUT EVERY FIVE SECONDS
	L2OUT			/SCHEDULE "CONOUT-TIMER" SERVICE
TIMPTR,	0			/NON-ZERO IF BUSY
	L2PTR			/WHERE TO GO WHEN READER HANGS
TIMCDR,	0			/NON-ZERO IF BUSY
	L2CDR			/WHERE TO GO IF THE CARD READER HANGS
TIMSI,	0			/NON-ZERO WHEN SI IS IN THE WAIT STATE
	L2SI			/WHERE TO GO WHEN IT TIMES OUT
TIMFIP,	0			/NON-ZERO IF "FIPLOCK" IS ON
	L2FIP			/WHERE TO GO TO TURN "FIPLOCK" OFF
TIM689,	0			/NON-ZERO IF ACTIVE
	L2689			/WHERE TO GO TO CHECK CARRIER STATUS
TIMER3,	ISZ	JOBTIM
	NOP
	CIF			/INHIBIT INTERRUPTS WHILE WE UN-BUMP THE CLOCK
	CLL STA
	TAD	CLOCK
	DCA	CLOCK
	SZL			/HAVE WE COUNTED ALL THE SCHEDULED SYSTEM TICKS?
	JMP	L2TIM2		/NO
/"RSCHED" IS ENTERED AT THIS POINT
/RSCHED'S FUNCTION IS TO FIND JOBS TO RUN, REGARDLESS
/OF WHERE THEY MAY CURRENTLY RESIDE. IF THEY ARE IN CORE,
/GOOD; IF NOT, THE NECESSARY STEPS WILL BE TAKEN TO
/BRING THEM INTO CORE. IN THE LATTER CASE, WE WILL THEN
/GO OFF AND FIND SOMETHING TO DO WHILE THE NON-RESIDENT
/JOB IS MADE RESIDENT.

SCHED0,	TAD	JOB		/GET CURRENT JOB
	AND	C0600
	SZA CLA
	EXIT			/?? - DON'T BUMP OFF A PHANTOM!
	TAD	SCHNEW		/IS THIS SOMETHING THAT CAN BE BUMPED OFF?
	SNA
	JMP	SCHE12		/YES - GET RID OF HIM/HER
	TAD	JOBTIM		/HAS [S]HE USED A FULL TIME SLICE YET?
	SPA SNA CLA
	EXIT			/NO, GO BACK TO HIM/HER
SCHE12,	ION
	SAVJOB			/YES. SAVE ITS STATE. SET JOB=0
	STA
	DCA	SCHNEW		/SET FOR FULL TIME SLICES
	TAD	CURJOB		/DID FILE TRANSFER PROCESSING CUT INTO SOMEONE'S TIME SLICE?
	SZA
	JMP	SCHEI6		/YES - START IT BACK UP
	TAD	NXTMAX
	DCA I	NXTJCA		/NUMBER OF JOBS TO CONSIDER
	TAD	SQREQ		/SWAP REQUEST IN PROGRESS?
	SNA CLA			/IF SO, THERE IS NO POINT IN GOING FURTHER NOW.
	JMP	SCHED1		/NO - PROCEED
/SCHEDULE NEXT RESIDENT JOB
/THIS IS THE ENTRY FOR "SCHED"
/WE ONLY COME HERE IF A SWAP IS IN PROGRESS
/OR IF WE FIND THE JOB WE REALLY
/WANT TO RUN IS CURRENTLY INDISPOSED TO RUNNING. SCHED
/WILL FIND SOME RESIDENT JOB TO RUN. IF NO JOB IS
/RUNNABLE OR RESIDENT, JOB 0 (THE NULL JOB) IS RUN.

SCHEDI,	TAD	FANCOR		/CHECK FOR PHANTOMS FIRST SO
	DCA	WS0		/START AT FIELD 2
	TAD I	SCHMUC		/NUMBER OF USER CORE FIELDS TO CONSIDER
	CLL RAL			/TIMES 2
	DCA I	NXTCNA		/ON THE SECOND PASS WE MAY PICK UP A COMPUTE-BOUND JOB
	TAD I	SCHMUC		/NUMBER OF FIELDS
	DCA	WS1
SCHEI3,	TAD I	WS0
	AND	C1000		/CHECK FOR "NOTRUN"
	SZA
	JMP	SCHEI4		/WE FOUND ONE
	ISZ	WS0
	ISZ	WS1
	JMP	SCHEI3		/TRY AGAIN
	JMP I	SCHNXT		/LOOK FOR SOMEONE TO RUN ON BORROWED TIME

SCHEI4,	CMA
	AND I	WS0		/REMOVE THE "NOTRUN" BIT
	DCA I	WS0
	TAD I	WS0
	AND	C0600		/IS IT A PHANTOM?
	SZA CLA
	JMP	SCHEI5		/YES - THEN IT MUST BE READY TO EXECUTE
	TAD I	WS0
	AND	C0037
	RUNABL			/IS IT RUNNABLE?
	JMP	SCHEI3+4	/NO
SCHEI5,	TAD I	WS0		/YES - IT MUST BE RUNNABLE
SCHEI2,	DCA	SCHNJN		/IS JOB IN CORE?
	TAD	SCHNJN		/SEARCH CORTBL FOR HIM/HER
	CORE
	SWAP LOCK FIP SI CJOB
	SCHED			/NOT THERE; HAVE TO SWAP HIM/HER IN LATER
	DCA	L2SF		/YES - SET UP SAVE FIELD
	TAD	SCHNJN		/RESTORE REST OF LEVEL 2 REGISTERS
	RESJOB
	START			/START JOB

SCHEI6,	DCA	SCHNJN		/SAVE JOB NUMBER
	DCA	CURJOB		/CLEAR "REMEMBERED" JOB
	JMP	SCHEI2+1	/NOW GO START HIM/HER BACK UP
SCHNXT,	NXTCO1
ICLK1,	-INCLK1
ICLK2,	-INCLK2-1
SCHNJN=WS0
SCHSI=C0200
TIMERA,	TIMER0
NXTMAX,	-JOBMAX-1
NXTJCA,	NXTJCT
SCHMUC,	CORCNT
NXTCNA,	NXTCNT
L2CDR,	DATFLD
	TAD I	UUCDR1
	DCA	AXS1
	TAD I	AXS1
	CDF
	ERROR			/PASS HUNG DEVICE ERROR TO THE USER
	HUNGDV
CDL20,	CIF DATFLD-1
	JMP I	.+1
	CDL21
UUCDR0,	IAC
	IAC
	DCA	UUOCAL		/SAVE THE IOT INDICATOR
	JMS I	CDRCHK		/SEE IF IT'S OK FOR HIM/HER TO USE THE CARD READER
UUCDR1,	DEVTBE+4
	TAD	UUOCAL		/ALL IS WELL
	CIF DATFLD-1
	JMP I	.+1		/OFF TO THE CARD READER HANDLER
	UUCDR
CDRCHK,	DEVCHK
REDO0,	STA			/IF WE CAN'T FINISH AN IOT FOR LACK OF SYSTEM
	TAD	L2SV0		/FACILITIES, WE BACK UP THE USER'S PC TO POINT
	DCA	L2SV0		/TO THE SAME IOT AND HOPE THAT LATER ON THINGS WILL LOOSEN UP.
WSCHED,	CDF			/THE USER PROGRAM IS TO GO INTO A WAIT
	JMP	SCHE12


SCHED1,	TAD	FIT		/SOMETHING LEFT FROM LAST PASS THROUGH SCHEDULER?
	AND	C0037		/JOB ONLY
	SZA
	JMP	SCHED4		/YES
	TAD	COMCNT		/SI REQUESTED?
	SNA CLA
	JMP	SCHED6		/NO
	TAD	SCHSI
	JMP	SCHED8		/YES - SCHEDULE IT
SCHED6,	TAD	FIPJOB		/SOMETHING WAITING FOR FIP?
	SNA
	JMP	SCHE13		/NO SPECIFIC JOB
SCHED4,	DCA	FIT		/SAVE IT
	TAD	FIT
	RUNABL			/IS IT STILL GOOD?
	SKP			/NO
	JMP	SCHED5		/YES - CHECK IT OUT
SCHE13,	JMS I	SCHNXA		/GET NEXT RUNNABLE JOB
	DCA	FIT		/SAVE JOB #
	DCA	BONUS		/BONUS JOB ALREADY PICKED UP
SCHED5,	TAD	FIT
	TAD	JOBTBA
	GETJTI			/GET CONTENTS OF STR0
	JOBSTS
	RTL			/PUT ERROR ENABLE IN THE LINK
	AND	SCFIP		/NEED FIP?
	SZA
	JMP	SCHED7		/YES; SCHEDULE FIP FOR HIM/HER
	DATFLD
	TAD I	JOBSWA		/GET STR0 AGAIN
	CDF
	AND	C0007		/ANY ERROR BITS ON?
	SZA SNL CLA		/EVEN IF THERE ARE WE'LL LET HIM/HER HANDLE IT IF [S]HE'S ENABLED (LINK=1)
	TAD	SCHSI		/CALL SI TO HANDLE ERROR
SCHED7,	TAD	FIT		/UPDATE "FIT" IF THERE'S A NEED FOR FIP OR SI
SCHED8,	DCA	FIT
	TAD	FIT
SCHED3,	AND	C0600		/IS FIT JOB FIP OR SI?
	SNA CLA
	JMP	SCHE11		/NO
	TAD I	FANCOR		/IS FIP OR SI IN CORE?
	AND	FIT		/IS IT THE PROPER PHANTOM?
	AND	C0600
	SNA CLA
	JMP	SCHE15		/NO - SCHEDULE THEIR SWAP IN
	TAD I	FANCOR		/YES - IS THE PHANTOM IN USE?
	AND	C0037		/JOB #
	SZA CLA
	JMP	SCHED9		/YES - NOT MUCH TO DO NOW
	SCLOCK			/LOCK PHANTOM FOR THIS JOB
	TAD	FIT		/NO - LOCK PHANTOM FOR THIS USER
	DCA I	FANCOR		/INDICATE THAT THIS FIELD IS NOW LOCKED
SCHED9,	DCA	FIT		/CLEAR FIT
	FANFLD			/DISK ACTIVITY HERE?
	JMS I	SCDACT
	JMP	SCHE13		/YES - FORGET ABOUT PHANTOM FOR NOW
	TAD I	FANCOR		/NO
	JMP I	.+1		/NOW GO FINISH BOOKKEEPING
	SCHEI2

SCHNXA,	NXTJOB
SCFIP=	C0400			/FIP
SCLOCK=	CLA CLL CML RTR		/LOCK BIT AC=2000
SCDACT,	DSKACT
FANFLD=	CLA STL RTL		/PHANTOMS ALWAYS RUN IN FIELD 2

SCHE15,	TAD I	FANCOR		/FANFLD LOCKED, SWAPPED, OR NOTRUN?
	AND	C7000
	SZA CLA
	JMP	SCHE13		/YES - GO FIND SOMETHING ELSE TO DO NOW
	TAD I	FANCOR		/IS THERE CURRENTLY A USER JOB IN FANFLD?
	AND	C0037		/IS THERE A USER JOB IN FANFLD?
	SZA CLA
	JMP	SCHE16		/YES, FORCE IT OUT
	FANFLD			/NO; FINISH:=FANFLD
	JMP	SCHE14

SCHE16,	TAD I	FANCOR		/IS A PHANTOM IN HERE?
	AND	C0600
	SZA CLA
	JMP	SCHE13		/YES, GO FIND ANOTHER JOB TO RUN
	DCA	DEAD		/DON'T GO LOOKING FOR AN ALTERNATIVE FIELD!
	FANFLD			/FORCE JOB OUT OF FANFLD
	DCA	FORCE
	JMP	SCHFR1
SCHE10,	CORE			/FIRST LOOK FOR A FIELD WITH NOTHING IN IT
	SWAP LOCK NOTRUN FIP SI NOHOLD CJOB
	SKP			/NO SUCH FIELDS
	JMP	SCHE19		/FOUND ONE TO USE
	TAD	DEAD		/ARE THERE ANY OLD DEAD JOBS STILL IN CORE?
	SZA
	JMP	SCHDED		/YES - SEE IF WE CAN GET RID OF IT
SCHE18,	CORE			/LET'S TRY AGAIN
FIPLOK,	SWAP LOCK NOTRUN CJOB
	JMP	SCNOUT		/NO, SCAN FOR OUTPUT
SCHE19,	AND	C0007		/YES
SCHE14,	DCA	FINISH		/FINISH:=FIELD #
	TAD	FINISH		/SET SWAP BIT IN CORTBL ENTRY
	TAD	CORTBA
	DCA	SUJT2		/POINTS TO CORTBL ENTRY
	STL RAR			/AC=4000 (SWAP)
	TAD	FIT		/JOB TO SWAP IN
	DCA I	SUJT2		/SAVE IN CORTBL
	JMP I	SCSWAP		/SWAP IN
SCNOUT,	TAD	SCNSVP		/RESTORE CORTBBL POINTER FOR OUTPUT SCANNING
SCHDED,	DCA I	SCNSV1
	CORE			/SCAN FOR AVAILABLE FIELD
	LOCK+NOTRUN+FIP+SI
	JMP	SCHE17		/ARE WE STUCK?
	AND	C0007
	DCA	FORCE		/FIELD TO SWAP OUT
	TAD I	SCNSV1		/PICK UP POSITION OF POINTER
	DCA	SCNSVP		/SAVE FOR THE NEXT TIME
SCHFR1,	TAD	FORCE		/DISC XFER IN PROGRESS?
	JMS I	SCDACT
	JMP	SCHE17		/SEE IF WE CAN TAKE ONE MORE LOOK AROUND
	TAD	FORCE
	TAD	CORTBA
	DCA	SUJT2		/CORTBL POINTER TO FORCED FIELD
	DCA	DEAD
	TAD	FORCE
	CIA
	DCA	FINISH		/SET FINISH=-FORCE (TO INDICATE SWAP OUT)
	JMP I	.+1		/NOW GO SET UP THE OUTSWAP
	SWPOUT
SCHE17,	TAD	DEAD		/CAN WE LOOK FURTHER?
	SNA CLA
	SCHED			/NO - WE'RE STUCK
	DCA	DEAD		/YES - GUESS WE GOT BAD ADVICE
	JMP	SCHE18		/GO TAKE ANOTHER LOOK

SCSWAP,	SWAPIN
SUJT2=	WS0
SCNSVP,	CORTBL+1		/VALUE OF CORTBL POINTER AFTER LAST SEARCH
SCNSV1,	CORTBP			/POINTS TO CORTBL POINTER IN CORE SEARCH ROUTINE


SCHE11,	TAD	FIT		/IS FIT JOB IN CORE?
	CORE
	SWAP LOCK FIP SI CJOB
	JMP	SCHE10		/NO - [S]HE HAS TO BE SWAPPED IN
	DCA	L2SF		/SAVE FIELD
	TAD	FIT		/RESTORE LEVEL 2 REGISTERS
	RESJOB
	DCA	FIT		/CLEAR FIT
	START			/START JOB
SWERER=	C0002			/SWPRER

SWPRET,	JMP	SWERR		/ERROR ON SWAP
	TAD	CORTBA		/GET A POINTER TO THIS FIELD'S
	TAD	FINISH		/ENTRY IN CORTBL
	DCA	SQREQ
	TAD	FIT		/JOB SWAPPED IN
	TAD	C1000		/NOT RUN BIT
SWGOD1,	DCA I	SQREQ		/STORE IT IN THE CORTABLE
	DCA	FINISH
	DCA	FIT		/SET ALL CONCERNED WORDS TO ZERO
	DCA	FORCE
	DCA	SQREQ
	JMS I	SWSCON		/SEE IF ANY MORE DISC I/O WAITING TO BE ATTENDED TO
	RSCHED			/RE SCHEDULE
SWSCON,	DSKCON

SWERR,	TAD	FINISH		/ERROR WHILE SWAPPING OUT OR SWAPPING IN?
	SPA
	CIA			/DURING SWAP OUT
	TAD	CORTBA
	DCA	SQREQ		/POINTER TO CORTBA FOR THIS FIELD
	TAD	FINISH
	SPA CLA
	JMP	SWER1		/WHILE SWAPPING OUT; CODE=3
	TAD	SWERER		/WHILE SWAPPING IN;  CODE=2
	DCA	SWPER1
	TAD	FIT
SWER2,	AND	C0037		/GET THE JOB #
	SNA			/IS IT A PHANTOM?
	JMP	SWGOD1		/YES, SO NO ERROR CODE TO SET
	ERROR			/NO JOB BEING SWAPPED IN SO HAVE TO SET ERROR CODE
SWPER1,	0			/ERROR CODE
	JMP	SWGOD1		/CLEAR ALL THE CONCERNED WORDS BEFORE LEAVING
SWER1,	TAD	SWER3		/ERROR CODE
	DCA	SWPER1
	TAD I	SQREQ		/JOB BEING SWAPPED OUT
	JMP	SWER2
SWER3=	C0003
REMJOA,	REMJOB
SCHFAN,	JMS I	REMJOA		/REMEMBER WHO'S RUNNING
	SCHED			/GO RUN THE PHANTOM
/BOOTSTRAP FOR CRASH RECOVERY, USED TO BRING INIT INTO HIGHEST MEMORY FIELD
BOOT,	CDF			/IN THE (VERY RARE) EVEN THE SYSTEM
	STA			/SHOULD CRASH, THIS ROUTINE MAY
	DCA I	B7751		/BE STARTED AT 4200 OF FIELD 0
	DCA I	B7750		/WC AND CA
	TAD	DSKFLD		/HIGHEST FIELD
	IFZERO RF08	<
	DIML
	CLA STL RTL
	DXAL			/TRACK 2
	>
	IFZERO RF08-40	<
	DEAL
	NOP			/FOR SIZE
	CLA
	>
	DMAR
	DFSC			/WAIT
	JMP	.-1
	CIF CDF+CORMEM
	JMP	0		/OFF TO INIT

B7751,	7751
B7750,	7750
DSKFLD,
	IFZERO RF08	<CORMEM>
	IFZERO RF08-40	<CORMEM+200>
/SAVE JOB REGISTERS
/THIS ROUTINE IS USED TO SAVE THE LEVEL 2 REGISTERS
/IN THE JOB DATA AREA. AFTER SAVING THIS
/INFORMATION, JOB IS SET TO 0 TO INDICATE
/THAT NULJOB IS RUNNING
/CALL	SAVJOB
/	RETURN

SAVJO0,	0
	TAD	JOB		/IS NULJOB RUNNING ALREADY?
	SNA
	JMP I	SAVJO0		/YES - NOTHING TO SAVE
	AND	C0600
	SZA CLA			/IS A PHANTOM RUNNING?
	JMP	SAVJO3		/YES
	TAD	CJOBDA		/MOVE LEVEL TWO REGISTERS TO JOB DATA AREA
	GETJTA
	JOBREG
	DCA	.+5
	BLT			/MOVE PC, LINK, AC TO JOB DATA AREA
	CDF			/FROM FIELD 0
	L2SV0
	DATFLD
	0
	-3
IFNZRO MQREG <
	GETJTW			/IF THERE'S AN MQ AND MAYBE AN EAE, SAVE THEM TOO
	JOBEAE
IFNZRO CPU-1 <
	CLA MQA MQL	>	/LOAD AC FROM MQ, CLEAR MQ
IFZERO CPU-1 <
	CLA MQA		>	/LOAD AC FROM MQ
	DATFLD
	DCA I	JOBSWA	>	/SAVE IN JOB MQ
IFNZRO EAE <
	ISZ	JOBSWA		/GET POINTER TO JOB SC
IFNZRO CPU-2 <
	SCA			/GET SC
	DCA I	JOBSWA	>	/AND SAVE IT
IFZERO CPU-2 <
	SCA			/GET SC
	CLL RTL			/MAKE ROOM FOR MODE AND GT
	DCA I	JOBSWA		/SAVE SC
	DPSZ			/SKIPS IF MODE B
	ISZ I	JOBSWA		/INCR IF MODE A
	SGT			/CHECK GT FLAG
	ISZ I	JOBSWA		/INCR, IF GT=0 OR IF MODE A
	> >			/IF MODE=A THERE MAY BE JUNK IN THE AC AT THIS POINT BUT
				/BITS 7-11 ARE GUARANTEED CLEAR

