2!		PROGRAM		: BACMNT.BAS
5!		VERSION		: V10.1
6!		EDIT		: A
7!		EDIT DATE	: 10-MAY-91
10		EXTEND
11	! &
	&
	&
	!	C O P Y R I G H T &
	&
	&
  !		      Copyright (C) 1976, 1991 by &
  !	        Digital Equipment Corporation, Maynard, Mass. &
  !	&
  !	&
  !	This software is furnished under a license and may be used and &
  !	copied  only  in accordance with the terms of such license and &
  !	with the  inclusion  of  the  above  copyright  notice.   This &
  !	software  or  any  other copies thereof may not be provided or &
  !	otherwise made available to any other person.  No title to and &
  !	ownership of the software is hereby transferred. &
  !	&
  !	The information in this software is subject to change  without &
  !	notice  and should not be construed as a commitment by Digital &
  !	Equipment Corporation. &
  !	&
  !	DIGITAL assumes no responsibility for the use  or  reliability &
  !	of its software on equipment that is not supplied by DIGITAL. &
  !	&
  !******************************************************************* &

20	! &
	&
	&
	!	M O D I F I C A T I O N    H I S T O R Y &
	&
	&
	! VER/ED	EDIT DATE	REASON &
	! KMF 01	17-MAY-84	CHANGE VALUE OF A% &
	!				TO PRIV'D USER &
	! &

100	! &
	&
	&
	!	G E N E R A L    D E S C R I P T I O N &
	&
	&
	&
!	THIS MODULE DOES ALL MOUNTING AND DISMOUNTING OF BACKUP &
!	VOLUMES.  IT CONDUCTS DIALOGUE TO GATHER LABELLING INFORMATION &
!	AND ACTUALLY LABELS MAGTAPES.  IT CALLS MODULE BACDSK TO LABEL &
!	DISKS AND CALLS MODULE BACLAB TO READ THE LABELS FROM DISKS. &
	&
	&
	&
	! &
	&
	&
	!	I / O    C H A N N E L S &
	&
	&
	&
   !	CHANNEL #		USED FOR &
!	   1			WORK FILE &
!	   3			LISTING FILE &
!	   6			BACKUP VOLUME ACCESSES &
	&
	&
   	! &
	&
	&
	!	V A R I A B L E    D E F I N I T I O N S &
	&
	&
	&
   !	NAME		USED FOR &
!	A$		ACCOUNT NUMBER STRING. &
!	A%		ACCOUNT NUMBER. &
!	B%		BACKUP OR RESTORE FLAG. &
!	B0%		FREE LIST POINTER. &
!	B1%		BACKUP CLUSTER SIZE IN BYTES. &
!	B2%		BACKUP DISK DEVICE CLUSTER SIZE IN BYTES. &
!	B9%		ERROR DIFFERENTIATION VAR. &
!	B$		BACKUP SET NAME. &
!	B0$		CHR$(255%) &
!	C$		GENERAL DECODE COMMAND STRING. &
!	C1%		CHANNEL NUMBER. &
!	C6$		CHR$(6%) &
!	C8$		BELL &
!	C9$		'CRLF' &
!	C8%		CREATION DATE. &
!	D$		DEVICE NAME. &
!	D%()		INTERUPT DECODE ARRAY. &
!	D$()		INTERUPT DECODE ARRAY. &
!	D1%()		DAYS IN MONTH ARRAY. &
!	D1$		MONTH STRING. &
!	D2$()		DENSITY VALUE DECODE ARRAY. &
!	D5$		'DENSITY'. &
!	D8%		DENSITY/PARITY WORD. &
!	D9%		EXPIRATION DATE. &
!	E%		ERROR VARIABLE. &
!	E0%		ENTRY TYPE. &
!	E2%		PACKAGE ERROR COUNT. &
!	E5$		'EXPIRATION DATE'. &
!	E9$		CHR$(6%)+CHR$(9%) &
!	F%		SUCCESS FLAG. &
!	F0$		CHR$(6%)+CHR$(-10%) (FOR FILE NAME STRING SCAN CALL) &
!	G%		SUCCESS FLAG. &
!	G1%		SECONDARY SUCCESS FLAG. &
!	I$		VERSION-EDIT. &
!	I%		FIRST TIME THROUGH FLAG. &
!	I5$		'IDENTIFICATION' &
!	J$		JOB NUMBER STRING. &
!	J%		JOB NUMBER. &
!	J1%		JOB DATA BLOCK 1. &
!	K%		KB: NUMBER. &
!	K0%		I/O BLOCK. &
!	K1%		KB: LIST FILE FLAG. &
!	L0%		LIST FILE FLAG. &
!	L$		LABEL STRING. &
!	M0$		CHR$(6%)+CHR$(18%) (FOR 'MESSAGE' SYS CALLS) &
!	M1%		UTILITY VAR. &
!	M2%		UTILTY VAR. &
!	M%		MAGTAPE OR DISK FLAG. &
!	N$		"". &
!	P%		STRING POSITION POINTER. &
!	P0%		CURRENT RECORD POINTER. &
!	P1%		RECORD POINTER. &
!	P$		CHAIN MODULE NAME. &
!	P$()		PARITY VALUES DECODE ARRAY. &
!	P5$		'PARITY' &
!	P8%		BACKUP SET ACCOUNT. &
!	PRIV.OFF$	SYS(PRIV.OFF$) DROPS PRIV'S (TEMPORARILY) &
!	PRIV.ON$	SYS(PRIV.ON$) REGAINS PRIV'S. &
!	R%		PACKAGE STATUS WORD. &
!	R$		PACKAGE STATE VARIABLE. &
!	R%()		RESPONSE ARRAY. &
!	R0$		MODULE STATE VARIABLE. &
!	R0%()		VALID RESPONSE ARRAY. &
!	R1%		VALID RESPONSE VAR. &
!	S%		STACK POINTER. &
!	S%()		STACK. &
!	S5$		'SEQUENCE' &
!	S1%		SCRATCH VOLUME INDICATOR. &
!	S2%		TEMPORARY DENSITY/PARITY STORAGE. &
!	S8%		MAGTAPE STATUS VAR. &
!	S9$		SEQUENCE NUMBER. &
!	S9%		SEQUENCE NUMBER. &
!	T$		TEXT TO SEND TO KB: OR OPERATOR. &
!	T%		ATTEMPTS COUNTER. &
!	T6%		TEMP VAR. &
!	T8%-T9%		TEMP VARS. &
!	T9$		TAB &
!	U8%		UNIT NUMBER. &
!	W$		WORK FILE NAME. &
!	ALL Z'S		TEMPORARY LOCAL WORK VARIABLES. &
	&
	&
	! &
	&
	&
	!	F U N C T I O N / S U B R O U T I N E    D E S C . &
	&
	&
	&
!	NAME		LINE	USE &
!	10000			DISMOUNT DEVICE. &
!	10200			RESTORE MOUNT. &
!	10300			READ A RECORD FROM MAGTAPE. &
!	10400			BACKUP MOUNT. &
!	10500			SHOULD WE LABEL A BACKUP VOLUME? &
!	10550			SHOULD WE LABEL A NON-BACKUP VOLUME? &
!	10600			DIALOGUE ROUTINE. &
!	10800			LABEL A MAGTAPE. &
!	11000			STANDARD MOUNT ROUTINE. &
!	FND%		15200	GET A DATA OUT OF A STRING. &
!	FNP9%		15400	SET MAGTAPE DENSITY/PARITY. &
	&
	&
	&
	&
	&
	! &
	&
	!	P A C K A G E    S U B R O U T I N E S &
	&
	! Name			Lines		Use &
	! OPEN THE LISTING FILE	22500-22540	Ensure an open listing &
	!					file &
	! PROCESS ANY ERROR ON LIST FILE &
	!			22550-22580	Process errors and &
	!					minimize effect on &
	!					program &
	! PREPARE FOR DETACH	22600-22690	Do checks and manipulate &
	!					flags preliminary to &
	!					DETACH. &
	! PRINT A LINE TO LIST FILE &
	!			22700-22770	Print a line and trap &
	!					errors. &
	! CHECK FOR ATTACHED	22800-22830	Check KB: DDB for &
	!					ATTACHed state &
	! STATUS		22900-22990	Create a status report &
	!					string. &
	! LOG ERROR		23000-23090	Log an error on a record &
	!					in the work-file. &
	! ISSUE A MESSAGE	23100-23190	Issue a message to KB: &
	!					or to OPSER. &
	! GET/DECODE RESPONSE OR INTERRUPT COMMAND &
	!			23200-23390	Get a (KB:) line or a &
	!					(Send/Receive) message; &
	!					Call the decoder; &
	!					Process internal &
	!					commands. &
	! DECODE A LINE		23400-23490	Do a table-driven decode &
	! PROCESS REQUESTS	23499-23790	A set of routines which &
	!					perform additional &
	!					parsing and processing &
	!					of commands. &
	&
	! &
	&
	!	P A C K A G E    F U N C T I O N S &
	&
	! Name			Lines		Use &
	! FNN$(A%)		25000		Return the unsigned &
	!					value of A% as a string. &
	! FNE$(E%,D%,P3%,P0%,E1%) &
	!			25100-25140	Create an error message &
	!					string from parameters. &
	! FNR%(S$,L%)		25200-25250	Match a  keyword. &
	! FNF0%(P0%,N$,D$)	25500-25690	Apply null default or &
	!					default string to a File &
	!					Descriptor Record. &
	! FNP%(P0%,P%,S$,Y0%,Y1%) &
	!			25800-25890	Turn a filename string &
	!					into a File Descriptor &
	!					Record. &
	! FNU$(P0%,C$,Z%,Z0%)	25900-25970	Turn a File Descriptor &
	!					Record into a filename &
	!					string, with switches. &
	! FNU0$(L%)		25980-25990	Return the NUM1$ of the &
	!					low byte of L%, or &
	!					'*', if the low byte is &
	!					255. &
	! FNO%(P0%,A0%,C0%)	26000-26090	Open the file described &
	!					in (work-file) record &
	!					P0% - drops and regains &
	!					temporary privs. &
	! FNA%			26100-26130 	Get the next free-list &
	!					record. &
	! FNA0%(P0%)		26200-26230	Put record P0% back &
	!					into the free-list. &
	! FNP0%(B%,L%,D%)	26300-26320	Set up a list for &
	!					processing. &
	! FNP1%()		26450-26470	Restore a list using the &
	!					data on the stack. &
	&
	&

900	&
	&
	&
	!	D I M E N S I O N    S T A T E M E N T S &
	&
	DIM #1%,Z0%(32767%,31%) &
	\ DIM #1%,Z0$(32767%)=64% &
				! WORK-FILE, PRIMARY. &

905	DIM C%(4%), D$(15%),D%(15%,2%), R%(2%),R0%(2%), &
		! 1. THIS ARRAY IS USED IN THE 'STATUS' INTERRUPT &
		!    COMMAND, BELOW. &
		! 2. THESE TWO ARRAYS ARE USED IN THE DECODE OF INTERRUPT &
		!    COMMANDS, BELOW. &
		! 3. THESE TWO ARRAYS ARE USED TO HOLD THE &
		!    RESULTS/REQUESTS TO THE INTERRUPT COMMAND &
		!    PROCESSOR, BELOW. &
	&
	    D1%(12%), D2$(2%),P$(2%), &
		! DAYS IN THE MONTHS ARRAY. &
		! DENSITY AND PARITY DECODE ARRAYS. &
	&
	    S%(30%), &
		! 'THE STACK'. &
	&
	    Z%(30%) &
		! DIMENSION STATEMENT FOR STANDARD ROUTINES &
		! USED BY FNP%() FOR RETURN OF DATA &
		! AND TEMPORARY STORAGE OF DATA &
	&
	&
	&

999	! &
	&
	&
	!	M A I N    C O D E &
	&

1000	ON ERROR GOTO 19000 &
		! SET UP STANDARD ERROR TRAP. &
	\ Z$=SYS(CHR$(6%)+CHR$(-21%)+CHR$(255%)) &
	\ I$="BACMNT	V10.1-A" &
		! SET UP HEADER LINE. &
	\ PRINT I$ IF E0%=0% &
		! PRINT THE HEADER LINE PREPARATORY TO GIVING &
		! AN ERROR. &
	\ CHANGE SYS(CHR$(12%)) TO Z% &
	\ IF Z%(3%)+SWAP%(Z%(4%))<>15%*2% OR E0%<>2% THEN &
		PRINT "?ILLEGAL ENTRY - PLEASE RUN THE RESTOR PROGRAM" &
	\	GOTO 32767 &
		! THIS WAS AN ILLEGAL ENTRY IF WE DIDN'T COME FROM A COMPILED &
		! FILE OR IT WASN'T A CHAIN ENTRY. &

1035	A5%=SWAP%(Z%(6%))+Z%(5%) &
	\ Z$="SY" IF (Z%(26%) AND 1%)=0% &
	\ Z$=CHR$(Z%(23%))+CHR$(Z%(24%))+NUM1$(Z%(25%)) IF Z%(26%) AND 1% &
	\ CHANGE SYS(CHR$(6%)+CHR$(-10%)+Z$) TO Z% &
	\ D5%=SWAP%(Z%(8%))+Z%(7%) &
		! SET UP THE DEVICE AND ACCOUNT OF THE LAST FILE OPENED. &
	\ T0=TIME(0%) &
	\ T1=TIME(1%) &
	\ T3=TIME(3%) &
	\ C6$=CHR$(6%) &
	\ F0$=C6$+CHR$(-10%) &
	\ M0$=C6$+CHR$(18%) &
	\ T9$=CHR$(9%) &
	\ E9$=C6$+T9$ &
	\ B0$=CHR$(255%) &
	\ PRIV.OFF$=C6$+CHR$(-21%)+B0$ &
	\ PRIV.ON$=C6$+CHR$(-21%)+CHR$(0%) &
	\ OPEN W$ FOR INPUT AS FILE 1% &
	\ Z$=SYS(PRIV.ON$) &
	\ J1%=PEEK(520%) &
	\ A%=PEEK(PEEK(J1%+8%)+24%) &
	\ A$="["+NUM1$(SWAP%(A%) AND 255%)+","+NUM1$(A% AND 255%)+"]" &
	\ A%=256%	! Force to [1,0] &
	\ J%=(PEEK(518%) AND 255%)/2% &
	\ J$=RIGHT(NUM1$(100%+J%),2%) &
	\ K0%=PEEK(J1%) &
	\ B0%=Z0%(0%,0%) &
	\ E2%=Z0%(0%,21%) &
	\ R%=Z0%(0%,26%) AND -8193% &
	\ K%=(SWAP%(PEEK(PEEK(K0%)+2%)) AND 255%) OR &
		(R% AND 16384%)=0% &
	\ Z$=SYS(PRIV.OFF$) &
	\ N$="" &
	\ C8$=CHR$(7%) &
	\ C9$=CHR$(13%)+CHR$(10%) &
	\ GOSUB 22600 UNLESS (R% AND 16384%) &
		! SET UP ENTRY TIMES FOR STATUS REPORTS; &
		! OPEN THE WORK-FILE, AFTER DROPPING PRIVS; &
		! HOLD THE ADDRESS OF THE JDB; &
		! GET THE PPN FROM THE JDB; &
		! GET THE JOB NUMBER FROM THE EXEC; &
		! SET UP AN ASCII STRING FOR PRINTING THE PPN; &
		! GET THE ADDRESS OF THE JOB'S I/O BLOCK IN &
		!	THE EXEC  (FIRST WORD IN THE JDB); &
		! SET UP THE FREE-LIST POINTER, THE ERROR COUNT, &
		!	AND THE CURRENT PACKAGE STATE (WITHOUT &
		!	THE FLAG SAYING THAT THE DECODE TABLES &
		!	HAVE BEEN LOADED); &
		! IF THE JOB IS ATTACHED, THEN SET UP THE &
		!	KEYBOARD NUMBER OF 'KB:' IN K%, OR SET &
		!	K% TO -1% IF THE JOB IS DETACHED; &
		! SET UP THE TWO STRING CONSTANTS - C8$=<BELL>, &
		!  C9$=<CR><LF>; &
		! IF THE 'DETACHED' FLAG IS SET, THEN GO SET UP &
		!	PROPER STRINGS; &
		! GO OPEN THE LISTING FILE, AS APPROPRIATE. &
	&
	\ R0%(0%)=(4% AND (A% AND -512%)=0% AND (R% AND 16384%)<>0%)+ &
		16%+128%+2048%+4096%+8192% &
	\ R0%(1%)=1% &
	\ R0$="MOUNT / DISMOUNT" &
	\ D2$(0%)="800" \ D2$(1%)="1600" &
	\ P$(0%)="ODD" \ P$(1%)="EVEN" &
	\ I5$="     ID:" &
	\ S5$="   SEQ#:" &
	\ D5$="DENSITY:" &
	\ P5$=" PARITY:" &
	\ E5$="EXPIRATION DATE:" &
	\ D1$="-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC" &
	\ RESTORE &
	\ READ D1%(Z%) FOR Z%=1% TO 12% &
	\ B%=Z0%(0%,28%)=1% &
	\ Z$=SYS(F0$+FNU$(Z0%(0%,B%*-2%+2%),N$,4096%,0%)) &
	\ M%=STATUS AND 255% &
	\ R$="BEGIN "+R0$ &
	\ GOSUB 23200 &
	\ GOTO 9000 IF (R% AND 1%) &
	\ R$=R0$ &
		! THE FOLLOWING INTERRUPT COMMANDS ARE PROCESSED &
		! ENTIRELY WITHIN THE GET/DECODE ROUTINE AND ARE &
		! ALWAYS LEGAL : &
		!	DETACH (IF PRIV'D AND NOT ALREADY DETACHED) &
		!	PAUSE &
		!	STATUS &
		!	LAST &
		!	LEGAL &
		!	NOTICE &
		! THE FOLLOWING INTERRUPT COMMANDS ARE PROCESSED BY THE &
		! PROGRAM BUT ARE ALWAYS LEGAL : &
		!	ABORT &
		! &
		! INITIALIZE THE DENSITY ARRAY. &
		! INITIALIZE THE PARITY ARRAY. &
		! SET THE VALID RRESPONSES FOR THIS PROGRAM. &
		! INITIALIZE THE STRING CONSTANTS FOR MESSAGES. &
		! K1% IS THE SIZE OF THE "TO BACKUP" PROGRAM. &
		! INITIALIZE THE MONTHS STRING AND THE DAYS IN MONTHS. &
		! &
		! SET UP THE BACKUP OR RESTORE FLAG. &
		! SET UP THE DISK OR MAGTAPE FLAG. &
		! &
		! GO SEE IF ANYTHING IS REQUESTED; &
		! END THIS NONSENSE IF 'ABORT' REQUESTED. &
	&

1100	! &
	&
	&
	!	C A L L    T H E    N E C E S S A R Y &
	!		R O U T I N E S &
	&
	&
	GOSUB 10000 IF (Z0%(0%,31%) AND 1%) &
	\ IF (Z0%(0%,29%) AND 384%) THEN &
		L$=Z0$(Z0%(0%,15%)) &
	\	Z0$(Z0%(0%,15%))=N$ &
	\	Z%=FNA0%(Z0%(0%,15%)) &
	\	Z0%(0%,15%)=0% &
	\	P0%=Z0%(0%,27%) &
	\	D$=FNU$(P0%,N$,-1%,-1%) &
	\	U8%=ASCII(RIGHT(D$,4%))-48% &
		! DO A DISMOUNT IF ONE IS NEEDED. &
		! WE MIGHT HAVE JUST READ A LABEL FROM DISK. &

1120	GOTO 9000 UNLESS (Z0%(0%,31%) AND 2%) &
	\ IF B%=0% THEN &
		GOSUB 10200 &
	ELSE	G%=-1% &
	\	GOSUB 10400 &
		! IF NO MOUNT HAS BEEN REQUESTED, WE SHOULD END UP. &
		! OTHERWISE GOSUB TO THE APPROPRIATE MOUNT ROUTINE. &

1130	GOTO 9000 IF (R% AND 1%) &
	\ GOTO 9000 UNLESS (Z0%(0%,29%) AND 128%) &
	\ P1%=FNA% &
	\ Z0%(P1%,1%)=Z0%(0%,13%) &
	\ Z0%(0%,13%)=P1% &
	\ Z0%(P1%,6%)=D5% &
	\ Z0%(P1%,8%)=A5% &
	\ Z0%(P1%,9%)=3243% &
	\ Z0%(P1%,10%)=19242% &
	\ Z0%(P1%,13%)=1% &
	\ Z0%(P1%,14%)=12417% &
	\ Z0%(0%,27%)=P0% &
	\ GOTO 9020 &
		! IF WE ARE SUPPOSED TO ABORT, LETS END UP WITHOUT &
		! FINDING OUT WHERE WE ARE SUPPUSED TO GO NEXT. &
		! END UP NORMALLY UNLESS WE MUST READ A DISK LABEL. &
		! &
		! SET UP THE CHAIN LIST FOR READING DISK LABEL. &
	&

9000	R$=R0$+" COMPLETE" &
	\ GOSUB 22500 UNLESS L0% OR K1%=-1% &
	\ GOSUB 23200 &
	\ GOSUB 22900 &
	\ IF L0% THEN &
		GOSUB 22700 &
	  ELSE	IF (R% AND 16384%) THEN &
			GOSUB 23100 &
		! &
		! &
		!	C O M P L E T I O N    R O U T I N E S &
		! &
		! &
		! SET UP TO LOG COMPLETION: &
		!	SET UP PHASE NAME STRING; &
		!	GO SEE IF ANY INTERRUPT COMMANDS ARE &
		!	AROUND; &
		!	GO SET UP STATUS STRING; &
		!	IF THE LISTING FILE IS AROUND, THEN &
		!		SEND THE STATUS STRING THERE; &
		!	ELSE	IF THE PROGRAM IS ATTACHED, THEN &
		!			SEND THE STATUS STRING TO THE &
		!			KB: &
		!		ELSE	NO STATUS IS PRINTED. &

9020	P0%=Z0%(0%,13%) &
	\ IF P0%=0% THEN &
		P$=N$ &
	  ELSE	P$=FNU$(P0%,N$,-1%,-1%) &
	\	Z0%(0%,13%)=Z0%(P0%,1%) &
	\	Z0%(P0%,1%)=0% &
	\	Z%=FNA0%(P0%) &
		! HOLD THE POINTER TO THE NEXT RECORD IN THE CHAIN LIST; &
		! IF THE POINTER IS ZERO, THEN &
		!	RETURN A NULL STRING; &
		! ELSE	MAKE THE FILENAME STRING; &
		!	TAKE THIS ONE OUT OF THE CHAIN LIST; &
		!	RETURN THE RECORD TO THE FREE LIST. &

9030	GOSUB 23200 &
	\ IF (R% AND 1%) THEN &
		T$="?RUN ABORTED" &
	\	GOSUB 22720 &
	\	GOSUB 23100 &
		! GO SEE IF ANYTHING NEW HAS BEEN TYPED; &
		! IF AN ABORT WAS REQUESTED, THEN &
		!	SET UP AND PRINT A MESSAGE TO THAT EFFECT INTO &
		!		THE LISTING FILE. &

9040	Z0%(0%,0%)=B0% IF B0% &
	\ Z0%(0%,26%)=R% &
	\ CLOSE Z% FOR Z%=1% TO 12% &
	\ ON ERROR GOTO 19000 &
	\ Z$=SYS(PRIV.ON$) &
	\ CHAIN P$ LINE 31000 UNLESS LEN(P$)=0% OR (R% AND 1%) &
	\ Z$=SYS(PRIV.OFF$) &
	\ GOTO 32700 &
		! RESTORE THE FREE-LIST POINTER AND THE PACKAGE STATUS &
		!	WORDS TO THE WORK-FILE; &
		! CLOSE OUT ALL THE FILES; &
		! CHAIN TO NEXT PROGRAM. &
		! IF WE ABORTED OR NO FILENAME IS SET UP, END THINGS. &
	&
	&

9500	! DATA STATEMENTS: &
	! &
	! THIS IS THE DAYS IN THE MONTHS DATA. &
	&
	DATA 31,28,31,30,31,30,31,31,30,31,30,31 &
	&

10000	! THIS IS THE DISMOUNT ROUTINE. &
	! THIS ROUTINE IS CALLED AT ENTRY POINT 10000 WHEN  THE BACMNT &
 	! PROGRAM ITSELF IS CALLED TO DISMOUNT A DEVICE. ALTENATIVELY, &
	! THIS ROUTINE CAN BE ENTERED AT LINE 10030 FOR A PARTIAL &
	! DISMOUNT. THIS HAPPENS WHEN A MOUNT REQUEST WAS A FAILURE AND &
	! WE WISH TO GET THE OFFENDING VOLUME OFF OF THE DRIVE. &
	! THE VARIABLE G% CONTROLS THE ALTERNATIVE EXECUTION. &
	&
	ON ERROR GOTO 10055 &
	\ G%=-1% &
	\ P0%=Z0%(0%,B%*-2%+2%) &
	\ P0%=Z0%(P0%,1%) &
	     UNTIL (Z0%(P0%,31%) AND 1%) XOR (Z0%(P0%,30%) AND 1%) &
	\ GOTO 10051 UNLESS P0% &
	\ D$=FNU$(P0%,N$,4096%,0%) &
	\ OPEN D$ AS FILE 6% IF M% &
		! SET THE FULL OPERATIONS FLAG. &
		! &
		! FIND THE VR THAT WE WISH TO DISMOUNT. &
		! GET THE DEVICE AND UNIT NUMBER IN STRING FORM. &

10030	ON ERROR GOTO 10055 &
	\ Z%=MAGTAPE(1%,0%,6%) IF M% &
	\ CLOSE 6% &
	! SET THE REWIND ON CLOSE FOR MAGTAPE &
	! CLOSE THE CHANNEL &

10040	T$="DISMOUNT DEVICE:"+T9$+D$ &
	\ IF B% AND G%=-1% THEN &
	  T$=T$+C9$+T9$+I5$+T9$+RAD$(Z0%(P0%,9%))+RAD$(Z0%(P0%,10%))+C9$ &
	  \ T$=T$+T9$+S5$+T9$+NUM1$(Z0%(P0%,11%)) &
	  \ T$=T$+"(INDEX)" IF (Z0%(P0%,30%) AND 16384%) &
	  \ T$=T$+C9$ &
	  \ T$=T$+T9$+D5$+T9$+NUM1$(Z0%(P0%,19%) AND 16383%)+" BPI" &
			+C9$	IF M% &
	  \ T$=T$+T9$+P5$+T9$+P$((Z0%(P0%,19%) AND 16384%)/16384%) &
			+C9$	IF M% &
	  \ T$=T$+E5$+T9$+DATE$(Z0%(P0%,20%))+C9$ &
	  \ T$=T$+T9$+"PLEASE LABEL THIS VOLUME!"+C9$ &
		! CREATE THE TEXT STRING FOR THE MESSAGE. &
		! IF THIS IS A BACKUP AND IT IS A LEGIT DISMOUNT, THEN &
		! WE ALSO INCLUDE THE VITAL STATISTICS IN THE MESSAGE &
		! SO WE CAN LABEL THE VOLUME PROPERLY. &

10045	GOSUB 23100 &
	\ GOTO 10050 UNLESS G% &
	\ Z0%(0%,31%)=Z0%(0%,31%) XOR 1% &
	\ Z0%(P0%,30%)=Z0%(P0%,30%) OR 1% &
	\ Z0%(P0%,31%)=Z0%(P0%,31%) AND (NOT 2%) &
	\ Z0%(P0%,30%)=Z0%(P0%,30%) AND (NOT 2%) &
		! SEND THEN MESSAGE. &
		! SKIP OVER THE VOLUME RECORD ALTERATION IF WE ARE &
		! DISMOUNTING A BAD MOUNT. &
		! &
		! GET RID OF THE DISMOUNT REQUEST IN THE FHR. &
		! SET THE DISMOUNTED BIT IN THE VR. &
	&

10050	Z0%(P0%,7%)=0% &
	\ Z$=SYS(F0$+D$) &
	\ U8%=ASCII(MID(Z$,25%,1%)) &
	\ D$=MID(Z$,23%,2%) &
	\ Z$=SYS(F0$+D$) &
	\ Z0%(P0%,6%)=SWAP%(CVT$%(MID(Z$,7%,2%))) &
	\ Z$=SYS(C6$+CHR$(11%)+STRING$(20%,0%)+D$ &
			+CHR$(U8%)+B0$) &
	\ D$="_"+D$+":" &
		! GET THE EXPLICIT UNIT NUMBER OUT OF THE DEVICE &
		! NAME IN THE VR. &
		! DEASSIGN THE DEVICE AND RETURN. &

10051	ON ERROR GOTO 19000 &
	\ RETURN &
		! RESET ERROR TRAP AND RETURN. &

10055	E%=ERR &
	\ T$=RIGHT(SYS(E9$+CHR$(E%)),3%)+" ON DISMOUNT OF " &
					+D$ &
	\ RESUME 10060 &

10060	GOSUB 23100 &
	\ GOTO 10040 IF (E%=14%) OR (E%=39%) &
	\ GOTO 10000 IF G%=-1% &
	\ GOTO 10030 &
		! THIS IS THE ERROR TRAP FOR DISMOUNT ERRORS. &
	&

10200	! RESTORE MOUNT. &
	! THIS MOUNT IS USED TO MOUNT THE NEXT VOLUME FOR THE "BACFRM" &
	! TRANSFER PROGRAM. IT DOES, HOWEVER, HAVE A SPECIAL FUNCTION, &
	! THAT BEING, IF MOUNTS THE INDEX VOLUME WHEN A RESTORE FROM THE &
	! PRIMARY INDEX VOLUME IS REQUESTED. THE VARIABLE I% &
	! DISINGUISHES BETWEEN THE TWO CASES. &
	&
	I%=((Z0%(0%,31%) AND 4%) XOR (Z0%(0%,30%) AND 4%)) AND &
				(Z0%(0%,29%) AND 24%)<>0% &
	\ IF I% THEN S9$="INDEX" &
		\ P0%=Z0%(0%,2%) &
		\ D$=FNU$(P0%,N$,4096%,0%) &
		\ P8%=A% &
		\ B$=MID(Z0$(P0%),19%,6%) &
		\ GOTO 10240 IF (Z0%(0%,29%) AND 128%) &
		\ GOSUB 10600 &
		\ Z0%(P0%,9%)=SWAP%(CVT$%(B$)) &
		\ Z0%(P0%,10%)=SWAP%(CVT$%(RIGHT(B$,3%))) &
		\ Z0%(P0%,11%)=SWAP%(CVT$%(RIGHT(B$,5%))) &
		! SET THE INDEX MOUNT FLAG AS REQUIRED. &
		! WE MAY HAVE JUST READ A DISK LABEL, SO CHECK IT OUT. &
		! IF THIS IS AN INDEX MOUNT THEN &
		!	SET THE FLAG &
		!	SET THE VOLUME SEQUENCE TO "INDEX" &
		!	SET THE VOLUME RECORD POINTER. &
		!	GET THE DEVICE NAME. &
		!	SEE WHO IS SUPPOSED TO OWN THE BACKUP SET. &
		!	DO THE DIALOGUE TO GET THE BACKUP SET NAME, &
		!		THE DENSITY AND PARITY IF MAGTAPE. &

10220	GOTO 10290 IF (R% AND 1%) &
	\ IF I%=0% THEN &
		P0%=Z0%(0%,2%) &
		\ P0%=Z0%(P0%,1%) &
		    UNTIL (Z0%(P0%,31%) AND 2%) XOR (Z0%(P0%,30%) AND 2%) &
		\ D$=FNU$(P0%,N$,4096%,0%) &
		\ B$=RAD$(Z0%(P0%,9%))+RAD$(Z0%(P0%,10%)) &
		\ S9$=NUM1$(Z0%(P0%,11%)) &
		\ S9%=Z0%(P0%,11%) &
		\ D8%=Z0%(P0%,19%) &
		\ P8%=Z0%(P0%,8%) &
		! IF AN ABORT WAS REQUESTED IN THE ABOVE DIALOGUE, WE &
		! SHOULD RETURN RIGHT AWAY. &
		! IF THIS IS A NORMAL RESTORE MOUNT, WE GET ALL THE INFO &
		! OUT OF THE VOLUME RECORD TO BE MOUNTED. &

10230	IF (Z0%(0%,29%) AND 128%)=0% THEN &
	GOSUB 11000 &
	\ GOTO 10290 IF (R% AND 1%) &
	\ GOTO 10290 IF (Z0%(0%,29%) AND 128%) &
	\ IF E% THEN E%=0% &
		\ GOTO 10200 &
		! GOSUB TO THE MOUNT ROUTINE. &
		! EXIT ON ABORT, EXIT IF WE MUST READ A DISK LABEL. &
		! TRY AGAIN ON AN ERROR. &

10240	Z0%(0%,29%)=Z0%(0%,29%) AND (NOT 128%) &
	\ GOTO 10285 IF MID(L$,1%,12%)<>"BACKUP543210" &
	\ GOTO 10285 IF CVT$$(MID(L$,13%,6%),2%)<>LEFT(B$,6%) &
	\ GOTO 10285 IF CVT$%(MID(L$,23%,2%))<>P8% AND &
				(SWAP%(A%) AND 255%)<>1% &
	\ GOTO 10285 IF I%=0% AND CVT$%(MID(L$,25%,2%))<>S9% &
	\ GOTO 10285 IF I% AND M%=0% AND MID(L$,33%,2%)=CHR$(0%) &
	\ IF I% AND M% THEN &
		ON ERROR GOTO 10295 &
	\	FOR Z1%=1% TO 2% &
	\		Z%=MAGTAPE(4%,32767%,6%) &
	\		Z%=MAGTAPE(4%,32767%,6%) UNTIL &
				MAGTAPE(7%,0%,6%) AND 640% &
	\	NEXT Z1% &
		\ Z0%(0%,15%)=CVT$%(RIGHT(L$,25%)) &
		\ GET #6% \ FIELD #6%, RECOUNT AS L$ &
		\ GOTO 10285 IF CVT$%(MID(L$,RECOUNT-1%,2%))<>3% &
		\ Z%=MAGTAPE(4%,1%,6%) &
		! THIS IS NOT THE RIGHT VOLUME IF &
		! THE RECORD WE READ WAS NOT A BACKUP VOLUME. &
		! THE VOLUME IS NOT FROM THE RIGHT BACKUP SET. &
		! THE VOLUME DOES NOT BELONG TO THE USER AND HE'S NOT &
		!    PRIVILEGED. &
		! THIS IS SUPPOSED TO BE AN INDEX VOLUME AND IT ISN'T. &

10245	IF I% AND (M%=0%) THEN &
			Z0%(P0%,22%)=CVT$%(RIGHT(L$,31%)) &
			\ Z0%(0%,15%)=CVT$%(RIGHT(L$,25%)) &
			\ Z0%(P0%,23%)=CVT$%(RIGHT(L$,33%)) &
			\ Z0%(P0%,25%)=CVT$%(RIGHT(L$,35%)) &
			\ Z0%(P0%,24%)=CVT$%(RIGHT(L$,37%)) &
		! PUT INDEX FILE INFO INTO VR FOR DISK. &

10250	GOSUB 10460 &
	\ Z0%(0%,27%)=P0% &
	\ Z0%(0%,31%)=Z0%(0%,31%) XOR 2% &
	\ Z0%(P0%,30%)=2% &
	\ Z0%(P0%,31%)=Z0%(P0%,31%) OR 1% &
	\ Z0%(P0%,17%)=B1% &
	\ GOTO 10290 &
		! PUT THE BACKUP VOLUME POINTER INTO THE FHR. &
		! SET THE MOUNT COMPLETED BIT IN THE VOLUME RECORD. &
		! SET THE DISMOUNT BITS HERE. &

10285	T$="?THIS IS NOT THE RIGHT VOLUME" &
	\ G%=0% &
	\ GOSUB 23100 &
	\ GOSUB 10030 &
	\ GOTO 10200 &
		! NOT THE RIGHT ONE, SO TRY AGAIN. &

10290	RETURN &

10295	RESUME 10285 IF ERR=4% &
	\ E%=ERR &
	\ G%=0% &
	\ RESUME 10297 &

10297	T$=RIGHT(SYS(E9$+CHR$(E%)),3%) &
	\ GOSUB 23100 &
	\ GOSUB 10030 &
	\ GOTO 10200 &

10300	E%=0% &
	\ Z%=FNP9%(D8%,6%) &
	\ IF Z%=0% THEN &
		T$="?DENSITY/PARITY SETTING CAN NOT BE SET" &
				+" ON THIS DRIVE" UNLESS E% &
	\		T%=-1% &
	\		GOTO 10345 &
		! &
		! &
		!	R E A D    A    R E C O R D    F R O M &
		!		A    M A G T A P E &
		!	( L O O K I N G    F O R    A    L A B E L ) &
		! &
		! &
		! SET THE DESIRED DENSITY TO SEE IF ITS LEGAL. IF NOT &
		! SEND A MESSAGE,GET OUT. &

10310	T%=2% &
	\ T%=3% IF (S8% AND 16%) &
	\ S%=S%+1% \ S%(S%)=700% &
	\ ON ERROR GOTO 10345 &
	\ Z%=MAGTAPE(3%,0%,6%) &
		! T% IS THE NUMBER OF VALID DENSITY/PARITY SETTINGS &
		! THERE ARE FOR THIS DRIVE (I.E. 3 FOR TU16, 2 FOR OTHER) &
		! WE MUST STACK A DUMMY SETTING TO KEEP TRACK OF OUR &
		! ATTEMPTS TO READ AT DIFFERENT SETTINGS. &
		! MAKE SURE THAT TAPE IS REWOUND FOR FIRST READ ATTEMPT. &

10320	Z%=FNP9%(D8%,6%) &
	\ GOTO 10345 IF E% &
	\ ON ERROR GOTO 10345 &
	\ T%=T%-1% &
	\ FOR Z1%=1% TO 6% &
		\ GET #6% &
		\ GOTO 10330 &
		! SET A TEMPORARY ERROR TRAP, &
		! DECREMENT THE SETTINGS COUNTER, AND TRY TO READ ONE OF &
		! THE SIX LABELS. &

10325	NEXT Z1% &
	\ IF T%=0% THEN C$=N$ &
			\ T$="%THIS TAPE IS UNREADABLE!" &
			\ T$=T$+" MOUNT IT ANYWAY<NO> ? " IF B% &
			\ R1%=1%+1024% IF B% &
			\ GOSUB 23100 \ GOSUB 23200 &
			\ E%=13% UNLESS FNR%("Y",1%) &
			\ GOTO 10340 &
		! TRY THE NEXT LABEL. IF WE'VE TRIED ALL SIX, AND THERE &
		! ARE NO MORE SETTINGS, ITS BAD. &

10327	Z%=MAGTAPE(3%,0%,6%) &
	\ S%=S%+1%\S%(S%)=D8% AND 16383% &
	\ D8%=800% IF D8%=1600% &
	\ GOTO 10320 IF S%(S%)<>(D8% AND 16383%) &
	\ D8%=D8% XOR 16384% IF S%(S%)<>S%(S%-1%) &
	\ D8%=1600% IF S%(S%)=S%(S%-1%) &
	\ GOTO 10320 &
		! TRY ANOTHER SETTING AFTER REWINDING THE TAPE. &

10330	S8%=MAGTAPE(7%,0%,6%) &
	\ Z%=(S8% AND 2048%)*8% &
	\ Z%=Z%+800%+800%*((S8% AND 8%)/8%) &
	\ IF ((B% OR (B%=0% AND I%)) AND Z%<>S2%) OR &
		(B%=0% AND I%=0% AND Z%<>Z0%(P0%,19%)) &
		THEN &
		T$="DENSITY CHANGED TO"+NUM$(Z% AND 16383%)+ &
			", PARITY CHANGED TO "+P$((Z% AND 16384%)/16384%) &
	\	T$="ATTEMPTING TO READ LABEL AT DENSITY"+NUM$(Z% AND 16383%)+ &
			", PARITY "+P$((Z% AND 16384%)/16384%)+"."+C9$+ &
			"(TRANSFER WILL BE PERFORMED AT SETTINGS REQUESTED.)" &
			IF B% &
		\ T$=T$+", FOR TRANSFER" UNLESS B% &
		\ T$=T$+" OF INDEX." IF B%=0% AND I% &
		\ Z0%(P0%,19%)=Z% UNLESS B% OR (Z0%(0%,29%) AND 4%) &
		\ GOSUB 23100 &
		! IF THE DENSITY/PARITY WAS CHANGED, INFORM THE USER &
		! DEPENDING UPON WHICH OF THREE CASES THIS IS: &
		!	A BACKUP MOUNT &
		!	A STANDARD RESTORE MOUNT &
		!	AN INDEX VOLUME RESTORE MOUNT &

10340	ON ERROR GOTO 19000 &
	\ S%=S%-1%-((1%-((S8% AND 16%)<>0%))-T%) UNLESS T%=-1% &
	\ RETURN &
		! RESET THE ERROR TRAP. &
		! CLEAN UP THE STACK. &
		! RETURN. &

10345	RESUME 10330 IF ERR=11% &
	\ RESUME 10325 IF ERL=10320% &
	\ E%=ERR IF ERL=10310% OR ERL=10327% OR ERL=10330% &
	\ T$=RIGHT(SYS(E9$+CHR$(E%)),3%)+" - "+D$ IF E% &
	\ GOSUB 23100 &
	\ E%=13% &
	\ RESUME 10340 &
		! THIS IS THE READ ERROR HANDLER. &
	&

10400	! BACKUP MOUNT. &
	! THIS ROUTINE IS USED TO MOUNT THE NEXT VOLUME FOR THE "BACKTO" &
	! TRANSFER PROGRAM. A SPECIAL CASE ARISES WHEN THAT VOLUME &
	! HAPPENS TO BE THE FIRST VOLUME. IN THIS CASE WE MUST DO A &
	! DIALOGUE WITH THE USER TO GET THE NECESSARY INFO TO &
	! CREATE THE VOLUME RECORDS. I% IS USED AS THE FLAG. &
	&
	GOTO 10420 IF (Z0%(0%,29%) AND 384%) &
	\ I%=0% &
	\ P0%=Z0%(0%,4%) &
	\ IF Z0%(P0%,11%)=0% THEN &
		I%=-1% &
		\ S9%=1% \ S9$=NUM1$(S9%) &
		\ Z$=SYS(PRIV.ON$) &
		\ C8%=PEEK(512%) &
		\ Z$=SYS(PRIV.OFF$) &
		\ P8%=A% &
		\ B1%,B2%=0% &
		\ T8%=Z0%(P0%,13%) &
		\ T9%=Z0%(P0%,14%) &
		\ D$=FNU$(P0%,N$,4096%,0%) &
		\ GOSUB 10600 &
		! IF WE JUST READ A DISK LABEL, GO CHECK IT OUT. &
		! INITIALIZE THE FIRST TIME FLAG. &
		! POINT P0% TO THE OUTPUT VOLUME LIST. &
		! IF THERE IS NO SEQUENCE NUMBER IN THE FIRST VOLUME &
		! THEN THIS IS THE FIRST TIME. WE MUST: &
		!	SET THE FLAG, SEQUENCE NUMBER IS NOW 1, &
		! 	CREATED TODAY, BELONGS TO THE CURRENT USER, &
		!	CURRENT UFD IS N/A, BLOCKSIZE AND &
		!	CLUSTERSIZE ARE NOT YET DETERMINED, DO THE &
		!	DIALOGUE TO GET THE BACKUP SET NAME, EXPIRATION, &
		!	AND DENSITY/PARITY SETTINGS IF MAGTAPE. &

10420	GOTO 10490 IF (R% AND 1%) &
	\ IF I%=0% THEN Z%=0% &
		\ P0%=Z0%(P0%,1%) WHILE Z0%(P0%,1%) &
		\ GOTO 10430 UNLESS G% &
		\ S9%=Z0%(P0%,11%)+(-1%*((Z0%(0%,29%) AND 384%)=0%)) &
		\ S9$=NUM1$(S9%) &
		\ B1%=Z0%(P0%,17%) &
		\ B2%=Z0%(P0%,18%) &
		\ D8%=Z0%(P0%,19%) &
		\ D9%=Z0%(P0%,20%) &
		\ C8%=Z0%(P0%,21%) &
		\ P8%=Z0%(P0%,8%) &
		\ T8%=Z0%(P0%,13%) &
		\ T9%=Z0%(P0%,14%) &
		\ D$=FNU$(P0%,N$,4096%,0%) &
		\ B$=RAD$(Z0%(P0%,9%))+RAD$(Z0%(P0%,10%)) &
		\ GOTO 10440 IF (Z0%(0%,29%) AND 384%) &
		\ P0%,Z0%(P0%,1%)=FNA% &
		\ Z0%(P0%,13%)=T8% &
		\ Z0%(P0%,14%)=T9% &
		! IF THIS IS NOT THE FIRST VOLUME THEN WE GET OUT INFO &
		! OUT OF THE LATEST VOLUME. &

10430	G%=-1% &
	\ GOSUB 11000 &
	\ GOTO 10490 IF (R% AND 1%) &
	\ G%=-1% IF S1% &
	\ GOTO 10460 IF S1% &
	\ GOTO 10460 IF (Z0%(0%,29%) AND 128%) &
	\ IF E% THEN E%=0% &
			\ GOTO 10400 &
		! GOSUB TO THE MOUNT ROUTINE. &
		! EXIT ON ABORT, EXIT IF WE NEED TO READ A DISK LABEL. &
		! TRY AGAIN ON ERROR. &

10440	B9%,Z0%(0%,29%)=Z0%(0%,29%) AND (NOT 384%) &
	\ IF LEFT(L$,12%)="BACKUP543210" THEN GOSUB 10500 &
				ELSE GOSUB 10550 UNLESS L$="BAD DISK" &
		! SEE IF THE RECORD WE READ IS A "BACKUP" LABEL. &
		! IF SO, GOTO 10500 TO SEE IF WE CAN USE THIS VOLUME. &
		! IF NOT, GOTO 10550 TO SEE IF WE CAN USE THIS VOLUME. &

10450	G%=0% IF L$="BAD DISK" &
	\ GOTO 10490 IF (R% AND 1%) &
	\ T$=N$ &
	\ T$="?TOO MANY BAD CLUSTERS - "+D$ IF B9%=4096% &
	\ T$="?CAN'T WRITE LABELS - "+D$ IF B9%=8192% &
	\ T$="?Device hung or write locked - "+D$ IF B9%=16384% &
	\ GOSUB 23100 &
	\ B9%,Z0%(0%,29%)=0% &
	\ IF G%=0% THEN GOSUB 10030 &
			\ Z0%(P0%,11%)=0% IF Z0%(P0%,11%)=1% &
			\ GOTO 10400 &
		! IF ABORT WAS REQUESTED, GET OUT. &
		! IF THIS VOLUME COULD NOT BE LABELED, DISMOUNT IT AND &
		! TRY AGAIN. &

10460	IF I% OR (B%=0%) THEN &
		B1%=4096% &
	\	B1%=B1%+4% IF M% &
	\	RETURN UNLESS B% &
		! IF THIS IS THE FIRST TIME THROUGH, WE MUST CALCULATE &
		! THE BLOCKSIZE AND CLUSTERSIZE. &
		! THIS IS A SUBROUTINE TO DO THE SAME THING FOR A &
		! RESTORE. &

10470	GOSUB 10800 IF M%=14% &
	\ GOTO 10450 UNLESS G% &
	\ Z0%(P0%,8%)=P8% &
	\ Z$=SYS(F0$+B$) &
	\ Z0%(P0%,9%)=SWAP%(CVT$%(MID(Z$,7%,2%))) &
	\ Z0%(P0%,10%)=SWAP%(CVT$%(MID(Z$,9%,2%))) &
	\ Z0%(P0%,11%)=S9% &
	\ Z0%(P0%,17%)=B1% &
	\ Z0%(P0%,18%)=B2% &
	\ Z0%(P0%,19%)=D8% IF M% &
	\ Z0%(P0%,20%)=D9% &
	\ Z0%(P0%,21%)=C8% &
	\ Z0%(P0%,22%)=0% &
	\ Z0%(P0%,22%)=CVT$%(MID(L$,31%,2%)) IF (M%=0%) AND G1% &
	\ Z0%(P0%,27%)=Z0%(0%,2%) &
	\ Z0%(0%,27%)=P0% &
	\ Z0%(0%,31%)=Z0%(0%,31%) XOR 2% UNLESS (Z0%(0%,29%) AND 128%) &
	\ Z0%(P0%,Z%)=2% &
			FOR Z%=30% TO 31% &
	\ Z0%(P0%,31%)=Z0%(P0%,31%) OR 1% &
		! WRITE THE LABELS IF THIS IS MAGTAPE. &
		! IF THE LABELS COULD NOT BE WRITEN, GO BACK AND TRY &
		! AGAIN. &
		! WE THEN BUILD THE RECORD AND PLACE THE RECORD NUMBER &
		! INTO WORD 27 OF THE FHR (THIS IS SO THE TRANSFER &
		! PROGRAM KNOWS WHAT TO OPEN). &
		! SET THE MOUNT COMPLETED BIT. &
		! SET THE DISMOUNT REQUIRED BIT. &
	&
	\ IF (M%=0%) AND (Z0%(0%,29%)=0%) THEN P1%=FNA% &
			\ Z0%(P1%,1%)=Z0%(0%,13%) &
			\ Z0%(0%,13%)=P1% &
			\ Z0%(P1%,6%)=D5% &
			\ Z0%(P1%,8%)=A5% &
			\ Z0%(P1%,9%)=3243% &
			\ Z0%(P1%,10%)=7171% &
			\ Z0%(P1%,13%)=1% &
			\ Z0%(P1%,14%)=12417% &
		! SET UP CHAIN TO BACDSK. &

10490	RETURN &
	&

10500	G%=-1% &
	\ Z$=SYS(PRIV.ON$) &
	\ Z%=PEEK(512%) &
	\ Z$=SYS(PRIV.OFF$) &
	\ IF CVT$%(MID(L$,19%,2%))<Z% THEN GOTO 10540 &
	  ELSE IF (SWAP%(A%) AND 255%)=1% OR A%=CVT$%(MID(L$,23%,2%)) &
			THEN T$="%EXPIRATION DATE HAS NOT YET ARRIVED!"+C9$ &
				+T9$+I5$+T9$+MID(L$,13%,6%)+C9$ &
				+T9$+S5$+T9$+NUM1$(CVT$%(MID(L$,25%,2%)))+C9$ &
			\ Z%=CVT$%(MID(L$,27%,2%)) &
			\ T$=T$+T9$+D5$+T9$+NUM1$(Z% AND 16383%)+" BPI"+C9$ &
				+T9$+P5$+T9$+P$((Z% AND 16384%)/16384%)+C9$ &
			     IF M% &
			\ T$=T$+E5$+T9$+DATE$(CVT$%(MID(L$,19%,2%)))+C9$ &
				+"MOUNT IT ANYWAY<NO>?" &
			\ R1%=1%+1024% &
			\ GOSUB 23100 \ GOSUB 23200 &
			\ P%=0% &
			\ G%=0% UNLESS FNR%("YES",1%) &
			\ GOTO 10540 &
		! &
		! &
		!	S H O U L D    W E    L A B E L    A &
		!		B A C K U P    V O L U M E ? &
		! &
		! &
		! SET THE 'GO' FLAG UNTIL WE GET A 'NO GO'. &
		! IF THE EXPIRATION DATE HAS PASSED, WE CAN LABEL IT. &
		! IF NOT, AND THE USER EITHER IS PRIVILEGED OF OWNS THE &
		! VOLUME, HE CAN LABEL IT WITH CONFIRMATION. &

10510	T$="?YOU ARE NOT PRIVILEGED TO USE THIS VOLUME!" &
	\ GOSUB 23100 &
	\ G%=0% &
		! THE EXPIRATION DATE HAS NOT PASSED AND THE USER IS &
		! NEITHER PRIVILEGED NOR DIES HE OWN THE VOLUME. HE &
		! GET A MESSAGE AND ANOTHER TRY IF HE LIKES. &

10540	G1%=-1% IF G% &
	\ RETURN &
	&

10550	G%=-1% &
	\ GOTO 10580 UNLESS M% OR (SWAP%(A%) AND 255%)=1% &
	\ GOTO 10570 IF M% &
	\ Z$=RAD$(SWAP%(CVT$%(RIGHT(L$,13%))))+ &
		RAD$(SWAP%(CVT$%(RIGHT(L$,15%)))) &
	\ Z2$=MID(L$,13%,4%) &
	\ CLOSE 6% &
	\ ON ERROR GOTO 10595 &
	\ Z3$=SYS(F0$+D$) &
	\ Z3$=MID(Z3$,23%,2%)+CHR$(U8%)+B0$ &
	\ Z1$=SYS(C6$+CHR$(11%)+STRING$(20%,0%)+Z3$) &
	\ Z1$=SYS(C6$+CHR$(3%)+STRING$(4%,0%)+Z2$+ &
		STRING$(12%,0%)+Z3$) &
	\ OPEN D$+"[0,1]BADB.SYS" AS FILE 6% &
	\ CLOSE 6% &
	\ Z1$=SYS(C6$+CHR$(3%)+CHR$(2%)+STRING$(19%,0%)+Z3$) &
	\ Z1$=SYS(C6$+CHR$(10%)+STRING$(20%,0%)+Z3$) &
		! &
		! &
		!	S H O U L D    W E    A L L O W    A &
		!	 N O N - B A C K U P    V O L U M E &
		!	 T O    B E    L A B E L L E D ? &
		! &
		! &
		! SET THE 'GO' FLAG UNTIL WE GET A 'NO GO'. &
		! IF THIS IS A DISK AND THE USER IS NOT PRIVILEGED, &
		! 'NO GO'. IF THIS IS A MAGTAPE WE CAN LABEL IT WITH &
		! CONFIRMATION. IF THIS IS A RSTS DISK, A PRIVILEGED &
		! USER CAN LABEL IT. &

10570	T$="%THIS VOLUME HAS NO BACKUP LABEL!"+C9$ &
	\ T$=T$+"PACK-ID IS - "+Z$+C9$ UNLESS M% &
	\ T$=T$+"MOUNT IT ANYWAY<NO> ? " &
	\ R1%=1%+1024% &
	\ GOSUB 23100 \ GOSUB 23200 &
	\ P%=0% &
	\ G%=0% UNLESS FNR%("YES",1%) &
	\ GOTO 10590 &
		! GET CONFIRMATION BEFORE GOING AHEAD AND LABELING. &

10580	T$="?DISK MUST BE DSKINTED" &
	\ T$="?DISK MUST BE INITIALIZED" IF (SWAP%(A%) AND 255%)<>1% &
	\ T$=CVT$$(RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(ERR)),3%),4%) IF ERR<>10% &
	\ T$="?DISK MUST BE DISMOUNTED" IF ERR=18% &
	\ GOSUB 23100 &
	\ G%=0% &
		! DISK CAN'T BE LABELED. &

10590	ON ERROR GOTO 19000 &
	\ RETURN &

10595	RESUME 10580 &
	&

10600	B$=MID(W$,INSTR(1%,W$,".")-6%,6%) &
	\ T$="PLEASE ENTER BACKUP SET NAME<"+B$+"> - " &
	\ R1%=1%+1024% &
	\ GOSUB 23100 \ GOSUB 23200 &
	\ GOTO 10690 IF (R% AND 1%) &
	\ B$=C$ IF LEN(C$) &
	\ B$=LEFT(CVT$$(B$,254%)+SPACE$(6%),6%) &
	\ ON ERROR GOTO 10695 &
	\ Z$=SYS(F0$+C$) &
	\ GOTO 10695 IF SWAP%(CVT$%(MID(Z$,29%,2%))) AND 13466% &
	\ ON ERROR GOTO 19000 &
		! &
		! &
		!	D I A L O G U E    R O U T I N E &
		! &
		! &
		! THIS QUESTION GETS ASKED WHEN WE ARE RESTORING FROM &
		! PRIMARY AND ALSO BEFORE THE FIRST MOUNT ON A BACKUP. &
		! THE DEFAULT NAME IS THE NAME OF THE WORK FILE. &

10620	IF B% THEN &
		Z$=SYS(PRIV.ON$) &
	\	D9%=PEEK(512%)+1000% &
	\	Z$=SYS(PRIV.OFF$) &
	\	T$="PLEASE ENTER EXPIRATION DATE<"+DATE$(D9%)+"> - " &
	\	R1%=1%+1024% &
	\	GOSUB 23100 \ GOSUB 23200 &
	\	GOTO 10690 IF (R% AND 1%) &
	\	GOTO 10630 UNLESS LEN(C$) &
	\	T6%=FNA% \ P%=0% &
	\	Z0%=D9%-1000% &
	\	D9%=FND%(T6%,0%,21%,21%) \ Z%=FNA0%(T6%) &
	\	IF D9%<Z0% THEN &
			T$="?INVALID DATE" &
	\		GOSUB 23100 &
	\		E%=0% &
	\		GOTO 10620 &
		! IF THIS IS A BACKUP, WE NEED AN EXPIRATION DATE. &
		! THE DEFAULT IS 1 YEAR FROM NOW. IF THE DATE SPECIFIED &
		! WAS BEFORE TODAY, ITS INVALID. TRY AGAIN. &

10630	IF M% THEN &
		T$="PLEASE ENTER DENSITY IN BPI<800> - " &
	\	R1%=1%+1024% &
	\	GOSUB 23100 \ GOSUB 23200 &
	\	GOTO 10690 IF (R% AND 1%) &
	\	C$=D2$(0%) UNLESS LEN(C$) &
	\	Z%=0% &
	\	Z%=Z%+1% WHILE Z%<2% AND C$<>D2$(Z%) &
	\	IF Z%=2% THEN &
			T$="?INVALID DENSITY SETTING" &
	\		GOSUB 23100 &
	\		GOTO 10630 &
		! TRY FOR THE DENSITY SETTING IF THIS IS MAGTAPE. &

10640	IF M% THEN P%=0% \ D8%=FNN% &
		! PUT THE DENSITY SETTING IN D8% &

10650	IF M% AND D8%<>1600% THEN &
		T$="PLEASE ENTER THE PARITY<ODD> - " &
	\	R1%=1%+1024% &
	\	GOSUB 23100 \ GOSUB 23200 &
	\	GOTO 10690 IF (R% AND 1%) &
	\	C$=P$(0%) UNLESS LEN(C$) &
	\	Z%=0% &
	\	Z%=Z%+1% WHILE Z%<2% AND C$<>P$(Z%) &
	\	IF Z%=2% THEN &
			T$="?INVALID PARITY SETTING" &
	\		GOSUB 23100 &
	\		GOTO 10650 &
		! TRY TO GET THE DENSITY SETTING, DEFAULT IS "ODD". &

10660	D8%=D8% OR ((C$="EVEN") AND 16384%) IF M% &
		! THE 16384 BIT OF D8% HOLDS THE PARITY SETTING. &

10690	RETURN &

10695	T$="?INVALID BACKUP SET NAME" &
	\ GOSUB 23100 &
	\ RESUME 10600 &
		! INVALID CHARACTERS IN BACKUP SET NAME. &
	&

10800	G%=-1% &
	\ ON ERROR GOTO 10860 &
	\ Z%=MAGTAPE(3%,0%,6%) &
	\ FIELD #6%,84% AS L$ &
	\ LSET L$="BACKUP543210"+B$+CVT%$(D9%)+ &
		CVT%$(C8%)+CVT%$(P8%)+CVT%$(S9%)+ &
		CVT%$(D8%)+STRING$(10%,0%)+CVT%$(-1%) &
	\ LSET L$=LEFT(L$,40%)+LEFT(L$,40%)+CVT%$(-1%) &
		! &
		! &
		!	L A B E L    A    T A P E &
		! &
		! &
		! SET THE 'GO' FLAG UNTIL WE GET A 'NO GO'. &
		! REWIND THE MAGTAPE, OPEN IT AGAIN WITH A RECORDSIZE OF &
		! 84, AND SET UP THE BODY OF THE LABEL IN THE BUFFER. &
	&
	\ E%=0% &
	\ Z%=FNP9%(D8%,6%) &
	\ GOTO 10861 IF E% &
	\ IF Z%=0% THEN G%=0% &
			\ T$="?DENSITY/PARITY SETTING CAN NOT BE SET" &
			+" ON THIS DRIVE" &
			\ GOSUB 23100 &
			\ GOTO 10850 &
		! SET THE PARITY AND DENSITY. &
		! IF ITS ILLEGAL, SAY SO AND SCOOT. &

10830	ON ERROR GOTO 10860 &
	\ FOR Z%=1% TO 6% &
		\ LSET L$=LEFT(L$,80%)+CVT%$(Z%)+CVT%$(1%) &
		\ PUT #6%, COUNT 84% &
	\ NEXT Z% &
	\ Z%=MAGTAPE(2%,0%,6%) FOR Z1%=1% TO 3% &
	\ Z%=MAGTAPE(5%,1%,6%) FOR Z1%=1% TO 2% &
		! TRAP ERRORS IN WRITING AT 10860. &
		! WRITE OUT 6 LABELS, AND 3 EOF MARKS. &
		! WE THEN BCKSPACE OVER TWO OF THEM. &

10850	ON ERROR GOTO 19000 &
	\ RETURN &
		! RESET THE ERROR TRAP AND RETURN. &

10860	E%=ERR &
	\ RESUME 10861 &

10861	G%=0% &
	\ T$=RIGHT(SYS(E9$+CHR$(ERR)),3%)+" - "+D$ &
	\ T$=T$+" - ?UNABLE TO WRITE ON THIS TAPE" IF ERL=10830% &
	\ GOSUB 23100 &
	\ GOTO 10850 &
		! ERROR IN WRITING THE LABELS. &
	&

11000	S1%,E%=0% &
	\ T$="MOUNT    DEVICE:"+T9$+D$+C9$ &
	\ T$=T$+T9$+I5$+T9$+B$+C9$ &
	\ T$=T$+T9$+S5$+T9$+S9$+C9$ &
	\ T$=T$+T9$+D5$+T9$+NUM1$(D8% AND 16383%)+" BPI"+C9$ &
				IF M% &
	\ T$=T$+T9$+P5$+T9$+P$((D8% AND 16384%)/16384%)+C9$ &
				IF M% &
	\ T$=T$+T9$+"IDENTIFICATION WILL BE FINAL UPON SUCCESSFUL MOUNT" &
				+C9$   IF B% &
	\ T$=T$+T9$+"PLEASE MOUNT VOLUME WRITE LOCKED!"+C9$ IF (B%=0%) &
					AND M% &
	\ T$=T$+"DEVICE? " &
	\ R1%=1%+1024% &
	\ GOSUB 23100 \ GOSUB 23200 &
	\ IF (R% AND 1%) THEN GOTO 11090 &
		! &
		! &
		!	S T A N D A R D    M O U N T    R O U T I N E &
		! &
		! &
	&
		! SET UP THE MOUNT MESSAGE, SEND IT, AND GET A RESPONSE. &
		! IF ABORT IS DESIRED, RETURN IMMEDIATELY. &

11020	ON ERROR GOTO 11095 &
	\ Z$=MID(SYS(F0$+D$),23%,2%) &
	\ CHANGE SYS(F0$+LEFT(C$,INSTR(1%,C$,":"))) TO Z% &
	\ IF SWAP%(Z%(30%))<0% OR Z%(26%)=0% OR (STATUS AND 255%)<>M% &
		OR ((Z$<>CHR$(Z%(23%))+CHR$(Z%(24%))) AND M%=0%) THEN &
			T$="?INVALID DEVICE OR NO UNIT NUMBER" &
			\ GOSUB 23100 &
			\ GOTO 11000 &
			! SEE IF THE DEVICE SPECIFICATION IS VALID. &
			! IF NOT, SEND A MESSAGE AND RETURN. &

11025	P%=INSTR(1%,C$,"/") &
	\ IF P% THEN C$=RIGHT(C$,P%+1%) &
		\ P%=0% &
		\ Z%=FNR%("SCRATCH",3%) &
		\ T$=N$ &
		\ T$="?INVALID SWITCH SPECIFICATION" IF Z%=0% OR &
			P%<LEN(C$) &
		\ T$="?ILLEGAL SWITCH USAGE" IF B%=0% OR M%=0% OR &
			SWAP%(A% AND -256%)>1% &
		\ S1%=-1% UNLESS LEN(T$) &
		\ IF LEN(T$) THEN GOSUB 23100 &
			\ GOTO 11000 &
		! SEE IF VALID SWITCH IS PRESENT &
		! IT IS ILLEGAL IF: &
		!	THIS IS A RESTORE &
		!	DEVICE IS NOT MAGTAPE &
		!	USER IS NOT PRIVELEDGED &

11030	Z1$=CHR$(Z%(23%))+CHR$(Z%(24%)) &
	\ D$="_"+Z1$+NUM1$(Z%(25%))+":" &
	\ Z$=SYS(F0$+LEFT(D$,INSTR(1%,D$,":")-1%)) &
	\ Z0%(P0%,6%)=SWAP%(CVT$%(MID(Z$,7%,2%))) &
	\ Z0%(P0%,7%)=0% &
	\ U8%=Z%(25%) &
	\ ON ERROR GOTO 11095 &
	\ Z$=SYS(C6$+CHR$(10%)+STRING$(20%,0%)+Z1$ &
			+CHR$(U8%)+B0$) &
	\ OPEN D$ AS FILE 6%, RECORDSIZE 516% IF M% &
	\ ON ERROR GOTO 19000 &
	\ IF M% THEN &
		ON ERROR GOTO 11095 &
		\ S8%=(MAGTAPE(7%,0%,6%) AND 1024%) &
		\ ON ERROR GOTO 19000 &
		\ IF (B% AND S8%) OR (B%=0% AND S8%=0%) THEN &
			G%=0% &
			\ T$="?MAGTAPE NOT WRITE LOCKED" UNLESS B% &
			\ T$="?MAGTAPE WRITE LOCKED" IF B% &
			\ GOSUB 23100 &
			\ GOSUB 10030 &
			\ GOTO 11000 &
		! PUT THE DEVICE NAME INTO D$ AND THE VR. &
		! ASSIGN THE DEVICE, OPEN IT NON-FILESTRUCTURED, &
		! IF MAGTAPE. &
		! CHECK MAGTAPE LOCK STATUS - IF BACKUP AND NOT LOCKED &
		! OR RESTORE AND LOCKED CONTINUE, OTHERWISE SEND MESSAGE &
		! DISMOUNT AND TRY AGAIN. &

11040	GOTO 11090 IF S1% &
	\ S2%=D8% &
	\ GOSUB 10300 IF M% &
	\ Z0%(0%,29%)=Z0%(0%,29%) OR 128% UNLESS M% &
	\ D8%=S2% IF B% &
	\ IF E%=13% THEN G%=0% &
		\ GOSUB 10030 &
		\ GOTO 11090 &
		! RETURN IF SCRATCH IS SPECIFIED &
		! SAVE THE DENSITY/PARITY &
		! GO READ THE LABEL IF MAGTAPE, SET BACLAB FLAG IF DISK. &
		! IF THIS IS A BACKUP, RESTORE THE DENSITY/PARITY &
		! IF VOLUME UNREADABLE, DISMOUNT IT AND RETURN. &

11050	FIELD #6%,RECOUNT AS L$ UNLESS (Z0%(0%,29%) AND 128%) &
		! OVERLAY L$ ON WHATEVER WE GOT, IF MAGTAPE. &

11090	RETURN &

11095	 RESUME 11000 IF ERL=11020% &
	\ E%=ERR &
	\ RESUME 11096 &

11096	T$=RIGHT(SYS(E9$+CHR$(E%)),3%)+" - "+D$ &
	\ GOSUB 23100 &
	\ E%=0% &
	\ D$="_"+CHR$(Z%(23%))+CHR$(Z%(24%))+":" &
	\ RESUME 11000 &
		! TRAP FOR ERRORS ON OPEN GET AN AUTO-RETRY. &
	&

15100	DEF* FNN% &
	\ FNN%,E%,F%=0% &
	! FUNCTION:	RETURN A NUMBER ROUTINE. &
	! PARAMETERS:	NONE &
	! GLOBAL &
	! VARIABLES &
	! AFFECTED:	P%	CHARACTERS POSITION POINTER. &
	!		F%	FOUND FLAG. &
	! LOCAL &
	! VARIABLES &
	! USED:		Z%	TEMPORARY POSITION POINTER. &
	!		Z0%	ASCII CHARACTER REPRESENTATION. &
	! RETURNS:	VALUE OF NUMERIC DIGITS FOLLOWING POSITION P% &
	!		IN THE STRING C$. IF NONE ARE FOUND THE FOUND FLAG &
	!		IS RETURNED AS ZERO. &
	! ERRORS:	NONE EXPECTED. &

15110	ON ERROR GOTO 15160 &
	\ Z%=P%-1% &
	\ Z0%=-1% &
		! SET LOCAL ERROR HANDLER. &
		! SET LOCAL CHARACTER POINTER. &
		! INITIALIZE ASCII DIGIT FLAG. &
	&
	\ WHILE (Z0%>=48% AND Z0%<=57%) OR Z0%=-1% &
		\ Z%=Z%+1% &
		\ Z0%=ASCII(RIGHT(C$,Z%+1%)) &
	\ NEXT &
		! CHECK FOR DIGITS, AND EXIT HERE WITH Z%=P% OR Z% &
		! POINTING TO THE LAST DIGIT FOUND. &
	&
	\ IF Z%<>P% THEN FNN%=VAL(MID(C$,P%+1%,Z%-P%)) &
				\ P%=Z% &
				\ F%=-1% &
		! WE HAVE FOUND A NUMBER. SET THE FUNCTION VALUE TO &
		! THE VALUE OF THE NUMBER FOUND AND SET THE FOUND FLAG. &

15150	ON ERROR GOTO 19000 &
	\ FNEND &
		! RESET THE ERROR HANDLER. &
		! RETURN. &

15160	E%=512%+52% &
	\ FNN%=0% &
	\ RESUME 15150 &
		! ERROR IN THE VAL FUNCTION IS TRAPPED HERE. &

15200	DEF* FND%(P1%,T%,M1%,M2%) &
	\ F%,FND%=0% &
	! FUNCTION:	GET A DATE AND, OPTIONALLY, A TIME. &
	! PARAMETERS:	P1%	WORK FILE RECORD TO PLACE THE TIME OR DATE &
	!		IN. &
	!		T%	LOOK FOR TIME FLAG. IF <>0%, LOOK FOR TIME &
	! 		M1%	WORD IN WORK-FILE RECORD INTO WHICH THE &
	!			DATE WILL BE PLACED. &
	!		M2%	WORD IN WORK-FILE INTO WHICH THE TIME &
	!			WILL BE PLACED. &
	! GLOBAL &
	! VARIABLES &
	! AFFECTED:	Z0%()	WORK-FILE. &
	!		P%	POSITION POINTER. &
	!		F%	FOUND FLAG. &
	!		S%,S%()	STACK POINTER,STACK. &
	!		D1%(0%)	DAYS IN MONTH SPECIFIED. &
	!		D1%()	DAYS IN MONTH TABLE. &
	!		D1$	MONTHS DECODE STRING. &
	! LOCAL &
	! VARIABLES &
	! USED:		Z2%	DATE WORD ACCUMULATOR. &
	!		Z1%,Z3%	UTILITY VARIABLES. &
	!		Z$	TO TURN PRIV'S ON AND OFF. &
	! RETURNS:	FOUND FLAG SET IF DATE IS FOUND. &
	!		DATE RETURNED AS FUNCTION VALUE. &
	!		WORK-FILE UPDATED WITH DATE AND TIME WORDS. &
	! ERRORS:	ILLEGAL OPERAND &
	&
	\ S%=S%+1% \ S%(S%)=P% &
	\ Z9%=1% &
	\ Z2%=0% &
	\ D1%(0%)=FNN% &
	\ UNTIL Z9%>=49% OR FNR%(MID(D1$,Z9%,4%)+B0$,4%) &
	\	Z9%=Z9%+4% &
	\	Z2%=Z2%+D1%((Z9%-1%)/4%) &
	\ NEXT &
		! PUSH THE OLD CHARACTER POINTER. &
		! INITIALIZE THE MONTHS STRING DECODE POINTER. &
		! INITIALIZE THE DAY COUNTER. &
		! &
		! GET THE DAY AND SEARCH FOR THE MONTH ADDING IN THE &
		! DAYS OF EACH MONTH AS WE GO ALONG. &
	&
	\ GOTO 15270 IF Z9%=49% &
	\ S%(S%)=P% &
	\ Z3%=FNR%("-",1%) &
	\ IF Z3% THEN &
		Z3%=FNN% &
	  ELSE	Z$=SYS(PRIV.ON$) &
	\	Z3%=PEEK(512%)/1000%+70% &
	\	Z$=SYS(PRIV.OFF$) &
		! IF WE DIDN'T FIND A MONTH NO USE GOING ON. CHECK FOR &
		! YEAR AND GET IT ONE WAY OR ANOTHER. WE MUST SAVE THE &
		! CHARACTER POINTER BEFORE DOING THE YEAR CHECK. &

15240	F%=0% &
	\ GOTO 15270 IF Z3%<70% OR Z3%>99% &
	\ IF (Z3% AND 3%)=0% THEN &
		D1%(2%)=D1%(2%)+1% &
	\	Z2%=Z2%+1% IF Z1%>5% &
		! CHECK IF WE FOUND A VALID YEAR AND THEN HANDLE &
		! LEAP YEAR PROPERLY. &

15250	GOTO 15270 IF D1%(0%)>D1%(Z1%/4%+1%) OR D1%(0%)<=0% &
	\ F%=-1% &
	\ FND%,Z2%=(Z3%-70%)*1000%+Z2%+D1%(0%) &
	\ Z3%,Z1%=0% &
	\ IF P%=S%(S%) OR T% THEN &
		Z1$=",/:" &
	\	Z3%=1% &
	\	S%=S%+1% \ S%(S%)=P% &
	\	Z3%=Z3%+1% UNTIL FNR%(MID(Z1$,Z3%,1%),1%) OR Z3%>4% &
	\	P%=S%(S%) \ S%=S%-1% &
	\	IF ((Z3%>4%) AND (P%=S%(S%))) OR &
				((T%=0%) AND (Z3%=3%)) THEN &
						F%,FND%=0% &
		! IF THE DAY FOR THE MONTH SPECIFIED IS VALID THEN SET &
		! THE FOUND FLAG AND SET THE VALUE OF THE FUNCTION. &
		! &
		! THIS IS THE SPECIAL TERMINATOR CHECK. &
		! IF WE FOUND THE MINIMUM MONTH, BUT SOMETHING NON &
		! STANDARD FOLLOWED IT, WE FAIL. WE ALSO MAKE THIS CHECK &
		! IF TIME IS POSSIBLE. &

15265	IF T% AND Z3%=3% THEN &
		P%=P%+1% &
 		\ Z1%=FNN% &
		\ IF Z1%<0% OR Z1%>23% THEN F%,FND%=0% &
		  ELSE IF FNR%(":",1%)=0% THEN F%,FND%=0% &
			ELSE Z3%=FNN% &
				\ IF Z3%<0% OR Z3%>59% THEN F%,FND%=0% &
					ELSE Z1%=Z1%*60%+Z3% &
		! PUT THE TIME INTO Z1% IF IT IS VALID. &

15270	IF F%=0% THEN P%=S%(S%) &
			\ E%=512%+53% &
			\ GOTO 15280 &
		! IF ITS AN ERROR, RETURN THE OLD CHAR POINTER, SET THE &
		! ERROR NUMBER AND RETURN. &

15275	Z0%(P1%,M1%)=Z2% &
	\ Z0%(P1%,M2%)=Z1% &
		! ASSIGN THE DATE AND TIME TO THEIR PROPER PLACES. &
		! FUNCTION RETURNS AS DATE. &

15280	D1%(2%)=28% &
	\ S%=S%-1% &
	\ FNEND &
		! RESTORE THE STACK AND RETURN. &
	&

15400	DEF* FNP9%(D8%,C1%) &
	\ FNP9%=0% &
		! SET THE DENSITY AND PARITY ON CHANNEL C1% TO D8%. &
		! RETURNS:	0% IF SETTING IS ILLEGAL FOR THE DRIVE. &
		!		-1% IF DENSITY AND PARITY HAS BEEN SET. &
		!		S8% AS MAGTAPE STATUS WORD (ALWAYS). &

15410	ON ERROR GOTO 15460 &
	\ Z2%=0% &
	\ S8%=MAGTAPE(7%,0%,C1%) &
	\ Z2%=-1% IF (D8% AND 16384%) AND (S8% AND 4096%)=0% &
	\ Z2%=-1% IF D8%=1600% AND (S8% AND 16%)=0% &
	\ Z1%=((D8% AND 16384%)/16384%)+8192% &
	\ Z1%=Z1%+8% IF (S8% AND 4096%) &
	\ Z1%=Z1%+256% IF D8%=1600% &
	\ Z1%=Z1%+12% IF (S8% AND 4096%)=0% AND (D8% AND 800%)=800% &
	\ S8%=MAGTAPE(6%,Z1%,C1%) &
	\ S8%=MAGTAPE(7%,0%,C1%) &
	\ GOTO 15450 IF Z1%<>((S8% AND 24576%)/8192%)*4%+ &
			(S8% AND 2048%)/2048% &
		UNLESS (Z1% AND 256%)=(S8% AND 8%)*32% &
	\ FNP9%=-1% UNLESS Z2% &
		! GET THE MAGTAPE STATUS INTO S8%. &
		! IF THE DENSITY IS ILLEGAL FOR THE DRIVE, EXIT. &
		! IF OK, CALCULATE THE 'MODE' VALUE AND SET THE DENSITY/ &
		! PARITY. SET THE RETURN VALUE AND EXIT. &

15450	ON ERROR GOTO 19000 &
	\ FNEND &

15460	E%=ERR &
	\ RESUME 15450 &
	&

19000	! &
	&
	&
	!	T R A P    F O R    U N H A N D L E D    E R R O R S &
	&
	RESUME 19020 &
		! BE SURE TO CLEAR THE ERROR. &

19020	Z$=SYS(PRIV.OFF$) IF LEN(PRIV.OFF$) &
	\ E%=ERR UNLESS E% &
	\ T$=RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(E% AND 63%)),4%) &
	\ T$="?UNEXPECTED ERROR IN "+I$+" - "+T$+" AT LINE"+NUM$(ERL)+ &
		" - FATAL" &
	\ T$=T$+C9$+" ON 'CHAIN' TO '"+P$+"'" IF ERL=9040 &
	\ IF (ERL<23100 OR ERL>23199) AND ERL>1099 THEN &
		GOSUB 23100 &
	  ELSE	PRINT T$ &
		! SET UP TEXT OF ERROR MESSAGE; &
		! IF THE ERROR DID NOT HAPPEN WITHIN THE 'ISSUE A &
		!	MESSAGE' ROUTINE, THEN &
		!		GO ISSUE THE MESSAGE; &
		! ELSE	PRINT IT OUT. &

19030	RESUME 32700 &
		! AND EXIT THE PROGRAM. &
	&

22500	! &
	&
	&
	!	O P E N    T H E    L I S T I N G    F I L E &
	&
	! This routine is called at the beginning of the program &
	! to ensure that the listing file is open, if it is possible. &
	! It is also called upon detach/attach to determine if the &
	! explicit file needs to be opened/closed. &
	&
	! The data used by the routine are the following : &
	!	K%	- Keyboard to which job is ATTACHED, or -1, &
	!		  DETACHED. &
	!	Z0%(0%,5%) &
	!		- FHR word 5, pointing to the record holding the &
	!		  listing file name/spec. &
	!	L0%	- Channel # of the listing file - if non-zero, &
	!		  no work is performed, since the file is &
	!		  either already OPEN or has already been &
	!		  determined to be inaccessible. &
	&
	! The data returned by the routine are : &
	!	L0%	- Channel # of the OPENed listing file, or -1. &
	!		  If the OPEN failed (see below), then L0% is &
	!		  returned as -1.  If the OPEN succeeded, but &
	!		  the list file was the user's KB: (ie, the KB: &
	!		  to which the job is ATTACHed), then the &
	!		  channel is CLOSEd, and L0% is returned as 0. &
	!		  Otherwise, L0% is returned as the channel to &
	!		  list to (hardwired as #3). &
	!	K1%	- If the list file is a KB:, then K1% is &
	!		  returned holding the kb#.  If the list file is &
	!		  not a KB:, K1% is returned as -1. &
	&
	IF L0% THEN &
		GOTO 22530 &
	ELSE	E%=0% &
	\	Z%=FNO%(Z0%(0%,5%),6%,3%) &
	\	IF E%=0% THEN &
			L0%=3% &
		ELSE	E1%=3% &
	\		E3%=1% &
	\		GOSUB 22550 &
	\		IF L0%>0% THEN &
				GOTO 22500 &
		! IF THE LISTING FILE IS NOT YET OPEN, THEN &
		! SET UP TO OPEN THE LISTING FILE; &
		! TRY OPENING IT; &
		! IF OKAY, SET UP THE CHANNEL NUMBER FOR LATER; &
		! OTHERWISE, ASK FOR EITHER A 'RETRY' OR AN 'IGNORE'; &
		! IF 'RETRY, THEN TRY AGAIN; ELSE IF IGNORE, THEN &
		! NOTIFY THE USER OF THE CONDITION. &

22520	K1%=-1% &
	\ IF L0%>0% AND (STATUS AND 255%)=2% THEN &
		Z$=SYS(PRIV.ON$) &
	\	K1%=(SWAP%(PEEK(PEEK(K0%+2%*L0%)+2%)) AND 255%) &
	\	Z$=SYS(PRIV.OFF$) &
		! SET UP THE KEYBOARD NUMBER OF THE LIST FILE, IF IT &
		! IS A KEYBOARD FILE. &

22530	IF K1%=K% AND K%>-1% THEN &
		CLOSE L0% &
	\	L0%=0% &
		! IF THE KEYBOARD NUMBERS ARE EQUAL (AND BOTH ARE &
		! REALLY KEYBOARD NUMBERS) THEN &
		!	CLOSE THE LISTING FILE, SINCE WE DON'T WANT &
		!	THINGS PUT IN THERE TWICE; &
		!	SET THE FLAG TO NOT OPEN. &

22540	RETURN &
		! AND EXIT. &
	&
	&

22550	&
	&
	&
	!	P R O C E S S    A N Y    E R R O R    O N &
	!		L I S T    F I L E &
	&
	! The purpose of this routine is to keep the program's state as &
	! well isolated as possible from problems with the listing file. &
	! In order to ensure this, all variables which might affect the &
	! outside program must be pushed onto the stack before any &
	! operations are performed, and popped from the stack upon &
	! completion. &
	&
	S%=S%+1% \ S%(S%)=R2% &
	\ S%=S%+1% \ S%(S%)=D% &
	\ S%=S%+1% \ S%(S%)=P3% &
	\ S%=S%+1% \ S%(S%)=P0% &
	\ S%=S%+1% \ S%(S%)=L0% &
	\ P0%,D%=0% &
	\ P3%,C%(D%)=Z0%(0%,5%) &
	\ L0%=-1% &
	\ R1%=32%+512% &
	\ GOSUB 23000 &
	\ L0%=S%(S%) \ S%=S%-1% &
	\ P0%=S%(S%) \ S%=S%-1% &
	\ P3%=S%(S%) \ S%=S%-1% &
	\ D%=S%(S%) \ S%=S%-1% &
	\ IF R2%=512% THEN &
		T$="%PROCEEDING WITHOUT LISTING FILE" &
	\	GOSUB 23100 &
	\	ON ERROR GOTO 22590 &
	\	CLOSE L0% &
	\	L0%=-1% &
		! PUSH THE CURRENT VALUES OF: &
		!	RESPONSE FROM OPERATION COMMANDS; &
		!	ROUTINE DEPTH; &
		!	SOURCE RECORD; &
		!	CURRENT RECORD; &
		!	LISTING FILE CHANNEL NUMBER; &
		! SET UP THE ERROR RECORD AS THE LISTING FILE NAME &
		! RECORD; &
		! SET UP THE ERROR CHANNEL NUMBER AS THE LISTING &
		! FILE CHANNEL; &
		! SET THE LISTING FILE CHANNEL NUMBER TO -1 SO THE &
		! NOTIFICATION ROUTINES DO NOT TRY TO PRINT OUT &
		! THE MESSAGE ONTO THE LISTING FILE; &
		! SET UP LEGAL &
		! RESPONSES AS 'RETRY' AND 'IGNORE'; &
		! CALL THE NOTIFICATION ROUTINE; &
		! RECOVER THE LIST FILE CHANNEL, THE CURRENT RECORD, &
		! SOURCE RECORD, AND ROUTINE DEPTH; &
		! IF THE RESPONSE WAS 'IGNORE', THEN &
		!	NOTIFY THAT NO LISTING WILL BE MADE; &
		!	SET UP TO TRAP ERROR ON CLOSE; &
		!	EXECUTE THE CLOSE; &
		!	(ONLY GET HERE IF THE CLOSE WAS SUCCESSFUL) &
		!	RESET THE CHANNEL NUMBER TO -1, SO NO MORE LIST &
		!	 ACTIVITY WILL TAKE PLACE. &

22570	R2%=S%(S%) \ S%=S%-1% &
		! POP THE OLD RESPONSE. &
	\ RETURN &
		! AND EXIT. &

22590	L0%=-1% &
	\ RESUME 22570 &
		! THIS LINE IS EXECUTED WHEN AN ERROR OCCURRED ON THE &
		! LIST FILE CLOSE OPERATION;  THE FILE IS CLOSED, SO &
		! SET THE CHANNEL NUMBER TO -1, AND RESUME. &
	&

22600	&
	&
	!	P R E P A R E    F O R    D E T A C H &
	&
	! In order to DETACH, the following actions must be taken : &
	!	1) The job must be entered as a receiver; &
	!	2) The receiver table entry for this job must be &
	!	   located so the program can do a fast check for &
	!	   messages queued; &
	!	3) An 'ONLINE' command must be sent to OPSER, to inform &
	!	   OPSER of this job's existence; &
	!	4) The 'OPEN LIST FILE' routine must be executed, in &
	!	   case the list file is "KB:". &
	&
	! Errors may occur in steps 1 and 3.  An error in either &
	! place will cause a failure to DETACH. &
	&
	! The routine uses the following data, all of which are flags &
	! in variable R% : &
	!	2048	RECEIVER FLAG &
	!		If this is set, the job has already entered &
	!		itself as a receiver, so no entering will be &
	!		performed. &
	!	4096	ONLINE FLAG &
	!		if this is set, the job has already sent online &
	!		online notification to opser, and no new online &
	!		will be sent. &
	!	J%	- Job number of this job. &
	&
	! The data returned by the routine are : &
	!	E%	- If some error occurred which prevented the &
	!		  DETACH.  (If this is set, the variable T1$ &
	!		  will hold text describing the error.) &
	!	T1$	- Text of the error, if E% is non-zero. &
	!	J0%	- If no error, returns the value such that the &
	!		  high byte of the word PEEK(J0%) gives the &
	!		  number of messages queued to this job. &
	!	R%	- The following values : &
	!		-32768	- 0 => No prompt required &
	!		 16384	- 0 => Not ATTACHed &
	!		 4096	- 1 => Entered in receive table &
	!		 2048	- 1 => ONLINE to OPSER &
	!	T0$	- If no error is encountered, this string will &
	!		  hold the string information necessary to do a &
	!		  'SEND' to OPSER using the command &
	!			Z$=SYS(T0$+<string to send>) &
	!	K%	- Keyboard number of KB: to which job is &
	!		  ATTACHed; if no error, returned as -1. &
	&
	&
	IF K1%=K% AND K%<>-1% THEN &
		T1$="KEYBOARD IS LIST FILE" &
	\	E%=10% &
	\	GOTO 22680 &
		! IF THE CURRENT KEYBOARD IS THE LIST FILE, THEN &
		!	DO NOT ALLOW A DETACH, SINCE A DETACH WOULD &
		!	 NOT REALLY FREE THE KEYBOARD, AND IT WOULD &
		!	 BE RATHER CONFUSING. &

22610	T1$=N$ &
	\ IF (R% AND 2048%) THEN &
		GOTO 22630 &
	ELSE	ON ERROR GOTO 22620 &
	\	Z$=SYS(PRIV.ON$) &
	\	Z$=SYS(M0$+CHR$(1%)+CHR$(128%+5%)+ &
			MID(SYS(F0$+"BACK"+J$),7%,4%)) &
	\	Z$=SYS(PRIV.OFF$) &
	\	E%=-1% &
	\	T1$="OUTSTANDING MESSAGE" &
	\	GOTO 22680 &
		! IF NOT ALREADY DECLARED AS A RECEIVER, THEN DECLARE &
		! NOW; &
		! IF THERE IS ALREADY A MESSAGE OUTSTANDING, THERE IS A &
		! SYNCHRONIZATION ERROR, AND THE DETACH SHOULD NOT BE &
		! ALLOWED, IF IT CAN BE AVOIDED. &

22620	IF ERR=5% THEN &
		RESUME 22630 &
	ELSE	E%=ERR &
	\	T1$="NO ROOM IN RECEIVE TABLE" IF E%=4% &
	\	T1$="ILLEGAL SYS() USAGE" IF E%=18% &
	\	T1$="UNEXPECTED ERROR - "+RIGHT(SYS(E9$+ &
			CHR$(E%)),4%) IF E%<>4% AND E%<>18% &
	\	RESUME 22680 &
		! IF THE ERROR IS 'NO MESSAGES', THEN ALL IS WELL; &
		! IF THE ERROR IS 'NO ROOM' OR 'ILLEGAL SYS()', THEN &
		! DON'T ALLOW DETACH; IF THE ERROR IS SOMETHING ELSE, &
		! DON'T ALLOW A DETACH. &

22630	Z$=SYS(PRIV.ON$) &
	\ J0%=PEEK(PEEK(J1%+8%)+18%) &
	\ Z$=SYS(PRIV.OFF$) &
	\ R%=R% OR (2048% AND J0%<>0%) &
	\ J0%=J0%+14% &
		! THIS LINE IS EXECUTED ONLY IF AN ERROR 5 &
		! OCCURRED ON THE 'RECEIVE' CALL; FIND THE LOCATION &
		! OF THE RECEIVE TABLE ENTRY FOR THIS JOB, AND THE &
		! ADDRESS OF THE QUEUED MESSAGE COUNTER. &
	\ T0$=M0$+CHR$(-1%)+CHR$(0%)+ &
		MID(SYS(F0$+"OPSER"),7%,4%) &
	\ IF (R% AND 4096%)=0% THEN &
		R%=R% AND -16385% &
	\	T$=CHR$(128%+64%)+"ONLINE" &
	\	GOSUB 23100 &
	\	IF (R%  AND 4096%)=0% THEN &
			R%=R% OR 16384% &
	\		T1$="OPSER HUNG" &
	\		E%=-1% &
	\		GOTO 22680 &
		! SET UP THE 'SEND TO OPSER' STRING; &
		! IF NOT ALREADY ONLINE TO OPSER, THEN &
		!	SEND AN ONLINE MESSAGE; &
		!	IF IT FAILED TO SEND, THEN &
		!		FLAG US ATTACHED; &
		!		SET UP ERROR; &
		!		GOTO EXIT. &

22670	E%=0% &
	\ R%=(R% AND 16383%) &
	\ K%=-1% &
	\ GOSUB 22500 UNLESS L0% &
		! IF THIS LINE IS REACHED, RESET ERROR, RESET &
		! ATTACHED AND PROMPT NEEDED FLAGS, AND GO SEE &
		! IF THE LISTING FILE NEEDS TO BE OPENED. &

22680	ON ERROR GOTO 19000 &
	\ IF E% THEN &
		Z$=SYS(PRIV.ON$) &
	\	Z$=SYS(M0$) &
	\	Z$=SYS(PRIV.OFF$) &
	\	T$=T$+C9$+"("+T1$+")" &
		! RESET ERROR TRAP; &
		! IF SOME OUTSTANDING ERROR, MAKE SURE THIS &
		! JOB IS REMOVED FROM THE RECEIVER TABLE. &

22690	RETURN &
		! AND EXIT. &
	&

22700	! &
	&
	&
	!	P R I N T    A    L I N E    I N T O    T H E &
	!		L I S T I N G    F I L E &
	&
	GOSUB 22720 &
	\ GOSUB 23200 &
	\ GOTO 22730 &
		! 'USER ENTRY' : &
		! PRINT THE MESSAGE TO THE LOG FILE; &
		! MAKE SURE THAT THE PROMPT IS RE-PRINTED IF THE LIST &
		!	FILE IS THE KB:; &
		! EXIT. &
	&
	&
	!	FOLLOWING IS THE 'INTERNAL ENTRY' : &
	!	IT CAN BE USED BY ROUTINES WHICH ARE SURE THAT THE NEXT &
	!	CALL AFTER THIS PRINT IS COMPLETED WILL BE ONE THAT &
	!	ENSURES THAT THE PROMPT IS RE-PRINTED (OR WHICH DO NOT &
	!	WANT THE PROMPT RE-PRINTED, EG, ABORT). &

22720	IF L0%>-1% THEN &
		ON ERROR GOTO 22750 &
	\	PRINT #L0% IF CCPOS(L0%) &
	\	PRINT #L0%,T$ &
	\	R%=R% OR NOT 32767% UNLESS L0% &
		! IF THERE IS A LISTING FILE, PRINT THE LINE INTO IT. &
		! MAY GET AN ERROR HERE. &
		! IF THE LISTING FILE IS ON CHANNEL 0, THEN IT MUST &
		! BE THE KB:, SO SET 'PROMPT REQUIRED' FLAG. &

22730	ON ERROR GOTO 19000 &
		! RESET ERROR TRAP. &
	\ RETURN &
		! AND EXIT. &
	&

22750	E%=ERR &
	\ RESUME 22770 &
		! &
		!	E R R O R    T R A P &
		! &
		! SET ERROR NUMBER AND MAKE SURE OF RESUME. &

22770	GOSUB 22550 &
	\ IF L0% THEN &
		GOTO 22720 &
	  ELSE	GOTO 22730 &
		! GO PROCESS ERROR; &
		! IF NO MORE LISTING FILE, THEN GO EXIT; &
		! ELSE, GO TRY AGAIN. &
	&

22800	&
	&
	&
	!	C H E C K    F O R    A T T A C H E D &
	&
	Z$=SYS(PRIV.ON$) &
	\ IF (R% AND 16384%) THEN &
		GOTO 22830 &
	  ELSE	IF (PEEK(PEEK(K0%)+2%) AND 255%)/2%<>J% OR &
				(PEEK(PEEK(K0%)+6%) AND 8192%)<>8192% &
				THEN &
			GOTO 22830 &
		ELSE	K%=(SWAP%(PEEK(PEEK(K0%)+2%)) AND 255%) &
	\		GOSUB 22500 &
		! IF THE STATUS INDICATES THAT THE JOB IS ATTACHED, THEN &
		!	GO TO EXIT; &
		! ELSE	IF THE JOB REALLY IS NOT ATTACHED, ACCORDING TO &
		!		TO THE EXEC, THEN &
		!		GO TO EXIT; &
		!	ELSE	SET UP THE KB: # OF THE CURRENT KB:; &
		!		GO CHECK TO SEE IF THE LIST FILE SHOULD &
		!			BE OPENED OR CLOSED. &

22820	PRINT #0% IF CCPOS(0%) &
	\ PRINT #0%,"BACKUP ("+J$+") ATTACHED" &
	\ R%=(R% OR -16384%) &
	\ R0%(0%)=R0%(0%) OR 4% &
		! PRINT THE HEADER MESSAGE AND SET THE 'PROMPT REQUIRED' &
		! FLAG (ALSO SET THE 'ATTACHED' FLAG, FOR EASE); &
		! MAKE THE 'DETACH' COMMAND LEGAL (AT THIS POINT, IT &
		! MUST BE LEGAL - THE ONLY WAY THE PROGRAM FOUND OUT &
		! THAT IT WAS DETACHED WAS FROM A 'DETACH' COMMAND, SO &
		! IT WAS LEGAL ORIGINALLY). &

22830	Z$=SYS(PRIV.OFF$) &
	\ RETURN &
	! AND EXIT. &
	&

22900	! &
	&
	&
	!	S T A T U S &
	&
	! THIS ROUTINE PRINTS OUT THE CURRENT STATE OF THE PROGRAM, &
	! USING THE TWO ARRAYS C%() AND C().  THE CONTENTS OF THESE &
	! ARRAYS ARE : &
	!	C%(0)	- UNUSED &
	!	C%(1)	- SUBSCRIPT OF THE VOLUME RECORD SHOWING THE &
	!		  CURRENT VOLUME BEING PROCESSED &
	!	C%(2)	- SUBSCRIPT OF THE CURRENT UFD RECORD &
	!	C%(3)	- SUBSCRIPT OF THE CURRENT FILE RECORD &
	!	C%(4)	- BLOCK OF THE CURRENT BLOCK WITHIN THE FILE &
	! &
	!	C(0)	- UNUSED &
	!	C(1)	- TOTAL NUMBER OF VOLUMES IN INPUT VOLUME LIST &
	!	C(2)	- TOTAL NUMBER OF ACCOUNTS SELECTED &
	!	C(3)	- TOTAL NUMBER OF FILES SELECTED &
	!	C(4)	- TOTAL NUMBER OF DATA BLOCKS IN SELECTED FILES &
	! &
	!	R$	- PHASE NAME &
	!	T0	- TIME OF DAY AT WHICH THIS PROGRAM BEGAN &
	!	T1	- CPU TIME FOR THIS JOB AT THE TIME THIS PROGRAM &
	!		  BEGAN &
	!	T3	- KCT'S FOR THIS JOB AT THE TIME THIS PROGRAM &
	!		  BEGAN. &
	&
	T0=T0-86400. IF TIME(0%)<T0 &
	\ T$=C9$+"PHASE	: "+R$+C9$ &
		+"ERRORS	 : "+NUM1$(E2%)+C9$+C9$+C9$ &
		+"ELAPSED TIME : "+NUM1$(TIME(0%)-T0)+" SECONDS"+C9$ &
		+"CPU TIME     : "+NUM1$((TIME(1%)-T1)/10%)+" SECONDS"+C9$ &
		+"KCTS         : "+NUM1$(TIME(3%)-T3)+C9$+C9$ &
		! SET UP THE PHASE VALUE FOR THIS PROGRAM. &
		! PRINT OUT THE 'CURRENT' INFORMATION. &
	\ RETURN &
	&

23000	! &
	&
	&
	!	L O G     E R R O R &
	&
	! THIS ROUTINE PERFORMS THE FOLLOWING FUNCTIONS: &
	!	1. CREATES AN ERROR MESSAGE &
	!	2. DISPATCHES THE MESSAGE TO USER/OPERATOR &
	!	3. (CONDITIONALLY) ADDS THE ERROR TO THE LIST &
	!	    OF ERRORS ASSOCIATED WITH THE RECORD IN THE &
	!	    WORK-FILE POINTED TO BY P3%. &
	!	4. (CONDITIONALLY) PRINTS ERROR INTO THE LISTING &
	!	    FILE. &
	&
	! THE PARAMETERS USED ARE: &
	!	E%	- CONTAINING THE ERROR NUMBER OF THE ERROR &
	!		  TO LOG.  THIS NUMBER IS TRANSFORMED INTO &
	!		  A STRING BY THE FUNCTION FNE$(). &
	!		  E% MUST BE NON-ZERO UPON ENTRY. &
	! &
	!	D%	- DEPTH AT WHICH ERROR IS TO BE LOGGED &
	!		  (AFFECTS ONLY THE TEXT OF THE ERROR &
	!		  MESSAGE). &
	! &
	!	P3%	- RECORD CONTAINING DEVICE/ACCOUNT INFO. &
	!		   EG, IF ERROR OCCURRED WHILE SCANNING &
	!		   ACCOUNT DP0:[1,201], THEN THE RECORD &
	!		   POINTED TO BY P3% SHOULD CONTAIN THE &
	!		   INFORMATION. &
	! &
	!	P0%	- RECORD DESCRIBING ENTITY WHICH CAUSED &
	!		   ERROR;  EG, IF ERROR OCCURRED ON AN &
	!		   ACCOUNT, THEN P0% MUST POINT TO THE UR &
	!		   FOR THE ACCOUNT. &
	! &
	!	E1%	- RECORD NUMBER IN MFD/UFD/FILE AT WHICH ERROR &
	!		  OCCURRED (USED ONLY IN BAD BLOCK ERRORS). &
	! &
	!	R1%	- ACTION TO TAKE WITH THE ERROR.  IF NON-ZERO, &
	!		  THE ERROR TEXT WILL CONTAIN A LIST OF &
	!		  LEGAL RESPONSES. &
	! &
	!	L0%	- LIST FILE CHANNEL # - IF 0, THEN NO LIST &
	!		  FILE ACTIVITY TAKES PLACE. &
	! &
	!	C%(D%)	- POINTS TO THE RECORD TO WHICH THE ERROR &
	!		   SHOULD BE LOGGED. &
	&
	T$=FNE$(E%,D%,P3%,P0%,E1%) &
	\ T$=T$+C9$+"(ON " &
	\ T$=T$+"OPEN)" IF E3%=1% &
	\ L$=T$ &
	\ S%=S%+1% \ S%(S%)=E1% &
	\ S%=S%+1% \ S%(S%)=E3% &
	\ S%=S%+1% \ S%(S%)=E% &
	\ IF (R1% AND (32%+64%+512%)) THEN &
		T$=T$+C9$+"( " &
	\	T$=T$+"RETRY " IF (R1% AND 32%) &
	\	T$=T$+"SKIP " IF (R1% AND 64%) &
	\	T$=T$+"IGNORE " IF (R1% AND 512%) &
	\	T$=T$+"LEGAL)" &
		! SET UP ERROR MESSAGE STRING FROM THE PARAMETERS. &
		! APPEND (PROGRAM DEPENDANT) MODIFIERS, IF REQUIRED. &
		! IF SOME RESPONSE IS REQUESTED, THEN &
		! TELL THE USER WHAT IS LEGAL. &

23040	GOSUB 23100 &
	\ GOSUB 23200 &
	\ E%=S%(S%) \ S%=S%-1% &
	\ E3%=S%(S%) \ S%=S%-1% &
	\ E1%=S%(S%) \ S%=S%-1% &
	\ IF (R2% AND 32%) THEN &
		GOTO 23090 &
	  ELSE	S%=S%+1% \ S%(S%)=P0% &
	\	P0%=C%(D%) &
		! GO NOTIFY THE USER OF THE ERROR; &
		! CHECK FOR A RESPONSE, EVEN IF ONE IS NOT REQUIRED. &
		! &
		! POP THE STUFF OFF THE STACK; &
		! IF THE RESPONSE WAS 'RETRY', THEN &
		!	DO NOT LOG THE ERROR OR &
		!	ISSUE A MESSAGE TO THE LIST &
		!	FILE. &

23060	P1%,P0%=FNP0%(P0%,3%,0%) &
	\ P0%=Z0%(P0%,1%) &
	\ WHILE P0% AND (E%<Z0%(P0%,6%) OR (Z0%(P0%,7%)>25%)) &
	\	P1%=P0% &
	\	P0%=Z0%(P0%,1%) &
	\ NEXT &
	\ IF P0%=0% OR E%<>Z0%(P0%,6%) THEN &
		S%=S%+1% \ S%(S%)=Z0%(P1%,1%) &
	\	P0%,Z0%(P1%,1%)=FNA% &
	\	Z0%(P0%,1%)=S%(S%) \ S%=S%-1% &
	\	Z0%(P0%,6%)=E% &
	\	Z0%(P0%,7%)=7% &
		! SET UP THE ERROR LIST FOR THE RECORD IN ERROR; &
		! FIND THE RECORD IN THE ERROR LIST WHICH MEETS &
		! THE FOLLOWING QUALIFICATIONS: &
		!	1 - SAME ERROR NUMBER AS THIS ERROR; &
		!	2 - ROOM FOR MORE ERROR ENTRIES IN IT. &
		! IF SUCH A RECORD CAN NOT BE FOUND, THEN &
		!	SET UP A NEW RECORD IN THE ERROR LIST, &
		!	AND LINK IT IN AFTER THE PREVIOUS RECORD; &
		!	(NOTE THAT THE ERROR RECORDS ARE KEPT IN &
		!	ASCENDING ORDER BY ERROR NUMBER.) &
	&

23070	Z%=Z0%(P0%,7%)+1% &
	\ Z0%(P0%,Z%)=E1% &
	\ Z0%(P0%,Z%+1%)=Z0%(P3%,6%) &
	\ Z0%(P0%,Z%+2%)=Z0%(P3%,7%) &
	\ Z0%(P0%,Z%+3%)=Z0%(P3%,8%) &
	\ Z0%(P0%,7%)=Z%+3% &
	\ P0%=FNP1% &
	\ E2%=E2%+1% &
	\ P0%=S%(S%) \ S%=S%-1% &
	\ IF L0% THEN &
		T$=L$ &
	\	GOSUB 22700 &
		! PUT THE DATA FOR THIS ERROR INTO THE SLOT IN THE &
		! FOLLOWING MANNER: &
		!	RECORD NUMBER (MAY BE 0) &
		!	DEVICE NAME; &
		!	ACCOUNT #; &
		! UPDATE THE ENTRY COUNT FOR THIS ERROR RECORD. &
		! &
		! IF THE LIST FILE IS OPEN, THEN &
		!	SET UP TO PRINT A MESSAGE TO &
		!	IT AND GO DO IT. &

23090	E%,E1%=0% \ RETURN &
		! AND EXIT. &
	&

23100	&
	&
	&
	!	I S S U E    A    M E S S A G E &
	&
	! This routine does a small amount of message reformatting and &
	! dispatches the message to, either, the user's KB:, if &
	! ATTACHed, or to OPSER.  It also stores the current outstanding &
	! message dispatched, if no requests are outstanding, in case &
	! the package is later requested to re-print it (LAST command). &
	&
	! If some response is requested, the message is reformatted with &
	! a '%' as the first character. &
	&
	! If one of the legal responses is 'OTHER', then, if the &
	! request is printed on the KB:, no CR-LF is printed (and the &
	! 'CR-LF PROMPT INHIBIT' flag is left set). &
	&
	! The routine expects the following data : &
	!	T$	- Message to dispatch &
	!	R1%,R0%(2%) &
	!		- Mask word showing legal responses &
	!	R%	- Flags as follows : &
	!		16384	- ATTACHed flag &
	!			  If set, message is printed on KB:; &
	!			  Otherwise, a check is made to see that &
	!			  the program is really DETACHed; &
	!			  If so, the message is sent to OPSER; &
	!			  Otherwise, the message is printed. &
	!		4096	- ONLINE flag &
	!			  If set and the job is flagged as &
	!			  DETACHed, a check is made for possible &
	!			  recent ATTACH; &
	!			  If not set, and the job is flagged as &
	!			  DETACHed, the message is sent to OPSER &
	!			  without a check for ATTACHed (this is &
	!			  the way the 'CHECK FOR DETACH' routine &
	!			  sends OPSER an ONLINE). &
	!		1024	- MESSAGE STORED flag &
	!			  If set, the routine will not replace &
	!			  the message  held in R1$ with the new &
	!			  message coming in; &
	!			  If not set, the routine will replace &
	!			  the text in R1$ with the new text. &
	&
	! The routine returns the following data : &
	!	T	- The time at which the routine was called (used &
	!		  for timeout conditions for re-prompting the &
	!		  operator). &
	!	R1$	- The text of the current outstanding request, &
	!		  or, if none, the text of the last message &
	!		  passed. &
	!	R%	- Flags as follows : &
	!		-32768	- 'PROMPT REQUIRED' flag is always set; &
	!		 16384	- Set if the job was found to be &
	!			  ATTACHed; &
	!		 4096	- Set if the job successfully sent the &
	!			  message to OPSER. &
	&
	! Other variables used : &
	!	T1$	- temporary storage of the string to dispatch &
	!		  (Used when the string is to be sent to OPSER.) &
	!	R8%	- Retry counter used to determine how many times &
	!		  a send to OPSER has been attempted. &
	&
	IF R1% THEN &
		R0%(2%)=R1% &
	\	R1%=0% &
		! THIS IS IN TO ALLOW MINIMUM CHANGE TO BACDIR. &

23110	T1$=T$ &
	\ R8%=0% &
	\ R%=R% AND -513% &
	\ IF (R% AND 1024%)=0% THEN &
		R1$=T$ &
	\	IF R0%(2%) THEN &
			R%=R% OR 1024% &
	\		R%=R% OR 512% IF (R0%(2%) AND 1024%) &
	\		R1$,T$=C8$+T$ &
		! HOLD THE MESSAGE IN A TEMP LOCATION; &
		! SET THE TIME TO RIGHT NOW, TO AVOID UNNECESSARY &
		!	MESSAGES; &
		! SET THE RETRY COUNTER TO 0; &
		! RESET THE 'CR-LF INHIBIT' FLAG, SINCE THIS IS A NEW &
		!	MESSAGE; &
		! IF A MESSAGE IS NOT ALREADY STORED FOR &
		! THE 'LAST MESSAGE' COMMAND, THEN &
		!	STORE THIS ONE; &
		!	IF THIS ONE REQUIRES A RESPONSE, THEN &
		!		INHIBIT FURTHER STORING OF &
		!		MESSAGES UNTIL THIS ONE IS ANSWERED; &
		!		INHIBIT CR-LF AFTER THIS MESSAGE, FOR &
		!		THIS ONE ONLY, IF THE RESPONSE CAN BE &
		!		'OTHER'; &
		!		SET UP THE WARNING FLAG (A <BELL>) ON &
		!		 THE MESSAGE. &

23120	GOSUB 22800 IF (R% AND 16384%+4096%)=4096% &
	\ IF (R% AND 16384%)=0% THEN &
		ON ERROR GOTO 23150 &
	\	WHILE LEN(T1$) &
	\		Z%=LEN(T1$)+1% &
	\		Z%=255% IF Z%>20% &
	\		Z$=SYS(PRIV.ON$) &
	\		Z$=SYS(T0$+CHR$(Z%)+T1$) &
	\		Z$=SYS(PRIV.OFF$) &
	\		R8%=0% &
	\		T1$=RIGHT(T1$,20%) &
	\	NEXT &
	\	R%=R% OR 4096% &
		! IF NOT ATTACHED, THEN GO SEE IF THE PROGRAM HAS BEEN &
		! ATTACHED RECENTLY; &
		! IF STILL NOT ATTACHED, THEN &
		!	SEND MESSAGE, 19 BYTES AT A TIME, TO &
		!		OPSER; &
		!	IF SEND WAS SUCCESSFUL, THEN SET 'OPSER &
		!		ONLINE' FLAG. &

23130	IF (R% AND 16384%) THEN &
		ON ERROR GOTO 19000 &
	\	PRINT #0% IF CCPOS(0%) &
	\	PRINT #0%,T$; &
	\	PRINT #0% UNLESS (R% AND 512%) &
		! IF ATTACHED, THEN &
		!	PRINT TEXT (WITHOUT CR-LF); &
		!	PRINT A CR-LF IF THE INHIBIT FLAG IS NOT SET. &

23140	R%=R% OR NOT 32767% &
	\ ON ERROR GOTO 19000 &
	\ RETURN &
		! SET THE 'PROMPT NEEDED' FLAG, SINCE SOMETHING WAS &
		!	JUST PRINTED OUT/SENT TO OPSER; &
		! RESET THE ERROR TRAP, LIKE A GOOD SUBROUTINE; &
		! AND EXIT. &

23150	RESUME 23170 &
		! &
		!	E R R O R    T R A P &

23170	IF ERR=32% THEN &
		R8%=R8%+1% &
	\	IF R8%<5% THEN &
			GOTO 23190 &
		! IF THE ERROR IS 'NO ROOM' FOR MESSAGE, THEN &
		! IF THE RETRY COUNT IS LESS THAN FIVE, THEN &
		!	SLEEP AND RETRY. &

23180	IF R8%<10% THEN &
		R8%=10% &
	\	Z$=SYS(PRIV.ON$) &
	\	Z$=SYS(C6$+CHR$(-5%)+CHR$(0%)+C9$+ &
			"***** BACKUP"+A$+"  JOB "+J$+" - OPSER HUNG"+ &
			C9$+C9$) &
	\	Z$=SYS(PRIV.OFF$) &
	\	GOTO 23140 &
		! IF ANY OTHER ERROR, SEND NOTIFICATION TO THE CONSOLE &
		! KB: (KB0:) THAT OPSER IS HUNG; &
		! ASSUME THAT THE MESSAGE WILL BE ASKED FOR LATER. &

23190	SLEEP 5% &
	\ GOTO 23120 &
		! DO A SLEEP AND GO RETRY. &
	&
	&
	&
	&

23200	&
	&
	&
	!	G E T / D E C O D E    R E S P O N S E    O R &
	!	    I N T E R R U P T    C O M M A N D &
	&
	! This routine polls both the user's keyboard and the &
	! Send/Receive table, if the job has entered itself, to get any &
	! input waiting for it.  If any input is found,even a null line, &
	! it is passed to the 'DECODE A LINE' routine, see below, to &
	! decode it and set flags in the appropriate status words, &
	! R%(0%), R%(1%), and R%(2%). &
	&
	! After the KB: and receive table have been polled, and &
	! whatever input there might have been has been decoded, the &
	! routine checkS the base state (R%(0%)) for any processes &
	! which may have been requested.  If any have been which &
	! require some action by the routine, it dispatches to the &
	! proper dispatch line number. &
	&
	! After all processes have been done, the following  decisions &
	! are made : &
	!	1) Has the program been in an inactive state (in a &
	!	  'PAUSE', waiting for a response, etc.) for more than &
	!	  60 seconds? &
	!	  If so, dispatch a reminder message. &
	!	2) Has some input or output been performed since the &
	!	  last prompt was printed, and, if so, is the program in &
	!	  a state in which a prompt should be printed? &
	!	  If so, go back to the beginning of the routine -  get &
	!	  the prompt printed. &
	!	3) Is the program in a state which requires further &
	!	  input, eg, a 'PAUSE' state, or waiting for a &
	!	  response? &
	!	  If so, SLEEP for 60 seconds and go retry the input &
	!	  phase. &
	&
	! Finally, after these decisions/actions, the routine sets up &
	! some returnable variables and exits. &
	&
	! The routine expects the following variables : &
	!	R%	- The following flags : &
	!		16	-'PAUSE' state &
	!			  If set, the routine does not exit &
	!			  until a 'CONTINUE' command is &
	!			  entered.  Set by the 'PAUSE' command. &
	!		2048	-'Entered to receive table' flag &
	!			  If set, the program has an entry in &
	!			  the receive table, and the routine &
	!			  will attempt to receive data, if none &
	!			  is available at the KB:. &
	!		16384	- 'ATTACHed' flag &
	!			  If set, the KB: is checked for input &
	!			  the receive table is checked.  Note &
	!			  that the KB: has higher precedence &
	!			  than the receive table - all KB: input &
	!			  (immediately available) is processed &
	!			  before the receive table is polled. &
	!		-32768	- 'PROMPT Required' flag &
	!			  If set, the routine will be &
	!			  re-executed, thus causing a prompt, &
	!			  except in the cases outlined in (2), &
	!			  above. &
	!	R0%(2%)	- 'Responses Requested" word - used in decision &
	!		  (3), above. &
	!	J0%	- Queue address word - this must be the &
	!		  address in the receive table of the count of &
	!		  messages queued for this job.  The high byte &
	!		  of PEEK(J0%) is the desired quantity. &
	!	D%(,)	- Dispatch/decode table - D%(X,2%) must contain &
	!		  the subroutine number for Interrupt Command &
	!		  #X.  D%(X,0) must contain the status word &
	!		  index for command #X.  D%(X,1) must contain &
	!		  the flag value for Command #X.  Used by the &
	!		  dispatcher. &
	!	R0%(0)	- 'Internal Interrupt Commands Permission' word; &
	!		  See the variable descriptions in program's &
	!		  preface.  Only commands whose values are &
	!		  specified in this word are legal. &
	!	R%(0)	- 'Internal Interrupt Commands Requested' word; &
	!		  See the variable descriptions in the program's &
	!		  preface. &
	!	R%(2)	- 'Response' word; &
	!		  See the variable descriptions in the program's &
	!		  preface. &
	&
	! The routine returns the following data : &
	!	R%(0)	- 	] &
	!	R%(1)	-	] values of the response(s) given &
	!	R%(2)	-	] &
	!	R2%	- Same value as R%(2) &
	!	R0%(2)	- 0 &
	!	C$	- String entered as a response to an 'OTHER' &
	!		  request. &
	&
	! The routine effects the following other variables : &
	!	R4%	- used as a pointer into the decode/dispatch &
	!		  table; &
	!	C0$	- temporary storage of 'OTHER' string; &
	!	E%	- error value of an unexpected error &
	!	Z$,Z%	- used in the receive a string routine &
	!	T2$	- used in the receive a string routine &
	!	T	- timer for reminder messages &
	!	T$	- text string for reminder messages and &
	!		  Interrupt Command response text. &
	&
	IF (R% AND 16384%)=0% THEN &
		GOSUB 22800 &
	\	R4%=0% &
	\	GOSUB 23570 IF (R% AND 17408%)=17408% &
		! IF THE 'ATTACHED' FLAG IS NOT SET, THEN GO SEE IF &
		! RECENTLY ATTACHED.  IF SO, THEN IF SOME MESSAGE WAS &
		! JUST ISSUED, ISSUE IT AGAIN, SO THAT THE USER SEES IT. &
	&
	&
	&
	&

23250	! &
	&
	&
	!	G E T    A    L I N E &
	&
	!	T R Y    K E Y B O A R D &
	&
	R4%=0% &
	\ R%(2%)=0% IF R0%(2%) &
	\ IF (R% AND 16384%)=0% THEN &
		GOTO 23300 &
	ELSE	IF R%<0% AND (R% AND 512%)=0% THEN &
			PRINT #0% IF CCPOS(0%) &
	\		PRINT #0%,"*"; &
	\		R%=R% AND 32767% &
		! IF NOT ATTACHED AT THIS POINT, THEN &
		!	GO SEE IF THIS JOB IS RECEIVING; &
		! ELSE, IF A PROMPT IS NEEDED, THEN &
		!	ISSUE IT IF THE 'CRLF INHIBIT' FLAG IS NOT SET. &

23270	ON ERROR GOTO 23280 &
	\ W%=0% &
	\ W%=120% IF R0%(2%) &
	\ WAIT W% &
	\ GET #0%,RECORD (8192% AND (W%=0%)) &
	\ WAIT 0% &
	\ R%=(R% AND -129%) OR -16384% &
	\ FIELD #0%, RECOUNT AS C$ &
	\ C$=C$+N$ &
	\ PRINT #0% IF CCPOS(0%) &
	\ GOTO 23340 &
		! SET UP ERROR TRAP; &
		! TRY (IMMEDIATE RETURN) LINE FROM THE KB:; &
		! SET 'PROMPT REQUIRED' AND 'ATTACHED' FLAGS; &
		! FIELD RESULTING STRING. &

23280	RESUME 23300 IF ERR=13% OR ERR=11% OR ERR=15% &
	\ E%=ERR &
	\ RESUME 19000 &
		! IF THE ERROR MEANT SIMPLY, NO DATA, OR IF IT WAS &
		! 'EOF', THEN SEE IF A MESSAGE IS QUEUED FOR THIS JOB. &
		! ALL OTHER ERRORS ARE FATAL. &
	&

23300	! &
	&
	&
	!	R E C E I V E    A    M E S S A G E &
	&
	C$=N$ &
	\ R%=R% AND 32767% &
	\ Z$=SYS(PRIV.ON$) &
	\ IF (R% AND 2048%)=0% THEN &
		GOTO 23350 &
	  ELSE	IF (PEEK(J0%) AND -256%)=0% THEN &
			GOTO 23350 &
		ELSE	ON ERROR GOTO 23320 &
	\		Z$=SYS(M0$+CHR$(1%)) &
	\		Z%=ASCII(RIGHT(Z$,9%)) &
	\		Z$=RIGHT(Z$,10%) &
	\		T2$=T2$+Z$ &
	\		IF LEN(Z$)<Z% THEN &
				GOTO 23300 &
			ELSE	C$=T2$ &
	\			T2$=N$ &
	\			R%=(R% AND -129%) OR -30720% &
	\			Z$=SYS(PRIV.OFF$) &
	\			GOTO 23340 &
		! NULL OUT THE STRING AND CLEAR THE 'PROMPT REQUIRED' &
		! FLAG TO BEGIN WITH; &
		! IF NOT IN RECEIVE TABLE, THEN DON'T TRY &
		! TO RECEIVE A MESSAGE; &
		!	ELSE	IF NO MESSAGES QUEUED FOR &
		!		THIS JOB, THEN DON'T TRY TO RECEIVE; &
		!		ELSE	SET UP RECEIVE, AND TAKE ONLY &
		!			THE TEXT PART; &
		!			IF THE MESSAGE IS NOT COMPLETE, &
		!			THEN	SAVE THE PARTIAL; &
		!			ELSE	RETURN COMPLETED &
		!				MESSAGE; &
		!				NULL OUT THE PARTIAL; &
		!				SET 'PROMPT REQUIRED' &
		!				FLAG. &

23320	IF ERR=5% THEN &
		RESUME 23300 &
	ELSE	RESUME 23350 &
		! IF THE ERROR IS 'NO MORE FOR YOU', THEN &
		!	GO TRY AGAIN, BECAUSE MORE MAY HAVE BEEN &
		!		ENTERED; &
		! ELSE	DON'T WORRY ABOUT THE ERROR. &

23340	GOSUB 23400 &
		! THE ROUTINES ENTER HERE IF SOME INPUT WAS RECEIVED, &
		! AND THIS LINE DISPATCHES TO DECODE IT.  THE ROUTINES &
		! MUST NEVER COME HERE IF NO INPUT WAS GOTTEN. &

23350	Z$=SYS(PRIV.OFF$) &
	\ ON D%(R4%,2%) GOSUB &
	    23500,23520,23550,23560,23570,23580,23600 &
		IF (R%(0%) AND (D%(R4%,1%) AND D%(R4%,0%)=0%)) IF &
			D%(R4%,2%) FOR R4%=1% UNTIL &
				R%(0%)=0% OR R4%=D%(0%,0%) IF &
					R%(0%) &
		! DISPATCH TO ANY NECESSARY PROCESSES, IF ANY ARE &
		! CURRENTLY OUTSTANDING; &
		! THE PROCESSES FOR THIS PACKAGE ARE : &
		!	ROUTINE	#	NAME &
		!		1	CONTINUE &
		!		2	DETACH &
		!		3	PAUSE &
		!		4	STATUS &
		!		5	LAST &
		!		6	LEGAL &
		!		7	NOTICE &
	&
	\ GOTO 23200 IF R%<0% AND &
		(R%(2%)<>1024% OR R0%(2%) OR (R% AND 16%)) &
		! IF THE 'PROMPT REQUIRED' FLAG IS SET, THEN &
		!	IF THE ROUTINE IS NOT ABOUT TO RETURN AN &
		!		'OTHER' RESPONSE, THEN &
		!		GO RE-ASK, IN ORDER TO GET THE &
		!		PROMPT PRINTED. &
	&
	\ IF (R% AND 16%) OR R0%(2%) THEN &
		T=TIME(0%) &
	\	SLEEP 120% &
	\	GOTO 23200 IF (R% AND 128%) OR (TIME(0%)-T<120.) &
	\	T$="(FURTHER RESPONSE NECESSARY)" &
	\	T$="(IN PAUSE)" IF R% AND 16% &
	\	GOSUB 23100 &
	\	R%=R% OR 128% &
	\	GOTO 23200 &
		! IF THE PROGRAM IS IN 'PAUSE' STATE OR SOME &
		! FURTHER INPUT IS REQUIRED, THEN &
		!	SLEEP AWHILE IF IN PAUSE; &
		!	PRINT MESSAGE IF NOT PROHIBITED; &
		!	GO CHECK FOR FURTHER INPUT. &

23380	C$=C0$ IF R%(2%)=1024% &
		! IF THE RESPONSE IS 'OTHER', THEN RETURN THE &
		! STORED RESPONSE STRING IN C$. &
	&
	\ R%=R% OR (R%(1%) AND 1%+8%+256%) &
	\ R2%=R%(2%) &
	\ RETURN &
		! SET UP THE PROGRAM STATUS, AND THE RETURN VALUE, FOR &
		! THE CONVENIENCE OF BACKUP; &
		! AND EXIT. &
	&

23400	&
	&
	&
	!	D E C O D E    A    L I N E &
	&
	! The function of this routine is to decode the text entered in &
	! the previous routine and to set the flags corresponding to &
	! the command in the appropriate 'Request' word, R%(0), R%(1), &
	! or R%(2).  Incidental to this main function are the resetting &
	! of timers, issuing of 'can't decode' error messages, etc. &
	&
	! The routine expects the following data : &
	!	C$	- input string &
	!	R0%(0)	-	] &
	!	R0%(1)	-	] permissible commands for the three &
	!	R0%(2)	-	] levels &
	!	D%(X,Y),D$(X)	- Decode tables &
	&
	! The routine returns the following : &
	!	C0$	- Response string if it was an 'OTHER' response &
	!	T	- Timer decremented by 15 seconds. &
	!	R%(0)	-	] &
	!	R%(1)	-	] These values with the appropriate &
	!	R%(2)	-	] flags set, see program preface. &
	&
	R3%=0% &
	\ C$=CVT$$(C$,4%+8%+16%+32%+128%) &
	\ IF LEN(C$) THEN &
		GOTO 23420 &
	  ELSE	IF (R0%(2%) AND 1024%)=0% THEN &
			GOTO 23480 &
		ELSE	R4%=2% &
	\		R3%=1024% &
	\		GOTO 23480 &
		! SET THE TIMER BACK 15 SECONDS, SO THE PROMPT MESSAGE &
		! WILL BE PRINTED SOONER; &
		! SET THE RESPONSE VALUE TO ZERO, IN CASE NOTHING IN &
		! HERE SETS IT; &
		! IF THE STRING IS NOT NULL, THEN &
		!	GO PROCESS; &
		! ELSE	IF AN 'OTHER' RESPONSE IS NOT ALLOWED, THEN &
		!		EXIT QUICKLY; &
		!	ELSE	SET UP THE RESPONSE'S LEVEL; &
		!		RESET THE ROUTINE NUMBER, SO NO &
		!		CALL IS MADE; &
		!		SET THE RESPONSE TO 'OTHER'; &
		!		AND GO TO THE CLOSE UP. &

23420	IF (R% AND 8192%)=0% THEN &
		RESTORE \ Z$=N$ \ Z%=0% &
	\	READ Z$ UNTIL Z$="**DECOP" &
	\	READ Z$ &
	\	WHILE Z$<>"**END" &
	\		Z%=Z%+1% &
	\		D$(Z%)=Z$ &
	\		READ D%(Z%,0%),D%(Z%,1%),D%(Z%,2%) &
	\		READ Z$ &
	\	NEXT &
	\	D%(0%,0%)=Z% \ R%=R% OR 8192% &
		! IF THE DECODE TABLE HAS NOT YET BEEN BUILT, THEN &
		!	BUILD IT. &

23430	Z%,R4%=0% &
	\ UNTIL Z% OR R4%>=D%(0%,0%) &
	\	R4%=R4%+1% &
	\	P%=0% &
	\	Z%=FNR%(D$(R4%),3%) &
	\ NEXT &
	\ C$=RIGHT(C$,Z%+1%) &
	\ R3%=D%(R4%,1%) &
	\ R4%=D%(R4%,0%) &
	\ R3%=R3% AND R0%(R4%) &
	\ IF R3%=0% THEN &
		T$="?UNRECOGNIZED COMMAND" &
	\	T$="?ILLEGAL COMMAND" IF Z% &
	\	GOSUB 23100 &
	\	R3%=0% &
	\	GOTO 23490 &
		! SET THE CHARACTER POINTER AND THE COMMAND POINTER &
		! TO 0; &
		! SCAN THE COMMAND TABLE TO FIND THE ONE ENTERED. &
	&
		! SET THE VALUE FLAG TO THE FLAG VALUE FOR THIS COMMAND &
		!	IF THIS COMMAND IS LEGAL IN THIS CONTEXT; &
	&
		! IF THE OPERAND VALUE IS RETURNED AS ZERO, THEN &
		!	NO LEGAL COMMAND (INCLUDING 'OTHER') WAS &
		!	FOUND, SO PRINT AN ERROR: &
		!		IF JUST PLAIN DOESN'T MATCH, THEN &
		!			SAY 'UNRECOGNIZABLE'; &
		!		OTHERWISE, MUST HAVE BEEN A REAL &
		!			COMMAND WHICH IS NOT LEGAL &
		!			AT THIS POINT. &
	&

23480	IF R3% THEN &
		R%(R4%)=R%(R4%) OR R3% &
	\	IF R4%<>2% OR (R0%(2%) AND R3%)=0% THEN &
			R0%(2%)=0% IF R%(1%) &
		ELSE	R0%(2%)=0% &
	\		R%=R% AND NOT(512% OR 1024%) &
	\		IF R3%=1024% THEN &
				C0$=C$ &
	\			Z%=ASCII(C0$) &
	\			IF Z%=ASCII("'") OR Z%=ASCII('"') THEN &
					IF ASCII(RIGHT(C0$,LEN(C0$)))= &
					Z% THEN &
						C0$=RIGHT(LEFT(C0$, &
							LEN(C0$)-1%),2%) &
		! IF THE RESPONSE WAS SOME COMMAND (INCLUDING 'OTHER'), &
		! THEN &
		!	SET WHATEVER VALUES IN THE RESPONSE CORRESPOND &
		!	TO VALUES IN THE OVERALL LEGAL WORD INTO THE &
		!	STATUS WORD; &
		!	IF THE RESPONSE WAS A PURELY INTERRUPT COMMAND, &
		!	IE, IT DID NOT RESPOND TO A PROGRAM REQUEST, &
		!	THEN &
		!		RESET THE 'RESPONSE REQUESTED' FLAG IF &
		!		THE COMMAND WAS 'ABORT'; &
		!	ELSE	SET THE RESPONSE TO THE ENTERRED VALUE; &
		!		RESET THE RESPONSE REQUESTED FLAG; &
		!		RESET THE FLAGS IN THE STATUS WORD WHICH &
		!		RELATE TO THIS OUTSTANDING REQUEST; &
		!		IF THE RESPONSE WAS 'OTHER', THEN &
		!			STORE THE RESPONSE STRING FOR &
		!			SAFE-KEEPING; &
		!			IF THE FIRST CHARACTER OF THE &
		!			STRING IS A QUOTE, AND THE LAST &
		!			CHARACTER IS A MATCHING QUOTE, &
		!			THEN	REMOVE THE QUOTES. &

23490	RETURN &
		! AND EXIT. &
	&

23500	!	P R O C E S S    R E Q U E S T S &
	&
	! The following routines are the process routines for the &
	! Interrupt Commands.  None of them may effect any change to &
	! R4%.  They may effect R%, R0%(), R%(), and T$.  After &
	! execution of the appropriate routine, the flag in R%(0%) which &
	! caused the execution is reset, so the routine will not be &
	! executed again until some external process causes the flag to &
	! be set again. &
	&
	R0%(0%)=(R0%(0%) AND -3%) OR 16% &
	\ R%=R% AND -145% &
	\ GOTO 23780 &
		! 'CONTINUE' COMMAND : &
		! RESET THE 'CONTINUE LEGAL' FLAG, SET THE &
		! 'PAUSE LEGAL' FLAG, RESET THE 'PAUSE IN EFFECT' FLAG; &
		! SET THE TIME TO 0, SO THE USER IS IMMEDIATELY TOLD &
		! OF ANY FURTHER RESPONSE NEEDED; &
		! AND EXIT. &

23520	IF R0%(2%) THEN &
		T$="?CAN'T DETACH" &
	\	GOSUB 23100 &
	\	R%=R% AND -129% &
	\	GOTO 23780 &
		! 'DETACH' COMMAND : &
		! IF A QUESTION NEEDS ANSWERING, THEN &
		!	DON'T ALLOW DETACH. &

23530	T$="?CAN'T DETACH" &
	\ GOSUB 22600 &
	\ IF E% THEN &
		E%=0% &
	\	GOSUB 23100 &
	\	GOTO 23780 &
		! CALL THE SET UP FOR DETACH ROUTINE; &
		! IF ANY ERROR RETURNED, THEN ISSUE ERROR &
		! MESSAGE. &

23540	GOSUB 23500 &
	\ PRINT #0%,"DETACHING..."+C9$+CHR$(12%) &
	\ Z$=SYS(PRIV.ON$) &
	\ Z$=SYS(C6$+CHR$(7%)+CHR$(128%)) &
	\ Z$=SYS(PRIV.OFF$) &
	\ R0%(0%)=R0%(0%) AND -5% &
	\ GOTO 23780 &
		! DO A 'CONTINUE' OPERATION : &
		! PRINT INFORMATION MESSAGE AND DO THE DETACH; &
		! RESET THE 'DETACHED LEGAL' FLAG. &

23550	R0%(0%)=(R0%(0%) OR 2%) AND -17% &
	\ R%=R% OR 16% &
	\ T$="PAUSING . . ." &
	\ GOSUB 23100 &
	\ GOTO 23780 &
		! 'PAUSE' COMMAND : &
		! MAKE THE 'CONTINUE' COMMAND LEGAL, THE 'PAUSE' COMMAND &
		!	ILLEGAL; &
		! GO ISSUE 'PAUSE' MESSAGE; &
		! RESET TIME TO 0 SO THE USER IS IMMEDIATELY &
		!	INFORMED; &
		! AND EXIT. &

23560	GOSUB 22900 &
	\ GOSUB 23100 &
	\ GOTO 23780 &
		! 'STATUS' COMMAND : &
		! GO SET UP STATUS STRING; &
		! GO PRINT IT TO THE PROPER PLACE; &
		! AND EXIT. &

23570	T$="LAST MESSAGE WAS:"+C9$+R1$ &
	\ R%=R% AND -1537% IF (R% AND 1024%) &
	\ R2$=R1$ &
	\ GOSUB 23100 &
	\ R1$=R2$ &
	\ GOTO 23780 &
		! 'LAST' COMMAND : &
		! SET UP THE TEXT OF THE LAST MESSAGE; &
		! RESET THE 'STORING UNANSWERED REQUEST' FLAG AND &
		!	'NO CR-LF' FLAG, IF THE RESPONSE IS STORED; &
		! GO PRINT IT TO THE PROPER PLACE; &
		! AND EXIT. &

23580	IF (R0%(0%) OR R0%(1%) OR R0%(2%))=0% THEN &
		T$="<NO LEGAL COMMANDS>" &
	  ELSE	T$="LEGAL COMMANDS FOR THIS PHASE/QUESTION ARE:"+ &
			C9$ &
	\	T$=T$+D$(Z0%)+C9$ IF &
			(R0%(D%(Z0%,0%)) AND D%(Z0%,1%))<>0% FOR &
				Z0%=1% TO D%(0%,0%) &
		! 'LEGAL' COMMAND : &
		! SET UP A FLAG WORD FOR THE LEGAL COMMANDS; &
		! IF THE WORD IS NON-ZERO, THEN &
		!	SET UP A HEADER; &
		!	INCLUDE THE COMMAND NAME FROM THE COMMAND NAME &
		!	TABLE FOR EACH COMMAND WHICH IS LEGAL. &

23590	GOSUB 23100 &
	\ GOTO 23780 &
		! PRINT THE RESPONSE IN THE PROPER PLACE; &
		! EXIT. &

23600	IF L0%<0% THEN &
		T$="%'NOTICE' ILLEGAL - NO LIST FILE" &
	\	GOSUB 23100 &
	\	GOTO 23780 &
		! 'NOTICE' COMMAND : &
		! IF NO LIST FILE EXISTS, THEN &
		!	ISSUE AN ERROR MESSAGE. &

23610	T$="***** NOTICE FROM OPERATOR :"+C9$+"***** "+ &
		C$+C9$ &
	\ GOSUB 22720 &
	\ GOTO 23780 &
		! IF THE NOTICE IS LEGAL, THEN &
		!	SET UP A NOTICE STRING; &
		!	GO PRINT IT; &
		!	AND EXIT. &

23780	R%(D%(R4%,0%))=R%(D%(R4%,0%)) AND NOT(D%(R4%,1%)) IF R4% &
		! ALL ROUTINES WHICH DO NOT EFFECT THE PROGRAM'S STATUS &
		! MUST EXIT THROUGH THIS LINE, IN ORDER TO ENSURE THAT &
		! NO EFFECT IS MADE. &
	\ RETURN &
		! AND EXIT. &
	&

23900	DATA	"**DECOP", &
		OFFLINE,	1,	1,	0, &
		ABORT,		1,	1,	0, &
		CONTINUE,	0,	2,	1, &
		DETACH,		0,	4,	2, &
		END,		1,	8,	0, &
		PAUSE,		0,	16,	3, &
		RETRY,		2,	32,	0, &
		SKIP,		2,	64,	0, &
		STATUS,		0,	128,	4, &
		TERMINATE,	1,	256,	0, &
		IGNORE,		2,	512,	0, &
		LAST,		0,	2048,	5, &
		LEGAL,		0,	4096,	6, &
		NOTICE,		0,	8192,	7, &
		**OTHER**,	2,	1024,	0, &
		"**END" &

23910	! ORDER OF DATA : &
	!	COMMAND NAME; &
	!	COMMAND LEVEL : &
	!		0 => PROCESSED ENTIRELY BY THE COMMAND DECODER &
	!		1 => PROCESSED BY THE PROGRAM, BUT STILL AN &
	!			INTERRUPT COMMAND &
	!		2 => LEGAL ONLY AS A RESPONSE TO A REQUEST, NOT &
	!			AN INTERRUPT COMMAND &
	!	FLAG(S) TO SET IN RESPONSE WORD; &
	!	DISPATCH LINE # FOR PROCESS ROUTINE (IF ANY) &
	&

25000	DEF* FNN$(A%)=NUM1$( (A% EQV 32767%) +32768.) &
		! RETURNS AN UNSIGNED INTEGER. &
	&
	&

25100	DEF* FNE$(E%,D%,P3%,P0%,E1%) &
		! TURN A SET OF PARAMETERS INTO AN ERROR MESSAGE. &
		!	E%  - ERROR NUMBER &
		!	D%  - DEPTH &
	&
	\ Z$=N$ &
	\ IF E% THEN &
		Z$="CAN'T FIND FILE" IF (E% AND 63%)=5% &
	\	Z$=CVT$$(RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(E% AND 127%)) &
			,4%),36%) UNLESS LEN(Z$) &
	\	IF P3% THEN &
			Z$=Z$+" IN " &
	\		Z$=Z$+"LIST FILE " IF D%=0% &
	\		Z%=0% &
	\		Z$=Z$+FNU$(P3%,N$,Z%,0%) &
	\		IF P0%=0% THEN &
				GOTO 25130 &
			ELSE	Z$=Z$+" ON " &
	\			D%=D%+1% &
		! IF NO ERROR, DON'T GIVE THE ERROR TEXT; &
		! ELSE, SET UP THE APPROPRIATE. &

25120	Z%=4233% &

25130	Z$=CVT$$(Z$,4%+16%) &
	\ Z$=Z$+" '"+FNU$(P0%,N$,Z%,0%)+"'" IF P0% &
	\ Z$=Z$+", RECORD "+FNN$(E1%) IF E1% AND D%<4% &
	\ Z$="?"+Z$ IF R1% &
	\ FNE$=Z$ &
		! DISCARD TERMINATORS, REDUCE SPACES; &
		! IF THE MESSAGE REQUIRES A RESPONSE, THEN &
		!	PUT ON THE WARNING FLAG. &

25140	FNEND &
		! AND EXIT. &
	&
	&

25200	DEF* FNR%(S$,L%) &
	\ FNR%,Z1%=0% &
	\ Z0%=P% &
	! FUNCTION:	KEYWORD MATCHING ROUTINE. MATCHES A STRING IN &
	!		THE COMMAND STRING C$ STARTING AT POSITION P%+1% &
	!		TO THE DUMMY STRING S$. A MATCH IS MADE WHEN THE &
	!		MINIMUM NUMBER OF CHARACTERS ARE MATCHED. THIS &
	!		MINIMUM NUMBER IS HELD IN THE DUMMY VARIABLE &
	!		L%. &
	! PARAMETERS:	S$	STRING TO MATCH TO. &
	!		L%	MINIMUM LENGTH OF MATCH. &
	! GLOBAL &
	! VARIABLES &
	! AFFECTED:	P%	POSITION POINTER POINTS TO THE LAST CHAR- &
	!			ACTER MATCHED SUCCESSFULLY. &
	! LOCAL &
	! VARIABLES &
	! USED:		Z%	TEMPORARY CHARACTER POINTER. &
	!		Z$	CHARACTER MATCHING VARIABLE FOR PROCESS- &
	!			ING BEYOND THE MINIMUM LENGTH. &
	! RETURNS:	THE NUMBER OF CHARACTERS SUCCESSFULLY MATCHED. &
	! ERRORS:	NONE EXPECTED. &

25210	Z%=ASCII(RIGHT(C$,P%+1%)) &
	\ IF Z%=32% OR Z%=9% THEN P%=P%+1% &
				\ GOTO 25210 &
		! SKIP PAST BLANKS AND TABS. &

25220	IF MID(S$,1%,L%)=MID(C$,P%+1%,L%) THEN Z%=L% &
	ELSE GOTO 25250 &
		! SEARCH FOR MINIMUM MATCH. &

25230	Z$=MID(C$,P%+Z%+1%,1%) &
	\ IF Z$<>MID(S$,Z%+1%,1%) THEN GOTO 25240 &
	  ELSE IF LEN(Z$) THEN &
	    Z%=Z%+1% &
	  \ GOTO 25230 &
		! SEARCH FOR MORE MATCHING CHARACTERS. &

25240	P%=P%+Z% &
	\ FNR%,Z1%=Z% &
		! RETURN WITH P% POINTING TO THE LAST SUCCESSFULLY &
		! MATCHED CHARACTER. FUNCTION WILL RETURN AS THE NUMBER &
		! OF CHARACTERS MATCHED. &

25250	P%=Z0% UNLESS Z1% &
	\ FNEND &
	&

25900	DEF* FNU$(P0%,C$,Z%,Z0%) &
	! FUNCTION :	FNU$	TURN A FILE DESCRIPTOR RECORD INTO &
	!			AN OPENABLE FILENAME STRING. &
	! PARAMETERS :	P0%	RECORD IN WORK-FILE TO CHANGE &
	!		C$	DUMMY STRING TO USE IN CONSTRUCTING &
	!			THE FILENAME STRING. &
	!		Z%	FLAG WORD 2 FORMAT WORD SHOWING WHICH &
	!			FIELDS IN THE RECORD TO CONVERT. &
	!		Z0%	WORD SHOWING WHICH SWITCHES TO CONVERT &
	!			(OF /MODE, /CLU, AND /FILESIZE). &
	! RETURNS :	FUNCTION VALUE &
	!			THE STRING TO USE IN AN OPEN. &
	! USES :	FNU0$(L%) &
	&
	\ Z%=Z% AND Z0%(P0%,14%) &
	\ Z%=Z% AND -3201% IF (Z0%(P0%,13%) AND 1914%) &
		IF Z0%(P0%,14%)>0% &
	\ C$=N$ &
	\ C$="_"+RAD$(Z0%(P0%,6%))+RAD$(Z0%(P0%,7%))+":" IF Z% AND 4096% &
	\ C$=C$+"["+FNU0$(SWAP%(Z0%(P0%,8%)))+","+FNU0$(Z0%(P0%,8%))+"]" &
		IF Z% AND 128% &
	\ C$=C$+RAD$(Z0%(P0%,9%))+RAD$(Z0%(P0%,10%)) IF Z% AND 1% &
	\ C$=C$+"."+RAD$(Z0%(P0%,11%)) IF Z% AND 8% &
	\ C$=C$+"<"+FNU0$(SWAP%(Z0%(P0%,12%)))+">" IF Z% AND 3072% &
	\ Z0%=Z0% AND Z0%(P0%,15%) AND 14336% &
	\ C$=C$+"/CL:"+NUM1$(Z0%(P0%,18%)) IF Z0% AND 2048% &
	\ C$=C$+"/MO:"+NUM1$(Z0%(P0%,16%)) IF Z0% AND 4096% &
	\ C$=C$+"/FI:"+NUM1$(Z0%(P0%,19%)) IF Z0% AND 8192% &
		! CREATE A WORD (Z%) WHICH HAS BITS SET FOR A FIELD ONLY &
		! IF THAT FIELD IS BOTH REQUESTED AND PRESENT IN THE &
		! DATA; &
		! IF DEVICE IS NOT DISK, DT, MT, OR LOGICAL, DO NOT &
		! RETURN FILENAME, EXTENSION; &
		! INITIALIZE THE STRING TO NULL. &
		! &
		! SET UP Z% AS BITS SET IN BOTH THE REQUESTED ENTRY &
		! WORD AND THOSE SET IN THE ACTUAL FILENAME STRING. &
		! IF DEV: REQ/EXSTS, MAKE IT; &
		! IF [PPN] REQ/EXSTS, MAKE IT; &
		! IF FILENAME REQ/EXSTS, MAKE IT; &
		! IF .EXT REQ/EXSTS, MAKE IT; &
		! IF <PROT> REQ/EXSTS, MAKE IT. &
		! &
		! SET UP Z0% TO HOLD ONLY THE FLAGS SET BOTH IN THE &
		! OPERAND IN THE CALL AND IN THE RECORD POINTED TO; &
		! PUT THE "/SWITCH:OPERAND" STRINGS INTO THE RETURNED &
		! STRING IN THE ORDER: &
		!	2048	CLUSTERSIZE &
		!	4096	MODE &
		!	8192	FILESIZE &
	\ FNU$=C$ &
		! SET FUNCTION VALUE. &

25970	FNEND &

25980	DEF* FNU0$(L%) &
	\ L%=L% AND 255% &
	\ IF L%=255% THEN FNU0$="*" ELSE FNU0$=NUM1$(L%) &
		! TAKE THE LOW BYTE OF L%; &
		! IF THAT BYTE IS 255, THEN &
		!	RETURN '*'; &
		! ELSE	RETURN NUM1$ OR BYTE. &

25990	FNEND &
	&
	&
	&

26000	DEF* FNO%(P0%,A0%,C0%) &
	\ FNO%=0% &
		! FUNCTION :	OPEN THE FILE WHOSE NAME IS IN RECORD &
		!		P0% OF THE WORK-FILE, ACCESS TYPE A0%, &
		!		ON CHANNEL C0%, USING SPECIFIED &
		!		CLUSTERSIZE, MODE, FILESIZE, AND &
		!		RECORDSIZE VALUES. &
		! &
		! PARAMETERS : &
		!	P0%	RECORD # OF FILE RECORD IN WORK-FILE &
		!	A0%	ACCESS TYPE : &
		!			1 - READ ONLY &
		!			2 - WRITE ONLY (SUPERSEDE) &
		!			3 - READ/WRITE &
		!			4 - \ PROTECTION &
		!			5 - \ VIOLATION &
		!			6 - OPEN, WRITE-ONLY, FOR EXTEND &
		!			7 - OPEN, READ/WRITE, FOR EXTEND &
		!			8 - OPEN FOR READ-REGARDLESS &
		!				(NO DROP OF PRIVILEGES) &
		!	C0%	CHANNEL ON WHICH TO OPEN IT. &
	&
	\ E%=10% IF ((A0% AND 3%)=2% AND Z0%(P0%,13%)<0%) OR &
			((A0% AND 3%)<2% AND (A0% AND 4%)) &
	\ GOTO 26090 IF E% &
	\ Z0%(P0%,16%)=4096% IF A0%=8% &
	\ IF (A0% AND 4%) THEN &
		A0%=A0% AND 3% &
	\	IF (Z0%(P0%,13%) AND (1%+8%+128%)) THEN &
			Z0%(P0%,15%)=Z0%(P0%,15%) OR 4096% &
	\		Z0%=Z0%(P0%,13%) &
	\		Z%=2% IF (Z0% AND 1%) &
	\		Z%=Z% OR 8192% IF (Z0% AND 8%) &
	\		Z%=128% IF (Z0% AND 128%) &
	\		Z0%(P0%,16%)=Z% &
	\		A0%=3% &
		! IF THIS IS AN ATTEMPT TO SUPERSEDE A FILE ON ANOTHER &
		! ACCOUNT BY A NON-PRIVILEGED USER, GIVE HIM AN ERROR. &
		! THIS CHECK IS NECESSARY TO PREVENT A NON-PRIVILEGED &
		! USER FROM DESTROYING FILES ON OTHER ACCOUNTS TO WHICH &
		! HE HAS WRITE ACCESS. &

26020	ON ERROR GOTO 26070 &
	\ Z$=SYS(PRIV.ON$) IF A0%=8% &
	\ Z$=FNU$(P0%,N$,-1%,-1%) &
	\ Z%=(Z0%(P0%,17%) AND (Z0%(P0%,15%) AND 1024%)<>0%) &
	\ OPEN Z$ FOR INPUT AS FILE C0%, RECORDSIZE Z% IF A0%=1% OR &
			A0%=8% &
	\ OPEN Z$ FOR OUTPUT AS FILE C0%, RECORDSIZE Z% IF A0%=2% &
	\ OPEN Z$ AS FILE C0%, RECORDSIZE Z% IF A0%=3% &
		! SET UP TO TRAP AN OPEN ERROR; &
		! DROP PRIVILEGES, SET UP FILE NAME WITH SWITCHES, SET &
		! UP RECORDSIZE; &
		! GIVE HIM THE KIND OF OPEN HE ASKED FOR: &
		!	READ ONLY	OPEN FOR INPUT &
		!	WRITE ONLY	OPEN FOR OUTPUT &
		!	READ/WRITE	OPEN &

26050	Z$=SYS(PRIV.OFF$) &
	\ ON ERROR GOTO 19000 &
		! RECOVER PRIVILEGES; &
		! RESET ERROR TRAP. &

26060	FNEND &
		! AND EXIT. &

26070	E%=ERR \ RESUME 26090 &
		! &
		!	E R R O R    T R A P &
		! &
		! THIS IS FOR ERRORS TRAPPED IN THE OPEN. &

26090	E%=E% OR 1024% \ GOTO 26050 &
		! SET THE FLAG BIT SAYING 'ON OPEN', AND EXIT. &
	&
	&

26100	DEF* FNA% &
		! RETURN SUBSCRIPT OF NEXT FREE INDEX ENTRY AND ZERO &
		!  THAT ENTRY. &
		! PARAMETERS:	NONE &
		! RETURNS:	SUBSCRIPT OF THE FIRST ENTRY IN THE FREE &
		!		SPACE LIST. &
		! USES:	Z%	LOOP VARIABLE FOR ZEROING &
		! NOTES:	USES FREE LIST POINTER OUT OF THE INDEX FILE &
		!		HEADER TO GET SUBSCRIPT.  IF FL POINTER IS &
		!		NEGATIVE, THAT PART OF THE FILE HAS NOT YET &
		!		BEEN INITIALIZED, AND THE ROUTINE WILL GO TO &
		!		DO IT. THEN THE ENTRY TO BE RETURNED IS ZEROED. &
	&
	\ B0%=Z0%(0%,0%) UNLESS B0% &
	\ Z0%=B0% &
	\ IF Z0%<0% THEN &
		Z0%=-Z0% &
	\	Z0%(Z%,1%)=Z%+1% FOR Z%=Z0% TO Z0%+7% &
	\	Z0%(Z%,1%)=-Z%-1% &
		! GET NEXT FREE LIST ENTRY; &
		! IF SUBSCRIPT IS NEGATIVE, THIS ENTRY HAS NOT YET BEEN &
		! TOUCHED, SO EXTEND A FEW. &

26120	B0%=Z0%(Z0%,1%) &
	\ Z0$(Z0%)=N$ &
	\ FNA%=Z0% &
		! ZERO OUT THE RETURNED ENTRY AND SET FUNCTION VALUE. &

26130	FNEND &
		! END OF FNA%. &
	&

26200	DEF* FNA0%(P0%) &
	&
	\ Z0%,Z2%=P0% &
	\ Z0%=Z0%(Z0%,1%) WHILE Z0%(Z0%,1%) &
	\ FOR Z%=2% TO 5% &
	\	Z2%=P0% &
	\	WHILE Z2% &
	\		IF Z0%(Z2%,Z%) THEN &
				Z3%=Z0%(Z2%,Z%) &
	\			Z0%(Z2%,Z%)=0% &
	\			Z0%,Z0%(Z0%,1%)=Z3% &
	\			Z0%=Z0%(Z0%,1%) WHILE Z0%(Z0%,1%) &

26220			Z2%=Z0%(Z2%,1%) &
	\	NEXT &
	\ NEXT Z% &
	\ Z0%(Z0%,1%)=B0% &
	\ B0%=P0% &
	\ FNA0%=0% &

26230	FNEND &
	&

26300	DEF* FNP0%(B%,L%,D%) &
	! FUNCTION :	FNP0%	PUSH CURRENT LIST AND SET UP LIST &
	!			FROM Z0%(B%,L%).  CLEAR LIST IF D%<>0%. &
	! PARAMETERS :	B%	RECORD NUMBER WHOSE LIST IS TO BE SET UP &
	!		L%	ENTRY NUMBER OF LIST TO SET UP. &
	!		D%	0=>REALLY SET UP LIST &
	!			1=>CLEAR LIST &
	! RETURNS P1% POINTING TO LAST RECORD IN LIST, OR LIST HEADER &
	! (B%) IF NONE. &
	&
	\ S%=S%+1% \ S%(S%)=P1% &
	\ S%=S%+1% \ S%(S%)=Z0%(B%,1%) &
	\ S%=S%+1% \ S%(S%)=L% &
	\ S%=S%+1% \ S%(S%)=B% &
	\ P1%=Z0%(B%,L%) &
	\ P1%=FNA0%(P1%) IF P1% AND D%<>0% &
	\ Z0%(B%,1%)=P1% &
	\ P1%=B% &
	\ P1%=Z0%(P1%,1%) WHILE Z0%(P1%,1%) &
	\ FNP0%=B% &
	! PUSH CURRENT LIST, LIST NUMBER TO SET UP, AND CURRENT BASE; &
	! CLEAR LIST IF REQUESTED AND SET UP LIST; SET UP END OF LIST &
	! POINTER. &

26320	FNEND &
	! AND EXIT. &
	&
	&

26450	DEF* FNP1% &
	! FUNCTION :	FNP1%	RESTORE ORIGINAL LIST FROM DATA ON STACK &
	! PARAMETERS :	NONE &
	&
	\ Z%=S%(S%) \ S%=S%-1% &
	\ Z0%(Z%,S%(S%))=Z0%(Z%,1%) &
	\ Z0%(Z%,1%)=S%(S%-1%) &
	\ P1%=S%(S%-2%) &
	\ S%=S%-3% &
	\ FNP1%=Z% &
	! PUT NEW LIST WHERE IT BELONGS; RESTORE OLD LIST; POP ALL &
	! THREE VALUES; SET VALUE TO OLD BASE. &

26470	FNEND &
	! AND EXIT. &
	&
	&

31000	&
	&
	&
	!	C H A I N    E N T R Y &
	&
	E0%=2% &
	\ C$=SYS(CHR$(7%)) &
	\ B%=CVT$%(C$) &
	\ W$=RIGHT(C$,3%) &
	\ GOTO 1000 &
		! TAKE THE BASE FHR AND THE WORK-FILE &
		! NAME OUT OF CORE COMMON AND GO TO WORK. &
	&

32700	Z$=SYS(PRIV.ON$) &
	\ Z$=SYS(C6$+CHR$(8%)+CHR$(J%)+STRING$(24%,0%)+CHR$(-1%)) UNLESS &
			J%=0% OR (R% AND 16384%) &
		! KILL OURSELVES IF WE ARE DETACHED. &

32767	END
