Google
 

Trailing-Edge - PDP-10 Archives - BB-J713A-BM - language-sources/lptspl.mac
There are 45 other files named lptspl.mac in the archive. Click here to see a list.
	TITLE	LPTSPL - TOPS10/TOPS20 LINE PRINTER DRIVER
;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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.
;

	SEARCH	GLXMAC			;SEARCH GALAXY PARAMETERS
	PROLOGUE(LPTSPL)
	SEARCH	QSRMAC			;SEARCH QUASAR PARAMETERS
	SEARCH	ORNMAC			;SEARCH ORION/OPR PARAMETERS
	SEARCH	D60UNV			;SEARCH FOR DN60 SYMBOLS

	.DIRECT	FLBLST

IF1,<
TOPS20 <PRINTX ASSEMBLING GALAXY-20 LPTSPL>
TOPS10 <PRINTX ASSEMBLING GALAXY-10 LPTSPL>
>  ;END IF1

IF2,<PRINTX BEGIN ASSEMBLER PASS # 2.>

	SALL				;SUPPRESS MACRO EXPANSIONS

;VERSION INFORMATION
	LPTVER==104			;MAJOR VERSION NUMBER
	LPTMIN==0			;MINOR VERSION NUMBER
	LPTEDT==2650			;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
	RELOC	0
	SUBTTL	RJE SUPPORT DEFINITIONS


	;IF WE HAVE RJE,,GET SIMULATION PACKAGE (TOPS20)
TOPS20 <
IFN FTRJE,<.REQUIRE NURD.REL>		;LOAD THE DN200 I/O PACKAGE 
>

	;IF WE HAVE DN60,,GET DN60 I/O PACKAGE

IFN FTDN60,<.REQUIRE D60JSY.REL		;LOAD THE DN60 I/O  PACKAGE
	    D60ERR			;GENERATE ERROR SYMBOLS

		PHASE	0

	OPRPTR:! BLOCK	1		;OPR MESSAGE BYTE POINTER
	OPRBCT:! BLOCK	1		;OPR MESSAGE BYTE COUNT
	OPRLEN:!			;OPR MESSAGE HEADER LENGTH
	OPRTXT:!			;OPR MESSAGE TEXT
		DEPHASE

> ;END FTDN60 CONDITIONAL
	SUBTTL	Revision History

COMMENT \

2550	Delete all references to user name and job number.
	Replace them with ^R Library $Text Function.

2551	Add code to support new QUASAR device status message.

2552	Add RJE support

2553	Fix a Restart page count bug by not including the job
	headers and trailers in the final page count.

2554	Replace ERRSTP ITEXT with LPERR ITEXT. Make sure when LPT comes
	online or goes offline, the status is updated. Add a check to
	ACTEND so that if the request had an invalid account string,
	no USAGE entry is made.

2555	Fix a bug in which INPOPN was doing a LOAD S1,EQ.PRV to get
	the users privilge bits. This translated to MOVE S1,400 
	and 400 was SPLDIR (which was never 0). Given this, the
	JUMPN S1,INPO.1 always jumped to INPO.1 and avoided the
	access check. The LOAD was changed to LOAD S1,.EQSEQ(J),EQ.PRV.

2556	Changed the IB to conform to the new IB/PIB structure.

2557	Fix a bug in OUTOUT which caused to stack to be out of phase.
	Basic re-write of OUTOUT, elimination of OUTINT, and
	modification of $SOUT.

2560	Change the scheduler loop to use P1 instead of T2.
	Change the scheduler loop so that at MAIN.1 it
	checks to see if the stream status needs to be updated,
	and if so, it sends a status update and checkpoint 
	message to QUASAR.

2561	Delete the flag bit HDRTRL and the supporting code.

2562	Add Calls to S%SIXB & S%TBLK for WTOR response parsing.
	Move the call to FILDIS from ENDJOB to QRELEASE.

2563	Fix line count for narrow forms.
	Fix DEVOUT to save S1 across OUTOUT call
	Add code to cut off the header/trailer line at 'J$FWID' Length

2564	Add DN60 Support.

2565	Add 'Ignore Structure Accounting' MSTR JSYS.

2566	Change the $WTOR's for killing OPR requests from $WTOR to $KWTOR.

2567	Add spooling to mag tape support

2570	Fix a page count problem (on restarts).
	Spell cancelled right (canceled)

2571	Spell Canceling correctly
	add 40 (decimal) words to the context PDL

2572	Fix a bug in which it was possible for LPTSPL to set the output
	blocked scheduling bit and then deschedule for a page limit
	exceeded error. When this happened, LPTSPL would wait for
	the output done interrupt, which, of course, would never come.

2573	Clear J$RNPP IN DOJOB Just before checkpointing the next file
	Clear J$RNPP and checkpoint the number of copies in FILE.1

2574	If a job is cancelled while in OPR response wait from LODVFU or
	LODRAM then zero J$FORM to force the next job to go through
	new forms processing.

2575	Add DN60 operator response support (What a Crock !!)

2576	Delete FTRMTE feature test.

2577	At OUTERR move the PUSHJ P,.SAVET & MOVE T4,STREAM to OUTE.1
	under TOPS-10 conditional.

	Change the scheduler so that for both TOPS-10 & TOPS-20 we
	check to see if we processed a message and if so, dont sleep.

	Change OPRCHK so that as long as the output succeeds, we
	continue printing operator messages.

	For TOPS-10 make OUTDMP call OUTOUT BUFNUM+1 times.

	Add Spooling to Tape support for TOPS-10.

2600	Make LPTSPL sleep forever by removing the 60 second timer.

2601	TOPS10 - Detect EOF on spool to magtape.  Ask OPR to mount next reel

2602	Fix a bug in SHUTIN code. Get a new stack pointer if shutting
	down from 'IN STREAM' context.

2603	Fix a bug - reverse the compare in S$VFU which checks for
	optical VFU.

2604	Fix a bug - In OUTGET, if the default RAM and VFU are already set,
	then, dont set them.

2605	Fix a bug - if printing either the banner or header pages, dont
	flush the buffers in KILL or OACCAN.

2606	Add code to send a form feed if the printer VFU is ok and
	we are about to load the VFU.

2607	Delete the TOPS-20 mag tape code that assigns/deassigns the tape drive.
	Also make sure that the mat tape is not already assigned to anyone.

2610	Delete the RAM variable from the forms default macro and add
	J$FRAM.

2611	Change IPCF send/recieve quotas from max to 20.

2612	Change DN60 D60OPN parameters for new port/line handle.

2613	Fix a bug - prevent LPTSPL from deleting DN60'S link'd list.

2614	Delete the Send/Recieve Quotas from the PIB.

2615	Make OUTREL do a CLOSE instead of a RESDV. if we are spooling to tape

2616	Pick up non-existant printer status bits on the -20.

2617	Fix a bug in TAPGET; The correct value returned by the DVCHR for
	unassigned devices is -1,,unit # - Not -1.

2620	In SHUTDN, After the call to FNDOBJ check to see that the object
	was actually found, and if not, just return.
	In OPDINI, add a SETZM FMOPN and a $RETT at the end of the routine.
	In OPEN.6 add a SETOM J$LINK(J) to indicate that there is no DN60
	operator message list.
	In CLOSE.6, change the MOVE S1,J$LINK(J) to a SKIPL S1,J$LINK(J) so
	that we dont delete a list which may not exist.

2621	TOPS-10: Delete the call to F%FCHN and use the stream number as the 
	channel number.

2622	Fix a job restart problem which allows -pages to be printed.

2623	Fix a -10 problem caused by converting to extended channels in the
	library. Must re-write the load VFU and RAM sections for front
	end lint printers

2624	Fix a -10 problem - Clear the PSF%DO and PSF%OB bits in the
	OUTGET routine since we may wait forever after resetting the channel.
	Change all occurances of DC3 output to CRLF except for the ruler.

2625	Add a CRLF to the end of the header page file info line.

2626	Fix a bug in the /REPORT: code for COBOL report files.

2627	Fix a bug in deleting files. Make F%DEL use an in your behalf FOB.

2630	Delete the support for the old forms parameters.

2631	Convert DN60 support to new SETUP message format.

2632	Rework the Backspace /pages support to fix U.S. Railways QAR.

2633	Finally get the backspace code right.

2634	Add 8 bit input support. Also, make output byte sizes variable by
	adding J$LBTZ to keep track of output byte size.

2635	Add /FILE:ELEVEN support to print MACY11 files as standard ascii
	Requires that a new FP bit or field be defined for 8-BIT

2636	TOPS20 QAR (20-00608) Add code to OUTREL so that when closing
	a device other then the line printer, we write out
	trailing tape marks.

2637	Fix a bug in which the ABORT bit was being lit in the NXTJOB code,
	before the forms were set up. This caused the request to be trashed
	without the headers or trailers being printed

2640	Fix a bug - Make the TAPGET OPENF open the device in 7 bit Mode.

2641	Fix Another bug - make OUTGET open device for 8 bit bytes.

2642	Make PICTURE put out line feeds, not DC3's.

2643	Fix a bug in OUTERR code so that is the OUTFLS call fails, then
	send a Response-to-Setup message to QUASAR before shutting down.

2644	Add support for /RAM: in LPFORM.INI for -10 & -20.

2645	Fix an accounting problem in which usage accounting was being done
	twice. 

2646	Fix QAR # 20-00805 such that multiple ALIGN commands do not 
	add to the sleep time of previous ALIGN commands

2647	Add a SETZM T1 to the .MONOP MTOPR call in OUTDMP.
	Add a .MONOP MTOPR call to TAPGET to wait for I/O to finish or
	if a TTY, set the TTY page width to infinite.

2650	Fix BACKSPACE FILES problem. Just make it backspace to the beginning
	of the current file.

\   ;End of Revision History
	SUBTTL	AC and I/O Channel Definitions

;ACCUMULATOR DEFINITIONS

	M==12		;IPCF MESSAGE ADDRESS
	S==13		;STATUS FLAGS
	E==14		;POINTS TO CURRENT FILE
	J==15		;JOB CONTEXT POINTER
	C==16		;HOLDS A CHARACTER - ALMOST NEVER PRESERVED





	SYSPRM	ERRVFU,DF.LVE,MO%LVF
	SUBTTL	Parameters

;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME
	ND	PDSIZE,100	;SIZE OF PUSHDOWN LIST
	ND	LPTERR,2	;NUMBER OF LPT I/O ERRS BEFORE QUITTING
	ND	LOGPAG,12	;PAGE LIMIT FOR LOG IF OVER QUOTA


;CONSTANT PARAMETERS
	XP	MSBSIZ,30		;SIZE OF A MESSAGE BLOCK
	XP	AFDSIZ,10		;ALIGN FILE FD SIZE.

;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,4,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*4>
					;NUMBER OF CHARS PER BUFFER
	BUFSPC==BUFNUM*BUFSIZ

	SYSPRM	NPRINT,17,1		;NUMBER OF DEVICES THIS SPOOLER HANDLES
	SYSPRM	ACCTSW,0,-1		;ACCOUNTING -1=YES,0=NO

	SYSPRM	RAMNOR,SIXBIT/LP96/,SIXBIT/LP96/
	SUBTTL	MACROS

DEFINE LP(SYM,VAL,FLAG),<
	IF1,<
		XLIST
		IFNDEF J...X,<J...X==1000>
		IFDEF SYM,<PRINTX  ?PARAM SYM USED TWICE>
		SYM==J...X
		J...X==J...X+VAL
		IFNDEF ...BP,<...BP==1B0>
		IFNDEF ...WP,<...WP==0>
		REPEAT VAL,<
		IFIDN <FLAG><Z>,<LPZ(\...WP,...BP)>
			...BP==...BP_<-1>
			IFE ...BP,<
				...BP==1B0
				...WP==...WP+1
			>  ;;END IFE ...BP
		>  ;;END REPEAT VAL
		LIST
		SALL
	>  ;END IF1

	IF2,<
	.XCREF
	J...X==SYM
	.CREF
	SYM==J...X
	>  ;END IF2
>  ;END DEFINE LP


DEFINE LPZ(A,B),<
	IFNDEF ...Z'A,<...Z'A==B>
	IFDEF ...Z'A,<...Z'A==...Z'A!B>
>  ;END DEFINE LPZ
	SUBTTL	Special Forms Handling Parameters





;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)
;	RAM:SS		TRANSLATION RAM TO USE
;	DRUM:SS		DRUM TYPE
;	CHAIN:SS	CHAIN TYPE (DRUM/CHAIN ARE THE SAME)
;	NOTE:AA		TYPE NOTE TO THE OPERATOR


;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,5
	FF	ALSLP,7
	FF	RIBBON,FRMNOR
	FF	TAPE,FRMNOR
	FF	VFU,FRMNOR
	FF	DRUM,FRMNOR
	FF	CHAIN,FRMNOR
	FF	NOTE,0
	FF	RAM,-1
>


;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

	ARROW==1B0		;ARROW MODE IN EFFECT
	SUPFIL==1B1		;NO USER FORM CONTROL
	DSKOPN==1B2		;DISK DATA READ GOING ON
	RQB==1B3		;JOB HAS BEEN REQUED
	SUPJOB==1B4		;SUPPRESS /JOB
	ABORT==1B5		;THE SHIP IS SINKING
	FCONV==1B6		;THE NEXT CHAR IS FORTRAN FORMAT DATA
	NEWLIN==1B7		;FLAG FOR THE BEGINING OF LINE
	SKPFIL==1B8		;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
	GOODBY==1B9		;IN JOB TERMINATION SEQUENCE
	FBPTOV==1B10		;SPACING PAGE TABLE OVERFLOW BIT.
	FORWRD==1B11		;FORWARD SPACING REQUEST IN PROGRESS.
	INTRPT==1B12		;STREAM IS CONNECTED TO THE INTERRUPT SYSTEM
	BANHDR==1B14		;PRINTING BANNER/HEADER PAGES
	VFULOD==1B15		;VFU LOAD IS IN PROGRESS
	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$RLIM,1,Z		;JOB LIMIT IN PAGES
	LP	J$RTIM,1		;START TIME OF JOB
	LP	J$RLFS,1,Z		;ADR OF LOG FILE SPEC
	LP	J$RNFP,1,Z		;NUMBER OF FILES PRINTED
	LP	J$RNCP,1,Z		;NUMBER OF COPIES OF CURRENT FILE
	LP	J$RNPP,1,Z		;NUMBER OF PAGES IN CURRENT COPY PRINTED
	LP	J$RACS,20		;CONTEXT ACS
	LP	J$RPDL,^D100		;CONTEXT PUSHDOWN LIST

;LPT PARAMETERS
	LP	J$LBUF,1		;ADDRESS OF LPT BUFFER
	LP	J$LBFR,PAGSIZ		;LINE PRINTER 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$LERR,1		;LPT ERROR DOWNCOUNTER
	LP	J$LRAM,1		;DEFAULT RAM FILE NAME (LP64 or LP96)
	LP	J$LLCL,1		;-1 IF UPPER/LOWER CASE PRINTER
	LP	J$LDVF,1		;-1 IF DAVFU ON PRINTER
	LP	J$LPCR,1		;-1 IF DEVICE HAS A PAGE CNTR
	LP	J$LREM,1		; 0 = LOCAL LPT
					;-1 = DEC TYPE REMOTE LPT
					;+1 = DN60 TYPE REMOTE LPT
	LP	J$DCND,CN$SIZ		;DN60 LINE CONDITIONING BLOCK
	LP	J$DFLG,1		;DN60 FLAG WORD
	LP	J$D6OP,1		;DN60 OPERATOR CONSOLE ID
	LP	J$LINK,1		;DN60 OPERATORS MSG LIST ID
	LP	J$OMSG,1		;DN60 OPERATOR MESSAGE AVAILABLE FLAG
	LP	J$OFLN,1		;DN60 PRINTER IS OFFLINE FLAG
	LP	J$LCLS,1		;LPT CONTROLLER CLASS
	LP	J$LIOA,1		;-1 IF WE ARE IN A SOUT OR OUT
	LP	J$LLPT,1		;-1 IF DEVICE REALLY IS A LPT
	LP	J$LIOS,1		;LPT IO ERROR STATUS
	LP	J$MTAP,1		;SIXBIT MAG TAPE DEVICE NAME
	LP	J$LCHN,1		;LPT I/O CHANNEL
	LP	J$LBTZ,1		;LPT OUTPUT BYTE SIZE
TOPS20 <
	LP	J$LSTG,2		;DEVICE NAME STRING
	LP	J$LIBC,1		;INITIAL BYTE COUNT
	LP	J$LIBP,1		;INITIAL BYTE POINTER
>  ;END TOPS20 CONDITIONAL

	;CONTINUED ON NEXT PAGE
	;CONTINUED FROM PREVIOUS PAGE

;CURRENT FORMS PARAMETERS

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

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

	LP	J$FORM,1		;CURRENT FORMS TYPE
	LP	J$FPFM,1		;PREVIOUS FORMS TYPE
	LP	J$PDRU,1		;PREVIOUS LOADED DRUM
	LP	J$PRIB,1		;PREVIOUS LOADED RIBBON
	LP	J$PTAP,1		;PREVIOUS LOADED CARRAIGE CONTROL TAPE
	LP	J$FMSP,1,Z		;FORMS WTO/WTOR PAGE ADDRESS
	LP	J$FWCL,1		;CURRENT WIDTH CLASS
	LP	J$FLVT,1		;CURRENTLY 'LOADED' VFU TYPE
	LP	J$FLRM,1		;CURRENTLY 'LOADED' TRANSLATION RAM
	LP	J$FVIF,1		;IFN OF VFU FILE ON -10
	LP	J$FBYT,1,Z		;VFU INPUT BYTE COUNT.
	LP	J$FPTR,1		;VFU INPUT BYTE POINTER.
	LP	J$LVFF,1		;FIRST TIME THROUGH FLAG FOR LPT VFU'S
	LP	J$FNBK,16		;OPERATOR NOTE BLOCK

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

;ALIGN FILE PARAMETERS
	LP	J$APRG,1		;-1 IF ALIGN IS IN PROGRESS
	LP	J$AIFN,1		;ALIGN FILE IFN
	LP	J$ABYT,1		;ALIGN BUFFER BYTE COUNT.
	LP	J$APTR,1		;ALIGN BUFFER BYTE POINTER.
	LP	J$ASLP,1,Z		;SECONDS TO SLEEP
	LP	J$ACNT,1,Z		;LOOP COUNT
	LP	J$AFD,AFDSIZ		;THE FD FOR THE ALIGN FILE

;MISCELLANY
	LP	J$XTOP,1		;WE ARE AT TOP OF FORM
	LP	J$XFOB,FOB.SZ		;A FILE OPEN BLOCK
	LP	J$XPOS,1		;CURRENT VERTICAL POSITION
	LP	J$XHBF,<45>		;BUFFER TO BUILD HEADER LINE
	LP	J$XCOD,<^D55>		;COMPILE A ROUTINE TO CHECK
					; FOR MATCH ON /REPORT
	LP	J$XFRC,1		;FORTRAN CHARACTER REPEAT COUNT
	LP	J$XTBF,50		;$TEXT BUFFER FOR OUTPUT DEVICE
	LP	J$XTBP,1		;BYTE POINTER FOR J$XTBF.
	LP	J$RESP,2,Z		;OPERATOR RESPONSE BUFFER.
	LP	J$WTOR,^D50		;WTOR MESSAGE BUFFER.
	;ACCOUNTING PARAMETERS.

	LP	J$APRT,1,Z		;PAGE COUNT.
	LP	J$ADRD,1,Z		;DISK BLOCKS READ.
	LP	J$APRI,1,Z		;JOBS PRIORITY
	LP	J$ARTM,1,Z		;JOBS RUN TIME (CPU)
	LP	J$ASEQ,1,Z		;JOBS SEQUENCE NUMBER
	LP	J$AFXC,1,Z		;TOTAL FILES PRINTED (FILES*COPIES)

	;FORWARD SPACE / BACK SPACE PARAMETERS

	LP	J$FBPT,1		;CURRENT PAGE TABLE POSITION
	LP	J$FPAG,PAGSIZ		;BACKSPACE PAGE TABLE
	LP	J$FCBC,1,Z		;CURRENT INPUT BUFFER BYTE COUNT
	LP	J$FTBC,1,Z		;TOTAL INPUT BYTE COUNT
	LP	J$FPIG,1,Z		;NUMBER OF PAGES TO IGNORE

	;DISK FILE PARAMETERS

	LP	J$DIFN,1		;THE IFN
	LP	J$DFDA,1		;THE FD ADDRESS
	LP	J$DBPT,1		;BUFFER BYTE POINTER
	LP	J$DBCT,1,Z		;BUFFER BYTE COUNT

	;LOG FILE PARAMETERS

	LP	J$GBUF,^D10		;ADDRESS OF LOG FILE BUFFERS
	LP	J$GBFR,PAGSIZ		;FIRST LOG FILE BUFFER
	LP	J$GNLN,1,Z		;NUMBER OF LINES WRITTEN IN LOG
	LP	J$GIBC,1,Z		;INTERNAL LOG BYTE COUNT
	LP	J$GIBP,1,Z		;INTERNAL LOG BYTE POINTER
	LP	J$GINP,1,Z		;NUMBER OF INTERNAL LOG PAGES

	;PICTURE BLOCKS

	LP	J$PUSR,10		;USER NAME
	LP	J$PNOT,4		;/NOTE
	LP	J$PFL1,10		;FIRST LINE OF FILE NAME
	LP	J$PFL2,12		;SECOND LINE OF FILE NAME
	LP	J$PFLS,1		;BLOCKSIZE FOR FILENAME


	LP	J$$END,1		;END OF PARAMETER AREA

	J$$LEN==J$$END-J$$BEG		;LENGTH OF PARAMETER AREA

;NOW GENERATE A BIT TABLE OF WHICH WORDS IN THE JOB DATA PAGE TO ZERO
;	ON A NEW JOB

ZTABLE:					;PUT TABLE HERE

DEFINE ZTAB(A),<
	IFNDEF ...Z'A,<...Z'A==0>
	EXP	...Z'A
>  ;END DEFINE ZTAB

	Z==0
REPEAT <J$$LEN+^D35>/^D36,<
	XLIST
	ZTAB(\Z)
	Z==Z+1
	LIST
>  ;END REPEAT
	SUBTTL	Random Impure Storage

PDL:	BLOCK	PDSIZE		;PUSHDOWN LIST

MESSAG:	BLOCK	1		;ADDRESS OF MESSAGE JUST RECEIVED
BLKADR:	BLOCK	1		;IPCF MSG BLK ADDR SAVE AREA
ACTFLG:	BLOCK	1		;-1 IF DOING ACCOUNTING
TEXTBP:	BLOCK	1		;BYTE POINTER FOR DEPBP
SAB:	BLOCK	SAB.SZ		;A SEND ARGUMENT BLOCK
MSGBLK:	BLOCK	MSBSIZ		;A BLOCK TO BUILD MESSAGES IN.
FOB:	BLOCK	FOB.SZ		;A FILE OPEN BLOCK

FMOPN:	BLOCK	1		;SET TO -1 WHEN LPFORM IN OPEN
FMIFN:	BLOCK	1		;THE IFN FOR LPFORM.INI
FMBYT:	BLOCK	1		;LPFORM.INI INPUT BYTE COUNT
FMPTR:	BLOCK	1		;LPFORM.INI INPUT BYTE POINTER.
LPCNF:	BLOCK	10		;SYSNAME
JOBITS:	BLOCK	1		;SAVE JOB STATUS BITS FLAG.
STRSEQ:	EXP	4000		;STREAM SEQ #'S (START AT 4000)
SCHEDL:	-NPRINT,,0		;STREAM SCHEDULING DATA

SLEEPT:	BLOCK   1		;SLEEP TIME FOR SCHEDULING.

CNTSTA:	BLOCK	1		;NUMBER OF THE CENTRAL STATION

RUTINE:	BLOCK	1		;MESSAGE PROCESSING ROUTINE ADDRESS.

TOPS20 <

SPLDIR:	BLOCK	1		;DIRECTORY NUMBER OF PS:<SPOOL>
>  ;END TOPS20 CONDITIONAL
	SUBTTL	Resident JOB Database

STREAM:	BLOCK	1		;CURRENT STREAM NUMBER

JOBPAG:	BLOCK	NPRINT		;ADDRESS OF A FOUR PAGE BLOCK
				; ONE FOR REQUEST, ONE FOR JOB PARAMS
				; ONE FOR LPT BUFFER, ONE FOR LOG BUFFER

JOBOBA:	BLOCK	NPRINT		;TABLE OF OBJECT BLOCK ADDRESSES

JOBSTW:	BLOCK	NPRINT		;JOB STATUS WORD

JOBACT:	BLOCK	NPRINT		;-1 IF STREAM IS ACTIVE, 0 OTHERWISE

JOBOBJ:	BLOCK	3*NPRINT	;LIST OF SETUP OBJECTS

JOBWKT:	BLOCK	NPRINT		;JOB WAKE TIME (FOR ALIGN)

JOBCHK:	BLOCK	NPRINT		;STREAM CHECKPOINT FLAG. (-1=YES,,0=NO)

JOBWAC:	BLOCK	NPRINT		;STREAM WTOR ACK CODE.


;SCHEDULER FLAGS
	PSF%OB==1B1		;OUTPUT BLOCKED
	PSF%DO==1B2		;DEVICE IS OFF-LINE
	PSF%ST==1B3		;STOPPED BY OPERATOR
	PSF%OR==1B4		;OPERATOR RESPONSE WAIT
	PSF%AL==1B5		;ALIGNMENT TIMER WAIT STATE.
	PSF%OO==1B6		;WAITING FOR 2780/3780 OPERATOR OUTPUT

DEFINE $DSCHD(FLAGS),<
	PUSHJ	P,DSCHD
	XLIST
	JUMP	[EXP FLAGS]
	LIST
	SALL
>  ;END DEFINE $DSCHD
	SUBTTL	IB and HELLO message blocks


	TOPS10	<INTVEC==VECTOR>

	TOPS20	<INTVEC==:LEVTAB,,CHNTAB>



IB:	$BUILD	IB.SZ				;
	 $SET(IB.PRG,,%%.MOD)			;SET UP PROGRAM NAME
	 $SET(IB.INT,,INTVEC)			;SET UP INTERRUPT VECTOR ADDRESS
	 $SET(IB.PIB,,PIB)			;SET UP PIB ADDRESS
	 $SET(IB.FLG,IP.STP,1)			;STOPCODES TO ORION
	$EOB					;


PIB:	$BUILD	PB.MNS				;
	 $SET(PB.HDR,PB.LEN,PB.MNS)		;PIB LENGTH,,0
	 $SET(PB.FLG,IP.PSI,1)			;PSI ON
	 $SET(PB.INT,IP.CHN,0)			;INTERRUPT CHANNEL
	$EOB					;


HELLO:	$BUILD	HEL.SZ				;
	  $SET(.MSTYP,MS.TYP,.QOHEL)		;MESSAGE TYPE
	  $SET(.MSTYP,MS.CNT,HEL.SZ)		;MESSAGE LENGTH
	  $SET(HEL.NM,,<'LPTSPL'>)		;PROGRAM NAME
	  $SET(HEL.FL,HEFVER,%%.QSR)		;QUASAR VERSION
	  $SET(HEL.NO,HENNOT,1)			;NUMBER OF OBJ TYPES
	  $SET(HEL.NO,HENMAX,NPRINT)		;MAX NUMBER OF JOBS
	  $SET(HEL.OB,,.OTLPT)			;LPT OBJECT TYPE
	$EOB					;


OACERR:	BLOCK	1			;'OUTGET' ROUTINE RETURN CODE

SETMSG:	[ASCIZ/Started/]
	[ASCIZ/Not available right now/]
	[ASCIZ/Does not exist/]


LIMSG:	ASCIZ/
Type 'Respond <Number> ABORT' to Abort the Job
Type 'Respond <Number> IGNORE' to Ignore the Error/
	SUBTTL	$TEXT Utilities


DEPBP:	IDPB	S1,TEXTBP		;DEPOSIT THE BYTE
	$RETT				;AND RETURN


;OPERATING SYSTEM DEPENDENT ITEXTS


;LOG FILE STAMPS
LPMSG:	ITEXT(<^C/[-1]/ LPMSG	>)
LPDAT:	ITEXT(<^C/[-1]/ LPDAT	>)
LPOPR:	ITEXT(<^C/[-1]/ LPOPR	>)
LPEND:	ITEXT(<^C/[-1]/ LPEND	>)
LPERR:	ITEXT(<^C/[-1]/ LPERR	? >)
DATMON:	ITEXT(<  Date ^H/[-1]/ Monitor: ^T/LPCNF/ ^T7C*/0(T4)/>)
	SUBTTL 	LPTSPL - Multiple Line Printer Spooler.

LPTSPL:	RESET				;AS USUAL.
	MOVE	P,[IOWD PDSIZE,PDL]	;SET UP THE STACK.
	MOVEI	S1,IB.SZ		;GET THE IB SIZE.
	MOVEI	S2,IB			;ADDRESS OF THE IB.
	PUSHJ	P,I%INIT		;SET UP THE WORLD.
	PUSHJ	P,INTINI		;SET UP THE INTERRUPT SYSTEM.
	SETOM	ACTFLG			;TURN ON ACCOUNTING.
IFE ACCTSW,<
	SETZM	ACTFLG			;UNLESS HE DOESNT WANT IT.
>
	PUSHJ	P,OPDINI		;GET OPERATING SYSTEM INFO.
	PUSHJ	P,OPNFRM		;OPEN LPFORM.INI
	PUSHJ	P,I%ION			;TURN ON INTERRUPTS.
	MOVEI	T1,HELLO		;GET ADDRESS OF HELLO MESSAGE.
	PUSHJ	P,SNDQSR		;SAY HI TO QUASAR.
	MOVSI	P1,-NPRINT		;SET UP STREAM COUNTER.

	;FALL THROUGH TO MAIN LOOP.
	SUBTTL	Idle Loop

MAIN:	PUSHJ	P,OPRCHK		;CHECK FOR DN60 OPERATOR MESSAGES
	SKIPN	JOBACT(P1)		;IS THE STREAM ACTIVE ???
	JRST	MAIN.2			;NO,,GET THE NEXT STREAM.
	HRRZM	P1,STREAM		;RUNNABLE STREAM!!!
	MOVE	J,JOBPAG(P1)		;YES, GET JOB PAGE
	PUSHJ	P,CHKTIM		;SEE IF ITS TIME TO GET THE STREAM UP..
	SKIPN	JOBCHK(P1)		;DO WE WANT TO UPDATE THE JOB STATUS ??
	JRST	.+3			;NO,,THEN SKIP THIS
	PUSHJ	P,UPDTST		;SEND A DEVICE STATUS MESSAGE
	PUSHJ	P,CHKPNT		;SEND A CHECKPOINT MESSAGE
	SKIPE	JOBSTW(P1)		;IS THE STREAM BLOCKED ???
	JRST	MAIN.2			;YES,,GET THE NEXT STREAM.
	MOVEM	P1,SCHEDL		;SAVE THE SCHEDULING STREAM.
	MOVSI	17,J$RACS(J)		;ELSE SETUP TO
	BLT	17,17			;GET SOME ACS
	POPJ	P,			;AND RETURN

MAIN.1:	MOVE	P1,SCHEDL		;GET THE LAST SCHEDULED STREAM.
	SKIPN	JOBCHK(P1)		;DO WE WANT TO UPDATE THE JOB STATUS ??
	JRST	.+3			;NO,,THEN SKIP THIS
	PUSHJ	P,UPDTST		;YES,,SEND A DEVICE STATUS MESSAGE
	PUSHJ	P,CHKPNT		;YES,,SEND A CHECKPOINT MESSAGE
	PUSHJ	P,CHKTIM		;SET THE WAKEUP TIMER

MAIN.2:	AOBJN	P1,MAIN			;LOOP BACK FOR SOME MORE.
	PUSHJ	P,CHKQUE		;CHECK FOR INCOMMING MESSAGES.
	SKIPE	MESSAGE			;DID WE PROCESS A MESSAGE ???
	JRST	MAIN.3			;YES,,CONTINUE PROCESSING
	MOVE	S1,SLEEPT		;NO,,PICK UP SLEEP TIME.
TOPS20 <
	SKIPE	JOBACT			;CHECK IF STREAM ACTIVE..
	SKIPE	JOBSTW			;ANY BLOCKING CONDITIONS
>;END TOPS20 CONDITIONAL

	PUSHJ	P,I%SLP			;ELSE,,GO WAIT

MAIN.3:	MOVE	P,[IOWD PDSIZE,PDL]	;RESET THE STACK POINTER.
	SETZM	SLEEPT			;SLEEP FOREVER
	MOVSI	P1,-NPRINT		;GET LOOP AC.
	JRST	MAIN			;KEEP ON PROCESSING.
	SUBTTL	CHKTIM - ROUTINE TO WAKE UP A STREAM AT A FUTURE TIME.

CHKTIM:	MOVE	S1,JOBSTW(P1)		;GET THE STREAMS SCHEDULING BITS
	TXNN	S1,PSF%AL		;IS IT WAITING ???
	$RETT				;NO,,JUST RETURN
	PUSHJ	P,I%NOW			;YES,,GET CURRENT TIME.
	SUB	S1,JOBWKT(P1)		;CALCULATE THE NUMBER
	IDIVI	S1,3			;   OF SECONDS TO WAKE-UP.
	JUMPGE	S1,CHKT.1		;IF TIME IS UP,,WAKE UP STREAM.
	MOVMS	S1			;GET ABSOLUTE VALUE OF SECONDS.
	CAILE	S1,^D60			;IF WAKE UP TIME IS GREATER THEN
	MOVEI	S1,^D60			;   60 SECS,, THEN MAKE IT 60 SECS.
	CAMGE	S1,SLEEPT		;IF WAKE UP TIME IS LESS THEN
	MOVEM	S1,SLEEPT		;CURRENT WAKE UP TIME,,THEN RESET IT.
	$RETF				;DO NOT WAKE UP THE JOB.
CHKT.1:	MOVX	S1,PSF%AL		;PICK UP ALIGN BLOCK BIT.
	SKIPLE	J$LREM(J)		;IS THIS A DN60 LPT ???
	TXO	S1,PSF%DO		;YES,,INCLUDE DEVICE OFFLINE
	ANDCAM	S1,JOBSTW(P1)		;TURN OFF STREAM WAIT STATE BIT.
	$RETT				;WAKE UP THE STREAM.
	SUBTTL	Deschedule Process

;DSCHD is called by the $DSCHD macro to cause the "current" stream to
;	be un-scheduled.  The call is:
;
;	$DSCHD(flags)
;
;which generates:
;
;	PUSHJ   P,DSCHD
;	JUMP    [EXP flags]

DSCHD:	MOVEM	0,J$RACS(J)		;SAVE AC 0
	MOVEI	0,J$RACS+1(J)		;PLACE TO PUT AC 1
	HRLI	0,1			;SETUP THE BLT POINTER
	BLT	0,J$RACS+17(J)		;SAVE AWAY THE ACS
	HRRZ	S1,0(P)			;GET ADDRESS OF "JUMP [FLAGS]"
	MOVE	S1,@0(S1)		;GET THE FLAGS
	MOVE	S2,STREAM		;GET THE STREAM NUMBER
	IORM	S1,JOBSTW(S2)		;SET THE FLAGS
	MOVE	P,[IOWD PDSIZE,PDL]	;RESET THE STACK POINTER.
	JRST	MAIN.1			;AND CONTINUE SCHEDULING.
	SUBTTL	NEXTJOB Message from QUASAR

NXTJOB:	HRR	S1,J			;GET 0,,DEST
	HRL	S1,M			;GET SOURCE,,DEST
	LOAD	S2,.MSTYP(M),MS.CNT	;GET LENGTH OF MESSAGE
	ADDI	S2,-1(J)		;GET ADR OF END OF BLT
	BLT	S1,(S2)			;BLT THE DATA
	MOVE	S1,STREAM		;GET STREAM NUMBER
	SETOM	JOBACT(S1)		;MAKE THE STREAM ACTIVE
	SETOM	JOBCHK(S1)		;CHECKPOINT FIRST CHANCE WE GET !!!
	MOVX	S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL ;GET LOTS OF BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR THEM
	MOVEI	S1,J$RPDL-1(J)		;POINT TO CONTEXT PDL
	HRLI	S1,-^D100		;AND THE LENGTH
	PUSH	S1,[EXP DOJOB]		;PUSH THE FIRST ADR ON THE STACK
	MOVEM	S1,J$RACS+P(J)		;AND STORE THE PDL
	SETZB	S,J$RACS+S(J)		;CLEAR FLAGS AC
	LOAD	S1,.EQSPC(J),EQ.NUM	;GET NUMBER OF FILES
	MOVEM	S1,J$RFLN(J)		;STORE IT
	MOVEI	S1,J$$BEG(J)		;PREPARE TO ZERO SELECTED WORDS JOB AREA
	MOVSI	S2,-<J$$LEN+^D35>/^D36	;AOBJN POINTER TO BIT TABLE
NXTJ.2:	MOVEI	T1,^D36			;BIT COUNTER FOR THIS WORD
	MOVE	T2,ZTABLE(S2)		;GET A WORD FROM BIT TABLE
NXTJ.3:	JUMPE	T2,NXTJ.4		;DONE IF REST OF WORD IS ZERO
	JFFO	T2,.+1			;FIND THE FIRST 1 BIT
	ADD	S1,T3			;MOVE UP TO THE CORRESPONDING WORD
	SETZM	0(S1)			;AND ZERO IT
	SUB	T1,T3			;REDUCE BITS LEFT IN THIS WORD
	LSH	T2,0(T3)		;SHIFT OFFENDING BIT TO BIT 0
	TLZ	T2,(1B0)		;AND GET RID OF IT
	JRST	NXTJ.3			;AND LOOP
NXTJ.4:	ADD	S1,T1			;ACCOUNT FOR THE REST OF THE WORD
	AOBJN	S2,NXTJ.2		;AND LOOP
	$TEXT(LOGCHR,<^M^J^I/LPDAT/LPTSPL version ^V/[%LPT]/	^T/LPCNF/>)
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	$TEXT(LOGCHR,<^I/LPDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on ^B/@JOBOBA(S1)/ at ^H/[-1]/>)
	SKIPN	T2,.EQCHK+CKFLG(J)	;GET THE CHECKPOINT FLAGS
	JRST	NXTJ.5			;AND JUMP IF NEW JOB
	MOVEI	T1,[ASCIZ /system failure/]
	TXNE	T2,CKFREQ		;WAS IT A REQUEUE
	MOVEI	T1,[ASCIZ /requeue by operator/]
	$TEXT(LOGCHR,<^I/LPMSG/Job being restarted after ^T/0(T1)/>)
NXTJ.5:	LOAD	S1,.EQSEQ(J),EQ.IAS	;IS THIS AN INVALID REQUEST ???
	SKIPE	S1			;IS THIS AN INVALID REQUEST ???
	$TEXT	(LOGCHR,<^I/LPERR/Invalid Account String Specified (^T/.EQACT(J)/)>)
	GETLIM	T1,.EQLIM(J),OLIM	;GET PAGE LIMIT
	MOVEM	T1,J$RLIM(J)		;SAVE IT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	PUSHJ	P,ACTBEG		;GO SETUP THE ACCOUNTING PARMS
	PUSHJ	P,I%NOW			;GET TIME OF DAY
	MOVEM	S1,J$RTIM(J)		;SAVE IT AWAY
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	$WTOJ  (Begin,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	PUSHJ	P,TBFINI		;INITIALIZE THE BUFFER
	PUSHJ	P,CHKLPT		;GO MAKE SURE THE DEVICE IS ONLINE
	$RETT				;AND RETURN
	SUBTTL	Do the Job

DOJOB:	PUSHJ	P,FORMS			;GET FORMS MOUNTED
	JUMPF	ENDREQ			;CANT DO IT,,END THE REQUEST
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET INVALID ACCOUNT STRING BIT
	STORE	S1,S,ABORT		;SAVE IT AS THE ABORT BIT
	TXO	S,BANHDR		;LITE 'PRINTING BANNERS' FLAG
	PUSHJ	P,JOBHDR		;PRINT THE BANNER
	TXZ	S,BANHDR		;CLEAR 'PRINTING BANNERS' FLAG
	LOAD	E,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	E,J			;POINT TO FIRST FILE
	SETZM	J$RNFP(J)		;ZAP THE # OF FILES PRINTED
	SKIPN	.EQCHK+CKFLG(J)		;IS THIS A RESTARTED JOB?
	JRST	DOJO.4			;NO, SKIP ALL THIS STUFF
	MOVE	T1,.EQCHK+CKFIL(J)	;YES, GET NUMBER OF FILES DONE
	MOVEM	T1,J$RNFP(J)		;STORE FOR NEXT CHECKPOINT

DOJO.1:	SOJL	T1,DOJO.2		;DECREMENT AND JUMP IF SKIPED ENUF
	LOAD	S1,.FPINF(E),FP.FCY	;GET THE COPIES IN THIS REQUEST
	ADDM	S1,J$AFXC(J)		;ADD TO THE TOTAL COUNT
	PUSHJ	P,NXTFIL		;BUMP E TO NEXT SPEC
	JUMPF	DOJO.7			;FINISH OFF IF DONE
	JRST	DOJO.1			;LOOP SOME MORE

DOJO.2:	MOVE	S1,.EQCHK+CKCOP(J)	;GET NUMBER OF COPIES PRINTED
	MOVEM	S1,J$RNCP(J)		;SAVE FOR NEXT CHECKPOINT
	ADDM	S1,J$AFXC(J)		;ADD TO THE TOTAL FILE COUNT
	MOVE	S1,.EQCHK+CKTPP(J)	;GET THE TOTAL PAGES PRINTED.
	SUBI	S1,5			;MAKE SURE WE DONT SCREW THINGS UP
	SKIPGE	S1			;ALSO MAKE SURE WE ARE NOT NEGATIVE
	SETZM	S1			;YES,,MAKE IT 0
	MOVEM	S1,J$APRT(J)		;AND SAVE IT
	MOVE	S1,.EQCHK+CKPAG(J)	;GET CHKPNT'ED PAGE
	SUBI	S1,5			;MAKE SURE WE DONT MISS ANYTHING !!
	SKIPGE	S1			;ALSO MAKE SURE WE ARE NOT NEGATIVE
	SETZM	S1			;YES,,MAKE IT 0
	MOVEM	S1,J$RNPP(J)		;AND SAVE IT.

DOJO.4:	LOAD	S1,.FPFST(E)		;GET /START PARAMETER
	MOVEM	S1,J$FPIG(J)		;SAVE FOR FIRST COPY
	PUSHJ	P,FILE			;NO, PRINT THE FILE
	TXNE	S,RQB			;HAVE WE BEEN REQUEUED?
	JRST	ENDJOB			;YES, END NOW!!
	AOS	J$RNFP(J)		;BUMP THE FILE COUNT BY 1.
	SETZM	J$RNPP(J)		;CLEAR THE PAGES PER FILE COUNT
	PUSHJ	P,CHKPNT		;TAKE A CHECKPOINT
	PUSHJ	P,NXTFIL		;BUMP TO NEXT FILE
	JUMPT	DOJO.4			;AND LOOP

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

DOJO.7:	SKIPN	E,J$RLFS(J)		;GET ADR OF LOG-SPEC
	JRST	ENDJOB			;NO, FINISH JOB
	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
	TXZ	S,ABORT			;CLEAR ABORT FLAG
	PUSHJ	P,FILE			;PRINT THE FILE
	JRST	ENDJOB			;AND FINISH UP
	SUBTTL	NXTFIL - FIND AND RETURN THE NEXT FILE IN THE NEXTJOB MSG


NXTFIL:	SETZM	J$RNCP(J)		;CLEAR COPIES PRINTED
	SOSG	J$RFLN(J)		;DECREMENT FILE COUNT
	$RETF				;NO MORE, DONE
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	E,S1			;BUMP TO THE FD
	LOAD	S1,.FDLEN(E),FD.LEN	;GET THE FD LENGTH
	ADD	E,S1			;BUMP TO THE NEXT FP
	LOAD	S1,.FPINF(E),FP.FLG	;GET LOG FILE FLAG
	JUMPE	S1,.RETT		;RETURN IF NOT THE LOG FILE
	MOVEM	E,J$RLFS(J)		;SAVE ADDRESS OF LOG FILE SPEC
	JRST	NXTFIL			;AND LOOP



	SUBTTL	FILDIS - ROUTINE TO KEEP/DELETE PRINTED SPOOL FILES.

FILDIS:	LOAD	E,.EQLEN(J),EQ.LOH	;GET THE HEADER LENGTH.
	ADD	E,J			;POINT TO FIRST FILE .
	LOAD	T1,.EQSPC(J),EQ.NUM	;GET THE NUMBER OF FILES.
FILD.1:	LOAD	T2,.FPINF(E)		;GET THE FILE INFO BITS.
	LOAD	S2,.FPLEN(E),FP.LEN	;GET THE FILE INFO LENGTH.
	ADD	E,S2			;POINT TO FILE SPEC.
	MOVEM	E,J$XFOB+FOB.FD(J)	;SAVE THE FD ADDRESS IN THE FOB
	LOAD	S2,.FPLEN(E),FD.LEN	;GET THE FD LENGTH.
	ADD	E,S2			;POINT TO NEXT FILE.
	MOVEI	S1,FOB.SZ		;GET THE FOB LENGTH
	MOVEI	S2,J$XFOB(J)		;AND THE FOB ADDRESS
	TXNE	T2,FP.SPL+FP.DEL	;SPOOL FILE or /DELETE ???
	PUSHJ	P,F%DEL			;YES,,DELETE THE FILE.
	SOJG	T1,FILD.1		;GO PROCESS THE NEXT FILE.
	$RETT				;RETURN.
	SUBTTL	Print a File

FILE:	TXNE	S,ABORT			;ARE WE IN TROUBLE ???
	$RETT				;YES,,JUST RETURN.
	PUSHJ	P,INPOPN		;OPEN THE INPUT FILE UP
	JUMPF	.POPJ			;LOSE, RETURN
	$TEXT(LOGCHR,<^I/LPMSG/Starting File ^F/@J$DFDA(J)/>)

FILE.1:	PUSHJ	P,INPREW		;REWIND THE INPUT FILE
	PUSHJ	P,CHKPNT		;TAKE A CHECKPOINT
	PUSHJ	P,SETLST		;SETUP /REPORT CODE IF NECESSARY
	TXZ	S,FORWRD		;CLEAR FORWARD SPACE BIT
	TXO	S,BANHDR		;LITE 'PRINTING HEADERS' FLAG
	PUSHJ	P,HEAD			;PRINT THE HEADER
	TXZ	S,BANHDR		;CLEAR 'PRINTING HEADERS' FLAG
	MOVEI	S1,LPTERR		;GET NUMBER OF DEVICE ERRORS ALLOWED
	MOVEM	S1,J$LERR(J)		;AND SAVE IT
	SOSLE	J$FPIG(J)		;SUBTRACT 1 PAGE FROM STARTING PAGE #.
	TXO	S,FORWRD		;STILL POSITIVE,,TURN ON FORWARD BIT.
	TXNE	S,ABORT!SKPFIL!RQB	;DO WE REALLY WANT TO DO THIS ???
	JRST	FILE.2			;NO,,CLEAN UP THE MESS.
	PUSHJ	P,FILOUT		;PRINT THE FILE
	TXNE	S,ABORT!SKPFIL!RQB	;ABORTED OR SKIPPED OR REQUEUED?
	JRST	FILE.2			;YES, CONTINUE ON
	LOAD	T1,.FPFST(E)		;GET /START PARAMETER.
	MOVEM	T1,J$FPIG(J)		;SAVE STARTING POINT FOR THIS COPY.
	AOS	S1,J$RNCP(J)		;INCREMENT AND LOAD COPIES WORD
	AOS	J$AFXC(J)		;ADD 1 TO THE TOTAL FILE COUNT
	LOAD	S2,.FPINF(E),FP.FCY	;GET TOTAL NUMBER TO PRINT
	CAMGE	S1,S2			;PRINTED ENOUGH?
	JRST	FILE.1			;AND LOOP

FILE.2:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REL			;RELEASE IT
	$TEXT (LOGCHR,<^I/LPMSG/Finished File ^F/@J$DFDA(J)/>)
	TXZ	S,DSKOPN+SKPFIL+SUPFIL	;CLEAR LOTS OF BITS
	POPJ	P,			;AND RETURN
	SUBTTL	ENDJOB - END OF JOB PROCESSOR.

ENDJOB:	TXO	S,GOODBY		;FLAG EOJ SEQUENCE
	TXZ	S,FORWRD		;TURN OFF THE FORWARD SPACING BIT.
	$TEXT	(LOGCHR,<^I/LPEND/Summary:^D5/J$APRT(J)/ Pages of Output>)

TOPS10 <
	$TEXT	(LOGCHR,<^I/LPEND/        ^D5/J$ADRD(J)/ Disk Blocks Read>)
> ;END TOPS10 CONDITIONAL

TOPS20 <
	MOVE	S1,J$ADRD(J)		;GET THE NUMBER OF I/O REQUESTS
	IMULI	S1,SZ.BUF		;CALC NUMBER OF WORDS PROCESSED
	IDIVI	S1,PAGSIZ		;CALC NUMBER OF PAGES PROCESSED
	SKIPE	S2			;ANY REMAINDER ???
	ADDI	S1,1			;YES,,ADD 1 PAGE
	MOVEM	S1,J$ADRD(J)		;SAVE THE # 0F PAGES FOR ACCOUNTING
	$TEXT	(LOGCHR,<^I/LPEND/        ^D5/J$ADRD(J)/ Disk Pages Read>)
	MOVX	S1,.FHSLF		;LOAD FORK HANDLE
	RUNTM				;GET RUNTIME
	ADD	S1,J$ARTM(J)		;GET CPU TIME USED
	IDIVI	S1,^D1000		;CONVERT TO SECONDS
	$TEXT	(LOGCHR,<^I/LPEND/      ^D3R /S1/.^D3L0/S2/ Seconds CPU Time Used>)
> ;END TOPS20 CONDITIONAL

	PUSHJ	P,JOBTRL		;PRINT THE JOB TRAILERS.
	PUSHJ	P,OUTEOF		;FORCE ALL DATA OUT

ENDREQ:	PUSHJ	P,QRELEASE		;GO SEND THE RELEASE/REQUEUE MSG.
	SETZM	J$RACS+S(J)		;CLEAR ALL THE STATUS BITS.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	SETZM	JOBACT(S1)		;NOT BUSY
	JRST	MAIN.3			;RETURN TO THE SCHEDULER.
	SUBTTL	QRELEASE - ROUTINE TO SEND A REQUEUE/RELEASE MSG TO QUASAR.

QRELEA:	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	$WTOJ	(End,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;TELL THE OPERATOR.
	SKIPE	J$LREM(J)		;IF THIS IS A LOCAL LPT,,SKIP LOGGING
	$LOG	(Printed ^D/J$APRT(J)/ Pages,,@JOBOBA(S1)) ;LOG # OF PAGES
	MOVEI	S1,MSBSIZ		;GET BLOCK LENGTH
	MOVEI	S2,MSGBLK		;AND THE ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO THE BLOCK
	TXNE	S,RQB			;IS THIS A REQUEUE?
	JRST	RELE.1			;YES
	PUSHJ	P,FILDIS		;GO CLEAN UP THE SPOOL FILES.
	PUSHJ	P,ACTEND		;GO DO THE ACCOUNTING
	MOVEI	T1,MSGBLK		;GET ADDRESS OF THE BLOCK
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REL.IT(T1)		;STORE IT
	MOVX	S1,REL.SZ		;NO, GET RELEASE MESSAGE SIZE
	MOVX	S2,.QOREL		;AND FUNCTION
	JRST	RELE.2			;AND MEET AT THE PASS

RELE.1:	MOVEI	T1,MSGBLK		;GET ADDRESS OF THE BLOCK
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REQ.IT(T1)		;STORE IT
	LOAD	S1,J$RNFP(J)		;GET NUMBER OF FILES PRINTED
	STORE	S1,REQ.IN+CKFIL(T1)	;STORE IT
	LOAD	S1,J$RNCP(J)		;GET COPIES PRINTED
	STORE	S1,REQ.IN+CKCOP(T1)	;STORE IT
	LOAD	S1,J$RNPP(J)		;GET PAGES PRINTED
	STORE	S1,REQ.IN+CKPAG(T1)	;AND STORE IT
	LOAD	S1,J$APRT(J)		;GET TOTAL PAGES PRINTED.
	STORE	S1,REQ.IN+CKTPP(T1)	;STORE IT
	MOVX	S1,CKFREQ		;GET REQEUE BIT
	STORE	S1,REQ.IN+CKFLG(T1)	;STORE IT
	MOVX	S1,RQ.HBO		;GET HOLD BY OPERATOR
	STORE	S1,REQ.FL(T1)		;STORE IN FLAG WORD
	MOVX	S1,REQ.SZ		;GET SIZE
	MOVX	S2,.QOREQ		;AND FUNCTION

RELE.2:	STORE	S1,.MSTYP(T1),MS.CNT	;STORE SIZE
	STORE	S2,.MSTYP(T1),MS.TYP	;AND CODE
	PUSHJ	P,SNDQSR		;SEND IT TO QUASAR
	$RETT				;AND RETURN.
	SUBTTL	CHKQUE - ROUTINE TO RECIEVE AND SCHEDULE IPCF MESSAGES

CHKQUE:	SETZM	MESSAG			;NO MESSAGE YET
	PUSHJ	P,C%RECV		;RECEIVE A MESSAGE
	JUMPF	.POPJ			;RETURN,,NOTHING THERE.
	SETZM	BLKADR			;CLEAR THE IPCF MSG BLK ADDR SAVE AREA
	LOAD	S2,MDB.SI(S1)		;GET SPECIAL INDEX WORD
	TXNN	S2,SI.FLG		;IS THERE AN INDEX THERE?
	JRST	CHKQ.1			;NO, IGNORE IT
	ANDX	S2,SI.IDX		;AND OUT THE INDEX
	CAIE	S2,SP.OPR		;IS IT FROM OPR?
	CAIN	S2,SP.QSR		;IS IT FROM QUASAR?
	JRST	CHKQ.2			;YES, CONTINUE ON
CHKQ.1:	PUSHJ	P,C%REL			;RELEASE THE MESSAGE
	POPJ	P,			;RETURN TO THE SCHEDULER.
CHKQ.2:	LOAD	M,MDB.MS(S1),MD.ADR	;GET THE MESSAGE ADDRESS
	MOVEM	M,MESSAG		;SAVE IT AWAY
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	MOVSI	S1,-NMSGT		;MAKE AOBJN POINTER FOR MSG TYPES

CHKQ.3:	HRRZ	T1,MSGTAB(S1)		;GET A MESSAGE TYPE
	CAMN	S2,T1			;MATCH?
	JRST	CHKQ.4			;YES, WIN
	AOBJN	S1,CHKQ.3		;NO, LOOP
	PJRST	C%REL			;NO,,RELEASE THE MESSAGE

CHKQ.4:	HLRZ	T2,MSGTAB(S1)		;PICK UP THE PROCESSING ROUTINE ADDRESS.
	MOVEM	T2,RUTINE		;SAVE THE ROUTINE ADDRESS.
	PUSHJ	P,CHKOBJ		;GO FIND THE OBJECT BLOCK.
	JUMPF	CHKQ.1			;NOT THERE,,JUST DELETE IT
	PUSHJ	P,@RUTINE		;DISPATCH THE MESSAGE PROCESSOR.
	SKIPN	JOBITS			;DO WE WANT TO SAVE THE STATUS BITS ??
	MOVEM	S,J$RACS+S(J)		;YES,,SAVE THE STATUS BITS.
	SETZM	JOBITS			;CLEAR THE FLAG (DEFAULT TO ALWAYS SAVE)
	PUSHJ	P,C%REL			;RELEASE THE MESSAGE
	POPJ	P,			;RETURN TO THE SCHEDULER.

MSGTAB:	XWD	KILL,.QOABO		;ABORT MESSAGE
	XWD	CHKPNT,.QORCK		;REQUEST-FOR-CHECKPOINT
	XWD	NXTJOB,.QONEX		;NEXTJOB
	XWD	SETUP,.QOSUP		;SETUP/SHUTDOWN
	XWD	OACCON,.OMCON		;OPERATOR CONTINUE REQUEST.
	XWD	OACRSP,.OMRSP		;OPERATOR WTOR RESPONSE.
	XWD	OACREQ,.OMREQ		;OPERATOR REQUEUE REQUEST.
	XWD	OACCAN,.OMCAN		;OPERATOR CANCEL REQUEST.
	XWD	OACPAU,.OMPAU		;OPERATOR PAUSE/STOP REQUEST.
	XWD	OACFWS,.OMFWS		;OPERATOR FORWARD SPACE REQUEST.
	XWD	OACALI,.OMALI		;OPERATOR ALIGN REQUEST.
	XWD	OACSUP,.OMSUP		;OPERATOR SUPPRESS REQUEST.
	XWD	OACBKS,.OMBKS		;OPERATOR BACKSPACE REQUEST.
	XWD	QSRNWA,.QONWA		;QUASAR NODE-WENT-AWAY MESSAGE
	XWD	OPRD60,.OMDSP		;DN60 OPERATOR RESPONSE MESSAGE

	NMSGT==.-MSGTAB
	SUBTTL - CHKOBJ - ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.

	;CALL:  S1/OFFSET INTO MSGTAB
	;	S2/MESSAGE TYPE
	;
	;RET:	STREAM/STREAM NUMBER
	;	J/DATA BASE ADDRESS
	;	S/STATUS BITS


CHKOBJ:	CAIE	S2,.OMRSP		;IS THIS AN OPERATOR RESPONSE ???
	CAIN	S2,.QOSUP		;IS THIS A SETUP/SHUTDOWN MESSAGE ??
	$RETT				;YES,,JUST RETURN NOW.
	CAIN	S2,.OMDSP		;IS THIS A DN60 OPERATOR RESPONSE ???
	$RETT				;YES,,JUST RETURN NOW.
	CAIL	S2,.OMOFF		;IS THIS AN OPR/ORION MSG ??
	JRST	CHKO.1			;YES,,GO SET UP THE OBJ SEARCH.
	XCT	MSGOBJ(S1)		;GET THE OBJ BLK ADDRESS.
	JRST	CHKO.2			;LETS MEET AT THE PASS.

CHKO.1:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	.RETF			;NO MORE,,THATS AN ERROR
	CAIE	T1,.OROBJ		;IS THIS THE OBJECT BLOCK ???
	JRST	CHKO.1			;NO,,GET THE NEXT MSG BLOCK
	MOVE	S1,T3			;GET THE BLOCK DATA ADDRESS IN S1.

CHKO.2:	PUSHJ	P,FNDOBJ		;GO FIND THE OBJECT BLOCK.
	JUMPF	.RETF			;NOT THERE,,THATS AN ERROR.
	$RETT				;RETURN.

MSGOBJ:	MOVEI	S1,ABO.TY(M)		;GET ABORT MSG OBJ ADDRESS.
	MOVEI	S1,RCK.TY(M)		;GET CHECKPOINT MSG OBJ ADDRESS.
	MOVEI	S1,.EQROB(M)		;GET NEXTJOB MSG OBJ ADDRESS.
	SUBTTL	GETBLK - ROUTINE TO BREAK DOWN AN IPCF MSG INTO ITS DATA BLOCKS

	;CALL:	M/ MESSAGE ADDRESS
	;
	;RET:	T1/ BLOCK TYPE
	;	T2/ BLOCK LENGTH
	;	T3/ BLOCK DATA ADDRESS

GETBLK:	SOSGE	.OARGC(M)		;SUBTRACT 1 FROM THE BLOCK COUNT
	$RETF				;NO MORE,,RETURN
	SKIPN	S1,BLKADR		;GET THE PREVIOUS BLOCK ADDRESS
	MOVEI	S1,.OHDRS+ARG.HD(M)	;NONE THERE,,GET FIRST BLOCK ADDRESS
	LOAD	T1,ARG.HD(S1),AR.TYP	;GET THE BLOCK TYPE
	LOAD	T2,ARG.HD(S1),AR.LEN	;GET THE BLOCK LENGTH
	MOVEI	T3,ARG.DA(S1)		;GET THE BLOCK DATA ADDRESS
	ADD	S1,T2			;POINT TO THE NEXT MESSAGE BLOCK
	MOVEM	S1,BLKADR		;SAVE IT FOR THE NEXT CALL
	$RETT				;RETURN TO THE CALLER
	SUBTTL	User CANCEL Request

KILL:	TXNE	S,GOODBY+ABORT		;CHECK SOME BITS
	$RETT				;IF WE LEAVING, IGNORE IT ANYWAY
	$TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^U/ABO.ID(M)/>)
	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	ANDCAM	S2,JOBSTW(S1)		;ZAP THE OPR WAIT BIT
	$WTOJ	(<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	TXO	S,ABORT			;LITE THE ABORT BIT
	PUSHJ	P,INPFEF		;FORCE END OF FILE 
	TXNE	S,BANHDR		;ARE WE PRINTING BANNER/HEADER PAGES ???
	$RETT				;YES,,JUST RETURN
	PUSHJ	P,OUTFLS		;NO,,FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN !!!
	$RETT				;RETURN





	SUBTTL	QSRNWA - ROUTINE TO SHUTDOWN A STREAN WHOSE NODE HAS DROPPED

QSRNWA:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	MOVE	S1,J$DIFN(J)		;GET THE JFN 
	TXNE	S1,DSKOPN		;IS THE SPOOL FILE OPEN ???
	PUSHJ	P,F%REL			;YES,,CLOSE IT
	MOVX	S1,%RSUNA		;GET NOT AVAILABLE RIGHT NOW BITS
	PUSHJ	P,RSETUP		;TELL QUASAR HE CAN HAVE THE OBJ BACK
	PUSHJ	P,SHUTND		;SHUT THE STREAM DOWN
	$RETT				;AND RETURN
	SUBTTL	Request for Checkpoint

CHKPNT:	MOVEI	T1,MSGBLK		;LOAD THE ADDRESS OF THE MESSAGE BLK.
	MOVX	S1,CH.FCH!CH.FST	;GET CHECKPOINT AND STATUS FLAGS
	STORE	S1,CHE.FL(T1)		;AND STORE THEM
	MOVE	S1,J$RNFP(J)		;GET NUMBER OF FILES
	MOVEM	S1,CHE.IN+CKFIL(T1)	;STORE IT
	MOVE	S1,J$RNCP(J)		;GET NUMBER OF COPIES
	MOVEM	S1,CHE.IN+CKCOP(T1)	;AND STORE IT
	MOVE	S1,J$RNPP(J)		;GET NUMBER OF PAGES
	MOVEM	S1,CHE.IN+CKPAG(T1)	;AND STORE IT
	MOVE	S1,J$APRT(J)		;NUMBER OF PAGES PRINTED
	MOVEM	S1,CHE.IN+CKTPP(T1)	;AND STORE IT
	LOAD	S1,.EQITN(J)		;GET JOBS ITN
	MOVEM	S1,MSGBLK+CHE.IT	;AND STORE IT
	MOVX	S1,CKFCHK		;CHKPOINT FLAG
	MOVEM	S1,CHE.IN+CKFLG(T1)	;STORE IT

	MOVEI	S1,CHE.ST(T1)		;GET ADDRESS OF STATUS AREA
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,TEXTBP		;SAVE BYTE POINTER
	$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
	HRRZ	S1,TEXTBP		;GET THE BYTE POINTER
	SUBI	S1,MSGBLK-1		;SUBTRACT START POINT
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE THE LENGTH
	MOVX	S1,.QOCHE		;GET THE FUNCTION CODE
	STORE	S1,.MSTYP(T1),MS.TYP
	PJRST	SNDQSR			;AND SEND IT
	SUBTTL	UPDTST - ROUTINE TO SEND STATUS UPDATES TO QUASAR


UPDTST:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVE	S2,JOBSTW(S1)		;GET THE JOBS STATUS WORD
	SETZM	JOBCHK(S1)		;CLEAR THE UPDATE FLAG
	MOVX	P1,%RESET		;DEFAULT TO RESET
	SKIPE	J$APRG(J)		;ARE WE ALIGNING FORMS ???
	MOVX	P1,%ALIGN		;YES,,SAY SO
	TXNE	S2,PSF%OR		;ARE WE WAITING FOR OPR RESPONSE ???
	MOVX	P1,%OREWT		;YES,,SAY SO
	TXNE	S2,PSF%ST		;ARE WE STOPPED ???
	MOVX	P1,%STOPD		;YES,,SAY SO
	TXNE	S2,PSF%DO		;ARE WE OFFLINE ???
	MOVX	P1,%OFLNE		;YES,,SAY SO
	TXNE	S2,PSF%OO		;ARE WE WAITING FOR OPERATOR OUTPUT ???
	MOVX	P1,%OPRWT		;YES,,SAY SO
	MOVEI	T1,MSGBLK		;GET THE MESSAGE BLOCK ADDRESS
	MOVEM	P1,STU.CD(T1)		;SAVE THE STATUS
	HRLZ	P1,JOBOBA(S1)		;GET THE OBJECT BLOCK ADDRESS
	HRRI	P1,STU.RB(T1)		;GET DESTINATION ADDRESS
	BLT	P1,STU.RB+OBJ.SZ-1(T1)	;COPY THE OBJ BLK OVER TO THE MSG
	MOVX	S1,STU.SZ		;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE IT
	MOVX	S1,.QOSTU		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(T1),MS.TYP	;SAVE IT
	PUSHJ	P,SNDQSR		;SEND IT OFF TH QUASAR
	$RETT				;AND RETURN
	SUBTTL	SETUP/SHUTDOWN Message

SETUP:	LOAD	S1,SUP.FL(M)		;GET THE FLAGS
	TXNE	S1,SUFSHT		;IS IT A SHUTDOWN?
	JRST	SHUTDN			;IF SO,,SHUT IT DOWN !!!
	SETZ	T2,			;CLEAR A LOOP REG

SETU.1:	SKIPN	JOBPAG(T2)		;A FREE STREAM?
	JRST	SETU.2			;YES!!
	CAIGE	T2,NPRINT-1		;NO, LOOP THRU THEM ALL?
	AOJA	T2,SETU.1		;NO, KEEP GOING
	$STOP(TMS,Too many setups)

SETU.2:	MOVEM	T2,STREAM		;SAVE THE STREAM NUMBER
	MOVEI	S1,J$$END		;GET THE LPT DATA BASE LENGTH
	ADDI	S1,PAGSIZ-1		;ROUND UP TO NEXT HIGHEST PAGE
	IDIVI	S1,PAGSIZ		;GET NUMBER OF PAGES IN S1
	PUSHJ	P,M%AQNP		;ALLOCATE THEM
	PG2ADR	S1			;CONVERT TO AN ADDRESS
	MOVEM	S1,JOBPAG(T2)		;AND SAVE IT
	MOVE	J,S1			;PUT IT IN J
	SETZM	JOBSTW(T2)		;CLEAR THE JOB STATUS WORD
	MOVEM	J,J$RACS+J(J)		;SAVE J AWAY
	MOVEI	S1,J$LBFR(J)		;LPT BUFFER ADDRESS
	MOVEM	S1,J$LBUF(J)		;STORE IT
	MOVEI	S1,J$GBFR(J)		;LOG FILE BUFFER PAGE (FIRST)
	MOVEM	S1,J$GBUF(J)		;SAVE IT AWAY
	MOVE	S2,T2			;COPY OVER THE STREAM NUMBER
	IMULI	T2,OBJ.SZ		;GET OFFSET OF OBJECT BLOCK
	ADDI	T2,JOBOBJ		;ADD IN THE BASE
	MOVEM	T2,JOBOBA(S2)		;STORE OBJECT ADDRESS
	MOVE	S2,T2			;GET DESTINATION OF BLT INTO S2
	HRLI	S2,SUP.TY(M)		;MAKE A BLT POINTER
	BLT	S2,OBJ.SZ-1(T2)		;BLT THE OBJECT BLOCK

	SETZM	J$LREM(J)		;DEFAULT TO LOCAL LPT
	MOVE	S1,SUP.NO(M)		;GET THIS GUYS NODE NAME
	CAMN	S1,CNTSTA		;IS IT A LOCAL LPT ???
	JRST	SETU.3			;YES,,SKIP THIS
	SKIPN	SUP.CN(M)		;IS THIS A DN60 REMOTE ???
	JRST	[SETOM  J$LREM(J)	;NO,,MUST BE DN200 - SET DN200 FLAG
		 JRST	SETU.4    ]	;AND CONTINUE PROCESSING
	HRLI	S1,SUP.CN(M)		;DN60,,GET LINE CONDITIONING BLK ADDRESS
	HRRI	S1,J$DCND(J)		;   AND WHERE TO PUT IT
	BLT	S1,J$DCND+CN$SIZ-1(J)	;COPY IT OVER
	MOVEI	S1,1			;GET A 1 (DN60 FLAG)
	MOVEM	S1,J$LREM(J)		;MAKE THIS A DN60 REMOTE
	MOVE	S1,SUP.ST(M)		;GET THE DN60 FLAG WORD
	MOVEM	S1,J$DFLG(J)		;SAVE IT FOR LATER
	JRST	SETU.4			;GO SETUP OUTPUT DEVICE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

SETU.3:	MOVE	S1,SUP.ST(M)		;GET A POSSIBLE MAG TAPE DEVICE NAME
	LOAD	S2,SUP.FL(M),SPLTAP	;GET THE SPOOL-TO-TAPE BIT
	SKIPE	S2			;ARE WE SPOOLING TO TAPE ???
	MOVEM	S1,J$MTAP(J)		;YES,,SAVE THE DEVICE NAME

SETU.4:	SETOM	J$LCHN(J)		;INDICATE NO OUTPUT CHANNEL YET.
	PUSHJ	P,OUTGET		;GET THE OUTPUT DEVICE
	PUSH	P,S1			;SAVE THE RESPONSE CODE
	PUSHJ	P,RSETUP		;SEND THE RESPONSE TO SETUP MSG.
	POP	P,T2			;GET THE RESPONSE CODE BACK
	MOVE	S1,STREAM		;GET STREAM NUMBER
	AOS	S2,STRSEQ		;ADD 1 TO THE STREAM SEQ #, PUT IN S2.
	MOVEM	S2,JOBWAC(S1)		;SAVE IT AS THE OPR WTOR ACK CODE.
	$WTO  (<^T/@SETMSG(T2)/>,,@JOBOBA(S1))  ;TELL THE OPR WHATS GOING ON.
	CAIE	T2,%RSUOK		;ALL IS OK?
	JRST	SHUTDN			;NO, SHUT IT DOWN
	$RETT				;RETURN
	SUBTTL	SHUTDN - ROUTINE TO SHUT DOWN A LINE-PRINTER


SHUTDN:	MOVEI	S1,SUP.TY(M)		;GET THE OBJECT BLOCK ADDRESS
	PUSHJ	P,FNDOBJ		;FIND THE OBJECT BLOCK
	JUMPF	.RETT			;NO OBJECT,,THEN NOTHING TO SHUT DOWN
SHUTND:	SKIPA	T4,[EXP 0]		;INDICATE 'OUT OF STREAM' CONTEXT
SHUTIN:	SETOM	T4			;INDICATE 'IN STREAM' CONTEXT
	SKIPL	J$LCHN(J)		;DO WE HAVE AN OUTPUT CHANNEL ???
	PUSHJ	P,OUTREL		;YES,,RELEASE THE OBJECT
	MOVE	S1,J$DIFN(J)		;GET THE SPOOL FILE IFN
	TXZE	S,DSKOPN		;IS THERE A FILE OPEN ???
	PUSHJ	P,F%REL			;YES,,CLOSE IT
	SKIPE	T4			;ARE WE IN STREAM CONTEXT ???
	MOVE	P,[IOWD PDSIZE,PDL]	;YES,,GET A NEW STACK POINTER
	MOVEI	S1,J$$END		;GET THE LPT DATA BASE LENGTH
	ADDI	S1,PAGSIZ-1		;ROUND UP TO NEXT HIGHEST PAGE
	IDIVI	S1,PAGSIZ		;GET NUMBER OF PAGES IN S1
	MOVE	S2,J			;GET THE JOBPAG ADDRESS
	ADR2PG	S2			;CONVERT TO A PAGE NUMBER
	PUSHJ	P,M%RLNP		;RETURN THEM
	PUSHJ	P,M%CLNC		;GET RID OF UNWANTED PAGES.
	SETOM	JOBITS			;SAY WE DONT WANT TO SAVE STATUS BITS.
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	SETZM	JOBPAG(S1)		;CLEAR THE PAGE WORD
	SETZM	JOBACT(S1)		;AND THE ACTIVE WORD
	JUMPE	T4,.RETT		;'OUT OF STREAM',,JUST RETURN
	JRST	MAIN.3			;'IN STREAM',,RETURN TO THE SCHEDULER


	SUBTTL	RSETUP - ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR

RSETUP:	MOVE	T2,S1			;SAVE THE SETUP CONDITION CODE.
	MOVEI	S1,RSU.SZ		;GET MESSAGE LENGTH
	MOVEI	S2,MSGBLK		;AND THE ADDRESS OF THE BLOCK
	PUSHJ	P,.ZCHNK		;ZERO IT OUT
	MOVEI	T1,MSGBLK		;GET THE BLOCK ADDRESS
	MOVX	S1,RSU.SZ		;GET MESSAGE SIZE
	STORE	S1,.MSTYP(T1),MS.CNT	;STORE IT
	MOVX	S1,.QORSU		;GET FUNCTION CODE
	STORE	S1,.MSTYP(T1),MS.TYP	;STORE IT
	MOVE	S1,STREAM		;GET STREAM NUMBER
	MOVS	S1,JOBOBA(S1)		;GET OBJADR,,0
	HRRI	S1,RSU.TY(T1)		;AND PLACE TO MOVE IT TO
	BLT	S1,RSU.TY+OBJ.SZ-1(T1)	;AND MOVE THE OBJECT BLOCK
	STORE	T2,RSU.CO(T1)		;STORE THE RESPONSE CODE
	MOVX	S1,OBDLLC		;GET LOWER-CASE BIT
	SKIPL	J$LLCL(J)		;IS PRINT LOWER CASE?
	MOVX	S1,OBDLUC		;NO, LOAD THE UPPER CASE FLAG
	STORE	S1,RSU.DA(T1)		;STORE THE DEVICE ATRRIBUTES
	PUSHJ	P,SNDQSR		;AND SEND THE MESSAGE
	$RETT				;RETURN.
	SUBTTL	OACRSP - OPERATOR RESPONSE TO A WTOR PROCESSOR.

OACRSP:	MOVE	S2,.MSCOD(M)		;GET WTOR ACK CODE.
	MOVSI	S1,-NPRINT		;CREATE AOBJN AC.
RESP.1:	CAME	S2,JOBWAC(S1)		;COMPARE ACK CODES..
	JRST	[AOBJN S1,RESP.1	;NOT EQUAL,,CHECK NEXT STREAM.
		 $RETT	]		;NOT THERE,,FLUSH THE MSG.
	MOVX	S2,PSF%OR		;GET "OPERATOR-RESPONSE" WAIT BIT
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR IT
	SETOM	JOBCHK(S1)		;CHECKPOINT NEXT SCHEDULING PASS
	MOVE	J,JOBPAG(S1)		;GET THE STREAM DB ADDRESS.
	MOVE	S,J$RACS+S(J)		;GET THE STREAM STATUS BITS.
	DMOVE	S1,.OHDRS+ARG.DA(M)	;GET THE OPERATORS RESPONSE.
	DMOVEM	S1,J$RESP(J)		;AND SAVE IT.
	$RETT				;AND RETURN
	SUBTTL OACCAN - Operator CANCEL request.

OACCAN:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,STREAM		;GET STREAM NUMBER.
	$ACK  (Aborting,<^R/.EQJBB(J)/>,@JOBOBA(P1),.MSCOD(M)) ;TELL THE OPR.
	SETZM	J$APRG(J)		;ALIGNMENT NOT SCHEDULED,,NOT ACTIVE !!
	SETZM	JOBWKT(P1)		;SET WAKE UP TIME TO NOW.
	SETZM	RSNFLG			;SHOW NO REASON GIVEN.
	MOVX	S1,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S1,JOBSTW(P1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(P1))		;YES,,KILL THE WTOR
	ANDCAM	S1,JOBSTW(P1)		;ZAP THE OPR WAIT BIT

OACC.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	OACC.2			;NO MORE,,FINISH UP
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	MOVEM	T3,RSNFLG		;YES,,SAVE THE REASON ADDRESS
	CAIE	T1,.CANTY		;IS THIS THE CANCEL TYPE BLOCK ???
	JRST	OACC.0			;NO,,SKIP IT AND GET NEXT BLOCK
					;YES...
	MOVE	S1,0(T3)		;LOAD THE CANCEL TYPE.
	CAIE	S1,.CNPRG		;IS IT /PURGE ???
	JRST	OACC.0			;NO,,PROCESS THE NEXT MSG BLK
	MOVE	S1,J$DIFN(J)		;GET THE FILE IFN.
	TXZE	S,DSKOPN		;DONT CLOSE IF ITS NOT OPEN.
	PUSHJ	P,F%REL			;ELSE,,CLOSE IT OUT.
	MOVEM	S,J$RACS+S(J)		;SAVE THE 'S' AC WITH NEW DSKOPN BITS
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN
	PUSHJ	P,SENDFF		;OUTPUT A FORM FEED FOR NEXT JOB
	SETZM	JOBACT(P1)		;STREAM IS NO LONGER ACTIVE
	PUSHJ	P,QRELEASE 		;RELEASE THE REQUEST
	PUSHJ	P,OUTEOF		;OUTPUT AN EOF
	$RETT				;AND RETURN

OACC.2:	$TEXT(LOGCHR,<^I/LPOPR/Job Aborted by the Operator>)
	SKIPE	RSNFLG			;WAS A REASON GIVEN ???
	$TEXT (LOGCHR,<^I/LPOPR/ REASON: ^T/@RSNFLG/>) ;YES,,SAY SO
	SKIPN	RSNFLG			;WAS A REASON GIVEN ???
	$TEXT	(LOGCHR,<^I/LPOPR/ No reason given>) ;NO,,SAY SO
	TXO	S,ABORT			;TELL LPTSPL WE ARE LEAVING.
	TXNE	S,GOODBY		;ARE WE ON OUR WAY OUT ???
	$RETT				;YES,,JUST RETURN
	PUSHJ	P,INPFEF		;FORCE SPOOL FILE EOF
	TXNE	S,BANHDR		;ARE WE PRINTING BANNER/HEADER PAGES ???
	$RETT				;YES,,JUST RETURN
	PUSHJ	P,OUTFLS		;NO,,FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN
	$RETT				;FUNCTION COMPLETE !!!

RSNFLG:	0,,0
	SUBTTL OACSUP - Operator SUPPRESS request.

OACSUP:	TXNE	S,ABORT+RQB+GOODBY	;ARE WE ON OUR WAY OUT ???
	PJRST	TOOBAD			;YES,,SKIP THIS.

OACS.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	.RETT			;NO MORE,,JUST RETURN
	CAIN	T1,.SUPFL		;IS IT SUPPRESS FILE ???
	PJRST	OACS.1			;YES,,THEN GO PROCESS IT AND RETURN
	CAIN	T1,.SUPJB		;IS IT SUPPRESS JOB ???
	JRST	OACS.2			;YES,,THEN GO PROCESS IT AND RETURN
	CAIE	T1,.SUPST		;IS IT STOP SUPPRESSION ???
	JRST	OACS.0			;NO,,GO PROCESS NEXT MSG BLOCK

	TXZ	S,SUPJOB!SUPFIL		;TURN OFF SUPPRESS FILE AND JOB BIT
	$TEXT (LOGCHR,<^I/LPOPR/Operator stopped carriage control supression>)
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	$ACK  (Carriage control activated,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	$RETT				;RETURN NOW

OACS.1:	TXO	S,SUPFIL		;TURN ON SUPPRESS FILE BIT.
	TXZ	S,SUPJOB		;TURN OFF SUPPRESS JOB BIT.
	MOVEI	S1,[ASCIZ/this file/]	;GET THIS FILE MSG.
	JRST	OACS.3			;LETS MEET AT THE PASS

OACS.2:	TXO	S,SUPJOB		;TURN ON SUPPRESS JOB BIT.
	TXZ	S,SUPFIL		;TURN OFF SUPPRESS FILE BIT.
	MOVEI	S1,[ASCIZ/this job/]	;GET THIS JOB MSG.

OACS.3:	$TEXT(LOGCHR,<^I/LPOPR/Operator suppressed carriage control for rest of ^T/0(S1)/>)
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	$ACK (Carriage control suppressed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	$RETT				;RETURN NOW
	SUBTTL OACPAU - Operator PAUSE request.

OACPAU:	MOVX	S2,PSF%ST		;LOAD THE STOP BIT
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	IORM	S2,JOBSTW(S1)		;SET IT
	$ACK  (Stopped,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
	SETOM	JOBCHK(S1)		;SAY WE WANT A CHECKPOINT TAKEN.
	$RETT				;AND RETURN



	SUBTTL OACCON - Operator CONTINUE request.

OACCON:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%ST		;LOAD THE BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
	$ACK  (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
	SETOM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	$RETT				;AND RETURN
	SUBTTL OACREQ - Operator REQUEUE request.

OACREQ:	TXNE	S,GOODBY		;IS IT TOO LATE FOR THIS ???
	PJRST	TOOBAD			;YES,,TOUGH LUCK !!!
	PUSHJ	P,INPFEF		;FORCE AN INPUT EOF
	TXO	S,RQB+ABORT		;LITE THE REQUEUE+ABORT BITS
	$TEXT(LOGCHR,<^I/LPOPR/Job requeued by the the operator>)
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	$ACK	(Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR

	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	ANDCAM	S2,JOBSTW(S1)		;ZAP THE OPR WAIT BIT

OACR.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	.RETT			;NO MORE,,RETURN
	CAIN	T1,.REQTY		;IS THIS THE REQUEST TYPE BLOCK ???
	JRST	OACR.1			;YES,,GO PROGESS IT
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	$TEXT (LOGCHR,<^I/LPOPR/Requeue reason is: ^T/0(T3)/.>)
	JRST	OACR.0			;PROCESS THE NEXT MSG BLOCK

OACR.1:	MOVE	S1,0(T3)		;PICK UP THE REQUEUE CODE.
	SETZ	S2,			;ZERO AC 2
	CAXN	S1,.RQCUR		;/CURRENT?
	JRST	OACR.3			;YES, DO IT
	SETZM	J$RNPP(J)		;CLEAR CURRENT PAGE NUMBER
	CAXN	S1,.RQBCP		;BEGINNING OF COPY?
	MOVEI	S2,[ASCIZ /current copy/]
	JUMPN	S2,OACR.2		;AND CONTINUE ON
	SETZM	J$RNCP(J)		;CLEAR CURRENT COPY NUMBER
	CAXN	S1,.RQBFL		;FROM BEGINING OF FILE?
	MOVEI	S2,[ASCIZ /current file/]
	JUMPN	S2,OACR.2		;AND CONTINUE ON
	SETZM	J$RNFP(J)		;CLEAR FILE COUNT
	MOVEI	S2,[ASCIZ /job/]	;FROM BEGINNING OF JOB
OACR.2:	$TEXT(LOGCHR,<^I/LPOPR/Job will restart at the beginning of the ^T/0(S2)/>)
	JRST	OACR.0			;GO PROCESS THE NEXT MSG BLOCK.

OACR.3:	$TEXT(LOGCHR,<^I/LPOPR/Job will restart at the current position>)
	MOVNI	S1,2			;LOAD -2
	ADDM	S1,J$RNPP(J)		;INSURE NO LOSSAGE OF DATA
	ADDM	S1,J$APRT(J)		;HERE ALSO
	SKIPGE	J$RNPP(J)		;MAKE SURE WE DIDN'T SCREW THINGS UP
	SETZM	J$RNPP(J)		;YES,,ZERO THE PAGES PER COPY
	SKIPGE	J$APRT(J)		;CHECK HERE ALSO
	SETZM	J$APRT(J)		;NO GOOD,,SET IT TO ZERO
	JRST	OACR.0			;GO PROCESS THE NEXT MSG BLOCK
	SUBTTL OACALI - Routine to process Operator ALIGN request.

	; J$APRG(J) :: [?,,-1] = ALIGN IN PROGRESS.
	;	       [-1,,?] = ALIGN NEEDS TO BE SCHEDULED.

OACALI:	TXNE	S,ABORT+RQB+GOODBY	;ARE WE ON OUR WAY OUT ???
	PJRST	TOOBAD			;YES,,SKIP THIS.
	SETZM	FDADDR			;RESET ALIGN FD ADDRESS.

OALI.0:	PUSHJ	P,GETBLK		;GET A MESSAGE DATA BLOCK
	JUMPF	OALI.1			;NO MORE,,CONTINUE PROCESSING
	MOVE	S1,0(T3)		;GET THE FIRST DATA WORD IN THE BLOCK
	MOVEI	T3,-1(T3)		;POINT TO THE BLOCK HEADER
	CAIN	T1,.ALPAU		;IS THIS THE /PAUSE BLOCK ???
	MOVEM	S1,J$ASLP(J)		;YES,,SAVE THE SLEEP TIME
	CAIN	T1,.ALRPT		;IS THE THE /REPEAT-COUNT BLOCK ???
	MOVEM	S1,J$ACNT(J)		;YES,,SAVE THE REPEAT-COUNT
	CAIN	T1,.CMIFI		;IS THIS THE FILE-SPEC BLOCK ???
	MOVEM	T3,FDADDR		;SAVE THE FD ADDRESS
	CAIN	T1,.ALSTP		;IS THIS THE /STOP BLOCK ???
	PJRST	OALI.6			;YES,,GO PROCESS IT AND RETURN
	JRST	OALI.0			;NONE OF THESE,,TRY NEXT BLOCK

OALI.1:	SKIPN	J$APRG(J)		;ARE WE ALREADY ALIGNING ???
	JRST	OALI.2			;NO,,THEN WE'RE OK
	MOVE	S1,STREAM		;YES,,GET STREAM NUMBER.
	$ACK  (ALIGN already in progress,,@JOBOBA(S1),.MSCOD(M))
	$RETT				;RETURN NOW.

OALI.2:	MOVEI	S1,FOB.SZ		;PICK UP FOB SIZE.
	MOVEI	S2,J$XFOB(J)		;PICK UP FOB ADDRESS.
	PUSHJ	P,.ZCHNK		;ZERO OUT THE FOB BLOCK.
	MOVEI	S1,7			;PICK UP ASCII BYTE SIZE
	STORE	S1,J$XFOB+FOB.CW(J),FB.BSZ ;AND SAVE IT IN FOB.
	SKIPN	S1,FDADDR		;SKIP FD GEN IF USER SPECIFIED.
	PUSHJ	P,BLDLFD		;GO BUILD THE ALIGN FD.
	STORE	S1,J$XFOB+FOB.FD(J)	;AND SAVE ITS ADDRESS IN FOB.
	MOVEI	S1,FOB.SZ		;PICK UP THE FOB SIZE.
	MOVEI	S2,J$XFOB(J)		;PICK UP THE FOB ADDRESS.
	PUSHJ	P,F%IOPN		;OPEN THE ALIGN FILE.
	 JUMPF	OALI.3			;IF AN ERROR, RETURN WITH WTO.
	MOVEM	S1,J$AIFN(J)		;SAVE THE FILE ID.
	SKIPG	S1,J$ACNT(J)		;PICK UP USER DEFINED REPEAT-COUNT.
	SKIPLE	S1,J$FALC(J)		;ELSE PICK UP LPFORM.INI REPEAT-CNT.
	SKIPA				;SKIP DEFAULT.
	MOVE	S1,D$ALCN		;PICK UP THE DEFAULT REPEAT COUNT.
	MOVEM	S1,J$ACNT(J)		;SAVE THE REPEAT-COUNT.

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	SKIPG	S1,J$ASLP(J)		;PICK UP USER SLEEP TIME.
	SKIPLE	S1,J$FALS(J)		;ELSE, PICK UP LPFORM.INI SLEEP-TIME.
	SKIPA				;SKIP THE DEFAULT.
	MOVE	S1,D$ALSL		;PICK UP THE DEFUALT SLEEP-TIME.
	IMULI	S1,3			;CONVERT TO UNIVERSAL TIME.
	MOVEM	S1,J$ASLP(J)		;AND SAVE IT.
	SETOM	J$APRG(J)		;SHOW WE ARE DOING AN ALIGN,
					;   AND THAT IT NEEDS TO BE SCHEDULED.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Alignment Scheduled,,@JOBOBA(S1)) ;TELL THE OPERATOR.
	SETOM	JOBCHK(S1)		;SAY WE WANT A CHECKPOINT.
	$RETT				;RETURN.

OALI.3:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (<^E/[-1]/>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/>,@JOBOBA(S1))
	$RETT

OALI.6:	SKIPE	J$APRG(J)		;ARE WE ALREADY ALIGNING ???
	JRST	OALI.7			;IF SO,,CONTINUE PROCESSING.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$ACK  (</STOP Illegal>,Alignment not in Progress,@JOBOBA(S1),.MSCOD(M))
	$RETT
OALI.7:	MOVE	S1,J$AIFN(J)		;GET THE ALIGN IFN.
	SETOB	S2,J$ABYT(J)		;SET ALIGN FILE BYTE COUNT TO -1.
	PUSHJ	P,F%POS			;POSITION TO ALIGN EOF.
	SETZM	J$ACNT(J)		;SET REPEAT-COUNT TO 0.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$ACK  (Alignment Discountinued,,@JOBOBA(S1),.MSCOD(M))
	$RETT				;AND RETURN

FDADDR:	0,,0
	SUBTTL OACFWS - OPERATOR FORWARD SPACE COMMAND PROCESSOR.

OACFWS:	TXNE	S,ABORT+RQB+GOODBY	;ARE WE ON OUR WAY OUT ???
	PJRST	TOOBAD			;YES,,SKIP THIS.
	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	SETOM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.

OACF.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	.RETT			;NO MORE,,RETURN
	CAIN	T1,.SPPAG		;IS THIS FORWARD SPACE PAGES ???
	PJRST	FSPACE			;YES,,DO IT
	CAIN	T1,.SPCPY		;IS THIS FORWARD SPACE COPIES ???
	PJRST	FCOPYS			;YES,,DO IT
	CAIN	T1,.SPFIL		;IS THIS FORWARD SPACE 1 FILE ???
	PJRST	FFILES			;YES,,DO IT
	JRST	OACF.0			;NONE OF THESE,,TRY NEXT BLOCK

FSPACE:	TXNN	S,DSKOPN		;IS THERE A SPOOL FILE OPEN ???
	$RETT				;NO,,JUST IGNORE THIS
	TXO	S,FORWRD		;TURN ON FORWARD SPACE BIT.
	MOVE	S2,0(T3)		;PICK UP # OF PAGES TO FSPACE.
	MOVEM	S2,J$FPIG(J)		;SAVE THE VALUE.
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
	$ACK  (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),.MSCOD(M))
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Forward spaced ^D/J$FPIG(J)/ Pages>)
	$RETT				;AND RETURN


FCOPYS:	MOVE	S2,0(T3)		;PICK UP THE # OF COPIES TO FSPACE.
	ADDM	S2,J$RNCP(J)		;ADD TO # OF COPIES ALREADY PRINTED.
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/J$DFDA(J)/ Forward spaced ^D/S2/ Copies>)
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
	$ACK  (<Forward Spaced ^D/S2/ Copies>,,@JOBOBA(S1),.MSCOD(M))
	PUSHJ	P,INPFEF		;FORCE AN END-OF-FILE.
	$RETT				;AND RETURN

FFILES:	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER
	$ACK	(Forward Spaced 1 File,,@JOBOBA(S1),.MSCOD(M))
	$TEXT	(LOGCHR,<^I/LPMSG/File ^F/J$DFDA(J)/ Skipped by Operator>)
	PUSHJ	P,INPFEF		;FORCE AN END OF FILE
	TXO	S,SKPFIL		;TURN ON SKIP FILE FLAG
	$RETT				;AND RETURN
	SUBTTL - BACK SPACE operator action routine.

OACBKS:	TXNE	S,ABORT+RQB+GOODBY	;ARE WE ON OUR WAY OUT ???
	PJRST	TOOBAD			;YES,,SKIP THIS.
	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	SETOM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.

OACB.0:	PUSHJ	P,GETBLK		;GET A MESSAGE DATA BLOCK
	JUMPF	.RETT			;NO MORE,,JUST RETURN
	MOVE	S1,T3			;GET THE DATA ADDRESS IN S1.
	CAIN	T1,.SPPAG		;IS THIS BACKSPACE 'PAGES' ???
	PJRST	BSPACE			;YES,,GO PROCESS IT
	CAIN	T1,.SPCPY		;IS IT BACKSPACE COPIES ???
	PJRST	BCOPYS			;YES,,GO PROCESS IT
	CAIN	T1,.SPFIL		;IS IT BACKSPACE FILES ???
	PJRST	BFILES			;YES,,GO PROCESS IT
	JRST	OACB.0			;NONE OF THESE,,TRY NEXT BLOCK

BSPACE:	MOVE	T1,0(S1)		;PICK UP THE NUMBER OF PAGES TO BSPACE.
	MOVE	S1,STREAM		;PICK UP STREAM NUMBER.
	$ACK (<Backspaced ^D/T1/ Pages>,,@JOBOBA(S1),.MSCOD(M))
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Backspaced ^D/T1/ Pages>)
	TXNN	S,DSKOPN		;IS THE SPOOL FILE OPEN ???
	$RETT				;NO,,JUST RETURN.

	SETOM	J$DBCT(J)		;RESET THE INPUT BYTE COUNT
	SETZM	J$FPIG(J)		;ZERO THE FORWARD SPACE PAGE COUNTER
	SETZM	J$FCBC(J)		;CLEAR THE CURRENT INPUT BUFFER BYTE CNT
	MOVE	S1,J$FLIN(J)		;GET LINES PER PAGE
	MOVEM	S1,J$XPOS(J)		;RESET THE PAGE POSITION TO TOP OF PAGE
	MOVX	S1,.CHFFD		;GET A FORM FEED
	MOVEM	S1,J$RACS+C(J)		;CONVERT NXT CHAR TO FORM FEED
	MOVE	S1,J$RNPP(J)		;GET THE # OF PAGES PRINTED SO FAR.
	SUB 	S1,T1			;CALC DESTINATION PAGE NUMBER
	SKIPGE	S1			;CAN'T BE NEGATIVE
	SETZM	S1			;IF SO,,MAKE IT ZERO
	MOVEM	S1,J$RNPP(J)		;RESET PAGE POINTER FOR THIS FILE
	JUMPLE	S1,BSPA.2		;MORE THEN WE PRINTED,,JUST REWIND FILE
	CAXLE	T1,PAGSIZ		;REQUESTING MORE THEN WE'RE TRACKING ??
	JRST	BSPA.2			;YES,,REWIND THE FILE
	MOVE	S2,J$FBPT(J)		;GET THE PAGE TABLE ENTRY POINTER
	SUBI	S2,J$FPAG(J)		;CALC INDEX TO CURRENT PAGE
	SUBI	S2,1(T1)		;CALC INDEX TO NEW PAGE
	JUMPGE	S2,BSPA.1		;IF POSITIVE,,THEN NO PROBLEM
	TXNN	S,FBPTOV		;ELSE CHECK FOR PAGE TABLE OVERFLOW
	JRST	BSPA.2			;NO,,HMMMMM,,JUST REWIND THE FILE
	ADDI	S2,J$FPAG+PAGSIZ(J)	;GET TABLE ENTRY FROM THE TOP
	SKIPA				;SKIP NON OVERFLOW PATH
BSPA.1:	ADDI	S2,J$FPAG(J)		;GET TABLE ENTRY FROM THE BOTTOM

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVEI	S1,1(S2)		;POINT TO NEXT PAGE TBL ENTRY
	MOVEM	S1,J$FBPT(J)		;AND MAKE THIS THE CUR TBL ENTRY ADDR
	MOVE	S2,0(S2)		;PICK UP THE LISTING PAGE ADDRESS
	MOVEM	S2,J$FTBC(J)		;AND MAKE THIS THE TOTAL BUFR BYTE COUNT
	MOVE	S1,J$DIFN(J)		;GET THE SPOOL FILE IFN
	PUSHJ	P,F%POS			;POSITION TO THAT PAGE IN THE FILE
	$RETT				;AND RETURN

BSPA.2:	PUSH	P,S1			;SAVE THE DESTINATION PAGE #
	PUSHJ	P,INPREW		;REWIND THE SPOOL FILE 
	POP	P,S1			;RESTORE DESTINATION PAGE NUMBER
	JUMPLE	S1,.RETT		;IF NO SLACK DATA,,SKIP FORWARD SPACE
	MOVEM	S1,J$FPIG(J)		;SAVE THE # OF PAGES TO FORWARD SPACE
	TXO	S,FORWRD		;LITE FORWARD SPACE BIT
	$RETT				;RETURN
	SUBTTL	BACKSPACE 'COPIES' AND 'FILES'

BCOPYS:	MOVE	S2,J$RNCP(J)		;PICK UP # OF COPIES ALREADY PRINTED.
	MOVE	T1,0(S1)		;PICK UP # OF COPIES TO BSPACE.
	SUB	S2,T1			;SUBTRACT # OF COPIES TO BSPACE.
	MOVEM	S2,J$RNCP(J)		;SAVE THE NEW COPIES VALUE.
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Backspaced ^D/T1/ Copies>)
	MOVE	S1,STREAM		;PICK UP STREAM NUMBER.
	$ACK  (<Backspaced ^D/T1/ Copies>,,@JOBOBA(S1),.MSCOD(M))
	PUSHJ	P,INPFEF		;FORCE END OF FILE.
	$RETT				;RETURN.



BFILES:	PUSHJ	P,INPFEF		;FORCE AN END-OF-FILE
	SOS	J$RNCP(J)		;ADD 1 COPY TO THE FILE COPY COUNT
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$ACK	(<Backspaced Current File>,,@JOBOBA(S1),.MSCOD(M))
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	S1,E			;POINT TO THE FD
	$TEXT	(LOGCHR,<^I/LPMSG/Backspaced to Beginning of ^F/0(S1)/>)
	$RETT

PAGES:	0,,0
	SUBTTL	DN60 OPERATOR CONSOLE OUTPUT SUPPORT ROUTINES

	;CALL:	M/ The Operator Message Address
	;
	;RET:	True Always

IFE FTDN60,<
OPRD60:	$RETT				;SHOULD NOT HAPPEN
OPRCHK:	$RETT				;JUST RETURN
>

IFN FTDN60,<
OPRD60:	SETOM	JOBITS			;DONT SAVE THE STATUS BITS
	MOVX	T1,.OTLPT		;GET LINE PRINTER OBJECT TYPE
	SETZM	T2			;GET UNIT 0
	MOVE	T3,.MSCOD(M)		;GET NODE NAME
	MOVEI	S1,T1			;POINT TO THIS OBJECT BLOCK
	PUSHJ	P,FNDOBJ		;FIND IT IN OUR DATA BASE
	JUMPT	OPRD.2			;ITS THERE,,CONTINUE ON
	$WTO(<No Operator Console for IBM Remote '^W/.MSCOD(M)/'>,,,<$WTFLG(WT.SJI)>)
	$RETT				;NOT FOUND,,TELL LOCAL OPR AND EXIT

OPRD.2:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A MINUTE
	MOVE	S1,J$LINK(J)		;GET THE OPR MSG LIST ID
	PUSHJ	P,L%LAST		;POSITION TO LAST ENTRY
	LOAD	S2,.MSTYP(M),MS.CNT	;GET THE MESSAGE LENGTH
	SUBI	S2,.OHDRS		;SUBTRACT ALL HEADER LENGTHS
	ADDI	S2,OPRLEN+2		;ADD OUR HEADER+TIME STAMP LENGTH
	MOVE	S1,J$LINK(J)		;GET THE OPR MSG LIST ID
	PUSHJ	P,L%CENT		;CREATE AN ENTRY IN THE LIST
	MOVE	P1,S2			;SAVE THE ENTRY ADDRESS
	MOVEI	P2,.OHDRS(M)		;POINT TO THE FIRST MESSAGE BLOCK
	LOAD	T1,.OARGC(M)		;GET THE BLOCK COUNT
	MOVEI	S1,OPRTXT(P1)		;GET THE TEXT ADDRESS
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,TEXTBP		;SAVE IT FOR $TEXT

OPRD.3:	LOAD	S1,ARG.HD(P2),AR.TYP	;GET THE BLOCK TYPE
	CAXN	S1,.ORDSP		;IS IT A DISPLAY BLOCK ???
	$TEXT	(DEPBP,<^C/ARG.DA(P2)/ ^T/ARG.DA+1(P2)/>) ;YES,,GEN THE DISPLAY
	CAXN	S1,.CMTXT		;IS IT A TEXT BLOCK ???
	$TEXT	(DEPBP,<^T/ARG.DA(P2)/>) ;YES,,GEN THE DISPLAY
	LOAD	S1,ARG.HD(P2),AR.LEN	;GET THIS BLOCK LENGTH
	ADD	P2,S1			;POINT TO THE NEXT BLOCK
	SOJG	T1,OPRD.3		;PROCESS ALL MESSAGE BLOCKS

	HRROI	S1,OPRTXT(P1)		;GEN BYTE PTR TO MSG TEXT
	MOVEM	S1,OPRPTR(P1)		;SAVE IT IN THE LIST
	HRRZ	S1,TEXTBP		;GET THE LAST TEXT ADDRESS
	SUBI	S1,OPRTXT-1(P1)		;CALC THE TEXT LENGTH
	IMULI	S1,5			;CALC THE NUMBER OF BYTES
	MOVNM	S1,OPRBCT(P1)		;SAVE THE -BYTE COUNT
	SETOM	J$OMSG(J)		;FLAG THAT THE STATION HAS A MESSAGE
	$RETT				;AND RETURN
	SUBTTL	OPRCHK - ROUTINE TO CHECK FOR DN60 OPR MSGS AND SEND THEM

	;CALL:	P1/ THE STREAM WE ARE CHECKING
	;RET:	True Always

OPRCHK:	SKIPN	J,JOBPAG(P1)		;IS THIS STREAM SETUP ???
	$RETT				;NO,,JUST RETURN
	MOVEI	S1,3			;GET 3 SECONDS
	MOVEM	S1,SLEEPT		;   AND SAVE IT FOR THE SCHEDULER
	SKIPN	J$OMSG(J)		;AND IS THERE AN OPR MESSAGE WAITING ?
	$RETT				;NO TO EITHER,,JUST RETURN
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	HRRZM	P1,STREAM		;HERE ALSO

OPRC.0:	MOVE	S1,J$LINK(J)		;GET THE OPR MSG LIST ID
	PUSHJ	P,L%FIRST		;GET THE FIRST MESSAGE ON THE CHAIN
	JUMPF	OPRC.3			;NONE THERE,,CLEAN UP AND RETURN
	MOVE	P1,S2			;SAVE THE MSG ADDRESS
	MOVE	S1,J$D6OP(J)		;GET THE OPR'S CONSOLE ID
	MOVE	S2,OPRPTR(P1)		;GET THE POINTER TO THE TEXT
	MOVE	T1,OPRBCT(P1)		;GET THE TEXT BYTE COUNT
	PUSHJ	P,D60SOUT##		;OUTPUT THE OPERATOR MESSAGE
	JUMPT	OPRC.2			;IF OK,,DELETE THIS MSG,,TRY NEXT
	CAXE	S1,D6DOL		;IS THE ERROR 'DEVICE OFFLINE'
	CAXN	S1,D6NBR		;   OR IS IT A NON-BLOCKING RETURN
	JRST	OPRC.1			;YES,,THEN HE WINS
	CAXN	S1,D6CGO		;IS ERROR 'CANT GET OUTPUT PERMISSION' ?
	$RETT				;YES,,JUST RETURN
	$WTO	(<Fatal DN60 Error #^O/S1/>,,,<$WTFLG(WT.SJI)>) ;TELL LOCAL OPR
	MOVX	S1,%RSUDE		;GET 'DOES NOT EXIST' SETUP CODE
	PUSHJ	P,RSETUP		;TELL QUASAR WHATS GOING ON
	PUSHJ	P,SHUTND		;SHUT EVERYTHING DOWN !!!
	$RETT				;AND RETURN

OPRC.1:	MOVEM	S2,OPRPTR(P1)		;SAVE THE NEW TEXT POINTER
	MOVEM	T1,OPRBCT(P1)		;SAVE THE NEW TEXT BYTE COUNT
	CAXN	S1,D6NBR		;WAS THE ERROR 'NON-BLOCKING RETURN' ???
	JRST	OPRC.0			;YES,,GO TRY OUTPUT AGAIN
	MOVX	S1,PSF%OO		;GET 'OPERATOR OUTPUT WAIT' BITS
	MOVE	S2,STREAM		;GET THIS STREAM NUMBER
	IORM	S1,JOBSTW(S2)		;LITE 'OPERATOR OUTPUT WAIT'
	$RETT				;RETURN, WAIT 3 SECONDS & RETRY

OPRC.2:	MOVE	S1,J$LINK(J)		;GET OPR MSG LIST ID
 	PUSHJ	P,L%DENT		;DELETE THE CURRENT MESSAGE
	JRST	OPRC.0			;AND GO PROCESS THE NEXT

OPRC.3:	MOVX	S1,PSF%OO		;GET 'OPERATOR OUTPUT WAIT' BITS
	MOVE	S2,STREAM		;GET OUR STREAM NUMBER
	ANDCAM	S1,JOBSTW(S2)		;CLEAR 'OPERATOR OUTPUT WAIT' BITS
	SETZM	J$OMSG(J)		;CLEAR MSGS WAITING FLAG
	MOVE	S1,J$D6OP(J)		;GET THE OPERATOR CONSOLE ID
	PUSHJ	P,D60EOF##		;TURN THE LINE AROUND
	$RETT				;AND RETURN
>
	SUBTTL BLDL - CREATE A 10/20 FD FOR THE ALIGN FILE.


BLDLFD:
TOPS10 <
	MOVEI	S1,FDMSIZ		;PICK UP 10 FD SIZE.
	STORE	S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IN FD.
	MOVSI	S1,'SYS'		;PICK UP STRUCTURE NAME.
	MOVEM	S1,J$AFD+.FDSTR(J)	;SAVE IN FD.
	MOVE	S1,J$FALI(J)		;PICK UP FILE NAME (FORMS TYPE).
	MOVEM	S1,J$AFD+.FDNAM(J)	;SAVE IN FD.
	MOVSI	S1,'ALP'		;PICK UP FILE EXT.
	MOVEM	S1,J$AFD+.FDEXT(J)	;SAVE IN FD.
	MOVEI	S1,J$AFD(J)		;PICK UP FD ADDRESS.
	$RETT				;RETURN. . . . . . . . . .
> ;END TOPS10 CONDITIONAL

TOPS20 <
	MOVEI	S1,AFDSIZ		;GET THE FD LENGTH
	STORE	S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IT
	$TEXT	(<-1,,J$AFD+.FDSTG(J)>,<SYS:^W/J$FALI(J)/.ALP^0>)
	MOVEI	S1,J$AFD(J)		;PICK UP FD ADDRESS.
	$RETT				;RETURN. . . . . . . . . .
> ;END TOPS20 CONDITIONAL
	SUBTTL	ALIGN Processor.

ALIGN:	TXNE	S,GOODBY!ABORT		;ARE WE LEAVING ???
	JRST	ALIG.5			;RETURN.
	MOVE	S1,J$AIFN(J)		;GET THE IFN
	PUSHJ	P,F%REW			;REWIND THE FILE
	SETZM	J$XTOP(J)		;CLEAR TOP OF FORM FLAG
	PUSHJ	P,SENDFF		;SEND A FORM-FEED

ALIG.1:	SOSGE	J$ABYT(J)		;DECREMENT THE BYTE COUNT
	JRST	ALIG.3			;IF BUFFER EMPTY,,GET NEXT BUFFER.
	ILDB	C,J$APTR(J)		;PICK UP THE ALIGN BYTE.
	PUSHJ	P,DEVOUT		;PUT IT OUT....
	JRST	ALIG.1			;GO GET NEXT BYTE.

ALIG.2:	PUSHJ	P,OUTDMP		;FORCE OUT THE BUFFER
	SOSLE	J$ACNT(J)		;COUNT DOWN
	JRST	ALIG.4			;IF AGAIN,,SET UP SLEEP TIME.
	SETZM	J$XTOP(J)		;CLEAR TOP OF FORM
	PUSHJ	P,SENDFF		;GO TO TOP OF FORM
ALIG.5:	MOVE	S1,J$AIFN(J)		;PICK UP ALIGN IFN.
	PUSHJ	P,F%REL			;CLOSE THE ALIGN FILE.
	SETZM	J$APRG(J)		;INDICATE NO ALIGN IN PROGRESS.
	SETZM	J$ASLP(J)		;CLEAR THIS SLEEP TIME
	SETZM	J$ACNT(J)		;AND THIS REPEAT COUNT
	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	SETOM	JOBCHK(S1)		;SAY WE WANT TO CHECKPOINT.
	$RETT				;AND RETURN

ALIG.3:	MOVE	S1,J$AIFN(J)		;GET ALIGN IFN.
	PUSHJ	P,F%IBUF		;GET AN ALIGN BUFFER.
	JUMPF	ALIG.2			;IF NO MORE,,SLEEP A WHILE.
	MOVEM	S1,J$ABYT(J)		;SAVE THE # OF BYTES.
	MOVEM	S2,J$APTR(J)		;SAVE THE BYTE POINTER.
	JRST	ALIG.1			;KEEP ON PROCESSING.

ALIG.4:	MOVE	S2,STREAM		;PICK UP STREAM NUMBER.
	PUSHJ	P,I%NOW			;GET CURRENT TIME.
	ADD	S1,J$ASLP(J)		;ADD /PAUSE VALUE.
	MOVEM	S1,JOBWKT(S2)		;SAVE WAKE UP TIME FOR STREAM.
	$DSCHD	(PSF%AL)		;SHOW STREAM BLOCKED FOR ALIGNMENT.
	JRST	ALIGN			;WHEN RETURN,,CONTINUE.
	SUBTTL FNDOBJ - ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE.

FNDOBJ:	MOVE	T1,.ROBTY(S1)		;GET OBJECT TYPE
	MOVE	T2,.ROBAT(S1)		;GET UNIT NUMBER
	MOVE	T3,.ROBND(S1)		;AND NODE NUMBER
	SETZ	T4,			;CLEAR AN INDEX REGISTER

FNDO.1:	MOVE	S2,T4			;GET THE INDEX
	IMULI	S2,3			;MULTIPLY BY OBJECT BLCK SIZE
	CAMN	T1,JOBOBJ+OBJ.TY(S2)	;COMPARE
	CAME	T2,JOBOBJ+OBJ.UN(S2)	;COMPARE
	JRST	FNDO.2			;NOPE
	CAMN	T3,JOBOBJ+OBJ.ND(S2)	;COMPARE
	JRST	FNDO.3			;WIN, SETUP THE CONTEXT
FNDO.2:	ADDI	T4,1			;INCREMENT
	CAIL	T4,NPRINT		;THE END OF THE LINE?
	$RETF				;YES,,RETURN 'OBJECT NOT THERE'
	JRST	FNDO.1			;OK, LOOP

FNDO.3:	MOVEM	T4,STREAM		;SAVE STREAM NUMBER
	SKIPN	J,JOBPAG(T4)		;GET ADDRESS OF DATA
	$RETF				;UNLESS ITS NOT REALLY SETUP THEN RETURN
	MOVE	S,J$RACS+S(J)		;GET HIS 'S'
	$RETT				;AND RETURN
	SUBTTL SNDQSR - ROUTINE TO SEND A MESASGE TO QUASAR.

SNDQSR:	MOVX	S1,SP.QSR		;GET QUASAR FLAG
	TXO	S1,SI.FLG		;SET SPECIAL INDEX FLAG
	STORE	S1,SAB+SAB.SI		;AND STORE IT
	SETZM	SAB+SAB.PD		;CLEAR THE PID WORD
	LOAD	S1,.MSTYP(T1),MS.CNT	;GET THE MESSAGE LENGTH
	STORE	S1,SAB+SAB.LN		;SAVE IT
	STORE	T1,SAB+SAB.MS		;SAVE THE MESSAGE ADDRESS
	MOVEI	S1,SAB.SZ		;LOAD THE SIZE
	MOVEI	S2,SAB			;AND THE ADDRESS
	PUSHJ	P,C%SEND		;SEND THE MESSAGE
	JUMPT	.RETT			;AND RETURN

	$STOP(QSF,Send to QUASAR FAILED)



	SUBTTL	CHKLPT - ROUTINE TO MAKE SURE THE DEVICE IS ONLINE 

CHKLPT:

TOPS20 <
	SKIPE	S1,JOBSTW		;ARE ANY STATUS BITS SET ???
	TXNN	S1,PSF%DO		;IF SO,,IS IT DEVICE OFFLINE ???
	$RETT				;NO TO EITHER,,JUST RETURN
	$WTO	(<^T/BELL/>,,@JOBOBA)	;TELL OPR DEVICE IS OFFLINE
	PUSHJ	P,UPDTST		;SEND A STATUS UPDATE
	SETOM	JOBCHK			;INDICATE WE WANT ANOTHER WHEN WE CAN
> ;END TOPS20 CONDITIONAL

	$RETT				;RETURN


	SUBTTL	TOOBAD - ROUTINE TO RESPOND TO THE OPERATOR IF HIS REQUEST IS TOO LATE.


TOOBAD:	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	$ACK	(Print Request Completed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	$RETT
	SUBTTL	LOGCHR  --  Type a character in the log file


LOGCHR:	CAIE	S1,.CHLFD		;IS IT A LINE-FEED
	CAIN	S1,23			;OR A DC 3?
	AOS	J$GNLN(J)		;YES, COUNT ANOTHER LINE
LOGC.1:	SOSGE	J$GIBC(J)		;IS THERE ROOM?
	JRST	LOGC.2			;NO, GET ANOTHER PAGE
	IDPB	S1,J$GIBP(J)		;YES, DEPOSIT THE CHARACTER
	$RETT				;AND RETURN

LOGC.2:	PUSH	P,S1			;SAVE THE CHARACTER FOR A MINUTE
	PUSHJ	P,LOGBUF		;GET ANOTHER PAGE
	POP	P,S1			;RESTORE THE CHARACTER
	JRST	LOGC.1			;AND TRY AGAIN


SUBTTL	LOGBUF  --  Get a buffer page for LOG

LOGBUF:	PUSHJ	P,.SAVE1		;SAVE P1
	AOS	P1,J$GINP(J)		;INCREMENT BUFFER PAGE COUNT
	CAIN	P1,1			;IS THIS THE FIRST PAGE?
	JRST	[MOVE S1,J$GBUF(J)	;YES, USE THE PRE-ALLOCATED PAGE
		 JRST LOGB.1]		;AND CONTINUE ON
	CAIL	P1,^D10			;NO, WITHIN RANGE?
	$STOP(TML,TOO MANY LOG BUFFERS REQUIRED) ;NO,,COMMIT SUICIDE
	PUSHJ	P,M%GPAG		;GET A PAGE
	ADDI	P1,-1(J)		;POINT TO LOCATION IN J$GBUF
	MOVEM	S1,J$GBUF(P1)		;STORE THE ADDRESS
LOGB.1:	HRLI	S1,(POINT 7,0)		;MAKE A BYTE POINTER
	MOVEM	S1,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	SYSTEM ACCOUNTING ROUTINES

TOPS10 <
ACTBEG:	$RETT				;JUST RETURN

ACTEND:	$RETT				;HERE ALSO
>  ;END TOPS10 CONDITIONAL


TOPS20 <
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
	LOAD	S1,.EQSEQ(J),EQ.PRI	;GET EXTERNAL PRIORITY
	STORE	S1,J$APRI(J)		;STORE IT
	$RETT				;RETURN

ACTEND:	MOVX	S1,.FHSLF		;LOAD FORK HANDLE
	RUNTM				;GET RUNTIME
	ADDM	S1,J$ARTM(J)		;STORE IT
	SKIPN	ACTFLG			;ARE WE DOING ACCT?
	$RETT				;NO,,RETURN NOW.
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET THE INVALID ACCT STRING BIT
	JUMPN	S1,.RETT		;IF LIT,,THEN JUST RETURN
	MOVX	S1,.USENT		;WRITE AN ENTRY
	MOVEI	S2,ACTLST		;POINT TO THE LIST
	USAGE				;DO THE JSYS
	 ERJMP	ACTE.1			;ON AN ERROR,,TELL THE OPERATOR
	$RETT				;ELSE RETURN
ACTE.1:	MOVE	S1,STREAM		;GET THIS STREAM NUMBER
	$WTO	(System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	$RETT				;RETURN

	;ACCOUNT PARAMETER BLOCK DEFINED ON THE NEXT PAGE
	SEARCH	ACTSYM			;SEARCH THE ACCOUNTING UNV
ACTLST:	USENT.	(.UTOUT,1,1)
	USJNO.	(-1)			;JOB NUMBER
	USTAD.	(-1)			;CURRENT DATE/TIME
	USTRM.	(-1)			;TERMINAL DESIGNATOR
	USLNO.	(-1)			;TTY LINE NUMBER
	USPNM.	(<SIXBIT/LPTSPL/>,US%IMM) ;PROGRAM NAME
	USPVR.	(%LPT,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(-1)			;NODE NAME
	USACT.	(<POINT 7,.EQACT(J)	;ACCOUNT STRING POINTER>)
	USSRT.	(J$ARTM(J))		;RUN TIME
	USSDR.	(J$ADRD(J))		;DISK READS
	USSDW.	(0,US%IMM)		;DISK WRITES
	USJNM.	(.EQJOB(J))		;JOB NAME
	USQNM.	(<SIXBIT /LPT/>,US%IMM)	;QUEUE NAME
	USSDV.	(J$LDEV(J))		;DEVICE NAME
	USSSN.	(J$ASEQ(J))		;JOB SEQUENCE NUMBER
	USSUN.	(J$APRT(J))		;TOTAL PAGES PRINTED
	USSNF.	(J$AFXC(J))		;TOTAL FILES PROCESSED
	USCRT.	(.EQAFT(J))		;CREATION DATE/TIME OF REQUEST
	USSCD.	(J$RTIM(J))		;SCHEDULED DATE/TIME
	USFRM.	(J$FORM(J))		;FORMS TYPE
	USDSP.	(<SIXBIT/NORMAL/>,US%IMM) ;DISPOSITION
	USTXT.	(<-1,,[ASCIZ / /]>)	;SYSTEM TEXT
	USPRI.	(J$APRI(J))		;JOB PRIORITY
	USNM2.	(<POINT 7,.EQOWN(J)	;USER NAME>)
	0				;END OF LIST
>  ;END TOPS20 CONDITIONAL
	SUBTTL	INPOPN  --  Routine to open the input file

;INPOPN IS CALLED WITH AC "E" POINTING TO THE FP AREA FOR THE FILE
;	TO BE OPENED.

INPOPN:	MOVEI	S1,FOB.SZ		;GET THE FOB SIZE
	MOVEI	S2,J$XFOB(J)		;AND THE FOR ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO IT OUT
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	S1,E			;GET THE FD ADDRESS
	MOVEM	S1,J$DFDA(J)		;SAVE THE ADDRESS
	STORE	S1,J$XFOB+FOB.FD(J)	;SAVE IN THE FOB
	MOVEI	S1,7			;LOAD PROBABLE (7 BIT) BYTE SIZE
	LOAD	T1,.FPINF(E),FP.FFF	;GET /FILE:
	LOAD	T2,.FPINF(E),FP.FPF	;GET /PRINT:
	CAXN	T1,.FPF8B		;WAS IT /FILE:8-BIT???
	MOVEI	S1,^D8			;YES,,LOAD 8 BIT BYTE SIZE
	CAXN	T1,.FPF11		;WAS IT /FILE:ELEVEN???
	MOVEI	S1,^D36			;YES,,LOAD 36 BIT BYTE SIZE
	CAIE	T1,.FPFCO		;/FILE:COBOL?
	CAIN	T2,%FPLOC		;OR /PRINT:OCTAL?
	MOVEI	S1,^D36			;YES, USE FULL WORDS
	STORE	S1,J$XFOB+FOB.CW(J),FB.BSZ  ;AND SAVE THE BYTE SIZE
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET THE USERS PRIVILGE BITS
	JUMPN	S1,INPO.1		;IF SET, AVOID ACCESS CHECK
	LOAD	S1,.FPINF(E),FP.SPL	;LIKEWISE IF SPOOLED
	JUMPN	S1,INPO.1		; ...
	
TOPS10 <
	MOVE	S1,.EQOID(J)		;GET THE PPN
	STORE	S1,J$XFOB+FOB.US(J)	;AND SAVE IT
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	HRROI	S1,.EQOWN(J)		;GET THE OWNERS NAME
	STORE	S1,J$XFOB+FOB.US(J)	;SAVE IT
	HRROI	S1,.EQCON(J)		;GET CONNECTED DIRECTORY
	STORE	S1,J$XFOB+FOB.CD(J)	;AND SAVE IT
>  ;END TOPS20 CONDITIONAL

INPO.1:	MOVEI	S1,FOB.SZ		;GET FOB SIZE
	MOVEI	S2,J$XFOB(J)		;AND ADDRESS
	PUSHJ	P,F%IOPN		;OPEN THE FILE
	JUMPF	INPO.2			;JUMP IF FAILED
	MOVEM	S1,J$DIFN(J)		;ELSE, SAVE THE IFN
	TXO	S,DSKOPN		;INDICATE THE FILE IS OPEN.
	$RETT				;AND RETURN

INPO.2:	$TEXT(LOGCHR,<^I/LPERR/Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/>)
	ZERO	.FPINF(E),FP.DEL	;CLEAR THE 'DELETE FILE' BIT
	TXZ	S,DSKOPN		;INDICATE THE FILE IS NOT OPEN.
	$RETF				;AND RETURN
	SUBTTL	INPBUF  --  Read a buffer from the input file

INPBUF:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%IBUF		;GET A BUFFERFUL
	JUMPF	INPERR			;LOSE
	MOVEM	S1,J$DBCT(J)		;SAVE THE BYTE COUNT
	MOVEM	S2,J$DBPT(J)		;AND THE BYTE POINTER
	AOS	J$ADRD(J)		;ADD 1 TO BUFFER READ COUNT.
	EXCH	S1,J$FCBC(J)		;GET OLD BUFR BYTE CNT AND SAVE NEW
	ADDM	S1,J$FTBC(J)		;BUMP TOTAL BYTES PROCESSED
	$RETT				;THEN RETURN.

SUBTTL	INPBYT  --  Read a byte from the input file

INPBYT:	SOSGE	J$DBCT(J)		;MAKE SURE THERE IS DATA IN THE BUFFER.
	JRST	INPB.1			;IF NOT,,GET ANOTHER BUFFER.
	ILDB	C,J$DBPT(J)		;PICK UP A BYTE FROM THE BUFFER.
	$RETT				;AND RETURN.
INPB.1:	PUSHJ	P,INPBUF		;READ THE NEXT BUFFER.
	JUMPF	.RETF			;NO MORE,,RETURN.
	JRST	INPBYT			;ELSE GET THE NEXT BYTE.

SUBTTL	INPERR  --  Handle an input failure

INPERR:	CAXN	S1,EREOF$		;WAS IT EOF?
	$RETF				;WAS JUST RETURN
	$TEXT(LOGCHR,<^I/LPERR/Error reading input file -  ^E/[-1]/>)
	TXO	S,SKPFIL		;SKIP THE REST OF THE FILE
	$RETF				;AND RETURN

SUBTTL	INPFEF  --  Force end-of-file on next input

INPFEF:	TXNN	S,DSKOPN		;IS THE SPOOL FILE OPEN ???
	$RETT				;NO,,JUST RETURN
	MOVE	S1,J$DIFN(J)		;GET THE IFN
	SETOB	S2,J$DBCT(J)		;CLEAR BYTE COUNT AND SET EOF POS
	PUSHJ	P,F%POS			;AND POSITION IT
	$RETT				;AND RETURN

SUBTTL	INPREW  --  Rewind the input file

INPREW:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REW			;REWIND IT
	SETOM	J$DBCT(J)		;AND SET THE BYTE COUNT
	SETZM	J$RNPP(J)		;AND SET PAGE 0
	MOVEI	S1,J$FPAG(J)		;GET THE PAGE COUNTER TABLE ADDRESS
	MOVEM	S1,J$FBPT(J)		;AND SAVE IT.
	SETZM	J$FCBC(J)		;CLEAR CURRENT INPUT BUFFER BYTE COUNT
	SETZM	J$FTBC(J)		;CLEAR TOTAL INPUT BYTE COUNT
	TXZ	S,FBPTOV		;CLEAR PAGE TABLE OVERFLOW BIT
	MOVX	S1,PAGSIZ		;GET THE TABLE LENGTH.
	MOVEI	S2,J$FPAG(J)		;GET THE START ADDRESS.
	PJRST	.ZCHNK			;RETURN, ZEROING THE PAGE TABLE
	SUBTTL	FORMS   --  Setup Forms for a job

FORMS:	GETLIM	S1,.EQLIM(J),FORM	;GET THE FORMS TYPE
	CAMN	S1,J$FORM(J)		;OR ARE FORMS EXACTLY THE SAME?
	$RETT				;YES,,VFU AND RAM MUST BE SAME TO !!!
	MOVE	S2,[POINT 7,J$WTOR(J)]	;GET POINTER TO WTOR BUFFER.
	MOVEM	S2,TEXTBP		;AND SAVE IT FOR DEPBP.
	SKIPN	S2,J$FORM(J)		;GET FORMS TYPE
	MOVX	S2,FRMNOR		;USE NORMAL IF NULL
	XOR	S1,S2			;GET COMMON PART
	AND	S1,[EXP FRMSK1]		;AND IT WITH THE IMPORTANT PART
	GETLIM	S2,.EQLIM(J),FORM	;GET FORMS TYPE
	EXCH	S2,J$FORM(J)		;SAVE IT
	MOVEM	S2,J$FPFM(J)		;SAVE OLD ONES
	SKIPE	S1			;NO NEED TO CHANGE FORMS.
	$TEXT	(DEPBP,<Please load forms type '^W/J$FORM(J)/'>)

FORM.1:	MOVE	S1,J$FDRU(J)		;GET THE CURRENT DRUM TYPE
	MOVEM	S1,J$PDRU(J)		;AND SAVE IT
	MOVE	S1,J$FRIB(J)		;GET THE CURRENT RIBBON TYPE
	MOVEM	S1,J$PRIB(J)		;AND SAVE IT
	MOVE	S1,J$FTAP(J)		;GET THE CURRENT CARRIAGE CONTROL TAPE
	MOVEM	S1,J$PTAP(J)		;AND SAVE IT
	MOVE	S1,J$LRAM(J)		;GET THE DEFAULT RAM FILE NAME
	MOVEM	S1,J$FRAM(J)		;AND MAKE IT THE CURRENT RAM TYPE
	HRLZI	S1,-F$NSW		;GET NEGATIVE SWITCH TABLE LEN
	MOVEI	T1,J$FCUR(J)		;POINT TO CURRENT FORMS PARAMS

FORM.2:	MOVE	S2,FFDEFS(S1)		;GET A DEFAULT
	CAME	S2,[-1]			;IS THIS SUPPOSED TO BE DEFAULTED ???
	MOVEM	S2,(T1)			;YES,,SAVE IT
	ADDI	T1,1			;INCREMENT NEW PARAM STORE CTR
	AOBJN	S1,FORM.2		;AND LOOP

	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

	GETLIM	T1,.EQLIM(J),FORM	;FORMS NAME
	MOVEM	T1,J$FALI(J)		;SAVE IT AS DEFAULT ALIGN FILE NAME

FORM.3:	PUSHJ	P,FRMINI		;READ THE LPFORM.INI FILE.
	SKIPE	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	$RETT				;YES,,JUST RETURN NOW !!
	MOVE	S1,TEXTBP		;GET THE WTOR BYTE POINTER.
	CAMN	S1,[POINT 7,J$WTOR(J)]	;IS THERE A MESSAGE FOR THE OPERATOR ??
	JRST	FORM.5			;NO,,TRY LOADING VFU AND RAM
	$TEXT	(DEPBP,<^T/ENDRSP/^0>)	;ADD THE RESPONSE TO THE END

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

FORM.4:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTOR  (,<^T/J$WTOR(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
	SETOM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE.
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	$RETF				;YES,,RETURN NOW
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	FORM.4			;NO,,STUPID OPERATOR SO TRY AGAIN

FORM.5:	PUSHJ	P,LODRAM		;TRY TO LOAD THE RAM
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED ???
	$RETF				;YES,,RETURN NOW
	PUSHJ	P,LODVFU		;TRY TO LOAD THE VFU
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED ???
	$RETF				;YES,,RETURN NOW
	$RETT				;NO,,HE WINS SO FAR !!!


ENDRSP:	ASCIZ	/Type 'Respond <number> CONTINUE' When Ready/
FRMINI:	SKIPN	FMOPN			;IS LPFORM OPEN?
	POPJ	P,			;NO, JUST RETURN
	MOVE	S1,FMIFN		;YES, GET THE IFN
	PUSHJ	P,F%REW			;REWIND IT
	SETZM	FMBYT			;SET FILE BYTE COUNT TO 0

FRMIN1:	PUSHJ	P,FH$SIX		;GET THE FORMS NAME
	JUMPF	.RETT			;EOF!!
	GETLIM	T2,.EQLIM(J),FORM	;GET FORMS
	CAMN	T1,T2			;MATCH??
	JRST	FRMIN2			;YES!!
FRMI1A:	PUSHJ	P,FH$EOL		;NO, FIND NEXT LINE
	JUMPF	.RETT			;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
	JUMPF	.RETT			;EOF
	JRST	FRMIN2			;AND LOOP

FRMIN3:	PUSHJ	P,FH$SIX		;GET A LOCATOR
	JUMPF	.RETT			;EOF!!
	JUMPE	T1,FRMI3A		;MAYBE PAREN??
	JRST	FRMIN4			;AE	S2,TL%NOM+TL%

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!!

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
	JUMPF	.RETT			;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
	JUMPF	.RETT		;EOF!!
	JRST	FRMIN5		;AND LOOP AROUND
FRMI5A:	PUSHJ	P,FH$SIX	;GET THE SWITCH
	JUMPF	.RETT		;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
	MOVE	S1,STREAM	;GET THE STREAM NUMBER.
	$WTOJ	(LPFORM.INI Error,<Unrecognized switch ^W/T1/ found.>,@JOBOBA(S1))
	JRST	FRMIN5		;AND LOOP

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

FRMIN9:	MOVE	S1,STREAM	;GET THE STREAM NUMBER.
	$WTOJ	(Bad format in LPFORM.INI,,@JOBOBA(S1))
	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
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FRIB(J)		;SAVE IT
	CAME	T1,J$PRIB(J)		;SKIP IF NOT CHANGED
	$TEXT	(DEPBP,<Load Ribbon type '^W/J$FRIB(J)/'>)
	POPJ	P,			;AND RETURN

S$DRUM:
S$CHAI:	PUSHJ	P,FH$SIX		;GET SIXBIT ARG
	JUMPF	.RETT			;EOF!!
	MOVEM	T1,J$FDRU(J)		;SAVE IT
	CAME	T1,J$PDRU(J)		;SKIP IF NOT CHANGED
	$TEXT	(DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>)
	POPJ	P,			;AND RETURN

S$NOTE:	MOVE	T1,[POINT 7,J$FNBK(J)]
	SETZ	T2,			;CLEAR THE COUNTER

S$NOT1:	PUSHJ	P,FH$CHR		;GET A CHARACTER
	JUMPF	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:	$TEXT	(DEPBP,<Note: ^T/J$FNBK(J)/>) ;ADD THE MSG TO WTOR.
	$RETT				;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:	CAIN	C,"/"			;ARE WE AT THE BEGINNING OF A SWITCH ??
	PJRST	OALI.2			;YES,,JUST USE FORMS NAME AS ALIGN FILE
	PUSHJ	P,FH$SIX		;GET THE ALIGN FILENAME ARGUMENT
	SKIPE	T1			;SKIP IF NOTHING THERE
	MOVEM	T1,J$FALI(J)		;SAVE THE ALIGN FILENAME
	PUSHJ	P,OALI.2		;SCHEDULE THE FORMS ALIGNMENT
	POPJ	P,			;AND RETURN

S$VFU:
S$TAPE:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FTAP(J)		;SAVE IT
	CAME	T1,J$PTAP(J)		;ARE OLD AND NEW THE SAME?
	SKIPE	J$LDVF(J)		;OR DOES DEVICE HAVE A DAVFU?
	$RETT				;OLD=NEW OR SOFTWARE VFU,,RETURN
	$TEXT	(DEPBP,<Load CARRIAGE CONTROL TAPE '^W/J$FTAP(J)/'>)
	$RETT

S$RAM:	PUSHJ	P,FH$SIX		;GET THE SIXBIT ARGUMENT
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FRAM(J)		;SAVE IT
	$RETT				;AND RETURN
	SUBTTL	LODVFU  --  Load the Vertical Forms Unit

LODVFU:	SKIPN	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	SKIPN	J$LDVF(J)		;OR DOES THIS PRINTER HAVE A VFU ???
	$RETT				;TO TAPE OR NO VFU,,JUST RETURN.
	MOVE	S1,J$FTAP(J)		;GET NECESSARY VFU TYPE
	CAMN	S1,J$FLVT(J)		;IS IT IN THERE ALREADY?
	$RETT				;YES, RETURN
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Loading VFU with '^W/J$FTAP(J)/',,@JOBOBA(S1))

TOPS20 <
	$TEXT(<-1,,J$XTBF(J)>,<SYS:^W/J$FTAP(J)/.VFU^0>)

LODV.2:	MOVX	S1,GJ%OLD+GJ%SHT	;SHORT, OLD FILE ONLY
	HRROI	S2,J$XTBF(J)		;POINT TO STRING
	GTJFN				;GO GET THE JFN FOR THE FILE
	 ERJMP	NOVFU			;ERROR,,LETS TRY SOMETHING ELSE
LODV.3:	MOVE	T3,S1			;COPY THE JFN OVER
	MOVE	S1,J$LCHN(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
	PUSHJ	P,$MTOPR		;LOAD THE VFU
	MOVE	S1,T3			;GET THE VFU JFN ONCE MORE
	RLJFN				;RELEASE IT
	JFCL				;IGNORE ANY ERRORS
	 JUMPF	LODV.4			;CANT LOAD VFU,,GO FIND OUT WHY.
	MOVE	T1,J$FTAP(J)		;GET THE VFU TYPE
	MOVEM	T1,J$FLVT(J)		;SAVE AS CURRENTLY LOADED
	POPJ	P,			;AND RETURN

LODV.4:	MOVX	S1,.FHSLF		;GET MY HANDLE
	GETER				;GET THE LAST ERROR CODE
	HRRZS	S2,S2			;GET JUST THE ERROR CODE
	CAXE	S2,MTOX17		;IS THE ERROR 'DEVICE OFFLINE' ???
	JRST	NOVF.1			;NO,,LETS TRY SOME OTHER
	PUSHJ	P,OUTWON		;SAY 'DEVICE OFFLINE'
	JRST	LODV.2			;AND TRY AGAIN

>  ;END TOPS20 CONDITIONAL
	SUBTTL	TOPS10 VFU LOADING ROUTINES

TOPS10 <
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	TXO	S,VFULOD		;FLAG THE FACT WE'RE LOADING THE VFU

	;ON SYSTEM STARTUP, SEE IF THE VFU IS VALID AND IF SO THROW OUT A
	;FORM FEED. IF NOT, ASK OPR TO ALIGN FORMS BEFORE LOADING VFU.

	SKIPE	J$LVFF(J)		;IS THIS THE FIRST TIME THROUGH ???
	JRST	LODV.0			;NO,,SKIP THIS
	SETOM	J$LVFF(J)		;RESET THE FIRST TIME THROUGH FLAG
	MOVE	T1,[2,,T2]		;GET THE DEVOP. PARAMETERS
	MOVX	T2,.DFRDS		;GET 'READ DEVICE STATUS' FUNCTION CODE
	MOVE	T3,J$LDEV(J)		;GET THE SIXBIT DEVICE NAME
	DEVOP.	T1,			;GET THE DEVICE STATUS
	 $STOP	(LDF,Line Printer Device Status DEVOP. Failed) ;SHOULD'NT HAPPEN
	TXNE	T1,DF.LVE		;DOES THE LPT HAVE A GOOD VFU ???
	JRST	LOD.0A			;NO,,DONT OUTPUT FORM FEED
	MOVX	C,.CHFFD		;GET FORM FEED CODE
	PUSHJ	P,DEVOUT		;PUT IT OUT
	PUSHJ	P,OUTDMP		;ALIGN THE FORMS ON THE PRINTER
	JRST	LODV.0			;AND GO RELOAD THE VFU

LOD.0A:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTOR(<Align Forms and Put Online>,<^T/ENDRSP/>,@JOBOBA(S1),JOBWAC(S1))
	SETOM	JOBCHK(S1)		;TAKE A CHECKPOINT WHEN WE CAN
	$DSCHD	(PSF%OR)		;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;ARE WE STILL IN BUSINESS ???
	JRST	[SETZM J$FORM(J)	;NO,,ZAP THE LOADED FORMS TYPE
		 TXZ   S,VFULOD		;CLEAR THE VFU LOAD FLAG
		 $RETT ]		;AND RETURN
	MOVEI	S1,CONANS		;GET THE ANSWER BLOCK ADDRESS
	HRROI	S2,J$RESP(J)		;POINT TO THE OPERATORS RESPONSE
	$CALL	S%TBLK			;CHECK ONE AGAINST THE OTHER
	TXNE	S2,TL%NOM+TL%AMB	;DO THEY MATCH ???
	JRST	LOD.0A			;NO,,STUPID OPERATOR - TRY AGAIN !!

LODV.0:	LOAD	S1,J$LCLS(J)		;GET THE PRINTER CONTROLLER CLASS
	CAXN	S1,.DFS20		;FRONT END LPT ???
	JRST	LODV.4			;YES,,DO THINGS A LITTLE DIFFERENTLY

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVE	S1,J$FTAP(J)		;GET FILENAME
	STORE	S1,VFUFD+.FDNAM		;AND STORE IN THE FD
	MOVEI	S1,FOB.SZ		;GET THE FOB SIZE
	MOVEI	S2,FOB			;AND FOB ADDRESS
	PUSHJ	P,.ZCHNK		;AND ZERO IT
	MOVEI	S1,VFUFD		;GET FD ADDRESS
	STORE	S1,FOB+FOB.FD		;STORE
	MOVEI	S1,7			;GET 7 BIT BYTE SIZE
	STORE	S1,FOB+FOB.CW,FB.BSZ	;AND STORE
	MOVEI	S1,FOB.SZ		;GET FOB SIZE
	MOVEI	S2,FOB			;AND FOB ADDRESS
	PUSHJ	P,F%IOPN		;SETUP TO READ IT
	 JUMPF	NOVFU			;FILE NOT THERE,,HE LOSES !!!
	MOVEM	S1,J$FVIF(J)		;ELSE,,SAVE THE IFN
	MOVE	T1,[2,,T2]		;ARGS FOR DEVOP
	MOVX	T2,.DFENV		;ENABLE VFU LOAD
	MOVE	T3,J$LDEV(J)		;FOR I/O DEVICE
	DEVOP.	T1,			;DO IT
	  JRST	NODAVF			;ASSUME NO DAVFU
LODV.1:	SOSGE	J$FBYT(J)		;CHECK AND SEE IF DATA IS IN BUFFER.
	JRST	LODV.3			;IF NOT,,GET NEXT BUFFER.
	ILDB	C,J$FPTR(J)		;PICK UP A BYTE.
	PUSHJ	P,DEVOUT		;WRITE IT OUT.
	JRST	LODV.1			;GO GET ANOTHER.
LODV.2:	PUSHJ	P,OUTDMP		;FORCE OUT THE BUFFERS
	MOVE	T1,[2,,T2]		;LOAD ARG POINTER
	MOVX	T2,.DFDVL		;DISABLE VFU LOAD
	MOVE	T3,J$LCHN(J)		;AND CHANNEL NUMBER
	DEVOP.	T1,			;DO IT!
	  JRST	NODAVF			;LOSE
	MOVE	S1,J$FVIF(J)		;GET THE IFN
	PUSHJ	P,F%REL			;RELEASE IT
	MOVE	T1,J$FTAP(J)		;GET TAPE NAME
	MOVEM	T1,J$FLVT(J)		;SAVE AS TYPE LOADED
	TXZ	S,VFULOD		;CLEAR THE VFU LOAD FLAG
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	$RETT				;OK,,JUST RETURN
LODV.3:	MOVE	S1,J$FVIF(J)		;GET VFU IFN.
	PUSHJ	P,F%IBUF		;GET ANOTHER BUFFER.
	 JUMPF	LODV.2			;IF NO MORE,,RETURN
	MOVEM	S1,J$FBYT(J)		;SAVE THE BYTE COUNT
	MOVEM	S2,J$FPTR(J)		;SAVE THE BYTE POINTER.
	JRST	LODV.1			;CONTINUE PROCESSING.

VFUFD:	$BUILD	FDMSIZ
	 $SET(.FDLEN,FD.LEN,VFUFDL)	;FD LENGTH
	 $SET(.FDEXT,,<SIXBIT/VFU/>)	;FILENAME EXTENSION
	 $SET(.FDSTR,,<SIXBIT/SYS/>)	;FILE STRUCTURE
	$EOB

	VFUFDL==.-VFUFD			;FD LENGTH
	;FOR FRONT END LINE PRINTERS, WE MUST DO THINGS A LITTLE DIFFERENTLY !!

LODV.4:	OPEN	17,VFUFOB		;OPEN THE STRUCTURE
	 JRST	NOVFU			;CANT,,TRY SOMETHING ELSE
	MOVE	S1,J$FTAP(J)		;GET THE VFU WE WANT
	MOVEM	S1,VLKUP+0		;SAVE IN THE LOOKUP BLOCK
	MOVSI	S1,'VFU'		;GET THE EXTENSION
	MOVEM	S1,VLKUP+1		;SAVE IN THE LOOKUP BLOCK
	SETZM	VLKUP+2			;CLEAR 3'RD WORD OF LOOKUP BLOCK
	SETZM	VLKUP+3			;CLEAR 4'TH WORD OF LOOKUP BLOCK
	LOOKUP	17,VLKUP		;FIND THE FILE WE WANT
	 JRST	VDON.2			;NOT THERE,,TRY SOMETHING ELSE
	PUSHJ	P,M%GPAG		;GET A PAGE FOR A BUFFER
	MOVE	T4,S1			;SAVE THE ADDRESS FOR LATER
	MOVEI	T1,-1(S1)		;GET BUFFER ADDRESS-1
	HLL	T1,VLKUP+3		;GET -FILE LENGTH,,BUFFER ADDR-1
	SETZM	T2			;END CCW
	IN	17,T1			;READ THE VFU FILE
	SKIPA				;CONTINUE ON SUCCESSFUL RETURN
	 JRST	VDON.1			;AN ERROR,,TRY SOMETHING ELSE
	HLRO	T3,VLKUP+3		;GET -FILE LENGTH
	MOVMS	T3			;WANT POSITIVE LENGTH
	IMULI	T3,5			;CALC NUMBER OF VFU BYTES
	MOVEI	T1,.DFLV2		;WANT LOAD VFU FUNCTION
	MOVE	T2,J$LCHN(J)		;WANT LPT CHANNEL NUMBER
	MOVE	S1,[4,,T1]		;GET ARG COUNT,,BLOCK ADDRESS
	SETZM	S2			;FLAG S2 (IF 0 THEN VFU LOADED OK)
	DEVOP.	S1,			;LOAD THE VFU
VDON.1:	 SETOM	S2			;FLAG THAT VFU LOAD FAILED
	MOVE	T1,S2			;SAVE THE VFU LOAD FLAG

	MOVE	S1,T4			;GET THE BUFFER ADDRESS BACK
	PUSHJ	P,M%RPAG		;RELEASE THE PAGE

VDON.2:	MOVEI	S1,17			;GET THE CHANNEL NUMBER
	RESDV.	S1,			;WIPE IT OUT
	JFCL				;IGNORE ANY ERROR RELEASING THE DEVICE
	JUMPN	T1,NOVF.1		;LOAD FAILED,,TRY SOMETHING ELSE

	MOVE	S1,J$FTAP(J)		;GET THE VFU TYPE WE JUST LOADED
	MOVEM	S1,J$FLVT(J)		;SAVE IT AS LOADED VFU TYPE
	TXZ	S,VFULOD		;CLEAR THE VFU LOAD FLAG
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	$RETT				;OK,,RETURN

VFUFOB:	.IODMP				;DUMP MODE I/O
	SIXBIT/SYS/			;FILE ON SYS:
	0,,0				;DUMP MODE (NO BUFFERS)

VLKUP:	BLOCK	4			;LOOKUP BLOCK

>  ;END TOPS10 CONDITIONAL
	SUBTTL	HERE IF VFU FILE THAT WE ARE LOOKING FOR IS NOT AROUND

NOVFU:	MOVE	T1,J$FTAP(J)		;TYPE WE TRIED TO LOAD
	CAME	T1,D$TAPE		;IS IT THE DEFAULT
	JRST	NOVF.1			;NO, GIVE UP

TOPS10 <
	MOVE	T1,[2,,T2]		;ARGS FOR DEVOP
	MOVEI	T2,.DFLLV		;LOAD HARDWARE VFU
	MOVE	T3,J$LCHN(J)		;FOR CHANNEL
	DEVOP.	T1,			;DO IT
	  JRST	NOVF.1			;LOSE
	MOVE	T1,D$TAPE		;GET NAME OF NORMAL
	MOVEM	T1,J$FLVT(J)		;STORE IT
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Error loading VFU,Loaded hardware VFU instead.,@JOBOBA(S1))
	TXZ	S,VFULOD		;CLEAR THE VFU LOAD FLAG
	$RETT				;AND RETURN

;HERE WHEN DEVOP FAILS...CLEAR DAVFU FLAG AND RETURN

NODAVF:	SETZM	J$LDVF(J)		;CLEAR THE FLAG
	MOVE	S1,J$FTAP(J)		;GET THE FORMS TYPE.
	MOVEM	S1,J$FLVT(J)		;   AND SAVE THEM AS LAST USED.
	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL

NOVF.1:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTOR	(,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1))
	SETOM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	$DSCHD	(PSF%OR)		;WAIT FOR THE REPLY.
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ??
	JRST	[SETZM J$FORM(J)	;YES,,ZAP THE LOADED FORMS TYPE
		 TXZ   S,VFULOD		;CLEAR THE VFU LOAD FLAG
		 $RETT ]		;AND RETURN
	HRROI	S1,J$RESP(J)		;GET THE OPERATORS RESPONSE
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,J$FTAP(J)		;SAVE THE FORMS TYPE
	JRST	LODVFU			;TRY LOADING AGAIN.

VFUI1:	ITEXT	(<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2:	ASCIZ	/Respond with VFU type to continue/
	SUBTTL	LODRAM - ROUTINE TO LOAD THE TRANSLATION RAM

LODRAM:	SKIPN	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	SKIPE	J$LREM(J)		;OR IS THIS A REMOTE LPT ???
	$RETT				;YES,,RETURN NOW !!!
	MOVE	S1,J$FRAM(J)		;GET THE RAM WE WANT 
	CAMN	S1,J$FLRM(J)		;IS IT IN THERE ALREADY ???
	$RETT				;YES,,RETURN NOW !!!

TOPS20 <
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
	$TEXT	(<-1,,J$XTBF(J)>,<SYS:^W/J$FRAM(J)/.RAM^0>) ;GEN RAM FILE NAME

LODR.1:	MOVX	S1,GJ%OLD+GJ%SHT	;SHORT, OLD FILE ONLY
	HRROI	S2,J$XTBF(J)		;POINT TO FILE NAME
	GTJFN				;GET A JFN FOR THE TRANSLATION RAM
	 ERJMP	NORAM			;CANT GET A JFN,,TRY SOMETHING ELSE

LODR.2:	MOVE	T3,S1			;SAVE THE JFN
	MOVE	S1,J$LCHN(J)		;GET THE PRINTER JFN
	MOVX	S2,.MOLTR		;WANT 'LOAD RAM' MTOPR FUNCTION
	MOVEI	T1,T2			;GET ARG BLOCK ADDRESS
	MOVEI	T2,2			;GET ARG BLOCK LENGTH
	PUSHJ	P,$MTOPR		;GO DO THE MTOPR
	MOVE	S1,T3			;GET THE JFN BACK
	RLJFN				;RELEASE IT
	JFCL				;IGNORE ANY ERRORS
	JUMPF	LODR.3			;COULD NOT LOAD RAM,,FIND OUT WHY
	MOVE	S1,J$FRAM(J)		;GET THE RAM TYPE WE LOADED
	MOVEM	S1,J$FLRM(J)		;SAVE IT
	$RETT				;AND RETURN

LODR.3:	MOVX	S1,.FHSLF		;GET MY HANDLE
	GETER				;GET THE LAST ERROR
	HRRZS	S2,S2			;GET JUST THE ERROR CODE
	CAXE	S2,MTOX17		;IS THE ERROR 'LPT OFFLINE' ???
	JRST	NORAM			;NO,,LETS TRY SOME OTHER
	PUSHJ	P,OUTWON		;WAIT FOR THE LPT TO COME ONLINE
	JRST	LODR.1			;AND TRY AGAIN

>  ;END TOPS20 CONDITIONAL
TOPS10 <
	MOVE	S1,J$LCLS(J)		;GET THE CONTROLLER CLASS
	CAIE	S1,.DFS20		;IS THIS A CONSOLE FRONT END LPT ???
	$RETT				;NO,,THEN WE DONT LOAD THE RAM
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
	OPEN	17,RAMFOB		;OPEN THE STRUCTURE
	 JRST	NORAM			;CANT,,TRY SOMETHING ELSE
	MOVE	S1,J$FRAM(J)		;GET THE RAM WE WANT
	MOVEM	S1,RLKUP+0		;SAVE IN THE LOOKUP BLOCK
	MOVSI	S1,'RAM'		;GET THE EXTENSION
	MOVEM	S1,RLKUP+1		;SAVE IN THE LOOKUP BLOCK
	SETZM	RLKUP+2			;CLEAR 3'RD WORD OF LOOKUP BLOCK
	SETZM	RLKUP+3			;CLEAR 4'TH WORD OF LOOKUP BLOCK
	LOOKUP	17,RLKUP		;FIND THE FILE WE WANT
	 JRST	RDON.2			;NOT THERE,,TRY SOMETHING ELSE
	PUSHJ	P,M%GPAG		;GET A PAGE FOR A BUFFER
	MOVE	T4,S1			;SAVE THE ADDRESS FOR LATER
	MOVEI	T1,-1(S1)		;GET BUFFER ADDRESS-1
	HLL	T1,RLKUP+3		;GET -FILE LENGTH,,BUFFER ADDR-1
	SETZM	T2			;END CCW
	IN	17,T1			;READ THE RAM FILE
	SKIPA				;CONTINUE ON SUCCESSFUL RETURN
	 JRST	RDON.1			;AN ERROR,,TRY SOMETHING ELSE
	HLRO	T3,RLKUP+3		;GET -FILE LENGTH
	MOVMS	T3			;WANT POSITIVE LENGTH
	LSH	T3,2			;CONVERT TO 8 BIT BYTE COUNT
	MOVEI	T1,.DFLR2		;WANT LOAD RAM FUNCTION
	MOVE	T2,J$LCHN(J)		;WANT LPT CHANNEL NUMBER
	MOVE	S1,[4,,T1]		;GET ARG COUNT,,BLOCK ADDRESS
	SETZM	S2			;FLAG S2 (IF 0 THEN RAM LOADED OK)
	DEVOP.	S1,			;LOAD THE RAM
RDON.1:	 SETOM	S2			;INDICATE RAM LOAD ERROR
	MOVE	T1,S2			;SAVE THE RAM LOAD FLAG

	MOVE	S1,T4			;GET THE BUFFER ADDRESS BACK
	PUSHJ	P,M%RPAG		;RELEASE THE PAGE

RDON.2:	MOVEI	S1,17			;GET OUR CHANNEL NUMBER
	RESDV.	S1,			;WIPE IT OUT
	JFCL				;IGNORE ANY ERROR RELEASING THE DEVICE
	JUMPN	T1,NORAM		;IF AN ERROR,,GO TRY SOMETHING ELSE
	MOVE	S1,J$FRAM(J)		;GET THE RAM TYPE WE JUST LOADED
	MOVEM	S1,J$FLRM(J)		;SAVE IT AS LOADED RAM TYPE
	$RETT				;AND RETURN

RAMFOB:	.IODMP				;DUMP MODE I/O
	SIXBIT/SYS/			;FILE ON SYS:
	0,,0				;DUMP MODE (NO BUFFERS)

RLKUP:	BLOCK	4			;LOOKUP BLOCK
>  ;END TOPS10 CONDITIONAL
	SUBTTL	NORAM - ROUTINE TO PROCESS RAM LOADING ERRORS

NORAM:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTOR	(,<^I/RAMI1/^J^M^T/RAMI2/>,@JOBOBA(S1),JOBWAC(S1))
	SETOM	JOBCHK(S1)		;WE WANT A CHECKPOINT TAKEN
	$DSCHD	(PSF%OR)		;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;CANCELED OR REQUEUED ???
	JRST	[SETZM J$FORM(J)	;YES,,ZAP THE LOADED FORMS TYPE
		 $RETT ]		;AND RETURN
	HRROI	S1,J$RESP(J)		;GET THE RESPONSE ADDRESS
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,J$FRAM(J)		;SAVE THE NEW RAM TYPE
	JRST	LODRAM			;AND TRY AGAIN

RAMI1:	ITEXT	(<RAM Error, Can't Load RAM '^W/J$FRAM(J)/'>)
RAMI2:	ASCIZ	/Respond With RAM Type to Continue/
	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
	JUMPF	.RETF		;FAIL IF 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"
	$RETT			;NO REASONALBE

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:	SOSGE	FMBYT			;MAKE SURE THERE IS DATA IN BUFFER.
	JRST	FH$C.1			;IF NOT,,GET ANOTHER BUFFER.
	ILDB	C,FMPTR			;PICK UP A BYTE
	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
	$RETT				;ITS NOT
	SUBI	C,40			;YUP, CONVERT TO UPPER
	$RETT				;AND SKIP BACK

FH$C.1:	MOVE	S1,FMIFN		;PICK UP THE IFN.
	PUSHJ	P,F%IBUF		;READ A BUFFER.
	JUMPF	.RETF			;IF AN ERROR,,RETURN.
	MOVEM	S1,FMBYT		;SAVE THE INPUT BYTE COUNT.
	MOVEM	S2,FMPTR		;SAVE THE INPUT BYTE POINTER.
	JRST	FH$CHR			;CONTINUE PROCESSING.
;ROUTINE TO SEARCH FOR EOL IN LPFORM.INI

FH$EOL:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	JUMPF	.RETF		;FAIL IF EOF
	CAIE	C,.CHLFD	;EOL?
	JRST	FH$EOL		;NO, LOOP
	$RETT			;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
	JUMPF	.RETF		;EOF, RETURN
	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
	SUBTTL	OUTGET  --  OPEN the output device

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

TOPS10 <
OUTGET:	PUSHJ	P,GENDEV		;CREATE THE PHYSICAL DEVICE NAME.
	MOVEM	S1,J$LDEV(J)		;AND SAVE IT
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVEM	S1,J$LCHN(J)		;SAVE IT AS THE CHANNEL NUMBER
	MOVX	S2,PSF%DO+PSF%OB	;GET OFFLINE+OUTPUT BLOCKED BITS
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR THE SCHEDULING BITS
	LSH	S1,^D23			;SHIFT CHANNEL # TO RIGHT PLACE

	IOR	S1,[OPEN T1]		;MAKE IT AN INSTRUCTION
	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
	XCT	S1			;AND EXECUTE IT
	   JRST	OUTDNA			;LOSE GIVE ERROR

	MOVE	T1,[2,,T2]		;ARG POINTER
	MOVX	T2,.DFHCW		;HARDWARE CHARACTERISTICS WORD
	MOVE	T3,J$LCHN(J)		;GET CHANNEL NUMBER
	DEVOP.	T1,			;READ THE CHARS
	  JRST	OUTDDE			;SHOULDN'T HAPPEN

	TXNE	T1,DF.LCP		;IS IT A LOWER-CASE PRINTER?
	SETOM	J$LLCL(J)		;YES, SET THE FLAG
	MOVE	S1,[SIXBIT/LP64/]	;DEFAULT RAM TO 64 CHARACTER
	SKIPE	J$LLCL(J)		;UNLESS ITS LOWER CASE
	MOVE	S1,[SIXBIT/LP96/]	;THEN DEFAULT TO 96 CHARACTER SET
	MOVEM	S1,J$LRAM(J)		;SAVE THE DEFAULT RAM FILE NAME
	MOVE	S1,D$TAPE		;GET THE DEFAULT VFU TYPE.
	SKIPN	J$FTAP(J)		;HAS THE VFU ALREADY BEEN DEFAULTED ???
	MOVEM	S1,J$FTAP(J)		;NO,,SAVE AS THE VFU DEFAULT.
	LDB	S1,[POINTR(T1,DF.CLS)]	;GET THE COBTROLLER TYPE
	MOVEM	S1,J$LCLS(J)		;SAVE IT FOR LATER
	LDB	T1,[POINTR(T1,DF.VFT)]	;GET VFU TYPE
	CAIN	T1,.DFVTD		;IS IT A DAVFU?
	SETOM	J$LDVF(J)		;YES, SET THE FLAG
	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

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVNI	T2,BUFSIZ*BUFNUM	;LOAD -<COMPLETE BUFFER SIZE>
	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
	JRST	OUTSOK			;AND CONTINUE ON

OUTG.2:	MOVE	S1,J$LBUF(J)		;GET ADR OF BUFFER PAGE
	EXCH	S1,.JBFF		;SWAP IT WITH JOBFF
	MOVE	S2,J$LCHN(J)		;GET THE CHANNEL NUMBER
	LSH	S2,^D23			;POSITION IT
	IOR	S2,[OUTBUF 2]		;MAKE AN INSTRUCTION
	XCT	S2			;AND EXECUTE IT
	MOVEM	S1,.JBFF		;RESTORE JOBFF
	JRST	OUTSOK			;AND CONTINUE ON



GENDEV:	SKIPE	S1,J$MTAP(J)		;IS THERE A SPECIFIC DEVICE TO WRITE ON
	$RETT				;YES,,RETURN WITH DEVICE IN S1
	MOVE	T1,STREAM		;PICK UP STREAM NUMBER.
	MOVE	T1,JOBOBA(T1)		;PICK UP OBJECT BLOCK ADDRESS.
	MOVE	S1,OBJ.ND(T1)		;PICK UP THE NODE NUMBER.
	CAME	S1,CNTSTA		;IS IT THE CENTRAL SITE ???
	SETOM	J$LREM(J)		;NO,,THEN ITS A REMOTE LPT.
	IDIVI	S1,10			;SPLIT NODE NUMBER IN HALF.
	IMULI	S1,100			;SHIFT LEFT 2 DIGITS.
	ADD	S1,S2			;ADD SECOND NODE DIGIT.
	IMULI	S1,100			;SHIFT LEFT ANOTHER 2 DIGITS.
	ADD	S1,OBJ.UN(T1)		;ADD THE UNIT NUMBER.
	ADD	S1,[SIXBIT/LPT000/]	;CREATE THE PHYSICAL DEVICE NAME.
	POPJ	P,			;RETURN. . . . .

>  ;END TOPS10 CONDITIONAL
TOPS20 <
OUTGET:	SKIPE	J$MTAP(J)		;ARE  WE SPOOLING TO TAPE ???
	PJRST	TAPGET			;YES,,OPEN DIFFERENTLY
	MOVSI	S1,(POINT 8,0)		;GET 8 BIT BYTE POINTER
	MOVEM	S1,J$LBTZ(J)		;SAVE IT FOR LATER
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;GET OUR OBJECT BLOCK ADDRESS
	SKIPN	J$LREM(J)		;IS THIS A LOCAL LPT ???
	$TEXT	(<-1,,J$LSTG(J)>,<PLPT^O/OBJ.UN(S1)/:^0>) ;YES,,GEN UNIT NAME
	SKIPGE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	$TEXT	(<-1,,J$LSTG(J)>,<^W/OBJ.ND(S1)/::PLPT^O/OBJ.UN(S1)/:^0>)
	MOVX	S1,GJ%FOU!GJ%SHT	;LOAD GTJFN FLAGS
	HRROI	S2,J$LSTG(J)		;POINT TO THE STRING
	PUSHJ	P,$GTJFN		;GET THE LPT JFN
	 JUMPF	OUTDDE			;CANT,,FATAL ERROR
	MOVEM	S1,J$LCHN(J)		;WIN, SAVE THE JFN
	MOVX	S2,OF%WR+OF%OFL+8B5	;OPEN FOR WRITING 8 BIT BYTES
	PUSHJ	P,$OPENF		;OPEN THE DEVICE
	 JUMPF	OUTDNA			;CANT,,DEVICE NOT AVAILABLE NOW.
	PUSHJ	P,OUTRES		;SETUP/RESET THE OUTPUT BUFR POINTERS
	SKIPLE	J$LREM(J)		;IS THIS A DN60 (IBM) LPT ???
	JRST	[MOVX  S1,%RSUOK	;YES,,GET 'SETUP OK'
		 $RETT ]		;   AND SKIP THE REST OF THIS !!!
	MOVE	S1,J$LCHN(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
	PUSHJ	P,$MTOPR		;GO GET THE DEVICE STATUS
	 JUMPF	OUTSOK			;CANT,,IGNORE THE ERROR
	TXNE	T3,MO%FNX		;DOES THE LPT EXIST ???
	PJRST	[PUSHJ P,OUTREL		;NO,,RELEASE JFN AND CLOSE THE LPT
		 PJRST OUTDDE ]		;   AND RETURN THROUGH 'DOES NOT EXIST'
	TXNE	T3,MO%LCP		;IS IT A LOWER CASE PRINTER?
	SETOM	J$LLCL(J)		;YES, SET THE FLAG
	MOVE	S1,[SIXBIT/LP64/]	;DEFAULT TO 64 CHARACTER RAM
	SKIPE	J$LLCL(J)		;UNLESS IT IS A LOWER CASE LPT,
	MOVE	S1,[SIXBIT/LP96/]	;THEN ITS A 96 CHARACTER RAM
	MOVEM	S1,J$LRAM(J)		;SAVE THE DEFAULT RAM FILE NAME
	MOVE	S1,D$TAPE		;GET THE DEFAULT VFU TYPE.
	SKIPN	J$FTAP(J)		;HAS THE VFU ALREADY BEEN DEFAULTED ???
	MOVEM	S1,J$FTAP(J)		;NO,,SAVE AS THE VFU DEFAULT.
	TXNN	T3,MO%LVU		;IS IT NOT OPTICAL VFU
	SETOM	J$LDVF(J)		;YES, SET THAT
	MOVX	S1,PSF%DO		;DEVICE OFFLINE FLAG
	ANDCAM	S1,JOBSTW		;CLEAR THE VALUE
	TXNE	T3,MO%OL		;IS IT OFF-LINE?
	IORM	S1,JOBSTW		;YES, SET FLAG
	JRST	OUTSOK			;CONTINUE ON OK
>  ;END TOPS20 CONDITIONAL
	SUBTTL	OUTGET Exit Subroutines


OUTSOK:	PUSHJ	P,INTCNL		;CONNECT UP THE LPT
	JUMPF	OUTDDE			;DID NOT SUCCEED,,DEVICE DOES NOT EXIST
	TXO	S,INTRPT		;INDICATE WE'RE CONNECTED
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN

OUTDNA:	MOVX	S1,%RSUNA		;NOT AVAILABLE RIGHT NOW
	$RETF				;AND RETURN

OUTDDE:	MOVX	S1,%RSUDE		;NEVER AVAILABLE
	$RETF				;RETURN
	SUBTTL	TAPGET - ROUTINE TO SETUP A MAG TAPE DEVICE FOR OUTPUT

TOPS20 <

TAPGET:	SKIPN	J$LSTG(J)		;DO WE HAVE A DEVICE NAME YET ???
	$TEXT	(<-1,,J$LSTG(J)>,<^W/J$MTAP(J)/:^0>) ;NO,,GEN THE DEVICE NAME
	SETZM	J$LREM(J)		;FORCE US TO BE LOCAL
	HRLI	S1,(POINT 7,0)		;GET 7 BIT BYTE POINTER (OUTPUT)
	MOVEM	S1,J$LBTZ(J)		;SAVE IT FOR LATER
	MOVX	S1,GJ%SHT+GJ%FOU	;GET GTJFN FLAG BITS
	HRROI	S2,J$LSTG(J)		;POINT TO THE DEVICE NAME
	GTJFN				;GET A JFN
	JRST	TAPG.2			;CANT,,TOUGH BREAKEEE
	MOVEM	S1,J$LCHN(J)		;SAVE THE JFN
	DVCHR				;GET THE DEVICE CHARACTERISTICS
	ERJMP	TAPG.1			;SHOULD NOT HAPPEN
	MOVX	S1,DEVX2		;GET ALREADY ASSIGNED ERROR CODE
	HLRZS	T1			;MOVE LEFT TO RIGHT,,ZERO LEFT
	CAIE	T1,-1			;THE TAPE SHOULD NOT BE ASSIGNED !!!
	JRST	TAPG.1			;IT IS,,CAN THE REQUEST
	MOVE	S1,J$LCHN(J)		;GET THE JFN BACK
	MOVX	S2,OF%WR+7B5		;WRITE+7 BIT BYTES
	OPENF				;OPEN THE MAG TAPE
	JRST	TAPG.1			;CANT,,TOUGH !!!
	MOVE	S1,J$LCHN(J)		;GET THE JFN
	MOVX	S2,.MONOP		;WAIT FOR I/O or SET TTY PAGE WIDTH
	SETZM	T1			;NO ARGS or INFINITE PAGE WIDTH
	MTOPR				;DO IT !!!
	ERJMP	.+1			;IGNORE THE ERROR
	PUSHJ	P,OUTRES		;SETUP THE OUTPUT POINTERS
	PJRST	OUTSOK			;SO FAR HE WINS...
TAPG.1:	MOVE	T1,S1			;SAVE THE ERROR CODE
	MOVE	S1,J$LCHN(J)		;GET THE JFN
	RLJFN				;RELEASE IT
	JFCL				;IGNORE THE ERROR
	MOVE	S1,T1			;RESTORE THE ERROR CODE TO S1
TAPG.2:	MOVE	S2,STREAM		;GET OUR STREAM NUMBER
	$WTO	(<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2)) ;TELL THE OPERATOR
	PJRST	OUTDDE			;GIVE UP THE SHIP
>
	SUBTTL	OUTOUT  --  Routine to output a buffer


TOPS10 <


	;NOTE:	The 'Output-Blocked' bit is set here in order to avoid
	;	a race condition which would allow LPTSPL to miss the
	;	'Output-Done' Interrupt. In particular, this avoids
	;	the problem of getting the 'Output-Done' interrupt
	;	before LPTSPL has set the 'Output-Blocked' bit when
	;	de-scheduling the stream. This situation would cause
	;	the stream to block forever, waiting for an interrupt
	;	which it had already received.



OUTOUT:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%OB		;GET THE 'OUTPUT-BLOCKED' BIT
	IORM	S2,JOBSTW(S1)		;TURN ON THE 'OUTPUT-BLOCKED' BIT
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL NUMBER
	LSH	S1,^D23			;POSITION IT
	TLO	S1,(OUT 0,0)		;MAKE IT AN OUTPUT UUO
	XCT	S1			;OUTPUT THE BUFFER
	JRST	[MOVE   S1,STREAM	;NO ERROR,,GET OUR STREAM NUMBER
		 ANDCAM S2,JOBSTW(S1)	;   AND CLEAR THE OUTPUT BLOCKED BITS
		 $RETT	]		;      NOW WE CAN RETURN
	PJRST	OUTERR			;ERROR,,GO PROCESS IT
>  ;END TOPS10 CONDITIONAL

TOPS20 <

OUTOUT:	PUSHJ	P,.SAVET		;SAVE THE 'T' ACS

OUTO.1:	PUSHJ	P,OUTWON		;CHECK OFFLINE STATUS
	$DSCHD(0)			;FORCE A SCHEDULING PASS
	SKIPGE	T1,J$LBCT(J)		;GET BYTES REMAINING IN BUFFER
	SETZM	T1			;IF LESS,,MAKE IT ZERO
	SUB	T1,J$LIBC(J)		;CALC -BYTE COUNT IN BUFFER
	JUMPGE	T1,OUTRES		;NOTHING TO PUT OUT,,RESET BUFR PTRS
	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVE	S2,J$LIBP(J)		;GET THE STARTING BYTE POINTER
	PUSHJ	P,$SOUT			;OUTPUT THE DATA
	MOVEM	S2,J$LIBP(J)		;SAVE THE BUFFER POINTER AND
	MOVMM	T1,J$LIBC(J)		;   THE BYTE COUNT JUST IN CASE
	SETZM	J$LBCT(J)		;CLEAR BYTE COUNT FOR THE BUFFER
	SKIPT				;SKIP IF SOUT WAS OK
	PUSHJ	P,OUTERR		;ELSE GO PROCESS THE ERROR
	SKIPLE	J$LIBC(J)		;ANY BYTES LEFT IN THE BUFFER ???
	JRST	OUTO.1			;YES,,GO PUT THEM OUT

OUTRES:	MOVEI	S1,BUFCHR		;GET CHARACTERS PER BUFFER
	MOVEM	S1,J$LBCT(J)		;SAVE AS BUFFER BYTE COUNT
	MOVEM	S1,J$LIBC(J)		;HERE ALSO
	MOVE	S1,J$LBUF(J)		;GET THE BUFFER ADDRESS
	ADD	S1,J$LBTZ(J)		;ADD THE BYTE PTR (LEFT HALF)
	MOVEM	S1,J$LBPT(J)		;SAVE AS BUFFER BYTE POINTER
	MOVEM	S1,J$LIBP(J)		;HERE ALSO
	$RETT				;AND RETURN

>  ;END TOPS20 CONDITIONAL
	SUBTTL	OUTERR  --  Handle Output Device Errors

OUTERR:
TOPS10 <
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL NUMBER
	LSH	S1,^D23			;POSITION IT
	IOR	S1,[GETSTS J$LIOS(J)]	;MAKE IT AN INSTRUCTION
	XCT	S1			;AND EXECUTE IT
	MOVE	S1,J$LIOS(J)		;GET THE IOERROR STATUS
	TXNE	S1,IO.ERR!IO.EOT	;WAS THERE AN ERROR? OR HIT END OF TAPE?
	JRST	OUTE.1			;YES, GIVE THE ERROR
	$DSCHD(0)			;BLOCK FOR OUTPUT DONE (See Above)
	JRST	OUTOUT			;AND TRY AGAIN

OUTE.1:	PUSHJ	P,.SAVET		;SAVE ALL THE 'T' ACS
	MOVE	T4,STREAM		;GET THE STREAM NUMBER
	MOVE	S1,J$LIOS(J)		;GET THE ERROR STATUS
	TRC	S1,IO.ERR		;TEST FOR ALL FOUR ERROR BITS
	TRCE	S1,IO.ERR		;BEING SET.
	JRST	OUTE.5			;AND THEY ARE NOT
	MOVE	T1,[2,,T2]		;PREPARE FOR DEVOP. UUO
	MOVEI	T2,.DFRES		;READ EXTENDED ERROR STATUS
	MOVE	T3,J$LCHN(J)		;GET CHANNEL NUMBER
	DEVOP.	T1,
	  JRST	OUTE.2			;LOSE, JUST GIVE STATUS
	CAXN	T1,IOVFE%		;IS THE ERROR BAD VFU ?
	JRST	OUTE.4			;YES,,DO SOME SPECIAL PROCESSING
	CAXE	T1,IOPAR%		;IS IT RAM TROUBLE ???
	JRST	OUTE.2			;NO,,GENERAL I/O ERROR
					;YES,,FALL THROUGH AND PROCESS IT
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	MOVE	T4,STREAM		;GET OUR STREAM NUMBER
	PUSHJ	P,$GDSTS		;GET THE DEVICE STATUS
	MOVEM	S1,J$LIOS(J)		;SAVE THE DEVICE STATUS
	MOVE	T1,S1			;SAVE IT HERE ALSO
	TXZ	S1,MO%OL		;CLEAR THE OFFLINE BIT
	PUSHJ	P,$SDSTS		;RESET THE DEVICE STATUS
	TXNE	T1,MO%LVF		;VFU ERR ???
	JRST	OUTE.4			;YES,,GO PROCESS IT
	TXNN	T1,MO%RPE		;WAS IT A RAM PARITY ERROR
	JRST	OUTE.2			;NO,,PROCESS AS AN I/O ERROR
>  ;END TOPS20 CONDITIONAL		;YES,,PROCESS IT

	;RAM PARITY ERROR

OUT.2A:	$WTO	(RAM Parity Error,,@JOBOBA(T4)) ;YES,,TELL OPERATOR
	PUSHJ	P,OUTE.3		;PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLRM(J)		;FORCE A RAM RELOAD
	PUSHJ	P,LODRAM		;GO DO IT !!!
	$RETT				;AND RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;UNKNOWN TYPE I/O ERROR OCCURED

OUTE.2:	$WTO  (I/O Error,<Status is: ^O/J$LIOS(J)/>,@JOBOBA(T4))

	;GENERAL I/O ERROR RECOVERY ROUTINE

OUTE.3:	PUSHJ	P,OUTDIE		;SEE IF TOO MANY ERRORS
	PUSHJ	P,OUTFLS		;RESET THE OUTPUT CHANNEL
	JUMPF	[MOVX  S1,%RSUNA	;CAN'T,,GET 'DEVICE NOT AVAILABLE' ERROR
		 PUSHJ P,RSETUP		;TELL QUASAR TO RESET THE OBJECT
		 PJRST SHUTIN ]		;SHUT DOWN THE DEVICE
	TXNN	S,VFULOD+BANHDR		;IF LOADING VFU OR PRINTING HDRS
	TXNN	S,DSKOPN		;   OR IF WE ARE NOT IN A FILE?
	$RETT				;THEN JUST RETURN
	MOVE	S1,J$RNCP(J)		;GET NUMBER OF COPIES PRINTED
	AOS	S1			;MAKE INTO CURRENCT COPY NUMBER
	$TEXT	(LOGCHR,<^I/LPERR/LPT I/O Error occurred during ^F/@J$DFDA(J)/, Copy:^D/S1/, Page:^D/J$RNPP(J)/; Status is: ^O/J$LIOS(J)/>)
	MOVEI	S1,[EXP 5]		;PREPARE TO BACKSPACE 5 PAGES
	PUSHJ	P,BSPACE		;BACKSPACE 5 PAGES
	$RETT				;RETURN

	;VFU ERROR OCCURED

OUTE.4:	$WTOR  (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
	SETOM	JOBCHK(T4)		;SAY WE WANT A CHECKPOINT TAKEN
	$DSCHD(PSF%OR)			;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	$RETT				;YES,,JUST RETURN
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	OUTE.4			;NO,,STUPID OPERATOR SO TRY AGAIN
	PUSHJ	P,OUTE.3		;GO PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLVT(J)		;FORCE A VFU RELOAD
	PUSHJ	P,LODVFU		;GO RELOAD THE VFU
	$RETT				;AND RETURN
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;NO STOCK ERROR BITS SET, TRY EOF (END OF TAPE)
TOPS10<
OUTE.5:	SKIPE	J$MTAP(J)		;ARE WE SPOOLING TO TAPE?
	TRZN	S1,IO.EOT		;YES, HIT EOT?
	JRST	OUTE.2			;NO, UNKNOWN ERROR
	MOVE	T1,J$LCHN(J)		;GET CHANNEL NUMBER
	LSH	T1,^D23			;MOVE INTO PLACE (AC FIELD)
	TLO	T1,(SETSTS (S1))	;MAKE INTO A UUO
	XCT	T1			;CLEAR THE ERROR (EOT)
	MOVE	T1,[XWD 2,T2]		;AIM AT ARGUMENT BLOCK FOR TAPOP.
	MOVX	T2,.TFWTM		;CODE TO WRITE A TAPE MARK
	MOVE	T3,J$LCHN(J)		;DEVICE ON THIS CHANNEL
	TAPOP.	T1,			;WRITE ONE MARK
	JFCL				;OH WELL
	TAPOP.	T1,			;WRITE ANOTHER (MARK END OF TAPE)
	JFCL				;ITS A BAD DAY (AND A BAD TAPE!)
	MOVX	T2,.TFUNL		;CODE TO GET RID OF THE TAPE
	TAPOP.	T1,			;UNLOAD THIS FULL REEL
	JFCL				;HAVE TO LIVE WITH IT
OUT.5A:	$WTOR	(End of tape,<Mount next reel on ^W/J$MTAP(J)/^M^Jand RESPOND with CONTINUE>,@JOBOBA(T4),JOBWAC(T4))
	SETOM	JOBCHK(T4)		;ASK FOR A CHECKPOINT
	$DSCHD	(PSF%OR)		;DROP THE STREAM TILL RESPONSE COMES IN
	TXNE	S,ABORT+RQB		;HAVE WE BEEN GIVEN THE GONG?
	$RETT				;YES, QUIT NOW
	MOVEI	S1,CONANS		;POINT TO THE VALID RESPONSES
	HRROI	S2,J$RESP(J)		;AIM AT WHAT THE OPR TYPED
	$CALL	S%TBLK			;BOUNCE RESPONSE OFF TABLE
	TXNE	S2,TL%NOM+TL%AMB	;MATCH?
	JRST	OUT.5A			;NO, ASK OPR AGAIN
	JRST	OUTOUT			;NEW REEL IS UP, TRY OUTPUT AGAIN
>;END OF TOPS10

CONANS:	1,,1				;TBLK CONTROL BLOCK
	[ASCIZ/CONTINUE/],,0		;POSSIBLE RESPONSE



OUTDIE:	SOSL	J$LERR(J)		;COUNT DOWN ERRORS
	POPJ	P,			;STILL ALIVE
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (TOO MANY DEVICE ERRORS,,@JOBOBA(S1))
	MOVEI	S1,%RSUDE		;GET DEVICE DOES NOT EXIST BIT.
	PUSHJ	P,RSETUP		;TELL QUASAR PRINTER IS OUT TO LUNCH.
	PJRST	SHUTIN			;AND SHUT IT DOWN
	SUBTTL	OUTWON  --  Wait for on-line

;On the -10, this routine should only be gotten to by DEBRKing to it
;	on a device off-line interrupt.  On the -20, it can be called
;	from anywhere.
;	NOTE: The ONLINE/OFFLINE (PSF%DO) status bits are set and cleared
;	      at interrupt level. This pervents a race condition from 
;	      occuring where the device comes online while we are still 
;	      processing the device offline interrupt. In this case
;	      it was possible for LPTSPL to miss the on-line
;	      change-of-state, and sleep forever waiting for the
;	      online interrupt.


TOPS10 <
OUTWON:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (<^T/BELL/>,,@JOBOBA(S1))	;TELL THE OPERATOR.
	$DSCHD(0)			;BLOCK THE PROCESS
	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	JRST	@J$LIOA(J)		;AND CONTINUE ON
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTWON:	MOVX	S2,PSF%DO		;DEVICE OFFLINE FLAG
	MOVE	S1,STREAM		;AND THE STREAM NUMBER
	TDNN	S2,JOBSTW(S1)		;IS IT OFF-LINE?
	POPJ	P,			;NO, JUST RETURN
	$WTO	(<^T/BELL/>,,@JOBOBA(S1))	;TELL THE OPERATOR.
	$DSCHD(0)			;BLOCK FOR DEVICE ONLINE
	POPJ	P,			;NO, RETURN
>  ;END TOPS20 CONDITIONAL

BELL:	BYTE(7) 07,07,117,146,146
	ASCIZ/line/
	SUBTTL	OUTREL  --  Release device on SHUTDOWN

TOPS10 <
OUTREL:	TXZE	S,INTRPT		;ARE WE CONNECTED TO INTRPT SYSTEM ??
	PUSHJ	P,INTDCL		;YES,,RELEASE THE INTERRUPTS
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL
	SKIPE	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	JRST	OUTR.1			;YES,,ISSUE A CLOSE/RELEASE INSTEAD
	RESDV.	S1,			;RESET THE CHANNEL
	JFCL				;IGNORE ANY ERRORS
	$RETT				;AND RETURN
OUTR.1:	LSH	S1,^D23			;POSITION THE CHANNEL NUMBER
	TLO	S1,(CLOSE 0,0)		;MAKE IT A CLOSE UUO
	XCT	S1			;CLOSE THE MAG TAPE 
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL NUMBER AGAIN
	LSH	S1,^D23			;POSITION IT
	TLO	S1,(RELEASE 0,0)	;MAKE IT A RELEASE UUO
	XCT	S1			;RELEASE THE DEVICE
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <
OUTREL:	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL(JFN)
	MOVX	S2,.MOFLO		;GET FLUSH BUFFERS CODE
	SETZ	T1,			;SET AC 3 TO 0
	PUSHJ	P,$MTOPR		;FLUSH THE BUFFERS
	 JUMPF	.+1			;IGNORE ANY ERRORS
	SKIPE	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	JRST	OUTR.1			;YES,,DO THINGS A LITTLE DIFFERENTLY
	MOVE	S1,J$LCHN(J)		;NO,,GET THE JFN AGAIN
	TXO	S1,CZ%ABT		;ABORT ALL OUTPUT OPERATIONS
	PUSHJ	P,$CLOSF		;CLOSE IT DOWN
	$RETT				;NO,, RETURN

OUTR.1:	MOVE	S1,J$LCHN(J)		;GET THE JFN
	MOVX	S2,.MONOP		;WAIT FOR ALL OUTPUT TO STOP
	SETZM	T1			;NO ARGS
	MTOPR				;DO IT !!!
	ERJMP	.+1			;IGNORE THE ERROR
	MOVX	S2,.MOEOF		;WANT TO WRITE SOME TAPE MARKS
	MTOPR				;WRITE ONE
	ERJMP	.+1			;IGNORE ANY ERROR
	MTOPR				;WRITE ANOTHER !!!
	ERJMP	.+1			;IGNORE THE ERROR
	MTOPR				;ONE MORE FOR GOOD LUCK !!!!
	ERJMP	.+1			;IGNORE THE ERROR
	MOVX	S2,.MORUL		;WANT TO REWIND AND UNLOAD THE TAPE
	MTOPR				;DO IT !!!
	ERJMP	.+1			;IGNORE THE ERROR
	TXO	S1,CZ%ABT		;LITE THE ABORT BIT
	CLOSF				;CLOSE DOWN THE MAG TAPE
	JFCL				;IGNORE THE ERROR
	$RETT				;AND RETURN
>;END TOPS20 CONDITIONAL
	SUBTTL	OUTEOF - ROUTINE TO CLEAR THE LPT OUTPUT BUFFERS


TOPS10 <
OUTEOF:	$SAVE	<T1>			;SAVE T1 FOR A MINUTE
	MOVX	S1,.TFWTM		;GET WRITE TAPE MARK CODE
	MOVE	S2,J$LCHN(J)		;GET THE DEVICE CHANNEL #
	MOVE	T1,[XWD 2,S1]		;GET LENGTH,,PARM BLOCK ADDRESS
	TAPOP.	T1,			;DO IT
	JFCL				;IGNORE ANY ERRORS
	$RETT				;AND RETURN
>

TOPS20 <
OUTEOF:	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MOEOF		;GET THE FLUSH BUFFERS CODE
	SETZM	T1			;NO ARGS
	PUSHJ	P,$MTOPR		;DO IT
	$RETT				;AND RETURN
>
	SUBTTL	OUTDMP  --  Dump out buffers and wait

TOPS10 <
OUTDMP:
REPEAT BUFNUM+1,<
	PUSHJ	P,OUTOUT		;DUMP THE BUFFER
>  ;END REPEAT BUFNUM
	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTDMP:	PUSHJ	P,OUTOUT		;DUMP THE INTERNAL BUFFERS
	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MONOP		;AND NO-OP FUNCTION
	SETZM	T1			;ZAP AC 3
	PUSHJ	P,$MTOPR		;DO IT
	SKIPT				;OK,,CONTINUE
	PUSHJ	P,OUTERR		;ELSE GO PROCESS THE ERROR
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL
	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).

TOPS10 <
OUTFLS:	PUSHJ	P,INTDCL		;DISCONNECT PRINTER INTERRUPTS
	MOVE	S1,J$LCHN(J)		;LOAD THE CHANNEL NUMBER
	RESDV.	S1,			;RESET THE CHANNEL
	  JFCL				;??
	PUSHJ	P,OUTGET		;GO RESET UP THE OUTPUT DEVICE
	CAIN	S1,%RSUOK		;ARE WE ALL RIGHT ???
	$RETT				;YES,,JUST RETURN
	PUSHJ	P,RSETUP		;NO,,SEND RESPONSE TO SETUP MSG
	$RETF				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTFLS:	MOVE	S1,J$LCHN(J)		;GET OUTPUT JFN
	MOVX	S2,.MOFLO		;LOAD FLUSH FUNCTION
	MOVEI	T1,0			;AND ZERO ARGUMENTS
	PUSHJ	P,$MTOPR		;FLUSH THE BUFFERS
	 JUMPF	OUTF.1			;ON AN ERROR,,SHUT IT DOWN AND RESET IT
	PUSHJ	P,OUTRES		;RESET THE OUTPUT POINTERS
	MOVX	S1,%RSUOK		;RETURN 'FLUSH' OK
	$RETT				;HEAD BACK

OUTF.1:	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	TXO	S1,CZ%ABT		;LITE THE ABORT BIT
	PUSHJ	P,$CLOSF		;CLOSE IT DOWN
	PJRST	OUTGET			;AND SET THE DEVICE UP AGAIN
>  ;END TOPS20 CONDITIONAL
	SUBTTL LPT CONTROL ROUTINES


;CONTROL CHARACTER TABLE
	NCLRFF==1B0		;DON'T CLEAR FORMFEED FLAG
	SUPRCH==1B1		;SUPPRESSABLE CHARACTER
	EOLCHR==1B2		;CHARACTER IS AN EOL (IN REPORT FILES)

CHTAB:	EXP	<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
	EXP	NCLRFF+DEVOUT		   ;(11) THIS IS A TAB
	EXP	SUPRCH+EOLCHR+DOLF	   ;(12) THIS IS A LINE FEED
	EXP	SUPRCH+EOLCHR+3+DOFRAC	   ;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
	EXP	SUPRCH+NCLRFF+EOLCHR+DOFORM   ;(14) THIS IS A FORM-FEED
	EXP	NCLRFF+EOLCHR+DEVOUT	   ;(15) CARRIAGE RETURN
	EXP	CHKARO			   ;(16) CONTROL-N
	EXP	CHKARO			   ;(17) CONTROL-O
	EXP	SUPRCH+EOLCHR+2+DOFRAC	   ;(20) THIS SKIPS 1/2 PAGE
	EXP	SUPRCH+EOLCHR+30+DOFRAC   ;(21) THIS SKIPS 2 LINES (DC1)
	EXP	SUPRCH+EOLCHR+20+DOFRAC   ;(22) THIS SKIPS 3 LINES (DC2)
	EXP	SUPRCH+EOLCHR+DODC3	   ;(23) DC3 SKIPS 1 LINE
	EXP	SUPRCH+EOLCHR+6+DOFRAC	   ;(24) THIS SKIPS 1/6 OF A PAGE (DC4)
	EXP	CHKARO			   ;(25) CONTROL-U
	EXP	CHKARO			   ;(26) CONTROL-OL-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
	SUBTTL FILOUT - SUBROUTINE TO SET UP FOR LPTIN AND LPTOUT

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

FILOUT:	MOVE	T1,J$FLIN(J)		;START AT TOP OF PAGE
	MOVEM	T1,J$XPOS(J)		;SAVE IT
	PUSHJ	P,SETPFT		;SETUP FILE TYPE
	PUSHJ	P,(T1)			;DISPATCH
	TXNN	S,RQB			;HAVE WE BEEN REQUEUED ???
	SKIPE	J$XTOP(J)		;OR ARE WE AT TOP-OF-FORM?
	POPJ	P,			;YES TO EITHER,,JUST RETURN
	AOS	J$APRT(J)		;NO, CHARGE HIM FOR THE REST
	AOS	J$RNPP(J)		;HERE ALSO
	POPJ	P,			;AND RETURN
	SUBTTL SETLST - SUBROUTINE TO COMPILE CODE TO TEST EACH LINE FOR A MATCH AGAINST

;	 THE /REPORT VALUE.
;	CALL WITH:
;		PUSHJ	P,SETLST
;		RETURN HERE
;



SETLST:	MOVEI	T2,J$XCOD-1(J)		;SET UP PDP TO COMPILED CODE
	SKIPN	.FPFR1(E)		;WAS /REPORT SPECIFIED?
	$RETT				;NO, JUST RETURN
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	T2,SETLSA		;COMPILE A PUSHJ
	PUSH	T2,SETLSB		;WE HAVE AN ERROR RETURN THEN
STLST4:	HLL	T1,SETLSC		;PLACE CHAR IN CAIE
	PUSH	T2,T1			;COMPILE THE CAIE
	PUSH	T2,SETLSD		;COMPILE THE JRST TO FLUSH7
	SOJG	T4,STLST2		;LOOP FOR WHOLE STRING
STLSC:	PUSH	T2,[POPJ P,]		;AND PROCESS THE CHARACTER
	POPJ	P,			;RETURN


;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA:	PUSHJ	P,INPBYT
SETLSB:	JUMPF	.RETT
SETLSC:	CAIE	C,0
SETLSD:	JRST	FLUSH7
	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)
;	LPTELV	<-->	/FILE:ELEVEN

;THE DETERMINATION IS DONE IN THE ABOVE ORDER


SETPFT:	LOAD	S1,.FPINF(E),FP.FFF	;GET /FILE
	LOAD	S2,.FPINF(E),FP.FPF	;GET /PRINT
	TXZ	S,ARROW			;CLEAR SOME INITIAL FLAGS
	TXO	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?
	TXO	S,ARROW			;YES, LIGHT A FLAG
	CAIN	S2,%FPLSU		;/PRINT:SUPPRESS?
	TXO	S,SUPFIL		;YES, LIGHT A BIT

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

	MOVEI	T1,LPTELV		;ASSUME /FILE:ELEVEN
	CAIN	S1,.FPF11		;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
	SUBTTL	LPTASC  --  Print Regular ASCII on LPT


LPTASC:	SOSL	J$DBCT(J)		;COUNT DOWN AND JUMP IF DATA IS THERE.
	JRST	LPTA.2			;GO GET A DATA BYTE.
	PUSHJ	P,INPBUF		;ELSE, GET A BUFFER FULL
	JUMPT	LPTASC			;IF OK,,CONTINUE PROCESSING.
	$RETT				;ELSE RETURN.

LPTA.2:	ILDB	C,J$DBPT(J)		;GET A CHARACTER
	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTA.5			;NO, GO HANDLE SPECIAL CHARS
	TXNE	S,FORWRD		;ARE WE FORWARD SPACING ???
	JRST	LPTASC			;YES,,SKIP THIS.
	SETZM	J$XTOP(J)		;CLEAR TOF FLAG
LPTA.3:	SOSGE	J$LBCT(J)		;ANY ROOM IN BUFFER?
	JRST	LPTA.4			;NO, FILL IT
	IDPB	C,J$LBPT(J)		;YES, DEPOSIT IN BUFFER
	JRST	LPTASC			;AND GET ANOTHER

LPTA.4:	PUSHJ	P,OUTOUT		;GET A BUFFER
	JRST	LPTA.3			;AND LOOP

LPTA.5:	PUSHJ	P,CHKSP			;GO HANDLE SPECIAL CHARS
	JRST	LPTASC			;AND LOOP AROUND
	SUBTTL	LPTELV  --  Print MACY11 file as regular ASCII


LPTELV:	PUSHJ	P,.SAVE1		;PRESERVE P1
LPTE.1:	SOSL	J$DBCT(J)		;COUNT DOWN AND JUMP IF DATA IS THERE.
	JRST	LPTE.2			;GO GET A DATA BYTE.
	PUSHJ	P,INPBUF		;ELSE, GET A BUFFER FULL
	JUMPT	LPTE.1			;IF OK,,GET NEXT FOUR BYTES
	$RETT				;ELSE RETURN.

LPTE.2:	ILDB	P1,J$DBPT(J)		;GET 4 BYTES TO PRINT
	LDB	C,[POINT 8,P1,17]	;GET THE FIRST BYTE
	PUSHJ	P,LPTE.3		;PRINT IT
	LDB	C,[POINT 8,P1,9]	;GET SECOND BYTE
	PUSHJ	P,LPTE.3		;PRINT IT
	LDB	C,[POINT 8,P1,35]	;GET THIRD BYTE
	PUSHJ	P,LPTE.3		;PRINT IT
	LDB	C,[POINT 8,P1,27]	;GET FOURTH BYTE
	PUSHJ	P,LPTE.3		;PRINT IT
	JRST	LPTE.1			;GET THE NEXT FOUR BYTES

LPTE.3:	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTE.6			;NO, GO HANDLE SPECIAL CHARS
	TXNE	S,FORWRD		;ARE WE FORWARD SPACING ???
	POPJ	P,			;YES,,SKIP THIS.
	SETZM	J$XTOP(J)		;CLEAR TOF FLAG
LPTE.4:	SOSGE	J$LBCT(J)		;ANY ROOM IN BUFFER?
	JRST	LPTE.5			;NO, FILL IT
	IDPB	C,J$LBPT(J)		;YES, DEPOSIT IN BUFFER
	POPJ	P,			;AND GET ANOTHER

LPTE.5:	PUSHJ	P,OUTOUT		;GET A BUFFER
	JRST	LPTE.4			;AND LOOP

LPTE.6:	PUSHJ	P,CHKSP			;GO HANDLE SPECIAL CHARS
	POPJ	P,			;AND LOOP AROUND
	SUBTTL	LPTFOR  --  Process FORTRAN data files

LPTFOR:	SOSLE	J$DBCT(J)		;AND CHARACTERS LEFT
	JRST	LPTF.1			;YUP, GET THEM
	PUSHJ	P,INPBUF		;NO, GET MORE DATA
	JUMPF	.RETT			;RETURN AT EOF
LPTF.1:	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,J$XFRC(J)		;SAVE THE REPEAT COUNT
	ANDI	C,177			;AND DOWN TO CHARACTER
FORC.3:	PUSHJ	P,LPTOUT		;SEND THE CHARACTER
	SOSLE	J$XFRC(J)		;COUNT DOWN THE REPEAT COUNTER
	JRST	FORC.3			;AND LOOP
	JRST	LPTFOR			;AND CONTINUE



SUBTTL	LPTRPT  --  Process REPORT files

LPTRPT:	PUSHJ	P,INPBYT		;GET A BYTE FROM THE FILE
	JUMPF	.RETT			;AND RETURN WHEN DONE
	PUSHJ	P,LPTOUT		;DO ALL THE CHECKING
	JRST	LPTRPT			;AND GET ANOTHER
	SUBTTL	LPTOCT  --  Give an Octal Dump

LPTOCT:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	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,INPBYT		;GET A WORD
	JUMPF	.RETT			;DONE!!
	MOVE	P3,C			;COPY WORD
	SETZM	J$XTOP(J)		;FLAG MIDDLE OF FORM
	MOVE	P1,[POINT 3,P3]		;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,.CHFFD		;PRINT A FORM FEED
	PUSHJ	P,DOFORM		;AND ENFORCE QUOTA ETC.
	JRST	OCT1			;PRINT NEXT PAGE
	SUBTTL	LPTCOB  --  Process COBOL Sixbit Files

LPTCOB:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	SETZM	J$XTOP(J)		;CAUSE A FORM FEED AT END
	PUSHJ	P,INPBYT		;GET THE FIRST WORD OF THE FILE
	JUMPF	.RETT			;NULL FILE
	HLRZ	T1,C			;COPY THE FIRST 3 LETERS
	CAIE	T1,'HDR'		;IS IT A HDR
	JRST	COBOL2			;NO--NORMAL INPUT
	MOVEI	T1,15			;FLUSH TAPE HEADER
	PUSHJ	P,INPBYT		;GET A WORD
	JUMPF	COBOL5			;EOF
	SOJG	T1,.-2			;LOOP FOR MORE


COBOL1:	PUSHJ	P,INPBYT		;GET A WORD
	JUMPF	COBOL5			;THE LAST WORD HAS COME
COBOL2:	ANDI	C,7777			;MASK TO 12 BITS
	JUMPLE	C,COBOL1		;IGNORE 0 COUNTS FOR OBVIOUS REASON
	MOVEI	P1,(C)			;COPY THE COUNT

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

COBOL3:	PUSHJ	P,INPBYT		;GET A DATA WORD
	JUMPF	.RETT			;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	T2,C			;COPY WORD
	MOVE	P2,[POINT 6,T2]		;POINT TO WORD
COBOL4:	ILDB	C,P2			;AND GET THE CHARACTER
	MOVEI	C,40(C)			;MAKE ASCII
	PUSHJ	P,DEVOUT		;PRINT
	SOJG	T1,COBOL4		;LOOP FOR NEXT CHAR
	SUBI	P1,6			;COUNT 6 MORE CHARS
	JUMPG	P1,COBOL3		;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:	MOVEI	C,.CHFFD		;GET A FORM FEED.
	PUSHJ	P,DEVOUT		;PUT IT OUT.
	$RETT				;AND RETURN.
	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)

LPTOUT:	CAIGE	C,40			;VISABLE ASCII
	JRST	CHKSP			;NO--SEE IF SPACE
LPTOU1:	TXZE	S,NEWLIN		;AND THIS IS A NEW LINE
	SKIPN	J$XCOD(J)		;LETS NOT DO A /REPORT IS THERE IS NO CODE.
	SKIPA				;DONT GO DOWN THE TUBES.
	JRST	J$XCOD(J)		;SEE IF REPORT LINE MATCHES
	SETZM	J$XTOP(J)		;CLEAR FORM FEED FLAG
	PJRST	DEVOUT			;PRINT IT

CHKSP:	MOVE	S1,CHTAB(C)		;GET THE DISPATCH
	TXNE	S1,EOLCHR		;IS THIS AN END OF LINE CHARACTER ???
	TXO	S,NEWLIN		;YES,,LITE NEW LINE BIT
	TXNN	S1,NCLRFF		;CLEAR FORMFEED FLAG?
	SETZM	J$XTOP(J)		;YES
	TXNE	S,SUPFIL!SUPJOB		;IN SUPPRESS MODE?
	TXNN	S1,SUPRCH		;YES, IS THIS CHARACTER SUPPRESSABLE?
	JRST	(S1)			;DISPATCH THE CHARACTER NORMALLY
	JRST	DOSUP			;SUPPRESS THE CHARACTER




;HERE TO THROW AWAY A LINE

FLUSH7:	PUSHJ	P,INPBYT	;GET A BYTE
	JUMPF	.RETT		;RETURN ON EOF
	PUSHJ	P,ISEOL		;END OF LINE?
	JUMPF	FLUSH7		;NO--LOOP FOR REST OF LINE
FLUSH8:	PUSHJ	P,INPBYT	;GET A BYTE
	JUMPF	.RETT		;RETURN ON EOF
	PUSHJ	P,ISEOL		;GOT EOL CHARACTER?
	JUMPF	LPTOUT		;NO, NEW LINE, DO THE MATCH
	JRST	FLUSH8		;YES, LOOP AGAIN


ISEOL:	CAIL	C," "			;IS IT PRINTABLE?
	$RETF				;YES, ITS NOT AN EOL
	MOVE	S1,CHTAB(C)		;NO, GET TABLE ENTRY
	TXNN	S1,EOLCHR		;IS IT AN EOL?
	$RETF				;NO, JUST RETURN
	TXO	S,NEWLIN		;YES, SET NEW LINE
	$RETT				;AND RETURN
;HERE ON A LINE FEED
DOLF:	LOAD	T1,.FPINF(E),FP.FSP	;GET SPACING PARAMETER
	SETO	S1,			;START WITH 1 LINE
DOLF1:	SOJLE	T1,CNTDWN		;ANY MORE?
	MOVEI	C,.CHLFD		;LOAD A LINE-FEED
	PUSHJ	P,DEVOUT		;YES--GIVE IT
	SOJA	S1,DOLF1		;AND SUBTRACT FROM QUOTA

;HERE TO PROCESS A FORM FEED
DOFORM:	SKIPE	J$XTOP(J)		;SKIP IF NOT AT TOP OF FORM
	POPJ	P,			;DO NOT PRINT BLANK PAGES
	MOVN	S1,J$XPOS(J)		;THIS TAKES ALL WE HAVE ON PAGE
	SKIPL	S1			;WAS VPOS NEGATIVE?
	CLEAR	S1,			;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
	SKIPE	J$XTOP(J)		;SKIP IF NOT TOP
	POPJ	P,			;ONLY 1 LINE FEED IN A ROW
	SETOM	J$XTOP(J)		;AND SET TOP
	SETO	S1,
	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 ON A DC3
DODC3:	SETOM	S1			;DC3 SKIPS 1 LINE
	JRST	CNTDWN			;AND COUNT DOWN

;HERE IF SPECIAL CHARACTER SKIPS A FRACTION OF A PAGE
DOFRAC:	HLRZS	S1			;GET 0,,FRACTION
	ANDI	S1,777			;AND OUT FLAGS
	MOVE	T1,J$FLIN(J)		;GET CURRENT PAGE SIZE
	IDIVI	T1,(S1)			;FIND THE RIGHT PART
	MOVE	T2,J$XPOS(J)		;GET CURRENT POSITION
	SOJL	T2,[MOVN S1,J$XPOS(J)	;COPY VPOS
		    SUBI S1,3		;SUBTRACT 3
		    JRST CNTDWN]	;AND CHARGE HIM
	IDIVI	T2,(T1)			;GET RESIDUE MOD SKIPSIZE
	MOVNI	S1,1(T3)		;AND MAKE IT NEGATIVE
	JRST	CNTDWN			;GO CHECK QUOTA
	SUBTTL	CNTDWN - COUNT DOWN LINE FEEDS AND PAGE FEEDS

	;CALL:	S1/ Line Count Modifier
	;	C/  The Character Being Printed
	;
	;RET:	TRUE ALWAYS

CNTDWN:	CAIL	C,12			;MAKE SURE THIS IS A CARRIAGE CONTROL
	CAILE	C,24			;   CHARACTER.
	PJRST	DEVOUT			;IF NOT,,JUST DUMP IT OUT.
	CAIN	C,.CHFFD		;IS IT A FORM FEED ???
	JRST	CNTDW1			;YES,,SKIP THIS.
	ADDB	S1,J$XPOS(J)		;REDUCE VERTICAL POSITION
	JUMPG	S1,DEVOUT		;JUMP IF STILL ON PAGE
	CAIN	C,23			;WAS IT A DC3?
	CAMG	S1,[-3]			;YES, GIVE HIM 3 EXTRA LINES
	JRST	CNTDW1			;OFF PAGE ANYWAY
	PJRST	DEVOUT			;HE WINS!!

CNTDW1:	MOVE	S1,J$FLIN(J)		;BACK TO TOP OF PAGE
	MOVEM	S1,J$XPOS(J)		;SAVE POSITION
	SOSG	J$FPIG(J)		;DECREMENT THE FORWARD SPACING COUNT.
	TXZ	S,FORWRD		;TURN OFF THE FORWARD SPACE BIT.
	TXNE	S,FORWRD		;FORWARD SPACING ???
	JRST	.+3			;YES,,SKIP THIS
	AOS	J$APRT(J)		;NO,,ADD 1 TO TOTAL PAGES COUNTER
	AOS	J$RNPP(J)		;NO,,ADD 1 TO PAGES PER COPY COUNTER

	;Here we keep track of where we are for backspaceing

	MOVE	S1,J$FCBC(J)		;GET NUMBER OF BYTES IN THIS BUFFER
	SUB	S1,J$DBCT(J)		;CALC BYT POS OF THIS PAGE IN THIS BUFR
	ADD	S1,J$FTBC(J)		;CALC BYT POS OF THIS PAGE IN THIS FILE
	MOVEM	S1,@J$FBPT(J)		;SAVE THE PAGE ADDRESS IN THE PAGE TABLE
	AOS	S1,J$FBPT(J)		;BUMP TO NEXT PAGE TABLE ENTRY
	CAIG	S1,J$FPAG+PAGSIZ(J)	;ARE WE AT THE END OF THE PAGE TABLE ???
	JRST	.+4			;NO,,CONTINUE ON
	TXO	S,FBPTOV		;YES,,LITE PAGE TABLE OVERFLOW FLAG
	MOVEI	S1,J$FPAG(J)		;AND WRAP THE
	MOVEM	S1,J$FBPT(J)		;   PAGE TABLE AROUND ITSELF

	PUSH	P,C			;SAVE THE CURRENT CHAR
	PUSHJ	P,CHKALN		;CHECK FOR ALIGNMENT
	POP	P,C			;RESTORE THE OLD CHARACTER
	MOVEI	S1,3			;LOAD A 3
	CAIN	C,23			;GET HERE VIA DC3?
	ADDM	S1,J$XPOS(J)		;YES, GIVE HIM 3 XTRA LINES
	CAIE	C,23			;WAS IT A DC3
	SETOM	J$XTOP(J)		;NO, SET TOP OF FORM
	MOVE	S1,J$RLIM(J)		;GET LIMIT
	SUB	S1,J$APRT(J)		;GET AMOUNT PRINTED

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	TXNN	S,ABORT+GOODBY		;ARE WE ON OUR WAY OUT OR
	SKIPL	S1			;   STILL UNDER QUOTA ???
	PJRST	DEVOUT			;YES,,PRINT THE POOR CHARACTER
	GETLIM	S1,.EQLIM(J),FLEA	;GET FORMS-LIMIT-EXCEED ACTION
	CAIN	S1,.STCAN		;SEE IF CANCEL
	JRST	CNTDW2			;IT WAS, DO IT
	CAIN	S1,.STIGN		;SEE IF IGNORE
	PJRST	DEVOUT			;YES, PRINT THE CHARACTER AND RETURN

	;DEFAULT TO ASK IF NOT IGNORE OR CANCEL

CNTDWX:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SETOM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT
	$WTOR	(Page Limit Exceeded,<^R/.EQJBB(J)/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1))
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	JRST	CNTIGN			;YES,,IGNORE THE ERROR
	MOVEI	S1,LIMANS		;POINT TO THE LIMIT ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	CNTDWX			;NO,,STUPID OPERATOR SO TRY AGAIN
	HRRZ	S1,0(S1)		;GET THE ROUTINE ADDRESS
	JRST	0(S1)			;AND PROCESS THE RESPONSE

	;IF ANSWER WAS 'IGNORE' COME HERE

CNTIGN:	MOVX	S1,.STIGN		;YES,,GET THE IGNORE BITS
	STOLIM	S1,.EQLIM(J),FLEA	;SAVE IT AS NEW LIMIT EX ACTION
	PJRST	DEVOUT			;GO DUMP THE BUFFERS

	;IF ANSWER WAS 'ABORT' COME HERE

CNTDWC:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	$WTO	(Aborting,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;TELL THE OPERATOR

CNTDW2:	$TEXT(LOGCHR,<^I/LPERR/Page Limit Exceeded>)
	SETZM	J$XTOP(J)		;CLEAR TOP-OF-FORM FLAG
	PUSHJ	P,SENDFF		;SEND A FORM FEED
	TXO	S,ABORT			;LIGHT THE ABORT BIT
	PJRST	INPFEF			;YES,,FORCE AN EOF

LIMANS:	2,,2
	[ASCIZ/ABORT/],,CNTDWC		;ABORT ENTRY
	[ASCIZ/IGNORE/],,CNTIGN		;IGNORE ENTRY
	;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
;	PUSHJ	P,DEVOUT
;	RETURN HERE (HALTS IF ERROR)
;

DEVOUT:	TXNE	S,FORWRD		;ARE WE FORWRD SPACING ???
	POPJ	P,			;YES,,RETURN.
DEVO.0:	SOSGE	J$LBCT(J)		;DECREMENT THE BYTE COUT
	JRST	DEVO.1			;LOSE, GO DUMP THE BUFFER
	IDPB	C,J$LBPT(J)		;DEPOSIT A BYTE
	POPJ	P,			;AND RETURN

DEVO.1:	PUSH	P,S1			;SAVE S1
	PUSHJ	P,OUTOUT		;DUMP THE BUFFER
	POP	P,S1			;RESTORE S1
	JRST	DEVO.0			;AND TRY AGAIN

;SENDFF - ROUTINE TO SEND A FF IF J$XTOP IS OFF
;
SENDFF:	MOVEI	C,.CHFFD		;LOAD A FF
	SKIPN	J$XTOP(J)		;SKIP IF ALREADY AT TOP
	PUSHJ	P,DEVOUT		;NO, SEND IT
	SETOM	J$XTOP(J)		;SET THE FLAG
	POPJ	P,			;RETURN


CHKALN:	SKIPL	J$APRG(J)		;IS AN ALIGNMENT SCHEDULED ???
	POPJ	P,			;NO,,RETURN.
	PUSHJ	P,ALIGN			;YES,,THEN DO IT.
	$RETT				;RETURN TO HIS CALLER.
	SUBTTL	Subroutines to send messages to the output device

;Since output to the output-device is interruptable $TEXT calls which
;	send characters directly to the device cannot be done.
;
;A per-context buffer (J$XTBF) is defined to store $TEXT'ed characters
;	in and the following set of subroutines exist to initialize,
;	deposit characters in, and dump this buffer to the output device.


;TBFINI initializes the byte-pointer to J$XTBF
TBFINI:	MOVEI	S1,J$XTBF(J)		;GET THE ADDRESS OF THE BUFFER
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,J$XTBP(J)		;STORE IT
	MOVEI	S2,0			;LOAD A NULL
	IDPB	S2,S1			;AND INITIALIZE THE BUFFER
	$RETT				;AND RETURN


;TBFCHR is the $TEXT subroutine to deposit characters in the text buffer.
TBFCHR:	IDPB	S1,J$XTBP(J)		;DEPOSIT THE CHARACTER
	$RETT				;RETURN


;TBFDMP dumps the text buffer to output device and re-initializes the buffer
TBFDMP:	SETZ	S1,			;CLEAR THE AC
	IDPB	S1,J$XTBP(J)		;DEPOSIT THE BYTE
	MOVEI	S1,J$XTBF(J)		;GET ADDRESS OF BUFFER
	PUSHJ	P,BFRDMP		;DUMP THE BUFFER
	PJRST	TBFINI			;RE-INIT THE BUFFER AND RETURN

;STGOUT is included to allow dumping of any arbitrary buffer of characters
;	Call with S1 containing either a byte pointer or the address of the buffer
STGOUT:	PUSH	P,S1			;SAVE S1
	PUSHJ	P,TBFDMP		;FORCE ANY BUFFERED STUFF OUT
	POP	P,S1			;RESTORE S1
					;AND FALL INTO BFRDMP

;BFRDMP to dump the buffer pointed to by S1
BFRDMP:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;PUT THE POINTER IN P1
	TLNN	P1,-1			;IS LEFT HALF ZERO
	HRLI	P1,(POINT 7,0)		;YES, MAKE IT A BYTE POINTER

BFRD.1:	ILDB	C,P1			;GET A CHARACTER
	JUMPE	C,.RETT			;RETURN WHEN DONE
	SETZM	J$XTOP(J)		;CLEAR THE TOP-OF-FORM FLAG
	CAIN	C,.CHFFD		;IS IT A FORMFEED?
	SETOM	J$XTOP(J)		;YES, SET IT
	PUSHJ	P,DEVOUT		;OUTPUT THE CHARACTER
	JRST	BFRD.1			;AND LOOP
	SUBTTL	ROUTINES TO GENERATE HEADERS AND TRAILERS

	;JOB HEADERS AND TRAILERS
JOBTRL:	MOVEI	T4,[ASCIZ /END/]	;ADDRESS OF END TEXT
	TXNE	S,RQB			;CLEAR REQUE AND SKIP IF NOT SET
	MOVEI	T4,[ASCIZ /REQUE/] 	;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
	MOVEI	T4,[ASCIZ /START/]	;ADDRESS OF START TEXT
	PUSHJ	P,GIVHDR		;GO SET THE LINE
	JRST	BANNER			;AND GO PRINT THE BANNER PAGES

GIVHDR:	$TEXT	(<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^R/.EQJBB(J)/  ^I/DATMON/^0>)

	MOVE	S1,J$FWID(J)		;GET THE PAGE WIDTH
	IDIVI	S1,5			;GET WORDS/BYTES TO THE END OF THE LINE
	ADDI	S1,J$XHBF(J)		;POINT TO THE LOGICAL END OF THE LINE
	LOAD	S2,PTRS(S2)		;GET BYTE PTR FOR END OF LINE
	SETZM	T1			;GET A NULL BYTE
	IDPB	T1,S2			;CUT THE HEADER OFF HERE !!!

	$RETT				;RETURN.

PTRS:	POINT	7,0(S1)
	POINT	7,0(S1),6
	POINT	7,0(S1),13
	POINT	7,0(S1),20
	POINT	7,0(S1),27
	POINT	7,0(S1),34
	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

TOPS10 <
	$TEXT(<-1,,J$PUSR(J)>,<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/^0>)
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	$TEXT(<-1,,J$PUSR(J)>,<^T/.EQOWN(J)/^0>)
>  ;END TOPS20 CONDITIONAL

BANN.1:	PUSHJ	P,SENDFF		;SEND A FORM FEED
	SETZM	J$XPOS(J)		;AND SET 0 POSITION
	MOVEI	T1,4			;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
	PUSHJ	P,CRLF			;TYPE A CRLF
	MOVEI	S1,1			;LOAD THE BLOCKSIZE
	MOVEI	S2,J$PUSR(J)		;AND THE STRING ADDRESS
	PUSHJ	P,PICTUR		;AND PRINT A PICTURE
	MOVEI	T1,^D12			;COUNT'EM
	ADDM	T1,J$XPOS(J)		;...
	PUSHJ	P,PLPBUF		;PRINT A LINE
	PUSHJ	P,PLPBUF		;AND ANOTHER
	PUSHJ	P,PLPBUF		;AND A THIRD
	MOVEI	T1,[0,,0]		;LOAD A NULL.
	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIN	S1,3			;ROOM ENOUGH FOR THE TITLE?
	MOVEI	T1,[ASCIZ /Note:/]	;YES, LOAD IT
	GETLIM	T2,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	JUMPE	T2,PLINES		;NO NOTE, FINISH THE PAGE
	GETLIM	T3,.EQLIM(J),NOT2	;AND THE SECOND HALF
	$TEXT(<-1,,J$PNOT(J)>,<^T/0(T1)/^W6/T2/^W/T3/^0>)
	MOVEI	S1,1			;GET THE BLOCKSIZE
	MOVEI	S2,J$PNOT(J)		;GET THE ADDRESS
	PUSHJ	P,PICTUR		;AND SEND IT OUT
	MOVEI	S1,^D11			;LOAD NUMBER OF LINES
	ADDM	S1,J$XPOS(J)		;AND MOVE DOWN THE PAGE
	PJRST	PLINES			;GO TO EOP AND RETURN
	SUBTTL	TRAILR  --  Routine to Print a Trailer

TRAILR:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	MOVE	P3,J$FTRA(J)		;AND THE NUMBER OF TRAILERS
	JUMPE	P3,OUTDMP		;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	OUTDMP			;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
	MOVEI	S1,[ASCIZ /* * * L P T S P L  R u n  L o g * * *

/]
	PUSHJ	P,STGOUT		;AND DUMP IT
	MOVE	T2,J			;COPY OVER J
	MOVE	T3,J$GINP(J)		;GET NUMBER OF PAGES
TRAI.4:	MOVE	S1,J$GBUF(T2)		;GET ADR OF BUFFER
	PUSHJ	P,STGOUT		;AND DUMP IT OUT
	MOVE	S1,J$GBUF(T2)		;GET THE PAGE ADDRESS
	CAME	T2,J			;SKIP IF THIS IS THE PRE-ALLOCATED PAGE
	PUSHJ	P,M%RPAG		;AND RELEASE IT
	CAMN	T2,J			;SKIP IF THIS IS NOT PRE-ALLOC PAGE
	PUSHJ	P,.ZPAGA		;ZERO IT THEN
	SOSLE	T3			;DECREMENT COUNT
	AOJA	T2,TRAI.4		;AND LOOP IF NOT DONE
	PUSHJ	P,CRLF			;PRINT 1 CRLF
	PUSHJ	P,CRLF			;AND ANOTHER
	PUSHJ	P,CRLF			;AND ANOTHER
	MOVE	T1,J$GNLN(J)		;GET NUMBER OF LOG LINES
	ADDI	T1,4			;ADD IN THE OVERHEAD
	ADD	T1,J$XPOS(J)		;AND ACCUMULATE VERTICAL POSITION
	IDIV	T1,J$FLIN(J)		;DID WE OVERFLW A PAGE?
	MOVEM	T2,J$XPOS(J)		;SAVE CURRENT POSITION
	SETZM	J$GNLN(J)		;AND DON'T PRINT IT AGAIN
	SUB	P3,T1			;REDUCE PAGES TO PRINT
	POPJ	P,			;AND RETURN
	SUBTTL - UTILITY ROUTINES

PLPBUF:	MOVEI	S1,J$XHBF(J)		;GET ADDRESS OF THE LINE
	PUSHJ	P,STGOUT		;AND DUMP IT
	PUSHJ	P,CR23			;END THE LINE WITH A CR23
	PUSHJ	P,CR23			;PRINT A CR23
	PUSHJ	P,CR23			;AND ANOTHER
	PUSHJ	P,CR23			;AND ANOTHER
	MOVEI	S1,4			;WE PRINT 4 LINES
	ADDM	S1,J$XPOS(J)		;ADD TO COUNT
	POPJ	P,



PLINES:	MOVE	T2,J$FLIN(J)		;GET LINES/PAGE
	ADDI	T2,1			;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
	PUSHJ	P,CR23			;PRINT A CR23
	SOJA	T2,PEOP1		;AND LOOP
PEOP2:	MOVEI	S1,STARS		;LOAD ADDRESS OF STRING
	PUSHJ	P,STGOUT		;AND SEND TO THE PRINTER
	POPJ	P,			;AND RETURN

CR23:	SKIPE	J$MTAP(J)		;SPOOLING TO TAPE ???
	JRST	CRLF			;YES,,JUST INSERT CRLF
	MOVEI	S1,[BYTE (7) 15,23,0,0,0] ;PRINT OUT CR23
	SKIPA				;SKIP CRLF ENTRY POINT
CRLF:	MOVEI	S1,[BYTE (7) 15,12,0,0,0] ;PRINT AT CRLF
	PUSHJ	P,STGOUT		;PUT IT OUT
	$RET				;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
	PJRST	OUTDMP			;DUMP BUFFERS AND RETURN
	PUSHJ	P,SETHDR		;SETUP THE FILENAME FOR BLOCK LETTERS
	PUSHJ	P,HEAD.1		;PRINT THE HEADER
	SOJG	P3,.-1			;LOOP FOR THE WHOLE WORKS
	PJRST	OUTDMP			;FORCE EVERYTHING OUT, AND RETURN

HEAD.1:	MOVE	S1,J$PFLS(J)		;GET BLOCKSIZE
	MOVEI	S2,J$PFL1(J)		;AND ADDRESS OF FIRST LINE
	PUSHJ	P,PICTUR		;PRINT THE LINE
	MOVE	S1,J$PFLS(J)		;GET BLOCKSIZE
	MOVEI	S2,J$PFL2(J)		;AND ADDRESS OF SECOND LINE
	PUSHJ	P,PICTUR		;AND PRINT THE SECOND LINE
	MOVE	P1,J$FWCL(J)		;LOAD THE WIDTH CLASS
	MOVEI	S1,J$XHBF(J)		;LOAD ADDRESS OF BANNER LINE
	PUSHJ	P,STGOUT		;AND SEND IT
	MOVE	S1,J$DIFN(J)		;GET THE IFN
	MOVX	S2,FI.CRE		;WANT CREATION TIME
	PUSHJ	P,F%INFO		;GET IT
	MOVEI	S2,[ASCIZ /, /]		;GET A STRING
	CAIE	P1,3			;WIDTH CLASS 3?
	MOVEI	S2,[BYTE (7) .CHCRT,.CHLFD,.CHTAB,0]
	$TEXT(TBFCHR,<^M^JFile ^F/@J$DFDA(J)/, created: ^H/S1/^T/(S2)/printed: ^H/[-1]/>)
	PUSHJ	P,TBFDMP		;AND DUMP THE BUFFER

	GETLIM	S1,.EQLIM(J),FORM	;GET FORMS NAME
	$TEXT(TBFCHR,<Job parameters: Request created:^H/.EQAFT(J)/   Page limit:^D/J$RLIM(J)/   Forms:^W/S1/  Account:^T/.EQACT(J)/^A>)
	GETLIM	S1,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	GETLIM	S2,.EQLIM(J),NOT2	;GET SECOND HALF OF NOTE
	SKIPE	S1			;IS THERE A NOTE?
	$TEXT(TBFCHR,<   Note:^W6/S1/^W/S2/^A>)
	PUSHJ	P,CRLF			;END THE LINE
	PUSHJ	P,TBFDMP		;AND DUMP IT
	LOAD	S1,.FPINF(E),FP.FSP	;GET /SPACING
	LOAD	S2,.FPINF(E),FP.FCY	;GET THE TOTAL COPY COUNT
	LOAD	T1,J$RNCP(J)		;GET THE COPIES DONE SO FAR
	ADDI	T1,1			;MAKE THIS THE CURRENT COPY
	$TEXT(TBFCHR,<File parameters: Copy: ^D/T1/ of ^D/S2/   Spacing:^W/SPCTAB-1(S1)/^A>)

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	PUSHJ	P,TBFDMP		;SEND THE LINE
	LOAD	S1,.FPINF(E),FP.FPF	;GET /PRINT
	LOAD	S2,.FPINF(E),FP.FFF	;GET /FILE
	CAXN	S2,.FPF8B		;/FILE:8-BIT?
	MOVEI	S2,4			;YES, RECORD THE VALUE
	CAXN	S2,.FPF11		;/FILE:ELEVEN?
	MOVEI	S2,5			;YES,,RECODE THE VALUE
	$TEXT(TBFCHR,<   File format:^W/FFMTAB-1(S2)/   Print mode:^W/FMTAB-1(S1)/^A>)
	LOAD	S1,.FPINF(E),FP.DEL	;GET /DELETE BIT
	SKIPE	S1			;IS IT SET?
	$TEXT(TBFCHR,<   /DELETE^A>)	;YES,,SAY SO
	PUSHJ	P,CRLF			;END THE LINE
	MOVE	S1,J$FPIG(J)		;GET STARTING PAGE
	CAILE	S1,1			;SKIP IF 0 OR 1
	$TEXT(TBFCHR,<^M^JPrinting will start at page ^D/J$FPIG(J)/>)
	PUSHJ	P,TBFDMP		;DUMP THE BUFFER
	PJRST	SENDFF			;SEND A FORM FEED


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

FFMTAB:	SIXBIT	/ASCII/
	SIXBIT	/FORT/
	SIXBIT	/COBOL/
	SIXBIT	/8-BIT/
	SIXBIT	/ELEVEN/



SPCTAB:	SIXBIT	/SINGLE/
	SIXBIT	/DOUBLE/
	SIXBIT	/TRIPLE/
	SUBTTL	SETHDR  --  Setup header name for file

;SETHDR is called to setup the strings to be used for the two lines of
;	block letters on the file header pages.
;
;Call:	E/  address of the file's FP
;
;T Ret:	always

SETHDR:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	SETZM	J$PFL1+1(J)		;CLEAR THE 2ND WORD OF FIRST BUFFER
	SETZM	J$PFL2+1(J)		; AND 2ND BUFFER, (SEE SETH.W)

	SKIPN	.FPFR1(E)		;IS THERE A /REPORT KEY?
	JRST	SETH.1			;NO, CONTINUE ON
	$TEXT(<-1,,J$PFL1(J)>,<Report:^0>)	;FIRST LINE
	$TEXT(<-1,,J$PFL2(J)>,< ^W6/.FPFR1(E)/^W/.FPFR2(E)/^0>)
	JRST	SETH.W			;SET BLOCKSIZE AND RETURN

SETH.1:	LOAD	S1,.FPINF(E)		;GET FLAGS FOR FILE
	TXNN	S1,FP.SPL		;IS IT A SPOOLED FILE?
	JRST	SETH.3			;NO, CONTINUE ON
	TXNN	S1,FP.FLG		;YES, IS IT ALSO THE LOG FILE?
	JRST	SETH.2			;NO, JUST A PLAIN SPOOLED FILE
	$TEXT(<-1,,J$PFL1(J)>,<Batch^0>) ;SPOOLED LOGS HAVE NO REASONABLE NAME
	$TEXT(<-1,,J$PFL2(J)>,< Log File^0>) 	;SO USE SOMETHING DESCRIPTIVE
	JRST	SETH.W			;AND FINISH UP

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

TOPS20 <
SETH.2:
SETH.3:	MOVE	P1,[POINT 7,J$PFL1(J)]	;GET THE FILENAME BYTE PTR
	MOVE	P2,[POINT 7,J$PFL2(J)]	;GET THE EXTEN BYTE PTR
	MOVX	S1,GJ%SHT!GJ%OFG	;PARSE-ONLY + SHORT-GTJFN
	MOVE	S2,J$DFDA(J)		;GET THE FD ADDRESS
	HRROI	S2,.FDFIL(S2)		;AND POINT TO THE FILESPEC
	GTJFN				;GET A JFN FOR THE FILE
	 ERJMP	SETH.S			;ERROR,,GIVE NON-DESCRIPT NAME
	EXCH	S1,P1			;SAVE JFN IN P1, GET POINTER IN S1
	MOVE	S2,P1			;GET JFN IN S2
	MOVX	T1,1B8			;FILENAME ONLY
	JFNS				;GET IT
	MOVE	S1,P2			;GET THE 2ND LINE POINTER
	MOVE	S2,P1			;GET THE JFN
	MOVX	T1,1B11			;EXTENSION ONLY
	JFNS				;GET THE EXTENSION
	MOVEI	T2,"."			;FIRST, LOAD A BLANK
	IDPB	T2,S1			;AND DEPOSIT IT
	MOVX	T1,1B14			;GET THE GENERATION NUMBER
	JFNS				;DO IT!!
	MOVE	S1,P1			;GET THE JFN
	RLJFN				;RELEASE IT
	ERJMP	.+1			;IGNORE THE ERROR
	LOAD	S1,.FPINF(E),FP.SPL	;GET THE SPOOL BIT
	JUMPE	S1,SETH.W		;IF NOT SPOOLED, THERE WE'RE DONE

	MOVE	P1,[POINT 7,J$PFL1(J)]	;RESTORE THE FILENAME BYTE PTR.
	MOVEI	S1,3			;HOW MANY DASHES TO LOOK FOR
	MOVE	S2,P1			;AND AN INPUT POINTER

SETH.4:	ILDB	T1,S2			;GET A CHARACTER
	JUMPE	T1,SETH.S		;NO, SPOOLED NAME IF NULL
	CAIE	T1,"-"			;A DASH?
	JRST	SETH.4			;NO, LOOP
	SOJG	S1,SETH.4		;YES, LOOP UNTIL 4TH FIELD
	MOVE	S1,P1			;GET A NEW POINTER TO SET DOWN CHARS

SETH.5:	ILDB	T1,S2			;GET A CHARACTER
	IDPB	T1,S1			;DEPOSIT IT
	JUMPN	T1,SETH.5		;AND LOOP UNTIL A NULL
	MOVEI	S2,6			;LOAD A COUNTER
	IDPB	T1,S1			;AND DEPOSIT MORE NULLS
	SOJG	S2,.-1			;FOR WIDTH CALCULATION
	MOVE	T1,J$PFL1(J)		;GET THE FIRST WORD ON 1ST LINE
	TLNN	T1,774000		;IS THERE AT LEAST ONE CHARACTER?
	JRST	SETH.S			;NO, NO NAME
	JRST	SETH.W			;YES, FILL IN WIDTH AND RETURN
>  ;END TOPS20 CONDITIONAL

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

TOPS10 <
SETH.2:	MOVE	S1,J$DIFN(J)		;GET THE FILE'S IFN
	MOVX	S2,FI.SPL		;GET THE SPOOL NAME INFO CODE
	PUSHJ	P,F%INFO		;GET THE SPOOLED NAME (.RBSPL)
	JUMPE	S1,SETH.S		;NO SPOOLED NAME
	$TEXT(<-1,,J$PFL1(J)>,<^W/S1/^0>) ;GENERATE THE SPOOLED NAME
	SETZM	J$PFL2(J)	 	;AND NO EXTENSION
	JRST	SETH.W			;AND FINISH UP

SETH.3:	MOVE	P1,J$DFDA(J)		;GET THE FD ADDRESS
	$TEXT(<-1,,J$PFL1(J)>,<^W/.FDNAM(P1)/^0>)
	$TEXT(<-1,,J$PFL2(J)>,<^W3/.FDEXT(P1)/^0>)
	JRST	SETH.W			;FINISH UP AND RETURN
>  ;END TOPS10 CONDITIONAL

;COMMON SUBROUTINES

;SETH.S is used to setup a non-descript name if we can't do any better

SETH.S:	$TEXT(<-1,,J$PFL1(J)>,<Spooled^0>)
	$TEXT(<-1,,J$PFL2(J)>,< Printer File^0>)
					;AND FALL INTO SETH.W

;SETH.W is called to figure out the blocksize to use, set it, and return.
;	If both lines are 6 characters or less, the current width-class is
;	used as the blocksize, else, blocksize of 1 is used.

SETH.W:	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	MOVE	S2,J$PFL1+1(J)		;GET 2ND WORD OF LINE 1
	IOR	S2,J$PFL2+1(J)		;OR IN SECOND WORD OF LINE 2
	TLNE	S2,003760		;IS THE 7TH CHARACTER THERE IN EITHER?
	MOVEI	S1,1			;YES, USE BLOCKSIZE 1
	MOVEM	S1,J$PFLS(J)		;SAVE IT
	$RETT				;AND RETURN
	SUBTTL	PICTUR  --  Routine to print block letters

;Call:	S1/  blocksize of letters
;	S2/  pointer to string (left half can be 0 or byte-pointer)

PICTUR:	PUSHJ	P,.SAVE3		;SAVE P1 THRU P3
	PUSHJ	P,.SAVET		;AND SAVE T1 THRU T4
	DMOVE	P1,S1			;SAVE THE INPUT ARGUMENTS
	MOVNI	P3,^D35			;GET A BIT COUNTER

PICT.1:	MOVE	T4,P1			;COPY OVER THE BLOCK SIZE
	PUSHJ	P,PICT.2		;PRINT A LINE
	SOJG	T4,.-1			;AND DO IT "BLOCKSIZE" TIMES
	ADDI	P3,5			;BUMP TO NEXT SEGMENT OF CHARACTER
	JUMPL	P3,PICT.1		;AND LOOP FOR NEXT SEGMENT

	MOVEI	S1,[BYTE (7) 15,12,12,12,12,0,0]
	PJRST	STGOUT			;SEND FOUR BLANK LINES AND RETURN

;HERE TO PRINT ONE LINE OF THE CURRENT SEGMENT
PICT.2:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	PUSH	P,T4			;SAVE T4
	TLNN	P2,-1			;MAKE SURE ITS A BYTE POINTER
	HRLI	P2,(POINT 7,0)		;MAKE IT ONE
	MOVE	T2,J$FWID(J)		;GET LINEWIDTH
	IDIV	T2,[EXP 7,^D14,^D21]-1(P1) ;AND DIVIDE BY CHARACTER SIZE
	MOVE	T4,T2			;SAVE MAX NUMBER OF CHARS/LINE

PICT.3:	ILDB	T2,P2			;GET A CHARACTER
	JUMPE	T2,PICT.6		;LAST CHARACTER, DONE
	CAIGE	T2,40			;MUST BE GREATER THEN ' '
	JRST	PICT.3			;ELSE GET THE NEXT CHAR
	MOVE	T1,CHRTAB-40(T2)	;GET THE WORD FROM THE TABLE
	ROT	T1,^D35(P3)		;POSITION TO CORRECT SEGMENT
	TLZ	T1,017777		;ZERO BITS FOR SPACE BETWEEN CHARS
	MOVEI	T3,7			;PRINT 5 CHARS + 2 SPACES

PICT.4:	MOVEI	C," "			;LOAD A SPACE
	TLNE	T1,(1B0)		;SEE IF HIGH BIT IS ONE
	LDB	C,P2			;IT IS, GET THE CHARACTER
	CAIN	C,":"			;IS IT A COLON ???
	MOVEI	C,"#"			;MAKE IT A # SIGN.
	PUSHJ	P,PICT.5		;PRINT IT THE CORRECT NUMBER OF TIMES
	ROT	T1,1			;ROTATE WORD 1 BIT
	SOJG	T3,PICT.4		;AND LOOP THE CORRECT NUMBER OF TIMES
	SOJG	T4,PICT.3		;AND GET THE NEXT CHARACTER
	JRST	PICT.6			;NO MORE ROOM, DONE

PICT.5:	MOVE	T2,P1			;GET THE BLOCKSIZE
	PUSHJ	P,DEVOUT		;PRINT IT
	SOJG	T2,.-1			;LOOP
	POPJ	P,			;AND RETURN

PICT.6:	POP	P,T4			;RESTORE T4
	PJRST	CRLF			;TYPE A CR 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,00,06,06,00,06,06	;:
	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) 21,21,22,34,22,21,21	;K
	BYTE (5) 20,20,20,20,20,20,37	;L
	BYTE (5) 21,33,25,21,21,21,21	;M
	BYTE (5) 21,21,31,25,23,21,21	;N
	BYTE (5) 16,21,21,21,21,21,16	;O
	BYTE (5) 36,21,21,36,20,20,20	;P
	BYTE (5) 16,21,21,21,25,22,15	;Q
	BYTE (5) 36,21,21,36,24,22,21	;R
	BYTE (5) 17,20,20,16,01,01,36	;S
	BYTE (5) 37,04,04,04,04,04,04	;T
	BYTE (5) 21,21,21,21,21,21,37	;U
	BYTE (5) 21,21,21,21,21,12,04	;V
	BYTE (5) 21,21,21,21,25,33,21	;W
	BYTE (5) 21,21,12,04,12,21,21	;X
	BYTE (5) 21,21,12,04,04,04,04	;Y
	BYTE (5) 37,01,02,04,10,20,37	;Z
	BYTE (5) 14,10,10,10,10,10,14	;[
	BYTE (5) 00,00,20,10,04,02,01	;\
	BYTE (5) 06,02,02,02,02,02,06	;]
	BYTE (5) 04,12,21,00,00,00,00	;^
	BYTE (5) 00,00,00,00,00,00,37	;_

	BYTE (5) 14,10,00,00,00,00,00	;ACCENT GRAVE
	BYTE (5) 00,00,36,01,17,21,17	;LC A
	BYTE (5) 20,20,20,36,21,21,36	;LC B
	BYTE (5) 00,00,17,20,20,20,17	;LC C
	BYTE (5) 01,01,01,17,21,21,17	;LC D
	BYTE (5) 00,00,16,21,36,20,17	;LC E
	BYTE (5) 16,21,20,34,20,20,20	;LC F
	BYTE (5) 00,00,16,21,17,01,37	;LC G
	BYTE (5) 20,20,20,36,21,21,21	;LC H
	BYTE (5) 00,04,00,04,04,04,04	;LC I
	BYTE (5) 00,04,00,04,04,24,10	;LC J
	BYTE (5) 20,22,22,24,30,24,22	;LC K
	BYTE (5) 04,04,04,04,04,04,04	;LC L
	BYTE (5) 00,00,24,37,25,25,25	;LC M
	BYTE (5) 00,00,20,36,21,21,21	;LC N
	BYTE (5) 00,00,16,21,21,21,16	;LC O
	BYTE (5) 00,00,36,21,36,20,20	;LC P
	BYTE (5) 00,00,17,21,17,01,01	;LC Q
	BYTE (5) 00,00,26,31,20,20,20	;LC R
	BYTE (5) 00,00,17,20,16,01,36	;LC S
	BYTE (5) 00,10,34,10,10,10,06	;LC T
	BYTE (5) 00,00,21,21,21,21,16	;LC U
	BYTE (5) 00,00,21,21,12,12,04	;LC V
	BYTE (5) 00,00,21,21,25,25,12	;LC W
	BYTE (5) 00,00,21,12,04,12,21	;LC X
	BYTE (5) 00,00,21,12,04,04,30	;LC Y
	BYTE (5) 00,00,37,02,04,10,37	;LC Z

	BYTE (5) 04,10,10,20,10,10,04	;OPEN BRACE
	BYTE (5) 04,04,04,00,04,04,04	;VERTICAL BAR
	BYTE (5) 04,02,02,01,02,02,04	;CLOSE BRACE
	BYTE (5) 00,10,25,02,00,00,00	;TILDE
	BYTE (5) 00,00,00,00,00,00,00	;RUBOUT
	SUBTTL	SYSTEM INITIALIZATION FUNCTIONS

TOPS10 <

OPDINI:	MOVEI	T3,4			;NUMBER OF WORDS IN SYSNAM - 1
	MOVS	T1,[%CNFG0]		;ADR OF FIRST WORD
GETSYN:	MOVS	T2,T1			;GET THE GETTAB ADR
	GETTAB	T2,			;GET THE WORD
	  JFCL				;IGNORE THIS
	MOVEM	T2,LPCNF(T1)		;SAVE NAME
	CAILE	T3,(T1)			;DONE?
	AOJA	T1,GETSYN		;NO, LOOP

	PUSHJ	P,I%HOST		;GET THE HOST NAME AND NUMBER
	MOVEM	S2,CNTSTA		;SAVE THE NUMBER
	MOVX	T3,%%.MOD		;GET PROGRAM NAME
	SETNAM	T3,			;NO, TURN OFF JACCT
>  ;END TOPS10 CONDITIONAL

TOPS20 <

OPDINI:	PUSHJ	P,I%HOST		;GET THE HOST NAME
	MOVEM	S1,CNTSTA		;SAVE IT
	MOVX	S1,.MSIIC		;GET 'IGNORE STR ACCTING' FUNCTION
	MSTR				;WE WANT TO IGNORE STRUCTURE ACCOUNTING
	ERJMP	.+1			;IGNORE ANY ERROR 
	MOVX	S1,'SYSVER'		;NAME OF GETTAB FOR SYSNAME
	SYSGT				;GET IT
	HRLZ	T1,S2			;GET TABLE#,,0
	MOVEI	T2,10			;AND LOAD LOOP COUNTER
GETSYN:	MOVS	S1,T1			;GET N,,TABLE#
	GETAB				;GET THE ENTRY
	  MOVEI	S1,0			;USE ZERO IF LOSING
	MOVEM	S1,LPCNF(T1)		;STORE THE RESULT
	CAILE	T2,(T1)			;DONE ENUF?
	AOJA	T1,GETSYN		;NO, LOOP

	MOVX	S1,RC%EMO		;EXACT MATCH
	HRROI	S2,[ASCIZ /PS:<SPOOL>/]	;DIRECTORY NAME
	RCDIR				;GET THE NUMBER
	MOVEM	T1,SPLDIR		;SAVE IT
>  ;END TOPS20 CONDITIONAL

IFN	FTDN60,<
	PUSHJ	P,D60INI##		;INIT D60 DATA BASE
>
	SETZM	FMOPN			;CLEAR FORMS.INI OPEN FLAG
	$RETT				;AND RETURN
	SUBTTL	OPNFRM  --  Routine to open LPFORM.INI

OPNFRM:	SKIPN	FMOPN			;OPEN ALREADY?
	JRST	OPNF.1			;NO, CONTINUE ON
	MOVE	S1,FMIFN		;YES, GET THE IFN
	PUSHJ	P,F%REL			;AND RELEASE IT
	SETZM	FMOPN			;CLEAR "OPEN"

OPNF.1:	MOVEI	S1,FOB.SZ		;FOB SIZE
	MOVEI	S2,FOB			;FOB ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO IT
	MOVEI	S1,FMFD			;GET FD ADDRESS
	STORE	S1,FOB+FOB.FD		;STORE IT
	MOVEI	S1,7			;LOAD BYTE SIZE
	STORE	S1,FOB+FOB.CW,FB.BSZ	;STORE IT
	MOVEI	S1,FOB.SZ		;LOAD THE FOB SIZE
	MOVEI	S2,FOB			;AND THE FOB ADDRESS
	PUSHJ	P,F%IOPN		;AND OPEN THE FILE
	JUMPF	.RETF			;LOSE?
	MOVEM	S1,FMIFN		;SAVE THE IFN
	SETOM	FMOPN			;SET "OPEN"
	$RETT				;AND RETURN

TOPS10 <
FMFD:	XWD	FMFDL,0			;FD SIZE
	SIXBIT	/SYS/			;DEVICE
	SIXBIT	/LPFORM/		;FILE NAME
	SIXBIT	/INI/			;EXTENSION
	EXP	0			;AND PPN WORD
	FMFDL==.-FMFD			;FD SIZE
>  ;END TOPS10 CONDITIONAL

TOPS20 <
FMFD:	XWD	FMFDL,0			;FD SIZE
	ASCIZ	/SYS:LPFORM.INI/	;AND THE STRING
	FMFDL==.-FMFD			;THE FD SIZE
>  ;END TOPS20 CONDITIONAL
	SUBTTL	Interrupt Module

;		INTINI		INITIALIZE INTERRUPT SYSTEM
;		INTON		ENABLE INTERRUPTS
;		INTOFF		DISABLE INTERRUPTS
;		INTCNL		CONNECT THE LINEPRINTER
;		INTDCL		DISCONNECT THE LINEPRINTER
;		INTIPC		INTERRUPT ROUTINE  --  IPCF
;		INTDEV		INTERRUPT ROUTINE  --  LPT OFF-LINE
	SUBTTL - INTERRUPT SYSTEM DATABASE

TOPS10 <

VECTOR:	BLOCK	0			;BEGINNING OF INTERRUPT VECTOR
VECIPC:	BLOCK	4			;IPCF INTERRUPT BLOCK
VECDEV:	BLOCK	4*NPRINT		;DEVICE INTERRUPT BLK
	ENDVEC==.-1			;END OF INTERRUPT VECTOR

>  ;END TOPS10 CONDITIONAL

TOPS20 <

LEVTAB:	EXP	LEV1PC			;WHERE TO STORE LEVEL 1 INT PC
	EXP	LEV2PC			;WHERE TO STORE LEVEL 2 INT PC
	EXP	LEV3PC			;WHERE TO STORE LEVEL 3 INT PC

CHNTAB:	XWD	1,INTIPC		;IPCF INT - LEVEL 1
	XWD	1,INTDEV		;DEV OFF LINE INT - LEVEL 1
	BLOCK	^D34			;RESTORE OF THE TABLE

LEV1PC:	BLOCK	1			;LVL 1 INTERRUPT PC STORED HERE
LEV2PC:	BLOCK	1			;LVL 2 INTERRUPT PC STORED HERE
LEV3PC:	BLOCK	1			;LVL 3 INTERRUPT PC STORED HERE
>  ;END TOPS20 CONDITIONAL


TOPS10 <
DEFINE LPINHD(Z),<
	XLIST
	$BGINT	1,
	MOVEI	S1,Z
	MOVEI	S2,VECDEV+<4*Z>
	JRST	LPINTR
	LPHDSZ==4
	LIST
>  ;END DEFINE LPINHD
>  ;END TOPS10 CONDITIONAL
TOPS10 <
INTINI:	MOVEI	S1,INTIPC		;GET ADDRESS OF IPCF INT RTN
	MOVEM	S1,VECIPC+.PSVNP	;SAVE IN VECTOR

	Z==0
REPEAT	NPRINT,<
	MOVEI	S1,INTDEV+<LPHDSZ*Z>	;GET ADDRESS OF LPT HEADER
	MOVEM	S1,VECDEV+<4*Z>+.PSVNP	;STORE IN THE VECTOR
	Z==Z+1
>  ;END REPEAT NPRINT

	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <
INTINI:	MOVX	S1,.FHSLF		;LOAD MY FORK HANDLE
	MOVX	S2,1B0!1B1		;CHANNELS 0 AND 1
	AIC				;ACTIVATE THE CHANNELS
	POPJ	P,			;AND RETURN
>  ;END TOPS20 CONDITIONAL
TOPS10 <

INTDCL:	SKIPA	S1,[PS.FRC+T1]		;REMOVE CONDITION USINGS ARGS IN T1
INTCNL:	MOVX	S1,PS.FAC+T1		;ADD CONDITION USING ARGS IN T1
	MOVE	T1,J$LCHN(J)		;USE CHANNEL AS CONDTION
	MOVE	T2,STREAM		;GET STREAM NUMBER
	IMULI	T2,4			;GET BLOCK OFFSET
	ADDI	T2,VECDEV-VECTOR	;GET OFFSET FROM BEGINNING
	HRLZS	T2			;GET OFFSET,,0
	HRRI	T2,PS.RDO+PS.ROD+PS.ROL	;AND CONDITIONS
	SETZ	T3,			;ZERO T3
	PISYS.	S1,			;TO THE INTERRUPT SYSTEM
	 $RETF				;WE FAILED !!!
	$RETT				;RETURN OK.
>  ;END TOPS10 CONDITIONAL

TOPS20 <
INTCNL:	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MOPSI		;GET MTOPR FUNCTION
	MOVEI	T1,T2			;AND ADDRESS OF ARGS
	MOVEI	T2,3			;1ST ARG IS # ARGS
	MOVEI	T3,1			;2ND ARG IS INT CHANNEL NUMBER
	MOVX	T4,MO%MSG		;DON'T TYPE THE MESSAGE
	PUSHJ	P,$MTOPR		;CONNECT IT
	 JUMPF	.RETF			;IF AN ERROR,,RETURN ERROR
	$RETT				;ELSE RETURN OK
>  ;END TOPS20 CONDITIONAL


	;INTERRUPT ROUTINES

INTIPC:	$BGINT	1,			;SETUP FOR THE INTERRUPT.
	PUSHJ	P,C%INTR		;FLAG THE INTERRUPT.

TOPS10 <
	$DEBRK				;DISMISS THE INTERRUPT.
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	SKIPN	J,JOBPAG		;DOES A STREAM EXIST ??
	$DEBRK				;NO,,JUST FINISH UP HERE.
	JRST	INTDON			;FINISH UP -20 INTERRUPT PROCESSING.
>  ;END TOPS20 CONDITIONAL
;Here on device interrupts on the -10.  This routine consists of multiple
;	interrupt headers (one for each stream) which load S1 and S2 and
;	call the main interrupt body, LPINTR.  Note that on the -10, while
;	it is assumed that 'output done' and 'on-line' interrupts can happen
;	anytime and anywhere, it is also assumed that 'device off-line'
;	interrupts ONLY HAPPEN IN THE STREAM CONTEXT.

TOPS10 <
INTDEV:	Z==0
	REPEAT NPRINT,<
	LPINHD(Z)
	Z==Z+1 	      >

LPINTR:	MOVE	J,JOBPAG(S1)		;GET THE JOB PARAMETER PAGE
	HRRZ	T1,.PSVFL(S2)		;GET I/O REASON FLAGS
	ANDCAM	T1,.PSVFL(S2)		;AND CLEAR THEM
	SETZ	T2,			;CLEAR AN AC
	TXNE	T1,PS.ROL+PS.RDO	;IS IT DEVICE ONLINE OR OFFLINE ???
	SETOM	JOBCHK(S1)		;YES,,SAY WE WANT A CHECKPOINT
	TXNE	T1,PS.ROL		;IS IT ON-LINE?
	MOVX	T2,PSF%DO+PSF%OB	;YES,,CLEAR ON-LINE & OUTPUT-BLOCKED
	TXNE	T1,PS.ROD		;IS IT OUTPUT DONE?
	TXO	T2,PSF%OB		;YES, GET SCHEDULER BIT
	ANDCAM	T2,JOBSTW(S1)		;CLEAR THE SCHEDULER FLAGS
	TXNN	T1,PS.RDO		;IS IT DEVICE OFF-LINE?
	$DEBRK				;NO,,DISMISS THE INTERRUPT.
	TXNE	T1,PS.ROL		;IF BOTH OFFLINE AND ONLINE,
	$DEBRK				;DISMISS THE INTERRUPT.
	MOVX	T2,PSF%DO		;GET OFF-LINE BIT.
	IORM	T2,JOBSTW(S1)		;   AND SET IT.
	MOVEI	T1,OUTWON		;LOAD RESTART ADDRESS
	EXCH	T1,.PSVOP(S2)		;STORE FOR DEBRK AND GET OLD ADRESS
	MOVEM	T1,J$LIOA(J)		;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
	$DEBRK				;DISMISS THE INTERRUPT.
>  ;END TOPS10 CONDITIONAL

	;HERE ON DEVICE INTERRUPTS ON THE -20.
	;	SINCE ALL I/O IS DONE BY CALLING A SUBROUTINE,
	;	IF AN INTERRUPT OCCURS WHILE WE ARE I/O ACTIVE,
	;	WE DONT WANT TO JUST DEBRK BACK INTO THE SOUT
	;	(UNLESS WE ARE PROCESSING A REMOTE LPT).
	;	FOR LOCAL LPT'S, WE JUST WANT TO RETURN FROM THE 
	;	SUBROUTINE, WITH THE UPDATED BYTE POINTER AND BYTE
	;	COUNT. THIS IS WHY WE ALTER THE RETURN PC FOR LOCAL
	;	LPT'S IF WE ARE I/O ACTIVE. IN THIS CASE WE JUST
	;	RETURN TO THE CALLING ROUTINE (OUTOUT)


TOPS20 <
INTDEV:	$BGINT	1,			;SETUP FOR INTERRUPT
	SKIPN	J,JOBPAG		;DOES A STREAM EXIST ??
	$DEBRK				;NO,,DEBREAK
	SETOM	JOBCHK			;SAY WE WANT A CHECKPOINT TAKEN
	MOVE	S1,J$LCHN(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
	PUSHJ	P,$MTOPR		;GET THE LPT STATUS
	MOVX	S1,PSF%DO		;DEVICE OFFLINE FLAG
	ANDCAM	S1,JOBSTW		;CLEAR THE VALUE
	TXNE	T3,MO%OL		;IS IT OFF-LINE?
	IORM	S1,JOBSTW		;YES, SET FLAG
INTDON:	SKIPE	J$LREM(J)		;IS THIS A REMOTE PRINTER ???
	JRST	INTD.1			;YES,,SKIP THIS 'LOCAL' STUFF
	MOVEI	S1,.RETT		;YES,,POINT TO EXIT ADDRESS
	SKIPE	J$LIOA(J)		;WERE WE I/O ACTIVE ???
	MOVEM	S1,LEV1PC		;DEBRK ADDRESS, SO SAVE IT.
INTD.1:	SETZM	J$LIOA(J)		;CLEAR I/O ACTIVE.
	$DEBRK				;DISMISS THE INTERRUPT.
>  ;END TOPS20 CONDITIONAL
	SUBTTL	TOPS-20 I/O LOCAL/REMOTE SUBROUTINES ($SOUT)

TOPS20 <

$SOUT:	SETOM	J$LIOA(J)		;INDICATE I/O IS ACTIVE
	SKIPE	JOBSTW			;ANY STATUS BITS SET ???
	JRST	SOUT.T			;YES,,RETURN NOW
	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  SOUT.2		;YES,,GO PROCESS IT
		 JRST  SOUT.6 ]		;NO,,MUST BE DN60
	SOUT				;LOCAL,,ISSUE THE SOUT NORMALLY
	ERJMP	SOUT.F			;ON ERROR,,TAKE FAIL RETURN
SOUT.T:	SETZM	J$LIOA(J)		;CLEAR I/O ACTIVE
	$RETT				;AND RETURN
SOUT.F:	SETZM	J$LIOA(J)		;CLEAR I/O ACTIVE
	$RETF				;AND RETURN

$GTJFN:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  GTJF.2		;YES,,GO PROCESS IT
		 JRST  GTJF.6 ]		;NO,,MUST BE DN60
	GTJFN				;LOCAL,,ISSUE THE GTJFN NORMALLY
	$RETF				;NO GOOD,,RETURN FALSE
	$RETT				;ELSE RETURN OK

$OPENF:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  OPEN.2		;YES,,GO PROCESS IT
		 JRST  OPEN.6 ]		;NO,,MUST BE DN60
	OPENF				;LOCAL,,OPEN THE LPT NORMALLY
	$RETF				;NO GOOD,,RETURN FALSE
	$RETT				;ELSE RETURN OK

$CLOSF:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  CLOS.2		;YES,,GO PROCESS IT
		 JRST  CLOS.6 ]		;NO,,MUST BE DN60
	CLOSF				;LOCAL,,CLOSE IT DOWN NORMALLY
	$RETF				;NO GOOD,,RETURN FALSE
	$RETT				;ELSE RETURN OK

$MTOPR:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  MTOP.2		;YES,,GO PROCESS IT
		 JRST  MTOP.6 ]		;NO,,MUST BE DN60 
	MTOPR				;LOCAL,,DO THE MTOPR NORMALLY
	ERJMP	.RETF			;ON AN ERROR,,RETURN NO GOOD
	$RETT				;ELSE RETURN OK

	;CONTINUED ON  THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

$GDSTS:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  GDST.2		;YES,,GO PROCESS IT
		 JRST  .RETT ]		;NO,,MUST BE DN60 (NO MTOPR)
	MOVE	S1,J$LCHN(J)		;LOCAL,,GET THE DEVICE JFN
	GDSTS				;GET THE DEVICE STATUS
	ERJMP	.RETF			;ON AN ERROR,,RETURN NO GOOD
	MOVE	S1,S2			;RETURN STATUS BITS IN S1
	$RETT				;RETURN OK

$SDSTS:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	$RETT				;YES,,CANT SET DEVICE STATUS
	MOVE	S2,S1			;GET THE STATUS BITS IN S2
	MOVE	S1,J$LCHN(J)		;GET THE DEVICE JFN  IN S1
	SDSTS				;SET THE LPT STATUS
	ERJMP	.RETF			;ON AN ERROR,,RETURN NO GOOD
	$RETT				;ELSE RETURN OK
	SUBTTL	DN200 I/O SUPPORT ROUTINES

IFN FTRJE,<

SOUT.2:	PUSHJ	P,USOUT##		;OUTPUT THE DATA
	ERJMP	SOUT.F			;ON ERROR,,TAKE FAIL RETURN
	JRST	SOUT.T			;OK,,JUST RETURN

GTJF.2:	PUSHJ	P,UGTJFN##		;MAKE GTJFN CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

OPEN.2:	PUSHJ	P,UOPENF##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

CLOS.2:	PUSHJ	P,UCLOSF##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

MTOP.2:	PUSHJ	P,UMTOPR##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

GDST.2:	MOVE	S1,J$LCHN(J)		;GET THE JFN
	MOVX	S2,.MORST		;GET READ DEVICE FUNCTION
	MOVEI	T1,T2			;AND ADDRESS OF ARGS
	MOVEI	T2,3			;ARG BLOCK LENGTH
	PUSHJ	P,UMTOPR##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	MOVE	S1,T3			;RETURN STATUS BITS IN S1
	$RETT				;HE WINS
>

IFE FTRJE,<
SOUT.2:
GTJF.2:
OPEN.2:
CLOS.2:
MTOP.2:
GDST.2:
	MOVE	S1,STREAM		;GET OUT STREAM NUMBER
	$WTO	(DN200 Remote not Supported,,@JOBOBA(S1))
	$RETF				;RETURN
>
	SUBTTL	DN60 I SUPPORT ROUTINES

IFN FTDN60,<
SOUT.6:	SETZM	J$LIOA(J)		;ZAP I/O ACTIVE (NONE FOR DN60)
	PUSHJ	P,D60SOUT##		;OUTPUT THE DATA
	JUMPT	SOU.6B			;IF OK,,RETURN
	CAIN	S1,D6NBR		;IS IT A NON-BLOCKING RETURN ???
	JRST	SOU.6B			;YES,,JUST RETURN
	MOVE	T2,STREAM		;GET OUR STREAM NUMBER
	CAIE	S1,D6DOL		;IS THE ERROR OFFLINE ???
	CAIN	S1,D6CGO		;OR IS IT CANT GET OUTPUT PERMISSION ??
	JRST	SOU.6A			;YES TO EITHER,,SKIP THIS
	$WTO(<DN60 I/O Error # ^O/S1/ on ^B/@JOBOBA(T2)/>,,,<$WTFLG(WT.SJI)>)
	PUSHJ	P,OUTDIE		;COUNT DOWN I/O ERRORS
SOU.6A:	PUSHJ	P,I%NOW			;GET THE CURRENT TIME
	ADDI	S1,^D12			;GET TIME + 4 SECONDS
	MOVEM	S1,JOBWKT(T2)		;SAVE IT FOR THE SCHEDULER
	SKIPE	J$OFLN(J)		;WERE WE ALREADY OFFLINE ???
	JRST	.+3			;YES,,SKIP THIS
	SETOM	JOBCHK(T2)		;FLAG THAT WE WANT A CHECKPOINT TAKEN
	$WTO	(<^T/BELL/>,,@JOBOBA(T2)) ;NO,,TELL OPR LPT IS OFFLINE
	SETOM	J$OFLN(J)		;SET THE LPT OFFLINE FLAG
	$DSCHD(PSF%AL+PSF%DO)		;DESCHEDULE THE PROCESS
	$RETT				;AND RETURN

SOU.6B:	SKIPN	J$OFLN(J)		;WERE WE OFFLINE BEFORE THIS ???
	$RETT				;NO,,JUST RETURN
	SETZM	J$OFLN(J)		;CLEAR THE OFFLINE FLAG
	PUSH	P,S2			;SAVE S2 (BYTE POINTER)
	PUSH	P,T1			;SAVE T1 (BYTE COUNT)
	PUSHJ	P,UPDTST		;UPDATE THE DEVICE STATUS
	POP	P,T1			;RESTORE T1 (BYTE COUNT)
	POP	P,S2			;RESTORE S2 (BYTE POINTER)
	$RETT				;AND RETURN

GTJF.6:	SETOM	S1			;NO JFN HERE (MUST RETURN -1)
	$RETT				;AND RETURN (NO JFN HERE)

OPEN.6:	SETOM	J$LINK(J)		;INDICATE NO OPR MSG LIST YET
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;GET OUR OBJECT BLOCK ADDRESS
	MOVE	S1,OBJ.UN(S1)		;GET OUR UNIT NUMBER
	STORE	S1,MSGBLK,OP$UNT	;SAVE THE UNIT NUMBER IN OPEN BLOCK
	MOVX	S1,.OPLPT		;WANT 'LPT' DEVICE
	STORE	S1,MSGBLK,OP$TYP	;SAVE THE DEVICE TYPE IN THE OPEN BLOCK
	LOAD	S1,J$DCND(J),CN$PRT	;GET THE PORT NUMBER
	STORE	S1,MSGBLK,OP$PRT	;SAVE IT IN THE OPEN BLOCK
	LOAD	S1,J$DCND(J),CN$LIN	;GET THE LINE NUMBER
	STORE	S1,MSGBLK,OP$LIN	;SAVE IT IN THE OPEN BLOCK
	LOAD	S1,J$DCND(J),CN$SIG	;GET THE LINE SIGNATURE
	STORE	S1,MSGBLK,OP$SIG	;SAVE IT IN THE OPEN BLOCK

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	HRROI	S1,-OP$SIZ		;GET THE NEGATIVE BLOCK LENGTH
	MOVEI	S2,MSGBLK		;GET THE PARM BLOCK ADDRESS
	PUSHJ	P,D60OPN##		;OPEN THE PRINTER
	JUMPF	.RETF			;CANT OPEN IT (OH WELL !!!)

	MOVEM	S1,J$LCHN(J)		;SAVE THE LPT HANDLE
	HRLZI	S1,.OPCOU		;WANT OUTPUT CONSOLE FOR REMOTE
	MOVEM	S1,MSGBLK		;SAVE THE DEV-TYP,,UNIT NUMBER IN WORD 0
	HRROI	S1,-OP$SIZ		;GET THE NEGATIVE PARM BLOCK LENGTH
	MOVEI	S2,MSGBLK		;GET THE PARM BLOCK ADDRESS
	PUSHJ	P,D60OPN##		;OPEN THE OUTPUT CONSOLE
	JUMPF	[MOVE   S1,J$LCHN(J)	;NO GOOD,,GET THE LPT ID
	 	 PUSHJ  P,D60RLS##	;RELEASE THE LINE PRINTER
		 $RETF  ]		;RETURN FALSE
	MOVEM	S1,J$D6OP(J)		;SAVE THE OPERATORS CONSOLE ID
	PUSHJ	P,L%CLST		;CREATE A LIST FOR OPERATOR MESSAGES
	MOVEM	S1,J$LINK(J)		;SAVE THE LIST ID
	$RETT				;AND RETURN

MTOP.6:	CAXE	S2,.MOEOF		;IS THIS END OF FILE ??
	$RETT				;NO,,JUST RETURN
	MOVE	S1,J$LCHN(J)		;GET THE LPT ID
	PUSHJ	P,D60EOF##		;CLEAR BUFFERS,,TURN THE LINE AROUND
	$RETT				;AND RETURN

CLOS.6:	MOVE	S1,J$LCHN(J)		;MAKE SURE WE HAVE JUST THE HANDLE
	PUSHJ	P,D60RLS##		;CLOSE DOWN THE DN60
	MOVE	S1,J$D6OP(J)		;GET THE CONSOLE ID
	PUSHJ	P,D60RLS##		;CLOSE DOWN THE OPERATORS CONSOLE
	SKIPL	S1,J$LINK(J)		;CHECK AND GET THE OPERATORS LIST ID
	PUSHJ	P,L%DLST		;DELETE THE LIST IF THERE IS ONE
	$RETT				;AND RETURN (NO JFN HERE)

>

IFE FTDN60,<
SOUT.6:
GTJF.6:
OPEN.6:
MTOP.6:
CLOS.6:
GDST.6:
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(DN60 Type Remote not Supported,,@JOBOBA(S1))
	$RETF				;RETURN
>
> ;END TOPS20 CONDITIONAL
	SUBTTL	STARS - JOB DEFINITION/SEPARATION LINE DEFINITIONS.


STARS:	ASCII	/000000000000000000000000000000000000000000000000000000000000/
	ASCII	/000000000000000000000000000000000000000111111111111111111111/
	ASCII	/1111111111/
	BYTE(7)	61,61,23,15,15
	ASCII	/000000000111111111122222222223333333333444444444455555555556/
	ASCII	/666666666777777777788888888889999999999000000000011111111112/
	ASCII	/2222222223/
	BYTE(7)	63,63,23,15,15
	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/1234567890/
	BYTE(7)	61,62,23,0,0
LPTEND::END	LPTSPL