/ MULTI SECTION 3   V 0.64
/ BEGIN SECTION 3 LISTING CONTROL
	IFNZRO LIST&10 <XLIST>
/ROUTINE TO TAKE CARE OF SEQUENCE NUMBERS, LABEL CHECKING, AND
/SIMILAR TRIVIA.  CALL:
/	PUSHJS
/	MOUNT		;DESIRED LABEL IN LABEL-LABEL+2
/			;SUGGESTED LOGICAL UNIT # (IF ANY) IN TIFN
/
/ MOUNT SAVES RELEVANT STATE, AND CHECKS TIFN FOR
/ A UNIT #.  LABELS ARE MOVED INTO MESSAGES AND THEN INTO THE
/ USER BUFFER BEFORE ANY I/O (CHANCE AT BEING SWAPPED) OCCURS. IF
/ TIFN IS NON-ZERO THE LABEL AND NUMBER OF USERS ON THE UNIT
/ IS CHECKED.  IF THE NUMBER OF USERS IS NON-ZERO, AND THE LABEL
/ IS AN EXACT MATCH, THE USER WINS, THE POINTERS ARE UPDATED
/ AND MOUNT IS DISMISSED.  IF THE NUMBER OF USERS IS ZERO BUT
/ A LABEL IS ON THE UNIT, THEN ANOTHER USER IS TRYING TO MOUNT A FILE
/ ON THAT UNIT AND NOTHING CAN BE DONE UNTIL THAT MATTER IS RESOLVED.
/ IF NO LABEL EXISTS, THEN THE UNIT IS FREE AND A TEMPORARY LABEL,
/ THAT OF THE FILE BEING SOUGHT, IS PUT IN THE PFT TABLE ENTRY FOR
/ THE UNIT, THUS LOCKING THE UNIT UNTIL THE ACTUAL LOGICAL UNIT
/ LABEL IS CHECKED.  AS USUAL, AN EXACT MATCH MUST BE OBTAINED ON
/ A READ, AND AN EXACT MATCH, OR SCRATCH UNIT LABEL ON A WRITE.
/ IF THE TIFN IS ZERO, OR IF THE MATCHES FAIL, THE USER IS ASKED
/ FOR ANOTHER LOGICAL UNIT NUMBER UNTIL EITHER HE WINS OR CONTROL/C'S
/ OUT IN EXASPERATION. 
/
/ NOTE THAT EACH TIME THE USER BUFFER ADDRESS OR FIELD IS NEEDED IT
/ IS RECALCULATED FROM PAGE ZERO (SWAP AREA) DATA.  THIS IS A PAIN AND, AS
/ EXPERIENCE HAS SHOWN, ENTIRELY NECESSARY.  FURTHER NOTE THAT NO
/ CHECKS ARE MADE AS TO HOW THE OTHER USERS OF THE FILE (IF ANY) HAVE
/ INITED OR ARE USING THE FILE.  THIS IS UP TO THE USER JOBS
/ THEMSELVES AND ANYONE READING FROM A FILE WITHOUT LOCKING IT FIRST
/ IS JUST BEGGING TO GET HURT.  ALL MESSAGES ARE TRANSFERED TO THE
/ USER BUFFER BEFORE USE SO THERE IS NO CHANCE OF CONFUSION OF
/ LABELS, ETC.
/

MOUNT,	AC7775				/FIRST MOVE LABEL INTO MESSAGE
	CALL	MOVE
	CDF RSFLD
	LABEL-1
	LBL1-1
	CALL	(NOROM3			/MERCILESS PAGE BOUNDARIES
	TAD	W0			/SELECT INPUT OR OUTPUT TEXT
	SMA CLA
	AC0002
	TAD	(OUTIN-1
	DCA	MONT1
	AC7776				/MOVE THIS INTO THE MESSAGE
	CALL	MOVE
	CDF RSFLD
MONT1,	0
	IORO-1

	CALL	(BMOVE		/NOW MOVE THE WHOLE MESSAGE INTO
	177				/USER BUFFER BEFORE SOMEONE ELSE
	TMOUNT-1			/CHANGES THE LABEL
	TMOUNT-REPLBL-1
	DCA	ASKMSG			/RETURNS ADDR FOR CDOIO
	DCA	W4		/GET RID OFF LEFTOVER SEGMENT OFFSET
	TAD	TIFN			/LOOK FOR PREASSIGNMENT
	SZA
	JMP	TRYUNT			/OH GOODY, GOT ONE TO TRY
ASKHIM,	JMS I	(BFRIDX			/ASK USER FOR UNIT TO TRY
	177				/HAVE TO DO THIS AGAIN IN CASE
	DCA	ASKMSG			/WE'RE COMING BACK FOR ANOTHER TRY
	JMS I	(BFRCDO			/GET BUFFER FIELD + 1 (TTY) INTO AC
	CALL	XCDOIO
ASKMSG,	0
MK20,	20				/NOP LOCATION NEVER EXECUTED
	TAD	P7			/REMAIN COMPATIBLE  BY RINGING
	CIF 00				/THE BEEP
	CALL	ZPUSHJ
	TTOCHR				/WAKE UP GIRLIE!
	AC7776				/PREPARE FOR ANSWER
	DCA	LENGTH			/SHUDDER
	JMS I	(BFRIDX
	-1				/READ ANSWER INTO FIRST PAGE OF BUFFER
	DCA	.+4
	TAD	W0
	AND	P70
	CALL	XCDOIO
	HLT
	JMP	ASKHIM			/BAD ANSWER, TRY AGAIN

	JMS I	(BFRIDX		/GO SEE WHAT THE ANSWER WAS
	1
	DCA	TRY1
	CALL	(CDFBFR		/DO CDF TO BUFFER FIELD
	TAD I	TRY1
	CDF RSFLD
	CALL	(PDTOOC		/PACKED DECIMAL TO OCTAL
	JMP I	(BADUNT
TRYUNT,	SPA SNA			/L.U. TO TRY IN AC
	JMP I	(BADUNT
	TAD	(-20		/DONT TRUST ANYBODY, NOT EVEN RSYS
	SMA
	JMP I	(BADUNT
	TAD	MK20
	DCA	TIFN

TRYAGN,	TAD	TIFN		/NOW HAVE LEGAL #
	CLL RTL
	RAL
	TAD	TIFN		/*11
	TAD	(SYSPFT-1
	IFNZRO TFTSIZ-11 <^^^ THE ARITHMETIC ABOVE JUST LOST ^^^>
	DCA	WX		/POINTER TO PFT ENTRY
	TAD	WX
	DCA	TRY1
	AC7775
	CALL	MOVE		/GET HANDLER WORDS INTO U'S
	CDF	RSFLD
TRY1,	0
	U0-1
	TAD	GETPNT
	DCA	LBLLOC
	ISZ	GETPNT
	CALL	ZWXIDX
	FNUSRS-SYSPFT+1
	SZA CLA
	JMP I	(MATLBL		/UNIT IN USE, LABEL BETTER MATCH
	TAD I	GETPNT		/NO USERS, IS SOMEONE ELSE TRYING
	SNA CLA			/MOUNT SOMETHING ON MY UNIT?
	JMP	READIT		/NO, FREE AS THE WIND
	CIF 00			/YES, WAIT TILL HE MAKES
	CALL	ZPUSHJ		/UP HIS MIND
	SLEEP
	JMP	TRYAGN		/AND TRY, TRY AGAIN

READIT,	CMA
	DCA I	GETPNT		/LOCK UP UNIT WITH FILENAME OF ^^
	PUSHJS			/FIND OUT WHAT THE REAL LABEL IS
	RDBLK0
	JMS I	(BFRIDX
	1
	DCA	READ2
	TAD	LBLLOC
	DCA	READ3
	CALL	(CDFBFR
	AC7775
	CALL	MOVE
	CDF RSFLD
READ2,	0
READ3,	0
	CALL	(CDFBFR
	TAD I	READ2
	JMP I	(MATLBB
GTUNDF,	0
	TAD	DES1W	/DID WE JUST BACK OVER A BOUNDARY
	CMA
	SZA CLA
	EXIT	GTUNDF	/NOPE
	TAD	DES1F	/YUP, DECREMENT CDF BY 10
	TAD	M10
	DCA	DES1F
	EXIT	GTUNDF
/
	PAGE

MATLBB,	AND	P77
	CDF RSFLD			/SEQ # IN AC
	ISZ	PUTPNT			/TO STORE IN PFT
	DCA I	PUTPNT
MATLBL,	TAD	LBLLOC
	DCA	XRM0
	JMS I	(BFRIDX
	200+LBL1-TMOUNT-1	/ADDR-1 OF DESIRED LABEL IN BUFFER
	DCA	XRM1
	AC7775
	DCA	XRM3
MATLP,	JMS	CDFBFR
	TAD I	XRM1
	CDF RSFLD
	CIA
	TAD I	XRM0
	SZA CLA				/ANY PROBLEMS SO FAR?
	JMP	NOMAT			/NO MATCH, STILL MIGHT BE OK
	ISZ	XRM3
	JMP	MATLP
	TAD I	XRM0		/OK FOR THE LABEL, HOW ABOUT REEL #
	AND	P77
	CIA
	TAD	REELNO
	SNA CLA
	JMP	MATEND		/GOT A MATCH

NOMAT,	TAD	W0		/IS THIS A WRITE?
K77X,	SMA CLA
	JMP	OHFOO		/NO, TRY ANOTHER ONE
	CALL	ZWXIDX
	FNUSRS-SYSPFT+1
	SZA CLA			/NO
	JMP I	(INUSE
	CALL	ZWXIDX
	FLABEL-SYSPFT+1
	SMA CLA				/CAN IT BE REPLACED?
	JMP	REPLOK			/YES, A SCRATCH UNIT
	TAD	LBLLOC		/DON'T KNOW, WHY NOT ASK
	DCA	NOMAT1
	AC7775				/MOVE LOGICAL UNIT LABEL INTO
	CALL	MOVE		/REPLACE MESSAGE
	CDF RSFLD
NOMAT1,	0
	LABEL1-1
	ISZ	GETPNT
	TAD I	GETPNT		/ALSO REEL #
	CALL	(OTOPD
	DCA I	KSEQLBL

	CALL	(BMOVE		/DO THE MAGIC MOVE UP TO BUFFER TRICK
	77
	REPLBL-1
	REPLBL-ILUNT-1
	DCA	.+3		/SING OUT
	JMS I	(BFRCDO
	CALL	XCDOIO
REK1,	0
KSEQLBL,	SEQLBL		/SHOULD NOT BE EXECUTED
	AC7775			/PREPARE FOR ANSWER
	DCA	LENGTH
	JMS I	(BFRIDX
	77
	DCA	.+4
	TAD	W0
	AND	P70
	CALL	XCDOIO
	0
KM7200,	-7200			/REALLY A NOP EVEN ON ^Z

	JMS I	(BFRIDX
	101
	DCA	REK1
	JMS	CDFBFR
	TAD I	REK1		/GET FIRST WORD OF RESPONSE
	CDF RSFLD
	AND	K77X
	TAD	KM7200		/LOOK FOR YXX
	SNA CLA
	JMP	REPLOK
OHFOO,	TAD	LBLLOC
	DCA	XRM1
	DCA I	XRM1		/GET RID OF TENTATIVE LABEL
	JMP I	(ASKHIM
REPLOK,	CALL	(NOROM4		/STILL NO ROOM,	MOVE DESIRED LABEL INTO
				/HEADER AND PFT
	TAD	M4		/TO MOVE FOUR WORDS
	DCA	XRM3
	JMS I	(BFRIDX		/GET ADDR-2(!) OF LABEL IN BUFFER
	0
	DCA	XRM2
	JMS	CDFBFR
	TAD	(400		/MAGIC HEADER WORD
	TAD	REELNO
	SKP
	TAD I	XRM1
	DCA I	XRM2
	ISZ	XRM3
	JMP	.-3
	AC4000
	PUSHJS			/WRITE OUT THE NEW LABEL WITH LENGTH = 0
	RDBLK0
MATEND,	CALL	(CTRLON
	TAD	(400
	DCA	W5
	JMP I	(MATCON

CDFBFR,	0
	DCA	CDFBTM
	CALL	(BFRCDF
	DCA	.+1
	HLT
	TAD	CDFBTM
	EXIT	CDFBFR
UNDEF,	POPS			/HERE WHEN LOOKUP ON UNDEF LOG. UNIT
	AC0001			/CLEAR STACK ENTRY
	TAD	P10		/ I.E. CLA;TAD (11
	CALL	XCDOIO
	ILUNT-1			/CTRL/O HAS BEEN FORCED BY MOUNT
CDFBTM,	0
	JMP	OHFOO		/CLEAR TENTATIVE LABEL ENTRY BEFORE RETRY
/
	PAGE

MATCON,	POPS
	DCA	LENGTH
MATSYS,	CALL	ZWXIDX
	FNUSRS-SYSPFT+1
	TAD	M1
	DCA I	WXI
	DCA	TIFN		/CLEAR PREASSIGNED LOGICAL UNIT
	TAD	W0
	SPA CLA			/RESET CERTAIN POINTERS IF WRITE
	JMP I	(MATW
	JMS I	KGPBUF		/OTHERWISE READ FIRST BUFFER FOR READ OR UPDATE
	CALL	ZWXIDX		/LOOK OUT! WXI MAY HAVE CHANGED
	BLOCK-SYSPFT+1		/WXI TO POINT TO BLOCK SIZE ENTRY
	CLA			/DISCARD OLD VALUE
	CALL	(CDFBFR
	TAD	W1		/GET FIRST WORD IN BUFFER
	AND	P7400
	DCA	BFRIDX
	TAD I	BFRIDX
	CDF RSFLD
	CIA
	IAC
	DCA I	WXI		/STORE RECORD SIZE FOR RECORD LOCK
	POPJS
BFRIDX,	0			/CALL TO GET AC SET TO BUFFER ADDR
	TAD	W1		/PLUS INDEX IN LOC FOLLOWING CALL
	AND	P7400
	TAD I	BFRIDX
	ISZ	BFRIDX
	EXIT	BFRIDX
BFRCDO,	0			/CALL TO GET CDOIO ARG INTO AC
	TAD	W0
	AND	P70		/FIELD BITS
	IAC			/PLUS 1 FOR TTY
	EXIT	BFRCDO
BFRCDF,	0			/CALL TO GET CDF TO BUFFER INTO AC
	TAD	W0
	AND	P70
	TAD	PCDF
	EXIT	BFRCDF

RDBLK0,	DCA	RDARG1		/SAVE BLOCK 0 R/W BIT
	TAD	U0
	SNA
	JMP I	(UNDEF
	AND	P7
	TAD	W0		/MUST BE PUSHJS'D TO
	AND	P77		/GET FIELD BITS FROM W0
	TAD	(100
	TAD	RDARG1
	DCA	RDARG1
	TAD	W1
	AND	P7400		/READ INTO FIRST PAGE OF BUFFER
	DCA	RDARG2
	TAD	U1
	DCA	RDARG3
	JMS	BFRIDX
	4			/VECTOR TO LENGTH AND DATE ENTRIES
	DCA	XRM0		/-1 OF COURSE
	CDF 00
	TAD I	M1		/GET DATE
	CALL	(CDFBFR
	DCA I	XRM0
	TAD	W4		/AND LENGTH
	DCA I	XRM0
	CDF RSFLD
	TAD	(RDARG0-1
	JMP I	(DKDOIT		/WILL DO POPJS
RDARG0,	0
RDARG1,	0
RDARG2,	0
RDARG3,	0

PDTOOC,	0
	DCA	PDTEM1
	TAD	PDTEM1
	BSWN
	JMS	ISITD
	EXIT	PDTOOC		/ERROR RETURN
	DCA	PDTEM2
	TAD	PDTEM1
	JMS	ISITD
	JMP	PDTOND		/GOT ONE GOOD DIGIT
	DCA	PDTEM1		/MEANS OTHER DIGIT WAS TEN'S
	TAD	PDTEM2
	CLL RTL
	TAD	PDTEM2
	RAL
	TAD	PDTEM1
	JMP	.+2
PDTOND,	CLA
	TAD	PDTEM2
	ISZ	PDTOOC
	EXIT	PDTOOC
ISITD,	0
	AND	P77
	TAD	(-33
	SMA
	EXIT	ISITD
	TAD	(12
	SMA
	ISZ	ISITD
	EXIT	ISITD
PDTEM1,	0
PDTEM2,	0

LPKLUG,	TAD	(LPTLO-1
	PUSHJS
	DKDOIT			/OUGHT TO GO THROUGH "SPLDEV"
	CIF CDF 0
	JMP I	(LPUNKL
LPTEOF,	CDF	RSFLD		/PUT HERE BECAUSE OF FEEBILITY
	TAD	(15
	JMS I	XCDOIO
	EOFREC-1
FINERR,	ERROR
	CIF CDF 0
	JMP I	(LPTFIN
EOFREC,	0			/MUST ALWAYS BE 0!
/
	PAGE

CLOSE,	JMS I	ZPTRST
	TAD	W0
	SMA CLA
	JMP	CLOSRD
	TAD	W3		/DO MAGIC CLOSE ARITHMETIC
	AND	P7400
	CLL CML RAR
	TAD	(200
	TAD	W0
	DCA	W0
	AC7776
	DCA	W3
	TAD	IFN
	JMS I	(RDOIO		/INSERT LENGTH OF 0 FOR EOF
	ZERO-1
	/NOTE - RDOIO WILL ALWAYS TAKE ITS ERROR RETURN HERE, SO TWO RETURN
	/POINTS ARE NOT NEEDED
	JMS	GPBUF		/OUTPUT LAST BUFFER
	PUSHJS
	RDBLK0
	TAD	W5
	AND	P7400
	SZA CLA
	ISZ	W4
	AC4000
	PUSHJS
	RDBLK0
CLOSRD,	DCA	W0
	DCA	W1		/CLEAR UNIT WORD TO PREVENT "IN USE" MESSAGES
	CALL	ZWXIDX
	FNUSRS-SYSPFT+1
	CLA
	ISZ I	WXI
	POPJS			/ALL DONE
	TAD	WXI		/WHOOPS! LAST USER, SO SHOW UNIT INACTIVE
	TAD	M4
	DCA	WXI		/POINTS TO FIRST WORD OF LABEL
	IFNZRO FLABEL-FNUSRS+4 <^^^ LOOK OUT, BART! ^^^>
	DCA I	WXI		/ZAP!
	POPJS
ZERO,	0

GPBUF,	0
	TAD	W5		/SAVE REL. BLK BITS
	DCA	GTEMP
	TAD	GPBUF
	PUSHS
NOTLST,	TAD	U1
	TAD	W4
	DCA	HIBLKA
	TAD	W0
	CLL RAL
	AND	P7400
	CLL
	TAD	W5		/UPDATE LOW REL. BLK BITS
	DCA	W5
	SZL
	ISZ	W4
	TAD	W4
	TAD	U2
	SZA CLA			/END OF UNIT?
	JMP	FULLOK		/NOT YET
	TAD	W5		/GET LOW REL BLK BITS
	AND	P7400
	CLL RAR
	CIA
FULLOK,	TAD	W0
	DCA	ARG1A
	TAD	U0		/PICK HANDLER VECTOR
	SNA
	JMP I	(BADUNT		/SET TO ZERO BY ONCE ONLY IF NOT DISK
	AND	P7		/MUST BE DISK, GET UNIT #
	TAD	ARG1A
	DCA	ARG1A
	TAD	W1
	AND	P7600
	DCA	ARG2A
	TAD	GTEMP
	AND	P7400
	DCA	ARG0A
	TAD	(ARG0A-1
	PUSHJS
	DKDOIT
MATW,	TAD	W0		/BUMP W3 TO NEXT RELATIVE BLOCKS
	RAL
	AND	P7400
	CIA
	DCA	W3		/HERE TO SHARE CODE FROM MOUNT ON READ
	TAD	W1		/RESET W2
	AND	P7600		/TO THE BEGINNING OF THE BUFFER
	TAD	M1
	DCA	W2
	POPJS
GTEMP,	0
ARG0A,	0
ARG1A,	0
ARG2A,	0
HIBLKA,	0

/ROUTINE TO MOVE CORE LOCATIONS AROUND.
/
/ *** DO NOT CALL FOR TRANSFERS CROSSING FIELD BOUNDARIES
/
/CALL:
/CDF	(FROM FIELD
/TAD	(-COUNT
/JMS	MOVE
/CDF	(TO FIELD
/"FROM" ADDR-1
/"TO" ADDR-1
/RETURN
/
XMOVE,	0
	DCA	COUNT
	RDF			/GET "FROM" CDF
	TAD	PCDF
	DCA	FRFLD
	CDF RSFLD
	TAD I	XMOVE		/GET "TO" CDF
	ISZ	XMOVE
	DCA	TOFLD
	TAD I	XMOVE		/GET "FROM" ADDR-1
	ISZ	XMOVE
	DCA	GETPNT
	TAD I	XMOVE		/GET "TO" ADDR-1
	ISZ	XMOVE
	DCA	PUTPNT
FRFLD,	HLT			/CDF FROM
	ISZ	GETPNT		/*****
	TAD I	GETPNT
TOFLD,	HLT			/CDF TO
	ISZ	PUTPNT		/*****
	DCA I	PUTPNT
	ISZ	COUNT
	JMP	FRFLD
	CDF RSFLD
	JMP I	XMOVE		/DONE THE THING
/
	PAGE

/ROUTINE TO GET AND PUT THINGS THAT LOOK LIKE DIBOL DATA RECORDS.
/THAT IS, WITH WORD COUNT FOLLOWED BY PACKED ASCII.  CALL:
/TAD	(FIELD+IFN
/JMS	RDOIO
/RECORD BUFFER ADDR-1
/EOF,EOS,EOU RETURN (EOF=0, EOS=+1, EOU=+2)
/OK RETURN
/END-OF-STRING AND END-OF-UNIT ARE IGNORED EXCEPT BY SORT.
/THE ONLY WAY YOU CAN GET AN EOU RETURN IS BY PATCHING "SRTFLG".
/
RDOIO,	0
	DCA	RTIFN
	TAD I	RDOIO
	DCA	RDOARG
	AC0002
	TAD	RDOIO		/SAVE RETURN ADDR
	PUSHS
NOROM2,				/REENTRY POINT FROM MOUNT CALL
RDOREN,	TAD	RTIFN
	JMS I	ZPTRST
	TAD	W0
	SNA
NOINIT,	FATAL		/NO INIT DONE?
	SMA CLA
	AC0002
	TAD	(DCA I	DOLIST
	DCA	DOSTOR
	TAD	RTIFN
	AND	P70
	TAD	PCDF
	JMS	STORE		/CDF LINE BUFR
	TAD	RDOARG
	IAC			/DO ISZ FIRST
	JMS	STORE		/LOC OF LINE BUFR
	CALL	(BFRCDF
	JMS	STORE		/CDF I/O BUFR
	TAD	DOSTOR
	DCA	RESTOR
	TAD	W3
	SZA CLA			/BUFR EMPT
	JMP	.+3		/NO
	JMS I	KGPBUF
	JMP	RDOREN		/MAY HAVE BEEN, RESET ALL POINTERS

	TAD	W2
	IAC			/AUTO ISZ
	JMS	STORE		/CURR. LOC'N CTR IN BUFR
	JMS	GETBMP		/GET WORD CNT
	DCA	COUNT
	CDF RSFLD
	TAD	W1		/GET STARTING ADDR OF BUFFER
	AND	P7600
	TAD	COUNT		/SUBTRACT LENGTH OF NEXT RECORD
	TAD	M4		/4 FOR A SAFETY MARGIN
	CIA
	TAD	W2		/GET INTERNAL BUFFER POINTER
	AND	P7400
	CLL
	TAD	W5
	CLA RAL
	TAD	W4
	TAD	U2
	SNA CLA		/WILL THE UNIT BE TOTALLY FILLED BY THIS LAST RECORD?
	TAD	W0		/BUT WAIT! THIS ONLY APPLIES TO WRITES
	SMA CLA		/ARE WE DOING A WRITE?
	JMP	ITSOK		/NO - ALL THOSE GROOVY CHECKS GONE TO WASTE
	/(THE REASON IS, ON READS THE POINTERS ARE ONE BUFFER
	/AHEAD, AND ON WRITES, THEY'RE ONE BEHIND)
	CLA CMA
	DCA	W3
	AC0002
	JMS	PUTBMP
	JMP I	(NOROM1		/NO ROOM HERE FOR MOUNT CALL AT EOU
ITSOK,	TAD	COUNT
	JMS	PUTBMP
	TAD	COUNT		/COUNT = +1 MEANS END-OF-STRING
	SMA			/END OF UNIT ON READ?
	JMP I	(RDPAT		/LOOKS LIKE IT
	CLL CML CIA
	TAD	LENGTH		/CHECK FOR OVERFLOW OF BUFFER
	SNL SZA CLA		/IF IT WONT FIT -
	JMP I	(RTNM1		/TAKE ERROR RETURN FROM RDOIO
GETCDL,	JMS	GETBMP
	JMS	PUTBMP
	ISZ	COUNT
	JMP	GETCDL
	POPJS			/DONE, TAKE GOOD RETURN TO CALL+2

GETBMP,	0
GETCDF,	HLT
	TAD I	GETPNT
	ISZ	GETPNT		/NOW BUMP POINTER
	EXIT	GETBMP
	CALL	(FLDOVR		/AND BUMP CDF ON CARRY
	GETCDF
	EXIT	GETBMP
STORE,	0
DOSTOR,	HLT			/DCA I DOLIST+N
	ISZ	DOSTOR
	JMP I	STORE
PUTBMP,	0
PUTCDM,	HLT
	DCA I	PUTPNT
	ISZ	PUTPNT		/BUMP POINTER
	JMP	.+3
	CALL	(FLDOVR		/AND FIELD ON CARRY
	PUTCDM
	CDF RSFLD
	CALL	(BUFINC		/INCR W2 WITH CHECKS
	ISZ	W3
	JMP I	PUTBMP
	TAD	PUTBMP		/SAVE RETURN!! (GUESS WHY)
	PUSHS
	TAD	GETCDF		/GROAN, HAVE TO DO I/O
	PUSHS
	TAD	PUTCDM		/SO SAVE ALL STATE
	PUSHS
	TAD	RESTOR		/NOT ON PAGE ZERO SWAP AREA
	PUSHS
	JMS I	KGPBUF		/ **** MAY BE SWAPPED ****
	POPS			/RESET THE WORLD AND GET BACK ON
	DCA	RESTOR
	POPS
	DCA	PUTCDM
	POPS
	DCA	GETCDF
	TAD	W2
	IAC			/ARMSTRONG AUTO INDEXING
RESTOR,	HLT			/DCA GETPNT OR DCA PUTPNT
	POPJS			/USE CORRECT RETURN ADDR
DOLIST,	GETCDF
	GETPNT
	PUTCDM
	PUTPNT
	GETCDF
	GETPNT
/
	PAGE

/ENTER WITH IFN IN AC
/SETS W0-W5,U0-U2 TO CONTAIN
/THE CORRECT TFT AND UT ENTRIES
/
/
PTRSET,	0
	CDF RSFLD
	AND	P7
	DCA	PTR3
	JMS	PTRCON
	DCA	PTR1
	TAD	USRFLD
	DCA	PTR2
	TAD	(-UTFTSZ
	CALL	MOVE
PTR2,	0
	WX-1
PTR1,	0
	TAD	PTR3
	DCA	IFN
	JMS	PTRCON
	DCA	PTR3
	TAD	USRFLD
	DCA	.+2
	TAD	(-UTFTSZ
	0
	CALL	MOVE
	CDF	RSFLD
PTR3,	0
	WX-1
	TAD	WX
	DCA	PTR4
	AC7775
	CALL	MOVE
	CDF RSFLD
PTR4,	0
	U0-1
	JMP I	PTRSET

PTRCON,	0
	CMA
	TAD	IFN
	DCA	PTR4
	TAD	PTR4
	CLL RAL
	TAD	PTR4
	RAL
	TAD	PTR4
	IFNZRO UTFTSZ-7 <^^^ THE ABOVE JUST STOPPED WORKING ^^^>
	TAD	USRBAS
	TAD	(UTFT
	EXIT	PTRCON
INU,	-3
	5257	/IN
	0166	/ U
	6446	/SE

/SYSTEM INITIALIZATION ROUTINE - USED FOR LOADER AND
/ FOR INIT'S TO DEVICE "SYS"
SYSINI,	ISZ	T2		/CHANGE 1777 TO 2000 (READ)
	TAD I	SYGET
	SNA
SYSERR,	ERROR			/ALL GONE!
	ISZ	SYGET		/BUMP TO NEXT FILE
	CLL RTR
	RTR
	DCA	W3
	TAD	W3
	RAR
	AND	P7400
	DCA	W5
	TAD	W3
	AND	X377
	DCA	W4
	DCA	W3
	TAD	XDSKQ		/SET UP HANDLER
	DCA	U0
	TAD	XSYSH		/AND PFT VECTORS
	DCA	WX
	JMP I	(MATSYS
X377,	377
XDSKQ,	DSKQ
XSYSH,	SYSPFT-1

POPSTK,	0
	CLA CMA CML
	TAD	PDL
	DCA	PDL
	TAD I	PDL
	JMP I	POPSTK
F1PSHJ,	0
	CDF RSFLD
	DCA	F1POPT
	TAD I	F1PSHJ
	DCA	F1POPV
	IAC
	TAD	F1PSHJ
	PUSHS
	TAD	F1POPT
	JMP I	F1POPV
F1POPJ,	DCA	F1POPT
	CDF RSFLD		/NEVER TAKE CANDY FROM STRANGERS
	POPS
	DCA	F1POPV
	TAD	F1POPT
	JMP I	F1POPV
F1POPT,	0
F1POPV,	0
PUSHX,	0
	DCA I	PDL
	ISZ	PDL
	TAD	PDL
	TAD	(-PDLLIM
	SNA CLA			/CAUSE ERROR ONLY ON FIRST OVERFLOW
PDLERR,	FATAL
	JMP I	PUSHX

/ROUTINE TO CONVERT OCTAL TO PACKED ASCII DECIMAL
/CALL WITH OCTAL # 0-143 IN AC AND "COUNT" =0
/EXIT WITH TWO 6-BIT ASCII DIGITS IN AC, 00-99.
/
OTOPD,	0
	DCA	TEMP
	DCA	COUNT
	TAD	TEMP
	ISZ	COUNT
	TAD	KM12		/-10 IN DISGUISE
	SMA
	JMP	.-3
	DCA	TEMP
	TAD	COUNT		/GET TENS
	BSWN			/PUT IN HIGH HALF
	TAD	TEMP		/AND ONES IN LOW HALF
	TAD	(2033		/MAKE ASCII
	JMP I	OTOPD
KM12,	-12
TEMP,	0
PSHERR,	FATAL		/TOO MUCH STUFF ON THE STACK WHEN SWAPPED OUT
			/(THIS WORD CAN GO ANYWHERE IN FIELD 1)
/
	PAGE

LK100,	100			/ -7700 IN DISGUISE, TOO
	IFNZRO LK100&177 <???> /MUST BE FIRST LOC ON PAGE
LOKREC,	CALL	(FAKENT		/GET CHANNEL # WITHOUT MOVING STACK
	TAD	T		/TEST FIRST FOR FILE LOCK
	CLL RAL
	CALL	(LOKJOB
	JMP	.+3		/ALREADY LOCKED?
LKM100,	SMA CLA			/LOCKED BY THIS USER?
	JMP	LOKROK		/NO, OK TO LOCK RECORD
	TAD I	WXI		/POINTS TO LOCK ENTRY
	TAD	LK100		/E.G. JOB #37
	SPA CLA
	JMP I	(POPLOK		/CANNOT LOCK RECORD IF FILE IS LOCKED
	AC2000
	CALL	(RBKCON		/FIGURE OUT BUFFER OR BLOCK NUMBER
	TAD	(-RCLKMX^JOBMAX
	DCA	RCLKCT		/PREPARE TO SCAN RECORD LOCK TABLE
	TAD	(J0RCLK
	DCA	T
RCLKL1,	JMS	DCMPR		/DO STRANGE DOUBLE WORD COMPARE
	TAD	IST1		/RETURN IF NOT EQUAL; WAS RESULT -
	SPA
	JMP	RCLKLT		/NO, TEST FOR LOCK ON BLOCK+1 IF NECESSARY
	TAD	RELBLO		/DOES THIS RECORD CROSS BLOCK BOUNDARY
RLK200,	AND	LK100
	CLL RAL			/MAKE CARRY BIT 0 OR 0200
	SZA			/IGNORE SCAN IF NO CARRY
	JMS	DCMPR
	JMP	RCLKX1		/RETURN IF NO MATCH

RCLKLT,	TAD I	T		/DOES COMPAREE CROSS BLOCK BOUNDARY?
	AND	LK100
	SNA CLA
	JMP	RCLKX1		/NO, CONTINUE SCAN
	TAD	P7600		/YES, TEST FOR MATCH WITH BLOCK-1
	JMS	DCMPR
RCLKX1,	ISZ	T		/HERE IF NO LOCK CONFLICT WITH THIS ENTRY
	ISZ	T		/BUMP TO NEXT ENTRY OR
	ISZ	RCLKCT		/IF COUNT OVERFLOWS
	JMP	RCLKL1
	SKP
LOKROK,	CALL	(RBKCON
	TAD	(-RCLKMX	/OK TO LOCK BLOCK
	DCA	RCLKCT
	CALL	ZJOBIX		/GET START OF RECORD LOCK TABLE FOR THIS JOB
	JBRCLK
	DCA	T
RCLKSC,	TAD I	T		/BEGIN SCAN LOOKING FOR EMPTY ENTRY
	SNA CLA
	JMP	RCLKFD		/IF 0 THEN HAVE FOUND AN ENTRY
	ISZ	T
	ISZ	T
	ISZ	RCLKCT		/OR MIGHT RUN OUT OF ROOM
	JMP	RCLKSC
TMNYLK,	FATAL			/**** INSERT MSG TOO MANY LOCKS ****
RCLKFD,	TAD	RELBLO		/HERE WHEN FREE SLOT FOUND
	DCA I	T
	ISZ	T
	TAD	RELBHI		/STORE THE ARGS
	DCA I	T
	CALL	ZWXIDX
	LOKARG-SYSPFT+1
	AND	P77
	TAD	LKM100		/PRESERVING THE PRECIOUS REEL #
	DCA I	WXI
	JMS I	ZFETPC		/BUMP PC PAST ERROR RETURN
	JMP I	ZILOOP

/ ROUTINE TO DO DOUBLE WORD COMPARE OF CONTTENTS OF RELBHI,RELBLO
/ AND ARGS AT ADDR T AND T+1.  COMPARE IS DOUBLE PRECISION SUBTRACT
/ AFTER MASKING OFF BIT 5.  RESULT IS
/ LEFT IN IST1,IST2.  IF RESULT IS ZERO, CONFLICT IS PROVEN AND
/ ROUTINE TAKES ERROR RETURN BRANCH FROM LOKREC
/ MAY BE CALLED WITH AC NON-ZERO TO TEST FOR A+1=B, OR A=B+1
/
DCMPR,	0		/AC MAY NOT EQUAL 0
	TAD	RELBLO
	AND	(7677		/MASK OUT CARRY BIT
	STL CIA
	DCA	IST2
	TAD I	T
	AND	(7677
	TAD	IST2
	DCA	IST2
	IAC
	TAD	T		/DO NOT DISTURB LINK OR T
	DCA	T1
	RAL			/FINALLY!
	TAD	RELBHI
	CIA
	TAD I	T1
	DCA	IST1		/THERE IS THE RESULT
	TAD	IST1		/IS IT ZERO?
	SZA CLA
	EXIT	DCMPR		/NO, SAFE
	TAD	IST2		/WELL?
	SZA CLA
	EXIT	DCMPR
	CALL	ZJOBIX		/IT MATCHES BUT MAYBE ITS A LOCK
	JBRCLK			/BY THE SAME JOB
	CIA			/RETURN WITH BEGINNING OF LOCK TABLE
	TAD	T		/COMPARE T WITH LIMITS FOR THIS JOB
	CLL
	TAD	(-RCLKMX^RCLKSZ /WILL GET CARRY IF T OUTSIDE RANGE
	SZL CLA
	JMP I	ZILOOP		/SAME BLOCK, DIFF JOB, FORGET IT!
	EXIT	DCMPR		/LET HIM LOCK IT ALL HE WANTS

/ ROUTINE TO MOVE A MESSAGE TO USER I/O BUFFER.
/ THIS ROUTINE WOULD NOT EXIST EXCEPT THAT IMPLEMENTING SEQUENCE
/ NUMBERS USED MORE ROOM THAN THERE WAS IN MOUNT.
/
/ WITH THE WX ENTRIES SET UP;
/	CALL:
/	CALL	(BMOVE
/	(INDEX FROM START OF BUFFER-1)
/	(ADDR IN FIELD 1 OF TEXT)
/	(NUMBER OF WORDS TO MOVE)
/	<RETURN>	; AC=ADDR IN BUFFER FOR CDOIO
/
BMOVE,	0
	TAD I	BMOVE		/PICK UP DISPLACEMENT INTO BUFFER
	DCA	BM1
	ISZ	BMOVE
	TAD I	BMOVE		/ADDR OF TEXT TO BE MOVED IN FIELD ONE
	DCA	BM2
	ISZ	BMOVE
	CALL	(BFRIDX		/GET REAL ADDRESS OF DEST. IN BUFFER
BM1,	0
	DCA	BM3
	CALL	(BFRCDF		/GET CDF TO BUFFER FIELD
	DCA	BM4
	TAD I	BMOVE		/GET WC INTO AC
	CALL	MOVE
BM4,	0
BM2,	0
BM3,	0
	TAD	BM3		/EXIT WITH REAL ADDR IN AC
	ISZ	BMOVE
	EXIT	BMOVE
/
	PAGE

ULOKRC,	JMS	FAKENT		/FIND CHEAPLY THE CHANNEL #
	JMS	RBKCON		/WITHOUT FURTHER ADO
	TAD	(-RCLKMX	/SCAN JOB RECORD LOCK TABLE FOR EXACT MATCH
	DCA	RCLKCT
	CALL	ZJOBIX		/GET POINTER TO START OF TABLE
	JBRCLK
	DCA	T		/GOOD OLD T
RNEXTT,	TAD I	T
	CIA
	TAD	RELBLO		/SAME THING?
	SZA CLA
	JMP	RCNXT		/NOT EVEN CLOSE
	ISZ	T		/COMPARE SECOND WORD OF ARG
	TAD I	T
	CIA
	TAD	RELBHI
	SNA CLA
	JMP	ULKCLR		/GOT IT, GO CLEAR IT
	SKP
RCNXT,	ISZ	T		/NEXT ENTRY
	ISZ	T
	ISZ	RCLKCT		/DONE WITH TABLE?
	JMP	RNEXTT
	JMP I	ZILOOP		/WE ARE? OH WELL, NO HARM DONE

ULKCLR,	DCA I	T		/ZAP!
	CMA
	TAD	T
	DCA	T		/WHERE IS DCR	T?
	DCA I	T
	TAD	WX		/GET FILE NUMBER
	JMS	TFTNUM
	JMS	ULKIT
	JMP I	ZILOOP
ULKIT,	0
	CIA
	DCA	T
	TAD	(-JOBMAX^RCLKMX
	DCA	RCLKCT		/LOOK FOR OTHER RECORD LOCKS ON SAME FILE
	TAD	(J0RCLK-1
	DCA	XRM0		/HERE IT IS AUTO-INDEX FANS!
ULKLP,	TAD I	XRM0
	AND	P77
	TAD	T		/SAME LOGICAL UNIT?
	SNA CLA			/
	EXIT	ULKIT		/YES, DUCK THE BUCK
	ISZ	XRM0
	ISZ	RCLKCT		/THROUGH TABLE YET?
	JMP	ULKLP
	CALL	ZWXIDX
	LOKARG-SYSPFT+1
	AND	P77		/RECORD LOCKS ARE ON FILE 
	DCA I	WXI
	EXIT	ULKIT

TFTNUM,	0			/ENTER WITH WX IN AC
	DCA	IST2		/EXIT WITH LOGICAL UNIT # IN AC
	DCA	IST1
	TAD	IST2
	TAD	(-SYSPFT+TFTSIZ+1
	TAD	(-TFTSIZ
	ISZ	IST1
	SZA
	JMP	.-3
	TAD	IST1
	EXIT	TFTNUM
FAKENT,	0			/CALLED TO GET I/O DESCRIPTOR WORD
	TAD	PDL		/WITHOUT BLOWING STACK OR DES1
	TAD	(-5		/POINT XRM0 AT ESTIMATED LOCATION
	DCA	XRM0		/OF DESCRIPTOR ENTRY
	TAD I	XRM0
	PUSHS			/COPY TWO WORD ENTRY ONTO STACK
	TAD I	XRM0
	PUSHS
	CALL	(IOCOMN		/CAN DO THIS NOW
	DCA	T
	CDF RSFLD
	POPDS1			/WITHOUT BOTHERING DES1
	EXIT	FAKENT
RBKCON,	0			/ROUTINE TO COMPUTE BUFFER (BLOCK) NUMBER
	DCA	RAT1
	CALL	ZWXIDX
	BLOCK-SYSPFT+1
	DCA	BLKSIZ
	CALL	(BLKCON		/ LET R.L. DO THE WORK
	TAD	BUFSIZ		/TEST FOR BUFFER (BLOCK) OVERFLOW
	CIA STL
	TAD	IST1
	TAD	BLKSIZ
	SNL CLA
	TAD	(100		/LINK IS CLEARED IF OVERFLOW
	TAD	RELBLO		/SET OVERFLOW BIT IN ARG
	DCA	RELBLO
	TAD	WX		/NOW COMPUTE #+1 OF LOGICAL UNIT ENTRY
	JMS	TFTNUM
	TAD	RELBLO		/ADD INTO LOW ARG WORD
	DCA	RELBLO
	EXIT	RBKCON

NOROM1,	TAD	WX
	TAD	(FLABEL-SYSPFT	/AIN'T NO ROOM FOR MOUNT CALL AT EOU
	DCA	NOR1		/TRY TO GET SAME LABEL WITH BUMPED SEQ #
	AC7775
	CALL	MOVE		/SO TAKE THE LABEL ON THE PRESENT UNIT
	CDF RSFLD		/FOR STARTERS
NOR1,	0			/FILLED IN WITH PFT ENTRY ADDR-1
	LABEL-1
	ISZ	GETPNT		/BUMP TO SEQ #
	AC0001			/INCR BY ONE
	TAD I	GETPNT
	AND	P77
	DCA	REELNO
	PUSHJS				/NOW CALL MOUNT TO FIND IT
	MOUNT
	JMP I	(NOROM2			/GO TO REENTRY POINT FOR RDOIO
POPLOK,	TAD	OLDPDL		/ATTEMPTED RECORD LOCK ON LOCKED FILE
	DCA	PDL		/CLEAR ALL GORP OFF STACK BEFORE
	JMP I	ZILOOP		/TAKING ERROR RETURN
/
	PAGE

/ MORE ROUTINES THAT WOULDN'T FIT ANYWHERE ELSE, BUT ARE
/ NECESSARY TO IMPLEMENT SEQUENCE NUMBERS
NOROM3,	0			/CALL TO PUT SEQ # INTO MOUNT MESSAGE
	CALL	NCTRLOF			/INITIAL ACTION IN MOUNT
	TAD	LENGTH		/SAVE FOR RDOIO
	PUSHS
	TAD	REELNO
	SNA				/OVERFLOW?
BADSEQ,	FATAL				/YOU LOSE
	CALL	NOTOPD
	DCA I	NSEQ
	EXIT	NOROM3
NSEQ,	SEQ			/ALL THIS IN LIEU OF A LIT PSEUDO-OP
NOTOPD,	OTOPD
NCTRLOF,	CTRLOF
NOROM4,	0			/CALLED TO MOVE LABEL OF DESIRED UNIT
	CALL	NBFRIDX
	200+LBL1-TMOUNT-1	/BELIEVE IT OR NOT, ADDR OF LABEL-1
	DCA	REP2
	TAD	LBLLOC
	DCA	REP3
	AC7775			/THREE WORDS OF LABEL
	CALL	NCDFBFR
	CALL	MOVE
	CDF RSFLD
REP2,	HLT
REP3,	HLT
	TAD	REELNO
	ISZ	PUTPNT
	DCA I	PUTPNT
	TAD	REP2		/SET SOME STUFF UP FOR RETURN
	DCA	XRM1
	EXIT	NOROM4
NCDFBFR,	CDFBFR
NBFRIDX,	BFRIDX

/ MULTI TERMINAL LOGICAL UNITS TABLE
/
/	ENTRIES CONTAIN:
/
/	HANDLER ADDR, UNIT #
/	STARTING SEGMENT #
/	LENGTH IN SEGMENTS
/	L A
/	B E
/	L S
/	LOCK BIT, JOB#, REEL #
/	-N USERS
/
SYSPFT,	DSKQ		/PHONEY IFN0 ENTRY FOR SYS FILES
	0
	-626
FLABEL,	0;	0;	0
LOKARG,	0
FNUSRS,	0
BLOCK,	0		/RECORD SIZE IF READ OR UPDATE
	/
TFT1,	ZBLOCK TFTSIZ
	/
	/
TFT2,	ZBLOCK TFTSIZ
	/
	/
TFT3,	ZBLOCK TFTSIZ
	/
	/
TFT4,	ZBLOCK TFTSIZ
	/
	/
TFT5,	ZBLOCK TFTSIZ
	/
	/
TFT6,	ZBLOCK TFTSIZ
	/
	/
TFT7,	ZBLOCK TFTSIZ
	/
	/
TFT8,	ZBLOCK TFTSIZ
	/
	/
TFT9,	ZBLOCK TFTSIZ
	/
	/
TFT10,	ZBLOCK TFTSIZ
	/
	/
TFT11,	ZBLOCK TFTSIZ
	/
	/
TFT12,	ZBLOCK TFTSIZ
	/
	/
TFT13,	ZBLOCK TFTSIZ
	/
	/
TFT14,	ZBLOCK TFTSIZ
	/
	/
TFT15,	ZBLOCK TFTSIZ
	/
	/

/ TABLE OF SYSTEM FILES AS SPECIFIED IN RUN COMMAND.  ENTRIES ARE
/ STARTING BLOCK NUMBER OF FILES, TERMINATED BY ZERO.  CALLING SYSINI
/ BUMPS INDIVIDUAL JOB POINTER TO THIS TABLE AND FETCHES NEXT ENTRY
/
MSBT,	ZBLOCK 10
	/
	/

/ RECORD LOCK TABLE
/
/	RCLKMX ENTRIES PER JOB;
/	2 WORDS PER ENTRY.
/	WORD1 = 0 INDICATES FREE ENTRY
/
/	ENTRIES CONTAIN:
/
/ WORD1:	BITS 0-4	;LOW ORDER BUFFER (BLOCK) NUMBER
/		BIT  5		;=1 IF CARRY INTO NEXT BLOCK
/		BITS 8-11	;LOGICAL UNIT # + 1
/
/ WORD 2:	HIGH ORDER BUFFER (BLOCK) NUMBER
/
J0RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J1RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J2RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J3RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J4RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J5RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J6RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/
J7RCLK,	ZBLOCK RCLKMX^RCLKSZ
	/
	/

/ PRESERVE ORDER OF THE FOLLOWING OR FIX UP MOUNT
TMOUNT,	-17
	5660
	6657
	6501
LBL1,	0
LBL2,	0
LBL3,	0
	0104
SEQ,	2122
	0101
	4760
	6301
IORO,	0
	0
	6665
	3301
REPLBL,	-12
	6346	/RE
	6155	/PL
	4244	/AC
SEQOUT,	4601	/E
LABEL1,	0
LABEL2,	0
LABEL3,	0
	0104	/ #
SEQLBL,	2122	/XX
	4000	/?
ILUNT,	-7	/LENGTH
	4052	/?I
	5555	/LL
	4650	/EG
	4255	/AL
	0166	/ U
	5752	/NI
	6500	/T
OUTIN,	6066;6561		/OUTP
	0152;5761		/INP

/ERROR MESSAGE LIST
ERRLST,	-EOFERR-1
	+EOFMSG-1
	-PDLERR-1
	+PDLMSG-1
	-DKERTN-1
	+DKEMSG-1
	-RETERR-1
	+RETMSG-1
	-P2ERR-1
	+P2MSG-1
	-D0ERR-1
	+D0MSG-1
	-A2DERR-1
	+A2DMSG-1
	-INIERR-1
	+INIMSG-1
	-BUFERR-1
	+BUFMSG-1
	-XMIERR-1
	+XMIMSG-1
	-NUMERR-1
	+NUMMSG-1
	-BR0ERR-1
	+BR0MSG-1
	-SSERR-1
	+SSMSG-1
	-LTLERR-1
	+LTLMSG-1
	-RAERR-1
	+RAMSG-1
	-RECERR-1
	+RECMSG-1
	-SYSERR-1
	+SYSMSG-1
	-CDINER-1
	+CDINMS-1
	-NOINIT-1
	+NOIMSG-1
	-TMNYLK-1
	+LOKMSG-1
	-BADSEQ-1
	+BADMSG-1
	-FINERR-1
	+FINMSG-1
	-FRMERR-1
	+FRMMSG-1
	-PSHERR-1
	+PSHMSG-1
	/
	/
LDBUF,	ZBLOCK 200		/LOADER LINE BUFFER BEGINS HERE

	FIELD 1
/ END SECTION 3 LISTING CONTROL
	IFNZRO LIST&10 <XLIST>
////////////////////////////////
/			       /
/	END OF MULTI3.PA       /
/			       /
////////////////////////////////