/OVERLAY FOR FGBG		EDITED 10/24/73
/COPYRIGHT 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASS.  01754
/
/SGW&JGD
/
/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.
/
	FORMVR=	2		/VERSION OF FORMS COMPILER WE NEED
	MONVER=	1		/VERSION OF MONITOR WE NEED

/OVERLAY #	BLOCK #	ASSEMBLED AT	FUNCTION
/---------------------------------------------------
/  -1		  1,2	  10000		  INIT
/---------------------------------------------------
/   0		  3,4	  11000		  OUTPUT
/---------------------------------------------------
/   1		  5,6	  12000		  UPDATE
/					  INQUIRY
/---------------------------------------------------
/   2	  	  7,10	  13000		  APPEND
/---------------------------------------------------
/   3		11,12	  14000
/---------------------------------------------------
/   4		13,14	  15000		  LOGIN
/---------------------------------------------------
/   5		15,16	  16000
/---------------------------------------------------
/    6		17,20	  00000
/---------------------------------------------------
/   7		21,22	  01000
/---------------------------------------------------
/  S0		23	  02000	  UPDATE SUPPLEMENT
/---------------------------------------------------
/  S1		24	  02400	  APPEND SUPPLEMENT
/---------------------------------------------------
/"BLOCK #"  IS ACTUAL BLOCK #, AS REFERENCED BY PATCH PROGRAM.
/OVERLAY #  -1 IS CALLED BY CALLX.
/OVERLAY #S 0-7 ARE CALLED BY INITMT.
/OVERLAY #  S0 IS CALLED BY OVERLAY #1.
/OVERLAY #  S1 IS CALLED BY OVERLAY #2.

/ASSEMBLY INSTRUCTIONS
/.R PAL8
/*OVERLA,OVERLA=OVERLA,FGBG1,FGBG2,FGBG3,FGBG4/K
/.R ABSLDR
/*OVERLA$
/.SAVE DTAN:OVERLA 0-2777,10000-16777;7600

/////////////////////////
/			/
/   OVERLAY # -1	/
/			/
/     BLOCK # 1,2	/
/			/
/////////////////////////
OVERLA=0
FIELD 1
*0000
ANDC=0200
TADC=1200
ISZC=2200
DCAC=3200
JMSC=4200
JMPC=5200
/THAT SHOULD FIX PAL8 FOR PAGE 0 MRI'S

/INITIALIZER
INIT,	JMS	CDFT
	TADC I	(VERSION	/GET MONITOR VERSION #
	TADC	(-MONVER
	SZA CLA			/COMPARE IT WITH WHAT WE WANT
	HLT			/CRUDE BUT EFFECTIVE
	UDF
	JMSC	SETUP1
PINIT3,	INIT3-.
PINPUT,		INPT-.
PTYPCH,		TYPCHR-.
PLOKUP,		LOKUP-.
OBASE,		-.-1400		/BASE
PPARMO,		PARMOV-.-1
PTRIN,		0000		/MUST BE 0000 SEE SETUP1
CTR,		SU2-.
TYPE,	0000			/TYPE A CHARACTER, ONLY 1 USER WILL BE USING THIS SO A JMS IS PERMITTED
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	TTOCHR
	JMPC I	TYPE
OVREAD,	0000
	CLA CLL			/SO TTICHR DOESN'T BLOW ITS MIND FROM INPT2
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	TTICHR
	JMPC I	OVREAD
SENDE,	0000			/SEND OUT THE "E" MESSAGES
	TADC I	SENDE
	JMS	CIFT
	PUSHJ
	ROW20
	ISZC	SENDE
	JMPC I	SENDE

INIT2,	TADC	O201
	JMS	CIFT		/HOME
	PUSHJ
	CAD
	TAD	L237
	JMSC	TYPE		/EOS, ERASE SCREEN
	JMSC	SENDE
	WFITBU			/WHICH FORM IS TO BE USED?
	TAD	L237
	DCAC I	PTYPCH		/SET UP FOR 6 BIT ASCII (NOT COSCII)
	JMSC I	PINPUT
	DCAC I	PTYPCH		/SETUP FOR COS
	JMSC I	PLOKUP
	JMPC	NOTFOU		/FILE NOT FOUND
FOUND,	CLL RTR			/HAVE BLOCK NUMBER IN AC, DO SPLIT
	RTR	RAR
	DCAC	OVREAD
	TADC	OVREAD
	AND	L7400		/LOW  ORDER ADDRESS
	DCAC	PARMOV
	TADC	OVREAD
	RAL
	AND	L377
	DCAC	SETUP1
	TADC	PPARMO
	JMS	CIFT
	PUSHJ
	CALLX
	TAD	L0004
	TADC	OBASE
	DCAC	PTRIN
	TADC I	PTRIN		/GET VERSION # OF FORMS COMPILER
	TADC	(-FORMVR
	SZA CLA			/IS IT WHAT WE WNAT?
	HLT			/NOPE
	AC7777			/ONE FOR WORD COUNT
	TADC I	OBASE		/GET WORD COUNT, 1ST RECORD
	CIA
	TADC	OBASE		/ADD IN BASE ADDRESS OF BUFFER
	DCAC	PTRIN
LOOP,	TADC I	PTRIN
	SNA CLA			/SEE IF END OF LIST
	JMPC I	PINIT3		/END
	TADC	PTRIN
	DCAC	OVREAD		/ENTER WITH POINTER TO
	TADC I	OVREAD		/R,C,-WC,TEXT
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	CAD			/POSITION CURSOR
	ISZC	OVREAD
	TADC	OVREAD		/GET POINTER TO TEXT
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	USRPRT			/SEND OUT THE FIELD DESCRIPTOR TEXT
	ISZC	PTRIN
	TADC I	PTRIN
	AND	L77
	SZA CLA
	JMPC	.-4
	ISZC	PTRIN
	JMPC	LOOP
O201,	201
PMCHRCT,	MCHRCT

NOTFOU,	CLA CLL
	JMSC	SENDE
	FNOTF			/FILE NOT FOUND!
	JMS	CIFT
	PUSHJ
	CRWAIT			/WAIT FOR CARRIAGE RETURN
	JMPC	INIT2
PARMOV,	0000			/LOW ORDER ADDRESS GOES HERE
	0600			/READ IN 3 BLOCKS
	0000			/INTO THE BASE ADDRESS
SETUP1,	0000			/HIGH ORDER ADDRESS GOES HERE
				/SETS UP A LINK LIST OF RELATIVE POINTERS
SET1LP,	TADC I	SETUP1
	SZA
	JMPC	SETUPA
	ISZC	SETUP1
	TADC I	SETUP1
	SNA
	JMPC I	SETUP1
	TADC	SETUP1
	DCAC	SETUP1
	JMPC	SET1LP
SETUPA,	TADC	SETUP1
	DCAC I	SETUP1
	ISZC	SETUP1
	JMPC	SET1LP
/
PAGE

O2002,	2002
INIT3,	TAD	L7400		/PUT SPACES IN T(N) REGISTERS NOW
	DCA	TEMP
	TAD	O2002		/FIRST CHARACTER OF RECORD IMMAGE
	DCA	XCHRNUM		/CHARACTER POSITION OR COUNT
	TAD	OBASE2
	DCA	PTR2		/WHERE PTFD'S GO
ZROFIL,	TAD	O0101
	DCA I	PTR2
	ISZ	PTR2
	ISZ	TEMP
	JMP	ZROFIL
	TAD	OBASE2
	DCA	PTR2
	DCA I	PTR2		/0000 AT BEGINNING SO LEFT ARROW DOESN'T GO OFF OF FORM
	ISZ	PTR2
	ISZ	PTR2
	TAD	OBASE2		/TEXT ON SCREEN, NOW FOR THE INITIAL VALUES
	TAD	L0400		/FORMS DISCRIPTOR BLOCK DISPLACEMENT
INIT4,	DCA	PTR1		/WHERE FORM DESCRIPTORS ARE
	DCA	SU2
	TAD I	PTR1
	SNA
	JMP	INIT7
	STA
	TAD	PTR1
	DCA I	PTR2		/POINTS TO FIELD DESCRIPTOR-1 FOR PTFD
	ISZ	PTR2
	TAD	XCHRNUM
	DCA I	PTR2		/CHARACTER NUMBER
	ISZ	PTR2
	ISZ	PTR1
	TAD I	PTR1		/GET WC
INIT6,	CIA			/MAKE POSITIVE
	DCA	TEMP		/SAVE SIZE FOR NOW
	TAD	TEMP
	TAD	XCHRNUM		/ADD PREVIOUS POSITION
	DCA	XCHRNUM		/AND UPDATE
	ISZ	PTR1
	TAD I	PTR1		/IS IT NUMERIC?
	SPA
	ISZ	SU2		/YES ADD 1 FOR EXTRA CHAR
	AND	MASKR		/R(M,N)?
	SZA CLA
	TAD	TEMP		/YES, BUMP IT BY THE SIZE OF THE FIELD
	TAD	SU2		/ANY EXTRA CHARACTERS?
	IAC			/AND EXTRA CHAR+1
	TAD	PTR1		/TO PTR1
	JMP	INIT4

LHUMA,	"U-"A^100
LHOMU,	"O-"U^100
LHAMI,	"A-"I^100
PTR2,	0000
SU2,	.
OBASE2,	INIT-1400-.		/INIT GOES IN AT BASE + 1400
KSENDE,	SENDE-.
KINPUT,	INPT-.
PINIT2,	INIT2-.
PTOVLA,	TOVLA-.
XCHRNUM,
INBUF,	0000
INB1,	SU3-.			/6 CHARACTER INPUT BUFFER
PTR1,	0000
EXTEN,	406			/EXTENSION ".DF" FOR DIBOL FORM FILE
O0101,	0101			/"0","0"
PJOB,	JOB
PLB1M6,	LABEL1-LAB11J
PLB11J,	LAB11J-6
KUPDDIS,	UPDDIS
INIT7,	ISZ	PTR1
	TAD I	PTR1
	SZA			/IS THIS THE END OF THE FORM???
	JMP	INIT6		/NO
	DCA I	PTR2		/PUT 0 IN THE END OF THE LIST
	JMS	CDFT
	DCA I	KUPDDIS		/MAKE SURE WE'RE AT RECORD IMAGE NOW
	UDF
	JMS	CIFT
	PUSHJ
	LISTIT
	JMS I	KSENDE
	ITTRF
	JMS	CIFT
	PUSHJ
	YESNO
	SZA CLA
	JMP I	PINIT2		/NOT RIGHT ONE TRY AGAIN
YES,	JMS I	KSENDE
	OORU			/OUTPUT OR UPDATE?
	JMS I	KINPUT
	TAD	INBUF
	AND	L7700		/CHECK ONLY FIRST CHAR
	TAD	L2000		/-O HAPPENS TO EQUAL 2000 SO WE USE THE CONSTANT
	SNA
	JMP	OUTPUT
	TAD	LHOMU		/O-U
	SNA
	JMP	UPDATE		/ITS A U
	TAD	LHUMA		/"U-"A
	SNA
	JMP	APPEND
	TAD	LHAMI		/"A-"I SEE IF INQUIRE
	SZA CLA
	JMP	YES		/NOT OUTPUT, UPDATE, APPEND OR INQUIRE TRY AGAIN
INQUIR,	TAD	L0400
	SKP
APPEND,	TAD	L1000
UPDATE,	TAD	L1000
OUTPUT,	DCA I	PTOVLA
	JMS I	KSENDE
	LODF			/"LABLE OF DATA FILE:"
	JMS I	KINPUT
	JMS	CDFT
	TAD	LMJOBS		/SEE IF 1 JOB
	DCA	TEMP
	TAD I	PJOB		/WHO ARE WE?
	CLL RAL
	TAD I	PJOB
	RAL			/JOB*6
	ISZ	TEMP
	TAD	PLB1M6
	TAD	PLB11J
	DCA	TEMP5		/POINTS TO BUFFER
	TAD	INBUF
	DCA I	TEMP5
	TAD	INB1
	ISZ	TEMP5
	DCA I	TEMP5
	ISZ	TEMP5
	UDF
	TAD I	PNBF2
	JMS	CDFT
	DCA I	TEMP5
	TAD	CDFFGM
	JMS	CIFT
	DCA	.+1
	0000			/BECAUSE CIFT CHANGES DATA FIELD TO HERE
	TAD	TOVLA		/OVERLA NUMBER
	TAD	TUNIT		/TRIAL UNIT IF ANY
	JMP I	.+1		/WHY PUSHJ IF I DON'T COME BACK HERE
	INITMT			/INITIALIZE MOUNT
TOVLA,	0000

TUNIT,				/TRIAL UNIT #
SU3,	.
ITYPE,	TYPE-.
PNBF0,	INBUF-.
PNBF1,	INBUF+1-.
PNBF2,	INBUF+2-.
IREAD,	OVREAD-.
POINNU,	OINNUM-.
TYPCHR,	0000
NUM,	SU4-.			/AND ESCAPE TO THE NEXT PAGE
RCINPT,	RCERR+35+10		/AS GOOD AS PLACE AS ANY
PINBUF,	INBUF-INIT+1400^2	/CHARACTER # OF LEFT HALF OF INBUF
SEQUEN,	W5			/SEQUENCE # GOES INTO W5
INPT,	0000
INPTL,	TAD	RCINPT
INCIFT,	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	CAD
	TAD	L237		/EOS
	JMS I	ITYPE
	TAD	PINBUF		/CHARACTER NUMBER
	JMS	CDFT
	DCA I	(CHRNUM		/PUT IT IN CHRNUM
	DCA I	SEQUEN		/CLEAR OUT SEQUENCE NUMBER
	UDF
INPT1,	DCA	CTRIPT		/ZERO OUT CHARACTER COUNTER
INPT2,	JMS I	IREAD
	TAD	(-215
	SZA
	JMP	INPT4
INPT3,	DCA	TUNIT		/CLEAR OUT UNIT#
INPT3L,	TAD	CTRIPT
	TAD	(-6
	SMA CLA
	JMP I	INPT
	TAD	TYPCHR
	SNA
	TAD	L0040
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	PUTPUT			/OVERLAY "PUTCHR"
	ISZ	CTRIPT
	JMP	INPT3L

INPT5,	TAD	(203-377
	SNA			/RUBBOUT?
	JMP	INPTL		/YES
	TAD	(377-240
	SPA
	JMP	INPT2
	TAD	(240-"#
	SNA
	JMP	INPT6		/GET SEQUENCE NUMBER
	TAD	("#-"/
	SNA
	JMP	INPUT9
	TAD	("/
	DCA I	IREAD		/SAVE THE RESTORED CHARACTER
	TAD	CTRIPT
	TAD	(-6		/CHECK FOR OVER FLOW
	SMA CLA
	JMP	INPT2		/ON TOO MANY CHARACTERS WE SIMPLY IGNORE THEM
	TAD I	IREAD		/OK TO PRINT THE CHAR
	JMS I	ITYPE
	TAD I	IREAD
	TAD	TYPCHR		/0 IF COS 6 BIT, 237 IF ASCII 6 BIT
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	PUTPUT
	ISZ	CTRIPT
	JMP	INPT2
INPT6,	TAD	("#
	JMS I	ITYPE		/PRINT IT
	JMS I	POINNUM
	DCA	TEMP5
	STA
	TAD	NUM		/YES GET THE NUMBER-1
	JMS	CDFT
	DCA I	SEQUEN
	UDF
	TAD	TEMP5
	TAD	(-215		/WAS IT TERMINATED BY A CARRIAGE RETURN?
	SNA
	JMP	INPT3
INPUT7,	TAD	(215-"/
	SZA CLA			/TRIAL UNIT?
	JMP	INPTL		/NO ILLEGAL CHARACTER TRY AGAIN
INPUT8,	JMS I	POINNUM		/YES GET THE NUMBER
	TAD	(-215		/ONLY CARRIAGE RETURN PERMITTED HERE
	SZA CLA
	JMP	INPTL
	TAD	NUM
	JMP	INPT3
INPUT9,	TAD	("/		/ECHO "/"
	JMS I	ITYPE
	JMP	INPUT8

INPT4,	TAD	L12		/(215-203)	/^C?
	SZA
	JMP	INPT5
	TAD	INCIFT
	IAC			/FORM CIF CDF
	DCA	CTRIPT
CTRIPT,	0
	JMP I	(START		/GO BACK TO LOGIN
/
PAGE

OINNUM,	0000
INNUM1,	DCA I	PNUM		/ENTER WITH AC=0 PLEASE
	JMS I	PREAD
	DCA	LOKUP
	TAD	LOKUP
	JMS I	PTYPE
	TAD	LOKUP
	TAD	(-":
	CLL
	TAD	(12
	SNL
	JMP	NOTNUM
	DCA	LOKUP		/SAVE IT WHILE WE
	TAD I	PNUM		/MULTIPLY NUM BY 10
	CLL RTL
	TAD I	PNUM
	RAL
	TAD	LOKUP
	JMP	INNUM1
NOTNUM,	TAD	L260
	JMP I	OINNUM
LOKUP,	0000
	CLA CLL
	DCA	DIRBLK		/ SO WE GET FIRST DIRECTORY BLOCK
	JMS	XMRDCA		/GET FIRST CAT BLOCK
	JMS	XMDSRC		/SEARCH FOR ENTRY
	JMP I	LOKUP		/COULDN'T FIND IT
	TAD	XSBLOC
	CIA
	TAD I	PSBLOC
	ISZ	LOKUP
	JMP I	LOKUP		/FOUND IT LEAVE WITH BLOCK NUMBER IN AC
XMRDCA,	0000
MRDEN,	TAD	DIRBLK
	TAD	L0400		/NEXT BLOCK
	DCA	DIRBLK
	TAD	PDIRBL
	JMS	CIFT		/CHANGES TO "CIF T"
	PUSHJ
	CALLX
	DCA	XSBLOC		/# OF BLOCKS FROM STARTING BLOCK
	TAD I	DIRBUF
	DCA	CNTR		/-# OF ENTRIES
	TAD	PWASTE
	DCA	XR15
	JMP I	XMRDCA

XMDSRC,	0000
XFSRCL,	TAD	XPTNAM
	DCA	XR16
	TAD	M4
	DCA	XCT
	TAD I	XR15
	SNA
	JMP	XSKPMT
	SKP
XSRCWD,	TAD I	XR15
	CIA
	TAD I	XR16
	SZA CLA
	JMP	XNXTFI
	ISZ	XCT
	JMP	XSRCWD
	JMS	XBUMPX
	TAD I	XR15
	SNA CLA
	JMP	XSKPM3
	ISZ	XMDSRC
	JMP I	XMDSRCH
XNXTFI,	TAD	XCT
	IAC
	JMS	XBUMPX
XSKPMT,	TAD I	XR15
	TAD	XSBLOC
	DCA	XSBLOC		/UPDATE BLOCK COUNT
XSKPM3,	ISZ	CNTR
	JMP	XFSRCL
	TAD I	PLINK
	SZA CLA
	JMP	MRDEN		/BLOCKS BETTER BE LINKED ONE AFTER ANOTHER
	JMP I	XMDSRC
XBUMPX,	0000
	TAD	I PWASTE
	CIA
	TAD	XR15
	DCA	XR15
	JMP I	XBUMPX
DIRBLK,	0000
	200			/ONE BLOCK
	0000
	0000			/HIGH ORDER ADDRESS

SU4,	.
XPTNAM,		INBUF-.-1
PDIRBL,		DIRBLK-.-1
DIRBUF,		INIT-1400-.	/THIS BETTER BE EQUAL TO BASE
PSBLOC,		INIT-1400-.+1
PLINK,		INIT-1400-.+2
PWASTE,		INIT-1400-.+4
CNTR,		INIT2-.
PNUM,		NUM-.
PREAD,		OVREAD-.
PTYPE,		TYPE-.
XCT,		0000
	0000			/END OF LINKED LIST
XSBLOC,	JMP I	CNTR
	PAGE

/////////////////////////
/			/
/   OVERLAY # 0		/
/			/
/     BLOCK # 3,4	/
/			/
/////////////////////////
/MOUNT	OVERLAY FOR OUTPUT
/THE FIRST PAGE OF IT SETS UP ALL THE CDF'S AND POINTERS NEEDED ON THE
/OTHER PAGES  ACCORDING TO WHERE THIS CODE GETS LOADED.  THIS CODE GETS
/READ INTO A JOB'S I/O BUFFERS TO BE EXECUTED BY THE ROUTINE "INITMT".
/AFTER PAGE 1 HAS DONE ITS THING, THAT PAGE IS USED AS A BUFFER FOR THE
/FIRST HALF OF BLOCK 0 OF THE LOGICAL UNIT SO THAT THE UNIT LABEL CAN
/BE CHECKED.  YOU ENTER THIS ROUTINE WITH CDF = FGM FIELD AND WITH THE
/TRIAL UNIT (IF ANY) IN THE AC, + OVERLAY OFFSET.
/ONE KLUDGE - TO TELL WHO CALLS IT, IF IT'S CALLED BY FOREGROUND
/OVERLAY, WHICH DOES A JMP TO INITMT, THE TRIAL UNIT IN AC IS 00XX.
/IF IT'S CALLED BY THE WRITE ROUTINE TO GET THE NEXT UNIT FOR
/OUTPUT (AND THEREFORE THERE IS NO TRIAL UNIT) THE AC = 04XX.
/LOADS INTO 000-177 DATA BUFFER 0
MOUNT,	DCA	.		/SAVE TRIAL UNIT (MAYBE)
MTJOB,	TAD I	(JOB
SEQNOT,	DCA	MTJOB
MTT1,	TAD I	(W5		/GET SEQUENCE # 
MTT2,	DCA	SEQNOT
SEQPTR,	UDF
	JMS	SETUP2		/FIX UP INTER-PAGE POINTERS
SEQNOX,	SEQNO-.
E7REL,	E7-.
RETRSW,	ISZJMP-.
MEOSX,	MEOS-.			/ *** MUST PRECEED DOMESX! ***
DOMESX,	DOMES-.			/ *** MUST FOLLOW MEOSX! ***
UNITNX,	UNITNO-.
LBLPTX,	LBLPTR-.
	0000
	PG2-.			/SET UP NEXT PAGE
PG1R,	TAD	MOUNT
	TAD	L7400
	SZL			/WHO CALLED US?
	ISZ I	RETRSW		/THE WRITE ROUTINE - BUMP PAST ENTRY IN TABLE
	AND	L17		/REMOVE ANY EXTRANIOUS BITS
	SPA SNA
	ISZ	XITJMP		/BUMP IF NO TRIAL UNIT SO WE ASK MOUNT MESSAGE
	DCA I	UNITNX		/PUT TRIAL UNIT WHERE IT BELONGS NOW
	AC0001			/CHECK IF 1 JOB
	TAD	LMJOBS
	SNA CLA
	ISZ	LBLBMP		/IF ONE JOB
	TAD	MTJOB		/MULTIPLY JOB # BY 6
	CLL RAL
	TAD	MTJOB
	RAL
LBLBMP,	TAD	LBLX6		/FORM POINTER TO WHERE FILE LABEL IS
	DCA I 	LBLPTX
	TAD I	LBLPTX
	TAD	L0004		/FORM PTR TO SEQUENCE # PLACE
	DCA	SEQPTR
	DCA	MTT2		/0 COUNTER
REPEAT,	ISZ	SEQNOT		/BUMP SEQ. #
	TAD	SEQNOT
	AND	L77
	SNA			/OVERFLOWED 77?
	JMP	BADSEQ		/YUP
REPTLP,	ISZ	MTT2
	TAD	(-12		/DIVIDE IT BY 10
	SMA
	JMP	REPTLP
	DCA	MTT1
	TAD	MTT2
	CLL RTL
	RTL
	RTL
	TAD	MTT1
	TAD	(2033		/MAGIC # TO MAKE IT -237 ASCII
	JMS	CDFT		/CDF FGM
	DCA I	SEQPTR		/PUT IT IN PLACE TO PRINT
	TAD I	(W1
	AND	L17		/GET PREVIOUS LOGICAL UNIT # THIS JOB HAD
	SNA			/WAS THERE ONE?
	JMP	NOUNIT		/NOPE - SKIP THIS STUFF
	DCA	MTT1
	TAD	MTT1
	CLL RAL
	TAD	MTT1
	TAD	(UTBASE		/FORM PTR TO ITS PLACE IN LOGICAL UNITS TABLE
	DCA	MTT1
	TAD I	(HANDLR		/GET SAVED VALUE OF THAT WORD
	DCA	MTT2
	CDF 0
	TAD I	MTT1		/SEE WHAT THAT WORD IS NOW
	TAD	(-5400		/5400 MEANS UNDEFINED OR IN USE BY FG JOB
	SZA CLA
	JMP	NOUNIT		/IT'S NOT IN USE BY ANYBODY INCLUDING US
	TAD	MTT2
	DCA I	MTT1		/RESTORE THE OLD VALUE OF THE WORD
NOUNIT,	UDF
	TAD	SEQNOT
	TAD	L0400		/LABELS ON UNITS HAVE THIS BIT SET
	DCA I	SEQNOX		/SAVE THIS COMBINATION FOR USE ELSEWHERE
XITJMP,	JMP I	MEOSX		/MAY BE INCREMENTED

LBLX6,	LABEL1-6		/*** KEEP THESE TOGETHER! ***
	LAB11J-6
BADSEQ,	JMS	CIFT		/"SEQUENCE # TOO BIG"
	PUSHJ
	ROW20			/POSITION CURSOR
	TAD	E7REL		/"SEQUENCE # TOO BIG"
	JMS	CIFT
	PUSHJ
	USRPRT
	JMS	CIFT
	PUSHJ
	CRWAIT
	JMP	REPEAT		/IF SEQUENCE # OVERFLOW, START AT 1 AGAIN
SETUP2,	0000
SET2LP,	TAD I	SETUP2
	SZA
	JMP	SETUPB
	ISZ	SETUP2
	TAD I	SETUP2
	SNA
	JMP I	SETUP2
	TAD	SETUP2
	DCA	SETUP2
	JMP	SET2LP
SETUPB,	TAD	SETUP2
	DCA I	SETUP2
	ISZ	SETUP2
	JMP	SET2LP
/
	PAGE

/PAGE 2 OF THE OUTPUT MOUNT OVERLAY
/IT PRINTS THE MESSAGE, GETS THE RESPONSE, AND SEES IF IT'S OK
/LOADS INTO 200-377 DATA BUFFER 0
UNITNO,
PG2,	.
OKX,	OK-.
FOROUT,	E3-.
MNTCTR,
DIGIT,	0
MNTTMP,	PG3-.
K7770,
DOMES,	SMA SZA SNL SKP CLA	/NECESSARY CLA (OF SOME VARIETY)
K11,	11			/IT'LL ALWAYS SKIP
	TAD	(MNTMSG		/GET PTR TO MOUNT MESSAGE
	JMS	CIFT		/CIF FGM
	PUSHJ
	ROW20			/"MOUNT "
	TAD	LBLPTR		/GET PTR TO LABEL
	JMS	CIFT
	PUSHJ
	FAKEIT			/"LABEL # XX "
	TAD	FOROUT
	JMS	CIFT
	PUSHJ
	USRPRT			/"FOR OUTPUT: "
NXTDIG,	DCA	UNITNO		/NOW ASSEMBLE AN ANSWER AS IT'S TYPED
	JMS	CIFT
	PUSHJ
	TTICHR
	TAD	(-203
	SNA			/^C?
	JMP	ABRTX		/^C IT IS
	TAD	(203-215
	SNA			/CAR. RET?
	JMP	MEOS
	TAD	(215-272	/CHECK FOR DIGIT 0-9
	CLL IAC
	TAD	K11
	SNL
	JMP	DOMES		/NOT A DIGIT - REPEAT MESSAGE
	DCA	DIGIT
	TAD	DIGIT
	TAD	L260
	JMS	CIFT
	PUSHJ
	TTOCHR			/ECHO
	TAD	UNITNO		/GET OLD
	CLL RTL			/MULTIPLY BY 10
	TAD	UNITNO
	RAL
	TAD	DIGIT		/ADD IN NEW
	JMP	NXTDIG		/& KEEP GOING
ABRTX,	JMS	CIFT
	JMP I	(ABORT		/GIVE UP

MEOS,	TAD	UPLIM		/CHECK FOR BEING WITHIN GOOD RANGE
	TAD	UNITNO
	CLL
	TAD	DIFF
	SNL CLA
	JMP	BADUNT		/NO GOOD
	TAD	K7770		/SET UP TO SPY ON BACKGROUND DOINGS
	DCA	MNTCTR
	TAD	(FTBASE+1
	DCA	MNTTMP
	CDF 0
CHKLP,	TAD I	MNTTMP		/GET WORD FROM BACKGROUND FILE TABLE
	AND	L17		/GET UNIT # IT'S USING
	CIA
	TAD	UNITNO		/COMPARE WITH WHAT WE WANT TO USE
	SNA CLA			/CAN WE?
	JMP	INUSE		/TOO BAD, SOMEBODY BEAT US TO IT
	TAD	MNTTMP
	TAD	K11		/BUMP TO NEXT IN TABLE
	DCA	MNTTMP
	ISZ	MNTCTR
	JMP	CHKLP
	TAD	UNITNO		/NOT BEING USED BY BACKGROUND...
	CLL RAL
	TAD	UNITNO		/SEE IF FOREGROUND IS USING IT
	TAD	(UTBASE		/OR IF IT'S EVEN DEFINED
	DCA	MNTTMP
	TAD I	MNTTMP		/IF IT'S IN USE OR UNDEFINED THIS WORD = 5400
	TAD	(-5400
	SZA
	JMP	UNITOK		/IT'S OK TO USE
	ISZ	MNTTMP		/IN USE OR UNDEFINED....
	ISZ	MNTTMP		/FIND OUT WHICH
INUSE,	TAD I	MNTTMP		/IF JUST IN USE THIS WORD NON-0
	SZA CLA
	TAD	(INUSMG-UNDFMG
	TAD	(UNDFMG-ILLUNT
BADUNT,	TAD	(ILLUNT
	UDF			/SO PUSHJ DOESN'T GET MESSED UP
	JMS	CIFT		/CIF THERE
	PUSHJ
	MESYES			/"IN USE" OR "UNDEFINED UNIT" OR "ILLEGAL UNIT"
				/MESYES RETURNS SOMETHING IN AC...
	JMP	DOMES		/GO TRY AGAIN
UNITOK,	TAD	(5400
	DCA	MNTCTR
	TAD	(5400
	DCA I	MNTTMP		/SET AS UNDEFINED
	TAD	MNTCTR
	JMS	CDFT
	DCA I	(HANDLR		/SAVE FOR EVENTUAL RESTORATION
	TAD I	(HANDLR
	TAD	(-6610		/DTA'S WILL GIVE + AC, DSK'S WILL GIVE - AC
	SMA CLA			/???
	TAD	(DTAQ-DSKQ
	TAD	(DSKQ
	DCA I	(U0
	ISZ	MNTTMP
	TAD	MNTTMP		/CROSS PAGE BOUNDARY WITH PTR IN AC
	JMP I	OKX		/SO WE DON'T HAVE TO GET IT FROM THERE
LBLPTR,	0
/
	PAGE

/PAGE 3 OF THE OUTPUT MOUNT OVERLAY
/....NOW THAT WE'VE GOT IT, WHAT DO WE DO WITH IT
/LOADS INTO 000-177 DATA BUFFER 1
MC,
PG3,	.
RMX,	RM-.
QQQ,	MOUNT+1-.
UNTNX,	UNITNO-.
KMTLB1,	MTLBL1-.
LBLPX,	LBLPTR-.
MTOVBX,	MOUNT-.
KOOSIK,	OOSIK-.
MX,	0
MY,	PG4-.
OK,	DCA	MX
	CDF 0
	TAD I	MX		/GET U1 AND U2 ENTRIES
	JMS	CDFT		/...THERE OUGHT TO BE A BETTER WAY
	DCA I	(U1
	CDF 0
	ISZ	MX
	TAD I	MX
	JMS	CDFT
	DCA I	(U2
	TAD I	(HANDLR
	AND 	L7		/GET PHYSICAL UNIT #
	TAD	(4200		/SET WRITE, 1 BLOCK
	RIF			/SET CDF = USER'S FIELD (RIGHT HERE)
	DCA I	(W0
	TAD	MTOVBX		/GET BUFFER ADDR
	CLL RAR
	UDF
	TAD I	UNTNX
	JMS	CDFT
	DCA I	(W1
	TAD	MTOVBX
	DCA I	(W2		/SAVE AS INTERNAL PTR
	TAD	L7400		/IF WRITE, SET -400
	DCA I	(W3		/AS # OF WORDS LEFT IN BUFFER
	DCA I	(W4		/ZERO HIGH REL. BLK BITS
	TAD	SEQNO
	DCA I	(W5
	TAD	MTOVBX		/GET BASE OF I/O BUFFERS
	DCA	MX		/....THIS IS WHERE LABEL WILL BE
	UDF
	AC7777	
	TAD I	LBLPX
	DCA	MY		/THIS IS WHERE OUR LABEL IS
	TAD	M4
	DCA	MC
	JMS	CIFT
	PUSHJ
	RWBLK0			/GET LABEL ON THE DEVICE
	TAD	SEQNO
	JMP	HOPOVR

LBLCHK,	JMS	CDFT
	TAD I	MY		/GET LABEL WORD FROM TABLE
HOPOVR,	ISZ	MY
	CIA
	UDF
	ISZ	MX
	TAD I	MX		/GET LABEL WORD FROM UNIT
	SZA CLA
	JMP	BADLBL
	ISZ	MC
	JMP	LBLCHK
	JMP I	KOOSIK		/ESKIMOS FOREVER!
BADLBL,	DCA	MC
	TAD I	QQQ		/GET SEQ. # OF THE FILE ON THE UNIT
	AND	L77
	ISZ	MC
	TAD	(-12
	SMA
	JMP	.-3
	DCA	MX
	TAD	MC
	CLL RTL
	RTL
	RTL
	TAD	MX
	TAD	(2033		/MAGIC # TO MAKE IT -237 ASCII
	DCA	SEQPRT		/PUT IT IN PLACE TO PRINT
	TAD	QQQ
	DCA	MX
	TAD	KMTLB1
	DCA	MY
	AC7775
	DCA	MC
MVLBLP,	ISZ	MX		/MOVE IN OLD LABEL TO REPLACE MESSAGE
	TAD I	MX
	DCA I	MY
	ISZ	MY
	ISZ	MC
	JMP	MVLBLP
	TAD	MTLBL1		/LOOK AT FIRST CHAR IN FILE LABEL
	JMP I	RMX

REPMSG,	6346			/"REPLACE XXXXXX #XX ? "
	6155
	4244
	4601
MTLBL1,	0
	0
	0
	0104
SEQPRT,	0
	0140
	0100
SEQNO,	0
E7,	6446			/"SEQUENCE # TOO BIG"
	6266
	4657
	4446
	0104
	0165
	6060
	0143
	5250
	0000
/
	PAGE

/PAGE 4 OF THE OUTPUT MOUNT OVERLAY
/LOADS INTO 200-377 DATA BUFFER 1
PG4,
LBLPUT,	MOUNT+1-.
SEQPTX,	SEQNO-.
LBLXX,	LBLPTR-.
REPPTR,	REPMSG-.
PG1RX,	PG1R-.
DOMSXX,	DOMES-.
PG4T,	0000
	0000			/EXIT FOR SETUP2
PG4CTR,	JMP I	PG1RX
RM,	SMA CLA
	JMP	OOSIK		/IF + CONSIDER IT A SCRATCH FILE
	JMS	CIFT
	PUSHJ
	ROW20			/POSITION CURSOR WITHOUT PRINTING ANYTHING
	TAD	REPPTR
	JMS	CIFT
	PUSHJ
	USRPRT			/"REPLACE XXXXXX # XX ? "
	JMS	CIFT
	PUSHJ
	YESNO
	SNA CLA
	JMP	OOSIK		/YES
	JMS	CDFT
	TAD I	(W1
	CLL RAL
	TAD I	(W1		/GET LOGICAL UNIT # TIMES 3
	AND	L77
	TAD	(UTBASE		/FORM POINTER TO ITS ENTRY
	DCA	PG4T
	TAD I	(HANDLR		/GET OLD VALUE OF IT
	CDF 0
	DCA I	PG4T		/& PUT IT BACK
	UDF
	JMP I	DOMSXX		/& GO TRY AGAIN

OOSIK,	JMS	CDFT		/EITHER LABEL AGREES OR WE DON'T CARE
	DCA I	(UPDSIZ		/MAKE SURE THAT IT IS 0 FOR OUTPUT
	ISZ I	(UPDWRT		/FLAG IT FOR THE WRITE ROUTENE
	UDF
	TAD I	LBLXX		/GET PTR TO LABEL
	DCA	LBLXX
	TAD	M4
	DCA	PG4CTR
	TAD I	SEQPTX
	JMP	SKP4
MOVEIN,	JMS	CDFT
	TAD I	LBLXX
	ISZ	LBLXX
	UDF
SKP4,	DCA I	LBLPUT		/MOVE IN NEW LABEL FOR FILE
	ISZ	LBLPUT
	ISZ	PG4CTR
	JMP	MOVEIN
	CDF 0
	TAD I	L7777		/GET CURRENT DATE
	UDF
	DCA I	LBLPUT		/AND PUT THAT IN TOO
	JMS	CIFT
	AC4000			/FOR WRITE
	PUSHJ
	RWBLK0			/WRITE OUT BLK 0 OF LOGICAL UNIT WITH NEW NAME
MCIF,	JMS	CIFT		/USED ONCE ONLY SO IT UDF'S TOO
	PUSHJ
	ROW20			/GET RID OF THE MOUNT MESSAGE
	AC0001
	TAD	CIFFGM		/MAKE CIF CDF
	DCA	.+1
	0
ISZJMP,	JMP I	.+1		/BUMPED BY 1 IF CALLED FROM WRITE ROUTINE
	OUTP
	GOAHED
E3,	4760			/"FOR OUTPUT: "
	6301
	6066
	6561
	6665
	3301
	0000
/
PAGE

/////////////////////////
/			/
/   OVERLAY # 1		/
/			/
/     BLOCK # 5,6	/
/			/
/////////////////////////
/MOUNT	OVERLAY FOR UPDATE AND INQUIRY
/THE FIRST PAGE OF IT SETS UP ALL THE CDF'S AND POINTERS NEEDED ON THE
/OTHER PAGES  ACCORDING TO WHERE THIS CODE GETS LOADED.  THIS CODE GETS
/READ INTO A JOB'S I/O BUFFERS TO BE EXECUTED BY THE ROUTINE "INITMT".
/AFTER PAGE 1 HAS DONE ITS THING, THAT PAGE IS USED AS A BUFFER FOR THE
/FIRST HALF OF BLOCK 0 OF THE LOGICAL UNIT SO THAT THE UNIT LABEL CAN
/BE CHECKED.  YOU ENTER THIS ROUTINE WITH CDF = FGM FIELD AND WITH THE
/TRIAL UNIT (IF ANY) IN THE AC, AND BIT 3 SET IF DOING INQUIRY.
/LOADS INTO 000-177 DATA BUFFER 0
UMOUNT,	DCA	.		/SAVE TRIAL UNIT (MAYBE)
UMTJOB,	TAD I	(JOB
USEQNO,	DCA	UMTJOB
UMTT1,	TAD I	(W5		/GET SEQUENCE # 
UMTT2,	DCA	USEQNO
USEQPT,	UDF
	JMS	SETUP4		/FIX UP INTER-PAGE POINTERS
USEQNX,	USEQN1-.
UMEOSX,	UMEOS-.			/ *** MUST PRECEED UDOMEX! ***
UDOMEX,	UDOMES-.		/ *** MUST FOLLOW UMEOSX! ***
UUNITX,	UUNITN-.
UE7REL,	UE7-.
ZAPPTR,	INQZAP-.
UPDMGP,	UPINPG-.
ULBLPX,	ULBLPT-.
	0000
	UPG2-.			/SET UP NEXT PAGE
UPG1R,	JMS	CDFT		/CDF FGM FIELD
	TAD	UMOUNT
	AND	L0400		/SEE IF INQUIRE MODE
	CLL
	SZA CLA
	AC5777			/SET IN 6XXX FOR INQUIRE (SETS LINK TOO)
	TAD	L7		/+ AND > 1 FOR UPDATE
	DCA I	(UPDWRT		/MAGIC WORD
	UDF			/CDF THIS FIELD
	SNL			/UPDATE OR INQUIRE?
	JMP	OUN		/UPDATE
	TAD	(INQJMP&177+5200	/JMP INQJMP IN DISGUISE
	DCA I	ZAPPTR
	ISZ I	UPDMGP
OUN,	TAD	UMOUNT
	AND	L17		/CLEAR THE OFFSET
	SPA SNA
	ISZ	UXITJM		/BUMP IF NO TRIAL UNIT SO WE ASK MOUNT MESSAGE
	DCA I	UUNITX		/PUT TRIAL UNIT WHERE IT BELONGS NOW
	AC0001			/CHECK IF 1 JOB
	TAD	LMJOBS
	SNA CLA
	ISZ	ULBLBM		/IF ONE JOB
	TAD	UMTJOB		/MULTIPLY JOB # BY 6
	CLL RAL
	TAD	UMTJOB
	RAL
ULBLBM,	TAD	ULBLX6		/FORM POINTER TO WHERE FILE LABEL IS
	DCA I	ULBLPX
	TAD I	ULBLPX
	TAD	L0004		/FORM PTR TO SEQUENCE # PLACE
	DCA	USEQPT
	DCA	UMTT2		/0 COUNTER
UREPEA,	ISZ	USEQNO		/BUMP SEQ. #
	TAD	USEQNO
	AND	L77
	SNA			/OVERFLOWED 77?
	JMP	UBADSE		/YUP
OUD10,	ISZ	UMTT2
	TAD	(-12		/DIVIDE IT BY 10
	SMA
	JMP	OUD10
	DCA	UMTT1
	TAD	UMTT2
	CLL RTL
	RTL
	RTL
	TAD	UMTT1
	TAD	(2033		/MAGIC # TO MAKE IT -237 ASCII
	JMS	CDFT		/CDF FGM
	DCA I	USEQPT		/PUT IT IN PLACE TO PRINT
	UDF
	TAD	USEQNO
	TAD	L0400		/LABELS ON UNITS HAVE THIS BIT SET
	DCA I	USEQNX		/SAVE THIS COMBINATION FOR USE ELSEWHERE
UXITJM,	JMP I	UMEOSX		/MAY BE INCREMENTED

ULBLX6,	LABEL1-6		/*** KEEP THESE TOGETHER! ***
	LAB11J-6
UBADSE,	JMS	CIFT		/"SEQUENCE # TOO BIG"
	PUSHJ
	ROW20			/POSITIOIN CURSOR
	TAD	UE7REL
	JMS	CIFT
	PUSHJ
	USRPRT
	JMS	CIFT
	PUSHJ
	CRWAIT
	JMP	UREPEA		/IF SEQUENCE # OVERFLOW, START AT 1 AGAIN
SETUP4,	0000
SET4LP,	TAD I	SETUP4
	SZA
	JMP	SETUPU
	ISZ	SETUP4
	TAD I	SETUP4
	SNA
	JMP I	SETUP4
	TAD	SETUP4
	DCA	SETUP4
	JMP	SET4LP
SETUPU,	TAD	SETUP4
	DCA I	SETUP4
	ISZ	SETUP4
	JMP	SET4LP
UE7,	6446			/"SEQUENCE # TOO BIG"
	6266
	4657
	4446
	0104
	0165
	6060
	0143
	5250
	0000
/
	PAGE

/PAGE 2 OF THE UPDATE MOUNT OVERLAY
/IT PRINTS THE MESSAGE, GETS THE RESPONSE, AND SEES IF IT'S OK
/LOADS INTO 200-377 DATA BUFFER 0
UUNITNO,
UPG2,	.
UOKX,	UOK-.
FORUPD,	E4-.		/!KEEP!
FORINQ,	E13-.		/!TOGETHER!
UMNTCT,
UDIGIT,	0
UMNTTM,	UPG3-.
UK7770,
UDOMES,	SMA SZA SNL SKP CLA	/NECESSARY CLA (OF SOME VARIETY)
UK11,	11			/IT'LL ALWAYS SKIP
	UDF			/MUST BE HERE
	TAD	(MNTMSG		/GET PTR TO MOUNT MESSAGE
	JMS	CIFT		/CIF FGM
	PUSHJ
	ROW20			/"MOUNT "
	TAD	ULBLPT		/GET PTR TO LABEL
	JMS	CIFT
	PUSHJ
	FAKEIT			/"LABEL # XX "
UPINPG,	TAD	FORUPD		/INCREMENTED IF INQUIRE
	JMS	CIFT
	PUSHJ
	USRPRT			/ "FOR UPDATE: " OR "FOR INQUIRY: "
UNXTDI,	DCA	UUNITN		/NOW ASSEMBLE AN ANSWER AS IT'S TYPED
	JMS	CIFT
	PUSHJ
	TTICHR
	TAD	(-203
	SNA			/^C?
	JMP	UABRTX
	TAD	(203-215
	SNA			/CAR. RET?
	JMP	UMEOS
	TAD	(215-272	/CHECK FOR DIGIT 0-9
	CLL IAC
	TAD	UK11
	SNL
	JMP	UDOMES		/NOT A DIGIT - REPEAT MESSAGE
	DCA	UDIGIT
	TAD	UDIGIT
	TAD	L260
	JMS	CIFT
	PUSHJ
	TTOCHR			/ECHO
	TAD	UUNITN		/GET OLD
	CLL RTL			/MULTIPLY BY 10
	TAD	UUNITN
	RAL
	TAD	UDIGIT		/ADD IN NEW
	JMP	UNXTDI		/& KEEP GOING
UABRTX,	JMS	CIFT
	JMP I	(ABORT

UMEOS,	TAD	UUPLIM		/CHECK FOR BEING WITHIN GOOD RANGE
	TAD	UUNITN
	CLL
	TAD	UDIFF
	SNL CLA
	JMP	UBADUN		/NO GOOD
	TAD	UK7770		/SET UP TO SPY ON BACKGROUND DOINGS
	DCA	UMNTCT
	TAD	(FTBASE+1
	DCA	UMNTTM
	CDF 0
UCHKLP,	TAD I	UMNTTM		/GET WORD FROM BACKGROUND FILE TABLE
	AND	L17		/GET UNIT # IT'S USING
	CIA
	TAD	UUNITN		/COMPARE WITH WHAT WE WANT TO USE
	SNA CLA			/CAN WE?
	JMP	UINUSE		/TOO BAD, SOMEBODY BEAT US TO IT
	TAD	UMNTTM
	TAD	UK11		/BUMP TO NEXT IN TABLE
	DCA	UMNTTM
	ISZ	UMNTCT
	JMP	UCHKLP
	TAD	UUNITN		/NOT BEING USED BY BACKGROUND...
	CLL RAL
	TAD	UUNITN		/SEE IF FOREGROUND IS USING IT
	TAD	(UTBASE		/OR IF IT'S EVEN DEFINED
	DCA	UMNTTM
	TAD I	UMNTTM		/IF IT'S IN USE OR UNDEFINED THIS WORD = 5400
	TAD	(-5400
	SZA
	JMP	UUNITO		/IT'S OK TO USE
	ISZ	UMNTTM		/IN USE OR UNDEFINED....
	ISZ	UMNTTM		/FIND OUT WHICH
UINUSE,	TAD I	UMNTTM		/IF JUST IN USE THIS WORD NON-0
	SZA CLA
	TAD	(INUSMG-UNDFMG
	TAD	(UNDFMG-ILLUNT
UBADUN,	TAD	(ILLUNT
	UDF			/SO PUSHJ DOESN'T GET MESSED UP
	JMS	CIFT		/CIF THERE
	PUSHJ
	MESYES			/"IN USE" OR "UNDEFINED UNIT" OR "ILLEGAL UNIT"
				/MESYES RETURNS SOMENTING IN AC...
	JMP	UDOMES		/GO TRY AGAIN

UUNITO,	TAD	(5400
	DCA	UMNTCT
INQZAP,	TAD	(5400		/MAY CAHNGE TO "JMP INQJMP" FOR INQUIRY
	DCA I	UMNTTM		/SET AS UNDEFINED
	TAD	UMNTCT
INQJMP,	JMS	CDFT
	DCA I	(HANDLR		/SAVE FOR EVENTUAL RESTORATION
	TAD	UMNTCT
	TAD	(-6610		/DTA'S WILL GIVE + AC, DSK'S WILL GIVE - AC
	SMA CLA			/???
	TAD	(DTAQ-DSKQ
	TAD	(DSKQ
	DCA I	(U0
	TAD	UMNTTM		/CROSS PAGE BOUNDARY WITH PTR IN AC
	JMP I	UOKX		/SO WE DON'T HAVE TO GET IT FROM THERE
ULBLPT,	0
/
	PAGE

/PAGE 3 OF THE UPDATE MOUNT OVERLAY
/....NOW THAT WE'VE GOT IT, WHAT DO WE DO WITH IT
/LOADS INTO 000-177 DATA BUFFER 1
UMC,
UPG3,	.
UUNTNX,	UUNITN-.
UDOMSX,	UDOMES-.
UPG1RX,	UPG1R-.
ULBLP1,	ULBLPT-.
UMTOVX,	UMOUNT-.
VMITC,	UMNTCT-.
USEGCN,	UMOUNT-.+6
USEQN1,	0
UMX,	0
	JMP I	UPG1RX
UMY,	0
UOK,	DCA	UMX
	UDF
	TAD I	VMITC
	AND	L7		/GET PHYSICAL UNIT #
	RIF			/GET USER'S FIELD (THIS FIELD)
	TAD	L0200		/READ 1 BLOCK
	JMS	CDFT
	DCA I	(W0
	ISZ	UMX
	CDF 0
	TAD I	UMX		/GET U1 AND U2 ENTRIES
	JMS	CDFT		/...THERE OUGHT TO BE A BETTER WAY
	DCA I	(U1
	CDF 0
	ISZ	UMX
	TAD I	UMX
	JMS	CDFT
	DCA I	(U2
	TAD	UMTOVX		/GET BUFFER ADDR
	CLL RAR
	UDF
	TAD I	UUNTNX
	JMS	CDFT
	DCA I	(W1
	TAD	UMTOVX
	DCA I	(W2		/SAVE AS INTERNAL PTR
	DCA I	(W3		/AS # OF WORDS LEFT IN BUFFER
	DCA I	(W4		/ZERO HIGH REL. BLK BITS
	TAD	USEQN1
	DCA I	(W5
	TAD	UMTOVX		/GET BASE OF I/O BUFFERS
	DCA	UMX		/....THIS IS WHERE LABEL WILL BE
	UDF
	AC7777	
	TAD I	ULBLP1
	DCA	UMY		/THIS IS WHERE OUR LABEL IS
	TAD	M4
	DCA	UMC
	JMS	CIFT
	PUSHJ
	RWBLK0			/GET LABEL ON THE DEVICE
	TAD	USEQN1
	JMP	UHOPOV
ULBLCH,	JMS	CDFT
	TAD I	UMY		/GET LABEL WORD FROM TABLE
UHOPOV,	ISZ	UMY
	CIA
	UDF
	ISZ	UMX
	TAD I	UMX		/GET LABEL WORD FROM UNIT
	SZA CLA
	JMP	URELES
	ISZ	UMC
	JMP	ULBLCH
UOOSIK,	JMS	CDFT		/NOW CALL THE SUPPLEMENTARY OVERLAY
	TAD I	(MTPARM		/GET BASE OF OVERLAYS
	DCA I	(ARG1A
	TAD I	(ARG4A		/GET SEG. # OF REL. SEG. 0
	DCA	RELSG0		/AND SAVE FOR LATER USE
	AC0001			/FUDGE BASE OF SUPPLAMENTARY OVERLAY
	TAD I	(MTHIBL
	DCA I	(ARG4A
	RIF			/GET FIELD (PHYSICAL DEVICE 0)
	TAD	L0200		/READ 1 BLOCK
	DCA I	(ARG2A
	TAD I	(SYSQ		/GET SYSTEM DEVICE QUEUE ADDRESS
	DCA	UPG4T
	TAD	UMTOVX
	DCA I	(ARG3A
	JMS	CIFT		/WILL DO UDF TOO
	TAD I	USEGCN		/ALSO GET # OF SEGMENTS IN DATA FILE
	DCA	USEGCN		/AND SAVE THAT
	IOF
	JMS I	UPG4T		/CALL IN THE SUPPLEMENTARY OVERLA
	JMS	CIFT
	PUSHJ
	IOWAIT
	JMP I	UMTOVX		/GO TO NEXT PART OF OVERLAY
RELSG0,	0

URELES,	JMS	CIFT
	PUSHJ
	CLOSE			/RELEASE LOGICAL UNIT
	JMP I	UDOMSX		/GO TRY AGAIN
UPG4T,	0
E4,	4760		/"FOR UPDATE: "
	6301
	6661
	4542
	6546
	3301
	0000
E13,	4760		/"FOR INQUIRY: "
	6301
	5257
	6266
	5263
	7233
	0100
/
PAGE
ZBLOCK 177;HLT

/////////////////////////
/			/
/   OVERLAY # 2		/
/			/
/     BLOCK # 7,10	/
/			/
/////////////////////////
/MOUNT	OVERLAY FOR APPEND
/THE FIRST PAGE OF IT SETS UP ALL THE CDF'S AND POINTERS NEEDED ON THE
/OTHER PAGES  ACCORDING TO WHERE THIS CODE GETS LOADED.  THIS CODE GETS
/READ INTO A JOB'S I/O BUFFERS TO BE EXECUTED BY THE ROUTINE "INITMT".
/AFTER PAGE 1 HAS DONE ITS THING, THAT PAGE IS USED AS A BUFFER FOR THE
/FIRST HALF OF BLOCK 0 OF THE LOGICAL UNIT SO THAT THE UNIT LABEL CAN
/BE CHECKED.  YOU ENTER THIS ROUTINE WITH CDF = FGM FIELD AND WITH THE
/TRIAL UNIT (IF ANY) IN THE AC, + OVERLAY OFFSET.
/LOADS INTO 000-177 DATA BUFFER 0
APPND,	DCA	.		/SAVE TRIAL UNIT (MAYBE)
ATJOB,	TAD I	(JOB
AEQNOT,	DCA	ATJOB
ATT1,	TAD I	(W5		/GET SEQUENCE # 
ATT2,	DCA	AEQNOT
AEQPTR,	UDF
	JMS	SETUP5		/FIX UP INTER-PAGE POINTERS
AE7REL,	AE7-.
AEQNOX,	AEQNO-.
AEOSX,	AEOS-.			/ *** MUST PRECEED DOMESX! ***
AOMESX,	AOMES-.			/ *** MUST FOLLOW MEOSX! ***
ANITNX,	ANITNO-.
ABLPTX,	ABLPTR-.
	0000
	AG2-.			/SET UP NEXT PAGE
AG1R,	TAD	APPND
	AND	L17		/CLEAR OFFSET
	SPA SNA
	ISZ	AITJMP		/BUMP IF NO TRIAL UNIT SO WE ASK MOUNT MESSAGE
	DCA I	ANITNX		/PUT TRIAL UNIT WHERE IT BELONGS NOW
	AC0001			/CHECK IF 1 JOB
	TAD	LMJOBS
	SNA CLA
	ISZ	ABLBMP		/IF ONE JOB
	TAD	ATJOB		/MULTIPLY JOB # BY 6
	CLL RAL
	TAD	ATJOB
	RAL
ABLBMP,	TAD	ABLX6		/FORM POINTER TO WHERE FILE LABEL IS
	DCA I 	ABLPTX
	TAD I	ABLPTX
	TAD	L0004		/FORM PTR TO SEQUENCE # PLACE
	DCA	AEQPTR
	DCA	ATT2		/0 COUNTER
AEPEAT,	ISZ	AEQNOT		/BUMP SEQ. #
	TAD	AEQNOT
	AND	L77
	SNA			/OVERFLOWED 77?
	JMP	AADSEQ		/YUP
AD10,	ISZ	ATT2
	TAD	(-12		/DIVIDE IT BY 10
	SMA
	JMP	AD10
	DCA	ATT1
	TAD	ATT2
	CLL RTL
	RTL
	RTL
	TAD	ATT1
	TAD	(2033		/MAGIC # TO MAKE IT -237 ASCII
	JMS	CDFT		/CDF FGM
	DCA I	AEQPTR		/PUT IT IN PLACE TO PRINT
	UDF
	TAD	AEQNOT
	TAD	L0400		/LABELS ON UNITS HAVE THIS BIT SET
	DCA I	AEQNOX		/SAVE THIS COMBINATION FOR USE ELSEWHERE
AITJMP,	JMP I	AEOSX		/MAY BE INCREMENTED

ABLX6,	LABEL1-6		/*** KEEP THESE TOGETHER! ***
	LAB11J-6
AADSEQ,	JMS	CIFT		/"SEQUENCE # TOO BIG"
	PUSHJ
	ROW20			/POSITION CURSOR
	TAD	AE7REL
	JMS	CIFT
	PUSHJ
	USRPRT
	JMS	CIFT
	PUSHJ
	CRWAIT
	JMP	AEPEAT		/IF SEQUENCE # OVERFLOW, START AT 1 AGAIN
SETUP5,	0000
SET5LP,	TAD I	SETUP5
	SZA
	JMP	SET5B
	ISZ	SETUP5
	TAD I	SETUP5
	SNA
	JMP I	SETUP5
	TAD	SETUP5
	DCA	SETUP5
	JMP	SET5LP
SET5B,	TAD	SETUP5
	DCA I	SETUP5
	ISZ	SETUP5
	JMP	SET5LP
AE7,	6446			/"SEQUENCE # TOO BIG"
	6266
	4657
	4446
	0104
	0165
	6060
	0143
	5250
	0000
/
	PAGE

/PAGE 2 OF THE APPEND MOUNT OVERLAY
/IT PRINTS THE MESSAGE, GETS THE RESPONSE, AND SEES IF IT'S OK
/LOADS INTO 200-377 DATA BUFFER 0
ANITNO,
AG2,	.
AKX,	AK-.
FORAPP,	E27-.			/"FOR APPEND: "
ANTCTR,
AIGIT,	0
ANTTMP,	AG3-.
A7770,
AOMES,	SMA SZA SNL SKP CLA	/NECESSARY CLA (OF SOME VARIETY)
A11,	11			/IT'LL ALWAYS SKIP
	TAD	(MNTMSG		/GET PTR TO MOUNT MESSAGE
	JMS	CIFT		/CIF FGM
	PUSHJ
	ROW20			/"MOUNT "
	TAD	ABLPTR		/GET PTR TO LABEL
	JMS	CIFT
	PUSHJ
	FAKEIT			/"LABEL # XX "
	TAD	FORAPP
ACIFT,	JMS	CIFT
	PUSHJ
	USRPRT			/"FOR APPEND: "
AXTDIG,	DCA	ANITNO		/NOW ASSEMBLE AN ANSWER AS IT'S TYPED
	JMS	CIFT
	PUSHJ
	TTICHR
	TAD	(-203
	SNA			/^C?
	JMP	ABRTAP
	TAD	(203-215
	SNA			/CAR. RET?
	JMP	AEOS
	TAD	(215-272	/CHECK FOR DIGIT 0-9
	CLL IAC
	TAD	A11
	SNL
	JMP	AOMES		/NOT A DIGIT - REPEAT MESSAGE
	DCA	AIGIT
	TAD	AIGIT
	TAD	L260
	JMS	CIFT
	PUSHJ
	TTOCHR			/ECHO
	TAD	ANITNO		/GET OLD
	CLL RTL			/MULTIPLY BY 10
	TAD	ANITNO
	RAL
	TAD	AIGIT		/ADD IN NEW
	JMP	AXTDIG		/& KEEP GOING

AEOS,	TAD	APLIM		/CHECK FOR BEING WITHIN GOOD RANGE
	TAD	ANITNO
	CLL
	TAD	AIFF
	SNL CLA
	JMP	AADUNT		/NO GOOD
	TAD	A7770		/SET UP TO SPY ON BACKGROUND DOINGS
	DCA	ANTCTR
	TAD	(FTBASE+1
	DCA	ANTTMP
	CDF 0
AHKLP,	TAD I	ANTTMP		/GET WORD FROM BACKGROUND FILE TABLE
	AND	L17		/GET UNIT # IT'S USING
	CIA
	TAD	ANITNO		/COMPARE WITH WHAT WE WANT TO USE
	SNA CLA			/CAN WE?
	JMP	ANUSE		/TOO BAD, SOMEBODY BEAT US TO IT
	TAD	ANTTMP
	TAD	A11		/BUMP TO NEXT IN TABLE
	DCA	ANTTMP
	ISZ	ANTCTR
	JMP	AHKLP
	TAD	ANITNO		/NOT BEING USED BY BACKGROUND...
	CLL RAL
	TAD	ANITNO		/SEE IF FOREGROUND IS USING IT
	TAD	(UTBASE		/OR IF IT'S EVEN DEFINED
	DCA	ANTTMP
	TAD I	ANTTMP		/IF IT'S IN USE OR UNDEFINED THIS WORD = 5400
	TAD	(-5400
	SZA
	JMP	ANITOK		/IT'S OK TO USE
	ISZ	ANTTMP		/IN USE OR UNDEFINED....
	ISZ	ANTTMP		/FIND OUT WHICH
ANUSE,	TAD I	ANTTMP		/IF JUST IN USE THIS WORD NON-0
	SZA CLA
	TAD	(INUSMG-UNDFMG
	TAD	L7776		/UNDFMG-ILLUNT IN DISGUISE
				IFNZRO UNDFMG-ILLUNT+2 <????>
AADUNT,	TAD	(ILLUNT
	UDF			/SO PUSHJ DOESN'T GET MESSED UP
	JMS	CIFT		/CIF THERE
	PUSHJ
	MESYES			/"IN USE" OR "UNDEFINED UNIT" OR "ILLEGAL UNIT"
				/MESYES RETURNS SOMETHING IN AC...
	JMP	AOMES		/GO TRY AGAIN

ANITOK,	TAD	(5400
	DCA	ANTCTR
	TAD	(5400
	DCA I	ANTTMP		/SET AS UNDEFINED
	TAD	ANTCTR
	JMS	CDFT
	DCA I	(HANDLR		/SAVE FOR EVENTUAL RESTORATION
	TAD I	(HANDLR
	TAD	(-6610		/DTA'S WILL GIVE + AC, DSK'S WILL GIVE - AC
	SMA CLA			/???
	TAD	(DTAQ-DSKQ
	TAD	(DSKQ
	DCA I	(U0
	ISZ	ANTTMP
	TAD	ANTTMP		/CROSS PAGE BOUNDARY WITH PTR IN AC
	JMP I	AKX		/SO WE DON'T HAVE TO GET IT FROM THERE
ABRTAP,	JMS	CIFT
	JMP I	(ABORT
ABLPTR,	0
/
	PAGE

/PAGE 3 OF THE APPEND MOUNT OVERLAY
/....NOW THAT WE'VE GOT IT, WHAT DO WE DO WITH IT
/LOADS INTO 000-177 DATA BUFFER 1
AG3,
AMX,	RM-.
SAARG3,	APPND-.
ABLPUT,	APPND+5-.
ANTNX,	ANITNO-.
AG1RX,	AG1R-.
AOMSXX,	AOMES-.
ABLPX,	ABLPTR-.
AX,	0
AY,	0
AC,
AEGCNT,	JMP I	AG1RX	
AK,	DCA	AX
	CDF 0
	TAD I	AX		/GET U1 AND U2 ENTRIES
	JMS	CDFT		/...THERE OUGHT TO BE A BETTER WAY
	DCA I	(U1
	CDF 0
	ISZ	AX
	TAD I	AX
	JMS	CDFT
	DCA I	(U2
	TAD I	(HANDLR
	AND 	L7		/GET PHYSICAL UNIT #
	TAD	(4200		/WRITE, 1 BLOCK
	RIF			/GET USER'S FIELD (THIS FIELD)
	DCA I	(W0
	TAD	SAARG3		/GET BUFFER ADDR
	CLL CML RAR		/SET BUFFER SWITCH TO 1
	UDF
	TAD I	ANTNX
	JMS	CDFT
	DCA I	(W1
	TAD	AEQNO
	DCA I	(W5
	TAD	SAARG3		/GET BASE OF I/O BUFFERS
	DCA	AX		/....THIS IS WHERE LABEL WILL BE
	UDF
	AC7777	
	TAD I	ABLPX
	DCA	AY		/THIS IS WHERE OUR LABEL IS
	TAD	M4
	DCA	AC
	JMS	CIFT
	PUSHJ
	RWBLK0			/GET LABEL ON THE DEVICE
	TAD	AEQNO
	JMP	AOPOVR
ABLCHK,	JMS	CDFT
	TAD I	AY		/GET LABEL WORD FROM TABLE
AOPOVR,	ISZ	AY
	CIA
	UDF
	ISZ	AX
	TAD I	AX		/GET LABEL WORD FROM UNIT
	SZA CLA
	JMP	AM
	ISZ	AC
	JMP	ABLCHK
	JMP	AOSIK		/ESKIMOS FOREVER!
AEQNO,	0
AM,	JMS	CDFT
	TAD I	(W1
	CLL RAL
	TAD I	(W1		/GET LOGICAL UNIT # TIMES 3
	AND	L77
	TAD	(UTBASE		/FORM POINTER TO ITS ENTRY
	DCA	AY
	TAD I	(HANDLR		/GET OLD VALUE OF IT
	CDF 0
	DCA I	AY		/& PUT IT BACK
	UDF
	JMP I	AOMSXX		/& GO TRY AGAIN
AOSIK,	JMS	CDFT		/ LABEL AGREES
	DCA I	(UPDSIZ		/MAKE SURE THAT IT IS 0 FOR OUTPUT
	CDF 0
	TAD I	L7777		/GET CURRENT DATE
	UDF
	DCA I	ABLPUT		/AND PUT THAT IN TOO
	ISZ	ABLPUT
	TAD I	ABLPUT		/GET # OF SEGS USED
	DCA	AEGCNT		/AND SAVE
	DCA I	ABLPUT		/THEN SET TO 0
	JMS	CIFT
	AC4000			/FOR WRITE
	PUSHJ
	RWBLK0			/WRITE OUT BLK 0 OF LOGICAL UNIT WITH NEW NAME
	JMS	CDFT
	TAD I	(ARG4A
	DCA	ASEG0
	TAD I	(MTPARM		/THIS IS LOW ORDER BLOCK ADDR OF "OUTPUT" OVERLAY
	CLL
	TAD	L0400
	DCA I	(ARG1A
	RAL			/GET ANY CARRY
	IAC			/ADD 20 TO GET TO SUPPLEMENT 1
	TAD I	(MTHIBL		/THIS IS HI-ORDER ADDR OF "OUTPUT" OVERLAY
	DCA I	(ARG4A
	RIF
	TAD	L0200
	DCA I	(ARG2A
	TAD	SAARG3
	DCA I	(ARG3A
	TAD I	(SYSQ
	DCA	AX
	JMS	CIFT
	IOF
	JMS I	AX
	JMS	CIFT
	PUSHJ
	IOWAIT
	JMP I	SAARG3		/GO TO SUPPLEMENT 1
ASEG0,	0
/
	PAGE

E27,	4760		/"FOR APPEND: "
	6301
	4261
	6146
	5745
	3301
	0000
/
	PAGE

/////////////////////////
/			/
/   OVERLAY # 3		/
/			/
/     BLOCK # 11,12	/
/			/
/////////////////////////
	ZBLOCK 777;	HLT

/////////////////////////
/			/
/   OVERLAY # 4		/
/			/
/     BLOCK # 13,14	/
/			/
/////////////////////////
/LOGIN OVERLAY. ACCEPTS PASSWORD OR NO PASSWORD, IF FIRST WORD IN PASSWORD = 0
/THEN NO PASSWORD REQUIRED. 6 LETTER PASSWORDS IS MAXIMUM
PASSTR,	JMS	.		/FIGURE OUT WHERE WE ARE
PPASWD,	PASWRD-.
	CLA			/INITMT LEAVES OVERLAY # IN AC...
	TAD	PASSTR
	TAD	PPASWD
	DCA	PPASWD
LOGIN,	UDF
LOGCIF,	JMS	CIFT
	PUSHJ
	ROW20			/CLEAR OUT ROW 20
	JMS	CIFT
	PUSHJ
	CRWAIT			/WAIT FOR SOME ACTIVITY
LOGIN1,	JMS	CDFT
	AC7777
	TAD I	(JOB		/WHO ARE WE?
	CLL RAL
	TAD	M1
	TAD I	(JOB
	CLL RAL			/JOB#-1*6
	TAD	PPASWD
	UDF
	DCA	LOGTMP		/POINTER TO PASSWORD TABLE
	DCA	MADEIT		/FLAG TO SEE IF ANY WRONG CHARACTERS TYPED
	DCA	LOGCNT		/COUNT OF # OF CHARACTERS TYPED
	TAD I	LOGTMP		/GET FIRST CHAR
	SZA CLA			/ANY PASSWORD REQUIRED FOR THIS JOB?
	JMP	LOGIN2		/YES
LOGING,	TAD	LOGCIF
	IAC
	DCA	.+1
LOGTMP,	0000
	JMP I	(RESTRT
LOGIN2,	JMS	CIFT
	PUSHJ
	ROW20
	JMS	CIFT
	TAD	(LOGMES-PPASWD
	TAD	PASSTR
	PUSHJ
	USRPRT
LOGIN3,	JMS	CIFT
	PUSHJ
	TTICHR
	TAD	(-377
	SNA			/RUBBOUT?
	JMP	LOGIN2		/YES
	TAD	(377-215
	SZA
	JMP	LOGIN4
	TAD	MADEIT
	SZA CLA			/ANY ERRORS?
	JMP	LOGIN1		/YES, DON'T LET HIM THROUGH
	TAD	LOGCNT		/ANY CHARS TYPED?
	SNA
	JMP	LOGIN1		/NO, NOT VALID EITHER
	TAD	(-6
	SNA CLA			/WAS THIS A 6 CHARACTER PASSWORD?
	JMP	LOGING		/YES, HE MADE IT
	TAD I	LOGTMP		/NO, NEED ONE MORE CHECK
	SNA
	JMP	LOGING
	SMA CLA			/IS IT A PRIVILEGED ACCOUNT?
	JMP	LOGIN1		/NO - THE FULL FRUITS OF FGBG ARE DENIED
	JMS	CIFT
	PUSHJ
	ROW20			/CLEAR LINE 20
	TAD	(SPCFNT-PPASWD
	TAD	PASSTR
	JMS	CIFT
	PUSHJ
	USRPRT			/"SPECIAL FUNCTIONS?"
	JMS	CIFT
	PUSHJ
	YESNO
	SZA CLA			/DOES HE WANT THE GOOD STUFF?
	JMP	LOGING		/COWARD!
	TAD	(FNTLIS-PPASWD
	TAD	PASSTR
	PUSHJ
	USRPRT			/"LPTSPL = 1,..."
	JMS	CIFT
	PUSHJ
	YESNO
	AND	L7
	TAD	.+2
	DCA	.+1
	JMP	.+1
	JMP	LOGIN1	/FUNC1	/JMP TO FUNCTION 1 IF 1 TYPED
	JMP	LOGIN1	/FUNC2	/JMP TO FUNCTION 2 IF 2 TYPED
	JMP	LOGIN1	/FUNC3	/GUESS WHAT
	JMP	LOGIN1	/FUNC4
	JMP	LOGIN1	/FUNC5
	JMP	LOGIN1	/FUNC6
	JMP	LOGIN1	/FUNC7
	JMP	LOGIN1	/FUNC8	/(REALLY FUNC0)
LOGIN4,	TAD	(215
	CIA
	TAD I	LOGTMP
	SZA CLA
	ISZ	MADEIT		/DIDN'T MATCH
	ISZ	LOGTMP
	ISZ	LOGCNT
	JMP	LOGIN3
LOGCNT,	0000
MADEIT,	0000
/
PAGE

PASWRD=.
	ZBLOCK 6^6	/6 PASSWORDS, 6 WORDS PER PASSWORD
LOGMES,	5560		/"LOGIN PLEASE?"
	5052
	5701
	6155
	4642
	6446
	4001
	0000
SPCFNT,	6461		/"SPECIAL FUNCTIONS?"
	4644
	5242
	5501
	4766
	5744
	6552
	6057
	6440
	0100
FNTLIS,	5561		/"LPTSPL = 1..."
	6564
	5501
	3601
	2200
/
	PAGE
ZBLOCK 377;HLT

/////////////////////////
/			/
/   OVERLAY # 5		/
/			/
/     BLOCK # 15,16	/
/			/
/////////////////////////
	ZBLOCK 777;	HLT

FIELD 0
*0
/////////////////////////
/			/
/   OVERLAY # 6		/
/			/
/     BLOCK # 17,20	/
/			/
/////////////////////////
	ZBLOCK 777;	HLT

/////////////////////////
/			/
/   OVERLAY # 7		/
/			/
/     BLOCK # 21,22	/
/			/
/////////////////////////
	ZBLOCK 777;	HLT

/////////////////////////
/			/
/   SUPPLEMENT # 0	/
/			/
/     BLOCK # 23	/
/			/
/////////////////////////
/BLOCK 0 OF THE SUPPLEMENTARY OVERLAYS - CALLED FOR UPDATES ONLY.
/GETS RECORD SIZE AND # OF RECORDS IN THE FILE.
/LOADS INTO 000-177 DATA BUFFER 0
SUPP0,	JMS	SETUP3
GOTEOF,	PG6GO-.
SG0PTR,	RELSG0-UMOUNT+SUPP0-.
BADSZE,	BDSZMG-.	/KEEP
DATPTR,	NODTMG-.	/THESE
EOFPTR,	EOFMSG-.	/IN
MSGPTR,	BADSZE-.	/ORDER!
BLOCK2,	SUPP0+400-.
SEGPTR,	USEGCN-UMOUNT+SUPP0-.
PG5T,	0
PG5T2,	SUPP0A-.
PG5GO,
RECSIZ,	JMS	CDFT
PG5CNT,	TAD I	(U0		/GET DEVICE QUEUE ADDR
	DCA	PG5T
	TAD	L0400
	DCA I	(ARG1A		/SET TO READ BLOCK 1 OF A SEGMENT...
	TAD I	(W0
	AND	L77
	TAD	L0200
	DCA I	(ARG2A
	UDF
	TAD I	SG0PTR
	JMS	CDFT
	DCA I	(ARG4A		/IT'S TO BE SEG. 0 OF THE LOGICAL UNIT
	TAD	BLOCK2
	DCA I	(ARG3A
	UDF
	TAD I	SEGPTR		/GET # OF SEGMENTS USED
	DCA	SEGPTR
	JMS	CIFT
	IOF
	JMS I	PG5T		/READ IN BLOCK 1 OF THE LOGICAL UNIT
	JMS	CIFT
	PUSHJ
	IOWAIT
	TAD I	BLOCK2		/GET RECORD LENGTH
	SMA
	JMP	NODATA		/EOF IS FIRST THING...NO RECORDS
	DCA	RECSIZ
	TAD	RECSIZ
	JMS	CDFT
	DCA I	(UPDSIZ
	TAD	SEGPTR		/GET # OF SEGS USED
	CIA			/MAKE NEG
	SNA			/0 MEANS WHOLE LOGICAL UNIT
	TAD I	(U2		/SO GET SIZE OF WHOLE UNIT
	CLL CML CIA		/NOW MAKE +
	TAD I	(U2		/AND COMPARE TO SIZE OF UNIT
	SNL SZA			/IS SIZE REASONABLE?
	JMP	BADSIZ		/NO - LABEL SAYS DATA > UNIT SIZE!
	CIA
	TAD I	(U2
	CLL CMA			/# OF SEGS USED -1
	SZA			/RELATIVE SEG 0?
	CML			/IF NOT, SET FLAG
	TAD I	(ARG4A		/ADD IN STARTING ABSOLUTE SEGMENT #
	DCA I	(ARG4A		/TO GET ABS. # OF LAST SEG. USED
	SNL			/REL. SEG 0?
	TAD	L0400		/IF SO, ADD IN FUDGE FACTOR FOR LABEL
	DCA I	(ARG1A
NXTBLK,	UDF
	JMS	CIFT
	IOF
	JMS I	PG5T		/GET A BLOCK OF THE FINAL SEGMENT USED
	JMS	CIFT
	PUSHJ
	IOWAIT
	TAD	L7400
	DCA	PG5CNT		/400 WORDS/BLOCK
	AC7777
	TAD	BLOCK2
	DCA	PG5T2		/ADDR-1 OF WHERE BLOCK IS
SRCHLP,	AC7775			/SETS LINK - IMPORTANT!
	ISZ	PG5T2
	AND I	PG5T2
	SNA CLA			/END-OF-UNIT? (A WORD OF 0000 OR 0002)
	JMP I	GOTEOF		/FOUND IT!
	ISZ	PG5CNT		/DONE ALL OF THIS BLOCK?
	JMP	SRCHLP		/NOT YET
	JMS	CDFT
	TAD I	(ARG1A
	TAD	L0400		/BUMP BLOCK #
	DCA I	(ARG1A
	SZL			/OVERFLOW?
	JMP	NXTBLK		/NOPE - KEEP GOING IN SEGMENT
	ISZ	MSGPTR		/WE DIDN'T FIND END-OF-UNIT
NODATA,	ISZ	MSGPTR
BADSIZ,	CLA
	JMS	CIFT		/DOES UDF TOO
	PUSHJ
	ROW20			/CLEAR OUT ROW 20
	TAD I	MSGPTR		/GET PTR TO APPROPRIATE MESSAGE
FGCIFA,	JMS	CIFT
	PUSHJ
	USRPRT			/AND OUTPUT IT
	JMS	CIFT
	PUSHJ
	CRWAIT
	JMS	CIFT
	JMP I	(ABORT		/GIVE UP
SETUP3,	0
SET3LP,	TAD I	SETUP3
	SZA
	JMP	SET3B
	ISZ	SETUP3
	TAD I	SETUP3
	SNA
	JMP I	SETUP3
	TAD	SETUP3
	DCA	SETUP3
	JMP	SET3LP
SET3B,	TAD	SETUP3
	DCA I	SETUP3
	ISZ	SETUP3
	JMP	SET3LP
/
	PAGE

/SUPPLEMENTARY OVERLAY - USED BY UPDATE ONLY...
/LOADS INTO 200-377 DATA BUFFER 0
RCSIZE,
SUPP0A,	RECSIZ-.
KPG5CT,	PG5CNT-.
KBDFIL,	BADSIZ-.
CURLOC,	SUPP0A-.-200
PG5RX,	PG5GO-.
PG6CNT,	0
HIGH,	0
	JMP I	PG5RX
/THE "TAD L0400" AND "TAD L7400" SIMPLY UNDO EACH OTHER AND ARE
/UNNECESSARY, BUT THEY MAY MAKE IT EASIER TO UNDERSTAND WHAT
/IS GOING ON IF YOU ASSUME THEY'RE THERE.
PG6GO,	CLL CML
	TAD I	KPG5CT		/(-) # OF UNUSED WORDS IN LAST BLOCK
/	TAD	L0400		/GET WORD # IN BLOCK OF THE EOU
	JMS	CDFT
	TAD I	(ARG1A		/GET LOW BLOCK #
/	TAD	L7400		/SUBTRACT 400 WORDS FOR BLOCK 0
	DCA I	(ARG1A		/NOW ARG4A,ARG1A = WORD ADDRESS OF EOF
	RAL			/IF ARG1A WAS 0, REDUCE SEGMENT COUNT BY 1
	TAD I	(U1
	CIA			/SUBTRACT STARTING SEGMENT # FROM CURRENT SEGMENT #
	TAD I	(ARG4A
	DCA I	(ARG4A		/BRING OVER TO THIS PAGE
	AC7777
	UDF			/LEAVING THIS OUT PRODUCES ALL SORTS OF FANTASTIC RESULTS
	TAD I	RCSIZE
	DCA	RCSIZE		/WORDS PER RECORD (-1 FOR THE WORD COUNT)
	JMS	CDFT
	DCA I	(UPDLST
	DCA I	(UPDLTH		/ZERO OUT THE RECORD COUNTER
	TAD	(-31		/-25 IN DISGUISE
	DCA	PG6CNT
RECDIV,	CLL			/DIVIDE THE WORD ADDRESS OF THE EOU WORD
	TAD	HIGH		/BY THE RECORD SIZE
	TAD	RCSIZE		/TO GET THE # OF RECORDS
	SZL			/ON THE UNIT
	DCA	HIGH		/(THANKS TO E.S.)
	CLA
	TAD I	(UPDLST
	RAL
	DCA I	(UPDLST
	TAD I	(UPDLTH
	RAL
	DCA I	(UPDLTH
	TAD I	(ARG1A
	CLL RAL
	DCA I	(ARG1A
	TAD I	(ARG4A
	RAL
	DCA I	(ARG4A
	TAD	HIGH
	RAL
	DCA	HIGH
	ISZ	PG6CNT
	JMP	RECDIV
	TAD	HIGH
	SZA			/CHECK FOR REMAINDER
	JMP I	KBDFIL		/THERE SHOULDN'T BE ANY!
	AC7777 CLL		/SUBTRACT 1 FROM # OF RECORDS
	TAD I	(UPDLST		/TO GET RECORD # OF FINAL RECORD
	DCA I	(UPDLST		/SINCE WE START COUNT AT 0
	SNL
	AC7777
	TAD I	(UPDLTH
	DCA I	(UPDLTH
	TAD I	(W0
	AND	L77		/GET FIELD & DEVICE #
	TAD	L0400		/SET TO R/W 2 BLOCKS
	DCA I	(ARG2A		/SET UP FOR USE BY UPDATE
	TAD	CURLOC
	DCA I	(ARG3A		/NECESSARY???
	AC0001
	TAD I	(STACK
	DCA	UPDTT
	AC7776			/MESSAGE AT 7776
	JMS	CIFT
	PUSHJ
	MESYES			/BINARY OR LINEAR SEARCH?
	TAD	L27		/CHECK FOR BINARY SEARCH ("Y-"B IN DSGUISE)
	SNA CLA
	TAD	(UPDBIN-UPDLIN	/ASSUME LINEAR IF ANYTHING OTHER THAN "B"
	TAD	(UPDLIN
	JMS	CDFT
	DCA I	UPDTT		/PUT IT ON THE STACK
	ISZ I	(STACK		/AND BUMP THE STACK POINTER
FGCIFB,	JMS	CIFT		/UDF TOO
	PUSHJ
	ROW20			/CLEAR ANY RANDOM MESSAGE
	AC0001
	TAD	FGCIFB		/FORM CIF CDF
	DCA	.+1
UPDTT,	0
	JMP I	(UPDTBR		/INPUT NEW KEY REGARDLESS OF SEARCH MODE

NODTMG,	5760		/NO RECORDS?
	0163
	4644
	6063
	4564
	4000
EOFMSG,	5760		/NO END OF UNIT
	0146
	5745
	0160
	4701
	6657
	5265
L27,	"Y-"B		/BITS 0-5=0 TO TERMINATE PRINTING OF MESSAGE
BDSZMG,	6742		/VARIABLE RECORD SIZE?
	6352
	4243
	5546
	0163
	4644
	6063
	4501
	6452
	7346
	4000
/
	PAGE

/////////////////////////
/			/
/   SUPPLEMENT # 1	/
/			/
/     BLOCK # 24	/
/			/
/////////////////////////
/BLOCK 1 OF THE SUPPLEMENTARY OVERLAYS - CALLED FOR APPENDS ONLY.
/FINDS END-OF-FILE AND PRETENDS IT'S DOING OUTPUT.
/LOADS INTO 000-177 DATA BUFFER 0
SUPP1,	JMS	SETUP6
AG0PTR,	ASEG0-APPND+SUPP1-.
AATPTR,	FULMSG-.	/THESE
AOFPTR,	AOFMSG-.	/IN
ASGPTR,	AATPTR-.	/ORDER!
AARG3,	SUPP1+400-.
PAGCIF,	AGCIFA-.
AEGPTR,	AEGCNT-APPND+SUPP1-.
AG5T,	0
AG5T2,	0
AECSIZ,	JMS	CDFT
AG5CNT,	TAD I	(U0		/GET DEVICE QUEUE ADDR
	DCA	AG5T
	TAD I	(W0
	AND	L77
	TAD	L0200
	DCA I	(ARG2A
	UDF
	TAD I	AG0PTR
	JMS	CDFT
	DCA I	(ARG4A		/IT'S TO BE SEG. 0 OF THE LOGICAL UNIT
	TAD	AARG3
	DCA I	(ARG3A
	UDF
	TAD I	AEGPTR		/GET # OF SEGMENTS USED
	DCA	AEGPTR
	TAD	AEGPTR		/GET # OF SEGS USED
	CIA			/MAKE NEG
	SNA			/0 MEANS WHOLE LOGICAL UNIT
	JMP	AADSIZ		/CAN'T APPEND TO A FULL UNIT!
	CLL CML CIA		/NOW MAKE +
	JMS	CDFT		/SCORE: Q.A. 1, DEVELOPMENT 0
	TAD I	(U2		/AND COMPARE TO SIZE OF UNIT
	SNL SZA			/IS SIZE REASONABLE?
	JMP	AADSIZ		/NO - LABEL SAYS DATA > UNIT SIZE!
	CIA
	TAD I	(U2
	CLL CMA			/# OF SEGS USED -1
	SZA			/RELATIVE SEG 0?
	CML			/IF NOT, SET FLAG
	TAD I	(ARG4A		/ADD IN STARTING ABSOLUTE SEGMENT #
	DCA I	(ARG4A		/TO GET ABS. # OF LAST SEG. USED
	SNL			/REL. SEG 0?
	TAD	L0400		/IF SO, ADD IN FUDGE FACTOR FOR LABEL
	DCA I	(ARG1A
AXTBLK,	UDF
	JMS	CIFT
	IOF
	JMS I	AG5T		/GET A BLOCK OF THE FINAL SEGMENT USED
	JMS	CIFT
	PUSHJ
	IOWAIT
	TAD	L7400
	DCA	AG5CNT		/400 WORDS/BLOCK
	AC7777 CLL
	TAD	AARG3		/SETS LINK - IMPORTANT!
	DCA	XR16		/ADDR-1 OF WHERE BLOCK IS
ARCHLP,	TAD I	XR16
	SNA CLA			/END-OF-FILE? (A WORD OF 0000)
	JMP	AOTEOF		/FOUND IT!
	ISZ	AG5CNT		/DONE ALL OF THIS BLOCK?
	JMP	ARCHLP		/NOT YET
	JMS	CDFT
	TAD I	(ARG1A
	TAD	L0400		/BUMP BLOCK #
	DCA I	(ARG1A
	UDF
	SZL			/OVERFLOW?
	JMP	AXTBLK		/NOPE - KEEP GOING IN SEGMENT
	ISZ	ASGPTR		/WE DIDN'T FIND END-OF-FILE
AADSIZ,	CLA
	JMS	CIFT		/DOES UDF TOO
	PUSHJ
	ROW20			/CLEAR OUT ROW 20
	TAD I	ASGPTR		/GET PTR TO APPROPRIATE MESSAGE
	JMP I	PAGCIF

AOTEOF,	JMS	CDFT
	TAD	XR16		/GET POINTER INTO BLOCK
	DCA I	(W2
	TAD I	(U1		/GET BASE SEGMENT #
	CIA
	TAD I	(ARG4A		/CURRENT SEGMENT #
	DCA I	(W4		/...THE RELATIVE SEGMENT #
	TAD	AG5CNT
	DCA I	(W3
	TAD I	(W5
	AND	L77
	TAD I	(ARG1A
	DCA I	(W5
FGCIFC,	JMS	CIFT
	PUSHJ
	ROW20
	AC0001
	TAD	FGCIFC
	DCA	.+1
	0
	JMP I	(OUTP		/GO AWAY AND PRETEND WE'VE BEEN DOING OUTPUT
SETUP6,	0
SET6LP,	TAD I	SETUP6
	SZA
	JMP	SET6B
	ISZ	SETUP6
	TAD I	SETUP6
	SNA
	JMP I	SETUP6
	TAD	SETUP6
	DCA	SETUP6
	JMP	SET6LP
SET6B,	TAD	SETUP6
	DCA I	SETUP6
	ISZ	SETUP6
	JMP	SET6LP
/
	PAGE

/SUPPLEMENTARY OVERLAY - USED BY APPEND ONLY...
/LOADS INTO 200-377 DATA BUFFER 0
AGCIFA,	JMS	CIFT
	PUSHJ
	USRPRT			/AND OUTPUT IT
	JMS	CIFT
	PUSHJ
	CRWAIT
	JMS	CIFT
	JMP I	(ABORT		/GIVE UP
AOFMSG,	4442		/CANNOT FIND END OF FILE
	5757
	6065
	0147
	5257
	4501
	4657
	4501
	6047
	0147
	5255
	4600
FULMSG,	6657		/"UNIT IS FULL!"
	5265
	0152
	6401
	4766
	5555
	0200
/
	PAGE
	NOPUNCH
IFNDEF LISTOFF <XLIST>
/
/END OF OVERLAY.PA

