Google
 

Trailing-Edge - PDP-10 Archives - AP-4172F-BM - 3a-sources/lptspl.mac
There are 45 other files named lptspl.mac in the archive. Click here to see a list.
TITLE	LPTSPL  --  Disk to Line-printer Spooler  -  version 103
SUBTTL	D.A. Lewine - L.S. Samberg/LSS	15 Nov 77


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


	SEARCH	QSRMAC			;SEARCH GALAXY PARAMETERS
	PROLOGUE(LPTSPL)
IFN FTJSYS,<
	SEARCH	RMSSYM
	SEARCH	ACTSYM
>  ;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==103			;MAJOR VERSION NUMBER
	LPTMIN==0			;MINOR VERSION NUMBER
	LPTEDT==2305			;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



;COPYRIGHT (C) 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978,  BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
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.

;2300	MAKE THIS VERSION 103.  FIX A BUG WHICH CAUSED LPTSPL TO REQUIRE
;	THAT LPFORM.INI EXIST.
;2301	INSERT CODE FOR USAGE ACCOUNTING ON THE -20.
;2302	INCLUDE A NUMBER OF MAINTAINANCE EDITS AND SPR ANSWERS.
;	SPECIFICALLY, EDITS 2267,2275,2273,2276.
;2303	ON -20, IF JOB HAS NO ACCOUNT STRING IN THE .EQ, FILL IN THE
;	ACCOUNT STRING OF THE FIRST FILE IN THE REQUEST.  IN THIS RELEASE
;	THIS WILL HAPPEN FOR ALL SPOOLED REQUESTS.
;2304	LINE-SEQUENCE NUMBERS IN LPFORM.INI DON'T WORK BECAUSE THE
;	TAB ISN'T EATEN UP.
;2305	ON -20 DON'T SEND A FORMFEED BEFORE LOADING VFU IF THE VFU
;	WAS IN ERROR.
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




;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$ADTM,1		;DATE,,TIME
	LP	J$ARTM,1		;RUNTIME USED
	LP	J$APRT,1		;# PAGES PRINTED
	LP	J$ADRD,1		;DISK FILE READS
>  ;END IFN FTJSYS

	LP	J$ASEQ,1		;REMEMBER SEQUENCE NUMBER
	LP	J$APRI,1		;REMEMBER EXTERNAL PRIORITY
	LP	J$AFXC,1		;FILES * COPIES
;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
RPTCNT:	BLOCK	1		;REPEAT COUNT FOR FORTRAN CTL CHARS

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,COPY			;DO THE COPY LOOP
	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
	AOS	J$AFXC(J)		;INCREMENT FILES*COPIES
	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
	HRROI	S2,.EQACT(J)		;POINT TO THE ACCOUNT STRING
	SKIPN	.EQACT(J)		;IS THERE AN ACCOUNT STRING?
	GACTF				;NO, GET ONE
	  JFCL				;IGNORE ERROR
	  JFCL				;RETURN #1
	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
;	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:	MOVX	S1,.FHSLF		;GET FORK HANDLE
	RUNTM				;GET MY RUNTIME
	MOVNM	S1,J$ARTM(J)		;REMEMBER IT NEGATED
	LOAD	S1,.EQSEQ(J),EQ.SEQ	;GET SEQUENCE NUMBER
	STORE	S1,J$ASEQ(J)		;STORE IT
	GTAD				;GET TIME AND DATE
	STORE	S1,J$ADTM(J)		;STORE IT
	LOAD	S1,.EQSEQ(J),EQ.PRI	;GET EXTERNAL PRIORITY
	STORE	S1,J$APRI(J)		;STORE IT
	SETZM	J$AFXC(J)		;CLEAR OUT FILES * COPIES
	SETZM	J$ADRD(J)		;CLEAR DISK READS COUNTER
	SETZM	J$APRT(J)		;CLEAR PAGES PRINTED
	POPJ	P,			;RETURN
>  ;END IFN FTJSYS
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

	MOVX	S1,.USENT	;WRITE AN ENTRY
	MOVEI	S2,ACTLST	;POINT TO THE LIST
	USAGE			;DO THE JSYS
	ERCAL	[TELL OPR,[ASCIZ /?LPTUJF  USAGE JSYS FAILED
/]
	POPJ	P,]
	POPJ	P,		;AND RETURN
ACTLST:	USENT.	(.UTOUT,1,1)
	USJNO.	(-1)
	USTAD.	(-1)
	USTRM.	(-1)
	USLNO.	(-1)
	USPNM.	(<SIXBIT/LPTSPL/>,US%IMM)
	USPVR.	(%LPT,US%IMM)
	USAMV.	(-1)
	USNOD.	(-1)
	USACT.	(<POINT 7,.EQACT(J)>)
	USSRT.	(J$ARTM(J))
	USSDR.	(J$ADRD(J))
	USSDW.	(0,US%IMM)
	USJNM.	(.EQJOB(J))
	USQNM.	(<SIXBIT /LPT/>,US%IMM)
	USSDV.	(J$LDEV(J))
	USSSN.	(J$ASEQ(J))
	USSUN.	(J$APRT(J))
	USSNF.	(J$AFXC(J))
	USCRT.	(.EQAFT(J))
	USSCD.	(J$ADTM(J))
	USFRM.	(.EQLM1(J))
	USDSP.	(<SIXBIT/NORMAL/>,US%IMM)
	USTXT.	(<-1,,[ASCIZ / /]>)
	USPRI.	(J$APRI(J))
	USNM2.	(<POINT 7,.EQOWN(J)>)
	0				;END OF LIST
>  ;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:	TXO	S,RQB			;TURN ON REQUEUE FLAG
	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 IN FILE
	AOS	J$ADRD(J)		;AND TOTAL PAGES READ
	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
	MOVE	S1,J$LJFN(J)		;GET THE LPT JFN
	MOVX	S2,.MORST		;READ-STATUS FUNCTION
	MOVEI	T1,T2			;AND ADDRESS OF ARGS
	MOVEI	T2,3			;LENGTH OF ARG BLOCK
	MTOPR				;READ THE STATUS
	TXNE	T3,MO%LVF		;IS THE VFU IN ERROR?
	JRST	LODV.9			;YES, DON'T SEND A FF
	PUSHJ	P,SENDFF		;SEND A FORM-FEED
	PUSHJ	P,OUTDMP		;AND FORCE IT OUT
LODV.9:	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, DEPOSIT ANOTHER
	JRST	FH$SX1		;AND LOOP AROUND


;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C
FH$CHR:	MOVE	C,@FMBPT		;GET THE WORD
	TRNN	C,1			;IS THERE AN LSN?
	JRST	FH$CR1			;NO, CONTINUE ON
	AOS	FMBPT			;YES, INCREMENT BYTE-POINTER
	ILDB	C,FMBPT			;AND EAT THE TAB
FH$CR1:	ILDB	C,FMBPT			;GET A CHARACTER
	JUMPE	C,.POPJ##		;RETURN WHEN DONE
	CAIE	C,.CHTAB		;CONVERT TABS
	CAIN	C,.CHCRT		;AND CARRIAGE RETURNS
	MOVEI	C,40			;INTO SPACES
	CAIE	C,.CHFFD		;CONVERT FORM FEEDS
	CAIN	C,.CHVTB		;AND VERTICAL TABS
	MOVEI	C,.CHLFD		;INTO LINEFEED
	CAIL	C,141			;CHECK LOWER CASE
	CAILE	C,172			;141-172
	PJRST	.POPJ1##			;ITS NOT
	SUBI	C,40			;YUP, CONVERT TO UPPER
	PJRST	.POPJ1##			;AND SKIP BACK
;ROUTINE TO SEARCH FOR EOL IN LPFORM.INI

FH$EOL:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	  POPJ	P,		;EOF!!
	CAIE	C,.CHLFD	;EOL?
	JRST	FH$EOL		;NO, LOOP
	PJRST	.POPJ1##		;YES, RETURN!


;ROUTINE TO PICK UP A DECIMAL NUMBER

FH$DEC:	CLEAR	T1,		;PLACE TO ACCUMULATE RESULT
FH$DE1:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	  POPJ	P,		;EOF
	CAIL	C,"0"		;CHECK THE RANGE
	CAILE	C,"9"		;0-9
	  POPJ	P,		;RETURN
	IMULI	T1,12		;SHIFT A PLACE
	ADDI	T1,-"0"(C)	;ADD IN A DIGIT
	JRST	FH$DE1		;AND LOOP AROUND
;SETDFF -- ROUTINE TO SET UP DEFAULT FORMS PARAMETERS


SETDFF:	HRLZI	T3,-F$NSW		;GET NEGATIVE SWITCH TABLE LEN
	MOVEI	T1,J$FCUR(J)		;POINT TO CURRENT FORMS PARAMS

SETDF1:	MOVE	T2,FFDEFS(T3)		;GET A DEFAULT
	MOVEM	T2,(T1)			;STORE IT
	AOJ	T1,			;INCREMENT STORE COUNTER
	AOBJN	T3,SETDF1		;AND LOOP

;NOW COMPUTE THE WIDTH CLASS
SETDF2:	MOVEI	T1,3			;START AT THREE
	MOVEM	T1,J$FWCL(J)		;STORE IT
	MOVE	T1,J$FWID(J)		;GET THE WIDTH
	CAIG	T1,F$CL2		;LE CLASS 2 LIMIT?
	SOS	J$FWCL(J)		;YES, SOS ONCE
	CAIG	T1,F$CL1		;LE CLASS 1 LIMIT
	SOS	J$FWCL(J)		;YES, SOS AGAIN


;SETUP DEFAULT ALIGN NAME AND CLEAR FLAG WORD
SETDF3:	MOVE	T1,J$FORM(J)		;FORMS NAME
	MOVEM	T1,J$FALI(J)		;SAVE IT

	POPJ	P,			;AND RETURN
SUBTTL	SUBROUTINE TO SAVE ALL ACS

	LOWSEG

;SUBROUTINE TO SAVE ACS 1 TO 16
;AC 0=S AND IS GLOBAL ACCROSS ALL ROUTINES
;AC 17=P AND SHOULD NOT BE PUSHED
;ACS ARE RESTORED AUTOMATICLY UPPON EXIT FROM A ROUTINE
; CALLING SAVALL AND .POPJ1## RETURNS ARE HANDLED CORRECTLY
;CALL WITH:
;	PUSHJ	P,SAVALL
;	RETURN HERE
;***WARNING*** THIS USES SPACE ON THE PDL VERY QUICKLY AND SHOULD
; BE USED WITH CARE
SAVALL:	EXCH	1,(P)		;PUT AC1 ON PDL
	MOVEM	16,15(P)	;SAVE AC16 ON PDL
	HRRZI	16,1(P)		;DESTAINATION
	HRLI	16,2		;SOURCE
	BLT	16,14(P)	;STORE THE AC'S
	ADD	P,[15,,15]	;UPDATE BOTH HALVES OF P
	MOVE	16,(P)		;PUT AC16 BACK
	PUSHJ	P,(1)		;GO DO YOUR THING
	  JRST	.+2		;NON-SKIP RETURN
	AOS	-16(P)		;CAUSE SKIP RETURN
	HRLZI	16,-15(P)	;FROM HERE
	HRRI	16,1		; TO HERE
	BLT	16,16		;PUT BACK AC'S
	SUB	P,[16,,16]	;UPDATE BOTH HALVES OF P
	POPJ	P,		;RETURN
SUBTTL	Output Device Monitor Interface Routines


;	OUTGET  --	GET THE OUTPUT DEVICE AND OPEN IT
;	OUTOUT	--	OUTPUT AND ADVANCE BUFFERS
;	OUTERR	--	OUTPUT DEVICE ERROR RECOVERY
;	OUTWON	--	WAIT FOR DEVICE TO COME ON-LINE
;	OUTEOJ	--	END OF JOB DEVICE HANDLING
;	OUTDMP	--	FORCE OUT ALL BUFFERS AND WAIT
;	OUTFLS	--	FLUSH ALREADY BUFFERED OUTPUT


	TOPSEG
SUBTTL	OUTGET  --  OPEN the output device

;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING

IFN FTUUOS,<
OUTGET:	MOVE	T1,J$LGNM(J)		;GET THE GIVEN NAME
	DEVNAM	T1,			;GET ITS PHYSICAL NAME
	  JRST	OUTG.4			;LOSE?
	MOVEM	T1,J$LDEV(J)		;AND SAVE IT
	MOVEM	T1,J$LSDV(J)		;AND AS SCHEDULING DEVICE
	MOVX	T1,.IOASC+IO.SFF+UU.PHS+UU.AIO
					;ASCII+SUPRESS FF+PHONLY+NBIO
	MOVE	T2,J$LDEV(J)		;OUTPUT DEVICE NAME
	MOVSI	T3,J$LBRH(J)		;BUFFER HEADER
	OPEN	LPT,T1			;INIT THE DEVICE
	   JRST	OUTG.3			;LOSE GIVE ERROR

	MOVE	T1,[2,,T2]		;ARG POINTER
	MOVX	T2,.DFHCW		;HARDWARE CHARACTERISTICS WORD
	MOVEI	T3,LPT			;LOAD LPT CHANNEL #
	DEVOP.	T1,			;READ THE CHARS
	  JRST	OUTG.4			;SHOULDN'T HAPPEN
	TXNE	T1,DF.LCP		;IS IT A LOWER-CASE PRINTER?
	SETOM	J$LLCL(J)		;YES, SET THE FLAG
	LDB	T1,[POINTR(T1,DF.VFT)]	;GET VFU TYPE
	CAIN	T1,.DFVTD		;IS IT A DAVFU?
	SETOM	J$LDVF(J)		;YES, SET THE FLAG
	MOVEI	T1,LPT			;LOAD LPT CHANNEL #
	DEVTYP	T1,			;GET THE DEVICE TYPE WORD
	  JRST	OUTG.4			;THIS SHOULDN'T HAPPEN
	TXNE	T1,TY.SPL		;IS IT SPOOLED?
	JRST	OUTG.5			;YES, TELL HIM
	MOVEI	T1,LPT			;NO, GET THE CHANNEL
	WHERE	T1,			;GET THE LOCATION
	  SETZ	T1,			;ASSUME STATION 0
	TLZ	T1,-1			;CLEAR STATION FLAGS
	CAME	T1,CNTSTA		;IS IT THE CENTRAL STATION?
	SETOM	J$LREM(J)		;NO, SET REMOTE FLAG
IFN FTDPM,<
	MOVE	S1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE
	EXCH	S1,.JBFF		;SAVE IT AS JOBFF
	OUTBUF	LPT,1			;MAKE ONE BUFFER
	MOVEM	S1,.JBFF		;RESTORE S1
	SETZM	J$LHNG(J)		;CLEAR THE HUNG FLAG
	PJRST	INTCNL			;CONNECT LPT TO PSISER
>  ;END IFN FTDPM

IFE FTDPM,<
	SKIPGE	J$LREM(J)		;SKIP IF LOCAL PRINTER
	JRST	OUTG.2			;SETUP REGULAR BFRS FOR REMOTE
	MOVE	T1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE
	SUBI	T1,BUFSIZ		;BACK UP ONE BUFFER
	SETZ	T2,			;CLEAR A COUNTER

OUTG.1:	ADDI	T1,BUFSIZ		;POINT TO NEXT BUFFER
	MOVEI	S1,BUFSIZ+1(T1)		;GET LINK TO NEXT BUFFER
	HRLI	S1,BUFSIZ-2		;AND NUMBER DATAWORDS+1
	MOVEM	S1,1(T1)		;AND STORE IT AWAY IN BUFFER
	CAIGE	T2,BUFNUM-1		;GOT THEM ALL?
	AOJA	T2,OUTG.1		;NO, LOOP AROUND

	MOVNI	T2,BUFSPC		;LOAD -BUFSPC
	ADDM	T2,1(T1)		;MAKE LAST BUFFER POINT TO FIRST
	MOVE	T1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE BACK
	ADDI	T1,1			;POINT TO WORD 1
	TXO	T1,BF.VBR		;MAKE IT A VIRGIN RING
	MOVEM	T1,J$LBRH(J)		;AND PUT IT WHERE MONITOR WILL FIND IT
	SETZM	J$LHNG(J)		;CLEAR THE HUNG FLAG
	PJRST	INTCNL			;CONNECT LPT TO PSI AND RETURN

OUTG.2:	MOVE	S1,J$LBUF(J)		;GET ADR OF BUFFER PAGE
	EXCH	S1,.JBFF		;SWAP IT WITH JOBFF
	OUTBUF	LPT,2			;GET TWO BUFFERS
	MOVEM	S1,.JBFF		;RESTORE JOBFF
	SETZM	J$LHNG(J)		;CLEAR HUNG FLAG
	PJRST	INTCNL			;AND CONNECT TO INTERRUPTS
>  ;END IFE FTDPM

OUTG.3:	TELL	OPR,%%DNA		;GIVE A MESSAGE
	JRST	LPTSPL			;AND RESET THE WORLD

OUTG.4:	MOVE	T1,J$LGNM(J)		;GET THE GIVEN NAME
	TELL	OPR,%%DDE		;DEVICE DOESN'T EXIST
	JRST	LPTSPL			;AND RESET THE WORLD

OUTG.5:	TELL	OPR,%%DIS		;DEVICE IS SPOOLED
	JRST	LPTSPL			;AND RESET THE WORLD
>  ;END IFN FTUUOS
IFN FTJSYS,<
OUTGET:	MOVE	T1,J$LGNM(J)		;GET GIVEN NAME
	MOVEM	T1,J$LDEV(J)		;SAVE AS REAL NAME
	LSH	T1,6			;SHIFT OFF POSSIBLE "P"
	MOVEM	T1,J$LSDV(J)		;SAVE A SCHEDULING DEVICE
	MOVE	T3,[POINT 6,J$LDEV(J)]	;POINT TO DEVICE NAME
	MOVE	T4,[POINT 7,J$LSTG(J)]	;PLACE TO STORE IT AS A STRING

OUTG.1:	ILDB	T2,T3			;GET A CHARACTER
	JUMPE	T2,OUTG.2		;DONE IT NULL
	ADDI	T2,40			;ELSE CONVERT TO ASCII
	IDPB	T2,T4			;STORE IN STRING
	TLNE	T3,770000		;DONE?
	JRST	OUTG.1			;NO, LOOP
OUTG.2:	MOVEI	T2,":"			;LOAD A COLON
	IDPB	T2,T4			;STORE IT
	MOVEI	T2,0			;LOAD A NULL
	IDPB	T2,T4			;STORE IT TOO
	MOVX	S1,GJ%FOU!GJ%SHT	;LOAD GTJFN FLAGS
	HRROI	S2,J$LSTG(J)		;POINT TO THE STRING
	GTJFN				;AND GET A JFN
	  JRST	OUTG.4			;NO SUCH DEVICE?
	MOVEM	S1,J$LJFN(J)		;WIN, SAVE THE JFN
	MOVX	S2,OF%WR+OF%OFL+7B5	;OPEN FOR WRITING 7 BIT BYTES
	OPENF				;OPEN IT
	  JRST	OUTG.4			;GO HANDLE THE ERROR
	MOVE	S1,J$LBUF(J)		;GET THE BUFFER ADDRESS
	HRLI	S1,(POINT 7,0)		;MAKE A POINTER TO IT
	MOVEM	S1,J$LBPT(J)		;AND SAVE THE POINER
	MOVEM	S1,J$LIBP(J)		;AND AS INITIAL POINTER
	MOVEI	S1,BUFCHR		;LOAD A BYTE COUNT
	MOVEM	S1,J$LBCT(J)		;AND SAVE IT
	MOVEM	S1,J$LIBC(J)		;AND AS INITIAL COUNT
	SETZM	J$LHNG(J)		;CLEAR THE HUNG FLAG
	PUSHJ	P,INTCNL		;CONNECT LPT TO INTERRUPTS
	PUSHJ	P,INTOFF		;CONO PIOFF FOR A SEC
	MOVE	S1,J$LJFN(J)		;GET LPT JFN
	MOVX	S2,.MORST		;GET FUNCTION TO READ STATUS
	MOVEI	T1,T2			;LOAD ADDRESS OF ARG BLOCK
	MOVEI	T2,3			;LOAD LENGTH OF ARG BLOCK
	MTOPR				;GET THE DEVICE STATUS
	ERJMP	OUTG.3			;NONE, JUST RETURN
	TXNE	T3,MO%LCP		;IS IT A LOWER CASE PRINTER?
	SETOM	J$LLCL(J)		;YES, SET THE FLAG
	TXNN	T3,MO%LVU		;IS IT NOT OPTICAL VFU
	SETOM	J$LDVF(J)		;YES, SET THAT
	TXNN	T3,MO%OL		;IS IT OFF LINE?
	JRST	OUTG.3			;NO, CONTINUE
	SETOM	J$LHNG(J)		;YES, SET THE FLAG
	TELL	OPR,%%DOL		;AND TELL THE OPERATOR
OUTG.3:	PJRST	INTON			;CONO PION AND RETURN

OUTG.4:	TELL	OPR,%%DNA		;DEVICE NOT AVAILABLE
	JRST	LPTSPL			;AND RESET EVERYTHING
>  ;END IFN FTJSYS
SUBTTL	OUTOUT  --  Routine to output a buffer

	LOWSEG

IFN FTUUOS,<
OUTOUT:	SKIPE	TTYFLG			;ANY TTY ACTIVITY?
	PUSHJ	P,CHKOPR		;YUP, GO CHECK IT
	PUSHJ	P,OUTWON		;WAIT FOR DEVICE TO COME ON-LINE
	SETOM	J$LIOA(J)		;SET IOACT
	OUT	LPT,			;DUMP THE BUFFER
	  JRST	OUTO.2			;SUCCESS, CLEAN UP AND RETURN
	SETZM	J$LIOA(J)		;CLEAR IOACT
	PJRST	OUTERR			;GO HANDLE THE ERROR

OUTO.2:	SETZM	J$LIOA(J)		;CLEAR IOACT
	SETZM	J$LHNG(J)		;CLEAR THE HUNG FLAG
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
OUTOUT:	SKIPE	TTYFLG			;ANY TTY ACTIVITY?
	PUSHJ	P,CHKOPR		;YES, GO CHECK IT
	PUSH	P,T1			;SAVE T1
	SKIPGE	T1,J$LBCT(J)		;GET # CHARS LEFT
	SETZ	T1,			;IF .LT. 0, MAKE IT 0
	SUB	T1,J$LIBC(J)		;LESS INITIAL YIELD -VE COUNT
	MOVE	S1,J$LJFN(J)		;GET THE JFN
	MOVE	S2,J$LIBP(J)		;GET THE INITIAL BP
	JUMPE	T1,OUTO.1		;JUMP IF NOTHING TO OUTPUT
	SETOM	J$LIOA(J)		;SET I/O ACT
	SOUT				;AND DUMP THE BUFFER
	ERCAL	OUTERR			;GO HANDLE THE ERROR
OUTO.1:	SETZM	J$LIOA(J)		;CLEAR I/O ACT
	MOVEI	S1,BUFCHR		;GET CHARS/BUFFER
	MOVEM	S1,J$LBCT(J)		;SAVE AS BUFFER COUNT
	MOVEM	S1,J$LIBC(J)		;AND AS INITIAL COUNT
	MOVE	S1,J$LBUF(J)		;GET ADDRESS OF BUFFER
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,J$LBPT(J)		;SAVE AS BUFFER POINTER
	MOVEM	S1,J$LIBP(J)		;AND INITIAL POINTER
	POP	P,T1			;RESTORE T1
	POPJ	P,			;AND FINALLY RETURN

;DEBRK TO HERE IF SOUT WAS INTERRUPTED
OUTINT:	MOVEM	S2,J$LIBP(J)		;SAVE THE CURRENT POINTER
	MOVMM	T1,J$LIBC(J)		;SAVE MAGNITUDE OF CHARS LEFT TO PRINT
	SETZM	J$LBCT(J)		;BUFFER IS FULL
	POP	P,T1			;PHASE THE STACK
	JRST	OUTOUT			;AND RESTART THE SOUT
>  ;END IFN FTJSYS
SUBTTL	OUTERR  --  Handle Output Device Errors

IFN FTUUOS,<
OUTERR:	STATZ	LPT,IO.ERR		;SOMETHING'S WRONG
	JRST	OUTE.1			;YES, GIVE THE ERROR
	SKIPE	J$LHNG(J)		;IS THE DEVICE OFF LINE?
	JRST	OUTOUT			;YES, GO BACK AND TRY AGAIN
	PUSH	P,S1			;NO, SAVE S1
	MOVEI	S1,0			;OUTPUT NOT DONE
	PUSHJ	P,SUSPND		;AND WAIT FOR IO DONE
	POP	P,S1			;RESTORE S1
	JRST	OUTOUT			;AND TRY AGAIN

OUTE.1:	PUSHJ	P,.SAVET##		;SAVE SOME AC'S
	GETSTS	LPT,N			;GET ERROR BITS
	TRC	N,IO.ERR		;TEST FOR ALL FOUR ERROR BITS
	TRCE	N,IO.ERR		;BEING SET.
	JRST	OUTE.2			;AND THEY ARE NOT
	MOVE	T1,[2,,T2]		;PREPARE FOR DEVOP. UUO
	MOVEI	T2,.DFRES		;READ EXTENDED ERROR STATUS
	MOVEI	T3,LPT			;GET CHANNEL NUMBER
	DEVOP.	T1,
	  HALT	.
	CAIN	T1,IOVFE%		;VFU ERROR?
	JRST	OUTE.3			;YES
	MOVE	N,T1
OUTE.2:	TELL	OPR,%%ULE		;UNEXPECTED ERROR
	JRST	OUTE.4			;AND GO TELL THE USER

OUTE.3:	TELL	OPR,%%VFE		;TELL OPR WE GOT A VFU ERROR
OUTE.4:	PUSHJ	P,OUTDIE		;SEE IF TOO MANY ERRORS
	GETSTS	LPT,N			;GET I/O STATUS
	TRZ	N,IO.ERR		;CLEAR ERROR FLAGS
	SETSTS	LPT,(N)			;GET RESET THE STATUS
	STAMP	LPMSG
	MOVE	N,J$RNCP(J)		;GET NUMBER OF COPIES PRINTED
	AOS	N			;MAKE INTO CURRENCT COPY NUMBER
	TELL	LOG,%%RLE		;RECOVERABLE LPT ERROR
	STAMP	LPMSG
	TELL	LOG,%%RLE1
	SETZM	J$FLVT(J)		;FORCE A RELOAD
	TXNN	S,DSKOPN		;ARE WE IN A FILE?
	PJRST	LODVFU			;NO, LOAD THE VFU AND RETURN
	PUSHJ	P,CHKSEG		;REMEMBER STATE OF HISEG
	PUSHJ	P,GETSPL		;GET THE HISEG
	MOVEI	N,5			;PREPARE TO BACKSPACE 5 PAGES
	PUSHJ	P,IBACK			;BACKSPACE 5 PAGES
	PJRST	LODVFU			;LOAD THE VFU AND RETURN
>  ;END IFN FTUUOS
IFN FTJSYS,<
OUTERR:	SETZM	J$LIOA(J)		;NO LONGER IOACTIVE
	PUSHJ	P,.SAVET##		;SAVE SOME ACS
	PUSHJ	P,INTOFF		;CONO PIOFF
	MOVE	S1,J$LJFN(J)		;GET LPT JFN
	MOVX	S2,.MORST		;READ STATUS FUNCTION
	MOVEI	T1,T2			;ADDRESS OF AFG BLOCK
	MOVEI	T2,3			;LENGTH OF ARG BLOCK
	SETZ	N,			;IN CASE THE MTOPR FAILS
	MTOPR				;GET THE STATUS
	ERJMP	OUTE.1			;FAIL, DIE
	TXNE	T3,MO%LVF!MO%RLD	;IS IT RECOVERABLE?
	JRST	OUTE.2			;YES, GO HANDLE IT
	MOVE	N,T3			;COPY STATUS OVER FOR MESSAGE
OUTE.1:	TELL	OPR,%%ULE		;UNRECOVERABLE ERROR
	JRST	OUTE.3			;AND CONTINUE

OUTE.2:	SETZM	J$LHNG(J)		;CLEAR "HUNG" FLAG
	TXNE	T3,MO%OL		;IS IT ON-LINE?
	SETOM	J$LHNG(J)		;NO, SET "HUNG" FLAG
	PUSHJ	P,INTON			;TURN PI ON AGAIN
	MOVEI	T1,%%VFE		;ASSUME VFU ERROR
	TXNE	T3,MO%RLD		;RELOAD FRONT END?
	MOVEI	T1,%%FER		;YES, LOAD THAT MSG INSTEAD
	TELL	OPR,(T1)		;AND TELL HIM
OUTE.3:	PUSHJ	P,OUTDIE		;SEE IF TOO MANY ERRORS
	STAMP	LPMSG			;STAMP THE LOG
	MOVE	N,J$RNCP(J)		;GET COPIES PRINTED
	AOS	N			;GET COPY NUMBER
	TELL	LOG,%%RLE		;RECOVERABLE LPT ERROR
	STAMP	LPMSG			;ANOTHER STAMP
	TELL	LOG,%%RLE1		;AND MORE TEXT
	MOVEI	N,5			;LOAD NUMBER OF PAGES
	TXNE	S,DSKOPN		;SKIP THIS IF WE ARE PRINTING HDRS
	PUSHJ	P,IBACK			;TO BACKSPACE
	PJRST	OUTWON			;AND WAIT FOR IT
>  ;END IFN FTJSYS


;HERE TO CHECK FOR TOO MANY LPT ERRORS
OUTDIE:	SOSL	J$LERR(J)		;COUNT DOWN ERRORS
	POPJ	P,			;STILL ALIVE
	TELL	OPR,%%TML		;TOO MANY
	JRST	DOREST			;AND DIE
SUBTTL	OUTWON  --  Wait for on-line

OUTWON:	SKIPN	J$LHNG(J)		;IS IT OFF LINE?
	POPJ	P,			;NO, JUST RETURN
	MOVEI	S1,^D60			;YES, LOAD A WAIT TIME
	PUSHJ	P,SUSPND		;AND WAIT
	PJRST	CHKOPR			;CHECK THE OPR
SUBTTL	OUTEOJ  --  End of job device handling

IFN FTUUOS,<
OUTEOJ:	PUSHJ	P,OUTDMP		;DUMP ALL BUFFERS
	MTEOF.	LPT,			;WRITE A TAPE MARK
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
OUTEOJ:	PUSHJ	P,OUTDMP		;DUMP ALL BUFFERS
	MOVE	S1,J$LJFN(J)		;GET THE JFN
	MOVX	S2,.MOEOF		;GET THE TAPE MARK CODE
	MTOPR				;WRITE A TAPE MARK
	ERJMP	.+1			;IGNORE THE ERROR
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	OUTDMP  --  Dump out buffers and wait

IFN FTUUOS,<
OUTDMP:	PUSHJ	P,OUTOUT		;FORCE THE LAST BUFFER
	MOVEI	S1,LPT			;GET THE CHANNEL
	WAIT	S1,			;WAIT FOR BUFFERS TO EMPTY
	POPJ	P,			;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
OUTDMP:	PUSHJ	P,OUTOUT		;DUMP THE INTERNAL BUFFERS
	MOVE	S1,J$LJFN(J)		;GET THE LPT JFN
	MOVX	S2,.MONOP		;AND NO-OP FUNCTION
	MTOPR				;DO IT
	ERCAL	OUTERR			;I/O ERROR?
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	OUTFLS  --  Flush already buffered output

;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE PRINTER WHICH HAS ALREADY BEEN
;	BUFFERED (AND POSSIBLE SENT TO THE PRINTER).

IFN FTUUOS,<
OUTFLS:	TXC	S,STARTD!BUSY!DSKOPN	;FLIP 3 BITS
	TXCE	S,STARTD!BUSY!DSKOPN	;SEE IF ALL 3 WERE ON
	POPJ	P,			;THEY WEREN'T, RETURN
	MOVEI	S1,LPT			;LOAD THE CHANNEL NUMBER
	RESDV.	S1,			;RESET THE CHANNEL
	  JFCL				;??
	PJRST	OUTGET			;AND REINIT THE LPT
>  ;END IFN FTUUOS

IFN FTJSYS,<
OUTFLS:	TXC	S,STARTD!BUSY!DSKOPN	;FLIP 3 BITS
	TXCE	S,STARTD!BUSY!DSKOPN	;SEE IF ALL 3 WERE ON
	POPJ	P,			;THEY WEREN'T, RETURN
	PUSH	P,T1			;SAVE AN AC
	MOVE	S1,J$LJFN(J)		;GET OUTPUT JFN
	MOVX	S2,.MOFLO		;LOAD FLUSH FUNCTION
	MOVEI	T1,0			;AND ZERO ARGUMENTS
	MTOPR				;AND FLUSH
	POP	P,T1			;RESTORE T1
	MOVE	S1,J$LIBC(J)		;INITIAL WORDS IN BUFFER
	MOVEM	S1,J$LBCT(J)		;RESET BUFFER COUNT
	MOVE	S1,J$LIBP(J)		;GET INITIAL POINTER
	MOVEM	S1,J$LBPT(J)		;AND SAVE IT
	POPJ	P,			;RETURN
>  ;END IFN FTJSYS
SUBTTL LPT CONTROL ROUTINES

	LOWSEG

;CONTROL CHARACTER TABLE
	NCLRFF==(1B0)		;DON'T CLEAR FORMFEED FLAG
	SUPRCH==(1B1)		;SUPPRESSABLE CHARACTER

CHTAB:	XWD	NCLRFF,.POPJ##		;(00) NULL
	EXP	CHKARO			;(01) CONTROL-A
	EXP	CHKARO			;(02) CONTROL-B
	EXP	CHKARO			;(03) CONTROL-C
	EXP	CHKARO			;(04) CONTROL-D
	EXP	CHKARO			;(05) CONTROL-E
	EXP	CHKARO			;(06) CONTROL-F
	EXP	CHKARO			;(07) CONTROL-G
	EXP	CHKARO			;(10) CONTROL-H
	XWD	NCLRFF,DEVOUT		;(11) THIS IS A TAB
	XWD	SUPRCH,DOLF		;(12) THIS IS A LINE FEED
	XWD	SUPRCH+3,DOFRAC		;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
	XWD	SUPRCH+NCLRFF,DOFORM	;(14) THIS IS A FORM-FEED
	XWD	NCLRFF,FIXNBR		;(15) CARRIAGE RETURN
	EXP	CHKARO			;(16) CONTROL-N
	EXP	CHKARO			;(17) CONTROL-O
	XWD	SUPRCH+2,DOFRAC		;(20) THIS SKIPS 1/2 PAGE
	XWD	SUPRCH+30,DOFRAC	;(21) THIS SKIPS 2 LINES (DC1)
	XWD	SUPRCH+20,DOFRAC	;(22) THIS SKIPS 3 LINES (DC2)
	XWD	SUPRCH+1,FIXNBR		;(23) THIS SKIPS 1 LINE (DC3)
	XWD	SUPRCH+6,DOFRAC		;(24) THIS SKIPS 1/6 OF A PAGE (DC4)
	EXP	CHKARO			;(25) CONTROL-U
	EXP	CHKARO			;(26) CONTROL-V
	EXP	CHKARO			;(27) CONTROL-W
	EXP	CHKARO			;(30) CONTROL-X
	EXP	CHKARO			;(31) CONTROL-Y
	EXP	CHKARO			;(32) CONTROL-Z
	EXP	CHKARO			;(33) ESCAPE
	EXP	CHKARO			;(34) CONTROL-\
	EXP	CHKARO			;(35) CONTROL-]
	EXP	CHKARO			;(36) CONTROL-^
	EXP	CHKARO			;(37) CONTROL-_
;FORTRAN CONTROL CHARACTOR TRANSLATION TABLE

DEFINE FORCHR(CHR,TRANS,N),<
	EXP	<CHR>B17+<N>B26+TRANS
>  ;END DEFINE FORCHR

FORTAB:	FORCHR	" ",.CHLFD,1
	FORCHR	"0",.CHLFD,2
	FORCHR	"1",.CHFFD,1
	FORCHR	"2",20,1
	FORCHR	"3",13,1
	FORCHR	"/",24,1
	FORCHR	"*",23,1
	FORCHR	"+",.CHCRT,1
	FORCHR	54,21,1
	FORCHR	"-",.CHLFD,3
	FORCHR	".",22,1
		NFORCH==.-FORTAB
;SUBROUTINE TO SET UP FOR LPTIN AND LPTOUT
;CALL WITH:
;	PUSHJ	P,FILOOUT
;	RETURN HERE
;

FILOUT:	PUSHJ	P,.SAVE3##		;SAVE P1 AND P2
	LOAD	T1,.FPINF(E),FP.FSP	;GET SPACING CODE
	SKIPE	T1			;SKIP IF ZERO
	SOS	T1			; ELSE CONVERT TO # OF LF TO APPEND
	MOVEM	T1,J$XSPC(J)		;AND SAVE IT
	MOVE	T1,J$FLIN(J)		;START AT TOP OF PAGE
	MOVEM	T1,J$XPOS(J)		;SAVE IT
	MOVEI	T1,LPTERR		;NUMBER OF LPT ERROR TO ALLOW
	MOVEM	T1,J$LERR(J)		;SET IT UP
	PUSHJ	P,SETLST		;SET UP TEST
	PUSHJ	P,SETPFT		;SETUP FILE TYPE
	PUSHJ	P,CLRSEG		;CLEAR THE HISEG
	JRST	(T1)			;DISPATCH

;RETURN HERE ON EOF
FILDON:	TXNN	S,FFSEEN		;ARE SER AT THE TOP OF A PAGE?
	AOS	J$APRT(J)		;NO, CHARGE HIM FOR THE REST
	PJRST	GETSPL			;GET THE HISEG AND RETURN
;SUBROUTINE TO COMPILE CODE TO TEST EACH LINE FOR A MATCH AGAINST
; THE /REPORT VALUE.
;CALL WITH:
;	PUSHJ	P,SETLST
;	RETURN HERE
;

	TOPSEG


SETLST:	MOVEI	N,J$XCOD-1(J)	;SET UP PDP TO COMPILED CODE
	SKIPN	.FPFR1(E)	;WAS /REPORT SPECIFIED?
	JRST	STLST3		;NO, ALL LINES MATCH
STLST1:	MOVE	T3,[POINT 6,.FPFR1(E)] ;POINTER TO LIST
	MOVEI	T4,^D12		;ABSOLUTE LIMIT
STLST2:	ILDB	T1,T3		;GET A CHAR
	JUMPE	T1,STLSC	;JUMP IF DONE
	ADDI	T1,"A"-'A'	;CONVERT TO ASCII
	CAIN	T4,^D12		;1ST TIME THRU, WE'VE GOT A CHARACTER
	JRST	STLST4		;YES--CHAR ALRADY IN C
	PUSH	N,SETLSA	;COMPILE A PUSHJ
	PUSH	N,SETLSB	;WE HAVE AN ERROR RETURN THEN
STLST4:	HLL	T1,SETLSC	;PLACE CHAR IN CAIE
	PUSH	N,T1		;COMPILE THE CAIE
	PUSH	N,SETLSD	;COMPILE THE JRST TO FLUSH7
	SOJG	T4,STLST2	;LOOP FOR WHOLE STRING
STLSC:	PUSH	N,SETLSA	;GET NEXT CHAR
	PUSH	N,SETLSB	; FOR TOP LEVEL
STLST3:	PUSH	N,[JRST ASCLIN];MATCH IN ASCII FORMAT
	POPJ	P,		;RETURN


;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA:	PUSHJ	P,DSKIN
SETLSB:	POPJ	P,
SETLSC:	CAIE	C,0
SETLSD:	JRST	FLUSH7


	LOWSEG
SUBTTL	SETPFT  --  Setup file processing type

;CALLED TO DETERMINE WHICH TYPE OF PROCESSING SHOULD BE DONE ON THE
;	INPUT FILE.
;
;RETURNS WITH T1 CONTAINING  ADDRESS OF PROCESSING ROUTINE AS FOLLOWS:
;
;	LPTOCT	<-->	/PRINT:OCTAL
;	LPTCOB	<-->	/FILE:COBOL
;	LPTFOR	<-->	/FILE:FORTRAN /PRINT:(ARROW,ASCII,SUPPRESS)
;	LPTRPT	<-->	/FILE:ASCII /REPORT:XXX /PRINT:(ARROW,ASCII,SUP)
;	LPTASC	<-->	/FILE:ASCII /PRINT:(ARROW,ASCII,SUPPRESS)

;THE DETERMINATION IS DONE IN THE ABOVE ORDER

	TOPSEG				;DO THIS IN THE HISEG

SETPFT:	LOAD	S1,.FPINF(E),FP.FFF	;GET /FILE
	LOAD	S2,.FPINF(E),FP.FPF	;GET /PRINT
	OFF	S,ARROW!SUPRES		;CLEAR SOME INITIAL FLAGS
	ON	S,NEWLIN!FCONV		;AND SET SOME OTHERS

	MOVEI	T1,LPTOCT		;ASSUME /PRINT:OCTAL
	CAIN	S2,%FPLOC		;IS IT?
	POPJ	P,			;YES, RETURN

	MOVEI	T1,LPTCOB		;NO, ASSUME /FILE:COBOL
	CAIN	S1,.FPFCO		;IS IT?
	POPJ	P,			;YES, RETURN

	CAIN	S2,%FPLAR		;/PRINT:ARROW?
	ON	S,ARROW			;YES, LIGHT A FLAG
	CAIN	S2,%FPLSU		;/PRINT:SUPPRESS?
	ON	S,SUPRES		;YES, LIGHT A BIT

	MOVEI	T1,LPTFOR		;ASSUME /FILE:FORTRAN
	CAIN	S1,.FPFFO		;IS IT?
	POPJ	P,			;YES, RETURN

	MOVEI	T1,LPTASC		;ASSUME STANDARD ASCII
	SKIPE	.FPFR1(E)		;UNLESS /REPORT WAS SPECIFIED
	MOVEI	T1,LPTRPT		;USE REPORT ROUTINE
	POPJ	P,			;AND RETURN


	LOWSEG				;BACK DOWN IN LOWSEG
SUBTTL	LPTASC  --  Print Regular ASCII on LPT


IFE FTDPM,<

LPTASC:	SOSG	J$DBCT(J)		;ANYTHING LEFT TO READ IN
	JSP	C,GETMOR		;NO, GET ANOTHER BUFFER
	ILDB	C,J$DBPT(J)		;GET A CHARACTER
	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTA.3			;NO, GO HANDLE SPECIAL CHARS
	OFF	S,FFSEEN		;CLEAR A FLAG
	TXNE	S,NOTYPE		;IS NOTYPE ON?
	JRST	LPTASC			;YES, DON'T TYPE ANYTHING
LPTA.1:	SOSGE	J$LBCT(J)		;ANY ROOM IN BUFFER?
	JRST	LPTA.2			;NO, FILL IT
	IDPB	C,J$LBPT(J)		;YES, DEPOSIT IN BUFFER
	JRST	LPTASC			;AND GET ANOTHER

LPTA.2:	PUSHJ	P,OUTOUT		;GET A BUFFER
	JRST	LPTA.1			;AND LOOP

LPTA.3:	PUSHJ	P,CHKSP			;GO HANDLE SPECIAL CHARS
	JRST	LPTASC			;AND LOOP AROUND

>  	;END IFE FTDPM

	IFN FTDPM,<LPTASC=LPTRPT> 	;DO  IT THE SLOW WAY
SUBTTL	LPTFOR  --  Process FORTRAN data files

LPTFOR:	SOSG	J$DBCT(J)		;AND CHARACTERS LEFT
	JSP	C,GETMOR		;NO, GET MORE DATA
	ILDB	C,J$DBPT(J)		;GET ONE
	JUMPE	C,LPTFOR		;IGNORE NULLS
	TXZE	S,FCONV			;CHECK FOR CTL CHAR
	JRST	FORCNV			;GO DO IT
	CAIN	C,.CHLFD		;LINEFEED?
	TXOA	S,FCONV			;FLAG NEXT CHAR AS CTL CHAR
	PUSHJ	P,LPTOUT		;OTHERWISE PRINT IT
	JRST	LPTFOR			;AND LOOP AROUND AGAIN.

FORCNV:	MOVSI	T1,-NFORCH		;MAKE AN AOBJN POINTER
FORC.1:	HLRZ	T2,FORTAB(T1)		;GET CHAR FROM TABLE
	CAMN	C,T2			;MATCH?
	JRST	FORC.2			;YES, GO TRANSLATE
	AOBJN	T1,FORC.1		;NO, LOOP
	MOVEI	C,.CHLFD		;DIDN'T FIND A MATCH, SO LOAD
	PUSHJ	P,LPTOUT		; A LINEFEED, SEND IT, AND
	JRST	LPTFOR			; CONTINUE ON

FORC.2:	HRRZ	C,FORTAB(T1)		;GET TRANS CHAR AND REPEAT COUNT
	LDB	T1,[POINT 9,C,26] 	;GET REPEAT COUNT IN T1
	MOVEM	T1,RPTCNT		;SAVE AS REPEAT COUNT
	ANDI	C,177			;AND DOWN TO CHARACTER
FORC.3:	PUSHJ	P,LPTOUT		;SEND THE CHARACTER
	SOSG	RPTCNT			;AND LOOP
	JRST	LPTFOR			;AND CONTINUE
	JRST	FORC.3			;ELSE, LOOP
SUBTTL	LPTRPT  --  Process REPORT files

LPTRPT:	SOSG	J$DBCT(J)		;ANYTHING LEFT TO READIN?
	JSP	C,GETMOR		;NO, GET ANOTHER BUFFER FULL
	ILDB	C,J$DBPT(J)		;GET A CHARACTER
	PUSHJ	P,LPTOUT		;DO ALL THE CHECKING
	JRST	LPTRPT			;AND GET ANOTHER
SUBTTL	LPTOCT  --  Give an Octal Dump

LPTOCT:	LOAD	T1,.FPINF(E),FP.FSP	;GET THE SPACING CODE
	CAIE	T1,1			;SINGLE SPACE?
	SKIPA	P2,[22,,1]		;NO--THEN TRIPLE SPACE, DOUBLE SPACE
					;IS UGLY --DO NOT ALLOW IT
	MOVE	P2,[12,,3]		;SINGLE SPACE THE LISTING
OCT1:	MOVEI	T1,(P2)			;BLOCK PER PAGE
OCT2:	MOVEI	T2,^D16			;LINES PER BLOCK
OCT3:	MOVEI	T3,^D8			;WORDS PER LINE
	MOVE	P1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIN	P1,2			;IS IT 2?
	MOVEI	T3,4			;YES, USE 4 WORDS/LINE
	CAIN	P1,1			;IS IT 1?
	MOVEI	T3,2			;YES, USE 2 WORDS/LINE
OCT4:	MOVEI	T4,^D12			;DIGITS PER WORD
	MOVEI	C," "			;EACH WORD BEGINS WITH 3 BLANKS
	PUSHJ	P,DEVOUT		;ONE
	PUSHJ	P,DEVOUT		;TWO
	PUSHJ	P,DEVOUT		;THREE
	PUSHJ	P,DSKIN			;GET THE NEXT WORD
	  JRST	FILDON			;DONE!!
	MOVE	N,C			;COPY WORD
	OFF	S,FFSEEN		;FLAG MIDDLE OF FORM
	MOVE	P1,[POINT 3,N]		;LOAD BYTE POINTER
OCT5:	ILDB	C,P1			;GET NEXT DIGIT
	MOVEI	C,60(C)			;MAKE ASCII
	PUSHJ	P,DEVOUT		;PRINT CHAR
	SOJG	T4,OCT5			;END OF WORD?
	SOJG	T3,OCT4			;END OF LINE?
	HLRZ	C,P2			;GET MOTION CHARACTER
	PUSHJ	P,DEVOUT		; ..
	SOJG	T2,OCT3			;END OF BLOCK?
	PUSHJ	P,DEVOUT		;YES--2 EXTRA LINE FEEDS
	PUSHJ	P,DEVOUT		; ..
	SOJG	T1,OCT2			;END OF PAGE?
	MOVEI	C,14			;PRINT A FORM FEED
	ON	S,FFSEEN		;FLAG TOP OF FORM
	AOS	J$APRT(J)		;COUNT 1 PAGE AGAINST QUOTA
	PUSHJ	P,FIXQTA		; ..
	JRST	OCT1			;PRINT NEXT PAGE
SUBTTL	LPTCOB  --  Process COBOL Sixbit Files

LPTCOB:	OFF	S,FFSEEN		;CAUSE A FORM FEED AT END
	PUSHJ	P,DSKIN			;GET THE FIRST WORD OF THE FILE
	  JRST	FILDON			;NULL FILE
	HLRZ	T1,C			;COPY THE FIRST 3 LETERS
	CAIE	T1,'HDR'		;IS IT A HDR
	JRST	COBOL4			;NO--NORMAL INPUT
	MOVEI	T1,15			;FLUSH TAPE HEADER
	PUSHJ	P,DSKIN			;GET A WORD
	  JRST	FILDON			;EOF
	SOJG	T1,.-2			;LOOP FOR MORE
COBOL1:	PUSHJ	P,DSKIN			;GET A WORD
	  JRST	FILDON			;TEH LAST WORD HAS COME
COBOL4:	ANDI	C,7777				;MASK TO 12 BITS
IFN FTUUOS,<  ;[2273]
	JUMPLE	C,COBOL5		;IGNORE 0 COUNTS FOR OBVIOUS REASON
>  ;END IFN FTUUOS
IFN FTJSYS,<
	JUMPLE	C,COBOL1		;SKIP THIS WORD IF 0
>  ;END IFN FTJSYS
	MOVEI	P1,(C)			;COPY THE COUNT

	MOVEI	P2,-1(P1)		;GET COUNT-1 IN P2
	SUB	P2,J$FWID(J)		;ROUND DOWN TO A LINE
	IDIV	P2,J$FWID(J)		;CONVERT TO # LINES
	MOVNS	P2			;NEGATE IT
	ADDM	P2,J$XPOS(J)		;AND DECREMENT POSITION

COBOL2:	PUSHJ	P,DSKIN			;GET A DATA WORD
	  JRST	FILDON			;END OF FILE-- ACTUALY THIS SHOULD
					; NEVER HAPPEN SINCE THE COUNT IS EXACT.
	MOVEI	T1,6			;CHARS PER WORD.
	CAIG	P1,6			;ARE WE DOWN TO LAST DREGS?
	MOVEI	T1,(P1)			;YES--USE EXACT COUNT TO AVOID FREE
					; CRLF ON EXTRA BLANKS.
	MOVE	N,C			;COPY WORD
	MOVE	P2,[POINT 6,N]		;POINT TO WORD
COBOL3:	ILDB	C,P2			;AND GET THE CHARACTER
	MOVEI	C,40(C)			;MAKE ASCII
	PUSHJ	P,DEVOUT		;PRINT
	SOJG	T1,COBOL3		;LOOP FOR NEXT CHAR
	SUBI	P1,6			;COUNT 6 MORE CHARS
	JUMPG	P1,COBOL2		;GET MORE
	MOVEI	C,.CHCRT		;LOAD A CARRIAGE RETURN
	PUSHJ	P,DEVOUT		;PRINT IT
	MOVEI	C,.CHLFD		;LOAD A LINE FEED
	PUSHJ	P,DOLF			;AND SEND EOL
	JRST	COBOL1			;LOOP FOR MORE.
COBOL5:	PUSHJ	P,FILL			;SKIP TO NEXT RECORD FOR ISAM
	  JRST	FILDON			;END OF FILE
	AOS	J$DBCT(J)		;WILL BE RESET BY SOSLE AT DSKIN:
	JRST	COBOL1			;LOOP FOR NEXT RECORD
SUBTTL	Character Interrogation Routines

;SUBROUTINE TO PLACE A CHAR ON THE LINE PRINTER
;CALL WITH:
;	PUSHJ	P,LPTOUT
;	RETURN HERE (EOF SET IF OVER LIMIT)
;
ASCLIN:	PUSHJ	P,ISEOL			;END OF LINE?
	  JRST	.+2			;NO--SKIPA
	ON	S,NEWLIN		;YES--LOOK FOR CODE
LPTOUT:	CAIGE	C,40			;VISABLE ASCII
	JRST	CHKSP			;NO--SEE IF SPACE
LPTOU1:	TXZE	S,NEWLIN		;AND THIS IS A NEW LINE
	JRST	J$XCOD(J)		;SEE IF REPORT LINE MATCHES
	OFF	S,FFSEEN		;CLEAR FORM FEED FLAG
	PJRST	DEVOUT			;PRINT IT

CHKSP:	MOVE	N,CHTAB(C)		;GET THE DISPATCH
	TLNN	N,NCLRFF		;CLEAR FORMFEED FLAG?
	OFF	S,FFSEEN		;YES
	TXNE	S,SUPRES		;IN SUPPRESS MODE?
	TLNN	N,SUPRCH		;YES, IS THIS CHARACTER SUPPRESSABLE?
	JRST	(N)			;DISPATCH THE CHARACTER NORMALLY
	JRST	DOSUP			;SUPPRESS THE CHARACTER



;ROUTINE TO GET THE NEXT BUFFER FULL OF DATA FROM THE INPUT FILE.
;CALL WITH:
;	JSP  C,GETMOR
;	   RETURN HERE IF MORE DATA AVAILABLE
;
;	BRANCHES TO FILDON AT EOF

GETMOR:	PUSH	P,C			;SAVE THE RETURN ADDRESS
	PUSHJ	P,FILL			;GET A BUFFER FULL
	  SKIPA				;EOF!!
	POPJ	P,			;RETURN
	POP	P,C			;RESTORE C
	JRST	FILDON			;AND FINISH UP
;HERE TO THROW AWAY A LINE

FLUSH7:	PUSHJ	P,DSKIN		;GET A BYTE
	  POPJ	P,		;EOF, RETURN
	PUSHJ	P,ISEOL		;END OF LINE?
	  JRST	FLUSH7		;NO--LOOP FOR REST OF LINE
FLUSH8:	PUSHJ	P,DSKIN		;GET A BYTE
	  POPJ	P,		;EOF, DONE
	PUSHJ	P,ISEOL		;GOT EOL CHARACTER?
	  JRST	J$XCOD(J)	;NO, BEGINNING A NEW LINE
	JRST	FLUSH8		;YES, LOOP AGAIN


ISEOL:	CAIL	C,12		;C .GT. 12?
	CAILE	C,24		;C .GT. 24?
	POPJ	P,		;NO--NOT END OF LINE
	CAILE	C,15		;C .LE. 15?
	CAIL	C,20		;C .GE. 20?
	AOS	(P)		;YES--CAUSE SKIP RETURN
	POPJ	P,		;NO--PLAIN RETURN
;HERE ON A LINE FEED
DOLF:	MOVE	T1,J$XSPC(J)	;NUMBER OF ADDITIONAL LINE FEEDS
	SETO	N,		;START WITH 1 LINE
DOLF1:	SOJL	T1,CNTDWN	;ANY MORE?
	MOVEI	C,.CHLFD	;LOAD A LINE-FEED
	PUSHJ	P,DEVOUT	;YES--GIVE IT
	SOJA	N,DOLF1		;AND SUBTRACT FROM QUOTA

;HERE TO PROCESS A FORM FEED
DOFORM:	TXOE	S,FFSEEN
	POPJ	P,		;DO NOT PRINT BLANK PAGES
	MOVN	N,J$XPOS(J)	;THIS TAKES ALL WE HAVE ON PAGE
	SKIPL	N		;WAS VPOS NEGATIVE?
	CLEAR	N,		;DONT CHARGE FOR ANYTHING THEN.
				;THIS MIGHT GIVE THE USER A
				;BONUS OF 1-3 FREE LINES.
	JRST	CNTDWN		;COUNT DOWN THE LIMIT

;HERE IF /PRINT:SUPPRESS
DOSUP:	MOVEI	C,.CHLFD	;MAKE IT A LINEFEED, REGARDLESS
	TXOE	S,FFSEEN
	POPJ	P,		;ONLY 1 LINE FEED IN A ROW
	SETO	N,
	JRST	CNTDWN		;CHARGE FOR THE LINE

;HERE TO DO ARROW MODE STUFF IF NEEDED
CHKARO:	TXNN	S,ARROW		;ARROW MODE?
	JRST	DEVOUT		;NO--JUST PRINT
DOARO:	PUSH	P,C		;SAVE C
	MOVEI	C,"^"		;LOAD A ^
	PUSHJ	P,DEVOUT	;PRINT THE ^
	POP	P,C		;RESTORE C
	MOVEI	C,100(C)	;MAKE INTO REAL LETTER
	PJRST	DEVOUT		;PRINT

;HERE IF SPECIAL CHAR MOVES A FIXED # OF LINES (EXCEPT LINE FEED)
FIXNBR:	HLRZS	N		;GET 0,,NUMBER OF LINES
	ANDI	N,777		;AND OUT FLAGS
	MOVNI	N,(N)		;MAKE -VE SO WE CAN DO ADDM'S
	JRST	CNTDWN		;AND COUNT THEM DOWN

;HERE IF SPECIAL CHARACTER SKIPS A FRACTION OF A PAGE
DOFRAC:	HLRZS	N		;GET 0,,FRACTION
	ANDI	N,777		;AND OUT FLAGS
	MOVE	T1,J$FLIN(J)	;GET CURRENT PAGE SIZE
	IDIVI	T1,(N)		;FIND THE RIGHT PART
	MOVE	T2,J$XPOS(J)	;GET CURRENT POSITION
	JUMPLE	T2,[MOVN N,J$XPOS(J)	;COPY VPOS
		    SUBI N,3	;SUBTRACT 3
		    JRST CNTDWN];AND CHARGE HIM
	IDIVI	T2,(T1)		;GET RESIDUE MOD SKIPSIZE
	MOVN	N,T3		;AND MAKE IT NEGATIVE
	JRST	CNTDWN		;GO CHECK QUOTA
;HERE TO ADJUST QUOTA
CNTDWN:	ON	S,NEWLIN		;SET NEWLINE FLAG
	ADDB	N,J$XPOS(J)		;REDUCE VERTICAL POSITION
	PJUMPG	N,DEVOUT		;JUMP IF STILL ON PAGE
	CAIN	C,23			;WAS IT A DC3?
	CAMG	N,[-3]			;YES, GIVE HIM 3 EXTRA LINES
	JRST	CNTDW1			;OFF PAGE ANYWAY
	PJRST	DEVOUT			;HE WINS!!

CNTDW1:	MOVE	N,J$FLIN(J)		;BACK TO TOP OF PAGE
	MOVEM	N,J$XPOS(J)		;SAVE POSITION
	AOS	J$APRT(J)		;ONE MORE PRINTED
	AOS	T1,J$RNPP(J)		;GET PAGE NUMBER
IFN FTUUOS,< 
	IDIVI	T1,TABSIZ		;MOD TABSIZ  IN T2
	ADD	T2,J			;POINT INTO JOB-INFO PAGE
	HRRZ	T1,J$DINF(J)		;GET DISK BLOCK NUMBER
	MOVEM	T1,J$XPTB(T2)		;AND SAVE IT
	MOVE	T1,J$DBCT(J)		;GET BYTE COUNT
	HRLM	T1,J$XPTB(T2)		;SAVE OFFSET INTO BLOCK
>  ;END IFN FTUUOS
	MOVEI	N,3			;LOAD A 3
	CAIN	C,23			;GET HERE VIA DC3?
	ADDM	N,J$XPOS(J)		;YES, GIVE HIM 3 XTRA LINES
	TXNN	S,NOTYPE		;IS BACKSPACE OR FORWARD IN PROGRESS?
	JRST	FIXQTA			;NO, SKIP DESTINATION CHECK
	MOVEI	C,.CHFFD		;LOAD A FORM-FEED
	MOVE	T1,J$RNPP(J)		;GET THE PAGE NUMBER
	CAME	T1,J$XDPG(J)		;HAVE WE HIT DESTINATION?
	JRST	FIXQTA			;NO, CONTINUE ON
	OFF	S,NOTYPE		;YES, START PRINTING AGAIN
	PUSHJ	P,TAKCHK		;BUT TAKE A CHECKPOINT FIRST
FIXQTA:	MOVE	N,J$RLIM(J)		;GET LIMIT
	SUB	N,J$APRT(J)		;GET AMOUNT PRINTED
	JUMPL	N,XCEED			;THAT DOES IT
	PJRST	DEVOUT			;AND PRINT THE POOR CHARACTER


;SENDFF - ROUTINE TO SEND A FF IF FFSEEN IS OFF
;
SENDFF:	MOVEI	C,.CHFFD		;LOAD A FF
	TXON	S,FFSEEN		;IS FFSEEN ON?
	PUSHJ	P,DEVOUT		;NO, SEND IT
	POPJ	P,			;RETURN
;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
;	PUSHJ	P,DEVOUT
;	RETURN HERE (HALTS IF ERROR)
;
	LOWSEG

DEVOUT:	TXNE	S,NOTYPE		;IS NOTYPE ON?
	POPJ	P,			;YES, JUST RETURN
DEVO.1:	SOSGE	J$LBCT(J)		;DECREMENT THE BYTE COUT
	JRST	DEVO.2			;LOSE, GO DUMP THE BUFFER
	IDPB	C,J$LBPT(J)		;DEPOSIT A BYTE
IFN FTDPM,<
	SKIPGE	J$XHIP(J)		;HEADER IN PROGRESS?
	POPJ	P,			;YES, JUST RETURN
	CAIG	C,24			;IS IT BETWEEN 
	CAIGE	C,12			; 12 AND 24?
	POPJ	P,			;NO, RETURN
	PJRST	OUTOUT			;YES, DUMP IT
>  ;END IFN FTDPM
	POPJ	P,			;RETURN

DEVO.2:	PUSHJ	P,OUTOUT		;DUMP THE BUFFER
	JRST	DEVO.1			;AND TRY AGAIN

;HERE WHEN USER IS OVER HIS PRINT OUT QUOTA

XCEED:	TELL	USR,CRLF		;GIVE A CRLF
	TELL	USR,CRLF		;AND ANOTHER
	STAMP	LPERR			;GIVE A STAMP
	TELL	USR!LOG,%%PLE		;INFORM EVERYONE
	SKIPE	MSGERR			;TELL OPR?
	TELL	OPR,%%PLE		;YES
	ON	S,ABORT			;HE HAS LOST
	PJRST	SETEOF			;FORCE AN EOF AND RETURN
SUBTTL	ROUTINES TO GENERATE HEADERS AND TRAILERS

	;JOB HEADERS AND TRAILERS
	TOPSEG
JOBTRL:	TXZN	S,BANDUN		;HAVE WE PRINTED A BANNER?
	POPJ	P,			;NO, JUST RETURN
	MOVEI	T4,TRLMSG		;ADDRESS OF END TEXT
	TXZE	S,RQB			;CLEAR REQUE AND SKIP IF NOT SET
	MOVEI	T4,[ASCIZ /*REQUEUE*/] 	;SAY SO
	PUSHJ	P,GIVHDR		;GO SETUP THE LINE
	JRST	TRAILR			;AND NOW GO PRINT THE TRAILER

JOBHDR:	MOVEI	T4,LPTERR		;ALLOW FOR LPT ERRORS HERE
	MOVEM	T4,J$LERR(J)		;STORE COUNTER
	ON	S,BANDUN		;HEADER SEQUENCE HAPPENED
	MOVEI	T4,HDRMSG		;ADDRESS OF START TEXT
	PUSHJ	P,GIVHDR		;GO SET THE LINE
	JRST	BANNER			;AND GO PRINT THE BANNER PAGES

GIVHDR:	MOVE	T3,J$FWCL(J)		;LOAD THE WIDTH CLASS
	PUSH	P,J$LBPT(J)		;SAVE BYTE POINTER
	PUSH	P,J$LBCT(J)		;SAVE REAL COUNT
	SETOM	J$XHIP(J)		;SET HEADER IN PROGRESS
	MOVE	T1,[POINT 7,J$XHBF(J)]
	MOVEM	T1,J$LBPT(J)		;AND SETUP A DUMMY BYTE-POINTER
	MOVEI	T1,^D1000
	MOVEM	T1,J$LBCT(J)		;PREVENT AN OUTPUT
	TELLN	USR,(T4)		;PRINT THE RIGHT THING
	MOVE	T1,.EQJOB(J)		;LOAD THE JOB NAME
	TELL	USR,JBHDR1		;TYPE USER ID AND JOB NAME
	LOAD	N,.EQSEQ(J),EQ.SEQ 	;GET THE SEQUENCE NUMBER
	TELL	USR,JBHDR4		;YES PRINT IT
	CAIN	T3,1			;IS IT WIDTH CLASS 1?
	TELL	USR,CRDC3		;YES, GIVE A CRLF
	TELL	USR,JBHDR5		;PRINT THE DATE
	CAIN	T3,2			;IS IT WIDTH CLASS2?
	TELL	USR,CRDC3		;YES, GIVE A CRLF
	TELL	USR,JBHDR8		;TYPE "MONITOR"
	TELLN	USR,LPCNF		;PRINT THE MONITOR NAME
	TELLN	USR,(T4)		;PRINT A WORD
	SETZ	T1,			;MAKE SURE THAT THERE
	IDPB	T1,J$LBPT(J)		; IS A NULL AT THE END
	POP	P,J$LBCT(J)		;RESTORE THE REAL
	POP	P,J$LBPT(J)		; HEADER
	CLEARM	J$XHIP(J)		;CLEAR HEADER IN PROGRESS FLAG
	POPJ	P,			;AND RETURN
SUBTTL	BANNER  --  Routine to print a banner

BANNER:	PUSHJ	P,.SAVE3##		;SAVE P1 THRU P3
	SKIPN	P3,J$FBAN(J)		;GET NUMBER OF BANNER PAGES
	POPJ	P,			;RETURN WHEN DONE
	PUSHJ	P,BNUNAM		;SETUP THE USER NAME

BANN.1:	PUSHJ	P,SENDFF		;SEND A FORM FEED
	SETZM	J$XPOS(J)		;AND SET 0 POSITION
	MOVEI	T1,2			;LOAD AN OFFSET
	CAIN	P3,1			;IS THIS THE LAST BANNER?
	ADDM	T1,J$XPOS(J)		;YES, DON'T PRINT OVER CREASE
	PUSHJ	P,BANN.2		;PRINT A BANNER PAGE
	SOJG	P3,BANN.1		;AND LOOP
	POPJ	P,			;RETURN

BANN.2:	PUSHJ	P,PLPBUF		;PRINT A LINE
	PUSHJ	P,PLPBUF		;PRINT ANOTHER LINE
	TELL	USR,CRDC3		;ONE BLANK
	MOVEI	P1,J$XHUN(J)		;POINT TO THE BLOCK
	HRL	P1,J$XHUW(J)		;AND THE NUMBER OF WORDS
	MOVEI	P2,1			;GET THE BLOCKSIZE
	PUSHJ	P,PPICT			;PRINT A PICTURE
	TELL	USR,CRDC3		;A BLANK
	TELL	USR,CRDC3		;ANOTHER BLANK
	MOVEI	T1,3			;COUNT'EM
	ADDM	T1,J$XPOS(J)		;...
	SKIPN	.EQNOT(J)		;IS THERE A NOTE?
	PJRST	PLINES			;NO, SKIP TO END OF PAGE AND RTN
	PUSHJ	P,PLPBUF		;PRINT A LINE
	PUSHJ	P,PLPBUF		;AND ANOTHER
	PUSHJ	P,PLPBUF		;AND A THIRD
	PUSHJ	P,PLPBUF		;AND A FOURTH
	MOVX	T1,'NOTE: '		;LOAD THE TITLE
	MOVEM	T1,J$XHNO(J)		;SAVE IT
	DMOVE	T1,.EQNOT(J)		;GET THE NOTE
	DMOVEM	T1,J$XHNO+1(J)		;STORE IT
	MOVEI	P1,J$XHNO(J)		;POINT TO THE BLOCK
	HRLI	P1,3			;AND THE NUMBER OF WORDS
	MOVEI	P2,1			;AND THE BLOCKSIZE
	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIE	S1,3			;IS IT 3?
	ADD	P1,[-1,,1]		;NO, RE-ADJUST THE POINTER
	PUSHJ	P,PPICT			;AND PRINT A PICTURE
	PJRST	PLINES			;GO TO EOP AND RETURN
;HERE TO FORMAT THE USER NAME

IFN FTUUOS,<
BNUNAM:	DMOVE	S1,.EQUSR(J)		;GET USER NAME
	DMOVEM	S1,J$XHUN(J)		;SAVE IT
	MOVEI	T1,2			;ASSUME 2 WORDS
	SKIPN	S2			;UNLESS THE SECOND WORD IS NULL
	MOVEI	T1,1			;THEN 1 WORD
	MOVEM	T1,J$XHUW(J)		;SAVE IT
	POPJ	P,			;RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
BNUNAM:	SETZB	S1,S2			;CLEAR S1 AND S2
	DMOVEM	S1,J$XHUN(J)		;CLEAR 2 WORDS IN BLOCK
	MOVEM	S1,J$XHUN+2(J)		;AND CLEAR THE 3RD WORD
	MOVE	S1,[POINT 7,.EQOWN(J)]	;POINT TO OWNER'S NAME
	MOVE	S2,[POINT 6,J$XHUN(J)]	;AND THE DESTINATION
	MOVEI	T1,0			;AND CLEAR A COUNTER

BNUN.1:	ILDB	T2,S1			;GET A CHARACTER
	JUMPE	T2,BNUN.2		;DONE ON NULL
	CAILE	T2,"_"			;IS IT LOWER CASE?
	SUBI	T2,40			;YES, MAKE IT UPPER
	SUBI	T2,40			;ESLE, CONVERT TO 6BIT
	SKIPGE	T2			;MAKE SURE ITS OK
	MOVEI	T2,0			;ELSE MAKE IT A SPACE
	IDPB	T2,S2			;STORE IT
	CAIGE	T1,^D17			;CHECK FOR MAX
	AOJA	T1,BNUN.1		;AND LOOP

BNUN.2:	MOVE	T2,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIE	T2,3			;IS IT 3?
	CAIG	T1,^D10			;NO, SO IF GT 10 CHARS
	SKIPA
	MOVEI	T1,^D10			;MAKE IT 10 CHARS
	MOVE	T3,T1			;GET NUMBER CHARS
	ADDI	T3,5			;ROUND UP
	IDIVI	T3,6			;CONVERT TO WORDS
	MOVEM	T3,J$XHUW(J)		;AND SAVE IT
	POPJ	P,			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	TRAILR  --  Routine to Print a Trailer

TRAILR:	PUSHJ	P,.SAVE3##		;SAVE P1 - P3
	MOVE	P3,J$FTRA(J)		;AND THE NUMBER OF TRAILERS
	PJUMPE	P3,OUTEOJ		;RETURN IF ZERO

TRAI.1:	PUSHJ	P,SENDFF		;SEND A FORMFEED
	SETZM	J$XPOS(J)		;CLEAR THE VERTICAL POSITION
	PUSHJ	P,TRAI.3		;PRINT THE INTERNAL LOG
	PUSHJ	P,PLINES		;PRINT TILL END OF PAGE
	SOJG	P3,TRAI.1		;LOOP UNTIL DONE
	PJRST	OUTEOJ			;AND DUMP BUFFERS AND RETURN

;HERE TO PRINT THE INTERNAL LOG
TRAI.3:	SKIPN	J$GNLN(J)		;ANYTHING IN THE INTERNAL LOG?
	POPJ	P,			;NO, RETURN
	PUSHJ	P,PLPBUF		;YES, PRINT A LINE
	PUSHJ	P,PLPBUF		;AND ANOTHER LINE
	MOVEI	C,.CHTAB		;LOAD A TAB
	MOVE	T1,J$FWCL(J)		;GET THE WIDTH CLASS
	PUSHJ	P,DEVOUT		;PRINT A TAB
	SOJG	T1,.-1			;PRINT N OF THEM
	TELLN	USR,[ASCIZ /* * * L P T S P L  R u n  L o g * * */]
	TELL	USR,CRDC3		;AND AN EOL
	TELL	USR,CRDC3		;AND ANOTHER EOL
	MOVEI	T1,0			;LOAD A NULL
	IDPB	T1,J$GIBP(J)		;AND TERMINATE THE STRING
	MOVE	T2,J			;COPY OVER J
	MOVE	T3,J$GINP(J)		;GET NUMBER OF PAGES
TRAI.4:	MOVE	T1,J$GBUF(T2)		;GET ADR OF BUFFER
	TELLN	USR,(T1)		;PRINT IT
	SOSLE	T3			;DECREMENT COUNT
	AOJA	T2,TRAI.4		;AND LOOP IF NOT DONE
	TELL	USR,CRDC3		;AND A BLANK LINE
	TELL	USR,CRDC3		;AND ANOTHER ONE
	TELL	USR,CRDC3		;AND ANOTHER
	MOVE	T1,J$GNLN(J)		;GET NUMBER OF LOG LINES
	ADDI	T1,5			;AND IN THE OVERHEAD
	ADDB	T1,J$XPOS(J)		;AND ACCUMULATE VERTICAL POSITION

	IDIV	T1,J$FLIN(J)		;DID WE OVERFLW A PAGE?
	PJUMPE	T1,.POPJ##		;RETURN IF NOT
	MOVEM	T1,J$XPOS(J)		;ELSE, SAVE CURRENT POSITION
	SETZM	J$GNLN(J)		;AND DON'T PRINT IT AGAIN
	SOJA	P3,.POPJ##		;AND RETURN
;UTILITY ROUTINES

PLPBUF:	TELLN	USR,J$XHBF(J)	;SEND A LINE
	MOVE	T4,J$FWCL(J)	;GET THE WIDTH CLASS
	CAIN	T4,3		;IS IT 3?
	TELL	USR,[BYTE (7)15,23,0]
	TELL	USR,[BYTE (7)15,23,23,23,0]
	MOVEI	T4,4		;WE PRINT 4 LINES
	ADDM	T4,J$XPOS(J)	;ADD TO COUNT
	POPJ	P,


PPICT:	MOVEI	T4,^D18		;GET A LINE COUNT
	CAIN	P2,1		;IS IT BLOCKSIZE = 1?
	MOVEI	T4,^D11		; THEN ITS ONLY 11 LINES
	ADDM	T4,J$XPOS(J)	;INCREMENT LINE COUNT
	PJRST	PICTURE		;AND PRINT THE PICTURE


PLINES:	MOVE	T2,J$FLIN(J)		;GET LINES/PAGE
	ADDI	T2,2			;ACCOUNT FOR MARGIN
	SUB	T2,J$XPOS(J)		;SUBTRACT AMOUNT PRINTED
	JUMPLE	T2,PEOP			;JUMP IF DONE
	IDIVI	T2,4			;ELSE GET NUMBER OF LINES TO PRINT
PLINE1:	SOJL	T2,PEOP			;JUMP IF DONE
	PUSHJ	P,PLPBUF		;PRINT A LINE (4 LINES)
	JRST	PLINE1			;AND LOOP

PEOP:	MOVE	T2,J$FLIN(J)	;GET NUMBER OF LINES/PAGE
	SUB	T2,J$XPOS(J)	;SUBTRACT THOSE PRINTED
	ADDI	T2,1		;COUNT THE MARGIN
PEOP1:	JUMPLE	T2,PEOP2	;GO FINISH OFF
	TELL	USR,[BYTE(7)15,23,0]
	SOJA	T2,PEOP1	;AND LOOP
PEOP2:	TELL	USR,STARS	;PRINT THE STARS
	POPJ	P,		;AND RETURN
SUBTTL	HEAD  --  Generate File-header pages

HEAD:	PUSHJ	P,.SAVE3##		;SAVE SOME ACS
	PUSHJ	P,SENDFF		;SEND A FORMFEED
	LOAD	P1,.FPINF(E),FP.NFH	;GET THE NO HEADER BIT
	SKIPN	P1			;SKIP IF WE DON'T WANT HEADERS
	SKIPN	P3,J$FHEA(J)		;GET NUMBER OF PICTURE PAGES
	POPJ	P,			;RETURN
	PUSHJ	P,.+3			;PRINT THE HEADER
	SOJG	P3,.-1			;LOOP FOR THE WHOLE WORKS
	POPJ	P,			;RETURN

	MOVEI	P1,J$DRNM(J)		;GET ADR OF REF NAME
	HRLI	P1,2			;GET NUMBER OF WORDS
	MOVE	P2,J$DRBS(J)		;LOAD THE BLOCKSIZE
	PUSHJ	P,PICTURE		;AND DO THE FILE NAME
	MOVEI	P1,J$DREX(J)		;GET ADR OF REF EXT
	HRLI	P1,2			;NUMBER OF WORDS
	MOVE	P2,J$DRBS(J)		;AND THE BLOCKSIZE
	PUSHJ	P,PICTURE		;AND DO THE EXTENSION
RHEAD:	TELLN	USR,J$XHBF(J)		; ..
	TELL	USR,CRLF		; ..
	MOVE	P1,J$FWCL(J)		;LOAD THE WIDTH CLASS

	TELL	USR,[ASCIZ /File: ^ Created: /]


IFN FTUUOS,<
	MOVE	T1,J$DUUO+.RBTIM(J)	;GET CREATION TIME
>  ;END IFN FTUUOS
IFN FTJSYS,<
	MOVE	T1,J$DFDB+.FBCRV(J)	;GET CREATION DATE OF FILE
>  ;END IFN FTJSYS
	PUSHJ	P,PRDTA			;AND PRINT IT

	CAIE	P1,3			;WIDTH CLASS 3?
	TELL	USR,[BYTE (7) 15,12,11,0]	;NO
IFN FTJSYS,<
	SKIPE	J$DRMS(J)		;IS IT AN RMS FILE?
	TELL	USR,[ASCIZ / (RMS Format File) /]
>  ;END IFN FTJSYS

	TELL	USR,[ASCIZ / Printed: @
/]
	TELL	USR,[ASCIZ .QUEUE Switches: .]
	LOAD	T2,.FPINF(E),FP.FPF		;GET PAPER FORMAT
	MOVE	T1,FMTAB-1(T2)			;GET THE WORD
	SKIPE	T2				;DONT PRINT IF FORCED TO BE NULL
	TELL	USR,[ASCIZ . /PRINT:+.]
	LOAD	T2,.FPINF(E),FP.FFF		;GET FILE FORMAT
	MOVE	T1,FFMTAB-1(T2)			;GET THE WORD
	SKIPE	T2				;SKIP IF NULL /FILE:
	TELL	USR,[ASCIZ . /FILE:+ .]
	LOAD	N,.FPINF(E),FP.FCY		;GET NUMBER OF COPIES
	TELL	USR,[ASCIZ ./COPIES:# .]
	CAIE	P1,3				;WIDTH CLASS 3?
	TELL	USR,[BYTE (7) 15,12,11,0]  		;NO
	LOAD	N,.FPINF(E),FP.FSP		;GET THE SPACING
	TELL	USR,[ASCIZ ./SPACING:# .]
	MOVE	N,J$RLIM(J)			;GET HIS LIMIT
	TELL	USR,[ASCIZ ./LIMIT:# .] 
	MOVE	T1,J$FORM(J)			;GET FORMS TYPE
	TELL	USR,[ASCIZ ./FORMS:+
.]

	LOAD	T1,.FPINF(E),FP.DEL		;GET DELETE BIT
	SKIPE	T1				;DELETE FILE?
	TELL	USR,[ASCIZ /
File: ^ will be DELETED after printing
/]

	MOVE	N,J$XPG1(J)		;GET STARTING PAGE
	SOJLE	N,SENDFF		;JUST RETURN IF 0 OR 1
	ADDI	N,1			;RESTORE THE NUMBER
	TELL	USR,[ASCIZ /
*****Printing will start at page # *****
/]
	PJRST	SENDFF			;SEND A FORM FEED


FMTAB:	SIXBIT	/ARROW/
	SIXBIT	/ASCII/
	SIXBIT	/OCTAL/
	SIXBIT	/SUPRES/

FFMTAB:	SIXBIT	/ASCII/
	SIXBIT	/FORT/
	SIXBIT	/COBOL/
SUBTTL	PICTUR  --  Routine to print block letters

;SUBROUTINE TO PRINT BLOCK LETTERS
;CALL WITH:
;	MOVE	P1,[XWD # WORDS,ADR OF FIRST WORD]
;	MOVEI	P2,BLOCKSIZE OF CHARACTER
;	PUSHJ	P,PICTUR
;	RETURN IS HERE
;
;THIS ROUTINE IS STOLEN FROM BOB CLEMENTS. I WISH TO THANK
;BOB FOR HIS CLEAR COMMENTS ON IT'S USE IN PRINTR.
;

PICTUR:	PUSHJ	P,.SAVE3##	;SAVE P1-P3
	MOVNI	T3,43		;NUMBER OF BITS IN MAP
	HLRZ	P3,P1		;GET NUMBER OF WORDS
	SKIPN	P3		;SKIP IF NON-ZERO
	MOVEI	P3,1		;ELSE ASSUME 1
	HRRZI	T1,-1(P1)	;GET ADR OF 1ST WORD -1
	ADD	T1,P3		;GET ADR OF LAST WORD
	IMULI	P3,6		;CONVERT WORDS TO CHARACTERS
	MOVEM	P3,J$XPCS(J)	;AND SAVE NUMBER OF SIGNIFICANT CHARS
	MOVE	P3,(T1)		;LOAD LAST WORD INTO P3
	MOVEI	T1,77		;AND LOAD A SIXBIT MASK

PICTR0:	TDNE	P3,T1		;MASK A CHARACTER
	JRST	PICTR1		;ITS SIGNIFICANT
	SOS	J$XPCS(J)	;ITS NOT SIGNIFICANT
	LSH	T1,6		;SHIFT THE MASK
	JUMPN	T1,PICTR0	;AND LOOP FOR 6 POSITIONS

PICTR1:	MOVEM	P2,J$XPCB(J)	;SAVE THE BLOCKSIZE

PICTR2:	MOVE	P2,J$XPCB(J)	;LOAD THE BLOCKSIZE
	PUSHJ	P,PIC1		;PRINT A PATTERN
	SOJG	P2,.-1		;N TIMES
	ADDI	T3,5		;POSITION TO NEXT PATTERN
	JUMPL	T3,PICTR2	;AND LOOP

	TELL	USR,CRLF	;4 CRLFS WHEN DONE
	TELL	USR,CRLF
	TELL	USR,CRLF
	TELL	USR,CRLF
	POPJ	P,		;AND RETURN
;HERE TO PRINT A WHOLE ROW
PIC1:	PUSHJ	P,.SAVE3##	;SAVE P1-P3
	HRRZ	N,P1		;GET ADDR OF FIRST WORD
	HRLI	N,440600	;MAKE A BYTE POINTER
	MOVE	P2,J$XPCS(J)
;HERE TO DO 1 CHAR
PIC2:	ILDB	T2,N		;GET A CHAR
	ADDI	T2,40		;MAKE ASCII
	MOVE	T1,CHRTAB-40(T2);GET PATTERN
	ROT	T1,43(T3)	;DIAL A BIT
	MOVNI	T4,5		;SET UP COUNT
PIC3:	MOVEI	C,40		;ASSUME IT IS A BLANK
	JUMPGE	T1,.+2		;WERE WE RIGHT
	MOVE	C,T2		;OF COURSE NOT
	PUSHJ	P,TELL3		;PRINT 3 WIDE
	ROT	T1,1		;GET NEXT BIT
	AOJL	T4,PIC3		;COUNT DOWN WIDTH
	MOVEI	C,40		;SET UP FOR SPACE
	SOJLE	P2,TCRLF	;IF NO MORE SIG CHARS, PRINT CRLF(ED.142)
	PUSHJ	P,TELL3		;NO. PRINT 6 BLANK
	PUSHJ	P,TELL3		; COL. BETWEEN LETTERS
	JRST	PIC2		;DO ANOTHER LETTER
TCRLF:	TELL	USR,CRLF	;PRINT A BLANK LINE
	POPJ	P,		;RETURN
TELL3:	MOVE	P3,J$XPCB(J)	;LOAD BLOCK SIZE
	PUSHJ	P,DEVOUT	;PRINT THE CHAR
	SOJG	P3,.-1		;LOAD FOR N CHARACTERS
	POPJ	P,		;AND RETURN
	
CHRTAB:	BYTE (5) 00,00,00,00,00,00,00	;SP
	BYTE (5) 04,04,04,04,04,00,04	;!
	BYTE (5) 12,12,00,00,00,00,00	;"
	BYTE (5) 12,12,37,12,37,12,12	;#
	BYTE (5) 04,37,24,37,05,37,04	;$
	BYTE (5) 31,31,02,04,10,23,23	;%
	BYTE (5) 10,24,10,24,23,22,15	;&
	BYTE (5) 06,02,00,00,00,00,00	;'
	BYTE (5) 04,10,20,20,20,10,04	;(
	BYTE (5) 04,02,01,01,01,02,04	;)
	BYTE (5) 00,25,16,33,16,25,00	;*
	BYTE (5) 00,04,04,37,04,04,00	;+
	BYTE (5) 00,00,00,00,00,06,02	;,
	BYTE (5) 00,00,00,37,00,00,00	;-
	BYTE (5) 00,00,00,00,00,06,06	;.
	BYTE (5) 00,00,01,02,04,10,20	;/

	BYTE (5) 16,21,23,25,31,21,16	;0
	BYTE (5) 04,14,04,04,04,04,16	;1
	BYTE (5) 16,21,01,02,04,10,37	;2
	BYTE (5) 16,21,01,02,01,21,16	;3
	BYTE (5) 22,22,22,37,02,02,02	;4
	BYTE (5) 37,20,34,02,01,21,16	;5
	BYTE (5) 16,20,20,36,21,21,16	;6
	BYTE (5) 37,01,01,02,04,10,20	;7
	BYTE (5) 16,21,21,16,21,21,16	;8
	BYTE (5) 16,21,21,17,01,01,16	;9
	BYTE (5) 00,06,06,00,06,06,00	;:
	BYTE (5) 00,06,06,00,06,06,02	;;
	BYTE (5) 02,04,10,20,10,04,02	;<
	BYTE (5) 00,00,37,00,37,00,00	;=
	BYTE (5) 10,04,02,01,02,04,10	;>
	BYTE (5) 16,21,01,02,04,00,04	;?

	BYTE (5) 16,21,21,27,25,25,07	;@
	BYTE (5) 16,21,21,21,37,21,21	;A
	BYTE (5) 36,21,21,36,21,21,36	;B
	BYTE (5) 17,20,20,20,20,20,17	;C
	BYTE (5) 36,21,21,21,21,21,36	;D
	BYTE (5) 37,20,20,36,20,20,37	;E
	BYTE (5) 37,20,20,36,20,20,20	;F
	BYTE (5) 17,20,20,20,27,21,16	;G
	BYTE (5) 21,21,21,37,21,21,21	;H
	BYTE (5) 16,04,04,04,04,04,16	;I
	BYTE (5) 01,01,01,01,21,21,16	;J
	BYTE (5)