2!		PROGRAM		: SPOOL .BAS
5!		VERSION		: V10.1
6!		EDIT		: A
7!		EDIT DATE	: 10-MAY-91
8!
10		EXTEND
11	! &
	&
	&
	!		  C O P Y R I G H T &
	&
	&
  !		      Copyright (C) 1974, 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 &
	&
	&

21	! VER/ED	EDIT DATE	REASON &
	! KMF 01	21-MAY-84	ADD PRIV CHECK &
	! JAC 02	14-SEP-84	FIX PRIV CHECK &
	! REG 03	25-SEP-86	LOCATE .WRK FILES IN OPSER$: &
	! &

100	! &
	&
	&
	!	G E N E R A L    D E S C R I P T I O N &
	&
	&
	&
	! THIS IS THE INITIALIZATION PROGRAM FOR THE 'SPOOL' PACKAGE. &
	! IT IS VERY SIMILAR TO THE PROGRAM USED FOR THE BATCH PACKAGE, &
	! BUT THERE ARE DIFFERENCES.  THE MAIN FUNCTION OF THIS PROGRAM &
	! IS TO SET UP A WORK-FILE FOR THE PACKAGE TO USE. &
	&

300	! &
	&
	&
	!	I / O    C H A N N E L S &
	&
	&

301!	CHANNEL #		USED FOR &
   !
400	! &
	&
	&
	!	V A R I A B L E    D E F I N I T I O N S &
	&
	&

401!	VARIABLE NAME		USED FOR &
   !
800	! &
	&
	&
	!	F U N C T I O N / S U B R O U T I N E    D E S C . &
	&
	&

801!	FUNCTION/SUBROUTINE		USE &
   !	&
	&
	&

830	! &
	&
	!	P A C K A G E    S U B R O U T I N E S &
	&
	! Name			Lines		Use
840	! &
	&
	!	P A C K A G E    F U N C T I O N S &
	&
	! Name			Lines		Use &
	! 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. &
	! FNCHNGE%(S$)		27000-27020	CHANGE THE STRING S$ &
	!					INTO THE INTEGER ARRAY &
	!					Z%(), PADDING TO 30 CHRS &
	!					WITH 0'S AND CONVERT &
	!					EACH TWO BYTES TO ONE &
	!					INTEGER IN THE ODD &
	!					WORDS. &
	! FNN%			27200-27250	RETURN THE UNSIGNED &
	!					INTEGER IN THE STRING C$ &
	!					AT POSITION P%+1%. &
	&

900	&
	&
	&
	!	D I M E N S I O N    S T A T E M E N T S &

901	DIM #1%,Z0%(32767%,63%) &
	\ DIM #1%,Z0$(32767%)=128% &
				! WORK-FILE, PRIMARY.
902	DIM #1%,Z1$(3%)=256%,Z2$(32767%)=128% &
				! SET UP THE NECESSARY STORAGE &
				!  LOCATIONS FOR THE LONG &
				!  STRINGS.
903	DIM S%(30%)		! INTERNAL STACK.
904	DIM M0%(30%)		! USED IN THE ASSIGN A DEVICE ROUTINE. &

950	!	DIMENSION STATEMENTS FOR STANDARD ROUTINES
951	DIM Z%(30%)		! USED BY FNP%() FOR RETURN OF DATA
952	DIM Z1%(30%)		! USED BY FNP%() FOR TEMPORARY STORAGE &
				! OF DATA. &
	&
	&
	&

999	&
	&
	&
	!	M A I N    C O D E &

1000	ON ERROR GOTO 19000 &
	\ UU1$=CHR$(6%)+CHR$(26%)+CHR$(0%)+CHR$(1%) &
	\ UU0$=CHR$(6%)+CHR$(26%)+CHR$(0%)+CHR$(0%) &
		! SET UP STANDARD ERROR TRAP. &

1010	I$="V10.1-A" &
		! SET UP HEADER LINE. &

1020	IF E0%=0% THEN &
		S$=CVT$$(RIGHT(SYS(CHR$(6%)+CHR$(9%)),3%),4%) &
	\	PRINT IF CCPOS(0%) &
	\	PRINT "SPOOL	"+I$+"	"+S$ &
		! IF THE ENTRY WAS A 'RUN' ENTRY, THEN &
		!	SET UP AND PRINT THE HEADER LINE. &
	&

1022	PRIV%=FNPRV%("SWCFG",-1%) &
	\ IF PRIV%=0% THEN &
		PRINT IF CCPOS(0%) &
		\ PRINT "?SWCFG privilege required" &
		\ GOTO 32767 &
		! MUST BE PRIVILEGED TO RUN SPOOL.BAS &

1030	CHANGE SYS(CHR$(12%)) TO Z% &
	\ PKG.LOC$="OPSER$:" &
	\ IF Z%(3%)+SWAP%(Z%(4%))<>15%*2% THEN &
		PRINT "?SPOOL must be COMPILED" &
	\	GOTO 32767 &
		! USE LOGICAL FOR THE PACKAGE LOCATION &
		! IF IT WAS NOT A COMPILED FILE THEN PRINT ERROR. &

1620	S$="SPOOL	"+I$ &
	\ CHR0$=CHR$(0%) &
	\ CHR10$=CHR$(10%) &
	\ CHR12$=CHR$(12%) &
	\ CHR13$=CHR$(13%) &
	&
	\ CHR6$=CHR$(6%) &
	\ CHR7$=CHR$(7%) &
	\ CHR6.M10$=CHR6$+CHR$(-10%) &
	\ CHR6.9$=CHR6$+CHR$(9%) &
	\ CHR6.M21.M1$=CHR6$+CHR$(-21%)+CHR$(-1%) &
	\ CHR6.M21.0$=CHR6$+CHR$(-21%)+CHR0$ &
	\ CHR6.18.M1.0$=CHR6$+CHR$(18%)+CHR$(-1%)+CHR0$ &
	\ CHR192$=CHR$(128%+64%) &
	\ CVT00$=CVT%$(0%) &
	&
	\ NULSTG$="" &
	&
	&

2000	&
	&
	&
	!	S E T    U P    F O R    P R O C E S S I N G &
	&

2010	IF E0%=2% THEN &
		GOTO 32700 IF FATAL.ERR% &
	\	GOSUB 20000 &
	\	IF (R% AND 64%)<>0% OR FATAL.ERR% THEN &
			GOTO 32700 &
		ELSE	GOTO 2030 &
		! IF THE ENTRY WAS A CHAIN, THEN &
		!	OPEN THE WORK-FILE; &
		!	IF THE PACKAGE STATUS INDICATES THAT AN &
		!	 END WAS REQUESTED, THEN &
		!		END PROCESSING; &
		!	ELSE	SET UP FOR NEW PROCESSING. &

2020	K1%=-1% &
	\ J%=(PEEK(518%) AND 255%)/2% &
	\ J$=NUM1$(J%) &
	\ J$="0"+J$ UNTIL LEN(J$)>2% &
	\ W$="SPL"+J$+".WRK" &
	\ J1%=SWAP%(CVT$%(MID(SYS(UU1$),25%,2%))) &
	\ A%=SWAP%(CVT$%(MID(SYS(UU0$),21%,2%))) &
	\ Z$=NUM1$(SWAP%(A%) AND 255%) \ Z$=" "+Z$ UNTIL LEN(Z$)>2% &
	\ A$="["+Z$+"," &
	\ Z$=NUM1$(A% AND 255%) \ Z$=" "+Z$ UNTIL LEN(Z$)>2% &
	\ A$=A$+Z$+"]" &
	\ W$=PKG.LOC$+W$ &
	\ K0%=PEEK(J1%) &
	\ OPEN W$ FOR OUTPUT AS FILE 1% &
		! SET THE LIST DEVICE TO -1 SO NO OPEN IS ATTEMPTED; &
		! SET UP THE JOB NUMBER IN J% AND J$; &
		! SET UP THE FIRST PART OF THE WORK-FILE NAME; &
		! NOW, GET THE ACCOUNT NUMBER UNDER WHICH WE ARE RUNNING &
		!  INTO BOTH A% AND A$ (A$ HAS THE FORM "[XXX,XXX]"); &
		! THEN APPEND IN THE 'SY:' AND THE ACCOUNT NUMBER INTO &
		!  THE WORK-FILE NAME; &
		! FINALLY, LOOK UP THE ADDRESS OF THE I/O BLOCK FOR THIS &
		!  JOB AND STORE IT IN J1%. &

2030	Z0$(0%)="" &
	\ Z0%(0%,26%)=16384% &
	\ Z0%(0%,0%)=-1% &
	\ CLOSE 1% &
	\ GOSUB 20000 &
	\ P0%=0% &
	\ WHILE P0%=0% OR (P0%/4%)*4%<>P0% &
	\	P1%=P0% &
	\	P0%,Z0%(P0%,1%)=FNA% &
	\ NEXT &
	\ Z0%(P1%,1%)=0% &
	\ P0%,Z0%(P0%,1%)=FNA% FOR P1%=1% TO 9% &
	\ Z0%(0%,1%)=FNA0%(Z0%(0%,1%)) IF Z0%(0%,1%)<>0% &
	\ GOSUB 10000 &
	\ ON ERROR GOTO 19000 &
	\ P0%=FNA% &
	\ Z%=FNP%(P0%,0%,W$,0%,0%) &
	\ Z0%(0%,12%)=P0% &
	\ P0%=FNA% &
	\ P1%=FNA% &
	\ Q9%,Z0%(0%,4%)=P0% &
		! CREATE THE WORK-FILE : &
		!	OPEN IT &
		!	ZERO OUT THE FIRST RECORD &
		!	SET THE 'PACKAGE STATUS' ADDRESS IN THE FILE TO &
		!	 'ATTACHED'; &
		!	SET THE FREE-LIST POINTER TO POINT TO THE FIRST &
		!	 RECORD; &
		!	CLOSE IT OUT; &
		! CALL THE STANDARD SET-UP ROUTINE TO GET EVERYTHING SET &
		!  UP PROPERLY; &
		! SET UP 10 CONTIGUOUS RECORDS FOR STRING STORAGE; &
		! CALL THE SET-UP FOR GCML; &
		! MAKE A RECORD IN THE FILE HOLDING THE NAME OF THE &
		!  FILE, IN ORDER TO ALLOW THE NAME/CHARACTERISTICS TO &
		!  BE CHANGED; &
		! SET UP A RECORD TO LOAD WITH THE DESTINATION DEVICE &
		!  INFORMATION; &
		! SET UP A WORK RECORD TO USE; &
		! PLUG THE DESTINATION VOLUME RECORD ADDRESS INTO THE &
		!  FILE HEADER RECORD. &
	&
	&
	&

4000	&
	&
	&
	!	G E T    A N D    P A R S E    I N P U T    L I N E &
	&

4010	E%=0% \ P0$="#" \ P1$="MORE>	" &
	\ GOSUB 10100 &
	\ ON ERROR GOTO 19000 &
	\ IF E%<>0% THEN &
		GOTO 32700 IF E%=11% &
	\	GOTO 19020 &
		! RESET THE ERROR FLAG, SET UP THE PROMPTS AND CALL THE &
		!  GCML ROUTINE; &
		! IF AN ERROR IS RETURNED, THEN &
		!	GOTO CLOSE OUT IF THE ERROR IS EOF; &
		!	OTHERWISE, GOTO THE ERROR HANDLER. &

4020	DEFACT%=A% &
		! SET THE DEFAULT ACCOUNT TO CHARGE TO THE CURRENT &
		!  ACCOUNT. &

4030	P%=FNP%(P0%,0%,C$,4095%,16375%) &
	\ GOTO 4150 IF E%<>0% OR Z0%(P0%,14%)=0% &
	\ PHYSD1%=Z0%(P0%,6%) \ PHYSD2%=Z0%(P0%,7%) &
	\	PHYDHI%=Z0%(P0%,13%) \ PHYFLG%=Z0%(P0%,15%) &
	\	PHYMOD%=Z0%(P0%,16%) \	PHYCLU%=Z0%(P0%,18%) &
	\	PHYSIZ%=Z0%(P0%,19%) &
		! DO THE FILENAME STRING SCAN ON THE INPUT STRING; &
		! MUST BE ONLY A DEVICE (AND MODE, CLUSTERSIZE, &
		!  FILESIZE), AND THE DEVICE MUST BE LP: OR KB:; &
		! TAKE THE DEFAULTS FOR THE LOGICAL AND PHYSICAL DEVICE &
		!  OUT OF THE SCANNED STRING. &

4040	Z$=RAD$(PHYSD1%)+RAD$(PHYSD2%) &
	\ Z0$,Z1$="" &
	\ Z%=0% &
	\ WHILE Z%<LEN(Z$) &
	\	Z2$=MID(Z$,Z%+1%,1%) &
	\	Z0%=ASCII(Z2$) &
	\	WHILE Z0%>64% &
	\		Z0$=Z0$+Z1$+Z2$ &
	\		Z1$="" &
	\		Z0%=0% &
	\	NEXT &
	\	WHILE Z0%>47% AND Z0%<58% &
	\		Z1$=Z1$+Z2$ &
	\		Z0%=0% &
	\	NEXT &
	\	GOTO 4150 IF Z0%<>0% AND Z0%>32% &
	\	Z%=Z%+1% &
	\ NEXT &
	\ Z0%=255% &
	\ Z0%=VAL(Z1$) IF LEN(Z1$)>0% &
	\ GOTO 4150 IF LEN(Z0$)<1% OR (Z0%>7% AND Z0%<>255%) &
	\ UNITNO%=(LEN(Z1$)<>0%) &
	\ UNITN0%=Z0% &
	\ Z%=FNP%(P1%,0%,Z0$,0%,0%) &
	\ GOTO 4150 IF E%<>0% &
	\ LOGDV1%=Z0%(P1%,9%) \ LOGDV2%=Z0%(P1%,10%) &
		! NOW, HAVE TO FIND THE LOGICAL DEVICE NAME OUT OF THE &
		!  SPECIFIED DEVICE : &
		!	SET UP THE PHYSICAL DEVICE STRING (W/OUT :) &
		!	Z0$ AND Z1$ ARE TO BE HOLDERS FOR THE NON-UNIT &
		!	 NUMBER PART AND THE UNIT NUMBER PART OF THE &
		!	 LOGICAL DEVICE, RESP - START THEM AT NULL; &
		!	SET UP THE POSITION POINTER; &
		!	WHILE STILL IN THE STRING : &
		!		HOLD THE CURRENT CHAR AND ITS ASCII VALUE; &
		!		WHILE THE ASCII VALUE FALLS IN THE &
		!		 NON-NUMERIC RANGE : &
		!			APPEND BOTH WHATEVER CHARS WERE &
		!			 PRECEDING THIS ONE IN THE &
		!			 STRING AND THE NEW CHR; &
		!			NULL OUT THE NUMERIC STRING; &
		!			RESET THE ASCII VALUE SO IT &
		!			 DROPS THROUGH; &
		!		EXIT; &
		!		APPEND THE NEW CHR TO THE NUMERIC STRING &
		!		 IF IT IS IN THE NUMERIC RANGE; &
		!		INCREMENT THE CURRENT POSITION POINTER; &
		!	NEXT &
		!	NOW, SET UP THE UNIT NUMBER, IF ANY - OTHERWISE, &
		!	 255=>*; &
		!	GO ISSUE AN ERROR IF THERE IS NO STRING PART OR &
		!	 IF THE UNIT NUMBER IS OUT OF RANGE; &
		!	SET THE 'UNIT NUMBER SPECIFIED' FLAG AND THE &
		!	 UNIT NUMBER VALUE; &
		!	NOW, NEED TO GET THE RAD50 INTEGERS FOR THE &
		!	 STRING PART - SO CALL THE FSS FUNCTION AND TAKE &
		!	 THE VALUES OUT OF THE WORK RECORD. &

4050	PRIOR%,RUNBST%,PHYSDV%,LOGFLE%,LOGID%,ASSGN%,NOTE%,FORM%, &
		HEADNG%,ALIGN%,LNGTH%,WIDTH%,QUEUE%,DELET%,LPFORM%, &
		TOLF%,TOLFST%,TOPFST%,SKPSIX%,DFLEN%=0% &
	\ TOPF0%,DELET0%,QUEUE0%,ASSGN0%=0% &
	\ HEADN0%,COPYC0%=1% &
	\ PRIOR0%=-8% &
	\ RUNBS0%=6% &
	\ LNGTH0%,DFLEN0%=66% &
	\ WIDTH0%=132% &
		! INITIALIZE ALL THE FLAG VARIABLES TO 0; &
		! INITIALIZE THE 'TOP OF PHYSICAL FORM', 'DELETE AFTER &
		!  PRINT', 'QUEUE UPON COMPLETION', AND 'ASSIGN' VALUES &
		!  TO THEIR DEFAULTS ('NO' FOR ALL); &
		! SET THE DEFAULT HEADING COUNT, COPY COUNT TO 1, &
		!  PRIORITY TO -8, RUN BURST TO 6, FORM LENGTH TO 66, &
		!  AND FORM WIDTH TO 132. &

4100	&
	&
	&
	!	G E T    A N D    P R O C E S S    S W I T C H E S &
	&

4110	Z%=FNPUSH%(P%) &
	\ IF FNR%("/",1%)=0% THEN &
		GOTO 5150 &
	  ELSE	GOTO 4210 IF FNR%("PRIORITY",3%)<>0% &
	\	GOTO 4220 IF FNR%("RUNBURST",3%)<>0% &
	\	GOTO 4230 IF FNR%("PHYSICAL",3%)<>0% &
	\	GOTO 4240 IF FNR%("NAME",3%)<>0% &
	\	GOTO 4250 IF FNR%("ASSIGN",3%)<>0% &
	\	GOTO 4300 IF FNR%("FORM",3%)<>0% &
	\	GOTO 4260 IF FNR%("HEADINGS",3%)<>0% &
	\	GOTO 4270 IF FNR%("ALIGN",3%)<>0% &
	\	GOTO 4280 IF FNR%("LENGTH",3%)<>0% &
	\	GOTO 4290 IF FNR%("WIDTH",3%)<>0% &
	\	GOTO 4320 IF FNR%("LPFORM",3%)<>0% &
	\	GOTO 4330 IF FNR%("PAGE_EJECT",3%)<>0% &
	\	GOTO 4340 IF FNR%("DFLENGTH",3%)<>0% &
	!\	GOTO <LOGFLE> IF FNR%("LOG",3%)<>0% &
	!\	GOTO <NOLGFL> IF FNR%("NOLOG",5%)<>0% &
	!\	GOTO <NOQUE> IF FNR%("NOQUEUE",5%)<>0% &
	!\	GOTO <QUEUE> IF FNR%("QUEUE",3%)<>0% &
	!\	GOTO <DELETE> IF FNR%("DELETE",3%)<>0% &
	!\	GOTO <NODEL> IF FNR%("NODELETE",5%)<>0% &
		! STORE THE CURRENT POSITION IN CASE A VALID SWITCH IS &
		!  NOT FOUND; &
		! IF THE NEXT CHR IS A SLASH, THEN &
		!	CHECK FOR ALL POSSIBLE SWITCHES. &

4120	GOTO 5150 &
		! GO TO ALL DONE. &

4150	&
	!	ILLEGAL LOGICAL DEVICE ERROR &

4160	T$="?Illegal Logical Device -"+C9$+C$ &
	\ GOSUB 23500 &
	\ GOTO 4000 &
		! NO TELLING WHERE THE DEVICE NAME IS AVAILABLE, SO &
		!  USE THE WHOLE STRING. &
	&

4200	&
	&
	&
	!	S W I T C H    P R O C E S S I N G &
	&
	&

4210	T$="Priority" &
	\ GOTO 5050 IF NOT FNPRV%("TUNE",-1%) &
	\ GOTO 5010 IF PRIOR%<>0% &
	\ PRIOR%=-1% &
	\ PRIOR0%=0% &
	\ GOTO 5110 UNLESS FNR%(":",1%)<>0% &
	\ DATWR0%=FNR%("+",1%) &
	\ DATWR0%=-FNR%("-",1%) UNLESS DATWR0%<>0% OR E%<>0% &
	\ DATWRD%=FNN% UNLESS E%<>0% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%>120% &
	\ DATWRD%=DATWRD%*DATWR0% IF DATWR0%<>0% &
	\ PRIOR0%=DATWRD% &
	\ GOTO 5110 &
		! SET UP THE NAME OF THE SWITCH IN CASE AN ERROR NEEDS &
		!  TO BE ISSUED; &
		! SET AN ERROR IF /PRIORITY WITH NO TUNE PRIVILEGE &
		! SET AN ERROR IF THE SWITCH HAS BEEN GIVEN BEFORE; &
		! GO GET THE NEXT SWITCH IF NO ":" IS FOUND (THE DEFAULT &
		!  IS 0); &
		! OTHERWISE, CHECK FOR A +/-; &
		! GET THE FOLLOWING INTEGER; &
		! GO TO ISSUE AN ERROR IF THE OPERAND ISN'T THERE OR IF &
		!  THE OPERAND IS OUT OF RANGE; &
		! OTHERWISE, SET UP THE PRIORITY VALUE; &
		! GO GET THE NEXT SWITCH. &

4220	T$="Runburst" &
	\ GOTO 5050 IF NOT FNPRV%("TUNE",-1%) &
	\ GOTO 5010 IF RUNBST%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNN% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%<1% OR DATWRD%>100% &
	\ RUNBST%=-1% &
	\ RUNBS0%=DATWRD% &
	\ GOTO 5110 &
		! SET UP THE NAME IN CASE OF ERROR; &
		! SET AN ERROR IF /RUNBURST WITH NO TUNE PRIVILEGE &
		! SET AN ERROR IF THE SWITCH HAS BEEN GIVEN BEFORE; &
		! GO ISSUE AN ERROR IF NO COLON APPEARS (THERE IS NO &
		!  PARTIAL DEFAULT); &
		! GET THE INTEGER, AND ISSUE AN ERROR IF IT IS OUT OF &
		!  BOUNDS; &
		! OTHERWISE, SET THE VALUE INTO THE RUN BURST HOLDER; &
		! GO GET THE NEXT SWITCH. &

4230	T$="Physical Device Specification" &
	\ GOTO 5010 IF PHYSDV%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ P%=FNP%(P1%,P%,C$,4095%,16373%) &
	\ PHYSDV%=-1% &
	\ PHYSD1%=Z0%(P1%,6%) \ PHYSD2%=Z0%(P1%,7%) &
	\ GOTO 5040 IF E% &
	\	PHYDHI%=Z0%(P1%,13%) &
	\	DATWRD%=Z0%(P1%,15%) &
	\	PHYMOD%=Z0%(P1%,16%) IF (DATWRD% AND 4096%)<>0% &
	\	PHYCLU%=Z0%(P1%,18%) IF (DATWRD% AND 2048%)<>0% &
	\	PHYSIZ%=Z0%(P1%,19%) IF (DATWRD% AND 8192%)<>0% &
	\	PHYFLG%=PHYFLG% OR DATWRD% &
	\ GOTO 5110 &
		! SET UP THE SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE; &
		! ISSUE ERROR IF NO ":"; &
		! DO A FILENAME STRING SCAN ON THE OPERAND, ALLOWING &
		!  ONLY DEVICE NAME (AND MODE, CLUSTERSIZE, AND FILE- &
		!  SIZE VALUES), AND RESTRICTING THE DEVICE TO LINE- &
		!  PRINTER OR KB:; &
		! ISSUE AN ERROR, IF ENCOUNTERED; &
		! OTHERWISE, SET UP THE NEW PHYSICAL DEVICE AND GO GET &
		!  THE NEXT SWITCH. &

4240	T$="Logical ID" &
	\ GOTO 5010 IF LOGID%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ P%=FNP%(P1%,P%,C$,-2%,0%) &
	\ GOTO 5030 IF E%<>0% &
	\ Z%=ASCII(RAD$(Z0%(P1%,9%))) &
	\ GOTO 5030 IF Z%>47% AND Z%<58% &
	\ LOGID1%=Z0%(P1%,9%) \ LOGID2%=Z0%(P1%,10%) \ LOGID%=-1% &
	\ GOTO 5110 &
		! SET UP NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF THE SWITCH HAS ALREADY BEEN SPECIFIED &
		!  ONCE; &
		! ISSUE ERROR IF THE SWITCH HAS NO OPERAND; &
		! DO A FILENAME STRING SCAN ON THE OPERAND, ALLOWING &
		!  ONLY A FILENAME TO APPEAR; &
		! ISSUE ERROR IF ENCOUNTERED; &
		! OTHERWISE, SET UP THE LOGICAL ID AND GO GET NEXT &
		!  SWITCH. &

4250	T$="Assign" &
	\ GOTO 5010 IF ASSGN%<>0% &
	\ ASSGN%=-1% &
	\ ASSGN0%=NOT(32767%) &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF SWITCH HAS ALREADY BEEN SPECIFIED; &
		! OTHERWISE, SET THE ASSIGN FLAG AND GO GET NEXT SWITCH. &

4260	T$="Headings" &
	\ GOTO 5010 IF HEADNG%<>0% &
	\ HEADNG%=-1% &
	\ HEADN0%=1% &
	\ GOTO 5110 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNN% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%<0% OR DATWRD%>3% &
	\ HEADN0%=DATWRD% &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IS DUPLICATE; &
		! OTHERWISE, SET UP THE HEADINGS FLAG, HEADINGS VALUE; &
		! DONE IF NO : FOUND; &
		! OTHERWISE, CHECK OPERAND, AND ISSUE ERROR IF NO GOOD &
		!  OR OUT OF BOUNDS; &
		! SET HEADING VALUE AND GO GET NEXT SWITCH. &

4270	T$="Align" &
	\ GOTO 5010 IF ALIGN%<>0% &
	\ ALIGN%=-1% &
	\ ALIGN0%=-1% &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE; &
		! OTHERWISE, SET UP THE ALIGN FLAG, ALIGN VALUE; &
		! GO GET THE NEXT SWITCH. &

4280	T$="Length" &
	\ GOTO 5010 IF LNGTH%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNN% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%<1% OR DATWRD%>127% &
	\ LNGTH%=-1% &
	\ LNGTH0%=DATWRD% &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE OR NO OPERAND; &
		! OTHERWISE, GET THE OPERAND; &
		! ISSUE ERROR IF NOT INTEGER OR OUT OF BOUNDS; &
		! SET THE LENGTH FLAG, LENGTH VALUE; &
		! GO GET THE NEXT SWITCH. &

4290	T$="Width" &
	\ GOTO 5010 IF WIDTH%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNN% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%<1% OR DATWRD%>510% &
	\ WIDTH%=-1% &
	\ WIDTH0%=DATWRD% &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE OR NO OPERAND; &
		! OTHERWISE, GET THE OPERAND; &
		! ISSUE ERROR IF NOT INTEGER OR OUT OF BOUNDS; &
		! OTHERWISE, SET THE WIDTH FLAG, WIDTH VALUE; &
		! GO GET NEXT SWITCH. &

4300	T$="Form Name" &
	\ GOTO 5010 IF FORM%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ P%=FNP%(P1%,P%,C$,-2%,0%) &
	\ GOTO 5030 IF E%<>0% OR (Z0%(P1%,14%) AND 1%)=0% &
	\ FORM%=-1% \ FORM1%=Z0%(P1%,9%) \ FORM2%=Z0%(P1%,10%) &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE OR NO OPERAND; &
		! OTHERWISE, DO A FILENAME STRING SCAN ON OPERAND; &
		! ISSUE ERROR IF ILLEGAL FILENAME OR NONE IN STRING; &
		! OTHERWISE, SET THE FORM FLAG, FORM VALUE; &
		! GO GET NEXT SWITCH. &

4310	T$="Note" &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ NOTE%=-1% &
	\ DATWR0%=INSTR(P%+1%,C$,"/")-1% &
	\ DATWR0%=LEN(C$) UNLESS DATWR0%>0% &
	\ C0$=C$ &
	\ C$=MID(C$,P%+1%,DATWR0%-P%) &
	\ P%=DATWR0% &
	\ Z%=FNPUSH%(P1%) &
	\ Z0%(P0%,1%)=Z0%(P0%,5%) &
	\ P1%=13% &
	\ GOSUB 20750 &
	\ P1%=FNPOP% &
	\ Z0%(P0%,5%)=Z0%(P0%,1%) &
	\ Z0%(P0%,1%)=0% &
	\ C$=C0$ &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF NO OPERAND FOUND; &
		! OTHERWISE, SET THE NOTE FLAG; &
		! SEARCH FOR THE TERMINATING / OR END OF &
		!  STRING; &
		! SET UP TO AND DO THE LOAD OF THE STRING INTO THE &
		!  WORK-FILE; &
		! GO GET THE NEXT SWITCH. &

4320	T$="LPForm" &
	\ GOTO 5010 IF LPFORM%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNYES.NO% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%=0% &
	\ LPFORM%=1% &
	\ LPFOR0%=(DATWRD%-1%)*512% &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE OR NO OPERAND; &
		! OTHERWISE, LOOK FOR A 'YES' OR 'NO' OPERAND; &
		! ISSUE ERROR IF NOT FOUND; &
		! SET THE LPFORM FLAG, LPFORM VALUE, AND THE TWO BIT IN &
		!  THE VALUE TO PROVE THAT IT WAS SPECIFIED; &
		! GO GET THE NEXT SWITCH. &

4330	T$="Page_Eject" &
	\ GOTO 5010 IF TOLF%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNYES.NO% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%=0% &
	\ TOLF%=1% &
	\ TOLF0%=(DATWRD%-1%)*4096% &
	\ GOTO 5110 &
		! SET UP SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE OF NO OPERAND; &
		! OTHERWISE, LOOK FOR A 'YES' OR 'NO' OPERAND; &
		! ISSUE ERROR IF NOT FOUND; &
		! OTHERWISE, SET THE TOLF FLAG, TOLF VALUE, AND THE TWO &
		!  BIT IN THE VALUE TO PROVE THAT IT WAS SPECIFIED; &
		! GO GET THE NEXT SWITCH. &

4340	T$="DFLength" &
	\ GOTO 5010 IF DFLEN%<>0% &
	\ GOTO 5020 UNLESS FNR%(":",1%)<>0% &
	\ DATWRD%=FNN% &
	\ GOTO 5030 IF E%<>0% OR DATWRD%<1% OR DATWRD%>127% &
	\ DFLEN%=1% &
	\ DFLEN0%=DATWRD% &
	\ GOTO 5110 &
		! SET UP THE SWITCH NAME IN CASE OF ERROR; &
		! ISSUE ERROR IF DUPLICATE OR NO OPERAND; &
		! OTHERWISE, LOOK FOR A NUMBER OPERAND; &
		! ISSUE ERROR IF NONE OR OUT OF RANGE; &
		! SET THE 'DFLEN SPECIFIED' FLAG AND THE VALUE; &
		! GO GET THE NEXT SWITCH. &
	&

5000	&
	&
	&
	!	E R R O R    I N    S W I T C H &
	&

5010	T$="Duplicate Switch - "+T$ &
	\ GOTO 5090 &
		! DUPLICATE SWITCH. &

5020	T$="Missing Operand in "+T$ &
	\ GOTO 5090 &
		! MISSING OPERAND. &

5030	T$="Illegal Operand for "+T$ &
	\ GOTO 5090 &
		! ILLEGAL OPERAND. &

5040	T$="Illegal Physical Device" &
	\ GOTO 5090 &
		! ILLEGAL DEVICE - NOT LP: OR KB:. &

5050	T$="TUNE privilege required for "+T$ &
	\ GOTO 5090 &
		! NOT ENUF PRIVILEGE TO SPECIFY /PRIORITY OR /RUNBURST &

5090	P%=FNPOP% &
	\ T$="?"+T$+C9$+RIGHT(C$,P%+1%) &
	\ GOSUB 23500 &
	\ GOTO 4000 &
		! POP THE POINTER OFF THE STACK; &
		! PUT A ? AT THE BEGIN OF THE ERROR MESSAGE; &
		! ISSUE THE MESSAGE; &
		! GO TRY AGAIN FOR A LINE. &
	&
	&
	&

5100	&
	&
	&
	!	C L E A N    U P    F R O M    C O M M A N D &
	!		P R O C E S S I N G &
	&

5110	Z%=FNPOP% \ GOTO 4100 &
		! POP THE OLD VALUE OF THE CURRENT POINTER OFF THE &
		!  STACK AND GO LOOK FOR ANOTHER SWITCH. &

5150	P%=FNPOP% &
	\ IF P%<LEN(C$) THEN &
		T$="?Can't parse remaining string"+C9$+RIGHT(C$,P%+1%) &
	\	GOSUB 23500 &
	\	GOTO 4000 &
		! POP THE CURRENT POSITION OFF THE STACK; &
		! IF THE PARSE DID NOT PROCESS THE WHOLE STRING, THEN &
		!	SET UP AND ISSUE AN ERROR MESSAGE TO THAT EFFECT &
		!	 AND GO TRY AGAIN. &

5160	IF (PHYDHI% AND 10%)=0% THEN &
		Z%=FNPUSH%(0%) \ GOTO 5040 &
		! IF THE PHYSICAL DEVICE EITHER WAS NOT SPECIFIED OR WAS &
		!  SPECIFIED ILLEGALLY, THEN &
		!	SET UP AN ERROR AND GO ISSUE IT. &
	&

6000	&
	&
	&
	!	S E T    U P    D E F A U L T S &
	&

6010	IF FORM%=0% THEN &
		Z%=FNP%(P1%,0%,"NORMAL",0%,0%) &
	\	FORM1%=Z0%(P1%,9%) \ FORM2%=Z0%(P1%,10%) &
		! IF NO 'FORM' WAS SPECIFIED, THEN &
		!	PUT IN 'NORMAL'. &

6020	IF LOGID%=0% THEN &
		Z$=RAD$(LOGDV1%) &
	\	Z$=Z$+NUM1$(UNITN0%) IF UNITNO%<>0% &
	\	Z$=Z$+"SPL" &
	\	Z%=FNP%(P1%,0%,Z$,0%,0%) &
	\	LOGID1%=Z0%(P1%,9%) \ LOGID2%=Z0%(P1%,10%) &
		! IF NOT 'NAME' WAS SPECIFIED, THEN &
		!	SET UP THE LOGICAL ID AS &
		!		DDUSPL &
		!	WHERE DD IS THE (LOGICAL) NAME OF THE DEVICE &
		!	 BEING SPOOLED, AND U IS THE UNIT NUMBER. &

6040	IF (PHYDHI% AND 16386%)=2% THEN &
		Z%=FNP%(P1%,0%,"KB"+NUM1$(K%)+":",0%,0%) &
	\	PHYSD1%=Z0%(P1%,6%) \ PHYSD2%=Z0%(P1%,7%) &
	\		PHYDHI%=PHYDHI% OR 16384% &
	\	Z0%(Q9%,6%)=PHYSD1% \ Z0%(Q9%,7%)=PHYSD2% &
	\		Z0%(Q9%,13%)=PHYDHI% &
		! IF THE DESTINATION DEVICE IS A KEYBOARD AND NO KB: &
		!  NUMBER WAS SPECIFIED, THEN &
		!	(MUST NOT LET THE ROUTINE SCAN FOR A FREE KB: - &
		!	IT MIGHT FIND A PK:, INSTEAD) &
		!	USE THE CURRENT KEYBOARD NUMBER. &

6100	LPFOR0%=((PHYDHI% AND 8%)<>0%) AND 512% UNLESS LPFORM%<>0% &
	\ TOLF0%=((PHYDHI% AND 8%)<>0%) AND 4096% UNLESS TOLF%<>0% &
	\ SKPSI0%=((PHYDHI% AND 8%)<>0%) AND 2048% UNLESS SKPSIX%<>0% &
	\ UCASE0%=1024% UNLESS UCASE%<>0% &
	\ CONVR0%=((PHYDHI% AND 8%)<>0%) AND 128% UNLESS CONVRT%<>0% &
	\ TRUNC0%=((PHYDHI% AND 8%)<>0%) AND 256% UNLESS TRUNCA%<>0% &
	\ NOFEE0%=((PHYDHI% AND 8%)<>0%) AND 8192% UNLESS NOFEED%<>0% &
		! SET UP DEFAULTS IF THEY AREN'T ALREADY SET : &
		!	LPFORM IF PRINTER; &
		!	TOLF IF PRINTER; &
		!	SKPSIX IF PRINTER; &
		!	UPPER CASE; &
		!	CONVRT IF PRINTER; &
		!	TRUNCA IF PRINTER; &
		!	NOFEED IF PRINTER. &
		! NOTE : THESE FLAGS ARE USED TO DETERMINE THE PHYSICAL &
		!  CHARACTERISTICS OF THE DESTINATION DEVICE AND WHAT &
		!  ACTIONS THE PRINTER PROGRAM HAS TO TAKE TO GET THE &
		!  RESULTS REQUESTED BY THE USER. &
	&

7000	&
	&
	&
	!	P U T    T H E    D A T A    I N T O &
	!	T H E    P R O P E R    R E C O R D S &
	&

7010	Z0%(0%,23%)=LOGID1% \ Z0%(0%,24%)=LOGID2% &
	&
	\ Z0%(P0%,6%)=PHYSD1% \ Z0%(P0%,7%)=PHYSD2% &
	\	Z0%(P0%,13%)=PHYDHI% \ Z0%(P0%,15%)=PHYFLG% &
	\	Z0%(P0%,16%)=PHYMOD% \ Z0%(P0%,18%)=PHYCLU% &
	\	Z0%(P0%,19%)=PHYSIZ% &
	&
	\ Z0%(P0%,8%)=DEFACT% &
	&
	\ Z0%(P0%,9%)=LOGDV1% \ Z0%(P0%,10%)=LOGDV2% &
	&
	\ Z0%(P0%,11%)=UNITN0% &
	&
	\ Z0%(P0%,22%) = DFLEN0% &
	&
	\ Z0%(P0%,23%)=FORM1% \ Z0%(P0%,24%)=FORM2% &
	&
	\ Z0%(P0%,25%)=LNGTH0% &
	&
	\ Z0%(P0%,26%)=WIDTH0% &
	&
	\ Z0%(P0%,28%)=TYPE0% &
	&
	\ Z0%(P0%,29%)=HEADN0% &
	&
	\ Z0%(P0%,30%)=COPYC0% &
	&
	\ Z0%(P0%,34%)=(1% AND (COPYCT%<>0%)) + TOPF0% + &
		(8% AND (HEADNG%<>0%)) + (32% AND (LNGTH%<>0%)) + &
		(64% AND (WIDTH%<>0%)) + CONVR0% + TRUNC0% + LPFOR0% + &
		UCASE0% + SKPSI0% + TOLF0% + NOFEE0% &
	&
	\ Z0%(P0%,17%)=TOLF% + 2%*DFLEN% + 4%*LPFORM% + 8%*SKPSIX% + &
		ASSGN0% &
	&
	\ Z0%(P0%,14%)=Z0%(P0%,14%) OR 4225% &
	&
		! PUT THE LOGICAL ID INTO THE FILE HEADER RECORD; &
		! &
		! PUT THE PHYSICAL DEVICE INFORMATION INTO THE &
		!  DESTINATION VOLUME RECORD; &
		! &
		! PUT THE DEFAULT ACCOUNT TO CHARGE INTO THE D.V.R.; &
		! &
		! PUT THE LOGICAL DEVICE INFORMATION INTO THE D.V.R.; &
		! &
		! PUT THE UNIT NUMBER INTO THE D.V.R.; &
		! &
		! PUT THE DEVICE FORM LENGTH INTO THE D.V.R.; &
	&
		! PUT THE FORM NAME INTO THE D.V.R.; &
		! &
		! PUT THE FORM LENGTH AND WIDTH INTO THE D.V.R.; &
		! &
		! PUT THE HEADING COUNT AND TYPE INTO THE D.V.R.; &
		! &
		! PUT THE COPY COUNT INTO THE D.V.R.; &
		! &
		! SET UP THE SWITCH SPECIFICATION WORD IN THE D.V.R., &
		!  BASED ON THE SWITCHES WHICH WERE SPECIFIED; &
		! &
		! SET UP THE DEVICE CHARACTERSTICS WORD IN THE D.V.R. &
	&
		! SET THE FILENAME, DEVICE AND PPN FLAGS IN FW2. &

7020	C0$=CHR$(129%)+STRING$(9%,255%)+CHR$(128%)+CHR$(255%)+ &
		CHR$(130%)+CHR$(129%)+STRING$(14%,255%)+ &
		CHR$(131%)+STRING$(99%,255%) &
	\ Z1$(2%)=C0$+STRING$(128%,130%) &
	\ Z1$(3%)=C0$+STRING$(128%,255%) &
	\ C0$="" &
	\ Z$="<$!#?=0*&+%>" &
	\ C0$=C0$+STRING$(10%,ASCII(MID(Z$,Z%,1%))) FOR Z%=1% TO 12% &
	\ Z2$(0%)=C0$ &
		! CREATE THE TWO TRANSLATION STRINGS FOR THE RUN-TIME &
		!  PROGRAM - THEY BOTH TRANSLATE THE <LF> AND <FF> CHRS &
		!  TO UNIQUE (CHR$(128%)) CHARS; THE LPFTBL$ STRING, THE &
		!  FIRST, ALSO TRANSLATES THE LPFORM CHRS, CHR$(127+), &
		!  TO THE UNIQUE CHR, SO THAT THEY WILL BE TREATED AS &
		!  CARRIAGE CONTROL CHRS; THE SECOND, TLTTBL$, &
		!  DOES NOT TRANSLATE THE LPFORM CHRS TO THE UNIQUE &
		!  VALUE, SO THESE CHRS WILL NOT BE TREATED AS CARRIAGE &
		!  CHRS. &
	&
		! NEXT, CREATE THE SPLAT STRING FOR THE HEADER PAGE. &
	&

7030	IF ALIGN0% THEN &
		P0%,Z0%(0%,1%)=0% \ P1%=26% \ C$="/ALIGN" &
	\	GOSUB 20750 &
	\	Z0%(P1%,12%)=20% \ M%(2%)=P1% \ Z0%(0%,1%)=0% &
		! IF '/ALIGN' WAS SPECIFIED, THEN &
		!	SET UP A '/ALIGN' FORMS CHANGE CALL IN THE LIST &
		!	 OF UNPROCESSED INTERRUPT COMMANDS (M%(2%) &
		!	 POINTS TO THIS LIST). &
	&

8000	&
	&
	&
	!	D O    T H E    A P P R O P R I A T E    O N L I N E &
	!	C A L L S ,    A S S I G N S ,    E T C . &
	&
	&

8010	GOSUB 23050 &
	\ GOTO 8100 IF E%<>0% &
	\ GOSUB 23100 &
	\ GOTO 8100 IF E%<>0% &
	\ GOSUB 20300 &
	\ GOTO 8100 IF E%<>0% &
		! GO ENTER THE JOB AS A RECEIVER; &
		! ISSUE ERROR IF ANY; &
		! GO ONLINE TO OPSER; &
		! ISSUE ERROR IF ANY; &
		! GO ONLINE TO QUEMAN; &
		! ISSUE ERROR, IF ANY. &

8020	IF ASSGN0%<>0% THEN &
		S0%=0% &
	\	GOSUB 11000 &
	\	IF ASSGN0%=0% THEN &
			Z0%(Q9%,13%)=PHYDHI% &
		ELSE	T$=FNU$(Q9%,"",4096%,0%)+" not available - "+ &
				C9$+"will wait for device after "+ &
				"DETACH" &
	\		IF E%=0% THEN &
				GOSUB 23500 &
			ELSE	T$="Unexpected error -"+C9$+ &
					RIGHT(SYS(CHR6.9$+ &
					 CHR$(E%)),4%)+C9$ &
	\			GOSUB 23500 &
	\			GOTO 4000 &
		! IF THE DEVICE IS TO BE ASSIGNED, THEN &
		!	SET UP A WAIT TIME OF 0; &
		!	TRY TO DO THE ASSIGNMENT; &
		!	IF THE ASSIGNMENT FAILS, THEN &
		!		SET UP THE 'WILL WAIT AFTER DETACH' MSG; &
		!		IF THAT IS THE PROBLEM, THEN &
		!			GO ISSUE THE MSG; &
		!		ELSE	SET UP AN ERROR MESSAGE AND GO &
		!			 BACK TO THE BEGINNING. &

8030	PRINT "Detaching..."+C9$+CHR12$  \ Z$=SYS(CHR6$+CHR$(7%)+ &
	 CHR$(128%)) &
	\ R%=R% AND -16385% &
		! DO THE DETACH, RESET THE 'ATTACHED' FLAG. &

8040	IF ASSGN0%<>0% THEN &
		S0%=-1% &
	\	GOSUB 11000 &
	\	Z0%(Q9%,13%)=PHYDHI% &
		! IF THE ASSIGNMENT IS STILL OUTSTANDING, THEN &
		!	SET AN INFINITE WAIT TIME; &
		!	CALL THE ASSIGNMENT ROUTINE. &

8050	GOTO 8200 &
		! ALL OKAY - GO TO NEXT STEP. &
	&
	&

8100	&
	&
	&
	!	E R R O R    I N    S O M E    S E N D / R E C E I V E &
	!			O P E R A T I O N &
	&

8110	PRINT "Error in some operation - Restarting" \ PRINT T$ &
	\ Z%=0% &
	\ Z%=31000% + (32767% + 1%) &
	\ CHAIN PKG.LOC$+"SPOOL" LINE Z% &
		! ISSUE ERROR AND RESTART. &
	&

8200	&
	&
	&
	!	S E T    P R I O R I T Y    A N D    R U N - B U R S T &
	&

8210	IF (PRIOR% OR RUNBST%)<>0% THEN &
		Z%(Z%)=0% FOR Z%=0% TO 30% &
	\	Z%(0%)=30% \ Z%(1%)=6% \ Z%(2%)=-13% \ Z%(3%)=-1% &
	\	Z%(4%)=PRIOR% \ Z%(5%)=PRIOR0% &
	\	Z%(6%)=RUNBST% \ Z%(7%)=RUNBS0% &
	\	CHANGE Z% TO Z$ &
	\	Z$=SYS(Z$) &
		! IF A PRIORITY OR RUNBURST CHANGE WAS REQUESTED, THEN &
		!	SET UP AND EXECUTE THE CALL. &
	&

8500	&
	&
	&
	!	S E T    U P    C H A I N    L I S T S &
	&

8510	P0%=FNA% &
	\ Z%=FNP%(P0%,0%,PKG.LOC$+"SPLIDL",0%,0%) &
	\ P2%=P0% &
	\ Z0%(P0%,1%)=FNA% &
	\ P0%=Z0%(P0%,1%) &
	\ Z%=FNP%(P0%,0%,PKG.LOC$+"SPOOL ",0%,0%) &
	\ Z0%(0%,13%)=P2% &
		! SET UP THE CHAIN TO THE IDLER PROGRAM AND BACK TO &
		!  THE INITIALIZATION PROGRAM. &

8520	P0%=FNA% &
	\ Z%=FNP%(P0%,0%,PKG.LOC$+"SPLRUN",0%,0%) &
	\ P2%=P0% &
	\ Z0%(P0%,1%)=FNA% &
	\ P0%=Z0%(P0%,1%) &
	\ Z%=FNP%(P0%,0%,PKG.LOC$+"SPLIDL",0%,0%) &
	\ Z0%(0%,14%)=P2% &
		! SET UP THE LIST TO BE COPIED BY THE IDLER PROGRAM TO &
		!  SET UP THE CHAIN TO GET SOMETHING DONE. &
	&
	&

9000	&
	&
	&
	!	C L O S E O U T    A N D    E X I T &
	&

9010	Z0%(0%,11%)=FNA0%(Z0%(0%,11%)) IF Z0%(0%,11%) &
	\ P0%=Z0%(0%,13%) &
	\ IF P0% THEN &
		P$=FNU$(P0%,NULSTG$,-1%,0%) &
	\	Z0%(0%,13%)=Z0%(P0%,1%) &
	\	Z0%(P0%,1%)=0% &
	\	Z%=FNA0%(P0%) &
		! GET RID OF THE INDIRECT COMMAND LIST; &
		! SET UP THE NEXT ONE TO CHAIN TO IF ONE IS IN THE LIST. &

9020	WHILE M%(4%) &
	\	Z0%(M%(5%),1%)=M%(2%) &
	\	Z0%(M%(2%),0%)=M%(5%) IF M%(2%) &
	\	M%(2%)=M%(4%) &
	\	M%(4%)=0% &
	\ NEXT &
	\ Z0%(0%,9%)=M%(2%) &
	\ Z0%(0%,19%)=M%(0%) &
	&
	\ Z0%(0%,0%)=B0% &
	\ Z0%(0%,26%)=R% &
	\ Z0%(0%,27%)=J9% &
	&
	\ W$=SYS(CHR$(8%)+CVT00$+FNU$(Z0%(0%,12%),NULSTG$,-1%, &
		-1%)) IF P0% &
	\ CLOSE 1%,2%,3%,12% &
	\ ON ERROR GOTO 19000 &
	\ IF P0% THEN &
		CHAIN P$ LINE 31000% + (32767% + 1%) &
	  ELSE	GOTO 32700 &
	&
		! THIS LINE PLACES THE HEAD POINTERS OF THE COMPLETE &
		!  MESSAGE AND INCOMPLETE MESSAGE LISTS INTO THE WORK- &
		!  FILE FOR RETRIEVAL BY THE NEXT MODULE.  IF ANY &
		!  'UNPROCESSED' REQUESTS ARE PRESENT, THEY ARE PUT AT &
		!  THE FRONT OF THE 'COMPLETED' MESSAGES LIST. &
	&
		! REPLACE THE FREE-LIST POINTER, THE PACKAGE STATUS, AND &
		!  THE CURRENT JOB NUMBER IN THE FILE HEADER RECORD. &
	&
		! PUT THE WORK-FILE NAME INTO CORE COMMON IF A CHAIN IS &
		!  TO BE DONE; &
		! CLOSE THE FILES; &
		! IF THERE WAS A CHAIN RECORD, THEN &
		!	DO THE CHAIN; &
		! ELSE	GO DO THE FINAL CLOSE OUT. &
	&
	&
	&
	&

10000	&
	!	I N I T    G C M L &

10010	S9%=S9%+1% \ S$(S9%)=C$ &
	\ C$="@KB:" &
	\ P%=1% &
	\ GOSUB 10350 &
	\ C$=S$(S9%) \ S9%=S9%-1% &
		! SET UP AN INDIRECT COMMAND FILE NAME AND SAVE THE &
		! ORIGINAL COMMAND. &

10020	Y%=0% &
	\ Y%=Y% OR 64% IF (E0% AND 7%)<>0% &
	\ Y%=Y% OR 16% IF (E0% AND 2%)<>0% &
	\ Y%=Y% OR ((E0% AND 56%)/8%) &
	\ Z0%(Z0%(0%,11%),31%)=Y% &
		! SET UP THE FLAG WORD FOR GCML; &
		! PUT IT INTO THE APPROPRIATE FR. &

10030	RETURN &
		! AND EXIT. &
	&

10100	&
	&
	!	G E T    C O M M A N D    L I N E &
	!		( G C M L ) &

10110	GOTO 10610 IF (Y% AND 256%)<>0% IF (Y0% AND 2%)=0% &
	\ GOTO 10620 IF (Y% AND 64%)<>0% IF Y1%<>0% &
	\ Y%=(Y% AND 511%) &
			OR &
		(512% AND (Y0% AND 2%)=2% AND (Y% AND 64%)=0%) &
			OR &
		(4096% AND (Y0% AND 2%)=2%) &
			OR &
		(2048% AND (Y% AND 64%)=0%) &
			OR &
		(8192% AND (Y% AND 8%)=0%) &
			OR &
		(16384% AND (Y% AND 16%)=0%) &
			OR &
		(NOT 32767% AND (Y% AND 32%)=0%) &
	\ Z0$=C$ &
	\ C$="" &
		! CHECK FOR :	1. ILLEGAL RETRY; &
		!		2. SECOND LINE ATTEMPTED ILLEGALLY. &
		! SET 'THIS LINE' VALUES IN Y% : &
		!	1. IF KB: AND NOT SINGLE-LINE ONLY, &
		!		PRINT PRIMARY PROMPT; &
		!	2. IF KB:, RETURN MARGIN; &
		!	3. IF NOT SINGLE-LINE ONLY, ASK FOR INPUT; &
		!	4. IF COMMENT SCAN IS LEGAL, REQUEST IT; &
		!	5. IF CONTINUATION LEGAL, REQUEST IT; &
		!	6. IF INDIRECT LEGAL, REQUEST IT. &
		! INIT RETURNED STRING TO NULL. &

10120	PRINT #12%,P0$; IF (Y% AND 512%)<>0% &
	\ PRINT #12%,P1$; IF (Y% AND 1024%)<>0% &
	\ ON ERROR GOTO 10160 &
	\ INPUT LINE #12%,Z0$ IF (Y% AND 2048%)<>0% &
	\ PRINT #12% IF (CCPOS(12%)<>0%) IF (Y% AND 4096%)<>0% &
	\ Y1%=Y1%+1% &
		! PROCESS AS INSTRUCTED BY Y% : &
		!	PRIMARY PROMPT; &
		!	SECONDARY PROMPT; &
		!	INPUT DATA; &
		!	RETURN CARRIAGE TO LEFT MARGIN; &
		!	ALWAYS INCREMENT LINE COUNTER. &

10130	Z0$=CVT$$(Z0$,1%+4%+16%+32%+128%) &
	\ GOSUB 10500 IF (Y% AND 8192%)<>0% &
	\ IF (Y% AND 16384%)<>0% THEN &
		IF RIGHT(Z0$,LEN(Z0$))="-" THEN &
			C$=C$+LEFT(Z0$,LEN(Z0$)-1%) &
	\		Y%=(Y% AND -513%) OR 2048% &
				OR (1024% AND (Y0% AND 2%)=2%) &
	\		GOTO 10120 &
		! TRIM PARITY, TERMINATORS & JUNK, REDUCE SPACES &
		! AND TABS TO ONE SPACE, CONVERT LOWER &
		! CASE TO UPPER CASE, AND DISCARD TRAILING SPACES &
		! AND TABS. &
		! DO COMMENT SCAN, IF REQUESTED; &
		! DO CONTINUATION, IF REQUESTED, INCLUDING PRINTING &
		! SECONDARY PROMPT IF DEVICE IS KB:. &

10140	C$=CVT$$(C$,8%)+Z0$ &
	\ IF Y%<0% THEN &
		IF LEFT(C$,1%)="@" THEN &
			P%=1% &
			 \GOSUB 10300 &
	\		IF E%=0% THEN 10100 ELSE 10190 &
		! CONSTRUCT THE FINAL STRING, DISCARDING LEADING SPACES; &
		! IF INDIRECT CHECK IS REQUESTED AND FIRST CHARACTER &
		! IS '@' (THE INDIRECT INDICATOR), THEN CALL INDIRECT &
		! SET UP AND LOOP FOR MORE. &

10150	GOTO 10630 &
		! SKIP TO END OF ROUTINE. &
	&

10160	&
	!	ERROR TRAPPED ON INPUT LINE &

10170	E%=ERR \ RESUME 10180 &
		! SET UP ERROR FLAG AND RESUME AT DISPATCHER. &

10180	&
	!	DISPATCHER &

10190	IF E%=11% THEN 10200 &
	ELSE	E%=256% OR E% &
	\	GOTO 10630 &
		! IF IT'S AN EOF, LOOK FOR NEXT COMMAND FILE; &
		! OTHERWISE, SET ERROR AND RETURN. &

10200	&
	&
	!	REMOVE CURRENT COMMAND FILE FROM INDIRECT LIST &

10210	Z%=Z0%(0%,11%) &
	\ Z0%=Z0%(Z%,1%) &
	\ Z0%(Z%,1%)=0% &
	\ Z0%(0%,11%)=Z0% &
	\ Z%=FNA0%(Z%) &
		! DE-LINK CURRENT COMMAND FILE. &

10220	GOTO 10630 IF Z0%(0%,11%)=0% &
	\ E%=0% \ GOSUB 10400 \ E%=11% IF E%=5% &
	\ GOTO 10180 IF E%<>0% &
	\ GOTO 10100 &
		! CALL RE-OPEN; &
		! IF NO ERROR, GET NEXT LINE OUT OF NEW COMMAND FILE. &
	&

10300	&
	&
	!	CLOSE OUT CURRENT COMMAND FILE AND OPEN &
	!	AN INDIRECT &

10310	Z0%=Z0%(0%,11%) &
	\ Z0%(Z0%,13%)=Y0% &
	\ Z0%(Z0%,27%)=Y1% &
	\ Z0%(Z0%,31%)=Y% &
		! SET UP CURRENT VALUES FOR NEXT TIME THIS &
		! ONE IS OPENED. &

10350	&
	&
	!	SET UP AN INDIRECT &

10360	Y0%=Z0%(0%,11%) \ Y1%=FNA% &
	\ P%=FNP%(Y1%,P%,C$,-31898%,16376%) &
	\ GOTO 10650 IF E%<>0% &
	\ Z%=FNF0%(Y1%,"KB:COMMND.CMD"+A$,C0$) &
	\ Z0%(Y1%,1%)=Y0% &
	\ Z0%(Y1%,31%)=(Y% AND 7%) OR (Y% AND 7%)*8% &
	\ Z0%(0%,11%)=Y1% &
		! SET UP NEW COMMAND FILE FR; &
		! SET UP ITS FLAG WORD; &
		! LINK IT INTO INDIRECT LIST. &

10400	&
	&
	!	CLOSE CURRENT COMMAND FILE - OPEN/RE-OPEN PREVIOUS &

10410	ON ERROR GOTO 10440 &
	\ CLOSE 12% &
		! SET UP ERROR TRAP FOR WHOLE ROUTINE; &
		! CLOSE CURRENT COMMAND FILE. &

10420	Y0%=Z0%(0%,11%) &
	\ Y1%=Z0%(Y0%,27%) &
	\ Y%=Z0%(Y0%,31%) &
		! GET THE CRUCIAL INFORMATION FROM THE OLD COMMAND FILE: &
		!	Y1% - LINE COUNT &
		!	Y%  - GCML FLAG WORD &

10430	Z%=FNO%(Y0%,1%,12%,0%) &
	\ GOTO 10450 IF E%<>0% &
	\ Y0%=Z0%(Y0%,13%) &
	\ INPUT LINE #12%,Z0$ FOR Z%=1% TO Y1% UNLESS (Y0% AND 2%)<>0% &
	\ GOTO 10450 &
		! OPEN NEW COMMAND FILE; &
		! RESET THE DHI WORD BASED ON ACTUAL DEVICE; &
		! SPACE FORWARD TO CURRENT LINE UNLESS IT'S A KB:. &

10440	E%=ERR \ RESUME 10450 &
		! ERROR ON CLOSE, OPEN, OR FORWARD SPACE. &

10450	ON ERROR GOTO 19000 &
		! RESET ERROR TRAP. &

10460	RETURN &
		! AND EXIT. &
	&

10500	&
	&
	!	DO COMMENT SCAN &

10510	IF (INSTR(1%,Z0$,"'") OR INSTR(1%,Z0$,'"'))=0% THEN 10580 &
		! IF NO QUOTES IN THE COMMAND STRING, SKIP THE QUOTE &
		! PROCESSING, BUT STILL LOOK FOR THE EXCLAMATION POINT. &

10520	Z0%=0% &
	\ Z1%=LEN(Z0$) &
	\ Z$="" &
		! SET UP FOR SCAN : &
		!	SET QUOTE HOLDER (Z0%) TO 0; &
		!	SET POSITION TO CHANGE (Z3%) TO FIRST CHARACTER; &
		!	SET END OF STRING (Z1%) TO LENGTH OF STRING; &
		!	SET RESULT STRING (Z$) TO NULL. &

10540	FOR Z3%=1% TO Z1% STEP 30% &
	\	CHANGE MID(Z0$,Z3%,30%) TO Z% &
	\	FOR Z%=1% TO Z%(0%) &
	\		Z2%=Z%(Z%) &
		! FOR EACH 30 BYTE SECTION OF THE STRING, CHANGE IT TO &
		! THE WORK ARRAY; &
		!	FOR EACH CHARACTER IN THE CHANGED STRING, HOLD &
		!	THE CHARACTER. &

10550			IF Z0%=0% THEN &
				IF Z2%=ASCII("'") OR Z2%=ASCII('"') THEN &
					Z0%=Z2% &
				ELSE	Z0%=0% &
			ELSE	IF Z0%<>Z2% THEN &
					Z%(Z%)=Z%(Z%) OR 128% &
				ELSE	Z2%=-1% &
				! IF WE'RE NOT WITHIN QUOTES, THEN: &
				!	IF THIS IS A QUOTE, THEN &
				!		STORE THE QUOTE &
				!	ELSE	Z0%=0% AGAIN (NOP); &
				! IF WE'RE NOT WITHIN QUOTES, THEN: &
				!	IF THIS IS NOT THE MATCHING &
				!	QUOTE, THEN SET PARITY BIT ON &
				!		THE CHARACTER; &
				!	ELSE	SET END OF QUOTE FLAG. &

10560			Z%(Z%)=0% IF Z0%=Z2% OR Z2%=-1% &
	\		Z0%=0% IF Z2%=-1% &
	\	NEXT Z% &
	\	CHANGE Z% TO Z1$ &
	\	Z$=Z$+Z1$ &
	\ NEXT Z3% &
	\ Z0$=Z$ &
				! CLEAR THIS CHARACTER IF IT'S A &
				! MATCHING QUOTE; &
			! LOOK AT NEXT CHARACTER; &
			! CHANGE THE STRING BACK TO A STRING AND UPDATE &
			! THE CURRENT OUTPUT STRING; &
		! DO NEXT SEGMENT OF THE INPUT STRING; &
		! SET ORIGINAL STRING TO NEW STRING. &

10580	Z%=INSTR(1%,Z0$,"!") &
	\ Z0$=LEFT(Z0$,Z%-1%) IF Z%<>0% &
	\ Z0$=CVT$$(Z0$,1%+4%+128%) &
	\ RETURN &
		! ANY EXCLAMATION POINT IN QUOTES NOW HAS THE PARITY BIT SET, &
		! SO THE INSTRING WILL FIND ONLY THOSE NOT IN QUOTES; IF ONE &
		! IS FOUND, THE REST MUST BE A COMMENT, SO TAKE IT OUT; &
		! RESET PARITY BITS AND REMOVE GARBAGE CHARACTERS; &
		! AND EXIT. &
	&
	&

10600	&
	&
	!	ERROR PROCESSING FOR GCML &

10610	E%=256%+46% \ GOTO 10630 &
		! RETRY REQUESTED ON AN UNRETRIABLE DEVICE. &

10620	E%=11% \ GOTO 10630 &
		! SECOND LINE REQUESTED ON A SINGLE LINE DEVICE &
		! (IE, CHAIN, CCL, OR LOGGED OUT ENTRY). &

10630	&
	&
	!	EXIT ROUTINE &

10640	IF E%<>0% THEN &
		Z%=FNA0%(Z0%(0%,11%)) &
	\	Z0%(0%,11%)=0% &
		! IF AN ERROR IS BEING RETURNED, THEN CLEAR THE &
		! COMMAND FILE LIST. &

10650	P%=0% &
	\ ON ERROR GOTO 19000 &
		! RESET ERROR TRAP. &

10660	RETURN &
		! AND EXIT. &
	&

11000	&
	&
	&
	!	A S S I G N    T H E    D E V I C E &
	&

11010	MAXUNT%=64% UNLESS MAXUNT% &
	\ WHILE PHYSD1%=0% &
	\	PHYSD1%=Z0%(Q9%,6%) \ PHYSD2%=Z0%(Q9%,7%) &
	\	PHYDHI%=Z0%(Q9%,13%) &
	\ NEXT &
	\ CHANGE SYS(CHR6.M10$+RAD$(PHYSD1%)+RAD$(PHYSD2%)+ &
		":") TO M0% &
	\ M0%(0%)=30% \ M0%(1%)=6% \ M0%(2%)=10% &
	\	M0%(Z%)=0% FOR Z%=3% TO 22% &
	\	M0%(Z%)=0% FOR Z%=27% TO 30% &
		! SET UP A MAXIMUM UNIT NUMBER (DEFAULT IS FOR KB:); &
		! SET UP THE VARIABLES TO HOLD THE PHYSICAL DEVICE INFO, &
		!  IF THEY ARE NOT ALREADY SET UP; &
		! DO AN FSS ON THE DEVICE NAME TO GET IT INTO A &
		!  CONVENIENT FORM FOR THE 'ASSIGN' CALL; &
		! PLUG IN THE 'ASSIGN' CALL VALUES. &

11020	IF (PHYDHI% AND 16384%) THEN &
		UNITNO%=M0%(25%) &
	ELSE	M0%(26%)=-1% &
	\	Z%=FNPUSH%(S0%) \ S0%=0% &
	\	GOSUB 11030 FOR UNITNO%=0% WHILE ASSGN0% AND &
			UNITNO%<MAXUNT% AND E%=0% &
	\	S0%=FNPOP% &
	\	MAXUNT%=UNITNO% IF E%=6% &
	\	E%=0% IF E%=6% &
	\	GOTO 11040 &
		! IF AN ABSOLUTE DEVICE IS SPECIFIED, THEN &
		!	SET UP THE UNIT NUMBER AND DROP THROUGH TO &
		!	 ASSIGN; &
		! ELSE	SET THE UNIT NUMBER FLAG, SO THE ASSIGN FINDS &
		!	 ONE THERE; &
		!	PUSH THE SLEEP FLAG, SO THE SUBSEQUENT ROUTINE &
		!	 WILL NOT SLEEP; &
		!	CALL THE ASSIGN ROUTINE FOR EACH POSSIBLE UNIT, &
		!	 UNTIL EITHER THE ASSIGNMENT IS PERFORMED, THE &
		!	 MAXIMUM DEVICE HAS BEEN FOUND, OR SOME ERROR &
		!	 OCCURRED; &
		!	POP THE SLEEP FLAG IMMEDIATELY; &
		!	SET THE ACTUAL MAXIMUM COUNT IF THE ERROR MEANT &
		!	 THAT THAT HAD BEEN FOUND; &
		!	RESET THE ERROR IF IT MEANT MAX COUNT; &
		!	GOTO THE EXIT ROUTINE. &

11030	ON ERROR GOTO 11070 &
	\ M0%(25%)=UNITNO% &
	\ CHANGE M0% TO Z$ &
	\ Z$=SYS(Z$) &
	\ ASSGN0%=0% &
	\ Z%=FNCHNGE%(SYS(CHR6.M10$+CHR$(M0%(23%))+CHR$(M0%(24%))+ &
	    NUM1$(UNITNO%))) &
	\ PHYSD1%=Z%(7%) \ PHYSD2%=Z%(9%) &
	\	PHYDHI%=PHYDHI% OR 16384% &
	\ Z0%(Q9%,6%)=PHYSD1% \ Z0%(Q9%,7%)=PHYSD2% &
		! SET UP THE ERROR TRAP; &
		! PLUG IN THE UNIT NUMBER; &
		! DO THE 'ASSIGN' CALL; &
		! SUCCESS : &
		! RESET THE 'ASSIGNMENT NECESSARY' FLAG; &
		! SET UP THE PHYSICAL DEVICE NAME IN THE PROPER FLAG &
		!  WORDS AND BACK INTO THE DESTINATION VOLUME RECORD. &

11040	IF ASSGN0%=0% OR E% THEN &
		GOTO 11050 &
	ELSE	IF S0%=0% THEN &
			GOTO 11050 &
		ELSE	SLEEP 30% &
	\		GOTO 11020 &
		! IF THE ASSIGNMENT WAS SUCCESSFUL OR AN UNEXPECTED &
		!  ERROR OCCURRED, THEN &
		!	GOTO EXIT; &
		! ELSE	IF THE SLEEP TIME IS 0, THEN &
		!		GOTO EXIT; &
		!	ELSE	SLEEP AWHILE; &
		!		GO TRY THE ASSIGNMENT LOOP AGAIN. &

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

11070	&
	!	ERROR HANDLER FOR THE ASSIGNMENT ROUTINE &

11080	E%=ERR \ RESUME 11090 &
		! HOLD THE ERR VALUE AND MAKE SURE OF THE RESUME. &

11090	IF E%<>8% THEN &
		GOTO 11050 &
	ELSE	E%=0% &
	\	GOTO 11040 &
		! IF THE ERROR IS NOT DEVICE NOT AVAILABLE, THEN &
		!	EXIT; &
		! ELSE	RESET THE ERROR AND GO TO THE EXIT ROUTINE. &
	&

15000	DEF* FNM0$(T$,J9%,P0%,E%,PGEFLG%) &

15010	T$=T$+" - " IF T$<>NULSTG$ &
	\ IF J9% THEN &
		T$=T$+" Job: "+FNU$(J9%,NULSTG$,129%,0%) &
	\	IF P0% THEN &
			T$=T$+"	File - "+FNU$(P0%,NULSTG$,-1%,0%) &
	\		IF PGECNT% THEN &
				T$=T$+C9$ &
	\			T$=T$+"Page: "+NUM1$(PGECNT%)+ &
				 "	" IF PGEFLG% &
	\			T$=T$+"Block: "+NUM1$(BLKCNT%) &

15090	T$=T$+C9$+ &
		CVT$$(RIGHT(SYS(CHR6.9$+CHR$(E%)),3%), &
			4%) IF E% &
	&
	\ FNM0$=T$ &
	&
	\ FNEND &
		! AND EXIT. &
	&

19000	&
	&
	&
	!	U N E X P E C T E D    O R    U N R E C O V E R A B L E &
	!		E R R O R    H A N D L E R &
	&

19005	IF ERL=19990% THEN &
	   T$="Fatal error while no access to work-file: ERR=" &
	     +NUM1$(E%)+", ERL="+NUM1$(E1%) &
	\  PRINT T$ &
	\  STOP &
	!  PUT THE JOB INTO HIBERNATION WHILE THE JOB IS DETACHED &

19010	E%=ERR \ E1%=ERL \ RESUME 19020 &
		! SET UP THE ERROR VALUE AND LINE; &
		! MAKE SURE OF THE RESUME. &

19020	ON ERROR GOTO 19000 &
		! RESET ERROR TRAP. &

19990	FATAL.ERR% = ERR &
	\ Z0%(0%,50%) = ERL &
	\ Z0%(0%,51%) = 31055% &
	\ Z0%(0%,52%) = 24480% &
	\ Z$ = SYS(CHR6.M10$ + MID(I$,2%,3%) + RIGHT(I$,6%)) &
	\ Z0%(0%,53%) = CVT$%(MID(Z$,7%,2%)) &
	\ Z0%(0%,54%) = CVT$%(MID(Z$,9%,2%)) &
	\ GOTO 2000 &
		! PACK IN FATAL ERROR DATA INTO WORK FILE. &
		!	ERROR CODE &
		!	ERROR LINE &
		!	"SPO" IN RAD$() FORM &
		!	"OL " IN RAD$() FORM &
		!	VERSION/EDIT #'S IN RAD$() FORM &
		!	BACK TO MAIN CONTROL POINT. &
	&

20000	&
	&
	&
	!	I N I T I A L I Z E    F O R    P O L L I N G &
	!	R O U T I N E    A N D    M S G    S T O R A G E &
	&

20010	Z$=SYS(CHR6.M21.M1$) &
	\	OPEN W$ FOR INPUT AS FILE 1% &
	\	Z$=SYS(CHR6.M21.0$) &
	\ R%=Z0%(0%,26%) &
	\ B0%=Z0%(0%,0%) &
	\ J9%=Z0%(0%,27%) &
	\ Q9%=Z0%(0%,4%) &
	\ FATAL.ERR% = Z0%(0%,49%) &
	&
	\ NOT32767%=NOT 32767% &
	&
	\ M%(0%)=Z0%(0%,19%) &
	\ M%(2%)=Z0%(0%,9%) &
	\ FOR Z%=0% TO 2% STEP 2% &
	\	Z0%=M%(Z%) &
	\	IF Z0% THEN &
			Z0%=Z0%(Z0%,1%) WHILE Z0%(Z0%,1%) &
	\		M%(Z%+1%)=Z0%
20020	  NEXT Z% &
	&
	\ J%=(PEEK(518%) AND 255%)/2% &
	\ J$="  " \ RSET J$=NUM1$(J%) &
	\ J1%=SWAP%(CVT$%(MID(SYS(UU1$),25%,2%))) &
	\ A%=SWAP%(CVT$%(MID(SYS(UU0$),21%,2%))) &
	\ Z$="   " \ RSET Z$=NUM1$(SWAP%(A%) AND 255%) &
	\	A$="["+Z$ \ RSET Z$=NUM1$(A% AND 255%) &
	\	A$=A$+","+Z$+"]" &
	\ K0%=PEEK(J1%) &
	\ K%=(SWAP%(PEEK(PEEK(K0%)+2%)) AND 255%) OR &
		(R% AND 16384%)=0% &
	&
	\ C8$=CHR7$ &
	\ C9$=CHR13$+CHR10$ &
	\ GOSUB 23050 IF (R% AND 2048%) &
	\ GOSUB 23100 IF (R% AND 4096%) &
	\ GOSUB 20300 IF (R% AND 8192%) &
	&
	\ RETURN &
	&
		! DROP PRIVILEGES, (TRY TO) OPEN THE WORK-FILE, AND &
		!  REGAIN PRIVILEGES; &
		! GET THE STATUS WORD OUT OF THE WORK-FILE; &
		! GET THE (WORK-FILE) FREE-LIST POINTER, THE CURRENT JOB &
		!  POINTER, AND THE OUTPUT VOLUME POINTER INTO SOME &
		!  CONVENIENT (IN-MEMORY) VARIABLES. &
	&
		! THESE TWO LINES SET UP THE HEADS AND TAILS OF THE &
		!  INCOMPLETE MESSAGES AND COMPLETED MESSAGES LISTS. &
		!  THE HEADS OF THE LISTS ARE TAKEN DIRECTLY OUT OF THE &
		!  FILE HEADER RECORD OF THE WORK-FILE; THE TAILS MUST &
		!  BE FOUND BY A SCAN, IF THE LISTS ARE NON-EMPTY. &
	&
		! SET UP PARAMETERS FROM THE EXEC : &
		!	GET THE JOB NUMBER INTO J%; &
		!	SET UP A JOB NUMBER STRING IN J$; &
		!	GET THE ACCOUNT NUMBER OF THIS JOB OUT OF THE &
		!	 JDB OF THE JOB; &
		!	TURN THE ACCOUNT NUMBER INTO AN ACCOUNT NUMBER &
		!	 STRING; &
		!	STORE IN K0% THE ADDRESS OF THE I/O BLOCK FOR &
		!	 THIS JOB, FOR LOOKING UP SUCH THINGS AS THE &
		!	 CURRENT KEYBOARD, FOR ATTACHED/DETACHED, OR THE &
		!	 STATUS OF AN OPEN CHANNEL; &
		!	AND SET UP THE KEYBOARD NUMBER OF THIS JOB'S &
		!	 KEYBOARD, UNLESS THE STATUS FLAG SHOWS THAT &
		!	 THE JOB IS DETACHED. &
	&
		! SET UP TWO USEFUL STRING CONSTANTS : &
		!	C8$	- A ^G (<BELL>) CHARACTER, FOR &
		!		   NOTIFICATION STRINGS &
		!	C9$	- A <CR><LF> STRING FOR GENERAL USE &
		! CALL THE 'ENTER' ROUTINE IF THE JOB IS ENTERED; &
		! CALL THE 'ONLINE' ROUTINE IF THE JOB IS ONLINE TO &
		!  OPSER; &
		! CALL THE 'ONLINE TO QUEMAN' ROUTINE IF THE JOB IS &
		!  ONLINE TO QUEMAN; &
		! THESE THREE ROUTINES, ENTER, ONLINE, AND ONQUE, SET &
		!  UP APPROPRIATE CONSTANTS AND STRINGS TO DO THE &
		!  REQUIRED POLLING AND COMMUNICATIONS. &
	&
		! AND EXIT. &
	&

20200	&
	&
	&
	!	S E N D    A    M E S S A G E    T O    Q U E M A N &
	&

20210	Z%=FNPUSH%(P%) \ P%=0% &
	\ R8%=0% &
		! PUSH THE CURRENT VALUE OF P% FOR &
		!  RECOVERY LATER; &
		! RESET THE RETRY COUNTER. &

20220	ON ERROR GOTO 20240 &
	\ WHILE P%<LEN(T$) &
	\	Z%=LEN(T$)-P%+1% &
	\	Z%=255% IF Z%>19% &
	\	Z$=SYS(Q1$+CHR$(Z%)+RIGHT(T$,P%+1%)) &
	\	R8%=0% &
	\	P%=P%+19% &
	\ NEXT &
	\ R%=R% OR 8192% &
		! RESET THE RETRY COUNTER; &
		! SEND EACH PART OF THE MESSAGE; &
		! SET THE 'ONLINE TO QUEMAN' FLAG. &

20230	P%=FNPOP% &
	\ ON ERROR GOTO 19000 &
	\ RETURN &
		! POP THE OLD VALUE OF P%; &
		! RESET THE TRAP; &
		! EXIT. &

20240	IF ERR=32% THEN &
		R8%=R8%+1% &
	\	IF R8%<60% THEN &
			SLEEP 5% &
	\		RESUME 20220 &
		! IF THE ERROR WAS 'NO ROOM', THEN &
		!	(IT'S PROBABLY A TEMPORARY CONDITION, SO) &
		!	INCREMENT THE RETRY COUNTER; &
		!	IF IT IS STILL LESS THAN 60, THEN &
		!		SLEEP AWHILE AND TRY AGAIN &
		!	(ELSE	QUEMAN HAS BEEN HUNG TOO LONG - &
		!		 SO FATAL). &

20250	T$="***** QUEMAN HUNG *****" \ GOSUB 23500 &
	\ RESUME 20230 &
		! SOME OTHER ERROR - ISSUE MESSAGE. &
	&

20300	&
	&
	&
	!	O N L I N E    T O    Q U E M A N &
	&

20310	Q1$=CHR6.18.M1.0$+ &
	 MID(SYS(CHR6.M10$+"QUEMAN"),7%,4%) &
	\ RETURN IF (R% AND 8192%)<>0% &
	\ T$=CHR$(5%)+CHR7$+LEFT(RAD$(Z0%(Q9%,9%)),2%)+ &
		CHR$(Z0%(Q9%,11%))+CVT%$(SWAP%(Z0%(0%,23%)))+ &
		CVT%$(SWAP%(Z0%(0%,24%)))+CHR$(1%) &
	\ GOSUB 20200 &
	\ GOTO 20380 &
		! SET UP THE 'SEND TO QUEMAN' STRING, REGARDLESS &
		!  OF WHETHER OR NOT THE ONLINE HAS ALREADY BEEN &
		!  SENT; &
		! ESCAPE IF IT HAS; &
		! OTHERWISE, SET UP A STRING OF THE FORM : &
		!	(5)(LEN OF SUBPACKET)(QUEUE NAME) &
		!	  (QUEUE UNIT)(LOGICAL ID)(1) &
		! SEND THIS STRING TO QUEMAN; &
		! GO DO A 'FORMS' REQUEST. &
	&
	&
	&

20320	&
	&
	&
	!	O F F L I N E    T O    Q U E M A N &
	&

20330	T$=CHR13$ \ GOSUB 20200 \ R%=R% AND -8209% &
	\ RETURN &
		! SEND AN OFFLINE TO QUEMAN; &
		! RESET THE 'ONLINE TO QUEMAN' AND 'OFFLINE TO QUEMAN &
		!  REQUESTED' FLAGS. &
	&

20380	&
	&
	&
	!	R E Q U E S T    F O R M S    C H A N G E    F R O M &
	!			Q U E M A N &

20390	T$=CHR12$+CVT%$(SWAP%(Z0%(Q9%,23%)))+ &
	   CVT%$(SWAP%(Z0%(Q9%,24%))) &
	\ GOTO 20200 &
		! SET UP A 'FORMS REQUEST' OF THE FORM : &
		!	(12)(FORM NAME IN RAD50); &
		! GO SEND IT TO QUEMAN. &
	&
	&

20750	&
	&
	&
	!	P U T    A    T E X T    S T R I N G    I N T O    T H E &
	!		W O R K - F I L E &
	&
	! ENTER WITH P0% POINTING TO THE HEAD OF THE LIST INTO WHICH &
	! THE TEXT STRING SHOULD BE PLACED AND P1% POINTING TO THE &
	! FIRST SLOT IN THE RECORD WHICH SHOULD BE USED TO STORE TEXT. &
	&
	! RETURNS P0% UNCHANGED AND THE RECORD Z0%(P0%,?) WITH NULLS IN &
	! THE FIRST P1% BYTES (P1% AS IT WAS ON ENTRY) AND P1% POINTING &
	! TO THE HEAD RECORD OF THE TEXT SUBLIST. &

20760	Z%=FNPUSH%(P0%) &
	\ Z%=FNPUSH%(P%) &
	\ P0%=Z0%(P0%,1%) WHILE Z0%(P0%,1%)<>0% &
	\ P0%,Z0%(P0%,1%)=FNA% &
	\ P1%=FNPUSH%(P1%)+2% &
	\ Z%=FNPUSH%(P0%) &
	\ P%=1% &
		! PUSH THE ORIGINAL VALUE OF P0% TO RETURN LATER; &
		! ALSO PUSH THE VALUE OF THE CURRENT POSITION POINTER; &
		! SEARCH FOR THE END OF THE LIST; &
		! PLUG IN A FREE-LIST ENTRY FOR BOTH 'NEXT RECORD' OF &
		!  THE CURRENT END OF LIST AND THE CURRENT POINTER; &
		! PUSH THE ADDRESS OF THAT ENTRY FOR USE LATER; &
		! PUSH THE FIRST POSITION TO FILL TO USE LATER AS THE &
		!  STRING LENGTH, AND INCREMENT THE FIRST POSITION &
		!  PAST THE FIRST WORD; &
		! SET THE CURRENT POSITION IN STRING TO 1. &

20770	Z0$(P0%)=STRING$(P1%,0%)+MID(C$,P%,128%-P1%) &
	\ P%=P%+128%-P1% &
	\ IF LEN(C$)>=P% THEN &
		P0%,Z0%(P0%,1%)=FNA% &
	\	P1%=12% &
	\	GOTO 20770 &
		! PUT THE STRING IN, PRECEDED BY NULLS FOR AS MANY AS &
		!  WERE REQUESTED; &
		! UPDATE THE CURRENT POSITION IN THE STRING; &
		! IF NOT PAST THE END, THEN &
		!	GET A NEW FIRST RECORD; &
		!	RESET THE 'NEXT SLOT TO FILL' POINTER PAST THE &
		!	 POINTER SLOTS; &
		!	GO TRY FOR MORE. &

20780	P0%=FNPOP% &
	\ Z0%(P0%,2%)=Z0%(P0%,1%) &
	\ Z0%(P0%,1%)=0% &
	\ P1%=FNPOP% &
	\ Z0%(P0%,P1%/2%)=LEN(C$) &
	\ P1%=P0% &
	\ P%=FNPOP% &
	\ P0%=FNPOP% &
		! POP THE HEAD OF THIS TEXT STRING; &
		! MAKE ANY SUBSEQUENT RECORDS PART OF ITS SUBLIST; &
		! RESET THE MAINPOINTER; &
		! PUT THE LENGTH OF THE WHOLE STRING INTO THE HEAD &
		!  RECORD; &
		! HOLD THE ADDRESS OF THIS RECORD FOR RETURN; &
		! POP THE ORIGINAL VALUE OF P%; &
		! POP THE ENTRY VALUE OF P0%. &

20790	RETURN &
		! AND EXIT. &
	&
	&

23000	&
	&
	&
	!	O P S E R - R E L A T E D    S U B R O U T I N E S &
	&

23050	&
	&
	&
	!	E N T E R    R E C E I V E R &

23060	IF (R% AND 2048%)<>0% THEN &
		GOTO 23900 &
	ELSE	ON ERROR GOTO 23070 &
	\	Z$=SYS(CHR$(6%)+CHR$(18%)) &
	\	Z$=SYS(CHR6$+CHR$(18%)+CHR$(1%)+CHR$(128%+5%)+ &
			CVT%$(SWAP%(Z0%(0%,23%)))+ &
			CVT%$(SWAP%(Z0%(0%,24%)))) &
	\	E%=-1% &
	\	T$="Outstanding message" &
	\	GOTO 23080 &
		! IF THE FLAG SAYS THAT THE JOB IS ALREADY ENTERED, THEN &
		!	GOTO THE COMMON EXIT; &
		! ELSE	SET UP AN ERROR TRAP FOR THE ENTER; &
		!	EXECUTE THE 'RECEIVE' FUNCTION; &
		!	IF IT SUCCEEDED, THEN SOME MESSAGE MUST HAVE &
		!	 BEEN WAITING FOR US, AND IT IS NOW LOST, SO &
		!		SET THE ERROR FLAG; &
		!		SET THE ERROR TEXT; &
		!		GO SET UP THE RECEIVER LOCATION. &

23070	IF ERR=5% THEN &
		RESUME 23080 &
	ELSE	E%=ERR &
	\	T$="No room in Receiver Table" IF E%=4% &
	\	T$="Duplicate Receiver ID" IF E%=18% &
	\	T$=RIGHT(SYS(CHR6.9$+CHR$(E%)),4%) IF E%<>4% AND E%<>18% &
	\	E%=-1% &
	\	RESUME 23900 &
		! IF THE ERROR WAS AN ERROR 5, THEN &
		!	THIS IS THE EXPECTED ERROR - IT MEANS THAT NO &
		!	 MESSAGES WERE READY FOR THIS JOB, AS THEY &
		!	 SHOULD NOT BE, SINCE THE JOB JUST BECAME A &
		!	 RECEIVER - SO PROCEED AS NORMAL; &
		! ELSE	SOME REAL ERROR OCCURRED - &
		!	SET UP TEXT FOR 'NO ROOM'; &
		!	SET UP TEXT FOR RSTS/E ERROR MESSAGE IF THE &
		!	 ERROR WAS NOT 'NO ROOM'; &
		!	SET THE ERROR FLAG; &
		!	GOTO 23900. &

23080	J0%=SWAP%(CVT$%(MID(SYS(UU1$),29%,2%))) &
	\ IF J0%=0% THEN &
		GOTO 23900 &
	  ELSE	J0%=J0%+14% &
	\	R%=R% OR 2048% &
	\	GOTO 23900 &
		! TAKE THE ADDRESS OF THE MESSAGE RECEIVER ENTRY OUT OF &
		!  JDB2; &
		! IF THE ADDRESS IS 0, THEN &
		!	WE FAILED TO ENTER OURSELVES, SO GO EXIT; &
		! ELSE	SET J0% TO POINT TO THE PLACE IN THE MESSAGE &
		!	 RECEIVER ENTRY WHEREIN IS STORED THE COUNT OF &
		!	 MESSAGES QUEUED FOR THIS JOB (THE COUNT IS IN &
		!	 THE HIGH BYTE OF THIS WORD); &
		!	SET THE 'ENTERED AS RECEIVER' FLAG; &
		!	EXIT. &
	&
	&

23100	&
	&
	&
	!	S E N D    O N L I N E    T O    O P S E R &
	&

23110	T0$=CHR6.18.M1.0$+ &
		MID(SYS(CHR6.M10$+"OPSER"),7%,4%) &
	\ IF (R% AND 4096%)<>0% THEN &
		GOTO 23900 &
	  ELSE	R%=FNPUSH%(R%) &
	\	R%=R% AND -16385% &
	\	T$=CHR192$+"ONLINE 2" &
	\	GOSUB 23500 &
	\	R%=FNPOP% OR R% &
	\	GOTO 23900 &
		! FIRST, SET UP THE STRING TO BE USED IN THE SEND TO &
		!  OPSER, REGARDLESS OF WHETHER OR NOT THE JOB HAS &
		!  ALREADY DONE AN ONLINE TO OPSER OR NOT - THE &
		!  ROUTINE IS CALLED BY THE SET-UP ROUTINES TO ENSURE &
		!  THAT THE COMMUNICATION STRING IS BUILT PROPERLY; &
		! IF THE JOB HAS ALREADY DONE AN ONLINE, THEN &
		!	GOTO THE EXIT; &
		! ELSE	PUSH THE CURRENT PROGRAM STATUS AND RESET THE &
		!	 ATTACHED FLAG TO FORCE A SEND TO OPSER; &
		!	SET UP THE TEXT TO SEND AS 'ONLINE'; &
		!	GO ISSUE AN OPERATOR MESSAGE; &
		!	POP THE OLD VALUE OF THE STATUS WORD; &
		!	AND EXIT. &
		!	(IF THE SEND WAS SUCCESSFUL, THE SEND ROUTINE &
		!	HAS SET THE 'ONLINE' FLAG IN THE STATUS WORD.) &

23120	&
	&
	&
	!	S E N D    A N    O F F L I N E    T O    O P S E R &
	&

23130	WHILE (R% AND 4096%)<>0% &
	\	R%=FNPUSH%(R%) &
	\	R%=R% AND -16385% &
	\	T$=CHR192$+"OFFLINE" &
	\	GOSUB 23500 &
	\	R%=FNPOP% AND -4097% &
	\ NEXT &
	\ GOTO 23900 &
		! IF THE 'ONLINE TO OPSER' FLAG IS NON-ZERO, THEN &
		!	PUSH THE STATUS; &
		!	FORCE AN 'OFFLINE' TO OPSER; &
		!	POP THE STATUS AND RESET THE 'ONLINE' FLAG. &
	&
	&
	&
	&

23500	&
	&
	&
	!	S E N D    T O    O P E R A T O R &

23510	R%=R% AND -513% &
	\ R8%=0% &
	\ Z%=FNPUSH%(P%) &
	\ P%=0% &
	\ IF (R% AND 1024%)=0% THEN &
		R1$=T$ &
	\	IF F1%<0% AND (F1% AND F2%)>=0% THEN &
			R%=R% OR 1024% OR 512% &
	\		T$=C8$+T$ &
		! RESET THE <CR><LF> INHIBIT FLAG; &
		! SET THE RETRY COUNTER FOR THE 'SEND' ROUTINE TO 0; &
		! PUSH THE CURRENT VALUE OF P%, SINCE THE ROUTINE WILL &
		!  USE P% AS A POSITION POINTER; &
		! SET THE VALUE OF P%; &
		! IF A MESSAGE IS NOT CURRENTLY STORED, THEN &
		!	STORE THIS ONE; &
		!	IF THIS MESSAGE IS A REQUEST (IE, THE 'USER &
		!	 RESPONSE' FLAG IN THE EVENT WORD IS SET AND &
		!	 IT IS NOT SET IN THE STATUS WORD), THEN &
		!		SET THE 'MESSAGE STORED' AND &
		!		 <CR><LF> INHIBIT FLAGS; &
		!		PUT A <BELL> ON THE FRONT OF THIS &
		!		 MESSAGE TO SIGNIFY AN ACTION REQUEST. &

23520	IF (R% AND 16384%) THEN &
		RESUME 23550 &
	  ELSE	ON ERROR GOTO 23530 &
	\	WHILE P%<LEN(T$) &
	\		Z%=LEN(T$)-P%+1% &
	\		Z%=255% IF Z%>20% &
	\		Z$=SYS(T0$+CHR$(Z%)+RIGHT(T$,P%+1%)) &
	\		R8%=0% &
	\		P%=P%+19% &
	\	NEXT &
	\	R%=R% OR 4096% &
	\	GOTO 23560 &
		! IF THE JOB IS FLAGGED AS ATTACHED, THEN &
		!	GO TO THE 'PRINT' ROUTINE; &
		! ELSE	SET ERROR TRAP; &
		!	SEND THE MESSAGE TO OPSER, 19 BYTES AT A TIME, &
		!	 USING THE STRING, T0$, SET UP BY THE 'ONLINE' &
		!	 ROUTINE; &
		!	SET THE 'ONLINE' FLAG. &

23530	IF ERR=32% THEN &
		R8%=R8%+1% &
	\	IF R8%<60% THEN &
			SLEEP 5% &
	\		RESUME 23520 &
		! IF THE ERROR MEANT 'NO ROOM FOR MESSAGE', THEN &
		!	INCREMENT THE RETRY COUNTER; &
		!	IF THE COUNTER IS STILL LESS THAN 60, THEN &
		!		SLEEP AWHILE; &
		!		TRY AGAIN TO SEND THE MESSAGE. &

23540	R%=(R% AND -4097%) OR 16384% &
	\ T$=T$+C9$+" ***** OPSER hung ***** "+C9$ &
	\ E%=-1% &
	\ RESUME 23550 &
		! IF THE ERROR WAS ANYTHING OTHER THAN 'NO ROOM', OR IF &
		!  THE RETRY COUNTER HAS EXPIRED, THEN &
		!	SET THE ATTACHED FLAG AND RESET THE ONLINE TO &
		!	 OPSER FLAG; &
		!	APPEND AN EXPLANATION TO THE MESSAGE; &
		!	SET AN ERROR; &
		!	GO PROCESS AS IF ATTACHED. &

23550	IF (R% AND 16384%) THEN &
		ON ERROR GOTO 0 &
	\	PRINT #0% IF CCPOS(0%) &
	\	PRINT #0%,T$; &
	\	PRINT #0% IF (R% AND 512%)=0% &
		! IF ATTACHED, THEN &
		!	RESET ERROR TRAP; &
		!	MAKE SURE THAT THE CARRIAGE IS AT THE LEFT &
		!	 MARGIN; &
		!	PRINT THE STRING WITHOUT <CR><LF>; &
		!	PRINT A <CR><LF> IF THE <CR><LF> INHIBIT FLAG IS &
		!	 NOT SET. &

23560	P%=FNPOP% &
	\ R%=R% OR NOT32767% &
	\ GOTO 23900 &
		! RESTORE THE ORIGINAL VALUE OF P%; &
		! SET THE 'PROMPT REQUIRED' FLAG; &
		! EXIT. &

23900	RETURN &
		! COMMON EXIT. &

25200	DEF* FNR%(S$,L%) &
	\ FNR%=0% &
	! 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 Z%=Z%+1% UNLESS Z$="" &
	  \ GOTO 25230 UNLESS Z$="" &
		! SEARCH FOR MORE MATCHING CHARACTERS. &

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

25250	FNEND &
	&
	&
	&

25500	DEF* FNF0%(P0%,N$,D$) &
	! FUNCTION:	FNF0%	APPLY 'NULL REPLACE' AND 'DEFAULTS' &
	!			TO ENTRY IN SUBSCRIPT P0%. &
	! PARAMETERS:	P0%	SUBSCRIPT OF ENTRY TO BE AFFECTED &
	!		N$	NULL REPLACE STRING &
	!		D$	DEFAULT STRING &
	! RETURNS:	FNF0%	????? &
	!		Z0%(P0%,X) &
	!			RECORD WITH NULL REPLACE OR DEFAULTS &
	!			APPLIED &

25510	IF (Z0%(P0%,14%) OR Z0%(P0%,15%))=0% THEN &
		Z%=FNP%(P0%,0%,N$,0%,0%) &
	\	Z0%=Z0%(P0%,14%) &
	\	GOTO 25680 &
		! IF NOTHING IN THE RECORD, APPLY 'NULL REPLACE'. &

25520	Z%=FNP%(-1%,0%,D$,0%,0%) &
	\ Z%=Z%(14%) &
	\ Z0%=Z0%(P0%,14%) &
	\ GOTO 25600 IF Z%=0% &
		! HOLD FW2 OF RECORD TO BE EFFECTED IN Z0%; &
		! DO FSS CALL ON THE 'DEFAULT STRING'; &
		! HOLD FW2 OF 'DEFAULT STRING' IN Z%; &
		! SKIP REPLACE IF DEFAULT STRING IS NULL. &

25530	&
	&
	&
	!	A P P L Y    F I L E N A M E    D E F A U L T S &

25540	IF (Z0% AND 4096%)=0% THEN &
		Z0%(P0%,13%)=(Z%(13%) AND 32767%) OR &
			(Z0%(P0%,13%) AND NOT (32767%) AND &
			((STATUS AND 256%)=0%)) &
	\	Z0%(P0%,Z3%)=Z%(Z3%) FOR Z3%=6% TO 7% &
	\	Z0%=Z0% OR (Z% AND -4096%) &
		! DEFAULT THE DEVICE AND DHI FLAG WORD. &

25550	IF (Z0% AND 128%)=0% THEN &
		Z0%(P0%,8%)=Z%(8%) &
	\	Z0%(P0%,25%)=Z%(25%) &
	\	Z0%=Z0% OR (Z% AND 896%) &
		! DEFAULT THE PPN. &

25560	IF (Z0% AND 1%)=0% THEN &
		Z0%(P0%,Z3%)=Z%(Z3%) FOR Z3%=9% TO 10% &
	\	Z0%=Z0% OR (Z% AND 7%) &
		! DEFAULT THE FILENAME. &

25570	IF (Z0% AND 8%)=0% THEN &
		Z0%(P0%,11%)=Z%(11%) &
	\	Z0%=Z0% OR (Z% AND 120%) &
		! DEFAULT THE EXTENSION. &

25580	IF (Z0% AND 1024%)=0% THEN &
		Z0%(P0%,12%)=Z%(12%) &
	\	Z0%=Z0% OR (Z% AND 3072%) &
		! DEFAULT THE PROT/STATUS. &

25590	Z0%(P0%,14%)=Z0% &
		! PUT IN ALL THE NEW VALUES. &

25600	&
	&
	&
	!	A P P L Y    C H A R A C T E R I S T I C &
	!		D E F A U L T S &

25610	Z0%=Z0%(P0%,15%) &
	\ Z%=Z%(15%) &
		! SET UP THE TWO FLAG WORDS FOR THE CHARACTERISTICS. &

25620	IF (Z0% AND 2048%)=0% THEN &
		Z0%(P0%,18%)=Z%(18%) &
	\	Z0%=Z0% OR (Z% AND 2048%) &
		! DEFAULT THE CLUSTERSIZE. &

25630	IF (Z0% AND 4096%)=0% THEN &
		Z0%(P0%,16%)=Z%(16%) &
	\	Z0%=Z0% OR (Z% AND 4096%) &
		! DEFAULT THE MODE. &

25640	IF (Z0% AND 8192%)=0% THEN &
		Z0%(P0%,19%)=Z%(19%) &
	\	Z0%=Z0% OR (Z% AND 8192%) &
		! DEFAULT THE FILESIZE. &

25670	Z0%(P0%,15%)=Z0% &
		! PUT THE NEW DATA INTO THE SELECTION SPECIFICATION &
		! WORD. &

25680	FNF0%=Z0%(P0%,14%) &
		! SET RETURNED VALUE. &

25690	FNEND &
		! AND EXIT. &
	&
	&
	&
	&
	&

25800	DEF* FNP%(P0%,P%,S$,Y0%,Y1%) &
	! FUNCTION:	FNP%	DO (NEW) FSS ON STRING S$, STARTING FROM &
	!			POSITION P%,AND RETURN THE DATA IN ARRAY &
	!			Z0%(P0%,X%), AND THE NEW CHARACTER POSITION &
	!			IN THE FUNCTION'S VALUE. &
	! PARAMETERS:	P0%	RECORD NUMBER IN Z0%(?,?) IN WHICH TO RETURN &
	!			THE DATA &
	!		P%	CHARACTER POSITION AFTER WHICH TO START THE &
	!			SCAN. &
	!		S$	STRING TO SCAN &
	!		Y0%	FIELD PROHIBIT WORD - SAME LAYOUT AS THAT &
	!			OF FLAG WORD 2 OF THE FSS SYS() CALL - &
	!			ANY BIT SET IN THIS WORD WHOSE CORRESPONDING &
	!			BIT IS SET IN THE FW2 RETURNED BY THE SYS() &
	!			CALL WILL RETURN E%=130%. &
	!		Y1%	DEVICE PROHIBIT/EXTRA FLAG/EXTRA SWITCH PROHIBIT &
	!			WORD - IF ANY BIT IS SET IN THIS WORD AND THE &
	!			CORRESPONDING BIT IS SET IN THE DEVICE HANDLER &
	!			INDEX (BITS 0-13) OF THIS WORD, E%=134% &
	!			IS RETURNED; IF ANY SUCH &
	!			CONDITION OCCURS IN THE TOP TWO BITS, &
	!			E% IS RETURNED AS 130%. &
	! GLOBAL VARIABLES EFFECTED: &
	!		E%	ERROR VALUE, IF ANY. &
	!		Z0%(P0%,X%) &
	!			THIS IS THE ULTIMATE PURPOSE OF THIS FUNCTION - &
	!			THIS WILL BE RETURNED AS AN INDEX-FILE FORMAT &
	!			REPRESENTATION OF THE SCANNED STRING. &
	!		Z%(30%)	USED FOR FSS FORMATTED STRING INTERMEDIATE &
	!			STORAGE; RETURNED IN THE SAME FORMAT AS THE &
	!			Z0%(P0%,X) ENTRY. &
	! LOCAL VARIABLES USED: &
	!		Z%	FOR LOOP COUNTER AND VARIOUS OTHER TEMPORARY &
	!			PURPOSES &
	!		Z1%(30%) &
	!			AS INTERMEDIATE STORAGE FOR THE STRING &
	!			RETURNED BY THE FSS CALL. &
	! RETURNS:	FNP%	POSITION OF THE CHARACTER AFTER THE LAST ONE &
	!			SCANNED.  IF ERROR (E%<>0%), THIS IS THE &
	!			SAME AS THE BEGIN POSITION ON ENTRY TO &
	!			THE FUNCTION (IE, P%, ABOVE). &
	! ERRORS EXPECTED: &
	!	E%=2	ILLEGAL FILENAME &
	!			IF THE FILENAME SPECIFIED DOES NOT &
	!			CONSTITUTE A VALID RSTS/E FILE SPEC. &
	!	E%=6	NOT A VALID DEVICE &
	!			IF THE DEVICE SPECIFIED IS INVALID. &
	!	E%=130	ILLEGAL FILENAME+ &
	!			IF SOME PROHIBITED FIELD, INCLUDING &
	!			ABSOLUTE DEVICE UNIT OR ANOTHER PPN, &
	!			WHEN PROHIBITED, WAS SPECIFIED. &
	!	E%=134	NOT A VALID DEVICE+ &
	!			WHEN A PROHIBITED DEVICE IS SPECIFIED. &
	&
	&

25810	ON ERROR GOTO 25880 &
	\ CHANGE SYS(CHR6$+CHR$(-23%)+RIGHT(S$,P%+1%)) TO Z1% &
	\ Z1%(Z%)=Z1%(Z%)+SWAP%(Z1%(Z%+1%)) FOR Z%=1% TO 29% STEP 2% &
	\ Z1%(29%) = Z1%(29%) AND NOT 2048% &
	\ FNP%=LEN(S$)-RECOUNT &
		! SET UP ERROR TRAP; DO THE SYS() CALL FOR FSS; &
		! PACK THE RETURNED DATA INTO THE ODD WORDS IN THE TEMP &
		! ARRAY; AND UPDATE CURRENT POSITION IN THE SOURCE &
		! STRING. &
		! PATCHED BY JAC, 04/24/85: &
		!  DON'T CHECK IF A DEFAULT PROTECTION CODE IS SET &

25820	IF (Z1%(29%) AND -28672%)=4096% THEN &
		S$=CVT%$(SWAP%(Z1%(23%))) &
	\	S$=S$+FNU0$(Z1%(25%)) IF Z1%(25%)<0% &
	\	S$=MID(SYS(CHR6.M10$+S$+":"+S$),7%,4%) &
	\	Z1%(23%)=SWAP%(CVT$%(S$)) &
	\	Z1%(25%)=SWAP%(CVT$%(RIGHT(S$,3%))) &
		! IF DEVICE NAME EXISTS AND IS NOT LOGICAL (IE, ALREADY IN &
		! RAD50 FORM), THEN CONVERT IT TO RAD50 FORM USING THE &
		! FSS SYS() CALL. &

25830	Z%=(STATUS AND 255%)/2% &
	\ Z%=(2%^Z%) AND (Z1%(29%)>0%) AND 16383% &
	\ Z%=Z% OR NOT(32767%) IF &
		A%<>Z1%(5%) AND (A% AND -512%)<>0% &
		AND (Z1%(29%) AND 896%)=128% &
	\ Z%=Z% OR 16384% IF Z1%(26%)=255% AND (Z1%(29%)>0%) &
	\ Z1%(14%)=Z% &
		! SET UP FLAGS:	Z1%(14%) &
		!		LOW ORDER 14 BITS USED FOR BIT-ENCODED DHI; &
		!		TOP 2 BITS USED FOR FLAGS AS FOLLOWS: &
		!			-32768	ACCOUNT DOESN'T MATCH A% &
		!				AND A% IS NOT PRIV'D &
		!			16384	SPECIFIC DEVICE UNIT REQUESTED &
	&

25835	E%=130% IF (Y0% AND Z1%(29%))<>0% &
	\ E%=134% IF (Y1% AND Z1%(14%) AND 32767%)<>0% &
	\ E%=130% IF (Y1% AND Z1%(14%))<0% AND (STATUS AND 256%)=0% &
	\ GOTO 25890 IF E%<>0% &
		! CHECK FOR PROHIBITED SWITCHES, PROHIBITED DEVICES. &

25840	Z%(Z%)=0% FOR Z%=0% TO 30% &
	\ Z%(6%)=Z1%(23%) \ Z%(7%)=Z1%(25%) &
	\ Z%(8%)=Z1%(5%) &
	\ Z%(9%)=Z1%(7%) \ Z%(10%)=Z1%(9%) &
	\ Z%(11%)=Z1%(11%) &
	\ Z%(12%)=Z1%(21%) &
	\ Z%(13%)=Z1%(14%) &
	\ Z%(14%)=Z1%(29%) &
	\ Z%(16%)=Z1%(17%) AND 32767% &
	\ Z%(18%)=Z1%(15%) &
	\ Z%(19%)=Z1%(13%) &
	\ Z%(15%)=(Z1%(27%) AND 7%)*2048% &
	\ Z%=Z%(8%) &
	\ Z%(25%)=(255% AND (Z% AND 255%)<>255%) OR (-256% AND &
		(Z% AND -256%)<>-256%) &
		! SET UP ARRAY TO RETURN: &
		!	 DATA			WORD(S) &
		!	DEVICE NAME		6,7 &
		!	ACCOUNT			8 &
		!	FILENAME (2 WORDS)	9,10 &
		!	EXTENSION		11 &
		!	PROT/STATUS		12 &
		!	DHI AND FLAGS		13 &
		!	FLAG WORD 2		14 &
		!	/MO/CL/FI FLAGS		15 &
		!	/MODE VALUE		16 &
		!	/CLUSTERSIZE VALUE	18 &
		!	/FILESIZE VALUE		19 &
		! SET UP SELECTION SPECIFICATION WORD WITH THE &
		! MODE, CLUSTERSIZE, AND FILESIZE FLAGS AS RETURNED &
		! FROM FILENAME STRING SCAN; &
		! SET UP ACCOUNT SELECTION WORD FOR FUNNY ALGORITHM &
		! FOR ACCOUNT SELECTION. &

25850	IF P0%>-1% THEN &
		Z0%(P0%,Z%)=Z%(Z%) FOR Z%=6% TO 19% &
	\	Z0%(P0%,25%)=Z%(25%) &
		! PUT THE RESULT IN THE WORK-FILE UNLESS INSTRUCTED &
		! OTHERWISE (IE, UNLESS P0%<0%). &

25860	ON ERROR GOTO 19000 &
		! RESET ERROR TRAP. &

25870	FNEND &
		! AND WE'RE DONE. &
	&

25880	E%=ERR &
		! SOME FILENAME ERROR. &

25890	Z0%(P0%,0%)=0% UNLESS P0%<0% &
	\ FNP%=P% &
	\ RESUME 25860 &
		! SET UP ERROR NUMBER AND BEGIN POSITION OF STRING IN &
		! ERROR. &
	&
	&
	&
	&

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%) &

25910	Z%=Z% AND Z0%(P0%,14%) &
	\ Z%=Z% AND -3201% IF (Z0%(P0%,13%) AND 1914%)<>0% &
		IF Z0%(P0%,14%)>0% &
	\ C$="" &
		! 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. &
	&

25920	C$=RAD$(Z0%(P0%,6%))+RAD$(Z0%(P0%,7%))+":" IF (Z% AND 4096%)<>0% &
	\ C$=C$+"["+FNU0$(SWAP%(Z0%(P0%,8%)))+","+FNU0$(Z0%(P0%,8%))+ &
		"]" IF (Z% AND 128%)<>0% &
	\ C$=C$+RAD$(Z0%(P0%,9%))+RAD$(Z0%(P0%,10%)) IF (Z% AND 1%)<>0% &
	\ C$=C$+"."+RAD$(Z0%(P0%,11%)) IF (Z% AND 8%)<>0% &
	\ C$=C$+"<"+FNU0$(SWAP%(Z0%(P0%,12%)))+">" IF (Z% AND 3072%)<>0% &
		! 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. &

25930	Z0%=Z0% AND Z0%(P0%,15%) AND 14336% &
	\ IF Z0%<>0% THEN &
		C$=C$+"/CL:"+NUM$(Z0%(P0%,18%)) IF (Z0% AND 2048%)<>0% &
	\	C$=C$+"/MO:"+NUM$(Z0%(P0%,16%)) IF (Z0% AND 4096%)<>0% &
	\	C$=C$+"/FI:"+NUM$(Z0%(P0%,19%)) IF (Z0% AND 8192%)<>0% &
		! SET UP Z0% TO HOLD ONLY THE FLAGS SET BOTH IN THE &
		! OPEERAND 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 &

25960	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%,PPN%) &
	\ 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. &

26010	GOTO 26090 IF E%<>0% &
	\ Z0%(P0%,16%)=4096% IF A0%=8% &
	\ IF (A0% AND 4%)<>0% THEN &
		A0%=A0% AND 3% &
	\	IF (Z0%(P0%,13%) AND (1%+8%+128%))<>0% THEN &
			Z0%(P0%,15%)=Z0%(P0%,15%) OR 4096% &
	\		Z0%=Z0%(P0%,13%) &
	\		Z%=Z0%(P0%,16%) &
	\		Z%=2% IF (Z0% AND 1%)<>0% &
	\		Z%=Z% OR 8192% IF (Z0% AND 8%)<>0% &
	\		Z%=128% IF (Z0% AND 128%)<>0% &
	\		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. &

26012	ON ERROR GOTO 26070 &
	\ GOTO 26020	IF PPN% = 0% &
	\ PRIV.MASK$ = MID(SYS(CHR$(6%)+CHR$(-25%)+CHR$(-1%)+CHR$(2%) &
		+CVT%$(SWAP%(PPN%))),9%,8%) &
			! DROP OUT IF WE AREN'T USING 3rd PARTY PRIVS &
			! GET THE OWNER PRIV MASK FROM DISK &

26014	DUMMY$ = SYS(CHR$(6%)+CHR$(31%)+STRING$(2%,0%) &
		+CVT%$(SWAP%(PPN%))+PRIV.MASK$) &
			! INSTALL THIRD PARTY PRIV CHECK &

26020	Z$=SYS(CHR6.M21.M1$) UNLESS A0%=8% &
	\ Z$=FNU$(P0%,"",-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 &

26030	DUMMY$ = SYS(CHR$(6%)+CHR$(31%))	IF PPN% &
			! DROP THIRD PARTY PRIV CHECK &

26050	Z$=SYS(CHR6.M21.0$) UNLESS A0%=8% &
	\ ON ERROR GOTO 19000 &
		! RECOVER PRIVILEGES; &
		! RESET ERROR TRAP. &

26060	FNEND &
		! AND EXIT. &

26070	IF	ERL = 26012% &
	THEN	PRIV.MASK$ = STRING$(8%,0%) &
		\ RESUME 26014 &
		! TRY READING THIRD PARTY PRIVS, RETURN NULLS IF ERROR &

26080	E%=ERR \ RESUME 26090 &
		! THIS IS FOR ERRORS TRAPPED IN THE OPEN. &

26090	E%=E% OR 1024% \ GOTO 26030 &
		! 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. &

26110	B0%=Z0%(0%,0%) IF B0%=0% &
	\ 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%)="" &
	\ FNA%=Z0% &
		! ZERO OUT THE RETURNED ENTRY AND SET FUNCTION VALUE. &

26130	FNEND &
		! END OF FNA%. &
	&

26200	DEF* FNA0%(P0%) &

26210	Z0%,Z2%=P0% &
	\ Z0%=Z0%(Z0%,1%) WHILE Z0%(Z0%,1%)<>0% &
	\ FOR Z%=2% TO 5% &
	\	Z2%=P0% &
	\	WHILE Z2%<>0% &
	\		IF Z0%(Z2%,Z%)<>0% THEN &
				Z3%=Z0%(Z2%,Z%) &
	\			Z0%(Z2%,Z%)=0% &
	\			Z0%,Z0%(Z0%,1%)=Z3% &
	\			Z0%=Z0%(Z0%,1%) WHILE Z0%(Z0%,1%)<>0% &

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

26230	FNEND &
	&

27000	DEF* FNCHNGE%(S$) &
	! FUNCTION :	CHANGE THE STRING S$ INTO THE INTEGER ARRAY &
	!		Z%(30%), PADDING TO 30 CHARACTERS WITH 0, AND &
	!		CONVERT EACH TWO BYTES TO ONE INTEGER. &

27010	CHANGE S$ TO Z% &
	\ Z%(Z%)=0% FOR Z%=Z%(0%)+1% TO 30% &
	\ Z%(Z%)=Z%(Z%)+SWAP%(Z%(Z%+1%)) FOR Z%=1% TO Z%(0%) STEP 2% &
	\ FNCHNGE%=0% &
		! CHANGE THE STRING; &
		! PAD OUT TO 30; &
		! DO THE SWAP/ADDS; &
		! SET A FUNCTION VALUE. &

27020	FNEND &
	&
	&
	&

27100	DEF* FNYES.NO% &
	! FUNCTION :	FNYES.NO% &
	! OPERANDS :	NONE &
	! PARAMETERS :	P%	CURRENT POSITION IN THE INPUT STRING; &
	!		C$	CURRENT INPUT STRING &
	! RETURNS :	2%	IF A 'YES' WAS FOUND IN THE CURRENT &
	!			 POSITION OF THE INPUT STRING; &
	!		1%	IF A 'NO' WAS FOUND IN THE CURRENT &
	!			 POSITION IN THE INPUT STRING; &
	!		0%	OTHERWISE. &
	! USES :	FNR%()	TO DETERMINE IF THE 'YES' OR 'NO' IS &
	!			 FOUND. &
	! NEVER SETS E%, BUT MAY RETURN E% SET BY FNR%. &

27110	FNYES.NO%=0% &
	\ IF FNR%("YES",1%)<>0% THEN &
		FNYES.NO%=2% &
	  ELSE	IF E%=0% THEN &
			IF FNR%("NO",1%)<>0% THEN &
				FNYES.NO%=1% &
		! SET UP THE 'NOT FOUND' VALUE; &
		! IF 'YES' IS FOUND, THEN &
		!	RETURN A 1; &
		! ELSE	IF THE ERROR VALUE IS 0, THEN &
		!		IF 'NO' IS FOUND, THEN &
		!			RETURN A 2. &

27120	FNEND &

27200	DEF* FNN% &
	\ FNN%,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. &

27210	ON ERROR GOTO 27250 &
	\ Z%=P%-1% &
	\ Z0%=-1% &
		! SET LOCAL ERROR HANDLER. &
		! SET LOCAL CHARACTER POINTER. &
		! INITIALIZE ASCII DIGIT FLAG. &

27220	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. &

27230	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. &

27240	ON ERROR GOTO 19000 &
	\ FNN%=0% IF E%<>0% &
	\ FNEND &
		! RESET THE ERROR HANDLER. &
		! IF AN ERROR OCCURED, RETURN ZERO RESULT &
		! RETURN.
27250	E% = 512%+52%	IF ERR/10% = 5% &
	\  RESUME 27240 &
	! HANDLE DATA ERRORS IN VAL FUNCTION &
	&

27400	DEF* FNPUSH%(VALUE%) &
	&
	\ S%=S%+1% \ S%(S%),FNPUSH%=VALUE% &
	&
	\ FNEND &

27410	DEF* FNPOP% &
	&
	\ FNPOP%=S%(S%) \ S%=S%-1% &
	&
	\ FNEND &

27500	DEF* FNPRV%(PRIV$,DROP%) &
	\ PRIV.OFF$ = SYS(CHR$(6%)+CHR$(-21%)+CHR$(255%))  IF DROP% &
	\ CHANGE SYS(CHR$(6%)+CHR$(32%)+CHR$(1%)+STRING$(3%,0%)+ &
		PRIV$) TO M0% &
	\ FNPRV% = (M0%(3%)=0%) &
	\ PRIV.ON$ = SYS(CHR$(6%)+CHR$(-21%)+CHR$(0%))  IF DROP% &
	\ FNEND &
	! Check to see if job currently has privileged named &
	! If privileged then return -1% &
	! Else return 0% &
	! Drop temp-privs if DROP%<>0% &
	&
	&
	&

31000	&
	&
	&
	!	C H A I N    E N T R Y &

31010	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	&
	&
	&
	!	C L E A N    U P    R O U T I N E &

32710	IF FATAL.ERR% THEN &
		T$ = "?" + C9$ + "Spool Program = " + &
		 RAD$(Z0%(0%,51%)) + RAD$(Z0%(0%,52%)) + &
		  "  Version = V" + RAD$(SWAP%(Z0%(0%,53%))) + &
		   "  Edit Level = " + RAD$(SWAP%(Z0%(0%,54%))) + &
		     C9$ &
	\	T$ = T$ + "Rcvr ID = " + RAD$(Z0%(0%,23%)) + &
		 RAD$(Z0%(0%,24%)) + "    Controlled Device = " + &
		  CVT$$(FNU$(Q9%,NULSTG$,1%,0%),2%) + ":/Unit:" + &
		  FNU0$(Z0%(Q9%,11%)) + " (" + &
		   FNU$(Q9%,NULSTG$,4096%,0%) + ")" + C9$ &
	\	T$=T$+"Error = ("+NUM1$(Z0%(0%,49%))+") "+ &
		   CVT$$(RIGHT(SYS(CHR$(6%) + CHR$(9%) + &
		   CHR$(Z0%(0%,49%))),4%),4%) + &
		    "  at line " + NUM1$(Z0%(0%,50%)) + C9$ &
	\	T$=FNM0$(T$,Z0%(0%,27%),Z0%(Z0%(0%,27%),27%),0%,0%) IF &
		  Z0%(0%,27%) &
	\	T$ = T$ + C9$ + &
		   " ***** Spooler will go OFF-LINE *****" + &
		     C9$ &
	\	GOSUB 23500
32720	 GOSUB 20320 IF (R% AND 8192%) &
	\ GOSUB 23120 IF (R% AND 4096%) &
	\ Z$=SYS(CHR$(6%)+CHR$(18%)) &
	\ ON ERROR GOTO 32730 &
	\ KILL W$ &
	\ GOTO 32740
32730	RESUME 32740
32740	 IF (R% AND 16384%)=0% THEN &
		Z%(Z%)=0% FOR Z%=0% TO 30% &
	\	Z%(0%)=30% \ Z%(1%)=6% \ Z%(2%)=8% &
	\	Z%(3%)=J% \ Z%(28%)=-1% &
	\	CHANGE Z% TO Z$ &
	\	Z$=SYS(Z$) &
	\	STOP &
		! OUTPUT FATAL ERROR STATISTICS : &
		!	PROGRAM NAME &
		!	VERSION NUMBER &
		!	EDIT LEVEL &
		!	ERROR NUMBER &
		!	ERROR TEXT &
		!	ERROR LINE NUMBER &
		! SEND TO OPSER (OR THE KB: IF ATTACHED) &
	&
		! GO OFFLINE TO QUEMAN IF ONLINE; &
		! GO OFFLINE TO OPSER IF ONLINE; &
		! REMOVE AS RECEIVER; &
		! SET ON ERROR FOR KILL ROUTINE; &
		! KILL SPOOL WORK FILE; &
	&
		! IF NOT ATTACHED, THEN &
		!	SET UP TO AND ACTUALLY KILL THIS JOB. &

32767	END
