/COS 300 FOREGROUND/BACKGROUND		EDITED 9/26/73
	*4600
/ * * * FOR ONE JOB IN 12K, THIS CODE GETS DESTROYED ! ! ! * * *
/
/QUEUEING DECTAPE HANDLER FOR COS 300 FOREGROUND/BACKGROUND
/CALL DTAQ TO QUEUE A REQUEST.  THIS CODE LIVES IN FIELD X, WHERE
/X IS UNKNOWN AND IS THE FOREGROUND FIELD.
/CALL:
/	TAD	(PARAM-1		PARAM,	LOW BLOCK #
/	CDF	CURRENT				R/W,LEN,F,U
/	CIF	DTAQ FIELD			ADDR
/	IOF	(IF BACKGROUND)			HIGH BLOCK #
/	JMS	DTAQ
/	(RETURN, AC = 0 AND IOF!)
DTAQ,	0
	IOF
	CLL
	SZA
	JMP	.+3
	CML
	TAD	(ARG1A-1
	DCA	XR10		/SAVE PTR TO PARAMS
	RDF
	TAD	CICDF0
	DCA	DTQXIT
	SZL
DF228,	DF229
	RDF			/GET PARAMS CDF
	TAD	LCDF
	DCA	DTARGF
	TAD	M4
	DCA	DTCNT
	TAD	ARG1A
	AND	L7400
	TAD	L0010		/SET BIT TO SHOW "IOERR" IT'S DECTAPE
	DCA	ARG1A
	AC7777
	TAD	DTPNDG
	DCA	DTPNDG		/BUMP COUNT OF PENDING REQUESTS
	TAD	JOB		/PUT JOB # WITH FIRST ARG
DTNCTR,
DTARGF,	0			/CDF ARG FIELD
	TAD I	XR10		/GET AN ARG
DF213,	DF214			/CDF CURRENT FIELD (GETS SET UP) *****
	DCA I	DTQPUT		/ADD ARG TO THE QUEUE
	ISZ	DTQPUT		/AND BUMP QUEUE PTR
	ISZ	DTCNT		/GOTTEN ALL ARGS?
	JMP	DTARGF		/NOPE
	TAD	JOB
	TAD	KDWAIT
	DCA	DTNEXT
	ISZ I	DTNEXT		/SET "OPERATION IN PROGRESS" FOR THIS JOB
	TAD I	DTQPUT		/RESET BUFFER POINTER
	DCA	DTQPUT
DTCK,	TAD	DTPNDG
	CMA			/CHECK ON PENDING REQUESTS
	SZA CLA			/IF ONLY ONE REQUEST PENDING, IT'S THE
	JMP	DTQXIT		/REQUEST WE JUST PUT ON THE QUEUE
	JMS	DTNEXT		/SO IF THAT'S THE CASE, GET IT OFF
	JMS I	(DTSTRT		/AND START IT GOING
DTQXIT,	0			/OUR GETAWAY ROUTE, REMEMBER?
	JMP I	DTAQ

/THIS ROUTINE GETS THE NEXT REQUEST FROM THE DTA QUEUE AND
/MAKES IT THE "CURRENT REQUEST" IN LOCATIONS DTARG1-DTARG4.
/IT ALSO SETS THE MAGIC ERROR COUNTER RETRY.
DTTMP,
DTCNT,
DTNEXT,	0
	TAD	(DTARG1-1
	DCA	XR10
	TAD	M4
	DCA	DTNCTR
DTNLP,	TAD I	DTQGET
	DCA I	XR10
	ISZ	DTQGET
	ISZ	DTNCTR
	JMP	DTNLP
	AC7775
	DCA	DTTRY
	TAD I	DTQGET		/RESET QUEUE POINTER
	DCA	DTQGET
	JMP I	DTNEXT
DTERR,				/COME HERE WITH LINK = 1!
DTDONE,	TAD	DTJOB		/COME HERE WITH LINK = 0!
	TAD	KDWAIT
	DCA	DTTMP
	RAR			/0 IF OK OR 4000 IF ERROR
	DCA I	DTTMP
	TAD	DTJOB
	TAD	KJMSKT
	DCA	DTTMP
	TAD	DDDBIT
	CMA
	AND I	DTTMP
	DCA I	DTTMP
	ISZ	DTPNDG
	SKP
	JMP I	(INTXIT
	JMS	DTNEXT
DTRETR,	JMS I	(DTSTRT
	JMP I	(INTXIT

DTQPUT,	DTQ0			/DTA QUEUE "PUT" PTR
DTPNDG,	0
DTJOB,	0
DTTRY,	0
DTSTAT,	0
DTQGET,	DTQ0			/DTA QUEUE "GET" PTR
DTARG1,	0			/THE "CURRENT JOB" PARAMETERS
DTARG2,	0
DTARG3,	0
DTARG4,	0
DTQ0,	ZBLOCK 4;	DTQ1
DTQ1,	ZBLOCK 4;	DTQ2
DTQ2,	ZBLOCK 4;	DTQ3
DTQ3,	ZBLOCK 4;	DTQ4
DTQ4,	ZBLOCK 4;	DTQ5
DTQ5,	ZBLOCK 4;	DTQ0
/
	PAGE

/%BLOCK 13
/***** THIS PAGE MAY CHANGE *****
/CODE FOR TC12 OR (BARF!) TD8E MAY BE MOVED TO HERE
DTSTRT,
TC08,	0
	TAD I	(DTARG1		/GET LOW BLOCK BITS
	AND	L7400
	CLL RAL
	TAD I	(DTARG4		/ADD IN HIGH
	RTL
	RTL
	CLL RAL			/MULTIPLY BY 2
	DCA	DTBLOC
	TAD I	(DTARG1
	AND	L7		/GET JOB #
	DCA I	(DTJOB
	AC7777
	TAD I	(DTARG3
	DCA	DTCORE
	AC7777
	DCA	DTXSW		/SET EXIT SWITCH
DTATRY,	TAD	DTAWC
	CDF 0
	DCA I	DTACA
DF229,	DF230
	TAD I	(DTARG2
	AND	L7
	CLL RTR
	RTR
	TAD	(414		/SEARCH REVERSE, "GO" OFF, INT ENABLE
	DTCA DTXA
	DTLB			/DECTAPE DF = 0
DTGO,	TAD	L0200		/"GO" BIT
DC,	SZL
	TAD	L0400		/CHANGE SEARCH DIRECTION
	DTXA
	JMS	DTWAIT
	DTRA
	RTL
	CMA RTL			/DIRECTION IN LINK
	SNL CLA			/THIS IS CLASSIC R.L. CODING!
	CML RTL			/SEARCH FOR BLOCK-2 IN REVERSE
	CDF 0
	TAD I	DTAWC
DF230,	DF231
	CIA
	TAD	DTBLOC
	SNA CLA
	SZL CLA
	JMP	DC
	TAD	DTCORE
	CDF 0
	DCA I	DTACA		/SET CA TO BUFFER-1
DF231,	DF232
	TAD I	(DTARG2
	DTLB			/LOAD BUFFER DF
	TAD I	(DTARG2
	CLL RAL
	AND	L7600
	DCA	DBLKCT
	RAL
	IAC
	CLL CML RTL
	RTL			/30 FOR READ, 50 FOR WRITE
DL,	DTXA
	TAD	L7600
	CDF 0
	DCA I	DTAWC		/WC = -200
DF232,	DF233
	DF233=	0
	JMS	DTWAIT
	TAD	DBLKCT		/BUMP BLOCK COUNT
	TAD	L7600
	SNA
	JMP	DSTOP		/ALL DONE!
	DCA	DBLKCT
	JMP	DL
DERR2,	ISZ I	(DTTRY		/TRIED 3 TIMES?
	JMP	DTATRY		/NOT YET
	TAD	(604		/REVERSE, STOP, NO INT
	DTXA			/STOP TAPE
	CLL CML			/SET "I/O ERROR"
	JMP I	(DTERR		/GO REPORT THE NEWS
DSTOP,	TAD	(604
	DTXA
	CLL			/SET "NO ERROR"
	JMP I	(DTDONE

DTWAIT,	0
	ISZ	DTXSW		/WHO CALLED US?
	JMP I	(DISMIS		/INTERRUPT SERVICE - GO AWAY AGAIN
	JMP I	TC08		/OPERATION STARTUP
TC8SRV,	DTRB
	SMA CLA			/ERROR?
	JMP I	DTWAIT		/NOPE - KEEP ON TRUCKIN'
	DCA	DTXSW		/IF YOU TRY TO READ A NON-EXISTANT BLOCK THE ISZ COULD SKIP AT THE WRONG TIME
	DTRB
	RTL
	RAL
	SNL CLA			/END ZONE ERROR TO LINK
	JMP	DERR2		/SOMETHING ELSE - BAD
	JMP	DTGO		/IF END ZONE
DTAWC,	7754
DTACA,	7755
DTXSW,	0
DBLKCT,	0
DTBLOC,	0
DTCORE,	0
/
	PAGE

/HERE IS A DESCRIPTION OF W0-W5 AND U0-U2
/W0	BIT 0 IS READ (IF 0) OR WRITE (IF 1)
/	BITS 1-5 ARE THE NUMBER OF PAGES TO READ OR WRITE (0 IMPLIES 40)
/	BITS 6-8 ARE THE FIELD THIS HAPPENS IN
/	BITS 9-11 ARE THE PHYSICAL UNIT # OF THE DEVICE IT'S HAPPENING ON
/W1	BIT 0 IS THE BUFFER SWITCH (0 = FIRST BUFFER, 1 = SECOND)
/	BITS 1-4 ARE THE BASE BUFFER ADDRESS DIVIDED BY 2
/	BITS 8-11 ARE THE LOGICAL UNIT # ASSIGNED
/W2	IS THE POINTER INTO THE BUFFER
/W3	IS THE COUNT OF THE UNUSED WORDS IN THE BUFFER
/W4	IS THE RELATIVE SEGMENT # WE'RE ON
/W5	BITS 0-3 ARE THE RELATIVE BLOCK BITS
/	BITS 6-11 ARE THE SEQUENCE #
/U0	IS THE ADDRESS OF THE DEVICE QUEUE ROUTINE
/U1	IS THE STARTING (ABSOLUTE) SEGMENT NUMBER OF THE LOGICAL UNIT
/U2	IS THE (-) SIZE OF THE LOGICAL UNIT, IN SEGMENTS

/ROUTINE TO WRITE OUT DATA RECORDS TO JOB'S OUTPUT FILE THAT HE
/OPENED BY CALLING MOUNT.  IT ASSUMES THE RECORD TO BE WRITTEN OUT
/IS IN THE JOB'S RECORD IMAGE BLOCK (BASE+1000) AND THAT THE RECORD
/WORD COUNT IS THE FIRST LOCATION OF THE RECORD.  TO CLOSE THE FILE,
/CALL WRITE WITH THIS WORD COUNT SET TO ZERO.  ANY OTHER NON-NEGATIVE
/WORD COUNT WILL SIMPLY BE OUTPUT TO THE FILE AND CONTROL RETURNED TO
/THE CALLER.
WRITE,	TAD	W0
	SNA CLA			/SELF-PRESERVATION
	HLT			/NO FILE OPEN FOR THIS GUY!
	TAD	W3		/THIS IS AMOUNT OF SPACE LEFT IN BUFFER
	SZA CLA
	JMP	GOAHED		/AS LONG AS THERE IS SOME, GO AHEAD
	PUSHJ			/BUT IF NOT, WRITE OUT CURRENT BUFFER
	GPBUF			/SO WE CAN START ON NEXT
GOAHED,	AC7777
	TAD	BASE		/NOW COMPUTE ADDR OF THIS JOB'S RECORD IMAGE
	TAD	L1000		/IT'S DISPLACED 1000 FROM BASE
	DCA	WRITXR
	UDF
	TAD I	WRITXR		/GET RECORD WORD COUNT
DF214,	DF215
	DCA	TEMP4
	TAD	TEMP4
	SMA			/IF >=0, A SPECIAL THINGIE
	JMP	SPECIL
	CLA CLL
	TAD	L0400		/BUMP ONE BLOCK (WE MUST ANTICIPATE OVERFLOW CONDITION,
				/NOT WAIT TILL IT HAPPENS)
	TAD	W5		/LOW RELATIVE BLOCK BITS
	CLA RAL			/GET ANY CARRY
	TAD	W4		/ADD TO RELATIVE SEGMENT #
	TAD	U2		/SUBTRACT OFF SIZE OF UNIT
	SZA CLA			/ARE WE ON FINAL BLOCK OF THE UNIT?
	JMP	WILFIT		/NOPE - DON'T WORRY ABOUT A THING
	TAD	W3		/GET SPACE LEFT IN BUFFER (-)
	CMA CLL			/CMA TO ALLOW 1 FOR WORD COUNT
	TAD	TEMP4
	TAD	M4		/FOR SAFETY - IN THEORY, WE DON'T NEED THIS...
	SNL CLA			/WILL THIS RECORD COMPLETELY FIT IN THIS LAST BUFFER?
	JMP	WILFIT		/YES, SO PUT IT IN
	AC7777			/NO IT WON'T
	DCA	W3		/SET W3 = -1 TO TRIGGER GPBUF TO OUTPUT
	AC0002			/+2 AS WORD COUNT = END-OF-UNIT
	PUSHJ			/BECAUSE W3 = -1,
	PUTBMP			/THIS WILL CALL GPBUF TO OUTPUT THE BLOCK
	PUSHJ
	IOWAIT			/WAIT TILL IT'S DONE
	PUSHJ
	CLOSE			/RELEASE LOGICAL UNIT
	TAD	L0400		/SET FLAG TO SAY WHO'S CALLING
	JMP I	(INITMT		/CALL MOUNT TO GET NEXT UNIT FOR OUTPUT
				/THEN GO TRY AGAIN (INITMT WILL RETURN TO "GOAHED")

WILFIT,	TAD	TEMP4
	PUSHJ
	PUTBMP			/OUTPUT RECORD WORD COUNT
OUTLUP,	UDF
	TAD I	WRITXR		/GET A WORD OF THE RECORD
DF215,	DF216			/NECESARY FOR PUSHJ, FOLKS
	PUSHJ
	PUTBMP			/OUTPUT THE WORD TO THE BUFFER
	ISZ	TEMP4		/DONE?
	JMP	OUTLUP		/KEEP GOING
	POPJ			/RECORD HAS GONE ON ITS WAY
/COME HERE ON WORD COUNTS >= 0
/A WORD COUNT OF 0 CLOSES THE FILE
/A WORD COUNT > 0 IS JUST SENT OUT, FIGURING IN HAPPY IGNORANCE
/THE GUY KNOWS WHAT HE'S DOING.
/ENTER WITH WORD COUNT IN AC.
SPECIL,	PUSHJ			/OUTPUT IT
	PUTBMP			/WHATEVER IT IS
	TAD	TEMP4
	SZA CLA			/0 FOR EOF?
	POPJ			/IF NOT, GO BACK TO CALLER
	TAD	W4
	DCA	TEMP4		/IF YES, SAVE THIS PAST CALL TO GPBUF
	PUSHJ
	GPBUF			/FORCE OUT FINAL BUFFER
	TAD	TEMP4
	IAC			/BUMP ONE FOR PARTIAL SEGMENT
	DCA	W4		/THIS IS THE NUMBER OF USED SEGMENTS ON THE LOGICAL UNIT
	PUSHJ
	RWBLK0			/GET BLOCK 0 OF UNIT
	AC4000			/AND WRITE IT OUT
	PUSHJ
	RWBLK0			/WITH LENGTH WORD SET
CLOSE,	DCA	W0		/NOW CLEAR ANYTHING ABOUT THIS GUY HAVING A FILE
	TAD	W1
	CLL RAL
	TAD	W1
	AND	L77
	TAD	(UTBASE		/FORM POINTER TO LOGICAL UNIT ENTRY
	DCA	TEMP4
	TAD	HANDLR		/0 IF DOING INQUIRY
	CDF 0
	SZA			/IF INQUIRY, DON'T MESS WITH IT!
	DCA I	TEMP4		/RESTORE VALUE IN LOGICAL UNITS TABLE THAT WE ZAPPED BEFORE
	DCA	HANDLR		/SHOW THAT THIS GUY HAS NO UNIT ASSIGNED
	POPJ			/POPJ DOES CDF

/TWO ROUTINES HERE - PUTBMP AND GPBUF.  PUSHJ TO GPBUF
/TO ACTUALLY OUTPUT A BUFFER AND SWAP THE BUFFER POINTERS,
/UPDATING RELATIVE BLOCKS AND ALL THAT.
/PUSHJ TO PUTBMP TO OUTPUT ONE WORD TO OUTPUT BUFFER, CHECK FOR FULL CONDITION,
/AND TO CALL GPBUF IF IT'S TIME TO WRITE IT OUT.
PUTBMP,	UDF
	DCA I	W2		/PUT THE WORD IN THE BUFFER
	ISZ	W2		/BUMP THE BUFFER POINTER
	NOP
	ISZ	W3		/BUMP THE AMOUNT OF SPACE LEFT IN BUFFER
	POPJ			/IF STILL SOME LEFT
				/IF BUFFER IS FULL, START IT GOING;
DF216,	DF217			/NECESSARY FOR PUSHJ!
GPBUF,	PUSHJ
	IOWAIT			/MAKE SURE NOTHING ELSE IS GOING ON
	TAD	W5		/GET LOW BLOCK BITS
	AND	L7400		/NECESSARY
	DCA	ARG1A
	TAD	U1		/GET STARTING SEGMENT # OF LOGICAL UNIT
	TAD	W4		/ADD DISPLACEMENT WE'RE AT
	DCA	ARG4A
	CLL
	TAD	W5
	TAD	L0400
	DCA	W5		/UPDATE LOW BLOCK BITS
	SZL
	ISZ	W4		/UPDATE HIGH IF NECESSARY
	TAD	W0
	DCA	ARG2A		/R/W, # BLOCKS, FIELD, PHYS UNIT
	JMS	BSWITC		/GET THE
	DCA	ARG3A		/BUFFER ADDRESS
	JMS I	U0		/CALL DEVICE QUEUE TO OUTPUT THE BUFFER
/	ION			/PAGE WAS FULL SOMETHING HAD TO GO
	TAD	L7400
	DCA	W3		/RESET BUFFER EMPTY
	AC4000
	TAD	W1
	DCA	W1
	JMS	BSWITC		/SWITCH THE BUFFERS
	DCA	W2		/RESET THE BUFFER POINTER
	POPJ			/THIS WILL DO THE ION THAT WE TOOK OUT (ABOVE)
BSWITC,	0
	TAD	W1
	CLL RAL
	SZL
	TAD	L0400
	AND	L7600		/REMOVE LOGICAL UNIT #
	JMP I	BSWITC
/
	PAGE


/%BLOCK 14
/***** 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		/COMBINE HIGH & LOW BLOCK #S
	RTL			/PUT BLOCK # IN RIGHT PLACE
	RTL
RKINST,	0			/GO!
	JMP I	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
	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!
	JMP I	(INTXIT		/COME BACK WHEN THE FLAG DOES
RKDSKD,	DCLS			/CLEAR THE FLAG
	TAD I	(DKSTAT
	SNA CLA
	JMP I	(DKDONE		/LINK IS CLEAR AT THIS POINT ( * * * MAKE SURE IT IS! * * * )
	DCA I	(DKSTAT
	TAD I	(DKRETR
RKOVRF,	DCLS			/COME HERE FOR TRACK OVERFLOWS
	TAD	RKINST
	DCA	RKOP2
	DRDA
	AND	(7760
	TAD	L0020
RKOP2,	0
	JMP I	(INTXIT
/
	PAGE

/THIS CODE IS THE STUFF TO ACTUALLY SCHEDULE ALL THE JOBS.  A SUMMARY
/OF IT IS GIVEN HERE.  THE "SLEEP" PART IS WHEN YOU WANT TO DISMISS
/A JOB. THE "INTERRUPT" PART IS WHAT HAPPENS WHEN YOU GET AN INTERRUPT.
/
/SLEEP:	1	IOF, PUSH JOB REGISTERS, SET JOB = "SCHEDULER"
/	2	ION, CHECK FOR FOREGROUND JOB TO RUN
/			YES - 3		NO - 4
/	3	ION, SWAP JOB TABLES
/	3A	IOF, POP JOB REGISTERS
/	3B	IOF, LOAD REGISTERS, START JOB (REGULAR DISMISS)
/	4	CAN BACKGROUND RUN?
/			YES - 5		NO - 2
/	5	SWAP JOB TABLES FOR BACKGROUND
/	6	IOF, SET JOB = BACKGROUND, CHECK FOR RUNNABLE FOREGROUND
/			YES - 2		NO - 3A
/
/
/INTERRUPT:
/	1	SAVE REGISTERS
/	2	CHECK DEVICE FLAGS; IF NONE, GOTO SLEEP(3B)
/	3	PROCESS INTERRUPT
/	4	AND OUT BIT CORRESPONDING TO INTERRUPT FROM THE CORRESPONDING JOB'S MASK
/	5	IF CURRENT JOB IS NOT BACKGROUND, GOTO SLEEP(3B)
/	6	IF CURRENT JOB IS BACKGROUND, GO TO SLEEP(1).

/COME HERE WHEN WE DECIDE CURRENT JOB HAS GOT TO GO
/
DSMSJB,	TAD	INTAC
SLPDSM,	PUSH			/PUT INFO ON CURRENT JOB STACK
	TAD	IFLAGS		/GET THE MAGIC WORD
	PUSH
	TAD	0
	PUSH
SCHED1,	TAD	JOB
	DCA	OLDJOB		/SAVE CURRENT JOB #
	TAD	OLDJOB
	DCA	NEWJOB
SCHDLP,	LAS			/ *** FRILL ***
	DCA	JCNT		/ ***
	TAD I	JCNT		/ ***
	MQL			/ ***
	AC4000			/SET JOB = SCHEDULER
	DCA	JOB
	ION			/WHAT A DUMB THING TO DO...
	TAD	LMJOBS
	DCA	JCNT
FJOBLP,	TAD	NEWJOB
	TAD	LMJOBS
	SNA CLA			/WRAP-AROUND?
	DCA	NEWJOB		/RESTART AT 0 IF SO
	ISZ	NEWJOB		/BUMP TO NEXT JOB TO TRY
	TAD	NEWJOB
	TAD	KJMSKT		/PTR TO JOB MASK TABLE
	DCA	T
	TAD I	T		/GET RESTART CONDITIONS FOR THIS JOB
	SNA CLA			/CAN THIS JOB RUN?
	JMP	RUN		/YES!
	ISZ	JCNT		/LOOKED AT ALL JOBS?
	JMP	FJOBLP		/NOT YET
	DCA	NEWJOB		/SET NEWJOB = BACKGROUND
	TAD I	KJMSKT
	SZA CLA			/CAN JOB 0 BE RUN?
	JMP	SCHDLP		/NOBODY CAN RUN - GO TRY 'EM AGAIN

RUN,	TAD	OLDJOB		/THIS IS JUST OPTOMIZATION SO THAT
	CIA			/IF OLDJOB = NEWJOB
	TAD	NEWJOB		/WE DON'T SWAP IT WITH ITSELF
	SNA CLA
	JMP	TSTBKG		/NO SWAP NECESSARY
	TAD	KCURJB
	DCA	CJPTR
	TAD	OLDJOB
	TAD	KSAVTB
	DCA	XR12
	TAD I	XR12		/GET ADDR OF JOB'S SAVE AREA
	DCA	XR12
	TAD	NEWJOB		/NOW DO SAME FOR NEWJOB
	TAD	KSAVTB
	DCA	XR13
	TAD I	XR13
	DCA	XR13
	TAD	CJSIZE
	DCA	JCNT
SWAPLP,	TAD I	CJPTR		/NOW SWAP OUT OLD JOB, SWAP IN NEW JOB
	DCA I	XR12
	TAD I	XR13
	DCA I	CJPTR
	ISZ	CJPTR
	ISZ	JCNT
	JMP	SWAPLP
TSTBKG,	IOF
	TAD	NEWJOB
	DCA	JOB
	TAD	JOB
	SZA CLA			/ARE WE ABOUT TO RUN BACKGROUND?
	JMP	POPRGS		/NO - GO AHEAD
	TAD	KJMSKT		/WE ARE, SO MAKE FINAL CHECK TO BE SURE
	DCA	XR10		/A FOREGROUND JOB DIDN'T BECOME RUNNABLE
	TAD	LMJOBS		/DURING THE SWAP
	DCA	JCNT

TSTBLP,	TAD I	XR10		/GET RESTART WORD
	SNA CLA
	JMP	SCHED1		/A FOREGROUND JOB IS RUNNABLE...
	ISZ	JCNT
	JMP	TSTBLP
/WE'RE ABOUT TO START UP BACKGROUND...
	ISZ	CTCFLG		/^C SEEN?
	JMP	SBNORM		/NOPE
EZCTC,	TAD	KSTCK0
	DCA	STACK		/CLEAR OUT BACKGROUND STACK
KCIF,	CIF 0			/THERE IS A CDF 0 AT LOCATION 7602 IN FIELD 0
	ION
	JMP I	L7600		/AND REBOOT BACKGROUND
SBNORM,	DCA	CTCFLG
POPRGS,	POP			/GET RESTART ARGS
	DCA	0		/FROM NEW JOB'S STACK
	POP
	DCA	IFLAGS
	POP
	DCA	INTAC
DISMIS,	TAD	IFLAGS	
ECHNGE,	RTF			/AND	L70		** IF NON-8/E
	CLA			/TAD	KCIF		** IF NON-8/E
	TAD	INTAC		/DCA	INTCIF		** IF NON-8/E
	JMP I	0		/TAD	IFLAGS		** IF NON-8/E
	AND	L7		/** EXECUTED IF NON-8/E
	CLL RTL
	RAL
	TAD	LCDF
	DCA	INTCDF
	TAD	IFLAGS
	RAL
	CLA
	TAD	INTAC
INTCDF,	0			/THIS SHOULD COME BEFORE INTCIF
INTCIF,	0
	ION
	JMP I	0
JCNT,	0
T,	0
INTAC,	0
NEWJOB,	0
CJPTR,	0
OLDJOB,	0
KSTCK0,	STACK0-1		/ !
CJSIZE,	CURJOB-CJEND
KCURJB,	CURJOB
KSAVTB,	SAVTBL-1		/ !
CHKER1,	CDF 0;	E20		/"CHECKDIGIT ERROR "
NUMER1,	CDF 0;	E22		/"NOT DECIMAL"

	*5774
INTRPT,	DCA	INTAC		/SAVE AC
	RAR			/COMBINE LINK WITH CDF & CIF IN "IFLAGS"
	RIB
	DCA	IFLAGS
/%BLOCK 15
SKPCHN,	RCSF			/CARD COLUMN?
	SKP CLA
	JMP	CDR
	RCSD			/CARD DONE?
	SKP CLA
	JMP	CDR
DTASKP,	DTSF			/THIS CHANGES IF DIFFERENT DECTAPE
	JMP	DSKSKP
	DTRA
	AND	L0004		/SEE IF IT'S FOR REAL
	SZA CLA			/IS INTERRUPT ENABLED?
	JMP I	TC8INT		/YES - IT'S NOT THAT GREAT HARDWARE "FEATURE"
DSKSKP,	DSKE			/THIS CHANGES IF DIFFERENT DISK ***
	SKP CLA
	JMP I	(RK8ERR
	DSKD			/THIS CHANGES IF DIFFERENT DISK ***
	SKP CLA
	JMP I	(RKDSKD
	JMP I	TTYINT		/CHECK TTY'S BEFORE LPT
LPTSKP,	LSF
	SKP CLA
	JMP	LPT
	RSF
	SKP CLA
	JMP	PTR
	PSF
	SKP CLA
	JMP	PTP
	NOP;NOP;NOP;NOP;NOP;NOP	/PATCH SPACE FOR NEW DEVICES
LPTERR,	LSE			/SKIP ON LPT ERROR (LP08 ONLY)
	JMP I	(DISMIS		/UNDEFINED INTERRUPT?
	6667			/DISABLE LPT  INTERRUPT (LP08 ONLY)
	LCF			/AND CLEAR FLAG
	JMP I	(DISMIS

LPT,	CIF CDF 0
	JMP I	(LPTSRV
PTR,	CIF CDF 0
	JMP I	(PTRSRV
PTP,	CIF CDF 0
	JMP I	(PTPSRV
CDR,	CIF CDF 0
	CDRSRV=0		/!!!!! FOR NOW !!!!!
	JMP I	(CDRSRV
RK5INT,	RK5SRV&177+DKSTRT
RF8BAD,	RF8ERR&177+DKSTRT
RF8INT,	RF8SRV&177+DKSTRT
TTYINT,	TTYSRV
TC8INT,	TC8SRV&177+DTSTRT
T12INT,	T12SRV&177+DTSTRT

UPDBIN,	TAD	UPDLST		/LAST RECORD
	DCA	UPRECB
	TAD	UPDLTH
	DCA	UPRECB+1
	DCA	UPSEED
	PUSHJ			/UPDIF TAKES CARE OF UPSEED+1
	UPDIF			/CHECK FIRST RECORD OUT
	SMA CLA
	JMP I	(UPDNOT		/KEY WE WANT IS LESS THAN A
	TAD	UPRECB
	DCA	UPSEED
	TAD	UPRECB+1
	PUSHJ
	UPDIF
	SPA CLA
	JMP I	(UPDNOT		/GREATER THAN B, NOT IN RANGE
	DCA	UPRECA
OKNEXT,	DCA	UPRECA+1	/A IS FIRST RECORD,B IS LAST
OKNXT2,	TAD	UPRECA
	CIA CLL
	TAD	UPRECB
	DCA	UPSEED
	CML RAL
	TAD	UPRECA+1
	CIA
	TAD	UPRECB+1
	CLL RAR
	DCA	UPSEED+1
	TAD	UPSEED
	RAR
	DCA	UPSEED		/(B-A)/2
	TAD	UPSEED
	SNA
	TAD	UPSEED+1
	SNA CLA
	JMP I	(UPDNOT		/(B-A)/2=0 RECORD NOT FOUND
OKNEW,	CLL
	TAD	UPSEED
	TAD	UPRECA
	DCA	UPSEED
	RAL
	TAD	UPSEED+1
	TAD	UPRECA+1
	DCA	UPSEED+1		/(B-A)/2+A
	TAD	UPSEED+1
	PUSHJ
	UPDIF
	SPA CLA
	JMP	BTWNSB		/BETWEEN SEED AND B
	TAD	UPSEED		/BETWEEN SEED AND A
	DCA	UPRECB
	TAD	UPSEED+1
	DCA	UPRECB+1
	JMP	OKNXT2

BTWNSB,	TAD	UPSEED
	DCA	UPRECA
	TAD	UPSEED+1
	JMP	OKNEXT
RNFUPD,	CDF 0;	E19		/RECORD NOT FOUND
ALPER1,	CDF 0;	E18		/ILLEGAL CHAR IN ALPHA FIELD
LODF,	CDF 0;	E8		/"LABEL OF DATA FILE: "
/
	PAGE

/CODE TO HANDLE INTERRUPTS FOR MULTIPLE TERMINALS
/
TTYSRV,	TAD	KTLST1
	DCA	XR10
	TAD	KTCTS
	DCA	TTCNT
	TAD	KTPTRS
	DCA	TTPNT
	TAD	KJMSKT
	DCA	JMASK
	TAD I	XR10		/GET PROPER IOT
TTLOOP,	DCA	TTTSF
TTTSF,	0
	JMP	NXTTTY		/NOT THIS ONE - TRY NEXT
	TAD	TTTSF
	IAC			/CHANGE TSF TO TCF...
	DCA	TTTCF
	TAD	TTTSF
	TAD	KK5		/AND THEN TO TLS
	DCA	TTTLS
	TAD I	TTCNT
	SMA CLA			/EMPTY BUFFER?
	JMP	TTTCF		/IF SO, JUST CLEAR FLAG
	ISZ I	TTCNT		/DID BUFFER JUST GO EMPTY?
	JMP	TTMORE		/NO - MORE CHARS TO GO
TTTCF,	0
	JMP	INTXIT
TTMORE,	ISZ I	TTPNT		/BUMP BUFFER PTR
	TAD I	TTPNT		/GET BUFFER PTR
	DCA	TTTCF
	TAD I	TTTCF		/GET CHAR FROM BUFFER...
	SPA			/OR IS IT A POINTER?
	DCA	TTTCF		/IF SO, UPDATE POINTER
	CLA
	TAD I	TTTCF		/AND GET CHAR FOR SURE
TTTLS,	0			/AND PRINT IT
	CLA
	TAD	TTTCF		/UPDATE THE PERMANENT PTR NOW
	DCA I	TTPNT
	AC0002			/# OF CHARS TO LEAVE IN BUFFER WHEN CLEARING TTO WAIT
	TAD I	TTCNT
	SZA CLA			/SHOULD WE SET THIS GUY RUNNABLE?
	JMP	INTXIT		/NOT YET
	TAD	TTOBIT
TTYCLR,	CMA
	AND I	JMASK
	DCA I	JMASK
INTXIT,	TAD	JOB
	SZA CLA
	JMP I	(DISMIS		/IF WE SHOULD RESTART CURRENT JOB
	JMP I	(DSMSJB		/OR GO LOOKING FOR A NEW JOB TO RUN

NXTTTY,	ISZ	TTPNT		/BUMP TO NEXT TERMINAL
	ISZ	TTCNT
	ISZ	JMASK
	TAD I	XR10
	SZA			/DONE ALL TTY'S?
	JMP	TTLOOP		/NOT YET
	TAD	KJMSKT		/YES - RESET FOR KBDS
	DCA	JMASK
	AC7777			/SET FLAG FOR BACKGROUND CHECK
	DCA	TTTLS
	TAD I	XR10		/GET KBD IOT
KKLOOP,	DCA	KKKSF
KKKSF,	0			/APPROPRIATE KSF CODE
	JMP	NXTKBD
	TAD	KKKSF
	TAD	KK5		/MAKE KSF INTO KRB
	DCA	KKKRB
KKKRB,	0
	AND	KK177		/TO KEEP PEOPLE WHO OWN PARITY TTYS HAPPY
	ISZ	TTTLS		/ARE WE LOOKING AT BACKGROUND TERMINAL?
	JMP	NOTBKG		/NOPE - DON'T WORRY ABOUT ^C OR ^O
	TAD	(-3
	SNA			/^C?
	JMP I	(GOTCTC		/YUP - DO SOMETHING APPROPRIATE
NOCTC,	TAD	(-14
	CDF 0
	ISZ I	(TICHR
	SZA			/^O?
	JMP	FIXCHR		/NOPE - RESTORE CHARACTER
	ISZ I	(CTRLO
FIXCHR,	TAD	L17
NOTBKG,	TAD	L0200		/TURN ON PARITY BIT
	DCA	KKKSF		/TEMP SAVE CHAR
DF217,	DF218
	TAD	KTTISI
	TAD I	TTCNT
	SNA CLA			/IS THERE ROOM IN BUFFER?
	JMP I	(DISMIS		/NOPE - FORGET CHAR
	AC7777
	TAD I	TTCNT		/BUMP CHAR COUNT
	DCA I	TTCNT
	TAD I	TTPNT
	DCA	KKKRB
	TAD	KKKSF
	DCA I	KKKRB		/PUT THE CHAR AWAY
	ISZ	KKKRB		/& BUMP THE PTR
	TAD I	KKKRB		/NOW CHECK FOR WRAP-AROUND
	SPA
	DCA	KKKRB
	CLA
	TAD	KKKRB		/NOW UPDATE REAL PTR
	DCA I	TTPNT
KBDCLR,	TAD	TTIBIT
	JMP	TTYCLR		/GO CLEAR WAIT BIT
NXTKBD,	ISZ	TTCNT		/BUMP TO NXT KBD
	ISZ	TTPNT
	ISZ	TTTLS		/BUMP BACKGROUND FLAG
KK5,	5			/IT MAY SKIP!
	ISZ	JMASK
	TAD I	XR10
	SZA			/END OF KBDS?
	JMP	KKLOOP		/NOT YET
	JMP I	(LPTSKP		/CONTINUE SKIP CHAIN
TTCNT,	0
TTPNT,	0
JMASK,	0
KTLST1,	TTLIST-1		/ !
KTCTS,	TTCTS			/ !
KTPTRS,	TTPTRS			/ !
KTTISI,	TTISIZ^2		/ !
KK177,	177
/
	PAGE

/%BLOCK 16
/ROUTINE TO CALL FOR KBD INPUT.
/IF JOB'S BUFFER IS EMPTY, JOB IS DISMISSED
/WITH KBD WAIT BIT SET
/
/CALL:	PUSHJ
/	TTICHR
/	(RETURN, CHAR IN AC)
TIWAIT,	TAD	TTIBIT		/GET KBD WAIT BIT
	JMS	SLEEP		/AND DISMISS THE JOB
TTICHR,	IOF			/NO INTERRUPTS FOR DELICATE STUFF
	TAD I	TTICNT
	SMA CLA			/ANY CHARS?
	JMP	TIWAIT		/NOPE - DISMISS CURRENT JOB WITH KBD WAIT CONDITION
	ISZ	TTIGET		/WE COULD DO ION AT THIS POINT, BUT WHY BOTHER?
	TAD I	TTIGET
	SPA			/CHECK FOR BUFFER WRAP-AROUND
	DCA	TTIGET
	CLA
	ISZ I	TTICNT		/BUMP COUNT (MAY SKIP!)
KTTOSI,	TTOSIZ^4		/ ! SEMI-NOP
	TAD I	TTIGET		/GET THE CHAR
	POPJ			/EXIT

/ROUTINE TO CALL FOR TTY OUTPUT.
/IF BUFFER IS FULL, CURRENT JOB IS DISMISSED UNTIL SOME PERCENTAGE OF
/BUFFER IS EMPTY.  RE-ENTRANT CODE!
/
/CALL:	TAD	CHAR
/	PUSHJ
/	TTOCHR
/	(RETURN, AC=0)
TTOCHR,	AND	L377		/SELF PRESERVATION
	DCA I	TTOPUT		/PUT CHAR IN BUFFER (AT LEAST ONE FREE LOC)
TTOGO,	TAD	KTTOSI
	IOF
	TAD I	TTOCNT
	SNA CLA			/IS BUFFER FULL?
	JMP	TTWAIT		/YES - DISMISS THE JOB
	CLA CLL CMA
	TAD I	TTOCNT		/BUMP DOWN COUNT
	DCA I	TTOCNT
	TAD	TTOTLS		/GET PROPER IOT
	DCA	TLSIOT
	TAD I	TTOPUT
	SNL			/IS PRINTER QUIET?
SLPTMP,
TLSIOT,	0			/PRINT CHAR IF SO
				/COULD DO ION HERE...
	SZL CLA			/DID WE PRINT CHAR?
	ISZ	TTOPUT		/NOPE, SO BUMP PTR
	TAD I	TTOPUT
	SPA			/CHECK FOR  BUFFER WRAP-AROUND
	DCA	TTOPUT
	CLA CLL			/MUST HAVE LINK 0
	POPJ
TTWAIT,	TAD	TTOBIT		/GET TTO WAIT BIT
	JMS	SLEEP		/AND DISMISS THE JOB
	JMP	TTOGO

/CALL THIS TO DISMISS A JOB.  POSSIBLY SET A WAIT CONDITION
/BEFORE DOING SO.  CALL WITH IOF AND WAIT CONDITION IN AC
/
TABORT,
IODEV,
SLEEP,	0
	DCA	SLPTMP		/SAVE WAIT CONDITION BIT IN AC
	RDF
	CLL RTR
	RAR
	RDF
DF218,	DF219			/SET CURRENT FIELD
	DCA	IFLAGS
	TAD	SLEEP		/GET RESTART ADDRESS
	DCA	0
	TAD	SLPTMP
	DCA I	MASK		/SET JOB'S RESTART CONDITION
	JMP I	(SLPDSM
GOTCTC,	CDF 0
	DCA I	(TF0		/KILL BACKGROUND BATCH JOB (IF ANY)
	TAD I	(CTCZAP		/EITHER "SKP" OR "SNA"
DF219,	DF220			/SKP MEANS PASS ^C'S TO BACKGROUND; SNA MEANS DO REAL ^C BOOT
BSW206,	BSW207			/THINK ABOUT THIS ONE FOR A WHILE
	SMA CLA
	JMP I	(NOCTC		/PASS ^C'S TO BACKGROUND
	TAD	JOB		/DO A ^C BOOT OF BACKGROUND
	SNA CLA			/IS BACKGROUND RUNNING?
	JMP I	(EZCTC		/YES - AN EASY TASK
	AC7777
	DCA	CTCFLG		/SET ^C FLAG FOR WHEN WE RESTART BACKGROUND
	JMP I	(KBDCLR		/CLEAR ANY PENDING TTI WAITS

/ROUTINE TO WAIT FOR I/O TO COMPLETE
/CALL WITH PUSHJ TO IOWAIT
/RETURNS AC = 0 IF OK OR GOES TO "START" IF FATAL ERROR
IOERR,	DCA I	T5		/CLEAR ERROR BIT
	TAD	(IOERMG
	PUSHJ
	MESYES			/"I/O ERROR; RETRY? "
	SZA CLA
	JMP I	KABORT		/CLEAR STACK AND RETURN TO "START"
	TAD	ARG1A
	AND	L0010
	SZA CLA			/DISK OR DTA?
	TAD	(DTAQ-DSKQ
	TAD	(DSKQ
	DCA	IODEV
	JMS I	IODEV
IOWAIT,	TAD	JOB
	TAD	KDWAIT
	DCA	T5
	IOF
	TAD I	T5
	SNA			/DONE?
	JMP	CLR		/YUP - GO AWAY
	SPA CLA			/ERROR OR PENDING?
	JMP	IOERR		/ERROR...
	TAD	DDDBIT
	JMS	SLEEP		/GO AWAY UNTIL OPERATION COMPLETE
	JMP	IOWAIT		/AND GO CHECK IT AGAIN
CLR,	TAD	ARG1A
	AND	L7400		/MUST CLEAR OUT ANY THING TO DO WITH DECTAPES
	DCA	ARG1A
	POPJ

OUTP,	PUSHJ
	NEWFRM
	PUSHJ
	WRITE
	JMP	OUTP
CLRSTK,	0			/ROUTINE TO CLEAR OUT A JOB'S STACK
	CLA CLL
	TAD	JOB
	CIA
	DCA	TABORT
	TAD	(STKSIZ		/COMPUTE WHERE BASE OF JOB'S STACK IS
	ISZ	TABORT
	JMP	.-2
	TAD	KSTK01
	DCA	STACK		/AND RESET STACK POINTER TO THAT (CLEAR THE STACK)
	JMP I	CLRSTK
KSTK01,	STACK0-1		/ !
LINMES,	CDF 0;	E23		/"REWIND?"
NUMER2,	CDF 0;	E24		/CHARACTER AFTER "-"
ALPER2,	CDF 0;	E21		/FIELD OVERFLOW
/
	PAGE

/THE POP, PUSHJ, AND POPJ ROUTINES.  EACH JOB'S STACK POINTER
/IS IN ITS OWN AREA, AND GETS SWAPPED WITH THE JOB.  THE ACTUAL STACKS
/NEVER MOVE.  NOTE COMMENTS ON EACH ROUTINE.
/ROUTINE TO POP TOP ITEM FROM CURRENT STACK INTO AC.
/MUST BE CALLED WITH CDF = POPX FIELD!
/ROUTINE PRESERVES THE LINK...THIS IS NECESSARY.
/
POPX,	0			/TIME: 17 CYCLES INCLUDING CALL
	TAD	STACK
	DCA	TPOP
	CMA CML
	TAD	STACK
	DCA	STACK
	TAD I	TPOP
	JMP I	POPX
/PUSHJ AND POPJ FOR 15-BIT ADDRESSES.  THE SUBROUTINES CALLED
/BY PUSHJ (AND THEREFORE EXITED BY POPJ) MUST BE IN SAME FIELD AS
/THEY ARE.  BUT PUSHJ MAY BE CALLED FROM ANY FIELD.  THE AC AND
/LINK ARE PRESERVED THROUGH THE CALLS.
/PUSHJ CALL:
/	CDF CURRENT FIELD
/	CIF PUSHJ FIELD
/	IOF		(IF CALLING FROM BACKGROUND)
/	PUSHJ
/	(ADDRESS OF SUBROUTINE TO CALL)
/	(RETURN)
/
BSWT,
PUSHJX,	0			/TIME: 38 CYCLES INCLUDING CALL
	DCA	PPAC
	TAD I	PUSHJX
	DCA	POPCDF
	RDF
	TAD	CICDF0
DF220,	DF221			/CURRENT FIELD CDF (GETS SET UP) *****
	PUSH
	TAD	PUSHJX
	IAC
	PUSH
	TAD	PPAC
	ION			/NECESSARY IF CALLED FROM BACKGROUND
	JMP I	POPCDF

/POPJ IS SIMPLY JUMPED TO WITH EITHER ION OR IOF
/MAKE SURE CDF = POPJ FIELD!
/
POPJX,	IOF			/TIME: 48 CYCLES INCLUDING CALL
	DCA	PPAC		/IOF IS NECESSARY FOR BACKGROUND
DF221,	DF222			/SELF-PRESERVATION
	JMS	POPX		/SAVE A CYCLE
	DCA	PUSHJX
	JMS	POPX		/SAVE ANOTHER
	DCA	POPCDF
TPOP,
POPCDF,	0			/CIF CDF
	TAD	PPAC
	ION
	JMP I	PUSHJX
/BYTE SWAP SIMULATION FOR NON-8/E'S.
/THANKS TO HJ & SR AT 11:30 PM SATURDAY NIGHT
/AND THEN TO THE WIZARD, WHO DID THE IMPOSSIBLE (AGAIN)
/AND GOT OUT ONE MORE LOCATION.
/IT PRESERVES THE LINK.
/.....YOU FIGURE IT OUT
PPAC,
BSWX,	0
	DCA	BSWT
	RTR
	RTR
	RTR
	TAD	BSWT
	AND	L7700
	TAD	BSWT
	RTL
	RTL
	RTL
	JMP I	BSWX

/ROUTINE TO PRINT TEXT ON CURRENT JOB TERMINAL.  POSITION
/CURSOR BEFORE CALLING.
/THE TEXT MUST BE IN PACKED -237 ASCII WITH 6 BITS OF 0
/AS THE FINAL CHARACTER.  CALL WITH A POINTER TO TWO WORDS IN
/THE AC, THE TWO WORDS BEING THE CDF AND ADDRESS OF THE TEXT.
/CALL:
/	TAD	(PARAM		PARAM,	CDF X	/CDF TEXT
/	CIF N				TXTABC	/ADDR OF TEXT
/	CDF CURRENT
/	PUSHJ				TXTABC,	AB
/	PRINT					C0
/	(RETURN)
/
/PARAM BLOCK MUST BE IN FGM FIELD.  THERE ARE ALSO TWO KLUDGES HERE SO
/PRINT CAN BE CALLED FROM THE USER FIELD WITHOUT HAVING A PARAMETER
/BLOCK.  DO A PUSHJ TO USRPRT, AND THEN THE ROUTINE ASSUMES THE USER
/CDF AND ASSUMES THE CONTENTS OF THE AC TO BE A POINTER TO THE MESSAGE.
/DO A PUSHJ TO FAKEIT IF TEXT IS IN FGM FIELD AND ACTUAL
/POINTER TO TEXT IS IN AC.
FAKEIT,	DCA	T1		/ENTER HERE FOR KLUDGE #2
	TAD	DF220		/WHEN CDF = FGM
	JMP	CROCK		/BUT PTR IS IN AC
USRPRT,	DCA	T1		/ENTER HERE FOR USER FIELD KLUDGE
	TAD	USRCDF
CROCK,	DCA	T2
	JMP	USRPT2

/ROUTINES TO POSITION CURSOR AT ROW 20, COLUMN 1, CLEAR THE
/LINE, BEEP THE BELL, AND PRINT TEXT POINTED TO BY ARG IN AC.
/PUSHJ TO ROW20 TO POSITION CURSOR AND CLEAR LINE BEFORE PRINTING.
/IF AC = 0, ROW 20 IS SIMPLY CLEARED.  PUSHJ TO CRWAIT TO WAIT
/FOR A CARRIAGE RETURN BEFORE CLEARING THE LINE.
/PUSHJ TO PRINT TO OUTPUT TEXT AT CURRENT CURSOR POSITON.
CRDING,	TAD	L7
	PUSHJ			/RING BELL ON IDIOCY
	TTOCHR
CRWAIT,	PUSHJ			/WAITS FOR A CAR. RET.
	TTICHR
	TAD	(-215
	SZA CLA
	JMP	CRDING
ROW20,	PUSH			/SAVE ARG PTR (IF ANY)
	TAD	(RCERR		/CLEAR OUT LINE 20
	PUSHJ
	CAD
	TAD	L237		/EOS (SAME AS EOL HERE)
	PUSHJ
	TTOCHR
	TAD	L7		/JUST AS GOOD AS 207
	PUSHJ
KTTOCH,	TTOCHR			/BEEP THE BELL (?)
	POP			/GET ARG PTR BACK
	SNA			/WAS THERE ONE?
	POPJ			/NOPE - NO MESSAGE
PRINT,	DCA	T1		/SAVE PTR TO PARAMS
	TAD I	T1		/GET CDF OF TEXT
	ISZ	T1
	DCA	T2
	TAD I	T1		/GET ADDR OF TEXT
	DCA	T1
USRPT2,	DCA	T3		/ZERO CHAR CNT
PRNTLP,	TAD	T2		/GET CDF
	DCA	TXTCDF		/WE MUST RESET THIS EACH TIME THRU
TXTPTR,
TXTCDF,	0			/CDF TEXT FIELD
	TAD	T3		/GET CHAR CNT
	CLL RAR			/MAKE IT WORD CNT
	TAD	T1		/ADD BASE ADDR
	DCA	TXTPTR
	TAD I	TXTPTR		/GET THE WORD
DF222,	DF223			/CDF N (GETS SET UP) *****
	SNL			/LINK TELLS WHICH HALF
BSW205,	BSW206
	AND	L77
	SNA			/DONE?
	POPJ			/YUP
	TAD	L237
	PUSHJ
	TTOCHR
	ISZ	T3		/BUMP CHAR PTR
	JMP	PRNTLP

/ROUTINE TO PRINT "CONFIRM:" ON TERMINAL AND WAIT FOR Y BEFORE RESTARTING A JOB..
/CALL WITH PUSHJ
CONFRM,	TAD	L7774		/CNFMSG DISGUISE
MESYES,	PUSHJ			/TYPE MESSAGE, THEN GOTO YESNO THEN RETURN
	ROW20			/"CONFIRM: "
				/FALL INTO YESNO WITH AC = 0   * * *
/ROUTINE TO CHECK IF Y FOLLOWED BY CAR.. RET. IS TYPED..
/ONLY THE LAST CHAR BEFORE THE CAR RET IS LOOKED AT
/SO TYPING YES<CAR.RET.> WOULD BE TAKEN AS TYPING S<CAR..RET.>
/RETURNS AC = 0 IF Y, OR AC NON-0 IF NOT Y.
/
YESNO2,	TAD	(215-240
YESNO,	CLL
	TAD	L0040
	DCA	T6
	SNL
	TAD	T6
	PUSHJ
	TTOCHR
	PUSHJ
	TTICHR
	TAD	(-215
	SZA
	JMP	YESNO2
	PUSHJ
	ROW20			/AND CLEAR OUT THE LINE
	TAD	T6
	TAD	(-131
	POPJ
IOERMG,	CDF 0;	E15		/"I/O ERROR; RETRY? "
ALPER3,	CDF 0;	E28		/"NOT #"
/
	PAGE

/%BLOCK 17
/QUEUEING DISK HANDLER FOR COS 300 FOREGROUND/BACKGROUND
/CALL DSKQ TO QUEUE A REQUEST.  THIS CODE LIVES IN FIELD X, WHERE
/X IS UNKNOWN AND IS THE FOREGROUND MONITER FIELD.
/CALL:
/	TAD	(PARAM-1		PARAM,	LOW BLOCK #
/	CDF	CURRENT				R/W,LEN,F,U
/	CIF	DSKQ FIELD			ADDR
/	IOF (IF CALLED FROM THE BACKGROUND)	HIGH BLOCK #
/	JMS	DSKQ
/	(RETURN, AC=0
/	AND WITH  I O F !)
DSKQ,	0			/ONLY BACKGROUND SHOULD CALL DSKQ WITH AC NON-0
	IOF
	CLL
	SZA			/BECAUSE ERROR RECOVERY WON'T WORK IF FOREGROUND JOBS DO IT
	JMP	.+3
	CML
	TAD	PARG1A		/IF AC = 0, ASSUME ARGS ARE IN ARG1A-ARG4A
	DCA	XR10		/SAVE PTR TO PARAMS
	RDF
	TAD	CICDF0
	DCA	DKQXIT
	SZL
DF227,	DF228
	RDF			/GET PARAMS CDF
	TAD	LCDF
	DCA	DKARGF
	TAD	M4
	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
DF223,	DF224			/CDF CURRENT FIELD (GETS SET UP) *****
	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	KDWAIT
	DCA	DKNEXT
	ISZ 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	DKQXIT		/REQUEST WE JUST PUT ON THE QUEUE
	JMS	DKNEXT		/SO IF THAT'S THE CASE, GET IT OFF
	JMS I	CDKSTR		/AND START IT GOING
DKQXIT,	0			/OUR GETAWAY ROUTE, REMEMBER?
	JMP I	DSKQ
PARG1A,	ARG1A-1
CDKSTR,	DKSTRT
/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	PDKARG
	DCA	XR10
	TAD	M4
	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
	JMP I	DKNEXT
PDKARG,	DKARG1-1

/COME HERE ON DISK ERRORS, OR ON DISK DONE
DKERR,	CLL CML
DKDONE,	TAD	DKJOB		/LINK = 0 IF ENTRY AT DKDONE
	TAD	KDWAIT
	DCA	DKTMP
	RAR			/0 IF OK OR 4000 IF ERROR
	DCA I	DKTMP		/SET JOB'S PENDING WORD
	TAD	DKJOB
	TAD	KJMSKT
	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
	JMP I	PINTXT		/NO - GO AWAY
	JMS	DKNEXT		/GET NEXT REQUEST FROM THE QUEUE
DKRETR,	JMS I	PDKSTR		/AND START IT GOING
	JMP I	PINTXT		/AND THEN GO AWAY
/
DKQPUT,	DKQ0			/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,	DKQ0			/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
PINTXT,	INTXIT
PDKSTR,	DKSTRT
/THE DISK QUEUE; 6 SLOTS + CURRENT OPERATION
/MEANS QUEUE CAN NEVER OVERFLOW (SPACE FOR 1 REQUEST BY 7 JOBS)
DKQ0,	ZBLOCK 4; DKQ1
DKQ1,	ZBLOCK 4; DKQ2
DKQ2,	ZBLOCK 4; DKQ3
DKQ3,	ZBLOCK 4; DKQ4
DKQ4,	ZBLOCK 4; DKQ5

/THE ROUTINE READ IS USED BY UPDATE TO READ IF NECESSESARY
/FROM AN OPEN FILE AND RETURN A POINTER TO THE REQUESTED RECORD
/AND IF PREVIOUS BUFFER WAS WRITTEN INTO IT WILL WRITE IT OUT ONTO
/THE USERS FILE
/
/	CALL:	TAD	XYZ
/		PUSHJ
/		READ
/		DCA	PTFD		/THIS IS ONE EXAMPLE OF A CALL
KM14,	-14
READ,	DCA	UPSEED+1	/PUT IT HERE TO SAVE CODE
	TAD	UPDSIZ
	CIA
	CLL IAC
	DCA	T1		/# OF WORDS/RECORD +1 (FOR W.C.)
	TAD	KM14		/-12 DECIMAL
	DCA	T6
	DCA	TEMP4
	DCA	TEMP5
READL,	TAD	TEMP4
	RAL
	DCA	TEMP4
	TAD	TEMP5
	RAL
	DCA	TEMP5
	TAD	T1
	CLL RAL
	DCA	T1		/THIS LOOP SHOULD MULTIPLY RECORD NUMBER
	SNL			/BY RECORD SIZE.
	JMP	READ2		/NO NEED TO ADD
	TAD	UPSEED
	TAD	TEMP4
	DCA	TEMP4
	CML RAL			/LINK WAS 1
	TAD	UPSEED+1
	TAD	TEMP5
	DCA	TEMP5
READ2,	ISZ	T6
	JMP	READL
	TAD	TEMP4
	TAD	L0400
	DCA	TEMP4		/FIRST BLOCK IS THE LABLE
	SZL
	ISZ	TEMP5		/IF OVERFLOW FROM TEMP4
	TAD	ARG4A		/H.O. IN
	CMA
	TAD	TEMP5		/H.O. WANTED
	TAD	U1		/AND THE BASE DISPLACEMENT
	DCA	TEMP3		/H.O. WANTED-IN-1
	TAD	ARG1A
	AND	L7400		/L.O. IN
	CIA
	CLL
	TAD	TEMP4		/L.O. WANTED
	SZL			/CARRY?
	ISZ	TEMP3		/YES, BUMP TEMP3 (H.O.)
UP7000,	7000			/NOP
	DCA	TEMP
	TAD	TEMP
	AND	UP7000		/SEE IF ON 1000 WORD BOUNDRY
	SNA
	TAD	TEMP3
	SZA CLA
	JMP	MOVWDO		/NOT IN THE WINDOW
	TAD	UPDSIZ
	CIA
	IAC			/SIZE OF THE RECORD
	TAD	TEMP
	AND	UP7000		/SEE IF THE END OF THE RECORD IS OUT OF THE BUFFER
	SNA CLA
	JMP	INWNDO		/ITS IN THE WINDOW
MOVWDO,	AC3777
	AND	UPDWRT
	SZA CLA			/DO WE NEED TO DO A WRITE?
	JMP	JSREAD		/NO, JUST READ
WRTWDO,	AC0002
	DCA	UPDWRT		/FLAG IT
	AC4000
	TAD	ARG2A
	DCA	ARG2A		/DO A WRITE ON THE LAST READ ARGUMENTS
	JMS I	U0		/WRITE OUT THE BUFFERS
	PUSHJ
	IOWAIT			/I MUST WAIT FOR THE DISK
JSREAD,	TAD	TEMP4
	AND	L7400
	DCA	ARG1A
	TAD	TEMP5
	TAD	U1
	DCA	ARG4A
	TAD	U1
	CIA
	TAD	U2		/-SEGMENT # -1 OF LAST SEGMENT
	TAD	ARG4A
	IAC
	CLL
	SNA CLA			/IF 0 WERE ON THE LAST SEGMENT
	TAD	L0400
	TAD	ARG1A		/IF LAST BLOCK OF LAST SEGMENT LINK = 1
	CLA
	TAD	ARG2A
	AND	L77
	SNL
	TAD	L0200		/READ TWO BLOCKS
	TAD	L0200		/READ ONLY ONE BLOCK
	DCA	ARG2A
	JMS I	U0
	PUSHJ
	IOWAIT			/MUST WAIT AGAIN
INWNDO,	TAD	ARG1A
	CIA
	TAD	TEMP4
	AND	K777
	TAD	BASE
	TAD	L1400
	UDF
	DCA	TEMP		/POINT TO RECORD
	TAD I	TEMP		/SEE IF + W.C. (ONLY IN BINARY SEARCH WOULD IT HAPPEN)
	SMA CLA			/ANY POSITIVE WORD COUNT  MEANS END-OF-UNIT TO US
	POPJ
	AC7777
	TAD TEMP
	POPJ
K777,	777

/ROUTINE TO READ OR WRITE BLOCK 0 OF A LOGICAL UNIT
/INTO PAGE 0 OF A JOB'S I/O BUFFER AREA
/TO WRITE, ENTER ROUTINE WITH AC = 4000
/
RW6,	6
RWBLK0,	TAD	L77		/GET FIELD AND PHYSICAL UNIT #
	AND	W0		/MAKE SURE W0 HAS THE BITS SET UP RIGHT!
	TAD	L100		/ONE-PAGE TRANSFER
	DCA	ARG2A
	DCA	ARG1A		/CLEAR ANY RANDOM BITS HERE
	TAD	U1		/U1 IS STARTING SEGMENT #
	DCA	ARG4A
	TAD	L1400		/OFFSET TO I/O BUFFERS
	TAD	BASE
	DCA	ARG3A
	TAD	ARG3A
	TAD	RW6		/FORM PTR TO LENGTH SPOT IN UNIT LABEL
	DCA	T6
	PUSHJ
RWIOWT,	IOWAIT			/WE MAY HAVE BEEN CALLED RIGHT AFTER GPBUF!
	TAD	W4		/GET RELATIVE SEGMENT #
	UDF			/SET USER CDF
	DCA I	T6		/STORE # OF SEGMENTS USED IN LABEL
DF224,	DF225
	JMS I	U0		/CALL THE DEVICE HANDLER
	JMP I	RWIOWT		/POPJ FROM IOWAIT WILL POPJ US FROM RWBLK0

UPDIFN,	AC7776
/%BLOCK 20
	TAD	STACK
	DCA	STACK		/DO A FAKE POPJ
	DCA	UPSEED		/REWIND HIS FILE FOR HIM
	DCA	UPSEED+1
UPDNOT,	TAD	UPDRNF		/RECORD NOT FOUND
	PUSHJ
	MESYES
	CLA CLL			/CLEAR OUT WHATEVER
UPDT,	DCA	UPDDIS		/CLEAR OUT DISPLACEMENT
	PUSHJ
	LISTIT			/LIST OLD KEY
	TAD	PUPDKY
	PUSHJ
	MESYES			/NEW KEY?
	SZA
	JMP	NOKEY
UPDTBR,	DCA	UPDDIS		/CLEAR IT HERE TOO (REDUNDANT IF IN LINEAR SEARCH MODE)
	TAD	BASE
	TAD	L1000		/RECORD IMMAGE IS BASE+1000
	DCA	XR14
	TAD	UPDSIZ
	DCA	MCHRCT
	UDF
	TAD	C4040		/FILL TO WILDCARDS ("??")
	DCA I	XR14		/ZERO OUT RECORD IMMAGE TO NULLS
	ISZ	MCHRCT
	JMP	.-3
DF225,	DF226
	PUSHJ
	LISTIT			/LIST WILDCARDS ("??")
	TAD	UPDWRT
	CLL CML RAR		/MAKE IT "-" (THIS IS WHY THE FLAG CANNOT BE SET WITH AN ISZ)
	DCA	UPDWRT
	PUSHJ
	ESCAPE			/FILL IN THE KEY
	TAD	UPDWRT
	CLL RAL			/RESTORE ALL BUT BIT 11 OF UPDWRT
	DCA	UPDWRT		/RESTORE STATUS
NOKEY,	TAD	L77		/ +Y - ^Z IN DISGUISE
	SZA CLA
	JMP	UPDTL3
UPDCLO,	DCA	TEMP4
	DCA	TEMP5		/THIS WILL FORCE A READ OF BLOCK 0 (TEMP5 IS SOME RANDOM NUMBER HERE, 
				/IF WE DONT CLEAR IT WE WILL POSSIBLY TRY TO READ SEGMENT 2212)
	PUSHJ			/^Z CLOSE OUT THE FILE
	MOVWDO			/MOVE WINDOW ONTO ITSELF (WRITES IF NEEDED)
	JMP I	KABORT		/ABORT MUST CLEAR THE AC
UPDRNF,	RNFUPD
UPDTL3,	POP			/THE ADDRESS OF WHERE WE WANT TO GO IS ON THE BOTTOM OF THE STACK
				/OR 1 LEVEL DEEPER THAN WE ARE NOW
				/FETCH UPDBIN OR UPDLIN
	ISZ	STACK		/RESTORE STACK
	DCA	TEMP
	JMP I	TEMP		/AND JUMP THERE

UPDLIN,	TAD	PLINMS
	PUSHJ
	MESYES			/REWIND?
	SZA CLA
	JMP	UPLIN2
	DCA	UPSEED
	JMP	UPLIN3
UPLIN2,	ISZ	UPSEED
	SKP CLA
	AC0001
	TAD	UPSEED+1
UPLIN3,	PUSHJ
GUPDT,	UPDIF
	JMP	UPLIN2		/AND KEEP GOING. UPDIF WILL TAKE CARE OF E.O.F.
PUPDKY,	UPDKEY
PLINMS,	LINMES
C4040,	4040

/DEFINITIONS OF SWAP AREAS FOR SINGLE FOREGROUND JOB RUNNING.
/THESE AREAS ARE USED INSTEAD OF THE ONES BEGINNING AT "J0SAVE"
/AND THE SPACE BEGINNING AT "J0SAVE" IS USED FOR JOB 1'S BUFFERS.
J0SV1J, 0
	0
	STK01J+2
TLS01J, TLS0
	OBF01J
	IBF01J-1
	TCTS1J
	TCTS1J+1+1
BAS01J,	0		/BASE ADDR OF JOB 0, NOT USED
	ZBLOCK MASK-BASE-1
MSK01J,	JMSK1J
	ZBLOCK USRCDF-MASK-1
U0DF1J, 0		/CDF USER AREA, NOT USED
/
J1SV1J, 0
	0
	STK11J+2
TLS11J, TLS1
	OBF11J
	IBF11J-1
	TCTS1J+1
	TCTS1J+1+1+1
BAS11J,	J0SAVE		/BASE ADDR OF JOB 1
	ZBLOCK MASK-BASE-1
MSK11J,	JMSK1J+1
	ZBLOCK USRCDF-MASK-1
DF226,
U1DF1J,	DF227

STK01J,	0			/WE KNOW THAT STACK 0 WILL NOT HAVE MORE THAN 5 ENTRIES
	0			/CIF CDF 0
	7600
	ZBLOCK STKSIZ-3-2-16	/ 3 FOR SLEEP
				/ 2 FOR A PUSHJ
				/ 16 FOR STOLEN SPACE AT END OF STACK
JMSK1J,	0+OFFBIT		/RESTART CONDITION WORDS FOR ALL JOBS IN EXTRA STACK 0 SPACE
	0+OFFBIT
UNDFMG,	CDF 0;	E5		/"UNDEFINED UNIT"
ILLUNT,	CDF 0;	E6		/"ILLEGAL UNIT #"
INUSMG,	CDF 0;	E2		/"IN USE"
ITTRF,	CDF 0;	E10		/"IS THIS THE RIGHT FILE?"
TPTR1J,	OBF01J-1		/TTY OUTPUT "GET" PTRS
	OBF11J-1
	IBF01J			/KBD INPUT "PUT" PTRS
	IBF11J
DDWA1J,	0			/MASS STORAGE "REQUESTS PENDING" FOR EACH JOB
	0			/ 0 = DONE
				/ + = OPERATION PENDING
				/ - = ERROR
STK11J,	0
	ID210=	0
ID207,	ID210
	START
	ZBLOCK STKSIZ-3
TTLI1J,	TSF0			/TABLE OF IOTS
	TSF1
	0
	KSF0
	KSF1
	0
SVTB1J,	J01J,	J0SV1J-1	/THE ADDRESS OF EACH JOB'S SAVE AREA
	J11J,	J1SV1J-1
TCTS1J,	0			/COUNTERS FOR OUTPUT BUFFERS
	0
	0			/COUNTERS FOR INPUT BUFFERS
	0
OBF01J,	ZBLOCK TTOSIZ;OBF01J	/TTY OUTPUT BUFFERS
OBF11J,	ZBLOCK TTOSIZ;OBF11J
IBF01J,	ZBLOCK TTISIZ;IBF01J	/KBD INPUT BUFFERS
IBF11J,	ZBLOCK TTISIZ;IBF11J

/FILE LABEL FOR EACH JOB'S FILE GOES HERE
/JOB ZERO DOESN'T HAVE ONE - IT USES FIELD ZERO'S MOUNT AND RDOIO
/
LAB11J,	ZBLOCK 3
	0104			/" #"
SEQ11J,	0			/"XX"	(SEQUENCE #)
	0100			/0 FOR BENEFIT OF PRINT ROUTINE
	IFZERO .+3&4000 <???>	/ERROR! OVERLAYING MESSAGE POINTERS
	*7774
CNFMSG,	CDF 0;	E14		/"CONFIRM: "
BINLIN,	CDF 0;	E26		/"BINARY OR LINEAR SEARCH?"
	IFNZRO CNFMSG-7774 <???> /ERROR
	IFNZRO BINLIN-7776 <???> /ERROR
/	END OF FGBG4.PA
	$-$-$