TITLE	LPTSPL  --  Disk to Line-printer Spooler  -  version 102
SUBTTL	D.A. Lewine - L.S. Samberg/LSS	29 Mar 77


;Copyright (C)  1970,71,72,73,74,75,76,77,
;	 Digital Equipment Corp., Maynard, MA.

;ASSEMBLY AND LOADING INSTRUCTIONS
;
;	.COMP LPTSPL
;	.LOAD /REL LPTSPL
;	.SSAVE LPTSPL


	SEARCH	QSRMAC			;SEARCH GALAXY PARAMETERS
	PROLOGUE(LPTSPL)
IFN FTJSYS,<
	SEARCH	RMSSYM
>  ;END IFN FTJSYS

	.REQUIRE	SBSCOM		;SUBSYSTEM COMMON MODULE
	.REQUIRE	CSPQSR		;QUASAR INTERFACE MODULE
	.REQUIRE	CSPMEM		;MEMORY MANAGER

IF1,<
IFN FTJSYS,<PRINTX ASSEMBLING GALAXY-20 LPTSPL>
IFN FTUUOS,<PRINTX ASSEMBLING GALAXY-10 LPTSPL>
>  ;END IF1
	SALL				;SUPPRESS MACRO EXPANSIONS

;VERSION INFORMATION
	LPTVER==102			;MAJOR VERSION NUMBER
	LPTMIN==0			;MINOR VERSION NUMBER
	LPTEDT==2263			;EDIT LEVEL
	LPTWHO==0			;WHO LAST PATCHED

	%LPT==<BYTE (3)LPTWHO(9)LPTVER(6)LPTMIN(18)LPTEDT>

;STORE VERSION NUMBER IN JOBVER
	LOC	137
.JBVER::EXP	%LPT

	TWOSEG				;TWO SEGMENT PROGRAM
	RELOC	400000			;START IN HISEG
	SEG==-1				;AND FLAG US IN HISEG
SUBTTL	Revision History

;2000	First field-test release of GALAXY-10, June,1975.

;2050	Make this version 101, Sept, 1975
;2056	On HELP command, just go thru and give a list
;	of valid commands.
;2060	In initialization, read LPFORM.INI into core, and
;	simply rescan the buffer on a forms change.
;2074	Insert the MONITOR Command as an emergency exit.
;2077	Add new LPFORM switches /ALCNT, /ALSLP.
;2111	Release version 101 on TOPS20, Feb, 1976

;2115
;		START GALAXY 1B DEVELOPMENT
;		MAKE THIS LPTSPL 101A
;	Start converting output device handling to run under
;	TOPS20 without compatibility.
;2122	Start putting in internal LOG code.
;2123	Finish up 2122 and add a new switch to LPFORM, /VFU
;	which is equivalent to /TAPE.
;2124	Change SUPPRESS command to accept keyword argument
;	instead of a switch.
;2125	Add new CSPQSR protocol and new interrupt code.
;2126	Add modifications to allow for new SBSMAC module.
;2133	Remove REQUEUE/C since it is the default.
;2141	Add a mechanism to flush all pending (already buffered)
;	output on KILL.
;2142	Remove station locator option in LPFORM.INI.
;2145	Start putting in support for DAVFUs.
;	 (Direct Access Vertical Forms Unit)
;2147	Rearrange some code so that LPT is always kept open.
;2151	Put in more graceful error recovery for the LP20.
;2154	Invent OUTWON to wait for device to come on-line.
;2156	On TOPS20 allow command processor to run
;	right after interrupt happens.
;2157	Have OPINFL, ACCCHK return TRUE or FALSE
;	rather than diddling DSKOPN.
;2200	Make this version 102, May 1976.
;2201	Fix up control-C handling.
;2202	Ignore line-sequence-numbers in LPFORM.INI.
;2203	Random fixes and cleanup.
;2204	Drive the LPT using non-blocking I/O on -10.
;2205	Change FORMS command to simply tell QUASAR and nothing else.
;2206	More of 2203.
;2207	On TOPS10 build output buffer ring myself.
;	Generate 4 200 word buffers (175+3).
;2210	Start moving operating system dependent code from the START command
;	processor to the OUTGET routine.  Symbolize buffer
;	size parameters for both systems.  Start phasing out the LOCAL
;	macro since it precludes multi-programming LPTSPL.
;2211	Files printed with /HEAD:0 get a blank page
;	between copies because FFSEEN was getting turned off at
;	end-of-file.
;2212	Make KILL work correctly when banners or headers
;	are printing.
;2213	Move more operating system dependent code from START
;	to OUTGET.
;2214	Random code cleanup.
;2215	On -20 dont print LPTDOL  if not busy.
;	On -10 make output buffer 400 words (375+3).
;2216	Rearrange START routine to call OUTGET
;	at the end.  Start putting in hooks for multiple internal
;	log pages.
;2217	Rework log file buffering code again.
;2220	Random code cleanup and bug fixes.
;2221	More of 2220.
;2222	COBOL sixbit files didn't print correctly.
;2223	Remove the MSGLVL command and add the new MESSAGE
;	command.
;2224	More of 2223.
;2225	Make some commands run more reasonably when device is
;	off-line.
;2226	Fix some forms changing problems.
;2227	Start updating LPTSPL to understand the "new" version
;	2 database and -20 structures etc.
;2230	More of 2227.
;2231	Remove all references to P4 and PURGE it.
;2232	Make VFU loading somewhat cleaner and smarter.
;2233	More of 2233 and random cleanup.
;2234	Rework BANNER and TRAILER code.
;2235	Start putting in RMS-20 support.  Make octal number
;	printer produce unsigned numbers.  Recover from
;	front-end reloads on -20.  On -10 turn JACCT off unless
;	I am a remote operator.
;2236	Fix printing of wrong request and file creation time on
;	file header page on -20  [SPR 20-].  New banner page format
;	caused the ruler to print on first data page.
;2237	Clean-up handling of STOP and PAUSE, and put in more RMS support.
;2240	Fix race condition in -20 terminal handler [SPR 20-10042].
;	Finish implementing support for RMS-20 files.
;2241	Take a checkpoint whenever a backspace or forward reaches its
;	destination.  On -10, use normal size buffers for remote printer.
;	Allow Open of LPT on -20 even if off-line.  Fix some RMS
;	releated bugs.
;2242	Fix a number of minor bugs.  Re-read LPFORM.INI on FORMS command.
;2243	Cleanup a number of problems with RMS and other things.
;2244	Add code to load DAVFU.
;2245	Some more RMS fixes.
;2246	Enable for online interrupts on the -10.  Ignore a
;	Request for Checkpoint if lineprinter is off-line.
;2247	Fix a number of minor bugs.
;2250	Use new RMS symbols.

;;First Field-Test Release of GALAXY release 2, Jan. 1977

;2251	The guarenteed log file limit was no being granted due to
;	a bad compare.  A FORMS command given before a START command
;	caused some very strange results (QAR#2).  Setup the LUUO
;	handler before calling OPNFRM (QAR#1).
;2252	Start inserting code for loading DAVFU on -10.
;2253	Fix time printer on -10 to be more accurate (esp.
;	around midnite).  Fix some problems with forms changes.
;2254	Allow 2 (assembly parameter LPTERR) hard lineprinter errors
;	per copy of a file before giving up and resetting.
;2255	More code to load DAVFU on the -10.
;2256	Fix some bugs in 2255 and do some code cleanup.
;2257	Fix the command scanner to see commands which begin with
;	lower-case alphabetics (QAR #5).  If output device is a
;	magtape, write a tape-mark at EOJ.
;2260	Log files which were to be deleted but not printed
;	weren't deleted. If NORMAL/TAPE is found in LPFORM,
;	make that tape the default.  More code for DAVFU on -10.
;2261	Fix a number of minor problems (inc. qar #18).
;2262	More of the same (qar #22 and #23).
;2263	Fix a few minor bugs.
SUBTTL	AC and I/O Channel Definitions

;ACCUMULATOR DEFINITIONS
	S=0		;STATUS FLAGS
	AP=13		;USED TO INTERFACE WITH QSRMEM (AND AS A TEMP)
	E=14		;POINTS TO CURRENT FILE
	N=15		;HOLDS A NUMBER - ALMOST NEVER PRESERVED
	C=16		;HOLDS A CHARACTER - ALMOST NEVER PRESERVED
	J=P4		;JOB PARAMETER BLOCK POINTER

	PURGE	P4	;NOW GET RID OF P4 FOREVER

;INPUT-OUTPUT CHANNELS
	DSK==1		;SPOOLED DATA ON DSK
	LOGF==2		;LOG FILE ON DISK
	LPT==3		;LINEPRINTER
	ALP==5		;FOR ALIGN COMMAND
	VFC==6		;FOR READING DAVFU FILE
	FRM==7		;READ LPFORM.INI
SUBTTL	Parameters

;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME
	ND	PDSIZE,200	;SIZE OF PUSHDOWN LIST
	ND	SLTIME,^D5000	;MS TO WAIT ON ?DEVICE OK
	ND	MAXERR,5	;NUMBER OF DISK I/O ERRS BEFORE PUNTING
	ND	LPTERR,2	;NUMBER OF LPT I/O ERRS BEFORE QUITTING
	ND	FTDPM,0		;OUTPUT TO LPT IN "LINE" MODE.
				;THIS ALLOWS LPT TO BE TURNED OFF AND
				;ON WITHOUT DATA LOSS, AT SOME COST IN
				;CPU TIME.
	ND	LOGPAG,12	;PAGE LIMIT FOR LOG IF OVER QUOTA
	ND	ACCTSW,-1	;-1 TO INCLUDE ACCOUNTING
	ND	TABSIZ,^D50	;SIZE OF BACKSPACE TABLE
	ND	AUTTIM,^D20	;AUTO-TIMEOUT IN MINUTES
	ND	MAXLIM,^D10000	;DEFAULT VALUE OF MLIMIT

IFN FTJSYS,<
	ACCTSW==0		;NO ACCOUNTING YET ON -20
>  ;END IFN FTJSYS



;CONSTANT PARAMETERS
	XP	FCTHDR,<251000,,13>	;FACT ENTRY CODE AND LENGTH
	XP	.EQNOT,.EQLM2+1		;NOTE FIELD IN EXTERNAL REQUEST

;CHECKPOINT BLOCK OFFSETS
	XP	CKFIL,0			;NUMBER OF FILES PRINTED
	XP	CKCOP,1			;NUMBER OF COPIES OF LAST FILE
	XP	CKPAG,2			;NUMBER OF PAGES OF LAST COPY
	XP	CKTPP,3			;TOTAL PAGES PRINTED
	XP	CKFLG,4			;FLAGS
		XP CKFREQ,1B0		;JOB WAS REQUEUED BY OPR
		XP CKFCHK,1B1		;JOB WAS CHECKPOINTED


	SYSPRM	BUFNUM,2,1		;NUMBER OF BUFFERS
	SYSPRM	BUFSPC,1000,1000	;SPACE ALLOCATED FOR BUFFERS
	SYSPRM	BUFSIZ,<1000/BUFNUM>,<1000/BUFNUM>
					;SIZE OF EACH BUFFER
	SYSPRM	BUFCHR,<BUFSIZ-3>*5,<BUFSIZ*5>
					;NUMBER OF CHARS PER BUFFER
	BUFSPC==BUFNUM*BUFSIZ
	SYSPRM	DEFLPT,<SIXBIT/LPT/>,<SIXBIT/PLPT0/>  ;DEFAULT LPT NAME
SUBTTL	MACROS

IFN FTJSYS,<

;MACROS TO MANIPULATE FIELDS IN THE FAB AND RAB FOR RMS-20 FILES

DEFINE $STFAB(AC,FLD),<
	IFNDEF .OF'FLD,<PRINTX FAB FIELD FLD IS UNDEFINED>
	IFDEF  .OF'FLD,<
	..MASK=MASK.(.SZ'FLD,.PS'FLD)
	STORE	AC,J$DFAB+.OF'FLD'(J),..MASK
	>
>  ;END DEFINE $STFAB

DEFINE $LDFAB(AC,FLD),<
	IFNDEF .OF'FLD,<PRINTX FAB FIELD FLD IS UNDEFINED>
	IFDEF  .OF'FLD,<
	..MASK=MASK.(.SZ'FLD,.PS'FLD)
	LOAD	AC,J$DFAB+.OF'FLD'(J),..MASK
	>
>  ;END DEFINE $LDFAB

DEFINE $STRAB(AC,FLD),<
	IFNDEF .OF'FLD,<PRINTX RAB FIELD FLD IS UNDEFINED>
	IFDEF  .OF'FLD,<
	..MASK=MASK.(.SZ'FLD,.PS'FLD)
	STORE	AC,J$DRAB+.OF'FLD'(J),..MASK
	>
>  ;END DEFINE $STRAB

DEFINE $LDRAB(AC,FLD),<
	IFNDEF .OF'FLD,<PRINTX RAB FIELD FLD IS UNDEFINED>
	IFDEF  .OF'FLD,<
	..MASK=MASK.(.SZ'FLD,.PS'FLD)
	LOAD	AC,J$DRAB+.OF'FLD'(J),..MASK
	>
>  ;END DEFINE $LDRAB

	PURGE	$STORE,$LOAD		;PURGE CONFUSING RMS MACROS
>  ;END OF IFN FTJSYS

;FREQUENTLY USED INSTRUCTIONS SEQUENCES

DEFINE	ACTCHR	(CH,A)<
	CAIN	C,"CH"			;;IS THIS A CH
	XLIST
	JRST	A			;YES
	LIST
	SALL
	>




;RELOC TO HISEG

DEFINE	TOPSEG,<
	IFE	SEG,<
	XLIST
	LIT
	SEG==-1
	RELOC>
	LIST
	SALL>

;RELOC TO LOWSEG

DEFINE	LOWSEG,<
	IFN	SEG,<
	XLIST
	LIT
	LIST
	SALL
	RELOC>
	SEG==0>


;MACRO TO ASSIGN BITS WITHIN A WORD (NOTE: BIT 0 = 400000 000000)

DEFINE	BIT(AC,SYMBOL)<
	IF1,<			;;DO NOT REDEFINE IN PASS2
	IFDEF AC'..<		;;SET UP COUNTER
	AC'..==AC'.._<-1>	;;AND MOVE TO NEXT BIT
	>
	IFNDEF AC'..<		;;ON FIRST CALL
	AC'..==1B0>		;;GIVE AWAY FIRST BIT
	SYMBOL==AC'..		;;DEFINITION OF SYMBOL
	IFE	AC'..,<		;;NO MORE ROOM
	PRINTX	? AC IS FULL
>>>
;BIT TESTING MACROS
DEFINE ON(AC,FLAG),<TXO AC,FLAG>

DEFINE OFF(AC,FLAG),<TXZ AC,FLAG> ;TURN OFF A FLAG



DEFINE LP(SYM,VAL),<
	IF1,<
		XLIST
		IFNDEF J...X,<J...X==1000>
		IFDEF SYM,<PRINTX  ?PARAM SYM USED TWICE>
		SYM==J...X
		J...X==J...X+VAL
	IFL 2000-J...X,<PRINTX ?PARAMETER AREA LONGER THAN A PAGE>
		LIST
		SALL
	>  ;END IF 1
>  ;END DEFINE LP
SUBTTL	Special Forms Handling Parameters



	LOWSEG		;DOWN TO LOWSEG


;FORMS SWITCHES:
;	BANNER:NN	NUMBER OF JOB HEADERS
;	TRAILER:NN	NUMBER OF JOB TRAILERS
;	HEADER:NN	NUMBER OF FILE HEADERS (PICTURE PAGES)
;	LINES:NN	NUMBER OF LINES PER PAGE
;	WIDTH:NN	NUMBER OF CHARACTERS PER LINE
;	ALIGN:SS	NAME OF ALIGN FILE
;	ALCNT:NN	NUMBER OF TIMES TO PRINT ALIGN FILE
;	ALSLP:NN	NUMBER OF SECS TO SLEEP BETWEEN COPIES OF ALIGN
;	RIBBON:SS	RIBBON TYPE
;	TAPE:SS		VFU CONTROL TAPE
;	VFU:SS		(SAME AS /TAPE)
;	DRUM:SS		DRUM TYPE
;	CHAIN:SS	CHAIN TYPE (DRUM/CHAIN ARE THE SAME)
;	NOTE:AA		TYPE NOTE TO THE OPERATOR
;	PAUSE		PAUSE BETWEEN JOBS ON THIS TYPE OF FORM
;	WHAT		PRINT A SHORT "WHAT" TO OPERATOR ON EACH JOB


;IN THE ABOVE AND BELOW EXPLANATIONS:
;	NN	IS A DECIMAL NUMBER
;	SS	IS A 1-6 CHARACTER STRING
;	AA	IS A STRING OF 1 TO 50 CHARACTERS
;	OO	IS AN OCTAL NUMBER



;LOCATION SPECIFIERS
;	ALL		ALL LINEPRINTERS
;	CENTRAL		ALL LINEPRINTERS AT THE CENTRAL SITE
;	REMOTE		ALL REMOTE LINEPRINTERS
;	LPTOOO		LINEPRINTER OOO ONLY

;NOTE:  LPTSPL WILL USE THE FIRST ENTRY WHICH MEETS THE LOCATION
;	SPECIFICATION FOR ITS LINEPRINTER.
DEFINE F,<
	FF	BANNER,2
	FF	TRAILER,2
	FF	HEADER,2
	FF	LINES,^D60
	FF	WIDTH,^D132
	FF	ALIGN,0
	FF	ALCNT,25
	FF	ALSLP,5
	FF	RIBBON,FRMNOR
	FF	TAPE,FRMNOR
	FF	VFU,FRMNOR
	FF	DRUM,FRMNOR
	FF	CHAIN,FRMNOR
	FF	NOTE,0
	FF	PAUSE,0
	FF	WHAT,0
>


;GENERATE TABLE OF SWITCH NAMES
DEFINE FF(A,B),<
	XLIST
	<<SIXBIT /A/>&777777B17>+S$'A
	LIST
	SALL
>

FFNAMS:	F

;GENERATE TABLE OF DEFAULT PARAMTERS
DEFINE FF(X,Y),<
	XLIST
D$'X:	EXP	Y
	LIST
	SALL
>

FFDEFS:	F
	F$NSW==.-FFDEFS
	PURGE	D$VFU,D$CHAI

	F$CL1==^D60	;WIDTH CLASS ONE IS 1 TO F$CL1
	F$CL2==^D100	;WIDTH CLASS TWO IS F$CL1 TO F$CL2
SUBTTL	Flag Definitions
IF1	<

	BIT	S,RUNB,		;ON IF I/O IN PROGRESS TO OUTDEV
	BIT	S,TELOPR,	;PRINT ON OPERATORS TTY (SET BY TELL)
	BIT	S,TELLOG,	;PLACE IN LOG (SET BY TELL)
	BIT	S,XTRA,		;XTRA BIT
	BIT	S,TELUSR,	;SENT DIRECTLY TO OUDEV(SET BY TELL)
;******* DO NOT MOVE BITS DEFINED ABOVE THIS LINE *******
	BIT	S,PAUSEB,	;(5) PAUSE AT EOJ
	BIT	S,TNOACT,	;(6) NO ACTION CHARACTERS
	BIT	S,STARTD,	;(7) START COMMAND GIVEN
	BIT	S,ARROW,	;(8) ARROW MODE IN EFFECT
	BIT	S,SUPRES,	;(9) NO USER FORM CONTROL
	BIT	S,DSKOPN,	;(10) DISK DATA READ GOING ON
	BIT	S,RQB,		;(11) JOB HAS BEEN REQUED
	BIT	S,SUPJOB,	;(12) SUPPRESS /JOB
	BIT	S,NOTYPE,	;(13) CNTRL O THE OUTPUT DEVICE
	BIT	S,XXX,		;(14)
	BIT	S,XXX,		;(15)
	BIT	S,PLOCK,	;(16) DO NOT CLEAR THE PAUSE BIT
	BIT	S,FFSEEN,	;(17) FORM FEED SEEN (LPTOUT)
	BIT	S,FROZE,	;(18) DON'T ASK TO CHANGE FORMS TYPE
	BIT	S,ABORT,	;(19) THE SHIP IS SINKING
	BIT	S,FCONV,	;(20) THE NEXT CHAR IS FORTRAN FORMAT DATA
	BIT	S,NEWLIN,	;(21) FLAG FOR THE BEGINING OF LINE
	BIT	S,MNTBIT,	;(22) REQUEST FOR FORMS TO BE MOUNTED
	BIT	S,JOBLOG,	;(23) THIS JOB HAS A LOG FILE
	BIT	S,BUSY,		;(24) JOB IN PROGRESS
	BIT	S,LOGOPN,	;(25) LOG FILE IS OPEN
	BIT	S,TTYBRK,	;(26) BREAK WAS SEEN ON TTY
	BIT	S,XXX,		;(27)
	BIT	S,BANDUN,	;(28) WE WENT THRU THE BANNER SEQUENCE

;STILL IN IF1
SUBTTL	LUUO	Definitions

	OPDEF	TELL	[001000,,0]
	OPDEF	TELLN	[002000,,0]
	OPDEF	STAMP	[004000,,0]

;AC FIELD OF TELL UUO

OPR==10				;SEND TO OPERATOR
LOG==4				;SEND TO LOG
USR==1				;ALSO PUT ON USER DEVICE

;BIT POSITION (FOR BYTE POINTERS)

SFRLOC==4			;LOCATION OF TELL BITS IN S
SFSBIT==4			;NUMBER OF TELL BITS
UURLOC==14			;LOCATION OF AC IN UUO
UUSBIT==4			;NUMBER OF BITS IN AC FIELD


	ASUPPRESS

>	;END OF IF1 CONDITIONAL


;LUUO BYTE POINTERS
PAC:	POINT	UUSBIT,.JBUUO##,UURLOC	;POINTER TO AC IN LUUO
PS:	POINT	SFSBIT,S,SFRLOC		;SAME FIELD IN S
SUBTTL	Job Parameter Area

	LP	J$$BEG,0		;BEGINNING OF PARAMETER AREA

;REQUEST PARAMETERS
	LP	J$RFLN,1		;NUMBER OF FILES IN REQUEST
	LP	J$RFLP,1		;NUMBER OF FILES TO BE PRINTED
	LP	J$RLIM,1		;JOB LIMIT IN PAGES
	LP	J$RLFS,1		;ADR OF LOG FILE SPEC
	LP	J$RNFP,1		;NUMBER OF FILES PRINTED
	LP	J$RNCP,1		;NUMBER OF COPIES OF CURRENT FILE
	LP	J$RNPP,1		;NUMBER OF PAGES IN CURRENT COPY PRINTED
	LP	J$RACS,20		;CONTEXT ACS
	LP	J$RPDL,50		;CONTEXT PUSHDOWN LIST

;ALIGN FILE PARAMETERS
	LP	J$ABRH,1		;BUFFER RING HEADER
	LP	J$ABPT,1		;BYTE POINTER
	LP	J$ABCT,1		;BYTE COUNT
	LP	J$APAG,1		;ALIGN SCRATCH PAGE NUMBER

;LPT PARAMETERS
	LP	J$LBUF,1		;ADDRESS OF LPT BUFFER
	LP	J$LBRH,1		;BUFFER RING HEADER
	LP	J$LBPT,1		;BYTE POINTER
	LP	J$LBCT,1		;BYTE COUNT
	LP	J$LDEV,1		;ACTUAL OUTPUT DEVICE NAME
	LP	J$LGNM,1		;DEV NAME SPEC ON START CMD
	LP	J$LSDV,1		;SCHEDULING DEVICE
	LP	J$LERR,1		;LPT ERROR DOWNCOUNTER
	LP	J$LLCL,1		;-1 IF UPPER/LOWER CASE PRINTER
	LP	J$LHNG,1		;-1 IF OUTPUT DEVICE IS HUNG
	LP	J$LDVF,1		;-1 IF DAVFU ON PRINTER
	LP	J$LPCR,1		;-1 IF DEVICE HAS A PAGE CNTR
	LP	J$LREM,1		;-1 IF REMOTE PRINTER
	LP	J$LIOA,1		;-1 IF WE ARE IN A SOUT OR OUT

IFN FTJSYS,<
	LP	J$LJFN,1		;JFN FOR THE LPT
	LP	J$LSTG,2		;DEVICE NAME STRING
	LP	J$LIBC,1		;INITIAL BYTE COUNT
	LP	J$LIBP,1		;INITIAL BYTE POINTER
>  ;END IFN FTJSYS




			;CONTINUED ON NEXT PAGE
			;CONTINUED FROM PREVIOUS PAGE

;CURRENT FORMS PARAMETERS

	LP	J$FORM,1		;CURRENT FORMS TYPE
	LP	J$FPFM,1		;PREVIOUS FORMS TYPE
	LP	J$FSFM,1		;TYPE OF FORMS QUASAR IS SCHEDULING

DEFINE	FF(X,Y),<
	LP	J$F'X,1
>

	LP	J$FCUR,0		;START OF FORMS PARAMS
	F				;CURRENT FORMS PARAMS

	LP	J$FWCL,1		;CURRENT WIDTH CLASS
	LP	J$FLVT,1		;CURRENTLY 'LOADED' VFU TYPE
	LP	J$FNBK,16		;OPERATOR NOTE BLOCK

	PURGE	J$FVFU,J$FCHA		;DON'T USE THESE



;MISCELLANY
	LP	J$XSBC,1		;SAVE BYTE-COUNT FOR FAST BAKSPC
	LP	J$XDPG,1		;FORW/BACK DESTINATION PAGE
	LP	J$XPOS,1		;CURRENT VERTICAL POSITION
	LP	J$XSPC,1		;CURRENT SPACING
	LP	J$XHIP,1		;HEADER-IN-PROGRESS
	LP	J$XHBF,<45>		;BUFFER TO BUILD HEADER LINE
	LP	J$XCOD,<^D49>		;COMPILE A ROUTINE TO CHECK
					; FOR MATCH ON /REPORT
	LP	J$XHUN,3		;PLACE TO BUILD USER NAME
	LP	J$XHUW,1		;NUMBER OF WORDS IN USER NAME
	LP	J$XHNO,3		;PLACE TO BUILD THE NOTE
	LP	J$XCOP,1		;NUMBER OF COPIES TO PRINT
	LP	J$XPG1,1		;START PAGE FOR FIRST COPY
	LP	J$XPG2,1		;START PAGE FOR SUBSEQENTS
	LP	J$XMLM,1		;MLIMIT FOR PRINTER
	LP	J$XPCB,1		;BLOCKSIZE FOR "PICTURE"
	LP	J$XPCS,1		;NUMBER OF SIG CHARS FOR "PICTURE"

IFN FTUUOS,<
	LP	J$XPTB,<TABSIZ>		;PAGE TABLE FOR BACKSPACE
	LP	J$XVFP,1		;SCRATCH PAGE FOR READING VFUS
	LP	J$XVFB,3		;BUFFER RING HEADER FOR READING VFUS
>  ;END IFN FTUUOS
IFN FTJSYS,<
	LP	J$XUNO,1		;OWNER'S USER NUMBER
	LP	J$XSFO,<10>		;SCRATCH FOR FORMATTED OUTPUT RTNS
>  ;END IFN FTJSYS
;ACCOUNTING BLOCK

IFN FTUUOS,<
	LP	J$AFNC,1		;DAEMON FUNCTION
	LP	J$AHED,1		;TYPE,,LENGTH (251B8,,13)
	LP	J$APPN,1		;PPN
	LP	J$ADAT,1		;DATE (FILLED BY DAEMON)
	LP	J$AQUE,1		;0-11 = QUEUE NAME
					;12-17 = STATION
					;18-35 = SERIAL # OF MASTER CPU
	LP	J$ARTM,1		;RUNTIME IN SECS*100
	LP	J$ACTI,1		;CORE-TIME INTEGRAL IN KCS*100
	LP	J$ADRD,1		;DISK READS
	LP	J$ADWT,1		;DISK WRITES
	LP	J$ADEV,1		;PROCESSING DEVICE
	LP	J$ASEQ,1		;JOB SEQUENCE NUMBER
	LP	J$APRT,1		;NUMBER OF PAGES PRINTED
		J$AEND==J$APRT		;END OF BLOCK
		J$ALEN==J$AEND-J$AHED+1
>  ;END IFN FTUUOS


IFN FTJSYS,<
	LP	J$AHED,1		;CODE,JOB,LINE,SIZE
	LP	J$ADIR,1		;0,,DIRECTORY
	LP	J$ADAT,1		;DATE,,TIME
	LP	J$ARTM,1		;RUNTIME USED
	LP	J$ADEV,1		;DEVICE USED
	LP	J$APRT,1		;# PAGES PRINTED
	LP	J$AFRM,1		;FORMS TYPE
	LP	J$AANO,1		;ACCOUNT NUMBER (OR -BYTE COUNT)
	LP	J$ASTG,10		;ACCOUNT STRING
		J$AEND==J$ASTG+7	;END OF BLOCK
		J$ALEN==J$AEND-J$AHED+1


	LP	J$AFIL,J$ALEN		;ACCOUNTING BLOCK FOR CURRENT FILE
	LP	J$ASVP,1		;SAVE AMOUNT PRINTED
	LP	J$ASVR,1		;SAVE RUNTIME
>  ;END IFN FTJSYS
;DISK FILE PARAMETERS

IFN FTUUOS,<
	LP	J$DPAT,<10>		;PATH BLOCK
	LP	J$DUUO,<.RBTIM+1>	;UUO BLOCK
	LP	J$DFLP,.FOPPN+1		;FILOP. BLOCK
>  ;END IFN FTUUOS

IFN FTJSYS,<
	LP	J$DSTG,1		;ADDRESS OF CURRENT FILENAME
	LP	J$DJFN,1		;JFN OF CURRENT FILE
	LP	J$DBIF,1		;#BYTES LEFT IN FILE (36BIT)
					; IF RMS FILE, -1 MEANS NORMAL READ
					; AND 0 MEANS EOF SET EXTERNALLY
	LP	J$DMOD,1		;POINT <BYTE-SIZE>,<BYTES/WORD>
	LP	J$DNAM,10		;PLACE TO JFNS THE FILENAME
	LP	J$DFDB,.FBLEN		;FDB FOR THE DISK FILE
	LP	J$DCAB,5		;CHKAC BLOCK

;--RMS PARAMETERS
	LP	J$DRMS,1		;-1 IF THIS IS AN RMS FILE
	LP	J$DFAB,FA$LNG		;FILE ACCESS BLOCK (FAB)
	LP	J$DRAB,RA$LNG		;RECORD ACCESS BLOCK (RAB)
	LP	J$DRFA,1		;RFA OF FIRST RECORD
	LP	J$DRME,1		;RMS ERROR FLAG SET BY RMSERR
>  ;END IFN FTJSYS

	LP	J$DBUF,1		;ADDRESS OF DSK BUFFERS
	LP	J$DINF,1		;CURRENT DISK BLK OR PAGE NUMBER
	LP	J$DRNM,2		;DISK FILE'S REFERENCE NAME
	LP	J$DREX,2		;FILE'S REFERENCE EXTENSION
	LP	J$DRBS,1		;CONTAINS BLOCK SIZE FOR HEADER
	LP	J$DERR,1		;NUMBER OF DEVICE ERRORS

	LP	J$DBRH,3		;BUFFER RING HEADER
		J$DBPT==J$DBRH+1	;BUFFER BYTE POINTER
		J$DBCT==J$DBRH+2	;BUFFER BYTE COUNT
;LOG FILE PARAMETERS

IFN FTUUOS,<
	LP	J$GPAT,<10>		;PATH BLOCK
	LP	J$GUUO,<.RBPRV+1>	;LOOKUP BLOCK
	LP	J$GFLP,<6>		;FILOP. UUO BLOCK
	LP	J$GBRH,1		;BUFFER RING HEADER
	LP	J$GBPT,1		;BYTE-POINTER
	LP	J$GBCT,1		;BYTE-COUNT
>  ;END IFN FTUUOS

IFN FTJSYS,<
	LP	J$GSTG,1		;POINTER TO GTJFN STRING
	LP	J$GJFN,1		;THE JFN
>  ;END IFN FTJSYS

	LP	J$GBUF,10		;ADDRESS OF LOG FILE BUFFERS
	LP	J$GNLN,1		;NUMBER OF LINES WRITTEN IN LOG
	LP	J$GIBC,1		;INTERNAL LOG BYTE COUNT
	LP	J$GIBP,1		;INTERNAL LOG BYTE POINTER
	LP	J$GINP,1		;NUMBER OF INTERNAL LOG PAGES


	LP	J$$END,1		;END OF PARAMETER AREA
		J$$LEN==J$$END		;LENGTH OF PARAMETER AREA
SUBTTL	Random Impure Storage

NXTJOB:	BLOCK	1		;NEXT JOB TO RUN
MESSAG:	BLOCK	1		;ADDRESS OF MESSAGE JUST RECEIVED
MSGBLK:	BLOCK	15		;PLACE TO BUILD MESSAGES TO QUASAR
TTYFLG:	BLOCK	1		;SET TO -1 ON TTY INTERRUPT
XITFLG:	BLOCK	1		;-1 IF PENDING EXIT
RSTFLG:	BLOCK	1		;-1 IF PENDING RESET
ACTFLG:	BLOCK	1		;-1 IF DOING ACCOUNTING
LPTPID:	BLOCK	1		;MY PID (RETURN BY CSPINI)
QRYFLG:	BLOCK	1		;ADR OF WORD TO SETOM WHEN AN IPCF INTERRUPT
				; COMES IN

MSGJOB:	BLOCK	1		;-1 ON MESSAGE JOB
MSGFIL:	BLOCK	1		;-1 ON MESSAGE FILE
MSGERR:	BLOCK	1		;-1 ON MESSAGE ERROR

FMBPT:	BLOCK	1		;BYTE POINTER
FMADR:	BLOCK	1		;ADDRESS OF BUFFER
FMNEW:	BLOCK	1		;SET TO -1 AFTER RE-READING LPFORM
LPCNF:	BLOCK	10		;SYSNAME


PDL:	BLOCK	PDSIZE		;PUSHDOWN LIST
CNTSTA:	BLOCK	1		;NUMBER OF THE CENTRAL STATION
MYSTA:	BLOCK	1		;MY STATION
JOBPAG:	BLOCK	1		;ADDRESS OF A TWO PAGE BLOCK
				; ONE FOR REQUEST, ONE FOR JOB PARAMS
NORMAL:	EXP	FRMNOR		;NAME OF STD FORMS

IFN FTJSYS,<
BLOKED:	BLOCK	1		;SET WHEN WE GO TO SLEEP
AWOKEN:	BLOCK	1		;SET WHEN WE GET AN INTERRUPT
GJBLK:	BLOCK	10		;BLOCK FOR LONG GTJFN

TTYFRK:	BLOCK	1		;FORK HANDLE FOR TTY PROCESS
TTYRUN:	BLOCK	1		;-1 IF TTY PROCESS IS RUNNING
TTYPTR:	BLOCK	1		;POINTER TO TTY BUFFER
TTYBUF:	BLOCK	30		;TTY BUFFER (FILLED BY LOWER FORK)
>  ;END IFN FTJSYS

IFN FTUUOS,<
SEGBLK:	BLOCK	6		;GETSEG BLOCK
JIFSEC:	BLOCK	1		;JIFFIES/SEC
>  ;END IFN FTUUOS
IFN FTJSYS,<
DDEV:	-1,,[ASCIZ /SYS/]		;DEFAULT DEVICE FOR VFU AND TRM
DVFU:	-1,,[ASCIZ /VFU/]		;DEF. EXT FOR VFU FILE
DTRM:	-1,,[ASCIZ /TRM/]		;DEF. EXT FOR LP20 TRANS RAM FILE
DJFN:	.NULIO,,.NULIO			;DEFAULT I/O JFNS
>  ;END IFN FTJSYS
SUBTTL	Idle Loop

	TOPSEG

MAIN:	MOVE	P,[IOWD PDSIZE,PDL]	;SETUP A NEW PDL
	SKIPE	XITFLG			;EXIT PENDING?
	JRST	DOEXIT			;YES, DO IT
	SKIPE	RSTFLG			;NO, WHAT ABOUT A RESET
	JRST	DOREST			;YUP!
	TXNN	S,PLOCK			;SKIP IF PAUSE LOCK IS SET
	TXNE	S,PAUSEB		;TIME TO PAUSE?
	PUSHJ	P,DOPAUS		;YES, PAUSE NOW

SLP0:	AND	S,[RUNB+STARTD+PLOCK+FROZE+TTYBRK]
					;CLEANUP FLAGS
	PUSHJ	P,CHKALL		;SOMETHING THERE?
	HRRZ	AP,MESSAG		;GET ADDRESS OF MESSAGE
	JUMPE	AP,SLP1			;NO. GO TO SLEEP
	LOAD	T1,.MSTYP(AP),MS.TYP	;GET THE MESSAGE TYPE
	CAIE	T1,.QONEX		;IS IT A JOB FOR ME?
	JRST	[MOVX	S1,1B0		;LOAD A BIT
		 TDNN	S1,MESSAG	;WAS IT A PAGE?
		 JRST	SLP0		;NO, JUST IGNORE IT
		 ADR2PG	AP		;MAKE A PAGE NUMBER
		 PUSHJ	P,M$RELP##	;RELEASE IT
		 JRST	SLP0]		;AND LOOP
	HRRZ	S2,J			;YES, GET ADR OF JOB BLOCK
	HRL	S2,AP			;MAKE A BLT POINTER
	LOAD	T1,.MSTYP(AP),MS.CNT	;GET SIZE OF REQUEST
	ADDI	T1,-1(J)		;GET END OF BLT ADR
	BLT	S2,(T1)			;BLT THE REQEST
	ADR2PG	AP			;MAKE A PAGE NUMBER
	PUSHJ	P,M$RELP##		;RELEASE THE PAGE
	JRST	SETJOB			;AND GO DO IT

SLP1:	PUSHJ	P,M$CLNC##		;CLEAN UP BEFORE RESTING
	MOVEI	S1,^D60			;60 SECONDS
	PUSHJ	P,SUSPND		;GO WAIT
	JRST	SLP0			;AND LOOP
SUBTTL	Job Setup

SETJOB:	ON	S,BUSY			;WE'VE GOT A JOB!!
	PUSHJ	P,M$ACQP##		;GET A DSK BUFFER PAGE
	PG2ADR	AP			;MAKE AN ADDRESS
	MOVEM	AP,J$DBUF(J)		;SAVE AS DISK BUFFER ADDRESS
	PUSHJ	P,ACTBEG		;SETUP ACCOUNTING INFO
	LOAD	T1,.EQSEQ(J),EQ.SEQ	;GET THE SEQUENCE NUMBER
	CAMN	T1,NXTJOB		;IS THE SPECIFIED NXTJOB?
	CLEARM	NXTJOB			;YES, CLEAR IT
	PUSHJ	P,CHKJOB		;CHECK OUT THE JOB
	PUSHJ	P,FNDLOG		;GO SETUP THE LOG-FILE
	PUSHJ	P,STALOG		;START THE LOG FILE
	LOAD	T1,.EQLM2(J),EQ.PGS	;GET LIMIT IN PAGES
	SUB	T1,.EQCHK+CKTPP(J)	;SUBRTRACT AMT PRINTED
	MOVEM	T1,J$RLIM(J)		;SAVE IT
	SETZM	J$RNFP(J)		;CLEAR FILES PRINTED
	SETZM	J$RNCP(J)		;CLEAR COPIES PRINTED
	SETZM	J$RNPP(J)		;CLEAR PAGES PRINTED

	PUSHJ	P,MOUNT			;MOUNT THE CORRECT FORMS
	SKIPN	MSGJOB			;MESSAGE JOB?
	SKIPE	J$FWHA(J)		;OR /WHAT?
	SKIPA				;YES!!
	JRST	SETJ.1			;NO, CONTINUE
	TELL	OPR,[ASCIZ /Starting /]
	PUSHJ	P,WHAT			;AND SOME MORE
SETJ.1:	SKIPE	J$FPAU(J)		;/PAUSE?
	PUSHJ	P,DOPAUS		;AND PAUSE
	LOAD	T1,.EQSEQ(J),EQ.RDE	;GET "IGNORE REQUEST" BIT
	SKIPE	T1			;IS IT SET?
	TXO	S,ABORT			;YES, SET ABORT
	SKIPE	J$RFLP(J)		;SKIP IF NO FILES TO BE PRINTED
	TXNE	S,ABORT			;WERE WE ABORTED?
	SKIPA				;EITHER 0 FILES, OR ABORTED
	PUSHJ	P,JOBHDR		;NO, GIVE THE BANNER
SUBTTL	Do the Job

DOJOB:	LOAD	E,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	E,J			;POINT TO FIRST FILE
	SKIPN	.EQCHK+CKFLG(J)		;IS THIS A RESTARTED JOB?
	JRST	DOJO.4			;NO, SKIP ALL THIS STUFF
	STAMP	LPMSG			;STAMP THE LOG
	TELL	LOG,%%JBR		;JOB WAS RESTARTED
	MOVEI	T1,%%JBR1		;AFTER CRASH
	MOVX	T2,CKFREQ		;GET REQUEUE BIT
	TDNE	T2,.EQCHK+CKFLG(J)	;CHECK IT
	MOVEI	T1,%%JBR2		;YES, REQ
	TELL	LOG,(T1)		;FINISH THE MESSAGE
	MOVE	T1,.EQCHK+CKFIL(J)	;YES, GET NUMBER OF FILES DONE
	MOVEM	T1,J$RNFP(J)		;STORE FOR NEXT CHECKPOINT
	SKIPGE	T1			;IS IT DURING THE LOG FILE?
	JRST	DOJO.7			;YES, GO DO THE LOG
DOJO.1:	SOJL	T1,DOJO.2		;DECREMENT AND JUMP IF SKIPED ENUF
	PUSH	P,T1			;ELSE, SAVE T1
	PUSHJ	P,NXTFIL		;BUMP E TO NEXT SPEC
	POP	P,T1			;RESTORE T1
	JUMPE	E,ENDJOB		;EASY JOB
	JRST	DOJO.1			;LOOP SOME MORE

DOJO.2:	MOVE	T1,.EQCHK+CKCOP(J)	;GET NUMBER OF COPIES PRINTED
	MOVEM	T1,J$RNCP(J)		;SAVE FOR NEXT CHECKPOINT

DOJO.3:	SKIPA	T1,.EQCHK+CKPAG(J)	;GET CHKPNT'ED PAGE
DOJO.4:	LOAD	T1,.FPFST(E)		;GET /START PARAMETER
	MOVEM	T1,J$XPG1(J)		;SAVE FOR FIRST COPY
DOJO.5:	LOAD	T1,.FPFST(E)		;GET START PARAMETER
	MOVEM	T1,J$XPG2(J)		;SAVE FOR SUBSEQUET COPIES
	CAME	E,J$RLFS(J)		;IS IT THE LOG FILE?
	PUSHJ	P,FILE			;NO, PRINT THE FILE
DOJO.6:	PUSHJ	P,NXTFIL		;BUMP TO NEXT FILE
	JUMPN	E,DOJO.4		;AND LOOP

DOJO.7:	PUSHJ	P,RIDLOG		;CLOSE AND RELEASE THE LOG
	SKIPN	E,J$RLFS(J)		;GET ADR OF LOG-SPEC
	JRST	ENDJOB			;NO, FINISH JOB
	SETZM	J$RLFS(J)		;CLEAR SOME LOCATIONS
	SETZM	J$RFLN(J)		; TO AVOID POSIBILITY OF LOOPS
	SETOM	J$RNFP(J)		;AND MAKE CHECKPOINT WORK RIGHT
	MOVE	S1,J$APRT(J)		;GET NUMBER OF PAGES PRINTED
	ADDI	S1,LOGPAG		;ADD IN GUARANTEED LOG LIMIT
	CAMLE	S1,J$RLIM(J)		;DOES HE HAVE AT LEAST THAT MANY?
	MOVEM	S1,J$RLIM(J)		;NO, GIVE HIM THAT MANY
	OFF	S,ABORT			;CLEAR ABORT FLAG
	PUSHJ	P,FILE			;PRINT THE FILE
	JRST	ENDJOB			;AND FINISH UP

NXTFIL:	SETZM	J$RNCP(J)		;CLEAR COPIES PRINTED
	SOSG	J$RFLN(J)		;DECREMENT FILE COUNT
	JRST	NXTF.1			;DONE, RETURN A ZERO
	PUSHJ	P,CLSLOG		;CLOSE OUT THE LOG
	LOAD	T1,.FPSIZ(E),FP.FHD	;GET SIZE OF THE FP
	LOAD	T2,.FPSIZ(E),FP.FFS	;GET SIZE OF THE FD
	ADD	E,T1			;BUMP E ONCE
	ADD	E,T2			;AND AGAIN
	AOS	J$RNFP(J)		;ONE MORE FILE DOWN
	POPJ	P,			;AND RETURN

NXTF.1:	SETZ	E,			;CLEAR E
	POPJ	P,			;AND RETURN
SUBTTL	Print a File

FILE:	PUSHJ	P,OPINFL		;OPEN THE FILE UP
	PJUMPE	S1,CLSFIL		;LOSE, CLOSE FILE AND RETURN
	TXNE	S,ABORT			;HAVE WE KILLED HIM?
	JRST	FILDIS			;YES, CLEAN UP SOME
	LOAD	T1,.FPINF(E),FP.IGN	;WAS FILE /REMOVE'D?
	JUMPN	T1,FILDIS		;YES, GO DISPOSE OF IT
	PUSHJ	P,ACCCHK		;CHECK FILE ACCESS
	PJUMPE	S1,CLSFIL		;NO ACCESS...
	PUSHJ	P,SETREF		;YES, GO SETUP REF-NAME

	STAMP	LPMSG			;GIVE A STAMP
	TELL	LOG,%%STF		;AND GIVE A START MESSAGE
	SKIPE	MSGFIL			;OPR WANT ONE TOO?
	TELL	OPR,%%STF		;YES,
	LOAD	T1,.FPINF(E),FP.FCY	;GET NUMBER OF COPIES
	SUB	T1,J$RNCP(J)		;SUBRTRACT THOSE ALREADY PRINTED
	MOVEM	T1,J$XCOP(J)		;AND STORE IT
	SETZM	J$RNCP(J)		;CLEAR NUMBER OF COPIES WORD
	PUSHJ	P,ACTBFL		;DO PRE-FILE ACCOUNTING
	PUSHJ	P,COPY			;DO THE COPY LOOP
	PUSHJ	P,ACTEFL		;DO POST-FILE ACCOUNTING
	TXNE	S,ABORT			;HAVE WE ABORTED?
	JRST	FILDIS			;YES, SKIP THE MESSAGE
	STAMP	LPMSG			;GIVE A STAMP
	TELL	LOG,%%FPF		;GIVE A MESSAGE

FILDIS:	LOAD	T1,.FPINF(E)		;GET THE INFO WORD
	TXNE	T1,FP.SPL		;IS IT SPOOLED?
	JRST	FILD.1			;YES, DELETE IT
	TXNE	T1,FP.IGN		;IS IT IGNORED
	JRST	CLSFIL			;YES, JUST CLOSE IT OFF
	TXNN	T1,FP.DEL		;IS IT /DELETE?
	PJRST	CLSFIL			;NO, JUST CLOSE IT OFF
	TXNE	T1,FP.FLG		;YES, IS IT THE LOG FILE?
	TXNE	T1,FP.FCY		;YES, IS IT /COPIES:0
	SKIPA				;NO, NORMAL FILE
	JRST	FILD.1			;YES, DELETE IT
	TXNN	S,ABORT			;ITS ORDINARY, IS JOB ABORTED?
FILD.1:	PUSHJ	P,DELFIL		;NO, GO DELETE THE FILE
	PJRST	CLSFIL			;CLOSE THE FILE AND RETURN
SUBTTL	Per Copy Loop

COPY:	SOSGE	J$XCOP(J)		;COUNT DOWN COPIES
	POPJ	P,			;RETURN WHEN DONE
	PUSHJ	P,HEAD			;PUT ON A HEADER
	PUSHJ	P,OUTDMP		;DUMP THE REST OUT AND WAIT
	ON	S,DSKOPN		;TURN ON FILE-OPEN FLAG
	TXNE	S,ABORT			;KILLED WHILE PRINTING?
	POPJ	P,			;YES, RETURN
	PUSHJ	P,REWIND		;REWIND THE FILE
	CLEARM	J$XSBC(J)		;CLEAR SAVED BYTE COUNT
	TXNE	S,SUPJOB		;SUPRES /JOB?
	ON	S,SUPRES		;YES.LIGHT A BIT
	MOVEI	T1,MAXERR		;NUMBER OF I/O ERROR BEFORE QUITTING
	MOVEM	T1,J$DERR(J)		;STORE
	SETZM	J$RNPP(J)		;CLEAR THE PAGE WORD
	MOVE	N,J$XPG1(J)		;GET PAGE FOR 1ST COPY
	MOVE	T1,J$XPG2(J)		;GET PAGE FOR SUBSEQENTS
	MOVEM	T1,J$XPG1(J)		;SAVE SO WE GET IT NEXT TIME
	SOSLE	N			;JUMP IF NONE
	PUSHJ	P,FORWD1		;CALL FORWARD TO SET EVERYTHING UP

	PUSHJ	P,FILOUT		;PRINT THE FILE
	OFF	S,NOTYPE!DSKOPN		;CLEAR SOME FLAGS
	TXNE	S,ABORT			;ABORTED?
	POPJ	P,			;YES, RETURN
	AOS	J$RNCP(J)		;INCREMENT COPIES WORD
	JRST	COPY			;STILL MORE TO DO
SUBTTL	End of Job

ENDJOB:	PUSHJ	P,ACTEND		;DO THE NECESSARY ACCOUTING
	MOVX	T1,<REL.SZ,,.QOREL>
	MOVEM	T1,MSGBLK		;SETUP MESSAGE HEADER
	LOAD	T1,.EQITN(J)		;GET THE JOBS ITN
	STORE	T1,MSGBLK+REL.IT	;STORE IN THE MESSAGE
	MOVEI	T1,MSGBLK		;LOAD ADDRESS
	TXNN	S,RQB			;DON'T SEND REL IF WE HAVE REQ'D
	PUSHJ	P,SNDQSR##		;SEND IT

ENDJ.1:	STAMP	LPSUM			;GENERATE A SUMMARY STAMP
	MOVE	N,J$ARTM(J)		;GET CP TIME USED
	IDIVI	N,^D1000		;DIVIDE BY MILLI-SECS PER SEC
	TELL	LOG,[ASCIZ /Spooler runtime # Seconds, /]

IFN FTUUOS,<
	MOVE	N,J$ACTI(J)		;GET # OFKCS USED
	IDIVI	N,144			;CONVERT TO SECONDS
	TELL	LOG,[ASCIZ /# KCS, /]
	MOVE	N,J$ADRD(J)		;READ COUNT
	TELL	LOG,[ASCIZ /# disk reads, /]
>  	;END IFN FTUUOS

	MOVE	N,J$APRT(J)		;GET PAGES 
	TELL	LOG,[ASCIZ /# pages printed
/]
	PUSHJ	P,JOBTRL		;PRINT THE TRAILER
	MOVE	AP,J$DBUF(J)		;GET ADR OF DSK BUFFER
	ADR2PG	AP			;MAKE IT A PAGE NUMBER
	PUSHJ	P,M$RELP##		;RETURN IT
	PUSHJ	P,CLNLOG		;CLEAN UP LOG PAGES
	SKIPN	MSGJOB			;WANT JOB MESSAGES?
	JRST	ENDJ.2			;NO, CONTINUE ON
	TELL	OPR,[ASCIZ /Finished /]
	PUSHJ	P,WHAT			;JOB ID
ENDJ.2:	OFF	S,BUSY			;NOT BUSY
	JRST	MAIN			;AND LOOP TO THE BEGINNING
SUBTTL	CHKJOB - Check the files and count them

;CHKJOB IS CALLED DURING JOB SETUP.  IT FILLS IN 3 LOCATIONS:
;	J$RFLN	-	NUMBER OF FILES IN REQUEST
;	J$RFLP	-	NUMBER OF FILES WHICH WILL BE PRINTED
;	J$RLFS	-	ADDRESS OF THE LOG FILE SPEC

CHKJOB:	SETZM	J$RLFS(J)		;ASSUME NO LOG FILE
	LOAD	T1,.EQSPC(J),EQ.NUM	;GET NUMBER OF FILES IN REQUEST
	MOVEM	T1,J$RFLN(J)		;AND SAVE IT
	MOVEM	T1,J$RFLP(J)		;AND START AS NUMBER TO PRINT
	LOAD	T2,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	T2,J			;AND POINT TO FIRST FILE

CHKJ.1:	LOAD	T3,.FPINF(T2)		;GET INFO WORD
	TXNE	T3,FP.FLG		;IS IT THE LOG FILE?
	MOVEM	T2,J$RLFS(J)		;YES, SAVE ITS ADDRESS
	TXNE	T3,FP.FCY		;/COP:0?
	TXNE	T3,FP.IGN		;NO, IS IT IGNORED?
	SOS	J$RFLP(J)		;EITHER 0 COPIES OR IGNORED
	LOAD	T3,.FPSIZ(T2),FP.FHD	;GET LENGTH OF THE FP
	LOAD	T4,.FPSIZ(T2),FP.FFS	;GET LENGTH OF THE FD
	ADD	T2,T3			;BUMP T2 ONCE
	ADD	T2,T4			;BUMP T2 AGAIN
	SOJG	T1,CHKJ.1		;AND LOOP
	LOAD	T1,.EQSEQ(J),EQ.RDE	;GET THE RDE BIT
	SKIPE	T1			;SKIP IF NOT AN RDE JOB
	SETZM	J$RLFS(J)		;ELSE, NO LOG FILE
	POPJ	P,			;DONE, RETURN
SUBTTL	Message Check Routines

	LOWSEG				;PLACE IN LOW SEGMENT

;THREE ROUTINES ARE USED TO CHECK FOR VARIOUS MESSAGES:
;	CHKALL	--  CHECKS FOR BOTH OPERATOR TYPEIN AND IPCF MESSAGES
;	CHKOPR	--  CHECKS FOR OPERATOR TYPE IN
;	CHKQUE	--  CHECKS FOR IPCF MESSAGES

;LOCATION "MESSAG" IS RETURNED WITH THE ADDRESS OF ANY MESSAGE RECEIVED.

CHKALL:	PUSHJ	P,CHKSEG		;CHECK TO SEE IF WE HAVE A HISEG
	PUSHJ	P,CHKOP0		;SEE IF OPR WANTS SOMETHING
	PUSHJ	P,CHKQU0		;SEE IF ANYTHING'S IN THE QUEUE
	POPJ	P,			;AND RETURN


;CHKSEG SIMPLY RETURNS IF THE HISEGMENT EXISTS, AND CALLS ITS CALLER
;	IF NOT.  HENCE, WHEN THE CALLER RETURNS WE GET TO DELETE THE
;	HISEG.
;
CHKSEG:	SKIPE	.JBHRL##		;IS THERE A HISEG?
	POPJ	P,			;YES, JUST RETURN
	EXCH	S1,0(P)			;NO, SAVE S1 GET CALLERS ADDRESS
	PUSHJ	P,(S1)			;AND CALL HIM
	POP	P,S1			;RESTORE S1
	PJRST	CLRSEG			;AND CLEAR THE HISEG
CHKOPR:	PUSHJ	P,CHKSEG		;CHECK THE HISEG
CHKOP0:					;ENTER HERE FROM CHKALL

IFN FTUUOS,<
	SETZ	S1,			;LOAD A 0
	EXCH	S1,TTYFLG		;LOAD TTYFLG AND SET FOR NEXT TIME
	JUMPE	S1,.POPJ##		;NO, RETURN IF NOTHING THERE
	SKPINL				;CHECK
	  POPJ	P,			;NOTHING THERE FOR REAL
	PUSHJ	P,GETSPL		;GET THE HISEG
	PUSHJ	P,SAVALL		;SAVE ALL ACS
CHKOP1:	PUSHJ	P,COMIN			;DO ONE COMMAND
	SKPINL				;IS THERE ONE?
	  POPJ	P,			;NO, RETURN
	JRST	CHKOP1			;YES, GET ANOTHER COMMAND
>  ;END IFN FTUUOS

IFN FTJSYS,<
	SKIPN	TTYFLG			;HAS HE TYPED ANYTHING?
	POPJ	P,			;NO, RETURN
	PUSHJ	P,SAVALL		;YES, SAVE ACS
	PJRST	COMIN			;GET A COMMAND
>  ;END IFN FTJSYS

CHKQUE:	PUSHJ	P,CHKSEG		;SEE IF WE HAVE A HISEG
CHKQU0:					;ENTER HERE FROM CHKALL
	PUSHJ	P,CSPRCV##		;RECEIVE A MESSAGE
	MOVEM	S1,MESSAG		;SAVE ADDRESS OF MESSAGE
	JUMPE	S1,.POPJ##		;RETURN NOTHING THERE, RETURN
	LOAD	S2,.MSTYP(S1),MS.TYP
	CAIE	S2,.QONEX		;IS IT A JOB FOR ME?
	JRST	CHKQU1			;NO, CONTINUE
	POPJ	P,

CHKQU1:	TXNN	S,BUSY			;ARE WE BUSY?
	POPJ	P,			;NO, JUST IGNORE THE WHOLE THING
	PUSHJ	P,SAVALL		;SAVE THE T REGS
	CAIE	S2,.QOABO		;IS IT ABORT??
	JRST	CHKQU2			;NO, SEE IF QUASAR IS REQUESTING A CHKPNT
	PUSHJ	P,GETSPL		;YES, GET THE HISEG
	PJRST	UKILL			;AND KILL OFF THE JOB

CHKQU2:	CAIE	S2,.QORCK		;CHECKPOINT REQUEST?
	POPJ	P,			;NO, RETURN
	PJRST	TAKCHK			;AND TAKE A CHECKPOINT
SUBTTL	Core and Segment Handling Routines

;	GETSPL	--		GET THE SPOOLER'S HISEG
;	CLRSEG	--		CLEAR THE SPOOLER'S HISEG


	LOWSEG			;THESE ARE IN THE LOWSEG
SUBTTL	GETSPL  -  Routine to get the spooler's hiseg

;GETSPL IS CALLED TO MAP THE SPOOLER'S HISEG IN
;CALL WITH:
;	PUSHJ	P,GETSPL
;	  RETURN HERE

IFN FTUUOS,<
GETSPL:	SKIPE	.JBHRL		;SKIPE IF NO HISEG
	POPJ	P,		;ELSE SKIP SEGCON
	PUSHJ	P,SAVALL	;SAVE THE AC'S
	PUSHJ	P,INTOFF	;TURN OFF INTERRUPTS
GETSP1:	MOVEI	T1,SEGBLK	;POINT TO SEGBLK
	PUSH	P,S
	MOVEM	P,SAVP#
	GETSEG	T1,		;GET IT
	  HALT	[MOVE P,SAVP
		 POP  P,S
		 JRST GETSP1]
	MOVE	P,SAVP
	POP	P,S
	PJRST	INTON		;TURN ON INTERRUPTS AND RETURN
>  ;END IFN FTUUOS


IFN FTJSYS,<
GETSPL:	POPJ	P,
>  ;END IFN FTJSYS
SUBTTL	CLRSEG  -  Routine to clear the spooler's hiseg

;CLRSEG IS CALLED TO MAP THE SPOOLER'S HISEG OUT
;CALL:
;	PUSHJ	P,CLRSEG
;	  RETURN HERE

IFN FTUUOS,<
CLRSEG:	SKIPN	.JBHRL		;IS THERE A HISEG?
	POPJ	P,		;NO, DON'T GET RID OF IT
	PUSH	P,T1		;SAVE T1
	MOVSI	T1,1		;SET SIZE OF HISEG TO 1 WORD
	CORE	T1,		;CALL CORE0
	  JFCL			;IGNORE ANY ERROR
	POP	P,T1		;RESTORE T1
	POPJ	P,		;IGNORE SUCCESS
>  ;END IFN FTUUOS

IFN FTJSYS,<
CLRSEG:	POPJ	P,
>  ;END IFN FTJSYS
SUBTTL	Input File Facilities


;	OPINFL		--	OPEN THE INPUT FILE
;	ACCCHK		--	CHECK USER'S ACCESS TO THE INPUT FILE
;	DELFIL		--	DELETE THE INPUT FILE
;	CLSFIL		--	CLOSE THE INPUT FILE
;	TELCAF		--	REPORT FILE ACCESS ERROR
;	SETREF		--	SETUP REFERENCE NAME FOR FILE

	TOPSEG			;PUT THEM ALL IN THE HISEG
SUBTTL	OPINFL  -  Routine to open the input file

;OPINFL IS CALLED WITH AC "E" POINTING TO THE FP AREA FOR THE FILE
;	TO BE OPENED.
;
;CALL:
;	PUSHJ P,OPINFL
;	  ALWAYS RETURN HERE
;
;RETURNS S1 =  "TRUE" ON SUCCESS, "FALSE" OTHERWISE.

IFN FTUUOS,<
OPINFL:	LOAD	S1,.FPSIZ(E),FP.FHD	;GET SIZE OF THE FP AREA
	ADD	S1,E			;AND POINT S1 TO THE FD AREA
	MOVE	T2,.FDNAM(S1)		;GET THE FILENAME
	MOVEM	T2,J$DUUO+.RBNAM(J)	;SAVE IN LOOKUP BLOCK
	HLLZ	T2,.FDEXT(S1)		;GET THE EXTENSION
	MOVEM	T2,J$DUUO+.RBEXT(J)	;SAVE IN THE UUO BLOCK
	MOVSI	T1,J$DPAT(J)		;ADR OF PATH BLOCK,,0
	HRRI	T1,J$DPAT+1(J)		;BLT POINTER TO ZERO IT OUT
	CLEARM	J$DPAT(J)		;CLEAR THE FIRST WORD
	BLT	T1,J$DPAT+7(J)		;CLEAR THE REST
	MOVEI	T1,J$DPAT+2(J)		;POINT TO PPN WORD
	HRLI	T1,.FDPPN(S1)		;SETUP TO BLT THE PATH
	LOAD	T2,.FPSIZ(E),FP.FFS	;GET SIZE OF FD AREA
	ADDI	T2,-FDMSIZ(J)		;SUB FDMSIZ, ADD AP
	BLT	T1,J$DPAT+2(T2)		;BLT THE PATH
	MOVEI	T1,J$DPAT(J)		;ADDRESS OF PATH BLOCK
	SKIPN	J$DPAT+3(J)		;IS THERE AN SFD?
	MOVE	T1,J$DPAT+2(J)		;NO, LOAD THE PPN
	MOVEM	T1,J$DUUO+.RBPPN(J)	;AND SAVE IN THE UUO BLOCK
	MOVEI	T1,.RBTIM		;GET THE SIZE OF THE BLOCK
	MOVEM	T1,J$DUUO+.RBCNT(J)	;AND SAVE IT IN RIBCNT
	MOVX	T1,FO.PRV+.FORED+<DSK>B17 ;FILOP SETUP
	MOVEM	T1,J$DFLP+.FOFNC(J)	;STORE THE FUNCTION WORD
	MOVEI	T1,.IOASC		;ASSUME ASCII MODE
	LOAD	T2,.FPINF(E),FP.FFF	;GET /FILE:
	LOAD	T3,.FPINF(E),FP.FPF	;GET /PAPER:
	CAIE	T2,.FPFCO		;/FILE:COBOL?
	CAIN	T3,%FPLOC		;OR /PAPER:OCTAL?
	MOVEI	T1,.IOBIN		;YES, USE BINARY MODE
	MOVEM	T1,J$DFLP+.FOIOS(J)	;SAVE IOS


				;CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

	SKIPN	T1,.FDSTR(S1)		;GET THE STRUCTURE
	MOVSI	T1,'DSK'		;GUARD AGAINST CONKLIN
	MOVEM	T1,J$DFLP+.FODEV(J)	;AND SAVE IT
	MOVEI	T1,J$DBRH(J)		;LOAD ADR OF BUFFER RING HDR
	MOVEM	T1,J$DFLP+.FOBRH(J)	;AND STORE IT
	MOVEI	T1,<1000/203>		;NUMBER OF INPUT BUFFERS
	MOVEM	T1,J$DFLP+.FONBF(J)	;STORE IT
	MOVEI	T1,J$DUUO(J)		;ADDRESS OF THE LOOKUP BLOCK
	MOVEM	T1,J$DFLP+.FOLEB(J)	;AND STORE IT
	MOVE	T4,J$DBUF(J)		;GET ADR OF BUFFERS
	EXCH	T4,.JBFF		;AND SAVE IT AS JOBFF
	MOVEI	T1,J$DFLP(J)		;LOAD ADR OF FILOP BLOCK
	HRLI	T1,6			;LOAD THE LENGTH
	FILOP.	T1,			;GET THE FILE
	  JRST	[MOVEM T4,.JBFF		;RESTORE JOBFF
		 JRST	OPIN.1]		;TYPE MESSAGE AND GO ON
	MOVEM	T4,.JBFF		;RESTORE JOBFF
	PJRST	.TRUE##			;WIN RETURN

OPIN.1:	MOVE	S1,T1			;GET THE ERROR CODE
	MOVX	S2,LOG			;TELL LOG
	SKIPE	MSGERR			;AND IF OPR WANTS ERRORS
	IORX	S2,OPR			;TELL HIM TOO
	PUSHJ	P,TELCAF		;TELL THEM
	PJRST	.FALSE##		;AND LOSE RETURN
>  ;END IFN FTUUOS
IFN FTJSYS,<
OPINFL:	LOAD	S2,.FPSIZ(E),FP.FHD	;GET SIZE OF FP AREA
	ADD	S2,E			;S2 POINTS TO FD
	MOVEM	S2,J$DSTG(J)		;AND SAVE THE POINTER
	HRLI	S2,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVX	S1,<GJ%OLD!GJ%SHT>	;SHORT GTJFN, OLD FILE ONLY
	GTJFN				;FIND THE FILE
	  JRST	OPIN.3			;FAILED?
	MOVEM	S1,J$DJFN(J)		;SAVE THE JFN
	SETZM	J$DRMS(J)		;ASSUME NOT AN RMS FILE
	MOVE	S1,J$DJFN(J)		;GET THE JFN
	MOVX	S2,<.FBLEN,,.FBHDR>	;GET ENTIRE FDB
	MOVEI	T1,J$DFDB(J)		;LOAD ADDRS OF BLOCK
	GTFDB				;AND GET IT
	LOAD	T1,J$DFDB+.FBCTL(J),FB%FCF
	CAIN	T1,.FBRMS		;LOAD FILE CLASS AND TEST IT
	SETOM	J$DRMS(J)		;IT IS AN RMS FILE
	MOVE	S1,J$DJFN(J)		;NOW, GET THE JFN
	MOVX	S2,<OF%RD+44B5>		;READ 36BIT BYTES
	SKIPL	J$DRMS(J)		;SKIP IF RMS FILE
	OPENF				;ELSE, OPEN THE FILE
	ERJMP	OPIN.3			;LOSE

	LOAD	T2,.FPINF(E),FP.FFF	;GET /FILE
	LOAD	T3,.FPINF(E),FP.FPF	;GET /PAPER
	MOVX	T1,<POINT 7,5>		;ASSUME 5 7BIT-BYTES/WORD
	CAIE	T2,.FPFCO		;/FILE:COBOL
	CAIN	T3,%FPLOC		;OR /PAPER:OCTAL?
	MOVX	T1,<POINT 36,1>		;YES, 1 36BIT-BYTE/WORD
	MOVEM	T1,J$DMOD(J)		;SAVE IT FOR "FILL"
	SKIPN	J$DRMS(J)		;SKIP IF RMS FILE
	PJRST	.TRUE##			;WIN RETURN


					;MORE OF "OPINFL" ON FOLLOWING PAGE
;HERE IF OPENING AN RMS-20 FILE, FIRST SETUP THE FAB
	MOVSI	T1,J$DFAB(J)		;GET FAB,,0
	HRRI	T1,J$DFAB+1(J)		;GET FAB,,FAB+1
	SETZM	J$DFAB(J)		;CLEAR THE FIRST WORD
	BLT	T1,J$DFAB+FA$LNG-1(J)	;CLEAR THE REST
	MOVX	T1,FA$TYP		;BLOCK TYPE
	$STFAB	T1,BID			;STORE THE BLOCK ID
	MOVX	T1,FA$LNG		;BLOCK LENGTH
	$STFAB	T1,BLN			;AND STORE IN FAB
	MOVX	T1,FB$GET		;GET "GET" ACCESS CODE
	$STFAB	T1,FAC			;STORE IN FILE ACCESS FIELD
	SETZ	T1,			;CLEAR T1
	$STFAB	T1,SHR			;AND STORE IT IN SHARE FIELD
	MOVE	T1,J$DJFN(J)		;GET THE JFN
	$STFAB	T1,JFN			;STORE IT IN JFN FIELD
	PUSHJ	P,SETRMS		;SETUP TO CALL RMS
	MOVEI	AP,J$DFAB(J)		;LOAD ADDRESS OF FAB
	$OPEN	<(AP)>,RMSERR		;OPEN THE FAB
	SKIPE	J$DRME(J)		;ERROR?
	JRST	OPIN.3			;YES, GO HANDLE IT
	$LDFAB	S1,BSZ			;GET THE BYTE SIZE
	LSH	S1,6			;POSITION IT
	TRO	S1,440000		;MAKE A BYTE POINTER
	HRLZ	S1,J$DMOD(J)		;AND STORE IT

;NOW SETUP THE RAB
	MOVSI	T1,J$DRAB(J)		;GET RAB,,0
	HRRI	T1,J$DRAB+1(J)		;GET RAB,,RAB+1
	SETZM	J$DRAB(J)		;CLEAR THE FIRST WORD
	BLT	T1,J$DRAB+RA$LNG-1(J)	;CLEAR THE REST
	MOVX	T1,RA$TYP		;GET BLOCK TYPE
	$STRAB	T1,BID			;STORE IT
	MOVX	T1,RA$LNG		;GET BLOCK LENGTH
	$STRAB	T1,BLN			;STORE IT
	MOVX	T1,RB$SEQ		;LOAD SEQUENTIAL ACCESS
	$STRAB	T1,RAC			;STORE RECORD ACCESS TYPE
	MOVX	T1,RB$LOC		;DONT MOVE RECORD
	$STRAB	T1,ROP			;REQUESTED OPERATION
	MOVEI	T1,1000			;LOAD THE BUFFER SIZE
	$STRAB	T1,USZ			;SAVE IT
	MOVE	T1,J$DBUF(J)		;LOAD ADDRESS OF BUFFER
	$STRAB	T1,UBF			;STORE IT
	MOVEI	T1,J$DFAB(J)		;LOAD ADDRESS OF FAB
	$STRAB	T1,FAB			;STORE IT
	PUSHJ	P,SETRMS		;SETUP TO CALL RMS
	MOVEI	AP,J$DRAB(J)		;LOAD ADDRESS OF RAB
	$CONNEC	<(AP)>,RMSERR		;CONNECT IT TO THE FAB
	SKIPE	J$DRME(J)		;ANY ERROR?
	JRST	OPIN.3			;YES, HANDLE IT
	SETOM	J$DRFA(J)		;INDICATE NO RFA YET
	PJRST	.TRUE##			;AND RETURN TRUE

				;OPINFL IS CONTINUED ON FOLLOWING PAGE
				;CONTINUED FROM PREVIOUS PAGE

OPIN.3:	MOVX	S2,LOG			;TELL LOG
	SKIPE	MSGERR			;AND IF OPR WANTS ERRORS
	IORX	S2,OPR			;TELL HIM TOO
	PUSHJ	P,TELCAF		;TELL THEM
	PJRST	.FALSE##		;AND LOSE
>  ;END IFN FTJSYS
SUBTTL	ACCCHK  -  Check access to current file

;ACCCHK IS CALLED TO CHECK THE USER'S ACCESS TO THE CURRENT FILE.
;
;THERE ARE FOUR CASES:
;	1) IF THE REQUEST CREATOR WAS PRIVILEGED, SUCCESS IS RETURNED
;	2) IF THE FILE IS SPOOLED, SUCCESS IS AUTOMATICALLY RETURNED
;	3) IF THE FILE IS NOT TO BE DELETED, "READ" ACCESS IS CHECKED
;	4) IF THE FILE IS TO BE DELETED:
;		A) DELETE ACCESS IS CHECKED.  IS THIS SUCCEEDS, SUCCESS
;			IS RETURNED.
;		B)  IF THIS FAILS, THE DISPOSITION IS CHANGED TO
;			PRESERVE AND WE GO BACK TO STEP 3.
;
;ON SUCCESS, S1 IS RETURNED "TRUE", OTHERWISE IT IS RETURNED "FALSE".

IFN FTUUOS,<
ACCCHK:	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET PRIV BIT
	PJUMPN	S1,.TRUE##		;AND RETURN IF CREATOR WAS PRIV'ED
	LOAD	S1,.FPINF(E),FP.SPL	;GET SPOOLED BIT
	JUMPN	S1,.TRUE##		;IT'S SPOOLED, JUST RETURN
	HRLZI	T2,.ACRED		;ASSUME READ ACCESS
	LOAD	S2,.FPINF(E),FP.DEL	;ARE WE DELETING IT?
	SKIPE	S2			;SKIP IF NO
	HRLZI	T2,.ACREN		;YES, WE ARE
	HLRZ	T3,J$DUUO+.RBPRV(J)	;GET PROTECTION CODE
	LSH	T3,-^D9			;SHIFT IT OVER
	HRR	T2,T3			;AND COPY IT INTO T2
	MOVE	T3,J$DUUO+.RBPPN(J)	;GET THE FILE'S DIRECTORY
	TLNN	T3,-1			;A PATH?
	MOVE	T3,2(T3)		;YES, GET PPN FROM PATH BLOCK
	MOVE	T4,.EQOWN(J)		;GET USER'S PPN
	MOVE	T1,[3,,T2]		;LOAD BLOCK POINTER
	CHKACC	T1,			;TRY IT!
	  JRST	ACCC.1			;FAILURE
	JUMPE	T1,.TRUE##		;SUCCESS!!
	CLEAR	S2,			;CLEAR A REG
	STORE	S2,.FPINF(E),FP.DEL	;CLEAR THE DELETE BIT
	HRLI	T2,.ACRED		;TRY READ ONLY
	MOVE	T1,[3,,T2]		;LOAD ARG POINTER
	CHKACC	T1,			;TRY AGAIN
	  JRST	ACCC.1			;THAT'S FUNNY?
	JUMPE	T1,.TRUE##		;WIN!

ACCC.1:	MOVX	S1,ERPRT%		;LOAD ERROR CODE
	MOVX	S2,LOG			;TELL LOG
	SKIPE	MSGERR			;AND IF OPR WANTS ERRORS
	IORX	S2,OPR			;TELL HIM TOO
	PUSHJ	P,TELCAF		;TELL THEM
	PJRST	.FALSE##		;AND LOSE
>  ;END IFN FTUUOS
IFN FTJSYS,<
ACCCHK:	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET PRIV BIT
	PJUMPN	S1,.TRUE##		;RETURN IF HE WAS PRIV'ED
	LOAD	S1,.FPINF(E),FP.SPL	;GET SPOOL BIT
	PJUMPN	S1,.TRUE##		;RETURN IF IT IS SPOOLED
	MOVX	S1,.CKARD		;GET "READ" CODE
	LOAD	S2,.FPINF(E),FP.DEL	;GET DELETE BIT
	SKIPE	S2			;WAS IT SET?
	MOVX	S1,.CKAWT		;YES, CHECK "WRITE" CODE
	MOVEM	S1,J$DCAB+.CKAAC(J)	;STORE IN CHKAC BLOCK
	MOVE	S1,J$DJFN(J)		;GET THE FILE'S JFN
	MOVEM	S1,J$DCAB+.CKAUD(J)	;STORE IN BLOCK
	HRROI	S1,.EQOWN(J)		;POINT TO USER'S DIRECTRY
	STORE	S1,J$DCAB+.CKALD(J)	;STORE IT
	HRROI	S1,.EQCON(J)		;POINT TO CONNECTED DIR
	STORE	S1,J$DCAB+.CKACD(J)	;STORE IT
	ZERO	J$DCAB+.CKAEC(J)
	MOVEI	S1,.CKAUD+1		;LOAD ARG COUNT
	TXO	S1,CK%JFN		;SET JFN ARG BIT
	MOVEI	S2,J$DCAB(J)		;LOAD BLOCK ADR
	CHKAC				;CHECK ACCESS
	  JRST	ACCC.1			;LOSE, NO ACCESS
	PJUMPN	S1,.TRUE##		;RETURN IF SUCCESSFUL
	ZERO	S2			;CLEAR OUT S2
	STORE	S2,.FPINF(E),FP.DEL	;AND CLEAR THE DELETE BIT
	MOVX	S1,.CKARD		;GET READ CODE
	MOVEM	S1,J$DCAB+.CKAAC(J)	;STORE IT
	MOVEI	S1,.CKAUD+1		;NUMBER OF ARGS
	TXO	S1,CK%JFN		;SET JFN ARG BIT
	MOVEI	S2,J$DCAB(J)		;WHERE THEY ARE
	CHKAC				;TRY AGAIN
	  JRST	ACCC.1			;LOSE
	PJUMPN	S1,.TRUE##		;WIN ?

ACCC.1:	MOVX	S1,OPNX3		;LOAD THE ERROR CODE
	MOVX	S2,LOG			;TELL LOG
	SKIPE	MSGERR			;AND IF OPR WANTS ERRORS
	IORX	S2,OPR			;TELL HIM TOO
	PUSHJ	P,TELCAF		;TELL THEM
	PJRST	.FALSE##		;AND LOSE
>  ;END IFN FTJSYS
SUBTTL	DELFIL  -  Routine to delete the current file

;DELFIL SIMPLY DELETES THE CURRENT FILE

IFN FTUUOS,<
DELFIL:	CLEARB	T1,T2			;CLEAR TWO WORDS
	CLEARB	T3,T4			;AND TWO MORE
	RENAME	DSK,T1			;DELETE IT
	  JFCL				;IGNORE THIS
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
DELFIL:	MOVX	S1,1B0			;"DON'T RELEASE JFN"
	HRR	S1,J$DJFN(J)		;GET THE JFN
	CLOSF				;CLOSE THE FILE
	  JFCL				;IGNORE
	MOVX	S1,DF%EXP		;DELETE AND EXPUNGE
	HRR	S1,J$DJFN(J)		;GET THE JFN
	DELF				;DELETE IT
	  JFCL				;IGNORE THIS
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	CLSFIL  -  Routine to close current file

;CLSFIL IS CALLED TO SIMPLY CLOSE OUT THE CURRENT INPUT FILE

IFN FTUUOS,<
CLSFIL:	CLOSE	DSK,100			;CLOSE AND GIVE UP THE A.T.
	RELEAS	DSK,			;RELEASE THE CHANNEL
	OFF	S,DSKOPN		;TURN OFF THE OPEN FLAG
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
CLSFIL:	SKIPE	J$DRMS(J)		;IS THIS AN RMS FILE?
	JRST	CLSF.1			;YES, GO DO SOMETHING DIFFERENT
	HRRZ	S1,J$DJFN(J)		;GET THE JFN
	CLOSF				;CLOSE IT AND RELEASE THE JFN
	  JFCL				;IGNORE THE ERROR
	OFF	S,DSKOPN		;CLEAR THE OPEN FLAG
	POPJ	P,			;AND RETURN

CLSF.1:	MOVEI	T1,J$DRAB(J)		;LOAD ADDRESS OF THE RAB
	$DISCON	<(T1)>			;AND DISCONNECT FROM THE FAB
	MOVEI	T1,J$DFAB(J)		;NO GET ADR OF THE FAB
	$CLOSE	<(T1)>			;AND CLOSE THE FILE
	MOVE	S1,J$DJFN(J)		;GET THE JFN
	RLJFN				;RELEASE IT
	  JFCL				;IGNORE THE ERROR RETURN
	POPJ	P,			;RETURN
>  ;END IFN FTJSYS
SUBTTL	TELCAF   -  Routine to report file access failure

;TELCAF IS CALLED TO REPORT A FAILURE IN ATTEMPTING TO ACCESS A FILE.
;
;CALL:
;	MOVE	S1,[ERROR CODE]
;	MOVE	S2,[AC FIELD (DESTINATION) OF TELL UUO]
;	PUSHJ	P,TELCAF
;	  ALWAYS RETURN HERE

TELCAF:	LOAD	T1,.FPINF(E),FP.IGN	;GET FILE-IGNORE BIT
	LOAD	T2,.EQSEQ(J),EQ.RDE	;AND REQUEST-IGNORE BIT
	IOR	T1,T2			;OR THEM TOGETHER
	JUMPN	T1,.POPJ##		;AND RETURN IF EITHER IS SET
	LSH	S2,^D23			;PUT BITS INTO AC FIELD
	DMOVEM	S1,T3			;AND STORE THE ARGS
	TXNE	S2,LOG_^D23		;IS IT GOING TO THE LOG
	STAMP	LPERR			;YES, STAMPIT
	MOVE	N,T3			;GET THE ERROR CODE
	MOVE	T1,[TELL %%CAF]		;LOAD THE UUO
	IOR	T1,T4			;OR IN THE DESTINATION
	XCT	T1			;AND DO THE UUO

IFN FTUUOS,<
	MOVSI	T1,-ERTBLN		;MAKE AOBJN PTR FOR TABLE
	MOVE	S1,T3			;AND GET ERROR CODE

TELC.1:	MOVE	T2,ERRTAB(T1)		;GET AN ENTRY
	CAIN	S1,(T2)			;CORRECT CODE?
	JRST	TELC.2			;YUP!!
	AOBJN	T1,TELC.1		;NO, LOOP
	MOVSI	T2,[ASCIZ /Unexpected System Error/]
>  ;END IFN FTUUOS

IFN FTJSYS,<
	HRROI	S1,J$XSFO(J)		;GET A SCRATCH BLOCK
	MOVE	S2,T3			;GET THE ERROR CODE
	HRLI	S2,.FHSLF		;AND GET MY FORK HANDLE
	MOVSI	T1,-<<5*10>-1>		;LOAD -VE CHARACTERS TO STORE
	ERSTR				;GET THE ERROR STRING
	  JFCL				;IGNORE ERROR 1
	  JFCL				;IGNORE ERROR 2
	MOVSI	T2,J$XSFO(J)		;LOAD 0,,ADR
>  ;END IFN FTJSYS

TELC.2:	MOVSS	T2			;GET ADR OF MESS IN RH
	HRLI	T2,(TELL)		;PUT IN THE OP-CODE
	IOR	T2,T4			;PUT IN THE DESTINATION
	XCT	T2			;TYPE IT OUT
	MOVE	T2,[TELL CRLF]		;SETUP TO TYPE CRLF
	IOR	T2,T4			;TO THE RIGHT PEOPLE
	XCT	T2			;DO IT
	POPJ	P,			;AND RETURN
;ERROR MESSAGE TABLES

;FORMAT OF TABLE IS XWD  ADR-OF-STRING,ERROR-CODE

IFN FTUUOS,<
ERRTAB:	XWD	[ASCIZ /File Not Found/],	ERFNF%
	XWD	[ASCIZ /No UFD on that Structure/],	ERIPP%
	XWD	[ASCIZ /Protection Failure/],	ERPRT%
	XWD	[ASCIZ /File Being Modified/],	ERFBM%
	XWD	[ASCIZ /RIB or UFD Error/],	ERTRN%
	XWD	[ASCIZ /No such device/],	ERNSD%
	XWD	[ASCIZ /No Room or Quota Exceeded/],	ERNRM%
	XWD	[ASCIZ /Structure is Write-locked/],	ERWLK%
	XWD	[ASCIZ /SFD Not Found/],	ERSNF%
	XWD	[ASCIZ /SFD Nesting too deep/],	ERLVL%

	ERTBLN==.-ERRTAB
>  ;END IFN FTUUOS
SUBTTL	SETREF  -  Setup reference name for file

;SETREF IS CALLED TO SETUP THE REFERENCE NAME FOR THE CURRENT FILE.
;	THIS NAME IS PRIMARILY USED FOR THE HEADER PAGES.
;CALL:
;	PUSHJ P,SETREF
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
SETREF:	SETZB	S1,S2			;CLEAR TWO REGS
	DMOVEM	S1,J$DRNM(J)		;AND CLEAR REF NAME
	DMOVEM	S1,J$DREX(J)		;CLEAR REF EXTENSION
	MOVE	S1,J$FWCL(J)		;GET FORMS WIDTH CLASS
	MOVEM	S1,J$DRBS(J)		;AND SAVE AS BLOCKSIZE FOR HEADER

	SKIPN	S1,.FPFR1(E)		;IS THERE A /REPORT?
	JRST	SETR.1			;NO, CONTINUE
	MOVE	S2,.FPFR2(E)		;YES, GET THE SECOND HALF
	MOVEM	S1,J$DRNM(J)		;STORE FIRST HALF
	MOVEM	S2,J$DREX(J)		;AND SECOND HALF
	POPJ	P,			;AND RETURN

SETR.1:	LOAD	S1,.FPINF(E),FP.SPL  	;GET SPOOL BIT
	JUMPE	S1,SETR.2		;AND JUMP IF NOT SPOOLED
	SKIPN	S1,J$DUUO+.RBSPL(J)  	;GET SPOOLED NAME
	JRST	SETR.2			;NONE, USE REAL FILENAME
	MOVEM	S1,J$DRNM(J)		;STORE THE NAME
	POPJ	P,			;AND RETURN

SETR.2:	MOVE	S1,J$DUUO+.RBNAM(J)  	;GET FILE NAME
	MOVEM	S1,J$DRNM(J)		;AND SAVE IT
	HLLZ	S1,J$DUUO+.RBEXT(J)  	;AND THE EXTENSION
	MOVEM	S1,J$DREX(J)		;SAVE IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS
IFN FTJSYS,<
SETREF:	SETZB	S1,S2			;CLEAR SOME REGS
	DMOVEM	S1,J$DRNM(J)		;CLEAR THE REF NAME
	DMOVEM	S1,J$DREX(J)		;CLEAR THE REF EXTENSION
	MOVE	S1,J$FWCL(J)		;START WITH THE WIDTH CLASS
	MOVEM	S1,J$DRBS(J)		;AS THE BLOCK SIZE

	SKIPN	S1,.FPFR1(E)		;IS THERE A /REPORT?
	JRST	SETR.1			;NO, CONTINUE
	MOVE	S2,.FPFR2(E)		;YES, GET SECOND HALF
	MOVEM	S1,J$DRNM(J)		;SAVE THE FIRST HALF
	MOVEM	S2,J$DREX(J)		;SAVE THE SECOND HALF
	POPJ	P,			;AND RETURN

SETR.1:	HRROI	S1,J$DNAM(J)		;GET POINTER TO NAME BLOCK
	MOVE	S2,J$DJFN(J)		;GET THE JFN
	MOVX	T1,1B8			;FILENAME ONLY
	JFNS				;GET IT

	LOAD	S1,.FPINF(E),FP.SPL	;GET THE SPOOL BIT
	JUMPN	S1,SETR.4		;AND JUMP IF SPOOLED
SETR.2:	MOVE	S1,[POINT 7,J$DNAM(J)]	;POINT TO FILENAME
	MOVE	S2,[POINT 6,J$DRNM(J)]	;AND SOME PLACE TO STORE IT
	SETZ	T1,			;AND CLEAR A COUNTER
SETR.3:	ILDB	T2,S1			;GET A CHARACTER
	JUMPE	T2,SETR.7		;JUMP TO GET EXTENSION
	SUBI	T2,40			;CONVERT TO SIXBIT
	IDPB	T2,S2			;AND DEPOSIT IT
	CAIGE	T1,10			;GET 9 YET?
	AOJA	T1,SETR.3		;NO, LOOP
	JRST	SETR.7			;GO GET EXTENSION

;HERE ON A SPOOLED FILE
SETR.4:	MOVE	S1,[POINT 7,J$DNAM(J)]	;POINT TO THE NAME
	MOVE	S2,[POINT 6,J$DRNM(J)]	;AND A PLACE TO STORE IT
	SETZ	T1,			;AND CLEAR A COUNTER

SETR.5:	ILDB	T2,S1			;GET A CHARACTER
	CAIN	T2,"-"			;GOT A DASH?
	JRST	SETR.6			;YES, HAVE TO SKIP 3 OF THEM
	JUMPE	T2,SETR.2		;END, GIVE FULL FILENAME
	JRST	SETR.5			;LOOP
SETR.6:	CAIE	T1,2			;GOT 3 DASHES YET?
	AOJA	T1,SETR.5		;NO, KEEP LOOKING
	SETZ	T1,			;YES, CLEAR T1
	JRST	SETR.3			;AND NOW PICK UP THE NAME


				;"SETREF" IS CONTINUED ON THE NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

SETR.7:	LOAD	S1,.FPINF(E),FP.SPL	;SPOOLED FILE?
	SKIPN	J$DRNM(J)		;IS THE NAME NULL?
	JUMPN	S1,SETR.2		;IF YES TO BOTH, GET SPOOLED NAME
	HRROI	S1,J$DNAM(J)		;POINT TO TEMP EXTENSION BLOCK
	MOVE	S2,J$DJFN(J)		;GET THE JFN
	MOVX	T1,1B11			;EXTENSION ONLY
	JFNS				;GET IT
	MOVE	S1,[POINT 7,J$DNAM(J)]	;ELSE, POINT TO EXTENSION
	MOVE	S2,[POINT 6,J$DREX(J)]	;AND A PLACE TO STORE IT
	SETZ	T1,			;AND CLEAR A COUNTER

SETR.8:	ILDB	T2,S1			;GET A CHARACTER
	JUMPE	T2,SETR.9		;END!!
	SUBI	T2,40			;CONVERT TO 6BIT
	IDPB	T2,S2			;AND STORE IT
	CAIGE	T1,7			;GET 8 YET?
	AOJA	T1,SETR.8		;NO, LOOP

SETR.9:	SKIPN	J$DRNM+1(J)		;.GT. 6 CHAR NAME?
	SKIPE	J$DREX+1(J)		;OR .GT. 6 CHAR EXT?
	SKIPA				;YES, ADJUST THINGS A LITTLE
	POPJ	P,			;NO, JUST RETURN
	DMOVE	S1,J$DREX(J)		;YES, LOAD EXTENSION
	LSHC	S1,-6			;SHIFT OVER SOME
	DMOVEM	S1,J$DREX(J)		;AND STORE IT
	SOS	J$DRBS(J)		;DECREMENT THE BLOCK SIZE
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	Accounting Routines

;	ACTBEG		--		SETUP ACCOUNTING AT JOB-START
;	ACTBFL		--		DO PRE-FILE ACCOUNTING
;	ACTEFL		--		DO POST-FILE ACCOUNTING
;	ACTEND		--		FINISH ACCOUNTING AT JOB-END
;	ACTERR		--		HANDLE ACCOUNTING ERROR


	TOPSEG				;THESE ARE IN THE HISEG
SUBTTL	ACTBEG  -  Routine to setup accounting

;ACTBEG IS CALLED AT THE BEGINNING OF EACH JOB TO SETUP THE ACCOUNTING
;	FOR THE JOB.
;
;CALL:
;	PUSHJ P,ACTBEG
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
ACTBEG:	MOVSI	S1,J$AFNC(J)		;GET ADR,,0
	HRRI	S1,J$AFNC+1(J)		;GET ADR,,ADR+1
	SETZM	J$AFNC(J)		;ZERO FIRST WORD OF ACCT BLOCK
	BLT	S1,J$AEND(J)		;ZERO THE REST
	MOVEI	T1,.FACT		;GET CORRECT DAEMON FUNCTION
	MOVEM	T1,J$AFNC(J)		;AND STORE IT
	MOVNI	T1,1			;GET THIS JOB'S TTY NUMBER
	GETLCH	T1			; ..
	TXNE	T1,GL.CTY		;CTY?
	MOVNI	T1,1			;YES
	GETLIN	T2,			;SEE IF DETACHED
	TLNN	T2,-1			; ..
	MOVNI	T1,2			;YES. FLAG AS DETACHED
	ANDI	T1,7777			;AND DOWN TO 12 BITS
	LSH	T1,6			;AND PUT INTO BITS 18-29
	PJOB	T2,			;GET JOB NUMBER
	HRL	T1,T2			;PUT INTO LH OF T1
	IOR	T1,[FCTHDR]		;OR IN FUNCTION AND LENGTH
	MOVEM	T1,J$AHED(J)		;AND STORE IN FACT BLOCK
	MOVE	S1,J$LDEV(J)		;GET THE PROCESSING DEVICE
	MOVEM	S1,J$ADEV(J)		;AND STORE IT
	HRROI	T1,.GTTIM	 	;GET THE RUNTIME
	GETTAB	T1,			; FROM THE MONITOR
	  SETZ	T1,			;FAILED!!!
	MOVNM	T1,J$ARTM(J)		;-VE TO FACT BLOCK
	HRROI	T1,.GTKCT	 	;GET THE TOTAL KCT'S
	GETTAB	T1,			; FROM THE MONITOR
	  SETZ	T1,			;FAILED!!!
	MOVNM	T1,J$ACTI(J)	 	;STORE -VE (SO ADDB WILL CAUSE SUB)
	HRROI	T1,.GTRCT		;BLOCKS READ
	GETTAB	T1,			; FROM THE MONITOR
	  SETZ	T1,			;FAILED!!!
	TLZ	T1,777700		;CLEAR INCR.
	MOVNM	T1,J$ADRD(J)		;STORE -VE IN BLOCK
	HRROI	T1,.GTWCT		;DISK WRITES
	GETTAB	T1,		 	;ASK THE MONITOR
	  SETZ	T1,			;EGAD!! MUST BE LEVEL C
	TLZ	T1,777700		;CLEAR INCREMENTAL
	MOVNM	T1,J$ADWT(J)		;STORE -VE FOR TESTQ
	LOAD	T1,.EQSEQ(J),EQ.SEQ	;GET THE SEQUENCE NUMBER
	MOVEM	T1,J$ASEQ(J)		;STORE IT
	LOAD	T1,.EQOWN(J)		;GET REQUEST DIRECTORY
	MOVEM	T1,J$APPN(J)		;AND STORE IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS
IFN FTJSYS,<
ACTBEG:	MOVSI	S1,J$AHED(J)		;GET FIRST ADR,,0
	HRRI	S1,J$AHED+1(J)		;MAKE A BLT POINTER
	SETZM	J$AHED(J)		;CLEAR THE FIRST WORD
	BLT	S1,J$AEND(J)		;AND ZERO THE BLOCK
	GJINF				;GET JOB INFORMATION
	DPB	T1,[POINT 9,J$AHED(J),17]  ;STORE JOB NUMBER
	DPB	T2,[POINT 9,J$AHED(J),26]  ;STORE LINE NUMBER
	MOVX	S1,<401B8+J$ALEN>	;LOAD REST OF THE HEADER WORD
	IORM	S1,J$AHED(J)		;STORE IT
;	LOAD	S1,.EQDIR(J),DI.OWN	;GET OWNER
;	MOVEM	S1,J$ADIR(J)		;SAVE IN FACT BLOCK
	GTAD				;GET DATE AND TIME
	MOVEM	S1,J$ADAT(J)		;AND SAVE IT
	MOVX	S1,.FHSLF		;GET FORK HANDLE
	RUNTM				;GET RUNTIME IN MS
	MOVNM	S1,J$ARTM(J)		;AND STORE NEGATED
	MOVE	S1,J$LDEV(J)		;GET PROCESSING DEVICE
	MOVEM	S1,J$ADEV(J)		;SAVE IT
	MOVE	S1,.EQLM1(J)		;GET FORMS
	MOVEM	S1,J$AFRM(J)		;SAVE IT
	POPJ	P,			;RETURN
>  ;END IFN FTJSYS
SUBTTL	ACTBFL  --  Do Pre-file Accounting

ACTBFL:	POPJ	P,
SUBTTL	ACTEFL  --  Do Post-file Accounting

ACTEFL:	POPJ	P,
SUBTTL	ACTEND  -  Routine to do accounting at end-of-job

;ACTEND IS CALLED AT THE END OF A JOB TO DO THE NECESSARY ACCOUNTING
;	FOR THE JOB.
;
;CALL:
;	PUSHJ P,ACTEND
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
ACTEND:	HRROI	T1,.GTTIM	;RUNTIME
	GETTAB	T1,		;GET FROM MONITOR
	  SETZ	T1,		;FAILED???
	ADDB	T1,J$ARTM(J)	;ADD TO -VE START TIME
	IMULI	T1,^D1000	;CONVERT TO MILLI-JIFFIES
	IDIV	T1,JIFSEC	;AND THEN TO MILLI-SECONDS
	MOVEM	T1,J$ARTM(J)	;AND STORE AGAIN
	HRROI	T1,.GTKCT	;GET THE NUMBER OF KCT'S
	GETTAB	T1,		; FROM THE MONITOR
	  SETZ	T1,		;FAILED!!!
	ADDB	T1,J$ACTI(J)	;COMPUTE ELAPSED KCT'S
	IMULI	T1,144		;CONVERT TO CENTI-JIFFIES
	IDIV	T1,JIFSEC	;CONVERT TO CENTI-SECONDS
	MOVEM	T1,J$ACTI(J)	;AND STORE
	HRROI	T1,.GTRCT	;GET THE NUMBER OF READS
	GETTAB	T1,		; FROM THE MONITOR
	  SETZ	T1,		;FAILED...
	TLZ	T1,777700	;CLEAR INCREMENTAL
	ADDM	T1,J$ADRD(J)	;GET ELAPSED READS
	HRROI	T1,.GTWCT	;GET THE NUMBER OF DISK WRITES
	GETTAB	T1,		; FROM THE MONITOR
	  SETZ	T1,		;FAILED,,,
	TLZ	T1,777700	;CLEAR INCREMENTAL
	ADDM	T1,J$ADWT(J)	;COMPUTE ELAPSED WRITES
	HRROI	T1,.GTLOC	;WHERE WE ARE
	GETTAB	T1,		;ASK THE MONITOR
	  SETZ	T1,		;WE ARE LOST DON'T SWEAT
	HRLZ	T2,T1		;SAVE OUR PLACE
	MOVE	T1,[%CNSER]	;APR SERIAL NUMBER (MASTER IF MORE
	GETTAB	T1,		; THAN ONE IN M/S)
	  SETZ	T1,		;EGAD!!
	HRR	T2,T1		;COPY APRSN
	MOVSI	T1,'LP '	;QUEUE NAME
	IOR	T1,T2		;MUSH TOGETHER
	MOVEM	T1,J$AQUE(J)	;SAVE FOR FACT ENTRIES
	SKIPN	ACTFLG		;CAN WE CALL THE DAEMON?
	POPJ	P,		;NO, RETURN
	MOVSI	N,14		;GET THE BLOCK LENGTH IN LH
	HRRI	N,J$AFNC(J)	;AND THE ADDRSS IN RH
	DAEMON	N,		;ACTIVATE THE DAEMON
	  JFCL			;IGNORE THE ERROR
	POPJ	P,		;AND RETURN
>  ;END IFN FTUUOS
IFN FTJSYS,<
ACTEND:	MOVX	S1,.FHSLF	;LOAD FORK HANDLE
	RUNTM			;GET RUNTIME
	ADDM	S1,J$ARTM(J)	;STORE IT
	SKIPN	ACTFLG		;ARE WE DOING ACCT?
	POPJ	P,		;NO, RETURN
;EFACT STUFF
	POPJ	P,		;AND RETURN
>  ;END IFN FTJSYS
SUBTTL COMMAND TABLES AND DISPATCHER
;FLAG BITS
	BIT	T2,IOACT,	;DISK FILE MUST BE OPEN

;COMMANDS

DEFINE 	NAMES,<
	C	EXIT,XITCOM,0
	C	MESSAGE,MESSGE,0
	C	STOP,STOP,0
	C	KILL,KILL,0
	C	FORMS,FRMCOM,0
	C	GO,GO,0
	C	ST,START,0
	C	START,START,0
	C	RESET,RESETC,0
	C	REQUEU,REQUE,0
	C	CURRENT,CURDEF,0
	C	CHKPNT,TAKCHK,IOACT
	C	PAUSE,PAUSE,0
	C	LOCK,SETLOK,0
	C	UNLOCK,CLRLOK,0
	C	WHAT,WHAT,0
	C	MLIMIT,MLIMIT,0
	C	LIMIT,LIMIT,0
	C	NEXT,NXTCOM,0	
	C	HELP,HELP,0
	C	FREEZE,FREEZE,0
	C	UNFREE,UNFREE,0
	C	REPRIN,REPRNT,IOACT
	C	SKPFIL,SKPFIL,IOACT
	C	SKPCOP,SKPCOP,IOACT
	C	SUPPRE,SUPPRE,IOACT
	C	NOSUPP,NOSUPR,IOACT
	C	BACKSP,BACKSP,IOACT
	C	FORWAR,FORWAR,IOACT
IFN FTUUOS,<
	C	ALIGN,ALIGN,0
>  ;END IFN FTUUOS
>  ;END OF NAMES MACRO
;TABLES
DEFINE	C(A,B,C),<
	XALL
	<SIXBIT	/A/>
	SALL
>
	TOPSEG
COMTAB:	NAMES


DEFINE	C(A,B,D),<
	EXP	D+B
>
DSPTAB:	NAMES
DISPL=.-DSPTAB
	SALL			;BACK TO SHORT FORM

	UUMASK==TELOPR!TELUSR!TELUSR!TNOACT	;UUO BITS
						;ALL IN THE LH

;HERE WHEN A COMMAND HAS BEEN TYPED

COMIN:	PUSHJ	P,SETNL		;SETUP FOR A NEW LINE
	MOVX	T1,UUMASK	;BITS TO SAVE AROUND COMMAND
	AND	T1,S		;EXTRACT THE BITS
	TXZ	S,UUMASK	;CLEAR THE BITS
	MOVEM	T1,UUSAVE#	;SAVE THEM.
	PUSHJ	P,SIXIN		;GET COMMAND
	  PJRST	CUE		;NULL COMMAND
	CAMN	T1,['MONITO']	;EMERGENCY EXIT?
	JRST	DOEXIT		;YES, DO IT
	MOVE	T2,T1		;COPY COMMAND
	SETO	T3,		;SET MASK TO ONES
	LSH	T3,-6		;SHIFT MASK
	LSH	T2,6		;SHIFT OFF 1 CHAR
	JUMPN	T2,.-2		;ANYTHING LEFT?
	MOVEI	N,0		;CLEAR FLAGS
	MOVSI	T2,-DISPL	;SET UP LENGTH OF TABLE
COMLP:	MOVE	T4,COMTAB(T2)	;GET A COMMAND
	CAMN	T4,T1		;AN EXACT MATCH?
	JRST	COMFND		;YES. THIS IS IT
	TDZ	T4,T3		;CLEAR PART NOT TYPED
	CAME	T4,T1		;PARTIAL MATCH
	JRST	COMNEQ		;NO. TRY NEXT
	TLOE	N,1		;FIRST OCCURENCE
	JRST	NOCOM		;NO. CAN'T BE UNIQUE
	HRR	N,T2		;YES. SAVE INDEX
COMNEQ:	AOBJN	T2,COMLP	;ANY MORE COMMANDS
	TLNN	N,-1		;NO. EXACTLY 1 MATCH?
	JRST	NOCOM		;NO, LOSE!
	HRR	T2,N		;YES, COPY INDEX
COMFND:	MOVE	T2,DSPTAB(T2)		;GET ADDRESS AND BITS

COMCK2:	TXNN	T2,IOACT		;DO WE HAVE TO BE IOACTIVE?
	JRST	COMCK3			;NO, GO ON
	TXNN	S,DSKOPN		;YES, ARE WE?
	JRST	CMSG2C			;NO, GIVE A MESSAGE

COMCK3:	PUSHJ	P,(T2)			;DISPATCH THE COMMAND
	JRST	CUE			;WAKE UP THE OPERATOR

NOCOM:	TELL	OPR,%%URC		;NOT UNIQUE
	PJRST	CUE			;RETURN


CMSG2C:	PUSHJ	P,NOTBSY		;TELL HIM WE'RE NOT BUSY

CUE:	PUSHJ	P,EAT			;EAT THE REST OF THE LINE
	TXNE	S,RUNB			;IF RUN IS ON
	TELL	OPR,EXCLPT		; TYPE A !
	TXNN	S,RUNB			;IF RUN IS OFF
	TELL	OPR,STAR		; TYPE A *
	TDZ	S,[UUMASK]		;CLEAR SAVED BITS
	IOR	S,UUSAVE		;PUT BACK ANY NEEDED
	TXNN	S,RUNB			;ARE WE RUNNABLE?
	JRST	COMIN			;NO, GET NEXT COMMAND
	POPJ	P,


NOTBSY:	MOVEI	T1,%%LII		;WE ARE IDLE
	TXNN	S,STARTD		;BUT IF WE'RE NOT STARTED,
	MOVEI	T1,%%WFS		;TELL HIM THAT INSTEAD
	TELL	OPR,(T1)		;GIVE SOME MESSAGE
	POPJ	P,			;AND RETURN
SUBTTL	Operator Commands -- START

;SUBROUTINE TO SELECT OUTPUT DEVICE AND START SPOOLER
;CALL WITH
;	PUSHJ	P,START
;	RETURN HERE
;
START:	TXNN	S,STARTD		;HAVE WE BEEN STARTED ALREADY?
	JRST	STAR.3			;NO, CONTINUE
	SKIPN	XITFLG			;IS THERE A PENDING EXIT?
	SKIPE	RSTFLG			;OR A PENDING RESET?
	JRST	STAR.1			;YES, CLEAR IT
	TXZN	S,PAUSEB		;NO, PENDING PAUSE?
	JRST	STAR.2			;NO, GIVE AN ERROR
STAR.1:	TELL	OPR,%%CPC		;TELL HIM
	SETZM	XITFLG			;CLEAR EXIT
	SETZM	RSTFLG			;AND RESET
	POPJ	P,			;AND RETURN

STAR.2:	TELL	OPR,%%LAS		;TELL HIM
	POPJ	P,			;AND RETURN

STAR.3:	PUSHJ	P,SIXIN			;GET A DEVICE NAME
	  MOVX	T1,DEFLPT		;USE THE DEFAULT
	MOVEM	T1,J$LGNM(J)		;SAVE AS GIVEN NAME
	PUSHJ	P,OUTGET		;OPEN THE DEVICE

STAR.4:	CAIE	C,"="			;DID HE SAY DEV=DEV?
	  JRST	STAR.5			;NO SCAN AHEAD
	PUSHJ	P,SIXIN			;YES, GET THE DEVICE
	  MOVSI	T1,'LPT'		;DEFAULT DEVICE
	MOVEM	T1,J$LSDV(J)		;STORE IT
	JRST	STAR.6			;AND CONTINUE

STAR.5:	PUSHJ	P,SIXIN			;SCAN AHEAD
	  JFCL				;THAT'S OK
	CAIN	C,"="			;FIND AN EQUAL?
	JRST	STAR.4			;YES, LOOP AROUND
STAR.6:	HLRZ	T1,J$LSDV(J)		;GET SCHEDULING DEVICE
	CAIN	T1,'LPT'		;IS IT A LPT?
	JRST	STAR.7			;YES, CONTINUE
	PUSHJ	P,EAT			;CLEAR TYPE AHEAD
	TELL	OPR,[ASCIZ /Specified device is not a LPT
What device do you want to schedule jobs for: /]
	PUSHJ	P,SETNL			;SET NEW LINE
	PUSHJ	P,SIXIN			;AND GET A DEVICE
	  JFCL				;IGNORE THIS
	MOVEM	T1,J$LSDV(J)		;STORE IT
	JRST	STAR.6			;AND LOOP

STAR.7:	PUSHJ	P,EAT			;EAT THE REST OF THE LINE
	ON	S,STARTD!RUNB		;FLAG THAT WE ARE STARTED
	PUSHJ	P,SETHEL		;SETUP HELLO BLOCK
	MOVEI	T1,MSGBLK		;LOAD ADR OF BLOCK
	PJRST	SNDQSR##		;AND SEND IT
SUBTTL	Operator Commands -- ALIGN

IFN FTUUOS,<

;SUBROUTINE TO ALLOW FORMS TO BE SET UP
;CALL WITH:
;	PUSHJ	P,ALIGN
;	HERE WHEN DONE
;
ALIGN:	TXNN	S,STARTD	;HAVE WE BEEN STARTED
	JRST	[TELL OPR,%%WFS	;NO TELL HIM
		 POPJ P,]	;AND RETURN
ALIGN1:	PUSHJ	P,SIXIN		;GET FILENAME
	  MOVE	T1,J$FALI(J)	;USE DEFAULT
	MOVE	P1,T1		;SETUP FOR LOOKUP
	MOVSI	P2,'ALP'	;EXTENSION .ALP
	CLEARB	P3,P4		;...
	SETZ	T1,		;ASCII MODE
	MOVEI	T3,J$ABRH(J)	;BUFFERS FOR ALIGN
	MOVSI	T2,'DSK'	;TRY DSK FIRST
ALOPN:	OPEN	ALP,T1		;INIT THE DEVICE
	  HALT	.		;???
	LOOKUP	ALP,P1		;LOOK FOR FILE
	  SKIPA			;SKIP IF LOOKUP FAILED
	JRST	ALGOT		;GOT IT!!

	CAMN	T2,[SIXBIT /SYS/]  ;DID WE LOOK ON SYS?
	JRST	[MOVE T1,P1	;GET FILE NAME
		 TELL OPR,%%CFA
		 POPJ P,]	;GUESS WE CAN'T FIND IT
	MOVSI	T2,'SYS'	;NO, TRY SYS
	JRST	ALOPN		;AND LOOP

ALGOT:	PUSHJ	P,M$ACQP##	;GET A PAGE
	MOVEM	AP,J$APAG(J)	;SAVE PAGE NUMBER
	PG2ADR	AP		;MAKE AN ADDRESS
	EXCH	AP,.JBFF	;SAVE AS JOBFF
	INBUF	ALP,2		;ALLOCATE BUFFERS
	MOVEM	AP,.JBFF	;RESTORE JOBFF
	OUTPUT	LPT,		;CLEAN UP
	TELL	OPR,STAR	;TELL THE OP TO DO SOMETHING
	MOVE	T1,J$FALC(J)	;GET LOOP COUNTER
ALNXT:	SOSGE	T1		;COUNT DOWN
	JRST	ALDIE		;DONE, RETURN
	USETI	ALP,1		;REWIND THE FILE
	SKPINL			;ANYTHING THERE?
	JRST	ALOOP		;NO, PRINT FILE AGAIN
	JRST	ALDIE		;YES, THAT'S ALL

ALOOP:	SOSLE	J$ABCT(J)	;ROOM IN BUFFERS
	JRST	ALDB		;YES--SHOVE IT
	IN	ALP,		;READ SOME FILE
	  JRST	ALDB		;NO ERRORS, CONTINUE
	STATO	ALP,IO.EOF	;IS IT END OF FILE?
	  JRST	ALDIE		;NO, STOP
	OUTPUT	LPT,		;DUMP THE PARTIAL BUFFER
	MOVE	T2,J$FALS(J)	;YES, GET SLEEP TIME
	SLEEP	T2,		;SLEEP
	  JFCL
	JRST	ALNXT		;LOOP

ALDB:	ILDB	C,J$ABPT(J)	;GET THE CHAR
	PUSHJ	P,DEVOUT	;PRINT THE CHAR
	JRST	ALOOP		;NOT SAVED
ALDIE:	RELEAS	ALP,		;GIVE UP THE DISK
	MOVE	AP,J$APAG(J)	;GET THE PAGE NUMBER BACK
	PUSHJ	P,M$RELP##	;RELEAS IT
	POPJ	P,		;AND RETURN

>  ;END IFN FTUUOS
SUBTTL	Operator Commands  --  HELP - MLIMIT
;SUBROUTINE TO TYPE THE HELP TEXT
;CALL WITH:
;	PUSHJ	P,HELP
;	RETURN HERE
;
HELP:	TELL	OPR,[ASCIZ /
Available Commands Are:
/]
	PUSHJ	P,.SAVE2##		;SAVE P1 AND P2
	MOVSI	P1,-DISPL		;SETUP AOBJN POINTER
	SETZ	P2,			;AND COMMAND COUNTER IS CLEAR

HELP.1:	MOVEI	C,.CHTAB		;LOAD A TAB
	SKIPE	P2			;FIRST COMMAND OF A LINE?
	PUSHJ	P,SEND			;NO, TYPE THE COMMA
	MOVE	T1,COMTAB(P1)		;GET THE COMMAND
	CAMN	T1,[SIXBIT /ST/]
	MOVE	T1,[SIXBIT /MONITO/]
	PUSHJ	P,SIXOUT		;TYPE IT
	CAIGE	P2,6			;TYPED SEVEN?
	AOJA	P2,HELP.2		;NO, KEEP GOING
	TELL	OPR,CRLF		;YES, TYPE A CRLF
	SETZ	P2,			;CLEAR THE COUNTER
HELP.2:	AOBJN	P1,HELP.1		;AND LOOP
	TELL	OPR,CRLF		;AND A FINAL CRLF
	POPJ	P,			;RETURN WHEN DONE


;SUBROUTINE TO SET MAX OUTPUT LIMIT FOR ALL JOBS
; ANY JOB OVER LIMIT WILL SIT IN QUEUE.
;CALL WITH:
;	PUSHJ	P,MLIMIT
;	RETURN HERE
;
MLIMIT:	PUSHJ	P,DECARG		;GET N
	  JRST	BADNBR			;BAD NUMBER
	JUMPE	N,LIMERR		;CAN'T BE ZERO
	MOVEM	N,J$XMLM(J)		;STORE AWAY
	PJRST	SNDSTC			;SEND A STATUS CHANGE AND RETURN
SUBTTL	Operator Commands  --  EXIT

;SUBROUTINE TO EXIT FROM SPOOLER
;CALL WITH:
;	PUSHJ	P,XITCOM
;	RETURN ONLY IF ERROR
;
XITCOM:	SETOM	XITFLG			;SET THE EXIT FLAG
	TXNN	S,BUSY			;ARE WE BUSY?
	JRST	DOEXIT			;NO, GO EXIT
	TELL	OPR,%%LWE		;YES, MAKE IT PEND
	POPJ	P,			;TELL OPR AND RETURN

DOEXIT:	PUSHJ	P,SETHEL		;SETUP HELLO BLOCK
	MOVX	T1,HELBYE!HELSTC;GOODBYE+STATUS CHANGE
	IORM	T1,MSGBLK+HEL.ST	;STORE THEM
	MOVEI	T1,MSGBLK		;ADDRESS OF BLOCK
	PUSHJ	P,SNDQSR##		;SEND IT
	RESET				;CLEAR ALL DEVICE PROBLEMS
IFN FTUUOS,<
	EXIT				;AND BACK TO MONITOR
>  ;END IFN FTUUOS
IFN FTJSYS,<
	HALTF				;AND BACK TO MONITOR
>  ;END IFN FTJSYS
SUBTTL	Operator Commands  --  LIMIT


;SUBROUTINE TO CHANGE LIMIT FOR THIS JOB ONLY
;CALL WITH:
;	PUSHJ	P,LIMIT
;	RETURN HERE
;
LIMIT:	TXNN	S,BUSY			;ARE WE BUSY?
	PJRST	NOTBSY			;NO, TELL HIM AND RETURN
	PUSHJ	P,DECARG		;GET ARGUMENT
	  JRST	BADNBR			;OOPS
	JUMPE	N,LIMERR		;CAN'T BE ZERO
	MOVEM	N,J$RLIM(J)		;STORE
	STAMP	LPOPR			;STAMP THE LOG
	TELL	LOG,%%OCL		;AND TELL THE LOG FILE
	POPJ	P,

LIMERR:	TELL	OPR,%%ICA		;ILLEGAL COMMAND ARGUMENT
	POPJ	P,


BADNBR:	TELL	OPR,BADNMS
	POPJ	P,
SUBTTL	Operator Commands  --  FORMS

;SUBROUTINE TO DECLARE A NEW TYPE OF FORMS TO BE MOUNTED
;CALL FROM COMAND DISPATCH
;

FRMCOM:	PUSHJ	P,SIXIN			;GET SPECIFIED TYPE
	  MOVX	T1,FRMNOR		;USE NORMAL BY DEFAULT
	TXNN	S,STARTD		;IS LPTSPL STARTED?
	JRST	FRMC.1			;NO, JUST SAVE FORMS AND RETURN
	MOVEM	T1,J$FSFM(J)		;SAVE AS SCHED TYPE
	PUSHJ	P,SNDSTC		;TELL QUASAR
	PJRST	OPNFRM			;RE-READ LPFORM.INI AND RETURN

FRMC.1:	MOVEM	T1,J$FORM(J)		;STORE FORMS TYPE
	MOVEM	T1,J$FSFM(J)		;AND SCHED FORMS TYPE
	POPJ	P,			;AND RETURN
SUBTTL	Operator Commands  --  KILL

;SUBROUTINE TO KILL THE CURRENT JOB
;
;CALL	KILL	-	ON OPERATOR KILL MESSAGE
;	UKILL	-	ON ABORT MESSAGE FROM USER

KILL:	SKIPA	P1,[EXP OPRKIL]		;LOAD ADR OF ROUTINE AND SKIP
UKILL:	MOVEI	P1,USRKIL		;LOAD ADDRESS

	TXNN	S,BUSY			;ARE WE DOING A JOB?
	PJRST	NOTBSY			;NO, TELL HIM AND RETURN
	TXNN	S,MNTBIT		;NO, ARE WE IN MOUNT WAIT?
	JRST	KILL2			;NO, JUST DO THE REGULAR THINGS
	MOVE	T1,J$FPFM(J)		;YES, GET PREVIOUS FORMS TYPE
	MOVEM	T1,J$FORM(J)		;SAVE A CURRENT FORMS
	MOVEM	T1,J$FSFM(J)		;SAVE AS SCHEDULING FORMS
	PUSHJ	P,SNDSTC		;AND TELL QUASAR
	PUSHJ	P,FRMINI		;INITIALIZE FORMS PARAMTERS

KILL2:	TXNE	S,DSKOPN		;ARE WE PRINTING A FILE?
	PUSHJ	P,OUTFLS		;YES, FLUSH ALL OUTPUT
	PUSHJ	P,(P1)			;CALL TYPE DEPENDENT ROUTINE
KILL3:	OFF	S,FFSEEN		;TURN OFF FF FLAG
	PUSHJ	P,SETEOF		;CAUSE AN EOF TO HAPPEN
	ON	S,ABORT			;AND SET ABORT BIT
	JRST	GO			;GO!


;HERE FOR OPERATOR KILL STUFF
OPRKIL:	TXNN	S,BANDUN		;HAVE WE PRINTED A BANNER?
	PUSHJ	P,JOBHDR		;NO, DO SO
	STAMP	LPOPR			;STAMP THE LOG
	TELL	LOG,%%KBO		;PUT IN A MESSAGE
	POPJ	P,			;AND RETURN

;HERE FOR USER KILL STUFF
USRKIL:	MOVE	S1,MESSAG		;GET ADDRESS OF MESSAGE
	MOVE	T1,ABO.CD(S1)		;GET ABORT CODE
	CAIN	T1,ABOOPR		;ABORT BY OPR?
	JRST	OPRKIL			;YES, SWITCH GEARS
	STAMP	LPMSG			;STAMP THE LOG
	TELL	LOG,%%CBU		;KILLED BY USER
	MOVE	T1,ABO.ID(S1)		;GET ID OF KILLER
	PUSHJ	P,TYPUID		;TYPE IT ON THE LOG
	TELL	LOG,CRLF		;PLACE A CRLF
	POPJ	P,			;AND RETURN
SUBTTL	Operator Commands  --  PAUSE - STOP - GO


PAUSE:	TXNE	S,BUSY			;PAUSE=STOP IFN BUSY
	TXOA	S,PAUSEB		;SET PAUSE BIT AND SKIP
STOP:	OFF	S,RUNB			;TURN OFF THE RUN BIT
	PJRST	SNDSTC			;STOP SCHEDULING AND RETURN

GO:	TXNE	S,STARTD
	ON	S,RUNB
	OFF	S,PAUSEB!MNTBIT
	PJRST	SNDSTC			;START SCHEDULING AGAIN


;HERE AT END-OF-JOB WHEN WE MUST PAUSE
DOPAUS:	TELL	OPR,[ASCIZ /Spooler is PAUSE'ing ON $, type GO to continue
/]
	JRST	STOP			;AND GO STOP
SUBTTL	Operator Commands  --  REPRINT - SKPCOPY - SKPFILE

;REPRINT -- ROUTINE TO START THE CURRENT COPY OF THE CURRENT
;	FILE OVER AGAIN.
;CALL WITH:
;	PUSHJ	P,REPRNT
;	RETURN HERE
;
REPRNT:	PUSHJ	P,OUTFLS		;FLUSH OUTPUT
	AOS	J$XCOP(J)		;INCREMENT COPY COUNT
	STAMP	LPOPR			;STAMP THE LOG
	MOVE	N,J$RNCP(J)		;GET COPY-1
	ADDI	N,1			;GET COPY #
	TELL	LOG,%%ORC		;AND A MESSAGE
	MOVN	T1,J$RNPP(J)		;GET -VE PAGES PRINTED THIS COPY
	ADDM	T1,J$APRT(J)		;AND DECREMENT THE TOTAL PRINTED
	SOS	J$RNCP(J)		;AND DECREMENT COPIES PRINTED
	JRST	SKPCP1			;AND MAKE AN END-OF-FILE


;SKPCOP -- ROUTINE TO START THE NEXT COPY OF THE CURRENT FILE
;CALL WITH:
;	PUSHJ P,SKPCOP
;	RETURN HERE
;
SKPCOP:	PUSHJ	P,OUTFLS		;FLUSH OUTPUT
	STAMP	LPOPR			;STAMP THE LOG
	MOVE	N,J$RNCP(J)		;GET COPY NUMBER-1
	ADDI	N,1			;MAKE IT COPY NUMBER
	TELL	LOG,%%OSC		;AND TELL HIM
SKPCP1:	PUSHJ	P,SETEOF		;CAUSE AN EOF TO HAPPEN
	POPJ	P,			;AND RETURN



;SKPFIL -- ROUTINE TO START THE NEXT FILE
;CALL WITH:
;	PUSHJ	P,SKPFIL
;	RETURN HERE
;
SKPFIL:	PUSHJ	P,OUTFLS		;FLUSH OUTPUT
	STAMP	LPOPR			;STAMP THE LOG
	TELL	LOG,%%OSF		;AND TELL HIM
	PUSHJ	P,SETEOF		;CAUSE AN EOF
	SETZM	J$XCOP(J)		;CAUSE END OF COPIES LOOP
	POPJ	P,			;AND RETURN
SUBTTL	Operator Commands  --  (UN)LOCK - (UN)FREEZE


;SUBROUTINES TO SET OR CLEAR BOTH PAUSE AND PAUSE LOCK
;CALL WITH:
;	PUSHJ	P,SETLOK (CLRLOK)
;	RETURN HERE
;
SETLOK:	TXOA	S,PLOCK			;SET THE LOCK
CLRLOK:	TXZ	S,PLOCK			;CLEAR THE LOCK
	POPJ	P,			;AND RETURN


;SUBROUTINES TO SET AND CLEAR FORMS LOCK.  CALLED ON THE FREEZE AND
;UNFREEZE COMMANDS.
;CALL WITH
;	PUSHJ P,FREEZE (OR UNFREE)
;	RETURN HERE
;
FREEZE:	TXOA	S,FROZE			;TURN ON FROZE BIT
UNFREE:	OFF	S,FROZE			;TURN OFF FROZE BIT
	PJRST	SNDSTC			;SEND A STATUS CHANGE AND RETURN
SUBTTL	Operator Commands  --  NEXT

;SUBROUTINE TO FORCE JOB #N TO BE RUN NEXT
;CALL WITH:
;		PUSHJ	P,NXTCOM
;		RETURN HERE
;
NXTCOM:	PUSHJ	P,DECARG	;READ A DECIMAL ARGUMENT
	  PJRST	BADNBR		;OOPS...
	MOVEM	N,NXTJOB	;SAVE FOR LATER
	PJRST	SNDSTC		;AND SEND A STATUS CHANGE
SUBTTL	Operator Commands  --  REQUEUE

;SUBROUTINE TO REQUEUE AN ENTRY
;CALL WITH:
;	PUSHJ	P,REQUE
;
REQUE:	TXNN	S,BUSY			;ARE WE BUSY?
	PJRST	NOTBSY			;NO, RETURN
	TXZN	S,MNTBIT		;ARE WE IN MOUNT WAIT?
	JRST	REQUE0			;NO, SKIP THIS STUFF
	MOVE	T1,J$FPFM(J)		;YES, LOAD OLD FORMS
	MOVEM	T1,J$FORM(J)		;AND STORE
	MOVEM	T1,J$FSFM(J)		;SAVE AS SCHEDULING FORMS
	ON	S,RQB!RUNB		;TURN ON REQUE AND RUN
	PUSHJ	P,SNDSTC		;AND SEND A STATUS CHANGE
	PUSHJ	P,FRMINI		;AND INITALIZE PARAMETERS
REQUE0:	PUSHJ	P,SETCHP		;SETUP CHECKPOINT INFO
	MOVEI	T1,5			;/AFTER:5 IS DEFAULT
	MOVEM	T1,MSGBLK+REQ.AF	;STORE IT
	MOVX	T1,CKFREQ		;GET REQUEUE BIT
	MOVEM	T1,MSGBLK+REQ.IN+CKFLG	;STORE IT

REQUE1:	PUSHJ	P,DOSW			;SCAN FOR A /
	TXNE	S,TTYBRK		;HIT EOL?
	JRST	REQUE2			;YES, DONE
	ACTCHR	A,RQAFT			;AFTER
	ACTCHR	H,RQHOLD		;HOLD
	ACTCHR	T,RQTOP			;TOP OF JOB
	ACTCHR	B,RQBACK		;BACK N UNITS
	ACTCHR	F,RQFOR			;FORWARD N UNITS
	TELL	OPR,BADSW		;BAD SWITCH
	POPJ	P,			;PUNT THE COMMAND
RQHOLD:	MOVEI	T1,^D720		;12 HOURS (720 MINUTES)
	MOVEM	T1,MSGBLK+REQ.AF	;NEW AFTER PARAM
	JRST	REQUE1			;DO NEXT SWITCH
RQBACK:	PUSHJ	P,GTARGU		;GET ARGUMENT
	MOVN	N,N			;BACK
	SKIPA				;THE REST IS LIKE /FORWARD
RQFOR:	PUSHJ	P,GTARGU		;GET THE ARGUMENT
	ADDM	N,MSGBLK+REQ.IN+CKPAG	;ADD TO CURRENT POSITION
	JRST	REQUE1			;AND LOOP
RQAFT:	PUSHJ	P,FNDELM		;GET THE DELIMITER
	  SKIPA				;NONE
	PUSHJ	P,DECARG		;GET THE NUMBER
	  MOVEI	N,^D30			;ASSUME 30 MIN.
	MOVEM	N,MSGBLK+REQ.AF		;STORE AWAY
	JRST	REQUE1			;LOOP FOR MORE COMPLEX STUFF
RQTOP:	SETZM	MSGBLK+REQ.IN+CKFIL	;CLEAR THE FILE WORD
	SETZM	MSGBLK+REQ.IN+CKCOP	;CLEAR THE COPIES WORD
	SETZM	MSGBLK+REQ.IN+CKPAG	;CLEAR THE PAGES WORD
	SETZM	MSGBLK+REQ.IN+CKTPP	;CLEAR THE TOTAL PAGES WORD
	JRST	REQUE1			;LOOK FOR MORE SWITCHES

REQUE2:	PUSHJ	P,RIDLOG		;RELEASE THE LOG FILE
	STAMP	LPOPR			;TELL USER WHAT OPR DID
	TELL	LOG,%%RBO		;SEND THE REQUEUE MESSAGE
	MOVX	T1,<REQ.SZ,,.QOREQ>	;GET MESSAGE HEADER
	MOVEM	T1,MSGBLK		;STORE IT
	MOVEI	T1,MSGBLK		;ADR OF REQUEUE BLOCK
	PUSHJ	P,SNDQSR##		;SEND IT TO QUASAR
	PUSHJ	P,CLSFIL		;AND CLOSE INPUT FILE
	PUSHJ	P,EAT			;EAT TILL EOL
	TELL	OPR,EXCLPT		;AND GIVE OPR THE PROMPT
	JRST	ENDJOB			;AND GO FINISH UP

GTARGU:	PUSHJ	P,FNDELM		;GET HTE DELIMITER
	  JFCL				;NONE DON'T SWEAT
	PUSHJ	P,DECARG		;GET A DECNAL NUMBER
	  JFCL				;LOSS DO NOT WORRY
	POPJ	P,			;RETURN
SUBTTL	Operator Commands  --  WHAT

;SUBROUTINE TO GIVE CURRENT STATUS OF SPOOLER

WHAT:	TXNN	S,STARTD		;ARE WE STARTED?
	PJRST	CURINF			;NO, JUST GIVE USEFUL INFO
	TXNN	S,BUSY			;DO WE HAVE A JOB?
	JRST	WHATC			;NO, SKIP ALLLLLLL OF THIS
WHATA:	LOAD	T1,.EQJOB(J)		;GET JOB NAME
	LOAD	N,.EQSEQ(J),EQ.SEQ	;AND SEQUENCE NUMBER
	TELL	OPR,[ASCIZ \$:+/SEQ:#/USER:]  \]

	MOVE	N,J$APRT(J)		;GET AMOUNT PRINTED
	TELL	OPR,WHAT6		;AND TYPE AMOUNT PRINTED
	MOVE	N,J$RLIM(J)		;GET LIMIT
	TELL	OPR,WHAT7		;AND TYPE IT

	TXNN	S,DSKOPN		;IS A FILE OPEN?
	JRST	WHATB			;NO, SKIP THIS STUFF
	TELL	OPR,WHAT10		;TYPE THE FILE NAME
	LOAD	T2,.FPINF(E),FP.DEL	;GET THE DISPOSITION
	MOVX	T1,'PRESER'		;ASSUME PRESERVED
	SKIPE	T2			;SKIP IF PRESERVED
	MOVX	T1,'DELETE'		;NO, DELETE
	LOAD	T2,.FPINF(E),FP.SPL	;GET SPOOL BIT
	SKIPE	T2			;IS IT SET?
	MOVX	T1,'SPOOL '		;YES, TELL HIM
	TELL	OPR,WHAT11		;AND PRINT IT
	TXNE	S,SUPRES		;ARE WE SUPPRESSED?
	TELL	OPR,[ASCIZ ?/SUPPRESS?]
	MOVE	N,J$RNCP(J)		;GET NUMBER OF COPIES PRINTED
	AOS	N			;GET CURRENT COPY NUMBER
	TELL	OPR,WHAT8		;AND PRINT IT
	LOAD	N,.FPINF(E),FP.FCY	;GET TOTAL NUMBER OF COPIES
	TELL	OPR,WHAT9		;PRINT IT
	MOVE	N,J$RNPP(J)		;GET NUMBER OF PAGES PRINTED
	TELL	OPR,WHAT12		;AND TEEL THE OPERATOR

WHATB:	SKIPN	T1,.EQNOT(J)		;IS THERE A USER NOTE?
	JRST	WHATC			;NO, CONTINUE ON
	TELL	OPR,[ASCIZ /![User note: +/]
	MOVE	T1,.EQNOT+1(J)		;GET THE SECOND HALF
	TELL	OPR,[ASCIZ /+!]
/]

WHATC:	TXNN	S,BUSY			;ARE WE BUSY?
	TELL	OPR,%%LII		;NO, TELL HIM
	MOVE	T1,J$FORM(J)		;LOAD THE FORMS TYPE
	TXNE	S,MNTBIT		;ARE WE IN MOUNT WAIT?
	TELL	OPR,%%WFF		;YES, TELL HIM
	PJRST	CURINF			;AND GIVE THE REST OF CURRENT INFO
SUBTTL	Operator Commands  --  CURRENT

;SUBROUTINE TO GIVE THE CURRENT DEFAULTS

CURDEF:	MOVE	N,J$XMLM(J)		;PICK UP MLIMIT
	TELL	OPR,CURMS1		;GIVE THE FIRST MESSAGE
	TELL	OPR,[ASCIZ /Messages on:/]
	SKIPE	T1,MSGJOB		;JOB?
	TELL	OPR,[ASCIZ / JOB/]
	SKIPE	T2,MSGFIL		;FILE?
	TELL	OPR,[ASCIZ / FILE/]
	SKIPE	T3,MSGERR 		;ERRORS?
	TELL	OPR,[ASCIZ / ERRORS/]
	ADD	T1,T2			;COMBINE JOB+FILE
	ADD	T1,T3			;ADD IN ERROR
	SKIPN	T1			;ANY OF THE ABOVE?
	TELL	OPR,[ASCIZ / No Conditions/]
	TELL	OPR,CRLF		;AND AN EOL

	SKIPE	N,NXTJOB		;GET NEXT-JOB
	TELL	OPR,CURMS2		;TELL HIM

	MOVE	T1,J$FORM(J)		;GET CURRENT FORMS TYPE
	TXNE	S,MNTBIT		;ARE WE WAITING FOR MOUNT?
	MOVE	T1,J$FPFM(J)		;YES, USE PREVIOUS TYPE
	MOVEI	T2,%%TFM		;LOAD FORMS MOUNTED MESSAGE
	TXNE	S,FROZE			;ARE WE FROZEN?
	MOVEI	T2,%%FAF		;YES, GET FROZEN MESSAGE
	TELL	OPR,(T2)		;AND TYPE A MESSAGE
	MOVE	T1,J$FSFM(J)		;TYPE OF FORM QUASAR BELIEVES IN
	CAME	T1,J$FORM(J)		;IS IT THE TYPE MOUNTED?
	TELL	OPR,%%FHB		;NO, TELL HIM
	SKIPE	J$FNOT(J)		;IS THERE A NOTE?
	TELLN	OPR,@J$FNOT(J)		;YES, TYPE IT


				;CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

CURINF:	TXNE	S,STARTD		;ARE WE STARTED?
	JRST	CURD.1			;YES, CONTINUE
	TELL	OPR,%%WFS		;NO, TELL HIM
	POPJ	P,			;AND RETURN

CURD.1:	TXNN	S,RUNB			;ARE WE RUNNING?
	TELL	OPR,%%SIS		;NO, TELL HIM

CURD.3:	SKIPE	XITFLG			;WILL WE EXIT
	TELL	OPR,%%LWE		;YES, TELL HIM

CURD.4:	SKIPE	RSTFLG			;WILL WE RESET?
	TELL	OPR,%%LWR		;YES, TELL HIM

CURD.5:	TXNE	S,PAUSEB!PLOCK		;WILL WE PAUSE?
	TELL	OPR,%%LWP		;YES

CURD.7:	SKIPE	J$LHNG(J)		;IS THE LPT HUNG?
	TELL	OPR,%%DOL		;YES, TELL HIM

	POPJ	P,			;RETURN
SUBTTL	Operator Commands  --  BACKSPACE

;(NOTE: ENTER AT "IBACK" WITH N CONTAINING NUMBER OF PAGES)


BACKSP:	TXNE	S,NOTYPE	;IS BACK OR FORWARD IN PROGRESS?
	JRST	BFINPR		;YES, GIVE AN ERROR
	PUSHJ	P,DECARG	;GET THE ARGUMENT
	  POPJ	P,		;ZERO OR ILLEGAL
BACK.1:	CAMLE	N,J$RNPP(J)	;BACKING UP PAST BEGINNING?
	MOVE	N,J$RNPP(J)	;YES, MAKE IT A REWIND
	STAMP	LPOPR		;STAMP THE MESSAGE
	TELL	LOG,%%BSF	;PUT MESSAGE IN THE LOG
IFN FTUUOS,<
	CAIG	N,TABSIZ	;IS BACK-SKIP WITHIN TABLE?
	JRST	BSPCF		;YES, TRY FOR FAST BACKSPACE
>  ;END IFN FTUUOS

BACKS1:	PUSHJ	P,REWIND	;REWIND THE FILE
	MOVNS	N		;GET NEGATIVE PAGES TO SKIP
	ADD	N,J$RNPP(J)	;ADD TO CURRENT PAGE = DESTINATION PAGE
	SETZM	J$RNPP(J)	;SET CURRENT PAGE TO 0
	SOJG	N,FORWD1	;AND SKIP THE PAGES IF GT 1
	POPJ	P,		;AND RETURN

;ENTER HERE FOR INTERNAL BACKSPACE CALL WITH N CONTAINING THE NUMBER OF PAGES
IBACK:	JRST	BACK.1		;JUMP INTO MIDDLE OF ROUTINE



BFINPR:	TELL	OPR,WHATB7	;BACKSPACE OR FORWARD IN PRGRESS
	POPJ	P,		;RETURN
IFN FTUUOS,<

;HERE IS ACTUAL "FAST BACKSPACE" CODE

BSPCF:	MOVN	T1,N		;GET NEGATIVE ARGUMENT
	ADD	T1,J$RNPP(J)	;GET DESTINATION PAGE
	CAIG	T1,1		;ARE WE JUST DOING A REWIND?
	JRST	BACKS1		;YES, USE REGULAR CODE
	IDIVI	T1,TABSIZ	;DIVIDE BY SIZE OF TABLE
	MOVE	T1,T2		;SAVE THE INDEX IN T1
	ADD	T2,J		;POINT INTO JOB-INFO PAGE
	SKIPN	T2,J$XPTB(T2)	;GET THE TABLE ENTRY
	JRST	BACKS1		;ITS ZERO!! USE OLD CODE
	MOVEI	T3,DSK		;DSK CHANNEL
	WAIT	T3,		;AND WAIT FOR IO TO COMPLETE

	PUSHJ	P,REWIND	;REWIND THE FILE
	USETI	DSK,(T2)	;SET THE BLOCK
	HRRZM	T2,J$DINF(J)	;SAVE FOR NEXT TIME
	HLRZM	T2,J$XSBC(J)	;AND STORE THE BYTE COUNT
	SOS	J$DINF(J)	;SAVE DECREMENTED.
	MOVNS	N		;GET -VE PAGES
	ADDM	N,J$RNPP(J)	;SET CURRENT PAGE
	MOVNS	N		;RE-NEGATE
	ADDM	N,J$RLIM(J)	;HOW MANY TO SKIP

BSPCF3:	ADDI	T1,1		;POINT TO NEXT INVALID PAGE
	IDIVI	T1,TABSIZ	;GET IT MODULO TABSIZ
	ADD	T2,J		;POINT INTO JOB INFO PAGE
	CLEARM	J$XPTB(T2)	;CLEAR IT
	MOVE	T1,T2		;RESTORE THE INDEX
	SUB	T1,J		;SUBTRACT OUT THE ADR OF J-I PAGE
	SOJG	N,BSPCF3	;AND LOOP FOR ALL SKIPPED PAGES
	POPJ	P,		;AND RETURN




;ROUTINE TO CLEAR OUT THE PAGE-LOCATION TABLE
CLRTAB:	HRRI	T4,J$XPTB(J)	;GET ADR OF FIRST WORD
	HRL	T4,T4		;XWD ADR,ADR
	CLEARM	(T4)		;CLEAR THE FIRST WORD
	ADDI	T4,1		;MAKE XED ADR,ADR+1
	MOVEI	T3,J$XPTB(J)	;GET ADDRESS OF BLOCK
	BLT	T4,TABSIZ-1(T3)	;BLT THE BLOCK
	POPJ	P,		;AND RETURN

>  ;END IFN FTUUOS
SUBTTL	Operator Commands  --  FORWARD

;SUBROUTINE TO SPACE FORWARD N PAGES
;CALLED FROM COMIN:
;	PUSHJ	P,FORWAR
;	RETURN WITH SOME LOCATIONS FIXED
;

FORWAR:	PUSHJ	P,DECARG		;GET THE ARGUMENT
	  POPJ	P,			;ILLEGAL OR ZERO
	STAMP	LPOPR			;STAMP THE LOG
	TELL	LOG,%%FSF		;PUT MESSAGE IN THE LOG
FORWD1:	TXOE	S,NOTYPE		;SET NOTYPE AND SKIP IF IT WASN'T ALREADY
	JRST	FORWD2			;IT WAS, WE'RE MOVING FORWARD ALREADY
	MOVN	T1,N			;GET -VE NUMBER OF PAGES TO SKIP
	ADDM	T1,J$APRT(J)		;AND DECREMENT NUMBER PRINTED BY IT
	ADD	N,J$RNPP(J)		;ADD CURRENT PAGE NUMBER
	MOVEM	N,J$XDPG(J)		;SAVE AS DESTINATION PAGE
	POPJ	P,			;AND RETURN

FORWD2:	ADDM	N,J$XDPG(J)		;JUST PUSH DESTINATION AHEAD
	POPJ	P,			;AND RETURN
SUBTTL	Operator Commands  --  MESSAGE

MESSGE:	SETZ	AP,			;CLEAR ARGUMENT COUNTER
MESS.0:	SETZM	MSGJOB			;START WITH A CLEAN SLATE
	SETZM	MSGFIL			; DITTO
	SETZM	MSGERR			; DITTO AGAIN

MESS.1:	PUSHJ	P,SIXIN			;GET A WORD
	  JRST	MESS.4			;NO MORE, CHECK FOR NULL ARG AND RET
	LDB	T2,[POINT 6,T1,5]	;GET THE FIRST CHARACTER
	CAIN	T2,'A'			;IS IT 'ALL'?
	JRST	MESS.5			;YES, HANDLE SPECICAL CASE
	MOVSI	T4,-MSGTLN		;MAKE AN AOBJN POINTER TO TABLE

MESS.2:	HLRZ	T3,MSGTBL(T4)		;GET AN ENTRY
	CAMN	T2,T3			;IS IT A MATCH?
	JRST	MESS.3			;YES, GO DO SOMETHING
	AOBJN	T4,MESS.2		;NO, LOOP
	TELL	OPR,%%ICAS		;NO MATCH, ERROR
	JRST	MESS.4			;BUT CONTINUE ANYWAY

MESS.3:	AOJ	AP,			;FLAG THAT WE GOT AN ARGUMENT
	HRRZ	T3,MSGTBL(T4)		;GET WORD TO SET
	SETZ	T1,			;DUMMY FOR 'NONE'
	SETOM	(T3)			;SET IT
	JUMPN	T1,MESS.0		;JUMP IF 'NONE'
MESS.4:	CAIN	C,","			;IS THERE MORE?
	JRST	MESS.1			;YES, LOOP
	SKIPN	AP			;DID WE GET AN ARGUMENT?
	SETOM	MSGERR			;NO, SET DEFAULT
	POPJ	P,			;NO, RETURN

MESS.5:	SETOM	MSGFIL			;SET JOB
	SETOM	MSGJOB			;SET FILE
	SETOM	MSGERR			;SET ERROR
	JRST	MESS.4			;AND CONTINUE


MSGTBL:	XWD	'J',MSGJOB
	XWD	'F',MSGFIL
	XWD	'E',MSGERR
	XWD	'N',T1		;DUMMY FOR 'NONE'

	MSGTLN==.-MSGTBL
SUBTTL	Operator Commands  -- (NO)SUPPRESS

;SUBROUTINE TO IMPLEMENT THE SUPPRESS COMMAND
;CALL WITH:
;	PUSHJ	P,SUPPRE
;	RETURN HERE
;
SUPPRE:	OFF	S,SUPJOB!SUPRES		;START CLEAN
	PUSHJ	P,SIXIN			;GET ARGUMENT
	  MOVSI	T1,'FIL'		;GET DEFAULT ARGUMENT
	LDB	T2,[POINT 6,T1,5]	;GET THE FIRST CHARACTER
	CAIN	T2,'F'			;"FILE"
	ON	S,SUPRES		;YES, LIGHT THE BIT
	CAIN	T2,'J'			;"JOB"
	ON	S,SUPJOB		;YES, SET THE BIT
	TXNN	S,SUPJOB!SUPRES		;DID WE LIGHT ONE?
	TELL	OPR,%%ICAS		;NO, GIVE AN ERROR
	POPJ	P,			;YES, RETURN


;ROUTINE TO IMPLEMENT THE NOSUPPRESS COMMAND
;CALL WITH
;	PUSHJ P,NOSUPR
;	RETURN HERE ALWAYS
;
NOSUPR:	OFF	S,SUPJOB!SUPRES	;TURN OFF LOCAL AND GLOBAL FLAGS
	POPJ	P,		;AND RETURN
SUBTTL	LOWSEG Operator Commands  --  RESET - CHECKPOINT


	LOWSEG

;SUBROUTINE TO DO A RESET
;CALL WITH:
;	PUSHJ	P,RESETC
;	NEVER RETURNS
;ALL AC'S REFRESHED
RESETC:	SETOM	RSTFLG			;SET THE RESET FLAG
	TXNE	S,BUSY			;ARE WE BUSY?
	POPJ	P,			;YES, MAKE IT PEND

DOREST:	PUSHJ	P,GETSPL		;GET THE HISEG
	PUSHJ	P,SETHEL		;SETUP HELLO BLOCK
	MOVX	T1,HELSTC!HELBYE	;GOODBYE+STATUS CHANGE
	IORM	T1,MSGBLK+HEL.ST	;STORE FLAGS
	MOVEI	T1,MSGBLK		;LOAD ADR OF BLOCK
	PUSHJ	P,SNDQSR##		;SEND IT
	TELL	OPR,%%LIR		;LPTSPL IS RESET
	JRST	LPTSPL


;SUBROUTINE TO TAKE A CHECKPOINT

TAKCHK:	SKIPN	J$LHNG(J)		;RETURN IF DEVICE IS OFF-LINE
	TXNE	S,ABORT			;ARE WE ABORTED?
	POPJ	P,			;YES, DON'T CHECKPOINT
	PUSHJ	P,SETCHP		;SETUP THE CHECKPOINT BLOCK
	PUSHJ	P,CLSLOG		;AND CLOSE THE LOG
	MOVX	T1,<CHE.SZ,,.QOCHE>	;LOAD THE MESSAGE HEADER
	MOVEM	T1,MSGBLK		;STORE IT
	MOVEI	T1,MSGBLK		;LOAD THE BLOCK ADDRESS
	PJRST	SNDQSR##		;AND SEND IT


SETCHP:	STAMP	LPMSG			;GIVE A STAMP
	MOVEI	T2,MSGBLK		;LOAD ADDRESS OF MSG BLOCK
	MOVE	N,J$RNFP(J)		;GET NUMBER OF FILES
	MOVEM	N,CHE.IN+CKFIL(T2)	;STORE IT
	MOVE	N,J$RNCP(J)		;GET NUMBER OF COPIES
	MOVEM	N,CHE.IN+CKCOP(T2)	;AND STORE IT
	AOS	N			;INCREMENT IT
	TELL	LOG,%%CPT		;AND TYPE FIRST PART OF MESSAGE
	MOVE	N,J$RNPP(J)		;GET NUMBER OF PAGES
	MOVEM	N,CHE.IN+CKPAG(T2)	;AND STORE IT
	TELL	LOG,%%CPT1		;AND SECOND PART OF MESSAGE
	MOVE	N,J$APRT(J)		;NUMBER OF PAGES PRINTED
	MOVEM	N,CHE.IN+CKTPP(T2)	 ;AND STORE IT
	LOAD	N,.EQITN(J)		;GET JOBS ITN
	MOVEM	N,MSGBLK+CHE.IT		;AND STORE IT
	MOVX	N,CKFCHK		;CHKPOINT FLAG
	MOVEM	N,CHE.IN+CKFLG(T2)	;STORE IT
	POPJ	P,			;AND RETURN
SUBTTL	TTY I/O Routines

	TOPSEG
;SUBROUTINE TO FIND A DELIMITER (ANY OF :,=)
;CALL WITH:
;	PUSHJ	P,FNDELM
;	  CAN'T FIND A DELIMITER
;	RETURN HERE WITH DELIMITER IN C
;
FNDELM:	PUSHJ	P,GETCHR	;GET A CHAR
	CAIN	C,12		;LINE FEED?
	POPJ	P,		;YES. NO DELIMITER
	CAIE	C,":"		;COLON?
	CAIN	C,"="		; OR EQUALS
	JRST	.POPJ1##		;YES. WE HAVE A DELIMITER
	JRST	FNDELM		;NO KEEP LOOKING

;SUBROUTINE TO INSERT THE FIRST CHAR AFTER A / IN C
;CALL WITH
;	PUSHJ	P,DOSW
;	  RETURN HERE IF NO SWITCHES
;	RETURN HERE WITH C SET UP
;
DOSW:	CAIE	C,"/"		;GOT A SLASH?
DOSW.1:	PUSHJ	P,GETCHR	;NO, GET A CHARACTER
	TXNE	S,TTYBRK	;HIT EOL?
	POPJ	P,		;YES, RETURN
	CAIE	C,"/"		;DO WE HAVE A SLASH?
	JRST	DOSW.1		;NO, LOOP
	PJRST	GETCHR		;YES, GET THE NEXT CHRACTER AND RETURN
;SUBROUTINE TO INPUT A DECMAL NUMBER
;CALL WITH:
;	PUSHJ	P,DECARG
;	  INVALID DATA
;	RETURN HERE WITH NUMBER IN N
;MUST RESPECT T2
DECARG:	SETZ	N,		;CLEAR RESULT
	PUSHJ	P,SPACES	;FLUSH SPACES
	SKIPA			;AND SKIP INTO LOOP
DECAR1:	PUSHJ	P,GETCHR	;GET A CHAR
	CAIG	C,71		;IS THIS CHAR A DIGIT
	CAIGE	C,60		; ..
	JRST	ACH		;NO. MUST BE END OF NUMBER
	IMULI	N,12		;ADJUST N FOR NEXT DECADE
	ADDI	N,-60(C)	;NIFTY INSTRUCTION, TO INCR. N
	JRST	DECAR1		;GET NEXT DIGIT
ACH:	CAIE	C," "		;BLANKS TABS
	CAIN	C,12		; AND LINE FEEDS ARE VALID AFTER NUMBER
	AOS	(P)		;GOOD DELIMITER IN C
	POPJ	P,		;INVALID DELIMITER
;SUBROUTINE TO INPUT A SIXBIT WORD (A-Z AND 0-9 ONLY VALID CHARS.)
;CALL WITH:
;	PUSHJ	P,SIXIN
;	  RETURN HERE IF NOTHING FOUND
;	RETURN HERE WITH WORD IN T1
;
SIXIN:	SETZ	T1,		;CLEAR RESULT
	MOVE	T2,[POINT 6,T1];SET UP A BYTE POINTER
	PUSHJ	P,SPACES	;SKIP SPACES
	SKIPA			;AND GET INTO LOOP WITH 1ST CHAR
SIXLPI:	PUSHJ	P,GETCHR	;GET A CHAR
	TXNE	S,TTYBRK	;GOT A BREAK CHAR?
	JRST	CKT1		;YES. CHECK RESULT
	CAIL	C,"0"		;STANDARD CHECK
	CAILE	C,"Z"		; FOR ALPHABETIC
	JRST	CKT1		; OR NUMERIC DATA
	CAILE	C,"9"		; ANYTHING THAT FAILS
	CAIL	C,"A"		; IS CONSIDERED A TERMINAL
	JRST	.+2
	JRST	CKT1		; CHARACTOR
	SUBI	C,40		;CONVERT TO SIXBIT
	TLNE	T2,770000	;MORE THAN 6 CHARS?
	IDPB	C,T2		;STORE
	JRST	SIXLPI		;LOOP GO MORE
CKT1:	JUMPN	T1,.POPJ1##	;DID WE FIND A CHAR
	POPJ	P,		;NO. PUNT
;SUBROUTINE TO INPUT ONE CHAR HANDLING SYNTAX
;CALL WITH:
;	PUSHJ	P,GETCHR
;	RESULT IN C

GETCHR:	PUSHJ	P,TTYIN			;GET A CHARACTER
	CAIL	C,"A"+40		;CHECK TO SEE IF IT IS
	CAILE	C,"Z"+40		; A LOWER CASE CHARACTER
	SKIPA				;IT'S NOT
	SUBI	C,40			;IT IS, MAKE IT UPPER CASE
	CAIE	C,.CHCRT		;CARRAGE RETURN
	CAIN	C,177			;RUBOUT
	JRST	GETCHR			;GET A NEW CHAR
	CAIN	C,11			;TAB?
	MOVEI	C,40			;YES. SAME AS BLANK
	CAIE	C,";"			;COMMENT
	CAIN	C,"!"			; "  "
	SKIPA				;YES, SKIP
	POPJ	P,			;NO, RETURN

EAT:	PUSHJ	P,TTYIN			;GET A CHARACTER
	TXNN	S,TTYBRK		;GET A BREAK YET?
	JRST	EAT			;NO, LOOP
IFN FTJSYS,<
	PUSHJ	P,TTYSTA		;START THE TTY PROCESS GOING
>  ;END IFN FTJSYS
	POPJ	P,			;YES, RETURN

SPACES:	PUSHJ	P,GETCHR		;SKIP A CHARACTER
	CAIN	C," "			;IS IT A SPACE?
	JRST	SPACES			;NO, LOOP
	POPJ	P,			;AND RETURN
SUBTTL	SETNL  --  Setup to read a new line from TTY

IFN FTUUOS,<
SETNL:	OFF	S,TTYBRK		;CLEAR THE BREAK FLAG
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
SETNL:	OFF	S,TTYBRK		;CLEAR THE BREAK FLAG
	MOVE	S1,[POINT 7,TTYBUF]	;POINT TO THE BUFFER
	MOVEM	S1,TTYPTR		;SAVE THE POINTER
	SKIPE	TTYFLG			;IS THERE ANYTHING?
	POPJ	P,			;YES, RETURN
	PUSHJ	P,TTYSTA		;NO, START IT
	MOVEI	S1,^D60			;LOAD A MINUTE
	PUSHJ	P,SUSPND		;GO SLEEP
	JRST	SETNL			;AND LOOP
>  ;END IFN FTJSYS
SUBTTL	TTYIN  --  Read a character from the TTY

;TTYIN ROUTINE TO GET A CHARACTER FROM THE OPERATOR'S CONSOLE
;	RETURNS CHARACTER IN C

	IFN FTUUOS,<OPDEF  GTCHR.  [INCHWL C]>
	IFN FTJSYS,<OPDEF  GTCHR.  [ILDB C,TTYPTR]>

TTYIN:	TXNN	S,TTYBRK		;GOT A BREAK?
	JRST	TTYI.1			;NO, CONTINUE
	MOVEI	C,.CHLFD		;YES, LOAD A LF
	POPJ	P,			;AND RETURN

TTYI.1:	GTCHR.				;GET A CHARACTER
	CAIE	C,.CHCNZ		;IS IT A CONTROL-Z OR A
	CAIN	C,.CHCNC		; CONTROL-C?
	JRST	DOEXIT			;YES, GO EXIT
	CAIE	C,.CHESC		;IS IT AN ESCAPE?
	CAIN	C,.CHLFD		; OR A LINEFEED?
	ON	S,TTYBRK		;YES, SET FLAG
	POPJ	P,			;RETURN
SUBTTL	TTYOUT  --  Type out a character on the TTY

;TTYOUT ROUTINE TO TYPE A CHARACTER ON THE OPERATOR'S CONSOLE
;	CALL WITH CHARACTER IN AC C

IFN FTUUOS,<
TTYOUT:	OUTCHR	C			;TYPE IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
TTYOUT:	EXCH	C,S1			;GET CHARACTER IN S1
	PBOUT				;OUTPUT IT
	EXCH	C,S1			;EXCHANGE BACK
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	LUUO Handler

;HERE FROM LOCATOIN 40 ON THE TELL AND TELLN AND STAMP UUO.

	LOWSEG
UUOL:	MOVEM	N,SAVN#			;SAVE N
	MOVEM	T1,SAVT1#		;SAVE T1
	PUSHJ	P,SAVALL		;SAVE THE AC'S
	PUSHJ	P,GETSPL		;GET THE SPOOLER
	PJRST	UUOH			;PROCESS THE UUO

	TOPSEG

UUOH:	OFF	S,TNOACT		;CLEAR SOME BITS
	MOVE	P1,.JBUUO##		;PICK UP THE UUO
	TXNE	P1,STAMP		;IS IT A STAMP UUO?
	JRST	STPLOG			;YES, DO IT
	TXNE	P1,TELLN		;IS IT A TELLN UUO?
	ON	S,TNOACT		;YES, DON'T ALLOW ACTION CHARACTERS
	HRLI	P1,440700		;CONVERT TO BYTE POINTER
	LDB	T1,PAC			;PICK UP THE AC BITS
	DPB	T1,PS			;SAV3 IN STATUS REG.
	TXNE	S,TELUSR		;IF THIS IS FOR THE USER
	OFF	S,FFSEEN		; THEN WE ARE NOT AT TOP OF FORM
TLOOP:	ILDB	C,P1			;GET A CHAR
TLOOP0:	JUMPE	C,UUORST		;JUMP IF NULL
	CAIE	C,"!"			;THE ESCAPE CHAR?
	JRST	TLOOP1			;NO, CONTINUE
	ILDB	C,P1			;YES, GET NEXT CHAR
	JUMPE	C,UUORST		;FINISH UP IF NULL
	PUSHJ	P,SEND			;ELSE, SEND IT
	JRST	TLOOP			;AND LOOP
TLOOP1:	TXNN	S,TNOACT		;ACTION ALLOWED?
	PUSHJ	P,DOACT			;YES. IS THIS ACTIVE
	SKIPE	C			;C=0 IF IT WAS AN ACTION CHAR
	PUSHJ	P,SEND			;NO. JUST PRINT
	JRST	TLOOP			;DO NEXT CHAR
UUORST:	OFF	S,TNOACT		;CLEAR A BIT
	POPJ	P,			;RETURN
;SUBROUTINE TO PROCESS ACTION CHARS
;CALL WITH:
;	MOVE	C,CHAR-TO-CHECK
;	PUSHJ	P,DOACT
;	ACTION TAKEN IF (C) = 0
;ALL ACS PRESERVEVED UNLESS ACTION SAYS OTHERWISE
DOACT:	PUSHJ	P,DOACT1	;GO DO THE CHECKS
	SETZ	C,		;HERE IF IT WAS AN ACTION CHARACTER
	POPJ	P,		;HERE IF IT WASN'T AN ACTION CHAR

DOACT1:	ACTCHR	<^>,A5		;PRINT FILE NAME
	ACTCHR	<]>,PRUSER	;PRINT USER IDENTIFICATION
	ACTCHR	<+>,A9		;PRINT T1 AS SIXBIT
	ACTCHR	<#>,A10		;PRINT N AS DECMAL NUMBER
	ACTCHR	<@>,PRDTC	;PRINT CURRENT DATE AND TIME
	ACTCHR	<&>,A13		;PRINT N AS OCTAL
	ACTCHR	<$>,PRDEV	;PRINT CURRENT PROCESSING DEVICE
	PJRST	.POPJ1##	;SKIP RETURN - NOTHING DONE


;SUBROUTINE TO PRINT A SIXBIT VALUE PASSED TO MESSAGE HANDLER
;CALL WITH:
;	PUSHJ	P,A9
;	RETURN	HERE
;
A9:	MOVE	T1,SAVT1	;PICK UP WORD
	PJRST	SIXOUT		;PRINT IT


;SUBROUTINE TO PRINT N AS DECMAL
A10:	MOVE	T1,SAVN		;GET ARGUMENT
	PJRST	DECOUT		;PRINT AND RETURN



;SUBROUTINE TO PRINT N IN OCTAL
A13:	MOVE	T1,SAVN
	PJRST	OCTOUT
;SUBROUTINE TO PRINT A FILE NAME
;CALL WITH:
;	PUSHJ	P,A5
;	  ALWAYS RETURN HERE


IFN FTUUOS,<
A5:	MOVE	T1,J$DFLP+.FODEV(J)	;GET STR NAME
	JUMPE	T1,A5A			;DON'T PRINT ":" ON NULL DEVICE
	PUSHJ	P,SIXOUT		;PRINT IT
	MOVEI	C,":"			;DELIMIT WITH A
	PUSHJ	P,SEND			; DOUBLE DECKER PERIOD
A5A:	MOVE	T1,J$DUUO+.RBNAM(J)	;PICK UP FILE NAME
	PUSHJ	P,SIXOUT		;AND PRINT IT
	HLLZ	T1,J$DUUO+.RBEXT(J)	;GET EXTENSION
	JUMPE	T1,A5.1			;GO AWAY IF NULL
	MOVEI	C,"."			;PRINT A DOT
	PUSHJ	P,SEND			; ..
	PUSHJ	P,SIXOUT		;AND PRINT EXT
A5.1:	MOVEI	C,74			;LOAD OPEN WIDGET
	PUSHJ	P,SEND			;SEND IT
	LDB	T1,[POINT 9,J$DUUO+.RBPRV(J),8]
	MOVEI	C,"0"			;READY TO PAD
	CAIL	T1,100			;LESS THAN 3 DIGITS?
	JRST	A5.2			;NO, TYPE IT
	PUSHJ	P,SEND			;YES, PAD IT
	CAIL	T1,10			;LESS THAN TWO DIGITS?
	JRST	A5.2			;NO, TYPE IT
	PUSHJ	P,SEND			;YES, MORE PADDING
A5.2:	PUSHJ	P,OCTOUT		;TYPE IT NOW
	MOVEI	C,76			;LOAD A CLOSE WIDGET
	PUSHJ	P,SEND			;SEND IT
	MOVEI	T1,J$DPAT(J)		;GET ADDRESS OF PATH BLOCK
	PUSHJ	P,TYPUID		;AND TYPE IT
	SKIPN	T1,J$DUUO+.RBSPL(J)	;GET RIBSPL
	POPJ	P,			;NONE, RETURN
	MOVEI	C,"("			;LOAD OPEN PAREN
	PUSHJ	P,SEND			;SEND IT
	PUSHJ	P,SIXOUT		;SEND THE SPOOLED NAME
	MOVEI	C,")"			;LOAD A CLOSE PAREN
	PJRST	SEND			;SEND IT AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
A5:	MOVE	T1,J$DSTG(J)		;GET ADR OF THE STRING
	HRLI	T1,(POINT 7,0)		;MAKE A BYTE POINTER
A5.1:	ILDB	C,T1			;GET A BYTE
	JUMPE	C,.POPJ##		;RETURN WHEN DONE
	PUSHJ	P,SEND			;ELSE, SEND IT
	JRST	A5.1			;AND LOOP
>  ;END IFN FTJSYS
;SUBROUTINE TO TYPE A USER ID SPECIFICATION
;
;CALL:
;	MOVE T1,[DIRECTORY SPEC] (T10=PPN-PATH, T20=DIRECT #)
;	PUSHJ P,TYPUID
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
TYPUID:	PUSHJ	P,.SAVE2##		;SAVE P1 & P2
	MOVE	P1,T1			;AND SAVE THE ARG
	TLNN	T1,-1			;IS IT A PATH?
	MOVE	T1,2(T1)		;YES, GET THE PPN
	PUSHJ	P,TYPPPN		;AND TYPE THE PPN
	TLNE	P1,-1			;DID HE SUPPLY A PATH?
	JRST	TYPU.2			;NO, FINISH OFF AND RETURN
	MOVEI	P1,3(P1)		;POINT TO FIRST SFD

TYPU.1:	SKIPN	T1,(P1)			;GET NEXT SFD
	JRST	TYPU.2			;DONE
	MOVEI	C,","			;GET A COMMA
	PUSHJ	P,SEND			;SEND IT
	PUSHJ	P,SIXOUT		;SEND THE SFD NAME
	AOJA	P1,TYPU.1		;AND LOOP

TYPU.2:	MOVEI	C,"]"			;LOAD THE CLOSER
	PJRST	SEND			;AND SEND IT

TYPPPN:	MOVEI	C,"["			;LOAD THE OPENER
	PUSHJ	P,SEND			;SEND IT
	MOVE	P2,T1			;AND COPY THE PPN
	HLRZS	T1			;GET THE PROJECT NUMBER
	PUSHJ	P,OCTOUT		;TYPE IT
	MOVEI	C,","			;LOAD A COMMA
	PUSHJ	P,SEND			;SEND IT
	HRRZ	T1,P2			;GET PROGRAMMER NUMBER
	PJRST	OCTOUT			;SEND IT AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
TYPUID:	MOVE	S2,T1			;GET USER NUMBER IN S2
	HRROI	S1,J$XSFO(J)		;AND POINT TO THE BLOCK
	DIRST				;MAKE A STRING
	  JFCL				;AND IGNORE THE FAIL
	MOVE	T1,[POINT 7,J$XSFO(J)]	;POINT TO THE BLOCK

TYPU.1:	ILDB	C,T1			;GET A CHARACTER
	JUMPE	C,.POPJ##		;RETURN IF DONE
	PUSHJ	P,SEND			;ELSE SEND IT
	JRST	TYPU.1			;AND LOOP
>  ;END IF FTJSYS
;SUBROUTINE TO PRINT A NUMBER IN ANY RADIX
;CALL WITH:
;	MOVE	T1,NUMBER-TO-PRINT
;	PUSHJ	P,OCTOUT
;
;	-OR-
;
;	MOVE	T1,NUMBER-TO-PRINT
;	PUSHJ	P,DECOUT
;
;	-OR-
;
;	MOVEI	T4,RADIX
;	MOVE	T1,NUMBER-TO-PRINT
;	PUSHJ	P,ANYRDX
;
;
DECOUT:	MOVEI	T4,^D10		;BASE TEN
ANYRDX:	JUMPGE	T1,RDXOUT	;JUMP IF POSITIVE
	MOVEI	C,"-"		;LOAD A MINUS
	PUSHJ	P,SEND		;PRINT IT
	MOVM	T1,T1		;MAKE POSITIVE
RDXOUT:	IDIVI	T1,(T4)		;FIND THE REMAINDER
	HRLM	T2,(P)		;PUSH ONTO STACK
	SKIPE	T1		;FINISHED?
	PUSHJ	P,RDXOUT	;NO. RECUR
	HLRZ	C,(P)		;YES. POP OFF A DIGIT
	ADDI	C,60		;CONVERT TO ASCII
	PJRST	SEND		;PRINT THE DIGIT



OCTOUT:	LSHC	T1,-3		;SHIFT OUT THREE BITS
	HLLM	T2,(P)		;STACK IT
	SKIPE	T1		;SKIP IF DONE
	PUSHJ	P,OCTOUT	;ELSE RECURSE
	HLRZ	C,(P)		;GET A DIGIT
	LSH	C,-^D15		;RIGHT JUSTIFY IT
	ADDI	C,60		;MAKE IT ASCII
	PJRST	SEND		;AND PRINT IT
;SUBROUTINE TO PRINT AC AS SIXBIT
;CALL WITH:
;	MOVE	T1,WORD-TO-PRINT
;	PUSHJ	P,SIXOUT
;	RETURN IS ALWAYS HERE

SIXOUT:	MOVE	T2,T1		;COPY OVER THE ARG
SIXO.1:	SETZ	T1,		;ZERO OUT T1
	JUMPE	T2,.POPJ##	;ANYTHING LEFT?
	LSHC	T1,6		;SHIFT IN ANOTHER CHAR
	MOVEI	C,40(T1)	;PUTCHAR IN C
	PUSHJ	P,SEND
	JRST	SIXO.1		;LOOP FOR MORE
SUBTTL	PRUSER  -  Print out user identification

;PRUSER PRINTS OUT THE CURRENT USER'S IDENTIFICATION WHICH CONSISTS
;	OF USER NAME AND PPN ON TOPS10 AND USER DIRECTORY NAME ON
;	TOPS20
;
;CALL:
;	PUSHJ P,PRUSER
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
PRUSER:	MOVE	T1,.EQUSR(J)		;GET 1ST HALF OF NAME
	PUSHJ	P,SIXOUT		;SEND IT
	MOVEI	C," "			;LOAD A BLANK
	MOVE	T1,.EQUSR(J)		;AND GET FIRST HALF BACK
	TRNN	T1,77			;WAS LAST CHAR A BLANK?
	PUSHJ	P,SEND			;YES, SEND ONE BLANK
	MOVE	T1,.EQUSR+1(J)		;GET 2ND HALF
	PUSHJ	P,SIXOUT		;TYPE IT
	MOVEI	C," "			;LOAD A BLANK
	PUSHJ	P,SEND			;SEND IT
	MOVE	T1,.EQOWN(J)		;GET PPN
	PJRST	TYPUID			;AND TYPE IT
>  ;END IFN FTUUOS

IFN FTJSYS,<
PRUSER:	MOVEI	T1,.EQOWN(J)		;POINT TO USER NAME
	HRLI	T1,(POINT 7,0)		;MAKE A BYTE POINTER
PRUS.1:	ILDB	C,T1			;LOAD A CHACTER
	JUMPE	C,.POPJ##		;DONE, RETURN
	PUSHJ	P,SEND			;SEND IT
	JRST	PRUS.1			;AND LOOP
>  ;END IFN FTJSYS
SUBTTL	PRDEV - Print out current processing device

PRDEV:	MOVE	T1,J$LDEV(J)	;GET THE DEVICE
	PJRST	SIXOUT		;AND PRINT IT
SUBTTL	PRDTC - Print current date and time

;CALL WITH:
;	PUSHJ 	P,PRDTC
;	  RETURN HERE ALWAYS

PRDTC:	PUSHJ	P,PRDATE	;PRINT THE DATE
	MOVEI	C," "		;LOAD A BLANK
	PUSHJ	P,SEND		;SEND IT
	PJRST	PRTIME		;SEND THE TIME AND RETURN



SUBTTL	PRDTA - Print an arbitrary date and time

;CALL WITH:
;	MOVE T1,[DATE,,TIME]
;	PUSHJ P,PRDTA
;	  RETURN HERE ALWAYS

PRDTA:	PUSHJ	P,.SAVE1##	;SAVE P1
	PUSH	P,T1		;SAVE T1 FOR A WHILE
IFN FTJSYS,<
	MOVE	P1,T1		;GET THE DATE
>  ;END IFN FTJSYS

IFN FTUUOS,<
	HLRZ	P1,T1		;GET THE DATE
	MOVX	T1,%CNDTM	;GETTAB TO DATE-TIME
	GETTAB	T1,		;GET IT
	  HALT
	HLRZS	T1		;GET DATE
	SUB	T1,P1		;GET THE DIFFERENCE
	DATE	P1,		;GET TODAY'S DATE
	SUB	P1,T1		;SUBTRACT THE DIFFERENCE
>  ;END IFN FTUUOS
	PUSHJ	P,PRDAT1	;PRINT THE DATE
	MOVEI	C," "		;LOAD A BLANK
	PUSHJ	P,SEND		;SEND IT
	POP	P,P1		;GET THE TIME BACK
	PJRST	PRTIM1		;AND PRINT THE TIME
SUBTTL	PRDATE - Print the date

;CALL WITH:
;	PUSHJ	P,PRDATE
;	RETURN HERE

IFN FTUUOS,<
PRDATE:	PUSHJ	P,.SAVE3##	;SAVE 3 AC'S
	DATE	P1,		;GET THE DATE
	JRST	.+2		;SKIP THE SAVE
PRDAT1:	PUSHJ	P,.SAVE4##	;SAVE THE PRESERVED AC'S
	IDIVI	P1,^D31		;GET THE DAY
	MOVEI	T1,1(P2)		;ADD AND MOVE
	PUSHJ	P,TWODIG	;PRINT THE DAY
	IDIVI	P1,^D12		;GET THE MONTH
	MOVE	T1,P2		;GET MON-1 IN T1
	MOVE	P2,[POINT 7,MNTAB(T1)] ;LOAD A BYTE POINTER
	MOVEI	P3,5		;CHAR COUNT
	ILDB	C,P2		;LOAD A CHAR
	PUSHJ	P,SEND		;SHIP IT
	SOJG	P3,.-2		;LOOP OVER WORD
	MOVEI	T1,^D64(P1)	;ADD YEAR ZERO
	PJRST	DECOUT		;AND PRINT IT AND RETURN

MNTAB:	ASCII	/-Jan-/
	ASCII	/-Feb-/
	ASCII	/-Mar-/
	ASCII	/-Apr-/		;OR IS IT CPU
	ASCII	/-May-/	
	ASCII	/-Jun-/	
	ASCII	/-Jul-/
	ASCII	/-Aug-/
	ASCII	/-Sep-/
	ASCII	/-Oct-/
	ASCII	/-Nov-/
	ASCII	/-Dec-/
>  ;END IFN FTUUOS

IFN FTJSYS,<
PRDATE:	PUSHJ	P,.SAVE1##	;SAVE P1
	SETO	P1,		;AND SET TO -1
PRDAT1:	PUSHJ	P,.SAVET##	;SAVE T1-T4
	MOVE	S2,P1		;GET DATE TO PRINT
	HRROI	S1,J$XSFO(J)	;GET PTR TO BLOCK
	MOVX	T1,1B9		;DONT PRINT THE TIME
	ODTIM			;AND DO IT!!
	MOVE	T1,[POINT 7,J$XSFO(J)]

PRDA.2:	ILDB	C,T1		;GET A CHARACTER
	JUMPE	C,.POPJ##	;RETURN WHEN DONE
	PUSHJ	P,SEND		;SEND IT
	JRST	PRDA.2		;AND LOOP
>  ;END IFN FTJSYS
SUBTTL	PRTIME - Print the time

;CALL WITH:
;	PUSHJ	P,PRTIME
;	RETURN HERE

IFN FTUUOS,<
PRTIME:	PUSHJ	P,.SAVE2##	;GET SOME SCRATCH AC'S
	MOVX	P1,%CNDTM	;GET UNIVERSAL DATE-TIME
	GETTAB	P1,		;GET IT
	  HALT .
PRTIM1:	HRRZS	P1		;JUST TIME HALF
	MULI	P1,^D86400	;MULIPLY BY SECS/DAY
	ASHC	P1,^D17		;DIVIDE BY 2^18 YIELDING SECONDS
	IDIVI	P1,^D3600	;MAKE HOURS
	PUSHJ	P,PRT2		;PRINT HOURS AS TWO DIGITS
	MOVEI	C,":"		;PRINT A DELIMITER
	PUSHJ	P,SEND		; ..
	MOVE	P1,P2		;GET REMAINDER
	IDIVI	P1,^D60		;DIVIDE OUT THE MINUTES
	PUSHJ	P,PRT2		; ..
	MOVEI	C,":"		; DELIMIMIT THE HOURS
	PUSHJ	P,SEND		; FROM THE SECONDS
	MOVE	P1,P2		;GET THE SECONDS
PRT2:	MOVE	T1,P1		;SETUP FOR DECOUT
;FALL INTO TWODIG

;SUBROUTION TO PRINT AT LEASE 2 DECMAL DIGITS
;CALL WITH:
;	MOVE	T1,NUMBER-T0-PRINT
;	PUSHJ	P,TWODIG
;	RETURN HERE
;
TWODIG:	MOVEI	C,"0"		;ALWAYS PRINT 2 DIGITS
	CAIGE	T1,12		;IF LESS TAN 10
	PUSHJ	P,SEND
	PJRST	DECOUT		;PRINT N AS DECMAL
>  ;END IFN FTUUOS

IFN FTJSYS,<
PRTIM1:	SKIPA	S2,P1		;GET ARBITRARY TIME
PRTIME:	SETO	S2,		;GET CURRENT TIME
	HRROI	S1,J$XSFO(J)	;POINT TO THE BLOCK
	MOVX	T1,1B0		;AND FORMAT FLAGS
	ODTIM			;AND DO THE JSYS
	MOVE	T1,[POINT 7,J$XSFO(J)]

PRTI.1:	ILDB	C,T1		;GET A CHARACTER
	JUMPE	C,.POPJ##	;RETURN WHEN DONE
	PUSHJ	P,SEND		;SEND IT
	JRST	PRTI.1		;AND LOOP
>  ;END IFN FTJSYS
	;SUBROUTINE TO PLACE A CHAR IN ALL THE PROPER BUFFERS
;CALL WITH:
;	PUSHJ	P,SEND (CHAR IN C, FLAGS IN S)
;	RETURN HERE
;ALL AC'S RESPECTED (AT SOME PAIN)
;
SEND:	TXNE	S,TELOPR		;SHOULD WE GIVE TO OPER?
	PUSHJ	P,TTYOUT		;YES, GO AHEAD
SLOG:	TXNE	S,TELLOG		;LOG THIS MESSAGE?
	PUSHJ	P,CHRLOG		;YES, DO IT
SDEV:	TXNN	S,TELUSR		;PRINT DIRECTLY?
	POPJ	P,			;RETURN

	OFF	S,NOTYPE!FFSEEN		;MAKE IT SEEN
	CAIN	C,.CHFFD		;IS IT A FORM FEED?
	ON	S,FFSEEN		;YES, TURN ON A FLAG
	PJRST	DEVOUT			;PRINT THE CHAR AND RETURN
SUBTTL	LOG File Routines

;	FNDLOG	--	FIND THE LOG FILE AND SET IT UP
;	STALOG	--	PUT STARTUP MESSAGES IN USERS LOG FILE
;	STPLOG	--	PUT A TIMESTAMP IN THE LOG FILE
;	CHRLOG	--	PUT A CHARACTER IN THE LOG FILE
;	OPNLOG	--	OPEN THE LOG FOR WRITING
;	CLSLOG	--	CLOSE THE LOG FILE OUT
;	RIDLOG  --	RELEASE THE LOG FILE
;	BUFLOG	--	ALLOCATE A BUFFER PAGE FOR LOG
;	CLNLOG	--	CLEAN-UP LOG BUFFER PAGES


	TOPSEG
SUBTTL	FNDLOG  --  Setup the LOG File

;FNDLOG  --  ROUTINE TO FIND THE LOG FILE SPEC, AND SETUP THE
;	VARIOUS UUO BLOCKS.

FNDLOG:	OFF	S,JOBLOG!LOGOPN		;START WITH NO LOG
	SETZM	J$GNLN(J)		;AND 0 LINES
	SETZM	J$GINP(J)		;AND NO INTERNAL LOG YET
	PUSHJ	P,BUFLOG		;GET A BUFFER PAGE
	SKIPN	T1,J$RLFS(J)		;IS THERE A LOG FILE SPEC
	POPJ	P,			;NO, RETURN


IFN FTJSYS,<
FNDL.2:	ON	S,JOBLOG		;THERE IS A LOG FILE
	LOAD	S2,.FPSIZ(T1),FP.FHD	;GET LENGTH OF FP
	ADD	S2,T1			;ADD IN ADR OF FP
	MOVEM	S2,J$GSTG(J)		;AND SAVE ADDRESS OF NAME
	HRRO	S2,S2			;GET POINTER TO STRING
	MOVX	S1,GJ%SHT!GJ%OLD	;SHORT GTJFN, OLD FILE ONLY
	GTJFN				;FIND IT
	  JRST	FNDL.3			;NOPE!!
	MOVEM	S1,J$GJFN(J)		;GOT IT, SAVE THE JFN
	POPJ	P,			;AND RETURN

FNDL.3:	MOVX	S1,GJ%SHT!GJ%FOU	;SHORT GTJFN, FOR OUTPUT USE
	HRRO	S2,J$GSTG(J)		;GET THE STRING
	GTJFN				;MAKE IT
	  JRST	FNDL.4			;REALLY SHOULDN'T HAPPEN
	MOVEM	S1,J$GJFN(J)		;SAVE THE JFN
	POPJ	P,			;AND RETURN

FNDL.4:	OFF	S,JOBLOG		;MAKE NO LOG FILE
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
IFN FTUUOS,<
FNDL.2:	ON	S,JOBLOG		;THERE IS A LOG FILE
	LOAD	T3,.FPSIZ(T1),FP.FHD	;GET SIZE OF THE FP
	LOAD	T4,.FPSIZ(T1),FP.FFS	;GET SIZE OF FD
	SUBI	T4,FDMSIZ		;SUB THE MIN, YIELDING #SFDS
	ADD	T1,T3			;AND POINT TO THE FD
	MOVEI	T2,.RBPRV		;GET SIZE OF UUO BLOCK
	MOVEM	T2,J$GUUO+.RBCNT(J)	;AND SAVE THE BLOCK SIZE
	LOAD	T2,.FDNAM(T1)		;GET THE FILE NAME
	MOVEM	T2,J$GUUO+.RBNAM(J)	;AND SAVE IT
	LOAD	T2,.FDEXT(T1)		;GET THE EXTENSION
	HLLZM	T2,J$GUUO+.RBEXT(J)	;AND SAVE IT
	MOVSI	T2,J$GPAT(J)		;GET ADDRESS OF PATH BLOCK
	HRRI	T2,J$GPAT+1(J)		;AND MAKE A BLT POINTER
	CLEARM	J$GPAT(J)		;CLEAR THE FIRST WORD
	BLT	T2,J$GPAT+7(J)		;AND ZERO THE BLOCK OUT
	MOVEI	T2,J$GPAT+2(J)		;SETUP TO BLT THE PATH
	HRLI	T2,.FDPPN(T1)		;T2 HAS A BLT POINTER
	ADD	T4,J			;T4 HAD NUMBER OF SFDS
	BLT	T2,J$GPAT+2(T4)		;AND BLT THE PATH
	MOVEI	T2,J$GPAT(J)		;GET ADDRESS OF PATH BLOCK
	SKIPN	J$GPAT+3(J)		;IS THERE AN SFD?
	MOVE	T2,J$GPAT+2(J)		;NO, GET THE PPN
	MOVEM	T2,J$GUUO+.RBPPN(J)	;AND SAVE IN LOOKUP BLOCK

	MOVX	T2,FO.PRV+.FOAPP+<LOGF>B17;APPEND AND USE MY PRIVS ON CHN LOGF
	MOVEM	T2,J$GFLP+.FOFNC(J)	;STORE THE FUNCTION
	MOVEI	T2,.IOASC		;ASCII MODE
	MOVEM	T2,J$GFLP+.FOIOS(J)	;STORE IT
	LOAD	T2,.FDSTR(T1)		;GET THE STRUCTURE
	MOVEM	T2,J$GFLP+.FODEV(J)	;AND STORE IT
	MOVSI	T2,J$GBRH(J)		;OBUF,,0
	MOVEM	T2,J$GFLP+.FOBRH(J)	;SAVE IT
	MOVSI	T2,1			;ONE OUTPUT BUFFER
	MOVEM	T2,J$GFLP+.FONBF(J)	;SAVE IT
	MOVEI	T2,J$GUUO(J)		;ADDRESS OF LOOKUP BLOCK
	MOVEM	T2,J$GFLP+.FOLEB(J)	;STORE IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS
SUBTTL	STALOG  --  Put startup messages in the log

STALOG:	STAMP	LPDAT			;PUT IN A DATE STAMP
	TELL	LOG,%%LSJ		;AND AN INTRO MESSAGE
	STAMP	LPDAT			;ANOTHER STAMP
	MOVE	T1,.EQJOB(J)		;GET JOB NAME
	LOAD	N,.EQSEQ(J),EQ.SEQ	;AND THE SEQUENCE NUMBER
	TELL	LOG,%%SJS		;AND GIVE JOB INFO
	MOVE	T1,.EQAFT(J)		;GET REQUEST CREATED TIME
	PUSHJ	P,PRDTA			;PRINT IT
	MOVEI	C,"]"			;AND A CLOSE BRACKET
	PUSHJ	P,SEND			;SEND IT
	TELL	LOG,CRLF		;SEND A CRLF
	POPJ	P,			;AND RETURN
SUBTTL	CHRLOG  --  Type a character in the log file

;CALL WITH THE CHARACTER TO TYPE IN ACCUMULATOR C.  ASSUMES THAT
;	THE LOG IS OPEN FOR WRITING.

IFN FTUUOS,<
CHRLOG:	TXNN	S,JOBLOG		;IS THERE A LOG FILE?
	JRST	CHRL.2			;NO, USE INTERNAL LOG
	SOSG	J$GBCT(J)		;ANY ROOM IN THE BUFFER?
	PUSHJ	P,CHRL.1		;NO, ADVANCE
	IDPB	C,J$GBPT(J)		;DEPOSIT A BYTE
	POPJ	P,			;AND RETURN

CHRL.1:	OUT	LOGF,			;OUTPUT THE BUFFER
	  POPJ	P,			;AND RETURN
	TELL	OPR!USR,%%EWL		;ERROR WRITING LOG
	OFF	S,JOBLOG		;NO MORE LOG FILE
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
CHRLOG:	TXNN	S,JOBLOG		;IS THERE A LOG?
	JRST	CHRL.2			;NO, USE INTERNAL LOG
	MOVE	S1,J$GJFN(J)		;GET THE JFN
	MOVE	S2,C			;GET THE CHARACTER
	BOUT				;OUTPUT IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS


;HERE TO PLACE A CHARACTER IN THE INTERNAL LOG
CHRL.2:	SOSGE	J$GIBC(J)		;IS THERE ROOM?
	JRST	CHRL.3			;NO, GET ANOTHER PAGE
	IDPB	C,J$GIBP(J)		;YES, DEPOSIT THE CHARACTER
	POPJ	P,			;AND RETURN

CHRL.3:	PUSH	P,C			;SAVE C
	SETZ	C,			;AND CLEAR IT
	IDPB	C,J$GIBP(J)		;TERMINATE WILL A NULL
	PUSHJ	P,BUFLOG		;GET ANOTHER PAGE
	POP	P,C			;RESOTRE C
	JRST	CHRL.2			;AND TRY AGAIN
SUBTTL	STPLOG  --  Timestamp the LOG File

;SUBROUTINE TO PUT A TIME STAMP IN THE LOG
;
;CALLED BY THE STAMP LUUO

STPLOG:	PUSH	P,.JBUUO##	;SAVE THE UUO ON THE STACK
	PUSHJ	P,OPNLOG	;OPEN THE LOG FILE UP
	LDB	P2,PS		;SAVE SOME BITS FROM
	MOVEI	P1,LOG		; THE STATUS AC AND
	DPB	P1,PS		; PUT IN OUR OWN BITS
	PUSHJ	P,PRTIME	;PRINT THE TIME
	HRRZ	T1,0(P)		;GET ADR OF STAMP
	MOVE	T1,(T1)		;GET THE STAMP
	MOVEI	C," "		;PRINT A SPACE
	PUSHJ	P,SEND		;.. 
	PUSHJ	P,SIXOUT	;PRINT THE KEY WORD
	MOVEI	C,11		;PRINT A TAB
	PUSHJ	P,SEND		; ..
	POP	P,0(P)		;CLEAR TOP OF STACK
	AOS	J$GNLN(J)	;ONE MORE LINE
	POPJ	P,0		;AND RETURN


LPMSG:	SIXBIT	/LPMSG/
LPDAT:	SIXBIT	/LPDAT/
LPOPR:	SIXBIT	/LPOPR/
LPERR:	SIXBIT	/LPERR/
LPSUM:	SIXBIT	/LPSUM/
SUBTTL	OPNLOG  --  Open the LOG File

;CALLED TO OPEN THE LOG FILE AND APPEND TO IT

IFN FTUUOS,<
OPNLOG:	TXNE	S,JOBLOG	;IS THERE A LOG FILE?
	TXNE	S,LOGOPN	;YES, IS IT OPEN ALREADY?
	POPJ	P,		;NO LOG, OR ITS OPEN ALREADY - RETURN
	MOVE	S2,J$GBUF(J)	;GET ADDRESS OF LOG BUFFER
	EXCH	S2,.JBFF	;FAKE OUT THE MONITOR
	MOVEI	S1,J$GFLP(J)	;GET ADDRESS OF FILOP BLOCK
	HRLI	S1,6		;AND BLOCK LENGTH
	FILOP.	S1,		;OPEN THE FILE
	  JRST OPNL.1		;CAN'T DO IT?
	MOVEM	S2,.JBFF	;RESTORE JOBFF
	ON	S,LOGOPN	;ITS OPEN
	POPJ	P,		;RETURN

OPNL.1:	MOVEM	S2,.JBFF	;RESTORE JOBFF
	PJRST	RIDLOG		;CLOSE OFF LOG AND GET RID OF IT
>  ;END IFN FTUUOS

IFN FTJSYS,<
OPNLOG:	TXNE	S,JOBLOG	;IS THERE A LOG FILE
	TXNE	S,LOGOPN	;WHICH IS NOT OPEN
	POPJ	P,		;NO
	MOVE	S1,J$GJFN(J)	;GET THE JFN
	MOVX	S2,<7B5+OF%APP>	;7 BIT BYTES, APPEND
	OPENF			;OPEN IT
	  PJRST	RIDLOG		;LOSE, GET RID OF LOG
	ON	S,LOGOPN	;FLAG SUCCESS
	POPJ	P,		;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	CLSLOG  --  Close the LOG File

;ROUTINE TO CLOSE OFF THE LOG FILE, DUMPING ALL BUFFERS ETC.

IFN FTUUOS,<
CLSLOG:	CLOSE	LOGF,		;CLOSE THE CHANNEL
	OFF	S,LOGOPN	;CLEAR THE FLAG
	POPJ	P,		;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
CLSLOG:	TXC	S,JOBLOG!LOGOPN	;COMPLEMENT THESE TWO BITS
	TXCE	S,JOBLOG!LOGOPN	;RE-COMPLEMENT AND TEST
	POPJ	P,		;NOTHING TO CLOSE
	MOVE	S1,J$GJFN(J)	;GET THE LOG'S JFN
	TXO	S1,1B0		;SET "DON'T" RELEASE THE JFN
	CLOSF			;CLOSE THE FILE
	  JFCL			;IGNORE ANY ERRORS
	OFF	S,LOGOPN	;CLEAR THE FLAG
	POPJ	P,		;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	RIDLOG  --  Release the LOG File

;ROUTINE TO RELEASE THE LOG FILE, DUMPING ALL BUFFERS ETC.

IFN FTUUOS,<
RIDLOG:	TXNN	S,JOBLOG		;IS THERE A LOG?
	POPJ	P,			;NO, JUST RETURN
	RELEAS	LOGF,			;RELEASE THE CHANNEL
	OFF	S,LOGOPN!JOBLOG		;CLEAR THE FLAGS
	SETZM	J$GNLN(J)		;CLEAR LINE COUNT
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
RIDLOG:	TXNN	S,JOBLOG		;IS THERE A LOG?
	POPJ	P,			;NOTHING TO CLOSE
	PUSHJ	P,CLSLOG		;MAKE SURE ITS CLOSED
	MOVE	S1,J$GJFN(J)		;GET THE LOG'S JFN
	RLJFN				;RELEASE THE JFN
	  JFCL				;IGNORE ANY ERRORS
	OFF	S,LOGOPN!JOBLOG		;CLEAR THE FLAGS
	SETZM	J$GNLN(J)		;CLEAR THE LINE COUNT
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	BUFLOG  --  Get a buffer page for LOG

BUFLOG:	PUSHJ	P,.SAVE1##		;SAVE P1
	AOS	P1,J$GINP(J)		;INCREMENT BUFFER PAGE COUNT
	CAIL	P1,^D10			;WITHIN RANGE?
	  HALT				;NO, DIE FOR NOW
	PUSHJ	P,M$ACQP##		;GET A PAGE
	PG2ADR	AP			;MAKE AN ADDRESS
	ADDI	P1,-1(J)		;POINT TO LOCATION IN J$GBUF
	MOVEM	AP,J$GBUF(P1)		;STORE THE ADDRESS
	HRLI	AP,(POINT 7,0)		;MAKE A BYTE POINTER
	MOVEM	AP,J$GIBP(J)		;AND STORE IT
	MOVEI	S1,<5*1000>-1		;GET A COUNT
	MOVEM	S1,J$GIBC(J)		;STORE IT
	POPJ	P,			;AND RETURN
SUBTTL	CLNLOG  --  Cleanup the LOG File buffers

CLNLOG:	PUSHJ	P,.SAVE2##		;SAVE P1 AND P2
	MOVE	P1,J$GINP(J)		;GET NUMBER OF PAGES IN P1
	MOVEI	P2,J$GBUF(J)		;GET ADR OF ADR OF 1ST PAGE IN P2

CLNL.1:	JUMPE	P1,.POPJ##		;DONE IF NO MORE PAGES
	MOVE	AP,0(P2)		;GET ADDRESS OF PAGE
	ADR2PG	AP			;MAKE A PAGE NUMBER
	PUSHJ	P,M$RELP##		;RETURN IT
	SOJ	P1,			;DECREMENT PAGE COUNT
	AOJA	P2,CLNL.1		;BUMP POINTER AND LOOP
SUBTTL	Utility Routines

;	SUSPND	--		ROUTINE TO SUSPEND JOB FOR TIME PERIOD
;	SNDSTC	--		SEND A STATUS CHANGE
;	SETHEL	--		SETUP A HELLO BLOCK


	LOWSEG				;THESE ARE IN THE LOWSEG
SUBTTL	SUSPND  --  Suspend job for a given length of time

;CALL WITH THE NUMBER OF SECONDS IN S1

IFN FTUUOS,<
SUSPND:	IMULI	S1,^D1000		;CONVERT TO MILLISECS
	HIBER	S1,			;AND SLEEP
	  HALT
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
SUSPND:	IMULI	S1,^D1000		;CONVERT TO MILLISECS
	SETOM	BLOKED			;WE ARE SLEEPING
	SKIPN	AWOKEN			;INTERRUPTED SINCE LAST INSTRUCTION?
	DISMS				;SLEEP
	JFCL				;**DO NOT REMOVE THIS INSTRUCTION**
SUSP.1:	SETZM	AWOKEN			;WE ARE UP
	SETZM	BLOKED			;INSURE THAT EVERYONE KNOWS IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	Subroutines  --  Send a Status Change

;SNDSTC CALLS SETHEL TO SETUP THE HELLO BLOCK, ORS IN THE STATUS
;	CHANGE FLAG, AND SENDS IT TO QUASAR.

;SNDSTC WILL TURN OFF THE SCHEDULING BIT IF EITHER RUNB IS OFF OR
;	PAUSEB IS ON.

SNDSTC:	TXNN	S,STARTD		;ARE WE STARTED?
	POPJ	P,			;NO, WE ARE NOT KNOWN COMPONENT
	PUSHJ	P,SETHEL		;SET UP THE HELLO BLOCK
	MOVX	T1,HELSTC		;GET THE STATUS CHANGE FLAG
	IORM	T1,MSGBLK+HEL.ST	;STORE IT IN
	MOVX	T1,HELSCH		;LOAD THE BIT
	TXNE	S,RUNB			;IS RUNB OFF?
	TXNE	S,PAUSEB		;NO, IS PAUSEB ON?
	ANDCAM	T1,MSGBLK+HEL.ST	;YES, CLEAR THE BIT
	MOVEI	T1,MSGBLK		;LOAD ADDRESS OF HELLO BLOCK
	PJRST	SNDQSR##		;AND SEND IT OFF
SUBTTL	Subroutines  --  Setup HELLO Block

;SETHEL SETS UP THE ENTIRE HELLO BLOCK EXCEPT FOR THE STATUS WORD.
;	IT CORRECTLY SETS THE HELSCH, HELFRZ, HELLLP BITS IN THE STATUS WORD.

SETHEL:	MOVX	T1,<HEL.SZ,,.QOHEL>	;GET LENGTH,,FUNCTION
	MOVEM	T1,MSGBLK		;SAVE AS FIRST WORD

	MOVX	T1,'LPTSPL'		;GET PROGRAM NAME
	MOVEM	T1,MSGBLK+HEL.NM	;SAVE IT

	MOVE	T1,J$LSDV(J)		;GET SCHEDULING DEVICE
	MOVEM	T1,MSGBLK+HEL.SD	;SAVE IT

	MOVE	T1,J$LDEV(J)		;GET PHYSICAL DEVICE NAME
	MOVEM	T1,MSGBLK+HEL.PD	;SAVE PROCESSING DEVICE

	MOVE	T1,J$FSFM(J)		;GET SCHEDULING FORMS
	MOVEM	T1,MSGBLK+HEL.I1	;SAVE IT

	MOVS	T1,J$XMLM(J)		;GET MLIMIT,,0
	HRR	T1,NXTJOB		;GET MLIMIT,,NXTJOB
	MOVEM	T1,MSGBLK+HEL.I2	;SAVE IT

	SETZM	MSGBLK+HEL.I3		;CLEAR UNUSED WORD

	MOVEI	T1,%%.QSR		;START WITH NO FLAGS,,VERSION
	TXNE	S,FROZE			;ARE FORMS FROZEN?
	TXO	T1,HELFRZ		;YES, OR IN THE FREEZE BIT
	TXNE	S,STARTD		;HAS HE SAID START?
	TXO	T1,HELSCH		;YES, SET SCHEDUABLE BIT
	SKIPE	J$LLCL(J)		;IS IT A LOWER CASE PRINTER?
	TXO	T1,HELLLP		;YES, SET THE FLAG
	TXO	T1,HELRDE		;ALSE, WE CAN HANDLE RDE JOBS
	MOVEM	T1,MSGBLK+HEL.ST	;STORE IT
	MOVE	T1,MYSTA		;GET MY STATION NUMBER
	STORE	T1,MSGBLK+HEL.ST,HELDSN	;STORE AS DEFAULT
	POPJ	P,			;AND RETURN
SUBTTL	Disk File Input Routines


;	FILL	--		FILL THE INPUT BUFFER
;	SETEOF	--		CAUSE EOF ON NEXT INPUT
;	REWIND	--		REWIND THE INPUT FILE
;	DSKIN	--		READ A BYTE FROM THE INPUT FILE
;	SETRMS  --		SETUP TO MAKE AN RMS CALL
;	RMSERR  --		SET AN RMS ERROR


	LOWSEG			;THESE ARE IN THE LOWSEG
SUBTTL	FILL  -  Fill the input buffer

;SUBROUTINE TO FILL DISK INPUT BUFFER
;CALL WITH:
;	PUSHJ	P,FILL
;	  EOF RETURN
;	DATA RETURN

IFN FTUUOS,<
FILL:	PUSHJ	P,CHKQUE		;SEE IF WE'VE RECEIVED ANY MSGS
	SKIPE	J$XSBC(J)		;IS THERE A SAVED BYTE COUNT?
	JRST	FILLB			;YES, XCT FAST BACKSPACE CODE
	AOS	J$DINF(J)		;INCREMENT BLOCK COUNT
	IN	DSK,			;READ BLOCK
	  PJRST	.POPJ1##		;SKIP BACK OK
	JRST	FILL1			;I/O ERROR

FILLB:	PUSHJ	P,.SAVE2##		;SAVE P1 AND P2
	MOVSI	P1,(IN DSK,)		;LOAD THE UUO
	HRR	P1,J$DBRH(J)		;MAKE BELIEVE WE'RE CHANGING RINGS
	XCT	P1			;DO THE UUO
	  SKIPA				;WIN!!
	JRST	FILL1			;LOSE
	MOVE	P1,J$XSBC(J)		;GET SAVED BYTE COUNT
	EXCH	P1,J$DBCT(J)		;SAVE IT AS BYTE COUNT, LOAD REAL ONE
	SUB	P1,J$XSBC(J)		;CALCULATE AN OFFSET
	CLEARM	J$XSBC(J)		;AND CLEAR THE FLAG
	IDIVI	P1,5			;CONVERT TO WORDS
	ADDM	P1,J$DBPT(J)		;ADD IN WORDS
	AOS	J$DBPT(J)		;AND MOVE UP ONE MORE
	MOVE	P1,[440700
		    350700
		    260700
		    170700
		    100700](P2)		;LOAD THE BYTE OFFSET
	HRLM	P1,J$DBPT(J)		;STORE IT
	PUSHJ	P,TAKCHK		;TAKE A CHECKPOINT
	PJRST	.POPJ1##		;AND RETURN


				;"FILL" IS CONTINUED ON THE NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

FILL1:	PUSHJ	P,.SAVE1##		;SAVE P1
	STATZ	DSK,IO.EOF		;END OF FILE?
	  POPJ	P,			;YES, TAKE NON-SKIP
	GETSTS	DSK,N			;NO, GET DEVICE STATUS
	MOVE	P1,N			;GET STATUS INTO P1
	STAMP	LPERR			;GIVE A STAMP
	TELL	LOG,%%IDE		;GIVE A MESSAGE
	SKIPE	MSGERR			;SHOULD OPR SEE?
	TELL	OPR,%%IDE		;YES, SHOW HIM
	TXZ	P1,IO.ERR		;TURN OFF ERROR BITS
	SETSTS	DSK,(P1)		;AND SET STATUS
	SOSLE	J$DERR(J)		;TOO MANY??
	JRST	.POPJ1##		;NO, RETURN OK
	TELL	LOG,%%FSD
	SKIPE	MSGERR
	TELL	OPR,%%FSD
	MOVEI	P1,1			;MAKE THIS THE LAST COPY
	MOVEM	P1,J$XCOP(J)		;AND STORE IT SO WE DON'T REPRINT IT
	POPJ	P,			;YES, PUNT
>  ;END IFN FTUUOS
IFN FTJSYS,<
FILL:	PUSHJ	P,.SAVET##		;SAVE T1-T4
	PUSHJ	P,CHKQUE		;SEE IF WE'VE RECEIVED ANY MESSAGES
	SKIPE	J$DRMS(J)		;IS IT AN RMS FILE?
	JRST	FILL.3			;YES, GO A DIFFERENT ROUTE
	MOVE	S1,J$DBIF(J)		;GET #BYTES LEFT TO READ
	JUMPE	S1,.POPJ##		;NONE, EOF!!
	CAIL	S1,1000			;LESS THAN A FULL PAGE?
	JRST	FILL.1			;NO, CONTINUE
	SETZM	J$DBIF(J)		;YES, CAUSE EOF ON NEXT ONE
	JRST	FILL.2			;AND MEET AT THE PASS

FILL.1:	MOVNI	T1,1000			;LOAD NEGATIVE NUMBER OF WORDS
	ADDM	T1,J$DBIF(J)		;AND DECREMENT NUMBER LEFT
	MOVN	S1,T1			;AND GET NUMBER BACK

FILL.2:	MOVN	T1,S1			;GET NEGATIVE WORD COUNT
	HRRZ	T2,J$DMOD(J)		;GET BYTES/WORD
	IMUL	S1,T2			;CONVERT TO NUMBER OF BYTES
	MOVEM	S1,J$DBCT(J)		;AND STORE FOR PRINTING LOOP
	MOVE	S1,J$DJFN(J)		;GET THE JFN
	MOVE	S2,J$DBUF(J)		;GET POINTER TO THE BUFFER
	HRLI	S2,(POINT 36,0)		;AND MAKE A BYTE POINTER
	SIN				;GET THE DATA
	MOVE	S1,J$DBUF(J)		;GET ADDRESS OF BUFFER
	HLL	S1,J$DMOD(J)		;MAKE A BYTE POINTER
	MOVEM	S1,J$DBPT(J)		;STORE IT
	AOS	J$DINF(J)		;INCREMENT PAGE COUNT
	PJRST	.POPJ1##		;AND SKIP BACK

FILL.3:	SKIPN	J$DBIF(J)		;WAS EOF SET EXTERNALLY?
	POPJ	P,			;YES, RETURN EOF
	PUSHJ	P,SETRMS		;SETUP TO CALL RMS
	MOVEI	AP,J$DRAB(J)		;GET ADDRESS OF THE RAB
	$GET	<(AP)>,RMSERR		;GET A RECORD
	SKIPE	J$DRME(J)		;AN ERROR?
	POPJ	P,			;YES, ASSUME EOF
	SKIPGE	S1,J$DRFA(J)		;GET FIRST RFA IF SET
	$LDRAB	S1,RFA			;NOT SET, GET THIS ONE
	MOVEM	S1,J$DRFA(J)		;SET FIRST RFA
	$LDRAB	S1,RSZ			;GET THE RECORD SIZE
	PJUMPE	S1,.POPJ##		;RETURN EOF IF ZERO
	MOVEM	S1,J$DBCT(J)		;ELSE SAVE BYTE COUNT
	$LDRAB	S1,RBF			;LOAD ADDRESS OF RECORD
	HLL	S1,J$DMOD(J)		;MAKE A BYTE POINTER
	MOVEM	S1,J$DBPT(J)		;STORE IT
	PJRST	.POPJ1##		;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	SETEOF  -  Cause EOF on next input

;SUBROUTINE TO CAUSE "EOF" TO BE RETURNED ON THE NEXT INPUT CHARACTER
;
;CALL:
;	PUSHJ	P,SETEOF
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
SETEOF:	TXNN	S,DSKOPN		;IS THE DISK-FILE OPEN?
	POPJ	P,			;NO, JUST RETURN
	USETI	DSK,-1			;YES, DO THE USETI
	IN	DSK,			;AND CLEEAR BUFFERS AHEAD
	  JRST	.-1			;GET ALL BUFFERS
	SETOM	J$DBCT(J)		;CAUSE THE SOSG TO FAIL
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
SETEOF:	SETZM	J$DBIF(J)		;0 BYTES LEFT IN THE FILE
	SETZM	J$DBCT(J)		;0 BYTES LEFT IN CURRENT BUFFER
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	REWIND  -  Rewind the input file

;REWIND IS CALLED THE REWIND THE INPUT FILE (I.E CAUSE
;	SUBSEQUENT READS TO COME FROM THE BEGINNING OF THE
;	FILE).
;CALL:
;	PUSHJ P,REWIND
;	  ALWAYS RETURN HERE

IFN FTUUOS,<
REWIND:	PUSHJ	P,SETEOF		;CLEAR ALL BUFFERING AHEAD
	TXNE	S,DSKOPN		;IS THE FILE OPEN?
	USETI	DSK,1			;YES, REWIND IT
	SETOM	J$DBCT(J)		;IGNORE CURRENT BUFFER
	PUSHJ	P,CLRTAB		;CLEAR BACKSPACE TABLE
	SETZM	J$DINF(J)		;CLEAR INFO WORD
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
REWIND:	TXNN	S,DSKOPN		;IS THE FILE OPEN?
	POPJ	P,			;NO, JUST RETURN
	SKIPE	J$DRMS(J)		;RMS FILE?
	JRST	REWI.1			;YES, DO DIFFERENT THINGS
	MOVE	S1,J$DJFN(J)		;YES, GET THE JFN
	SETZ	S2,			;SET POINTER TO BYTE 0
	SFPTR				;DO IT!!
	  HALT
	SETZM	J$DINF(J)		;CLEAR INFO WORD
	MOVEI	S1,^D36			;LOAD A 36
	LDB	S2,[POINT 6,J$DFDB+.FBBYV(J),11]
	IDIV	S1,S2			;GET 36/<FILES BYTE SIZE>
	MOVE	S2,J$DFDB+.FBSIZ(J)	;GET SIZE OF FILE
	IDIV	S2,S1			;CONVERT TO # 36BIT BYTES
	SKIPE	S2+1			;ANY RESIDUE?
	AOS	S2			;YES ADD ANOTHER WORD
	MOVEM	S2,J$DBIF(J)		;AND INITIALIZE THE COUNTER
	SETZM	J$DBCT(J)		;AND THE BUFFER
	POPJ	P,			;AND RETURN

REWI.1:	SETOM	J$DBIF(J)		;CLEAR EOF INDICATOR
	SKIPGE	S1,J$DRFA(J)		;GET RFA OF FIRST RECORD
	POPJ	P,			;FIRST TIME THRU, JUST RETURN
	$STRAB	S1,RFA			;STORE THE RFA
	MOVX	S1,RB$RFA		;FIND BY RFA
	$STRAB	S1,RAC			;STORE NEW RECORD ACCESS
	PUSHJ	P,SETRMS		;SETUP TO CALL RMS
	MOVEI	AP,J$DRAB(J)		;LOAD ADDRESS OF RAB
	$FIND	<(AP)>,RMSERR		;FIND THE RECORD
	MOVX	S1,RB$SEQ		;SEQUENTIAL ACCESS
	$STRAB	S1,RAC			;STORE IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	DSKIN  -  Read a byte from the input file

;DSKIN IS CALLED TO READ THE NEXT BYTE FROM THE INPUT FILE.  IN
;	MOST CASES EACH ROUTINE PERFORMS THE SOSG LOOP ITSELF FOR
;	THE SAKE OF EFFICIENCY SINCE THE PUSHJ/POPJ PAIR TO CALL
;	THIS ROUTINE ON EVERY CHARACTER IS EXPENSIVE.  HOWEVER, IN
;	THE CASES WHERE EFFICIENCY IS NOT AN ISSUE, THIS ROUTINE CAN
;	BE USED.
;RETURNS WITH NEXT BYTE IN ACCUMULATOR "C".
;
;CALL:
;	PUSHJ P,DSKIN
;	  RETURN HERE ON EOF
;	  RETURN HERE NORMALLY

DSKIN:	SOSLE	J$DBCT(J)	;COUNT DOWN WORDS
	JRST	DSKI.1		;SOME LEFT
	PUSHJ	P,FILL		;REFILL
	  POPJ	P,
DSKI.1:	ILDB	C,J$DBPT(J)	;GET A CHAR
	JRST	.POPJ1##	;RETURN
SUBTTL	SETRMS - RMSERR	-   RMS Interface Routines

IFN FTJSYS,<
;CALL SETRMS BEFORE EXECUTING ANY RMS MACRO TO CLEAR THE ERROR INDICATOR

SETRMS:	SETZM	J$DRME(J)		;CLEAR THE ERROR FLAG
	POPJ	P,			;AND RETURN

;RMSERR SHOULD BE THE ERROR ADDRESS ON ALL RMS MACRO CALLS.  RMS WILL
;	CALL RMSERR ON AN ERROR.  ON RETURN FROM AN RMS CALL, J$DRME
;	WILL BE -1 IF AN ERROR OCCURED, AND S1 WILL CONTAIN THE ERROR
;	CODE.

RMSERR:	SETOM	J$DRME(J)		;SET THE ERROR
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	Forms MOUNT Routines

;SUBROUTINE TO ASK OPR TO CHANGE OUTPUT FORMS
;CALL WITH:
;	PUSHJ	P,MOUNT
;	RETURN HERE WITH DEVICE READY

	TOPSEG			;PUT THIS IN THE HISEG

MOUNT:	SKIPGE	FMNEW			;HAVE WE RE-READ LPFORM.INI?
	PUSHJ	P,FRMINI		;YES, REINIT FORMS PARAMETERS
	SETZM	FMNEW			;CLEAR THE FLAG
	MOVE	T1,J$FORM(J)		;GET CURRENT FORMS
	MOVEM	T1,J$FPFM(J)		;SAVE AS OLD FORMS TYPE
	MOVE	T1,.EQLM1(J)		;GET FORMS TYPE
	MOVEM	T1,J$FSFM(J)		;SAVE AS SCHEDULED TYPE
	CAMN	T1,J$FORM(J)		;SAME AS CURRENTLY MOUNTED?
	POPJ	P,			;YES, RETURN
	MOVEM	T1,J$FORM(J)		;SAVE NEW FORMS TYPE
	XOR	T1,J$FPFM(J)		;XOR WITH OLD ONES
	TXZ	T1,FRMSK2		;ZAP INSIGNIFICANT BITS
	JUMPE	T1,MOUNT0		;THE SAME, DON'T TELL OPR
	MOVE	T1,J$FORM(J)		;LOAD FORMS NAME AGAIN
	TELL	OPR,MOUNTM		;ASK OPR TO MOUNT 'EM
	ON	S,MNTBIT		;FLAG THAT WE WAIT
MOUNT0:	PUSHJ	P,FRMINI		;INITIALIZE FORMS
	TXNN	S,MNTBIT		;DO WE WAIT FOR OPR?
	POPJ	P,			;NO, JUST RETURN

MOUNT1:	SKIPE	J$LHNG(J)		;IS THE DEVICE OFF-LINE?
	JRST	MOUNT2			;YES, FORGET THE FORMFEED
	PUSHJ	P,SENDFF		;SEND A FORMFEED
	PUSHJ	P,OUTDMP		;AND DUMP IT OUT
MOUNT2:	OFF	S,RUNB			;TURN OFF RUN FLAG
	TELL	OPR,STAR		;AND TYPE A STAR
	MOVEI	T1,<AUTTIM>-1		;LOAD NUMBER OF SLEEPS
MOUNT3:	JUMPE	T1,MOUNT4		;TIMEOUT IF ZERO
	MOVEI	S1,^D60			;1 MINUTE
	PUSHJ	P,SUSPND		;DO IT
	SKIPN	TTYFLG			;DID OPR TYPE SOMETHING?
	SOJA	T1,MOUNT3		;DECREMENT COUNT AND LOOP
	PUSHJ	P,CHKOPR		;WAIT FOR A GO COMMAND
	PJRST	LODVFU			;LOAD THE VFU AND RETURN
MOUNT4:	TELLN	OPR,WAITED		;I TRIED!!
	PUSHJ	P,FREEZE		;FREEZE FORMS
	JRST	REQUE			;AND REQUE IT

WAITED:	ASCIZ /[Automatically requeuing job and Freezing forms]
/
SUBTTL	Special Forms Handler

FRMINI:	PUSHJ	P,SETDFF		;SET DEFAULT PARAMTERS
	SKIPN	C,FMADR			;IS THERE AN LPFORM.INI?
	POPJ	P,			;NO, JUST RETURN
	HRLI	C,440700		;YES, MAKE A BYTE POINTER
	MOVEM	C,FMBPT			;AND SAVE IT
	PUSHJ	P,FRMIN1		;DO EVERYTHING
	PJRST	LODVFU			;LOAD THE VFU AND RETURN

FRMIN1:	PUSHJ	P,FH$SIX		;GET THE FORMS NAME
	  POPJ	P,			;EOF!!
	CAMN	T1,J$FORM(J)		;MATCH??
	JRST	FRMIN2			;YES!!
FRMI1A:	PUSHJ	P,FH$EOL		;NO, FIND NEXT LINE
	  POPJ	P,			;EOF!!
	JRST	FRMIN1			;AND LOOP


FRMIN2:	CAIN	C,"/"			;BEGINNING OF SWITCH?
	JRST	FRMIN5			;YES, LOCATOR IS "ALL"
	CAIN	C,":"			;BEGINNING OF LOCATOR?
	JRST	FRMIN3			;YES, GO GET IT
	CAIN	C,.CHLFD		;EOL?
	JRST	FRMIN1			;YES, GO THE NEXT LINE
	PUSHJ	P,FH$CHR		;ELSE, GET A CHARACTER
	  POPJ	P,			;EOF
	JRST	FRMIN2			;AND LOOP

FRMIN3:	PUSHJ	P,FH$SIX		;GET A LOCATOR
	  POPJ	P,			;EOF!!
	JUMPE	T1,FRMI3A		;MAYBE PAREN??
	JRST	FRMIN4			;AND DO THE LIST

FRMI3A:	CAIN	C,"/"			;A SWITCH?
	JRST	FRMIN5			;YES!
	CAIE	C,"("			;A LIST?
	JRST	FRMIN9			;NO, ERROR
FRMIN4:	HLRZ	T2,T1			;GET THE FIRST THREE CHARS
	CAIN	T2,'ALL'		;IS IT "ALL"?
	JRST	FRMIN5			;YES, STOP CHECKING
	CAIN	T2,'LOC'		;IS IT LOCAL?
	SKIPGE	J$LREM(J)		;YES, ARE WE?
	  SKIPA				;NO, NO
	JRST	FRMIN5			;YES, YES!
	CAIN	T2,'REM'		;DOES IT SAY "REMOTE"?
	SKIPL	J$LREM(J)		;YES, ARE WE REMOTE
	  SKIPA				;NO!!!
	JRST	FRMIN5			;YES!!
	CAIE	T2,'LPT'		;IS IT "LPT"
	JRST	FRMI4B			;NO, TRY ONE LAST THING
	CAMN	T1,J$LDEV(J)		;COMPARE TO OUR DEVNAM
	JRST	FRMIN5			;MATCH!!
	CAMN	T1,J$LGNM(J)		;NO, TRY GIVEN NAME
	JRST	FRMIN5			;WIN!!

FRMI4B:	CAIN	C,.CHLFD		;BREAK ON EOL?
	JRST	FRMIN1			;YES, GET NEXT LINE
	CAIE	C,"/"			;IS IT A SLASH?
	CAIN	C,")"			;NO, CLOSE PAREN?
	JRST	FRMI1A			;YES, GET THE NEXT LINE
	PUSHJ	P,FH$SIX		;ELSE, GET THE NEXT LOCATOR
	  POPJ	P,			;EOF, RETURN
	JUMPE	T1,FRMIN9		;BAD FORMAT
	JRST	FRMIN4			;AND LOOP AROUND

;GET HERE IF THIS LINE IS FOR US

FRMIN5:	CAIN	C,.CHLFD	;WAS THE LAST CHARACTER A LINEFEED?
	POPJ	P,		;YES, RETURN
	CAIN	C,"/"		;ARE WE AT THE BEGINNING OF A SWITCH?
	JRST	FRMI5A		;YES, DO IT!
	PUSHJ	P,FH$CHR	;NO, GET A CHARACTER
	  POPJ	P,		;EOF!!
	JRST	FRMIN5		;AND LOOP AROUND
FRMI5A:	PUSHJ	P,FH$SIX	;GET THE SWITCH
	  POPJ	P,		;EOF!!
	JUMPN	T1,FRMIN6	;JUMP IF WE'VE GOT SOMETHING
	CAIN	C,.CHLFD	;EOL?
	POPJ	P,		;YES, RETURN
	JRST	FRMIN5		;ELSE, KEEP TRYING

FRMIN6:	MOVE	T4,T1		;SAVE SWITCH NAME FOR LATTER
	HLLZS	T1		;GET FIRST THREE CHARACTERS OF SWITCH
	MOVSI	T2,-F$NSW	;MAKE AOBJN POINTER

FRMIN7:	HLLZ	T3,FFNAMS(T2)	;GET A SWITCH NAME
	CAMN	T3,T1		;MATCH??
	JRST	FRMIN8		;YES, DISPATCH
	AOBJN	T2,FRMIN7	;NO, LOOP
	MOVE	T4,T1		;GET SWITCH NAME
	TELL	OPR,[ASCIZ /Unrecognized switch + in LPFORM.INI ignored
/]
	JRST	FRMIN5		;AND LOOP

FRMIN8:	HRRZ	T3,FFNAMS(T2)	;GET DISPATCH ADDRESS
	PUSHJ	P,(T3)		;GO!!
	JRST	FRMIN5		;AND LOOP


FRMIN9:	TELLN	OPR,[ASCIZ /Bad format in LPFORM.INI
/]
	POPJ	P,		;AND RETURN
SUBTTL	Forms Switch Subroutines


S$BANN:	PUSHJ	P,FH$DEC		;GET DECIMAL ARGUMENT
	MOVEM	T1,J$FBAN(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$TRAI:	PUSHJ	P,FH$DEC		;GET DECIMAL ARGUMENT
	MOVEM	T1,J$FTRA(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$HEAD:	PUSHJ	P,FH$DEC		;GET A DECIMAL ARGUMENT
	MOVEM	T1,J$FHEA(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$LINE:	PUSHJ	P,FH$DEC		;GET DECIMAL ARGMENT
	MOVEM	T1,J$FLIN(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$WIDT:	PUSHJ	P,FH$DEC		;GET DECIMAL ARGUMENT
	MOVEM	T1,J$FWID(J)		;SAVE IT
	MOVEI	T2,3			;ASSUME WIDTH CLASS 3
	MOVEM	T2,J$FWCL(J)		;SAVE WIDTH CLASS
	CAIG	T1,F$CL2		;LE CLASS 2 LIMIT?
	SOS	J$FWCL(J)		;YES, DECREMENT
	CAIG	T1,F$CL1		;LE CLASS 1 LIMIT
	SOS	J$FWCL(J)		;YES, DECREMENT AGAIN!
	POPJ	P,			;AND RETURN

S$RIBB:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	  POPJ	P,			;EOF
	TELL	OPR,[ASCIZ /Ribbon: +
/]
	MOVEM	T1,J$FRIB(J)		;SAVE IT
	POPJ	P,			;AND RETURN
S$DRUM:
S$CHAI:	PUSHJ	P,FH$SIX		;GET SIXBIT ARG
	  POPJ	P,			;EOF!
	TELL	OPR,[ASCIZ /Drum (chain): +
/]
	MOVEM	T1,J$FDRU(J)		;SAVE IT
	POPJ	P,			;AND RETURN

S$NOTE:	MOVEI	T1,J$FNBK(J)		;ADDRESS OF NOTE BLOCK
	MOVEM	T1,J$FNOT(J)		;IS THE ADDRESS OF THE NOTE
	MOVE	T1,[POINT 7,J$FNBK+2(J)]
	CLEAR	T2,			;T1 IS POINTER, T2 IS COUNTER
	MOVE	C,[ASCII /[NOTE/]
	MOVEM	C,J$FNBK(J)
	MOVE	C,[ASCII /:    /]
	MOVEM	C,J$FNBK+1(J)

S$NOT1:	PUSHJ	P,FH$CHR		;GET A CHARACTER
	  JRST	S$NOT2			;EOF, FINISH UP!!
	CAIGE	C,40			;MAKE SURE ITS GREATER THAN SPACE
	  JRST	S$NOT2			;ITS NOT!, FINISH UP
	CAIN	C,"/"			;ALSO STOP ON SLASH
	JRST	S$NOT2			;IT IS!!
	IDPB	C,T1			;DEPOSIT IT
	CAIGE	T2,^D49			;LOOP FOR 50 CHARACTERS
	AOJA	T2,S$NOT1		;INCR AND LOOP

S$NOT2:	MOVEI	T2,"]"			;CLOSE BRACKET
	IDPB	T2,T1			;DEPOSIT IT
	MOVEI	T2,.CHCRT		;LOAD A CARRIAGE RETURN
	IDPB	T2,T1			;DEPOSIT IT
	MOVEI	T2,.CHLFD		;LOAD A LINEFEED
	IDPB	T2,T1			;DEPOSIT IT
	CLEAR	T2,			;LOAD A NULL
	IDPB	T2,T1			;DEPOSIT IT
	TELLN	OPR,J$FNBK(J)		;AND TYPE IT TO THE OPERATOR
	POPJ	P,			;AND RETURN

S$PAUS:	SETOM	J$FPAU(J)		;SET THE PAUSE FLAG
	POPJ	P,			;AND RETURN

S$WHAT:	SETOM	J$FWHA(J)		;SET WHAT FLAG
	POPJ	P,			;AND RETURN

S$ALCN:	PUSHJ	P,FH$DEC		;GET DECIMAL ARG
	MOVEM	T1,J$FALC(J)		;STORE IT
	POPJ	P,			;RETURN

S$ALSL:	PUSHJ	P,FH$DEC		;GET DECIMAL ARG
	MOVEM	T1,J$FALS(J)		;SAVE IT
	POPJ	P,			;AND RETURN
S$ALIG:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	  POPJ	P,			;EOF
	MOVEM	T1,J$FALI(J)		;SAVE IT
	POPJ	P,			;AND RETURN

S$VFU:
S$TAPE:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	  POPJ	P,			;EOF
	MOVEM	T1,J$FTAP(J)		;SAVE IT
	MOVE	T2,J$FORM(J)		;GET FORMS NAME
	CAMN	T2,NORMAL		;IS IT NORMAL?
	MOVEM	T1,D$TAPE		;YES, MAKE THIS THE DEFAULT
	POPJ	P,			;AND RETURN
SUBTTL	LODVFU  --  Load the Vertical Forms Unit

LODVFU:	MOVE	T1,J$FTAP(J)		;GET VFU TYPE
	CAMN	T1,J$FLVT(J)		;SAME AS CURRENT ONE?
	POPJ	P,			;YES, RETURN
	SKIPE	J$LDVF(J)		;NO, DOES DEVICE HAVE A DAVFU?
	JRST	LODV.0			;YES, AUTO-LOAD
	MOVE	T1,J$FTAP(J)		;GET DESIRED TAPE
	MOVE	T2,T1			;IN BOTH T1 AND T2
	EXCH	T2,J$FLVT(J)		;MAKE IT THE CURRENT ONE
	SKIPN	T2			;IF PREVIOUS WAS NULL
	CAME	T1,D$TAPE		; AND THIS IS THE DEFAULT
	SKIPA				; THEN
	POPJ	P,			;DON'T TYPE A MESSAGE
	TELL	OPR,[ASCIZ /Please put VFU Tape + in $
/]
	ON	S,MNTBIT		;CAUSE A WAIT
	POPJ	P,			;AND RETURN

LODV.0:	TELL	OPR,%%LVF		;TELL OPR WE ARE LOADING
	PUSHJ	P,OUTWON		;WAIT FOR ONLINE


				;AND FALL INTO OS DEPENDENT CODE
IFN FTUUOS,<
	MOVE	T1,[2,,T2]		;ARG POINTER
	MOVX	T2,.DFRDS		;READ DEVICE STATUS
	MOVEI	T3,LPT			;FOR CHANNEL LPT
	DEVOP.	T1,			;DO IT
	  JRST	NODAVF			;ASSUME NO DAVFU
	TXNE	T1,DF.LVE		;CURRENT VFU IN ERROR?
	JRST	LODV.9			;YES, DONT SEND A FF
	TXZ	S,FFSEEN		;CLEAR FFSEEN
	PUSHJ	P,SENDFF		;SEND THE FORMFEED
	PUSHJ	P,OUTDMP		;AND FORCE IT OUT
LODV.9:	PUSHJ	P,OUTFLS		;FLUSH OUTPUT BUFFERS
	MOVX	T1,.IOASL		;LOAD ASCII MODE
	MOVSI	T2,'SYS'		;AND LOAD DEVICE
	MOVEI	T3,J$XVFB(J)		;AND ADDRRES OF BUFFER RING HEADER
	OPEN	VFC,T1			;OPEN SYS
	  HALT	.			;THIS REALLY SHOULDN'T HAPPEN
	MOVE	T1,J$FTAP(J)		;GET TAPE NAME
	MOVSI	T2,'VFU'		;AND EXTENSION
	SETZB	T3,T4			;AND CLEAR THE REST
	LOOKUP	VFC,T1			;FIND THE FILE
	  JRST	NOVFU			;LOSE, TELL HIM
	MOVE	T1,[2,,T2]		;ARGS FOR DEVOP
	MOVX	T2,.DFENV		;ENABLE VFU LOAD
	MOVEI	T3,LPT			;FOR I/O CHANNEL
	DEVOP.	T1,			;DO IT
	  JRST	NODAVF			;ASSUME NO DAVFU
	PUSHJ	P,M$ACQP##		;GET A PAGE
	PUSH	P,AP			;SAVE NUMBER FOR LATER
	PG2ADR	AP			;MAKE AN ADDRESS
	EXCH	AP,.JBFF		;AND FAKE OUT THE MONITOR
	INBUF	VFC,2			;FOR BUFFERS
	MOVEM	AP,.JBFF		;RESTORE JOBFF

LODV.1:	SOSGE	J$XVFB+.BFCNT(J)	;COUNT DOWN
	JRST	LODV.2			;GET ANOTHER BUFFER
	ILDB	C,J$XVFB+.BFPTR(J)	;GET A BYTE
	PUSHJ	P,DEVOUT		;OUTPUT IT
	JRST	LODV.1			;AND LOOP

LODV.2:	IN	VFC,			;GET A BUFFER
	  JRST	LODV.1			;SUCCESS, BACK TO LOOP
	PUSHJ	P,OUTDMP		;FORCE OUT THE BUFFERS
	MOVE	T1,[2,,T2]		;LOAD ARG POINTER
	MOVX	T2,.DFDVL		;DISABLE VFU LOAD
	MOVEI	T3,LPT			;AND CHANNEL NUMBER
	DEVOP.	T1,			;DO IT!
	  JRST	NODAVF			;LOSE
	RELEAS	VFC,			;RELEASE VFU CHANNEL
	POP	P,AP			;GET SCRATCH PAGE BACK
	PUSHJ	P,M$RELP##		;RELEASE IT
	MOVE	T1,J$FTAP(J)		;GET TAPE NAME
	MOVEM	T1,J$FLVT(J)		;SAVE AS TYPE LOADED
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS
IFN FTJSYS,<
	OFF	S,FFSEEN		;CLEAR FFSEEN
	PUSHJ	P,SENDFF		;SEND A FORM-FEED
	PUSHJ	P,OUTDMP		;AND FORCE IT OUT
	MOVE	T1,[GJBLK,,GJBLK+1]	;SETUP A BLT POINTER
	SETZM	GJBLK			;CLEAR THE FIRST WORD
	BLT	T1,GJBLK+7		;ZERO THE BLOCK
	MOVX	T1,GJ%OLD		;GET THE FLAGS
	MOVEM	T1,GJBLK+.GJGEN		;STORE THEM
	MOVE	T1,DJFN			;GET I/O JFN
	MOVEM	T1,GJBLK+.GJSRC		;SAVE 'EM
	MOVE	T1,DDEV			;GET DEFAULT DEVICE
	MOVEM	T1,GJBLK+.GJDEV		;SAVE IT
	MOVE	T1,DVFU			;AND THE  DEFAULT EXTENSION
	MOVEM	T1,GJBLK+.GJEXT		;SAVE IT

	MOVE	T3,[POINT 6,J$FTAP(J)]	;POINT TO THE NAME IN 6BIT
	MOVE	T4,[POINT 7,T1]		;POINT TO RESULT IN ASCII
	SETZB	T1,T2			;CLEAR DESTINATION WORDS

LODV.1:	ILDB	S1,T3			;GET A CHARACTER
	JUMPE	S1,LODV.2		;NULL MEANS DONE
	ADDI	S1,"A"-'A'		;ELSE CONVERT TO ASCII
	IDPB	S1,T4			;AND DEPOSIT IT
	TLNE	T3,770000		;DONE?
	JRST	LODV.1			;NO, LOOP AROUND

LODV.2:	MOVEI	S1,GJBLK		;POINT TO BLOCK
	HRROI	S2,T1			;POINT TO STRING
	GTJFN				;GET THE JFN
	  JRST	NOVFU			;LOSE
	MOVE	T3,S1			;COPY THE JFN OVER
	MOVE	S1,J$LJFN(J)		;GET THE LPT JFN
	MOVX	S2,.MOLVF		;GET LOAD VFU FUNCTION
	MOVEI	T1,T2			;ADDRESS OF ARG BLOCK
	MOVEI	T2,2			;LENGTH OF ARG BLOCK
	MTOPR				;LOAD THE VFU
	MOVE	T1,J$FTAP(J)		;GET THE VFU TYPE
	MOVEM	T1,J$FLVT(J)		;SAVE AS CURRENTLY LOADED
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
;HERE IF VFU FILE THAT WE ARE LOOKING FOR IS NOT AROUND

NOVFU:	MOVE	T1,J$FTAP(J)		;TYPE WE TRIED TO LOAD
	CAMN	T1,D$TAPE		;IS IT THE DEFAULT
	JRST	NOVF.1			;YES, GIVE UP
	TELL	OPR,%%CFV		;CAN'T FIND VFU
	JRST	REQUE			;AND REQUE THE JOB

IFN FTUUOS,<
NOVF.1:	TELL	OPR,%%CFD		;CANT LOAD DEFAULT
	MOVE	T1,[2,,T2]		;ARGS FOR DEVOP
	MOVEI	T2,.DFLLV		;LOAD HARDWARE VFU
	MOVEI	T3,LPT			;FOR CHANNEL
	DEVOP.	T1,			;DO IT
	  JRST	NOVF.2			;LOSE
	MOVX	T1,FRMNOR		;GET NAME OF NORMAL
	MOVEM	T1,J$FLVT(J)		;STORE IT
	POPJ	P,			;AND RETURN

NOVF.2:	TELL	OPR,%%ELV		;ERROR?
	JRST	DOREST			;RESET, I GUESS

;HERE WHEN DEVOP FAILS...CLEAR DAVFU FLAG AND RETURN
NODAVF:	SETZM	J$LDVF(J)		;CLEAR THE FLAG
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
NOVF.1:	TELL	OPR,%%CFD		;GIVE A MESSAGE
	JRST	DOREST			;AND DIE GRACEFULLY
>  ;END IFN FTJSYS
SUBTTL	I/O Subroutines for LPFORM.INI


;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. SKIPS NORMALLY, NON-SKIP ON EOF.
FH$SIX:	CLEAR	T1,		;CLEAR FOR RESULT
	MOVE	T2,[POINT 6,T1]	;POINTER FOR RESULT
FH$SX1:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	  POPJ	P,		;EOF!!
	CAIL	C,"A"		;CHECK FOR ALPHA
	CAILE	C,"Z"
	  SKIPA			;ITS NOT!!
	JRST	FH$SX2		;IT IS, DEPOSIT IT

	CAIL	C,"0"		;CHECK FOR NUMBER
	CAILE	C,"9"
	  PJRST	.POPJ1##		;NO REASONABLE

FH$SX2:	SUBI	C,40		;CONVERT TO SIXBIT
	TLNE	T2,770000	;GET SIX YET?
	IDPB	C,T2		;NO, DEPOS