/COS 300 FOREGROUND/BACKGROUND		EDITED 10/9/73
/COPYRIGHT 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASSACHUSETTS  01754
/SGW&JGD
/
/LIBRARY #S:
/DECTAPE:	DEC-08-OCFBA-A-UB
/RK05:		DEC-08-OCFBA-A-HB
/
/THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
/ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION
/OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXECPT
/AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
	DECIMAL
	YEAR=	73		/FOR
	MONTH=	10		/VERSION #
	OCTAL
	LEVEL=	"A-237^100

/THIS SYSTEM PERMITS SEVERAL TERMINALS TO BE DOING DATA ENTRY IN
/THE FOREGROUND WHILE A REGULAR COS 300 JOB IS GRINDING AWAY
/IN THE BACKGROUND.  ALL FOREGROUND JOBS HAVE EQUAL PRIORITY; THE
/BACKGROUND JOB RUNS ONLY WHEN NO FOREGROUND JOB CAN.  ALL FOREGROUND
/JOBS RUN TO AN I/O WAIT CONDITION OR UNTIL THEY SWAP THEMSELVES OUT.
/A FOREGROUND JOB CANNOT BE INTERRUPTED UNTIL IT DECIDES IT WANTS
/TO BE.  THE BACKGROUND CAN BE INTERRUPTED AT ANY TIME.  THE CODE
/FOR THE FOREGROUND JOB LIVES IN THE HIGHEST MEMORY FIELD OF
/THE MACHINE.  DATA BUFFERS FOR THE SEVERAL FOREGROUND JOBS ARE
/ALLOCATED AT 1/3 FIELD PER JOB, FROM THE NEXT LOWER FIELD(S).
/THE BACKGROUND GETS FIELDS 0 AND 1 PLUS ANY FULL FIELDS NOT USED
/BY THE FOREGROUND JOBS.
/
/ONE GROOVINESS TO NOTE IN THE CODE; ALL THE "CURRENT FIELD CDF"
/INSTRUCTIONS ARE CHAINED TOGETHER, ONE POINTING TO THE NEXT, AND AT
/INITIALIZATION TIME THE STARTUP CODE ZIPS THROUGH AND PUTS
/IN THE CORRECT CDF.  (IDEA COURTESY OF THE WIZARD)
/IF YOU CHANGE THOSE POINTERS, MAKE SURE YOU UNDERSTAND THEM
/BECAUSE SOME APPEAR TO BE COMPLETELY WRONG BECAUSE OF VARIOUS
/STRANGE "NOPUNCH" ORIGINS AND OFFSETS.
/
/THIS CODE IS SEMI-RE-ENTRANT.  AS FAR AS THE BACKGROUND JOB GOES,
/ANYTHING IT CALLS CAN BE INTERRUPTED AT ANY TIME .  ESPECIALLY,
/THE BACKGROUND MUST CALL PUSHJ WITH IOF.  THE FOREGROUND JOB CAN
/CALL PUSHJ WITH ION.  IN GENERAL, AS LONG AS A ROUTINE DOES NO I/O,
/THE FOREGROUND JOB CAN CALL IT WITH ION AND A JMS.  THE BACKGROUND
/MUST GENERALLY CALL ANY ROUTINE WITH IOF.
/
/THE FOREGROUND/BACKGROUND SYSTEM IS LOADED FROM REGULAR COS 300 BY
/SAYING ".RUN FGBG[/N]", THE OPTIONAL SWITCH BEING
/THE NUMBER OF FOREGROUND JOBS TO START UP.  IF THE SWITCH IS OMITTED,
/ONE IS ASSUMED.  THE STARTUP CODE IN FIELD 0 SEES HOW MUCH CORE IS 
/AVAILABLE, FIGURES OUT HOW MUCH IT NEEDS TO RUN THE NUMBER OF JOBS
/REQUESTED, AND ALLOCATES SPACE TO EACH JOB.  IF ONLY A SINGLE
/FOREGROUND JOB IS ACTIVE, IT PUTS HIM (WITH PAIN) IN THE FIELD WITH THE FG
/MONITOR (AND REMOVES DECTAPE).

/BYTE SWAP CAN ONLY BE USED IN MONITOR FIELD, IF YOU HAVE ANY
/INTENTIONS OF EVER USING THIS ON A NON-8E.
/
/LOCATIONS FLAGGED WITH A  !  GET MODIFIED IN SINGLE JOB CASE
/
/ELEKMAN'S THEOREM:  GIVEN 129 WORDS OF PDP-8 CODE, THE 129 WORDS CAN
/BE OPTOMIZED TO 128 WORDS.
/COROLLARY:  THE TIME REQUIRED TO APPLY ELEKMAN'S THEOREM INCREASES
/EXPONENTIALLY WITH THE NUMBER OF APPLICATIONS OF THE THEOREM TO A GIVEN PAGE.
/ASSEMBLY INSTRUCTIONS
/.R PAL8
/*FGBG,FGBG=FGBG1,FGBG2,FGBG3,FGBG4/K
/.R ABSLDR
/*MONITR,FGBG$
/.SAVE DTAN:FGBG 0-4377,10000-17577,20000-27777;200
/!!! NOTE WITH SOME OLDER VERSIONS OF OS/8 YOU MAY NOT BE ABLE TO
/!!! DO A 4K SAVE. IN THAT CASE YOU ARE OUT OF LUCK.
/!!! ALSO, SOME DEVICE HANDLERS CANNOT WRITE A FULL 4K (SUCH AS RK8E)
/!!! SO BE CAREFUL WHAT YOU SAVE IT ON.  (THIS SHOULD GET FIXED.)
/
/THE COMMENTS SCATTERED THROUGHOUT, "%BLOCK N"  GIVE THE BLOCK #S
/FOR USE WITH THE COS PATCH PROGRAM.

	FIELD 0			/FOR SUAVITY - IT RESETS PAL8'S LITERAL INFO
				/SO WHEN OVERLA IS ASSEMBLED YOU DON'T GET
				/FALSE PE ERRORS.
/DEFINE BACKGROUND MONITOR EQUIVALENCES
	P7400=	2
	BSWBKG=	22
	KMOVE=	23
	KCDOIO=	27
	TTYIN=	30
	TTYOUT=	31
	CTRLO=	5000
	P7600=	70
	PCDF=	71
	KSPLIT=	76
	SYSHND=	77
	P70=	65
	KM4=	66
	P7=	40
	P77=	20
	UTBASE=	6200
	FTBASE=	6260
	CTRLN=	7636
	WHYME=	7637
	IODIE=	7702
	FLAGS=	7772
	TOPFLD=	7775
	SWITCH=	7776
	TF0=	FTBASE
/DEFINE OVERLAY EQUIVALENCES
	LOGBLK=	13		/OFFSET FROM BEGINNING OF OVERLAY FILE
				/TO WHERE PASSWORDS ARE

/DEFINE RK01 IOT'S
	DLDCX=	6732
	DLWC=	6753
	DLDR=	6733
	DLCAX=	6755
	DSKD=	6745
	DSKE=	6747
	DRDS=	6741
	DCLS=	6742
	DCLA=	6751
	DRCA=	6757
	DRDA=	6734
	DRWC=	6752
/DEFINE RK05 IOT'S
	DSKP=	6741
	DCLR=	6742
	DLAG=	6743
	DLCA=	6744
	DRST=	6745
	DLDC=	6746
/DEFINE RF08 IOT'S
	DCMA=	6601
	DXAL=	6643
	DIMA=	6616
	DCIM=	6611
	DIML=	6615
	DFSE=	6621
	DISK=	6622
	DCXA=	6641
	DXAC=	6645
/LP08/LS8E IOT'S
	LSF=	6661
	LCF=	6662
	LSE=	6663
	LIE=	6665
	LLS=	6666
	LIF=	6667

/CARD READER IOT'S
	RCSF=	6631
	RCRA=	6632
	RCSD=	6671
	RCSE=	6672
/TC08 DECTAPE IOT'S
	DTSF=	6771
	DTRA=	6761
	DTCA=	6762
	DTXA=	6764
	DTRB=	6772
	DTLB=	6774
/EAE
	MQL=	7421
	MQA=	7501
/8E
	RTF=	6005		/USE THAT GOOD 8/E STUFF!
	BSW=	7002

/%BLOCK 41
	*200			/ONCE-ONLY CODE!
	TAD I	KM4
	DCA	SYSHND
	JMS I	(LOOKUP		/GET BLOCK # OF THE OVERLAYS
	DCA I	(BBB		/SAVE FOR LATER
	JMP I	(CKSWIT		/CHECK SWITCHES FIRST
OKTORN,	AC0001
	JMS I	KCDOIO
	FGBGVS-1		/"FGBG VX.XX "
K7616,	7616			/- BSW OF CDF 0
	TAD I	(TOPFLD		/SET UP ALL THE FOREGROUND CDF/CIF INSTRUCTIONS
	DCA I	(FGCDF
	TAD I	(TOPFLD
	IAC			/FORM CIF
	DCA I	(FGCIF
	TAD I	(TOPFLD
	CLL RTR
	RAR
	AND	P7
	DCA	IDFLD
	TAD I	(TOPFLD
	AND	P70
	TAD	IDFLD
	DCA I	(FGID		/IF IN BITS 6-8, DF IN BITS 9-11
	AC0002
	TAD I	(TOPFLD
	DCA I	(FGIFDF
	TAD	SYSHND		/FIGURE OUT WHAT DEVICE QUEUE TO USE
	TAD	(-6610		/TO USE FOR SYSTEM QUEUE POINTER
	SNA CLA
	TAD	(DTAQ-DSKQ
	TAD	(DSKQ
QADDR,	DCA	.
	TAD	IDLP		/A GOOD RANDOM # (CDF 0)
	BSW			/BSW, IF IT EXISTS
	TAD	K7616
	SNA CLA			/DID IT?
	JMP	IFDFFX		/IF YES, GOT 8E
	TAD	(JMS I	BSWPTR	/IF NON-8E
	DCA I	(BSWVAL		/FAKE IT WITH A JMS
	TAD	KM4
	JMS I	KMOVE		/FIX UP RTF SUBSTITUTE
	CDF 20
	RTFFIX-1
	ECHNGE-1
IFDFFX,	TAD I	IFDFLS		/FIX UP ALL THE "CDF N" STUFF
	ISZ	IFDFLS
	SNA			/FINISHED?
	JMP	LUKOVR		/YUP - GO SET UP OVERLAY POINTERS
	DCA	IX1		/THIS IS THE INSTRUCTION TO INSERT
IDLP,	CDF 0
	TAD I	IFDFLS		/GET ADDR OF WHERE TO PUT IT
	ISZ	IFDFLS
	SNA
	JMP	IFDFFX
	DCA	IX2		/GET CDF OF FIELD TO PUT IT IN
	TAD I	IFDFLS
	ISZ	IFDFLS
	DCA	IDFLD
IDFLD,	0
IDLP2,	TAD	IX2		/GET ADDR
	SNA
	JMP	IDLP
	DCA	IX3
	TAD I	IX3
	DCA	IX2
	TAD	IX1
	DCA I	IX3
	JMP	IDLP2
IFDFLS,	FGCDF

LUKOVR,	TAD I	(BBB		/GET BLOCK # OF THE OVERLAYS
	IAC			/SKIP CCB
	JMS I	KSPLIT
	CDF 20
	DCA I	(OVEPAR		/SPLIT UP BLOCK NUMBER L.O.A. HERE
	SKP
	0000			/KSPLIT HITS THIS SPOT WITH HIGH BLOCK NUMBER
	TAD	.-1
	DCA I	(OVEPR3		/SAVE IT IN A SPOT SO FG JOB CAN USE IT
	CLL
	TAD	(1000
	TAD I	(OVEPAR		/BUMP THIS UP BY 2 BLOCKS
	DCA I	(MTPARM		/BECAUSE MOUNT IS IN 3RD OVERLAY BLOCK
	RAL			/SEE IF WE NEED TO BUMP HIGH PART
	TAD I	(OVEPR3
	DCA I	(MTHIBL
	TAD	QADDR
	DCA I	(SYSQ		/NOW MAKE SYSQ CORRECT
	CDF 0
	JMP I	(ALLOCT		/NOW GO ALLOCATE CORE TO THE JOBS
IX1,	0
IX2,	0
IX3,	0

/
	PAGE

/%BLOCK 42
ALLOCT,	TAD I	(SWITCH		/NOW FIGURE OUT HOW TO ALLOCATE CORE
TX1,	SZA			/MAKE NO SWITCH AT ALL EQUIVALENT TO 1
	TAD	(-6100		/ALSO TEST FOR 1
	SNA
	JMP	ONEJOB		/ONE JOB GOES IN FGM FIELD
TX2,	TAD	(6100
	CMA
	SNA			/LOOK FOR ?? SWITCH
	JMP I	(KLUDGE		/IF SEEN
	CMA			/GET BACK
TX3,	CLL RTR
TX4,	RTR
TX5,	RTR
TX6,	TAD	(-67
	CLL
	TAD	(JOBMAX+1
	SZA			/MAKE 0 ILLEGAL
	SNL
	JMP	BADSWT		/NOT IN RANGE 1-6
	DCA	TX4		/SAVE AS HOW MANY JOBS TO RUN
	DCA	TX5
	TAD	TX4
DIV3LP,	CLL CML
	TAD	(-3
	ISZ	TX5
	SNL SZA			/DIVIDE # OF JOBS BY 3
	JMP	DIV3LP
	CLA
	TAD I	(TOPFLD		/GET HIGHEST CDF OF MACHINE
	TAD	K60		/SUBTRACT 2
	AND	P70
	DCA	TX6		/THIS IS THE # OF AVAILABLE FIELDS
	TAD	TX5		/AND THIS IS THE # OF FIELDS NEEDED
	CLL RTL
	RAL
	CIA
	TAD	TX6		/SUBTRACT WHAT WE NEED FROM WHAT WE GOT
	SMA			/DO WE FIT?
	JMP	REDUCE		/YUP - AC = # OF SPARE FIELDS
TOOMNY,	AC0001			/TOO MANY JOBS FOR AMOUNT OF CORE
	JMS I	KCDOIO
	OVRLIM-1		/"TOO MANY JOBS"
K60,	60
	JMP I	P7600

ONEJOB,	DCA	TX4		/SET 1-JOB-IN-FGM FIELD AS 0 JOBS
DIDDL,	TAD	(DDLLST-1	/FIX UP SPECIAL VARIABLES FOR SINGLE JOB
	DCA	XR10
DDLP,	TAD I	XR10
	SNA
	JMP	DDLDUN
	DCA	DDLCDF
DDLFIL,	TAD I	XR10		/GET ADDRESS TO DIDDLE
	SNA			/0 MEANS END OF THIS FIELD
	JMP	DDLP		/GO SEE IF MORE FIELDS
	DCA	DIDDL
	TAD I	XR10
DDLCDF,	0
	DCA I	DIDDL
	CDF 0
	JMP	DDLFIL
DDLDUN,	TAD I	(TOPFLD
	TAD	K60
	AND	P70
REDUCE,	TAD	(CDF 10		/ADD UNUSED FIELDS TO BACKGROUND AREA
	DCA I	(TOPFLD		/AND SAVE AS NEW UPPER LIMIT FOR BACKGROUND
	TAD I	(FGCDF
	CDF 20
	DCA I	(CDFFGM		/PUT CDF OF FGM IN FGM PAGE 0
	AC0001
	TAD I	(CDFFGM
	DCA I	(CIFFGM
	TAD	TX4
	SZA CLA			/ONE JOB IN FGM FIELD?
	TAD	(7770		/IF NOT, CDF OF JOBS 1-3 WILL BE CDF N-1
	TAD I	(CDFFGM
	DCA I	KU1DF		/PUT PROPER CDF IN JOB SWAP AREAS
	TAD I	KU1DF		/EVEN IF ALL THESE JOBS WON'T BE RUN
	DCA I	(USR2DF		/SETTING THESE UP DOES NO HARM, AND
	TAD I	(USR2DF		/IT SAVES FIGURING OUT WHO REALLY NEEDS IT
	DCA I	(USR3DF
	TAD I	(USR3DF
	TAD	(7770		/AC = CDF OF JOBS 4, 5, & 6
	DCA I	(USR4DF
	TAD I	(USR4DF
	DCA I	(USR5DF
	TAD I	(USR5DF
	DCA I	(USR6DF
	TAD	TX4
	SNA
	AC0001
	CIA
	DCA I	(LMJOBS		/SET COUNT OF # OF ACTIVE JOBS
	JMS I	KMOVE		/SHIFT UP FIELD 2 (IF 12K, IT WON'T MOVE)
DF001,	DF002
	7777
	7777
	JMP I	(IOFIX
KU1DF,	USR1DF			/ !

BADSWT,	AC0001
	JMS I	KCDOIO
	ILLSWT-1		/"ILLEGAL SWITCH"
K400,	400
	JMP I	P7600
RFTABL,	77			/MAGIC TABLE TO CHECK FOR RF08'S
	177
	277
	377
/
	PAGE


IOFIX,	IOF			/SELF-PRESERVATION
	TAD	(NEWINT-INTEND
	CDF 10			/"FROM" FIELD
	JMS I	KMOVE		/MOVE IN NEW INTERRUPT STUFF
	CDF 0
	NEWINT-1
	7400-1
	CLL CML			/FIGURE OUT WHAT KIND OF TAPE
	6141	/LINC
	0011	/CLR
	0002	/PDP
	SNL CLA			/IS MACHINE A PDP-12?
	JMP	TC12A		/YES - SO PUT IN LTA HANDLER
	AC4000
	6766			/TC08 INSTRUCTION, SHOULD CLA
	SNA CLA			/TC08?
	JMP	DTOK		/GUESS SO (TC08 IS DEFAULT)
	TAD	(TD8E-TC12	/ANYBODY WHO TRIES TO RUN THIS ON TD8E'S IS CRAZY
TC12A,	TAD	(TC12-1
	DCA	DTADR
	TAD	P7600
KCDF10,	CDF 10
	JMS I	KMOVE		/MOVE IN CORRECT HANDLER
DF003,	DF004
DTADR,	0
	DTSTRT-1
	TAD	(-6
	CDF 10
	JMS I	KMOVE
DF004,	DF005
	T12SKP-1
	DTASKP-1
DTOK,	AC2000			/NOW FIGURE OUT WHAT KIND OF DISK
	6742			/RK05 INSTRUCTION, SHOULD CLA
	SNA CLA			/DID IT?
	JMP	RK05IN		/YUP, SO WE MUST HAVE ONE OF 'EM
	AC0001
	6732			/RK01 INSTRUCTION, SHOULD CLA
	SNA CLA			/DID IT?
	JMP	RKOK		/LOOKS LIKE...(RK01 IS DEFAULT)
RFLP,	TAD I	RFGET		/BY ELIMINATION, WE'LL TRY RF08
	ISZ	RFGET
	DXAL			/RF08 IOT
	DIMA
	CLL RTR
	SZL CLA			/LOOK FOR NON-EXISTENT DISK
	JMP	RFEND		/WE GOT ONE (OR RATHER, DON'T GOT ONE?)
	TAD	(100
	TAD	RFSIZE
	DCA	RFSIZE		/BUMP UP THE RF SEGMENT COUNT
	ISZ	RFCNT		/TRIED FOR 4 DISKS?
	JMP	RFLP		/NOT YET
RFEND,	TAD	RFSIZE
	SNA CLA			/DID WE GET ANYTHING?
	JMP	RKOK		/NOPE - IGNORE
	TAD	(RF08-RK05	/PUT IN RF08 HANDLER
	ISZ	DSKBMP
RK05IN,	TAD	(RK05-1		/PUT IN RK05
	DCA	DISKAD
	TAD	P7600
	CDF 10			/"FROM" FIELD
	JMS I	KMOVE
DF005,	DF006
DISKAD,	0
	DKSTRT-1		/ADDR OF INTERRUPT DISK HANDLER
DSKBMP,	TAD	DKSKPL		/*** MAY BE BUMPED
	DCA	DKSKPM
	CDF 10
	TAD	(-6
	JMS I	KMOVE
	DF007=	0
DF006,	DF007
DKSKPM,	0
	DSKSKP-1
RKOK,	TAD	(DSKX-DSKXND
	CDF 10
	JMS I	KMOVE		/PATCH UP BACKGROUND DSK CALL
	CDF 0
	NEWDSK-1
	6410-1
	TAD	(DTAX-DTAXND
	CDF 10
	JMS I	KMOVE		/PATCH UP BACKGROUND DTA HANDLER
	CDF 0
	NEWDTA-1
	6610-1
	TAD	(NEWTTY-TTYEND
	CDF 10
	JMS I	KMOVE		/PUT IN NEW TTO, TTI CALLS
	CDF 0
	NEWTTY-1
	5000-1
	JMP I	(NXTPAG		/FOR LACK OF A BETTER TAG
RFSIZE,	0
RFCNT,	-4
RFGET,	RFTABL
DKSKPL,	RK5SKP-1
	RF8SKP-1
/
	PAGE

/%BLOCK 43
NXTPAG,	TAD	JTBM1
	DCA	XR10
	TAD I	(TX4
	SNA
	IAC
	CMA
RUNCNT,	DCA	.
DF002,	DF003			/CDF N (GETS SET UP) *****
	DCA I	XR10		/SET JOBS 0-N RUNNABLE
	ISZ	RUNCNT
	JMP	.-2
	CDF 0
	TAD	(2400		/SET UP TO READ 0-4777 ONLY
	DCA I	(7604
	TAD	(3000
	DCA I	(7720
	TAD	(5720		/JMP I 7720 IN DISGUISE
	DCA I	(7607
	AC7775
	TAD I	(TX4
	SPA SNA CLA		/HOW MANY JOBS ARE GOING TO BE RUNNING?
	JMP	LESS4		/LESS THAN 4
	CDF 20			/AT LEAST 4 JOBS
	TAD I	(USR4DF		/GET CDF OF JOBS 4-6
	DCA	JB4FLD
	TAD	P7400
	JMS I	KMOVE		/MOVE FOREGROUND MONITOR LOCATIONS 0-377
JB4FLD,	0			/TO THE FIELD OF JOBS 4-6
	7777
	7777
	TAD	JB4FLD
	JMS	USRSET		/SET USRCDF IN NON-MONITOR FIELD TO BE THAT FIELD
LESS4,	TAD I	(TX4
	SNA CLA			/WHERE IS JOB 1?
	JMP	INITXT		/IN FIELD WITH FGM - NO MOVE
	CDF 20
	TAD I	KKU1DF		/GET CDF OF JOBS 1-3
	DCA	JB1FLD
	TAD	P7400
	JMS I	KMOVE
JB1FLD,	0
	7777
	7777
	TAD	JB1FLD
	JMS	USRSET
INITXT,	AC4000
	TAD I	(FLAGS
	DCA I	(FLAGS		/SET "FOREGROUND JOB IS DOING ITS THING"
	ION			/RE-ENTER THE TWILIGHT ZONE
	JMP I	P7600
JTBM1,	JMSKTB-1		/ !
KKU1DF,	USR1DF			/ !

USRSET,	0
	DCA .+1
	0
	TAD .-1
	DCA I	(USRCDF
	CDF 0
	JMP I	USRSET
ILLSWT,	-7		/"ILLEGAL SWITCH"
	5255
	5546
	5042
	5501
	6470
	5265
	4451
OVRLIM,	-7		/"TOO MANY JOBS"
	6560
	6001
	5642
	5772
	0153
	6043
	6401
CLOD,	-14		/"FGBG IS ALREADY RUNNING!
	4750
	4350
	0152
	6401
	4255
	6346
	4245
	7201
	6366
	5757
	5257
	5002

FGBGVS,	-6		/"FGBG VX.XX "
	4750
	4350
	0167
	YEAR-106^100+2117	/X.
	Z1=	MONTH%12
	Z2=	Z1^12
	Z3=	MONTH-Z2
	Z1^100+Z3+2121		/XX
	LEVEL			/SUB-VERSION  (SUBVERSION???)
/
	PAGE

KLUDGE,	CLA
	TAD	KL0121		/COME HERE TO REASSIGN TERMINAL IOT'S
	DCA	JOBNBR
	TAD	(-7
	DCA	JOBCTR
	TAD	(IOTLST
	DCA	IOTPTR
JBMGLP,	AC0001
	JMS I	KCDOIO
	JOBMSG-1		/"JOB  N KSF: "
KLM10,	-10
	JMS	GETNUM		/GET THE KSF TO USE
	SNA			/0 MEANS TYPING ERROR
	JMP	JBMGLP		/REPEAT THE MESSAGE
	DCA I	IOTPTR		/PUT IN TABLE
	ISZ	IOTPTR
	ISZ	JOBNBR		/BUMP MESSAGE TEXT
	ISZ	JOBCTR		/DONE MAX?
	JMP	JBMGLP		/NOT YET
IOTOK,	TAD	JOBCTR
	TAD	KL5
	SPA 			/MUST HAVE GOTTEN AT LEAST 0 AND 1
	JMP	KLUDGE		/IF WE DIDN'T
	SZA CLA
	ISZ	FX1JMP		/IF > 1 JOB
	TAD	JOBCTR
	TAD	KL66
	CLL RTL
	RTL
	RTL
	DCA I	(SWITCH		/MAKE LIKE WE GOT A SWITCH OPTION TYPED
	TAD	IOTLST
	TAD	KL15		/MAKE A TLS
	CDF 20
	DCA I	(TTOTLS		/FIX SPECIAL JOB 0 KLUDGE
INSRTLP,CDF 0
	TAD I	IOTADR		/GET THE IOT
	SNA
	JMP	HANG		/WAIT FOR CONSOLE TTY TO DIE DOWN
	ISZ	IOTADR
	CDF 20
FX1JMP,	JMP	.+1		/MAY GET ISZ'D
	JMP I	(JOBFX1		/GETS ZAPPED IF > 1 JOB
	DCA I	KSFPTR		/FIRST IS KSF...PUT IT IN
	TAD I	KSFPTR
	TAD	KL10		/MAKE IT INTO A TSF
	DCA I	TSFPTR		/AND PUT THAT IN
	TAD I	TSFPTR
	TAD	KL5		/NOW MAKE THAT INTO A TLS
	DCA I	TLSPTR		/AND PUT THAT IN
	ISZ	KSFPTR
	ISZ	TSFPTR
	TAD	TLSPTR
	TAD	(TLS1LC-TLS0LC	/THIS PTR GETS BUMPED A BIT WEIRD
	DCA	TLSPTR
	JMP	INSRTLP

HANG,				/WASTE TIME
KL10,	10			/WE MUST MAKE SURE CONSOLE TTY IS QUIET
KL212,	212			/BECAUSE ITS KSF MAY HAVE BEEN REMOVED
KL15,	15			/FROM THE FGBG SKIP CHAIN
KL66,	66
KL5,	5
KL0121,	0121
	ISZ	STALL
	JMP	HANG
	JMP I	(ALLOCT		/GO AWAY AND PRETEND THIS NEVER HAPPENED
KSFPTR,	TTLIST+JOBMAX+2
TSFPTR,	TTLIST
TLSPTR,	TLS0LC
IOTADR,	IOTLST
IOTLST,	ZBLOCK 7;STALL,	0
JOBCTR,	0
IOTPTR,	IOTLST
SUMNUM,	0
TNUM,	0

GETNUM,	0
GNLP,	DCA	SUMNUM
	JMS I	TTYIN
	DCA	TNUM
	TAD	TNUM
	JMS I	TTYOUT		/ECHO
	TAD	TNUM
	TAD	(-215
	SNA			/CAR.RET?
	JMP	ENUM		/IF YES
	TAD	(215-232
	SNA			/^Z?
	JMP	IOTOK		/IF YES
	TAD	(232-270
	CLL
	TAD	KL10
	SNL			/0-7?
	JMP	BADDIG		/NOPE
	DCA	TNUM
	TAD	SUMNUM
	CLL RTL
	RAL
	TAD	TNUM
	JMP	GNLP		/KEEP GOING
BADDIG,	CLA
	DCA	SUMNUM
ENUM,	TAD	KL212
	JMS I	TTYOUT
	TAD	SUMNUM
	JMP I	GETNUM
JOBMSG,	-6
	5360			/"JOB  N KSF: "
	4301
JOBNBR,	0121
	0154
	6447
	3301
/
	PAGE

/%BLOCK 44
/THIS IS A TABLE OF ALL LOCATIONS THAT MUST GET CHANGED
/FOR THE ONE-JOB-IN-FGM-FIELD CASE.  YOU WILL NOTE THAT THERE ARE TWO
/AREAS OF TABLES.  ONE CONTAINS ONLY ENTRIES FOR JOBS 0 AND 1,
/AND THE OTHER CONTAINS ENTRIES FOR ALL 6 FOREGROUND JOBS PLUS THE
/BACKGROUND JOB.  THE DEFAULT VALUES OF ALL THE POINTERS TO THE TABLES
/POINT TO THIS MULTI-JOB AREA.  WHAT HAPPENS IF THERE IS JUST ONE
/FOREGROUND JOB TO RUN IS THAT THE CODE AT "DDLT" GOES THROUGH AND
/PATCHES ALL THE TABLE POINTERS TO POINT TO THE OTHER TABLE AREA,
/AND THE FOREGROUND JOB'S BUFFERS AND SUCH OVERLAY THE OTHER TABLE
/ AREA.  MESSY? YOU BET.
DDLLST,	CDF 0
	JTBM1;	JMSK1J-1
	KU1DF;	U1DF1J
	KKU1DF;	U1DF1J
	0
	CDF 10
	DDWT-10&177+NEWDTA;	DDWA1J
	0
	CDF 20
	KTTOSI;	TTOSIZ
	KTTISI;	TTISIZ
	STACK;	STK01J-1
	TTOPUT;	OBF01J
	KDWAIT;	DDWA1J
	KJMSKT;	JMSK1J
	TTIGET;	IBF01J-1
	TTOCNT;	TCTS1J
	TTICNT;	TCTS1J+1+1
	MASK;	JMSK1J
	KSTCK0;	STK01J-1
	KSAVTB;	SVTB1J-1
	KTLST1;	TTLI1J-1
	KTCTS;	TCTS1J
	KTPTRS;	TPTR1J
	KSTK01;	STK01J-1
	0
	0
JOBFX1,	DCA I	KSF1PT
	TAD I	KSF1PT
	TAD	(10
	DCA I	TSF1PT
	TAD I	TSF1PT
	TAD	(5
	DCA I	TLS1PT
	ISZ	KSF1PT
	ISZ	TSF1PT
	TAD	TLS1PT
	TAD	(TLS1LC-TLS0LC
	DCA	TLS1PT
	JMP I	(INSRTLP
KSF1PT,	TTLI1J+1+2
TSF1PT,	TTLI1J
TLS1PT,	TLS01J
/
FGCDF,	0			/TABLE OF HOW TO FILL IN PROPER CDF'S & CIF'S
	DF001
	CDF 0
	DF101
	CDF 10
	DF201
	CDF 20
	0
FGCIF,	0
	IF101
	CDF 10
	0
FGIFDF,	0
	IDF101
	CDF 10
	IDF201=	0
	IDF201
	CDF 20
	0
BSWVAL,	BSW			/JMS IF NON-8E
	BSW201
	CDF 20
	0
FGID,	0			/IF = BITS 6-8, DF = BITS 9-11
	ID201
	CDF 20
	0
	0

/GETS MOVED TO "ECHNGE" IF NON-8/E
RTFFIX,	L70&177			/AND	L70
	KCIF&177+1200		/TAD	KCIF
	INTCIF&177+3200		/DCA	INTCIF
	IFLAGS&177+1000		/TAD	IFLAGS
/
	PAGE

CKSWIT,	TAD I	(SWITCH
	TAD	(-2027		/CHECK FOR "/PW"
	SNA CLA
	JMP	PASSWD
	TAD I	KFLAGS
	SMA CLA			/IS FGBG ALREADY RUNNING?
	JMP I	(OKTORN		/NOPE
	AC0001
	JMS I	KCDOIO		/YUP - COMPLAIN
	CLOD-1			/"FGBG IS ALREADY RUNNING!"
KFLAGS,	FLAGS
	JMP I	P7600
PASSWD,	TAD	BBB		/GET STARTING BLOCK OF OVERLAYS
	TAD	(LOGBLK		/ADD IN OFFSET TO PROPER OVERLAY
	JMS I	KSPLIT
	JMS I	SYSHND
	0200
	DIRECT
PASSTM,	0
GETWRD,	AC0001
	DCA	PASNUM
	TAD	(-6
	DCA	PASCTR
	TAD	(DIRECT+200
	DCA	STRPTR		/WHERE THE PASSWORDS GET PUT
GETLUP,	TAD	PASNUM
	TAD	(3321
	JMS I	BSWBKG
	DCA	PASTXT		/SAVE AS "N:"
	TAD	(215
	JMS I	TTYOUT		/MAKE IT LOOK NICE
	TAD	(212
	JMS I	TTYOUT
	AC0001
	JMS I	KCDOIO
	PASMSG-1		/"PASSWORD FOR JOB  N:"
PASCTR,	0
	TAD	(-6
	DCA	CHRCNT		/AT MOST 6 CHARS PER PASSWORD
GETCHR,	JMS I	TTYIN
	TAD	(-377
	SNA			/RUBOUT?
	JMP	PASRUB		/YUP
	TAD	(377-225
	SNA			/^U?
	JMP	PASRUB		/YUP
	TAD	(225-215
	SNA
	JMP	ENDWRD		/TERMINATE ON CAR. RET.
	TAD	(215
	DCA	PASSTM
	TAD	PASSTM
	JMS I	TTYOUT		/ECHO
	TAD	PASSTM
	DCA I	STRPTR
	ISZ	STRPTR
	ISZ	CHRCNT
	JMP	GETCHR
	JMP	DONE1
PASRUB,	TAD	(6
	TAD	CHRCNT
	CIA
	TAD	STRPTR		/BACK UP BY # OF CHARS ACCEPTED
	DCA	STRPTR
	JMP	GETLUP
ENDWRD,	DCA I	STRPTR
	ISZ	STRPTR
	ISZ	CHRCNT		/FILLED TO 6 CHARS?
	JMP	ENDWRD		/CLEAR REMAINS OF PASSWORD TO 0
DONE1,	ISZ	PASNUM		/BUMP PASSWORD #
	TAD	(215
	JMS I	TTYOUT
	TAD	(212
	JMS I	TTYOUT
	ISZ	PASCTR
	JMP	GETLUP
	AC0001
	JMS I	KCDOIO
	OKMSG-1			/"PASSWORDS OK?"
BBB,	0
	JMS I	TTYIN
	DCA	PASSTM
	TAD	PASSTM
	JMS I	TTYOUT		/ECHO
	TAD	PASSTM
	TAD	(-331
	SZA CLA
	JMP	GETWRD		/GO TRY AGAIN
	TAD	BBB
	TAD	(LOGBLK		/OFFSET, AGAIN
	JMS I	KSPLIT
	JMS I	SYSHND
	4200			/WRITE OUT PASSWORDS
	DIRECT
PASNUM,	0
	JMP I	P7600
STRPTR,	0
CHRCNT,	0

PASMSG,	-12	/"PASSWORD FOR JOB  N:"
	6142
	6464
	7060
	6345
	0147
	6063
	0153
	6043
	0101
PASTXT,	0
/
	PAGE

/%BLOCK 45
/ROUTINE TO DO LOOKUPS ON PS/8 DIRECTORIES
/CALL:
/JMS LOOKUP
/POINTER-1 TO NAME
/NOT FOUND RETURN
/FOURND RETURN, ST. BLK. # IN AC, LENGHT IN "FILSZ"
/
/PROGRAM MUST HAVE PREVIOUSLY SET UP:
/UINT=PHYSICAL UNIT #
/DAVICE=DEVICE HANDLER ADDRESS
/DBLOCK=0
/DIRECT=ADDRESS OF WHERE TO PUT THE DIRECTORY BLOCK READ IN (FIELD 0)
/
LOOKUP,	0
	JMS	MRDCAT
	JMS	MDSRCH
	JMP	NOTFND		/IF OVERLAY FILE NOT FOUND
	TAD	SBLOCK
	CIA
	TAD I	PDORG
	JMP I	LOOKUP
/
MRDCAT,	0
	SZA
	JMP	MRDREN
MRDREN,	DCA	SBLOCK
	ISZ	DBLOCK
	JMS	MREADC
INLRDY,	TAD I	PDCNT
	DCA	NFILES
	TAD	PDWSTE
	DCA	XR10
	JMP I	MRDCAT
NOTFND,	AC0001
	JMS I	KCDOIO
	MISING-1		/"FILE "OVERLA" NOT FOUND"
	NOP
	JMP I	P7600

MDSRCH,	0
FSRCLP,	TAD	PTNAME
	DCA	XR11
	TAD	KM4
	DCA	CT
	TAD I	XR10
	SNA
	JMP	SKPMTF
	SKP
SRCWDL,	TAD I	XR10
	CIA
	TAD I	XR11
	SZA CLA
	JMP	NXTFIL
	ISZ	CT
	JMP	SRCWDL
	JMS	BUMPXR
	TAD I	XR10
	SNA CLA
	JMP	SKPOVR
	ISZ	MDSRCH
	JMP I	MDSRCH
NXTFIL,	TAD	CT
	IAC
	JMS	BUMPXR
SKPMTF,	TAD I	XR10
	TAD	SBLOCK
	DCA	SBLOCK
SKPOVR,	ISZ	NFILES
	JMP	FSRCLP
	TAD I	PDLINK
	SZA CLA
	JMP	MRDREN
	JMP I	MDSRCH
/
BUMPXR,	0
	TAD I	PDWSTE
	CIA
	TAD	XR10
	DCA	XR10
	JMP I	BUMPXR

MREADC,	0
	TAD	DBLOCK
	AND	P7
	JMS I	KSPLIT
	JMS I	SYSHND
	0200
	DIRECT
	0
	JMP I	MREADC
/
DBLOCK,	0
SBLOCK,	0
CT,	0
NFILES,	0
PTNAME,	.
	1726	/"OVERLA.SV"
	0522
	1401
	2326
PDCNT,	DIRECT
PDORG,	DIRECT+1
PDLINK,	DIRECT+2
PDWSTE,	DIRECT+4
/
MISING,	-14		/ FILE "OVERLA" NOT FOUND
	4752
	5546
	0103
	6067
	4663
	5542
	0301
	5760
	6501
	4760
	6657
	4500
OKMSG,	-7	/"PASSWORDS OK?"
	6142
	6464
	7060
	6345
	6401
	6054
	4000
/
	PAGE

/DIRECTORY BLOCKS GO HERE WHEN LOOKING UP OVERLAY FILE
	DIRECT=	.
	ZBLOCK 400
/%BLOCK 46 AT 2400
/%BLOCK 47 AT 3000
/%BLOCK 50 AT 3400
/%BLOCK 51 AT 4000

	FIELD 1

/HERE ARE THE RK05 AND RF08 DISK HANDLERS.   THEY GET MOVED INTO PLACE IF
/NECESSARY...THE RK01 IS THE DEFAULT CASE.  FOLLOWING ARE THE
/NECESSARY ABORTIONS TO BE LAID ON THE BACKGROUND I/O
/HANDLERS SO THEY USE THE NEW ONES.
/%BLOCK 21
	*200
/HERE ARE THE PATCHES TO THE INTERRUPT SKIP CHAIN FOR THE
/DEVICES THAT MAY CHANGE (DISK AND DTA)
RK5SKP,	DSKP
	SKP CLA
	RK5INT&177+5600		/JMP I	RK5INT IN DISGUISE
	NOP;NOP;NOP
RF8SKP,	DFSE
	SKP CLA
	RF8BAD&177+5600		/JMP I RF8BAD
	DISK
	SKP CLA
	RF8INT&177+5600		/JMP I	RF8INT
T12SKP,	100
	DTASKP&177+1200		/TAD .-1
	6151
	SKP CLA
	T12INT&177+5600		/JMP I T12INT
	NOP			/MAKE IT FIT RIGHT
/
	PAGE

/%BLOCK 22
/THIS CODE MAY MOVE TO "DKSTRT"
RK05,	0			/RK05 HANDLER
	DCA I	(DKSTAT		/CLEAR RECALIBRATE FLAG
	TAD I	(DKARG1		/LOW BLK # AND JOB #
	AND	L7
	DCA I	(DKJOB
	TAD I	(DKARG1
	AND	L7400
	DCA I	(DKBLOC
	TAD I	(DKARG2		/R/W,LEN,FLD,UNIT
	AND	L7
	TAD I	(DKARG2		/UNIT# * 2 + R/W + FIELD
	AND	(4077
	TAD	L0400		/ENABLE INTERRUPT (SHUDDER)
	DCA	RKECMD
	TAD I	(DKARG3
	DCA I	(DKCORE
	TAD I	(DKARG2
	AND	(3700
	SNA
	AC4000
	DCA	PAGCNT
	TAD I	(DKBLOC
	CLL RAL
	TAD I	(DKARG4		/WATCH THE LINK!
	RTL
	RTL
	DCA I	(DKBLOC		/WE'VE COMBINED HIGH & LOW BLK #, MAYBE BIT IN LINK
	JMS	RKEOPR		/THIS ROUTINE USES LINK...
	JMP I	RK05
RKEOPR,	0			/ENTER WITH 0 OR 2000
	SZL			/DO WE NEED TO BUMP SUPER ADDRESS BIT?
	ISZ	RKECMD		/IF YES
	DCA	CHKHED		/SET "CHECK HEADER" 0 OR 2000
RKELPX,	DCLR			/CLEAR DONE FLAG, FOR ONE THING
	TAD I	(DKCORE		/CORE ADDRESS
	DLCA
	TAD	PAGCNT
	AND	L7600
	SNA CLA			/HALF BLOCK?
	TAD	L0200		/YUP
	TAD	CHKHED
	CLL RAR
	TAD	RKECMD
	DLDC
	TAD I	(DKBLOC
	DLAG			/DO IT!
	JMP I	RKEOPR

RK5SRV,	TAD I	(DKSTAT
	SZA CLA			/ARE WE DOING A RECALIBRATE?
	JMP	RKEXXX		/YES
	DRST
	CLL RAL
	SZA CLA
	JMP	RKEBAD		/GOT AN ERROR
	TAD	PAGCNT
	TAD	L7600
	SPA SNA
	JMP	RKEDUN
	DCA	PAGCNT
	TAD I	(DKCORE
	TAD	L0400		/BUMP CORE ADDRESS
	DCA I	(DKCORE
	TAD I	(DKBLOC
	CMA CLL			/WATCH THE LINK
	AND	(37
	SZA CLA			/SEE IF WE CROSS A TRACK BOUNDARY
	AC2000			/IF NOT, SET "DON'T CHECK HEADER"
	ISZ I	(DKBLOC		/IF THIS OVERFLOWS, SET LINK
	SKP
	CML
	JMS	RKEOPR
	JMP I	(DISMIS

RKEXXX,	ISZ I	(DKSTAT
	JMP	RKEER2
RKERET,	ISZ I	(DKTRY
	JMP I	(DKRETR
	DCLR
	JMP I	(DKERR
RKEBAD,	AC7776
	DCA I	(DKSTAT
	DCLR
	AC0002
RKEER2,	DCLR
	TAD	RKECMD
	AND	L7		/GET DRIVE #
	TAD	(600		/ENABLE INTERRUPT ON SEEK DONE
	DLDC
	JMP I	(DISMIS
RKEDUN,	CLA CLL
	DCLR			/KILL THAT FLAG!
	JMP I	(DKDONE
RKECMD,	0
PAGCNT,	0
CHKHED,	0
/
	PAGE

/THIS CODE MAY MOVE TO "DKSTRT"
RF08,	0			/RF08 HANDLER
	TAD I	(DKARG1
	AND	L7		/GET # OF JOB REQUESTING OPERATION
	DCA I	(DKJOB
	TAD I	(DKARG2
	AND	L70		/GET FIELD BITS
	TAD	(500		/ENABLE INTERRUPT (SHUDDER)
	DIML
	AC7777
	TAD I	(DKARG3		/GET ADDRESS-1
	DCA	RF08T
	TAD I	(DKARG2
	CLL RAL			/R/W TO LINK
	AND	L7600		/# OF WORDS TO TRANSFER IN AC
	SZA			/DON'T CLOBBER LINK WITH CIA!
	CIA
	CDF 0
	DCA I	(7750
	TAD	RF08T
	DCA I	(7751
DF103,	DF104
	TAD I	(DKARG4		/GET HIGH BLOCK BITS
	DXAL
	RTL			/R/W TO BIT 10
	TAD	(DMAR
	DCA	RFINST		/6603 OR 6605
	TAD I	(DKARG1
	AND	L7400		/GET LOW BLOCK BITS
RF08T,
RFINST,	0			/GO!
	JMP I	RF08

RF8ERR,	DCMA			/CLEAR FLAG
	ISZ I	(DKTRY		/TRIED 3 TIMES?
	JMP I	(DKRETR		/NOT YET
	JMP I	(DKERR		/GIVE UP
RF8SRV,	DCMA			/CLEAR FLAG
	JMP I	(DKDONE		/LINK MUST = 0 HERE!
/
	PAGE

/%BLOCK 23
/THIS CODE MAY MOVE TO "DTSTRT"
TD8E,	0			/TD8E (BARF!) HANDLER
	HLT
	/
	PAGE

/THIS CODE MAY MOVE TO "DTSTRT"
TC12,	0			/LINCTAPE HANDLER
	TAD I	(DTARG1
	AND	L7400
	CLL RAL
	TAD I	(DTARG4
	RTL
	RTL
	CLL RAL			/MULTIPLY BY 2
	DCA	LTBLK
	TAD I	(DTARG1
	AND	L7
	DCA I	(DTJOB
	TAD I	(DTARG3
	DCA	LTLOC
	TAD I	(DTARG2
	AND	L7
	CLL RAR			/WATCH THE LINK!
	TAD	(130
	DCA	LTFUN
	TAD I	(DTARG2
	RTL			/THERE IT GOES!
	RTL
	AND	(14
	TAD	(702
	DCA	LTOP
	TAD I	(DTARG2
	CLL RTL
	RTL
	RTL
	DCA	LTFUN2
	TAD	LTFUN2
	AND	L17
	RAL
	SNA
	TAD	L0040
	CIA
	DCA	LTNMBL
	TAD	LTFUN2
	AND	(7000
	TAD	LTFUN
	DCA	LTFUN
	JMS	LTOPR
	JMP I	TC12
LTNMBL,	0
LTFUN2,	0
LTLOC,	0

T12SRV,	CLL RAL			/AC = 100 HERE
	6151			/MAINTENANCE IOT
	CLA
	6141		/LINC
	0003		/TAC
	0002		/PDP
	DCA	LTOPR
	TAD	LTOP
	AND	L0004
	SZA CLA
	JMP	LTOK		/CHECKSUM IS GARBAGE ON WRITES
	ISZ	LTOPR		/GOOD CHECKSUM = 7777
	JMP	LTBAD
LTOK,	TAD	L0200
	TAD	LTLOC
	DCA	LTLOC
	CLL			/SET "NO ERROR"
	ISZ	LTBLK
	ISZ	LTNMBL
	SKP
	JMP I	(DTDONE
LTRETR,	JMS	LTOPR		/START NEXT BLOCK
	JMP I	(INTXIT
LTBAD,	ISZ I	(DTTRY
	JMP	LTRETR
	CLL CML			/SET "I/O ERROR"
	JMP I	(DTERR
LTOPR,	0
	TAD	LTLOC
	6141		/LINC
	0023		/TMA
	1020		/LDA I
LTFUN,	0
	0001		/AXO
LTOP,	0		/RDE OR WRI
LTBLK,	0
	0002		/PDP
	CLA
	JMP I	LTOPR
	/
	PAGE

/%BLOCK 24
	NEWTTY=	.		/PATCH FOR BACKGROUND TTY HANDLER
	NOPUNC
	*5000
IFNDEF OVERLA <	ENPUNC >
	0			/LOC 5000 = CTRLO SWITCH
PTRSRV,	RRB
	HLT
PTPSRV,	PCF
	HLT
E1,	5660	/"MOUNT "
	6657
	6501
	0000
	ZBLOCK 5011-.		/THIS IS LEFT OVER FROM OLD COS 300
CTCZAP,	SNA			/THIS LOC = SNA MEANS DO REAL ^C'S
				/THIS LOC = SKP MEANS PASS ^C'S TO BACKGRGROUND
E18,	5760			/"NOT ALPHA "
	6501
	4255
	6151
	4201
	0000
E16,	5264			/"IS DATA OK?"
	0145
	4265
	4201
	6054
	4000
E22,	5760			/"NOT DECIMAL "
	6501
	4546
	4452
	5642
	5501
	0000
	ZBLOCK 5037-.

TTYO,	0
	IFNZRO TTYO-5037 <???> /ERROR!
	DCA	TTYI
	TAD	CTRLO
	RAR
	SZL CLA
	JMP I	TTYO		/IF ^O IS ON
	TAD	TTYI		/REGET CHAR
	TAD	TTY212
	SNA CLA			/LINE FEED?
	TAD	TTY4		/IF YES, SET UP FOR 4 NULLS
	CMA
	DCA	NULCNT
	TAD	TTYI		/NOW GET CHAR TO PRINT
NULLUP,	IOF
	IF101=	.&177+NEWTTY
	IF102			/CIF N (GETS SET UP) *****
	JMS I	KPUSHJ
	TTOCHR
	ISZ	NULCNT
	JMP	NULLUP		/MORE NULLS TO GO
	JMP I	TTYO
TTY4,	4
TTY212,	-212
TTYI,	0
	IFNZRO TTYI-5065 <???> /ERROR!
TI,	IOF
	IF103=	.&177+NEWTTY
	IF104			/CIF N (GETS SET UP) *****
	JMS I	KPUSHJ
	TTICHR
	DCA	TTYO
	DF105=	0
	DF104=	.&177+NEWTTY
	DF105
	CIF 0			/IOF!
	TAD I	KTTCTS
	SKP			/ANYBODY GOT A PAPER BAG?
TICHR,	0
	IFNZRO TICHR-5077 <???> /ERROR, RSYS (WHOT A KLUDGE!)
	DCA	TICHR
	CDF 0
	TAD	TTYO
	TAD	KM216
	SNA CLA
	ISZ I	KCTRLN
	TAD	TTYO
	JMS I	KWHYME
	JMP I	TTYI
KWHYME,	WHYME
KM216,	-216
NULCNT,	0
KPUSHJ,	PUSHJX
KTTCTS,	TTCTS
KCTRLN,	CTRLN

/FOREGROUND MESSAGES
E2,	5257	/"IN USE"
	0166
	6446
	0000
E5,	6657	/"UNDEFINED UNIT"
	4546
	4752
	5746
	4501
	6657
	5265
	0000
E6,	5255	/"ILLEGAL UNIT #"
	5546
	5042
	5501
	6657
	5265
	0104
	0000
E8,	5542	/"LABEL OF DATA FILE:"
	4346
	5501
	6047
	0145
	4265
	4201
	4752
	5546
	3300
E28,	5760	/"NOT # "
	6501
	0401
	0000
	TTYEND=	.&177+NEWTTY
/
	*NEWTTY+200

	NEWINT=	.		/PATCH TO CHANGE SKIP CHAIN
	NOPUNC
	*7400
IFNDEF OVERLA <	ENPUNC >
LPPAGE,	DCA	TMPAC
	IDF101=	.&177+NEWINT
	IDF102			/CIF CDF N (GETS SET UP) *****
	TAD	0		/MAKE LIKE AN INTERRPUT TRAPPED TO FIELD N
	DCA I	K0		/PUT FIELD 0 LOC 0 INTO FIELD N LOC 0
	TAD	TMPAC
	JMP I	.+1		/GO TO INTERRUPT HANDLER IN FIELD N
	INTRPT
TMPAC,	0
E23,	6346	/"REWIND? "
	7052
	5745
	4001
K0,	0
E17,	0401			/"# OUT OF RANGE?"
	6066
	6501
	6047
	0163
	4257
	5046
	4000
LPDNFG,	0			/FOR RSYS GROOVINESS
	IFNZRO LPDNFG-7425 <???> /RSYS ERROR!
LPTSRV,	TAD	LPCHCT
	SMA CLA
	JMP	LPTLCF
	ISZ	LPCHCT
	JMP	LPMORE
	AC7777
	DCA	LPDNFG
LPTLCF,	LCF
	JMP	LPTXIT
LPMORE,	ISZ	LPGETP
	TAD I	LPGETP
	SPA
	DCA	LPGETP
	CLA
	TAD I	LPGETP
	LLS
	CLA
	IDF103=	0
	IDF102=	.&177+NEWINT
LPTXIT,	IDF103			/CIF CDF N (GETS SET UP) *****
	JMP I	.+1
	DISMIS

LP377,	377
	ZBLOCK 7453-.
LPOCHR,	0
	IFNZRO LPOCHR-7453 <???>
	CDF 0
	AND	LP377
	DCA I	LPPUTP
LPFULP,	AC0001
	LIE
	TAD	LPCHCT
	TAD	LPSIZ
	SNA CLA
	JMP	LPFULP
	CIF 0			/DISABLE INTERRUPT
	AC7777 CLL
	TAD	LPCHCT
	DCA	LPCHCT
	DCA	LPDNFG
	TAD I	LPPUTP
	SNL
	LLS
	SZL CLA
	ISZ	LPPUTP
	TAD I	LPPUTP
	SPA
	DCA	LPPUTP
	CLA
	JMP I	LPOCHR
LPPUTP,	7221
LPGETP,	7220
LPCHCT,	0
LPSIZ,	117
/SOMEDAY THE CARD READER MAY USE THIS AREA...
E19,	6346	/"RECORD NOT FOUND"
	4460
	6345
	0157
	6065
	0147
	6066
	5745
	0000
E20,	4451	/"CHECKDIGIT ERROR "
	4644
	5445
	5250
	5265
	0146
	6363
	6063
	0100

E21,	4752	/"FIELD OVERFLOW"
	4655
	4501
	6067
	4663
	4755
	6070
	0100
E24,	4451	/"CHARACTER AFTER "-" "
	4263
	4244
	6546
	6301
	4247
	6546
	6301
	0316
	0301
	0000
E26,	4352	/"BINARY OR LINEAR SEARCH? "
	5742
	6372
	0160
	6301
	5552
	5746
	4263
	0164
	4642
	6344
	5140
	0100
	INTEND=	.-LPPAGE+NEWINT
/
	*NEWINT+200

/%BLOCK 25
/THE PATCH FOR THE BACKGROUND DISK HANDLER
	NEWDSK=	.
	NOPUNC
	*6410
IFNDEF OVERLA <	ENPUNC >
DSKX,	0
	DCA	DSK1		/SAVE FIRST ARG
	TAD I	DSKX		/AND GET THE REST
	ISZ	DSKX
	DCA	DSK2
	TAD I	DSKX
	ISZ	DSKX
	DCA	DSK3
	TAD I	DSKX
	ISZ	DSKX
	DCA	DSK4
	JMS I	DKDT		/NOW CALL COMMON DSK/DTA CODE
	DSKQ
	4554			/"DK"
DSK1,	0			/LOW BLK # + JOB #
DSK2,	0			/R/W,LEN,FLD,UNIT
DSK3,	0			/CORE ADDR
DSK4,	0			/HIGH BLK #
	JMP I	DSKX
DKDT,	DSKDTA
E9,	4752	/"FILE NOT FOUND"
	5546
	0157
	6065
	0147
	6066
	5745
	0000
E10,	5264	/"IS THIS THE RIGHT FORM?"
	0165
	5152
	6401
	6551
	4601
	6352
	5051
	6501
	4760
	6356
	4000

E11,	6066	/"OUTPUT, UPDATE, APPEND, OR INQUIRY? "
	6561
	6665
	1501
	6661
	4542
	6546
	1501
	4261
	6146
	5745
	1501
	6063
	0152
	5762
	6652
	6372
	4000
E12,	5742		/"NAME OF FORM: "
	5646
	0160
	4701
	4760
	6356
	3300
E15,	5220		/"I/O ERROR; RETRY? "
	6001
	4663
	6360
	6334
	0163
	4665
	6372
	4001
	0000
E25,	5746		/"NEW KEY? "
	7001
	5446
	7240
	0100
	DSKXND=	.
/
	*NEWDSK+200

/THE PATCH FOR THE BACKGROUND DTA HANDLER
	NEWDTA=	.
	NOPUNC
	*6610
IFNDEF OVERLA <	ENPUNC >
DTAX,	0
	DCA	DTA1
	TAD I	DTAX
	ISZ	DTAX
	DCA	DTA2
	TAD I	DTAX
	ISZ	DTAX
	DCA	DTA3
	TAD I	DTAX
	ISZ	DTAX
	DCA	DTA4
	JMS	DSKDTA
	DTAQ
	4565			/"DT"
DTA1,	0
DTA2,	0
DTA3,	0
DTA4,	0
	JMP I	DTAX

DSKDTA,	0			/COMMON CODE FOR DSK AND DTA
	JMS	DDARG
	DCA	DDCALL		/ADDR OF QUEUE
	JMS	DDARG
	DCA	DDNAME		/"DK" OR "DT"
	JMS	DDARG		/THIS CODE IS REDUNDUNDENT FOR DTA
	DCA	DTA1
	JMS	DDARG
	DCA	DTA2
	JMS	DDARG
	DCA	DTA3
	JMS	DDARG
	DCA	DTA4
	TAD	DTA2		/SEE WHAT FIELD WE'RE READING INTO
	SMA			/ONLY WORRY ABOUT IT ON READS
	AND	P70		/IF READ
	SZA CLA			/IS IT FIELD 0?
	JMP	DDOP2		/IF NOT 0, NO PROBLEMS
	TAD	DTA3
	SZA CLA			/AND LOCATION 0?
	JMP	DDOP2		/NOPE, WE'RE OK
	TAD	DTA2		/IF SO, BREAK OPERATION INTO TWO PARTS
	TAD	P7600		/SO LOCATION 0 DOESN'T DISAPPEAR AT RANDOM TIMES
	DCA	DTA2A		/WHEN WE'RE SERVICING AN INTERRUPT
	TAD	DD400		/WE ASSUME THERE WILL NEVER BE A 1-PAGE READ
	DCA	DTA3		/INTO JUST 0000-0177
	TAD	DTA2
	AND	P77
	TAD	DD200		/SO READ WHAT SHOULD BE 0-377 INTO 400-777
	DCA	DTA2
	JMS	DDOPR
	TAD	P7400		/NOW MOVE 400-777 DOWN TO 0-377
	DCA	DDCT
	DCA	DDY
	TAD	DD400
	DCA	DDX
/FLIP THE PAGE

P0MOVE,	TAD I	DDX
	ISZ	DDX
	DCA I	DDY
	ISZ	DDY
	ISZ	DDCT
	JMP	P0MOVE		/SHUFFLE OFF TO BUFFALO
	TAD	DTA2A
	AND	DD3700
	SNA CLA			/PERCHANCE WAS THERE JUST 0-377 TO READ?
	JMP I	DSKDTA		/YUP
	TAD	DTA2A		/FIX UP FOR 2ND PART OF OPERATION
	DCA	DTA2
	CLL
	TAD	DTA1		/BUMP UP BLOCK # BY 1
	TAD	DD400
	DCA	DTA1
	SZL			/NEED WE BUMP THE HIGH PART?
	ISZ	DTA4		/YUP
DDOP2,	JMS	DDOPR
	JMP I	DSKDTA

DDOPR,	0
DDTRY,	TAD	DDDTA1
	IOF
	IF102=	.-10&177+NEWDTA
	IF103			/CIF N (GETS SET UP) *****
	JMS I	DDCALL		/QUEUE UP REQUEST, RETURN WITH IOF
	TAD	KDBIT
	IF105=	0
	IF104=	.-10&177+NEWDTA
	IF105			/CIF N (GETS SET UP) *****
	JMS I	KSLEEP
	DF101=	.-10&177+NEWDTA
DKDTWT,	DF102
	TAD I	DDWT
	CDF 0
	SMA CLA
	JMP I	DDOPR
	DF102=	.-10&177+NEWDTA
	DF103
	DCA I	DDWT		/CLEAR ERROR BIT
	CDF 0
	TAD	DDNAME
	JMS I	DDIODI
	JMP	DDTRY
DDARG,	0
	TAD I	DSKDTA
	ISZ	DSKDTA
	JMP I	DDARG
DDX,	0
DDY,	0
DDCT,	0
DTA2A,	0
DD400,	400
KSLEEP,	SLEEP
KDBIT,	1000			/MAKE SURE DDDBIT IS DEFINED AS L1000
DD200,	200
DD3700,	3700
DDDTA1,	DTA1-1
LPUSHJ,	PUSHJX
DDWT,	DDWAIT			/ !
DDNAME,	0
DDIODI,	IODIE
DDCALL,	0			/EITHER DSKQ OR DTAQ
E14,	4460			/"CONFIRM: "
	5747
	5263
	5633
	0100
	DTAXND=	.
/
	*NEWDTA+200

/%BLOCK 26 AT 2400
/%BLOCK 27 AT 3000
/%BLOCK 30 AT 3400
/%BLOCK 31 AT 4000
/%BLOCK 32 AT 4400
/%BLOCK 33 AT 5000
/%BLOCK 34 AT 5400
/%BLOCK 35 AT 6000
/%BLOCK 36 AT 6400
/%BLOCK 37 AT 7000
/%BLOCK 40 AT 7400
/////////////////////////
/			/
	FIELD 2		
/			/
/////////////////////////
/END OF FGBG1.PA