Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93j-bb - 7,6/ap020/lptspl.x20
There are 4 other files named lptspl.x20 in the archive. Click here to see a list.
	TITLE	LPTSPL - TOPS10 LINE PRINTER DRIVER

;
;
;		COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985,1986,1987,1988.
;			ALL RIGHTS RESERVED.
;
;
;     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
	SEARCH	QSRMAC			;SEARCH QUASAR PARAMETERS
	SEARCH	ORNMAC			;SEARCH ORION/OPR PARAMETERS
	SEARCH	LPTMAC			;LPTSPL PARAMETERS
	PROLOGUE(LPTSPL)

	.DIRECT	FLBLST

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

	SALL				;SUPPRESS MACRO EXPANSIONS

	%%.LPT==:%%.LPT			;EDIT LEVEL

;STORE VERSION NUMBER IN JOBVER
	LOC	137
.JBVER::EXP	%%.LPT
IFDEF .MCRV.,<IFDEF .VERSION,<.VERSION <%%.LPT>>>
	RELOC	0

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1988. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO

	DEFINE	FACT,<IFN FTFACT>
SUBTTL	Table of Contents
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.
SUBTTL	Generate table of switch names

;*Note* FF is used in macro F defined in LPTMAC.

DEFINE FF(A,C),<
	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$WCL1==^D60	;WIDTH CLASS ONE IS 1 TO F$WCL1
	F$WCL2==^D100	;WIDTH CLASS TWO IS F$WCL1 TO F$WCL2
	F$LCL1==^D41	;Length class one is 1 to F$LCL1
	F$LCL2==^D55	;Length class two is F$LCL1 to F$LCL2
;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

	ZZ==0
REPEAT <J$$LEN+^D35>/^D36,<
	XLIST
	ZTAB(\ZZ)
	ZZ==ZZ+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
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
IMESS:	BLOCK	1		;IPCF message -1=one to be released
LPCNF::	BLOCK	11		;SYSNAME
LPJOB:	BLOCK	1		;LPTSPL'S JOB NUMBER
LPTRM:	BLOCK	1		;TERMINAL DESIGNATOR
LPCON:	BLOCK	1		;CONNECT TIME
LPLNO:	BLOCK	1		;LINE NUMBER
JOBITS::BLOCK	1		;SAVE JOB STATUS BITS FLAG.
STRSEQ:	EXP	4000		;STREAM SEQ #'S (START AT 4000)
SCHEDL:	-NPRINT,,0		;STREAM SCHEDULING DATA
FNTLST::BLOCK	1		;DEVICE SPECIFIC FONT LISTS

SLEEPT::BLOCK   1		;SLEEP TIME FOR SCHEDULING.
				;This is always the min. amount to sleep
				;-1 if no sleep time specified

ACTIVE::BLOCK	1		;NUMBER OF ACTIVE STREAMS PER SCHED PASS
SSETUP::EXP	0		;NUMBER OF STREAMS SETUP PER SCHED PASS
BYEUDT::BLOCK	1		;IF -1, LPTSPL IS A %ONCE OBJECT PROCESSOR,
				;  SETUP OR ACTIVE CHECKS NOT DONE
				;IF 0, LPTSPL IS A %STCMD OBJECT PROCESSOR,
				;  LPTSPL WILL SAY GOODBYE AND LOGOUT WHEN
				;  ALL STREAMS ARE SHUTDOWN. 
				;IF >0, LPTSPL IS A %DEMND OBJECT PROCESSOR
				;  BYEUDT WILL CONTAIN UDT LPTSPL WILL
				;  SAY GOODBYE AND LOGOUT IF ALL STREAMS
				;  ARE INACTIVE UP UNTIL THIS TIME

CNTSTA::BLOCK	1		;NUMBER OF THE CENTRAL STATION

RUTINE:	BLOCK	1		;MESSAGE PROCESSING ROUTINE ADDRESS.

STRTAB:	BLOCK	STRLEN		;STRUCTURE TABLE
STRBLK:	BLOCK	STRSLS		;ARGUMENT BLOCK FOR BUILDING SEARCH LISTS

TOPS10	<
DCHBLK:	BLOCK	.DCSNM+1	;DSKCHR BLOCK
>

TOPS20 <
SPLDIR:	BLOCK	1		;DIRECTORY NUMBER OF PS:<SPOOL>
>  ;END TOPS20 CONDITIONAL


; INIT FILE DATA STORAGE
INIFOB:	BLOCK	FOB.SZ		;FILE OPEN BLOCK
INIFD:	BLOCK	FDXSIZ		;FILE DESCRIPTOR BLOCK
INIIFN:	BLOCK	1		;INTERNAL FILE NUMBER
INITMP:	BLOCK	1		;TEMP STORAGE USED DURING I/O ERROR REPORTING
INIEPC:	BLOCK	1		;CALLER'S PC FOR I/O ERROR RECOVERY
INIPDP:	BLOCK	1		;PDL POINTER FOR I/O ERROR RECOVERY
INILIN:	BLOCK	1		;LINE NUMBER WITHIN FILE
INISAV:	BLOCK	1		;SAVED CHARACTER
INIATM:	BLOCK	INIWDS		;ATOM BUFFER
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 INDICATOR
				;Contains the time for the next checkpoint
				;  or 0 if one is requested

JOBUPD::BLOCK	NPRINT		;Stream update indicator
				;  if set, update is indicated for the stream

JOBWAC::BLOCK	NPRINT		;STREAM WTOR ACK CODE.
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
	 $SET(PB.SYS,IP.BQT,-1)			;MAX SEND/RECIEVE IPCF QUOTAS
	$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 terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue printing/
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	Device table

DEFINE	LL(DEVNAM)<.TEXT \'DEVNAM/LOCALS\>
	G..LPT				;CAUSE DRIVERS TO LOAD
	.TEXT	",LPTLP5/LOCALS"	;ALWAYS LOAD THE LP05 CLASS DRIVER
	.TEXT	",LPTMTA/LOCALS"	;ALWAYS LOAD THE MAGTAPE DRIVER
	.TEXT	",LPTD60/LOCALS"	;ALWAYS LOAD THE DN60 DRIVER

	.LNKEN	DEVLNK,DEVLST		;DEFINE HEAD OF DEVICE DRIVER CHAIN
DEVLST::BLOCK	1			;START OF DEVICE DRIVER CHAIN
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.
	PUSHJ	P,OPDINI		;GET OPERATING SYSTEM INFO.
	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.
	SETZM	ACTIVE			;INIT ACTIVE STREAM COUNT
	MOVX	S1,OPTYP%		;GET OUR OBJECT PROCESSOR TYPE
	SETOM	BYEUDT			;ASSUME %ONCE (SHOULDN'T BE, BUT..)
	SKIPE	DEBUGW			;DEBUGGING?
	JRST	MAIN			;YES, WE'LL STAY AROUND EVEN IF IDLE
	CAXN	S1,%DEMND		;"FIRED UP" WHEN JOB TO DO?
	AOSA	BYEUDT			;YES, MAKE BYEUDT +1
	CAXN	S1,%STCMD		;NO, "FIRED UP" ON START COMMAND?
	AOS 	BYEUDT			;YES, MAKE BYEUDT 0

	;FALL THROUGH TO MAIN LOOP.
SUBTTL	Idle Loop

MAIN:	SKIPE	J,JOBPAG(P1)		;Stream setup?
	PUSHJ	P,@J$SCHD(J)		;CALL DRIVER
	SKIPN	JOBACT(P1)		;IS THE STREAM ACTIVE ???
	JRST	MAIN.2			;NO, GET THE NEXT STREAM.
	AOS	ACTIVE			;YES, BUMP COUNTER
	HRRZM	P1,STREAM		;RUNNABLE STREAM!!!
	MOVE	J,JOBPAG(P1)		;YES, GET JOB PAGE
	PUSHJ	P,CHKTIM		;Adjust sleep time if needed
	$CALL	DSTATUS			;Do any status stuff
	SKIPE	JOBSTW(P1)		;IS THE STREAM BLOCKED ???
	JRST	MAIN.2			;YES, GET THE NEXT STREAM.
	MOVEM	P1,SCHEDL		;SAVE THE SCHEDULING STREAM.
	MOVSI	0,J$RACS+1(J)		;Setup first source address for BLT
	HRRI	0,1			;Setup first destination address
	BLT	0,17			;GET SOME ACS
	POPJ	P,			;AND RETURN

MAIN.1:	MOVE	P1,SCHEDL		;GET THE LAST SCHEDULED STREAM.
	$CALL	DSTATUS			;Do any status stuff
	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.6			;YES, CONTINUE PROCESSING
	SKIPLE	S1,BYEUDT		;CARE ABOUT IDLENESS?
	SKIPE	ACTIVE			;YES, ARE STREAMS ACTIVE?
	JRST	[SOJL   S1,MAIN.4	;ACTIVE STREAMS. JUMP IF DONT'T CARE
		 MOVEI	S1,1		;ELSE FLAG TIME IS TO BE SET
		 MOVEM	S1,BYEUDT	;NEXT TIME NO STREAMS ARE ACTIVE
		 JRST	MAIN.4]
	SOJE	S1,MAIN.3		;JUMP IF TIME NEEDS TO BE SET
	$CALL	I%NOW			;ELSE GET CURRENT TIME
	CAMGE	S1,BYEUDT		;TIME TO SAY GOODBYE TO QUASAR?
	JRST	MAIN.4
	PJRST	IDLBYE			;YES, GO TELL QUASAR AND LOGOUT

MAIN.3:	$CALL	I%NOW			;GET CURRENT TIME
	ADD	S1,[EXP IDLMIN*^D60*^D3];COMPUTE BYEBYE TIME
	MOVEM	S1,BYEUDT		;SAVE IT

MAIN.4:	MOVE	S1,SLEEPT		;NO, PICK UP SLEEP TIME.
	JUMPE	S1,MAIN.6		;Don't sleep if 0 sleep specified
	JUMPG	S1,MAIN.5		;JUMP IF SLEEP TIME SPECIFIED
	SKIPLE	BYEUDT			;KEEPING TRACK OF IDLENESS?
	SKIPA	S1,[EXP ^D60]		;YES, ONLY SNOOZE FOR A MINUTE
	SETZ	S1,			;NO, SLEEP UNTIL AWAKENED
TOPS20 <
	SKIPE	JOBACT			;CHECK IF STREAM ACTIVE..
	SKIPE	JOBSTW			;ANY BLOCKING CONDITIONS
>;END TOPS20 CONDITIONAL

MAIN.5:	PUSHJ	P,I%SLP			;ELSE,,GO WAIT

MAIN.6:	MOVE	P,[IOWD PDSIZE,PDL]	;RESET THE STACK POINTER.
	SETOM	SLEEPT			;Start fresh
	MOVSI	P1,-NPRINT		;GET LOOP AC.
	SETZM	ACTIVE			;INIT ACTIVE STREAM COUNT
	JRST	MAIN			;KEEP ON PROCESSING.

SUBTTL	CHKTIM - ROUTINE TO CHECK WAKEUP TIME BASED ON CURRENT STREAM

;  The purpose of this routine is to check and set the sleep time based
;  on current conditions.  The sleeptime is checked based on the stream's
;  wakeup time and the console wakeup time (on DN60).  Whoever wants to
;  wakeup the earliest sets the sleeptime if the time is less than the
;  current.

;  Returns:	False if it is not time to wake up this stream
;		True  if it is time to wakeup this stream

CHKTIM::PUSHJ	P,I%NOW			;GET CURRENT TIME INTO S1
	MOVE	T1,STREAM		;GET OUR STREAM NUMBER
	MOVE	S2,JOBWKT(T1)		;GET WAKEUP TIME OF JOB
	PUSHJ	P,@J$WAKE(J)		;DO WAKEUP TIMER CHECKING
	JUMPE	S2,.RETF		;NO TIME SET, THIS IS IRRELEVANT
	SUB	S2,S1			;CALCULATE THE NUMBER
	IDIVI	S2,3			;   OF SECONDS TO WAKE-UP.
	JUMPLE	S2,CHKT.1		;IF TIME IS UP,,WAKE UP STREAM.
	CAILE	S2,^D60			;IF WAKE UP TIME IS GREATER THEN
	MOVEI	S2,^D60			;   60 SECS,, THEN MAKE IT 60 SECS.
	SKIPL	SLEEPT			;IF -1 THEN NONE SET - GO SET
	CAMGE	S2,SLEEPT		;IF WAKE UP TIME IS LESS THEN
	MOVEM	S2,SLEEPT		;CURRENT WAKE UP TIME,,THEN RESET IT.
	$RETF				;DO NOT WAKE UP THE JOB.
CHKT.1:	SETZM	SLEEPT			;NO SLEEP TIME NEEDED
	MOVX	S1,PSF%AL		;PICK UP ALIGN BLOCK BIT.
	MOVE	T1,STREAM		;GET STREAM NUMBER AGAIN
	ANDCAM	S1,JOBSTW(T1)		;CLEAR ALIGN BIT
	MOVE	T1,STREAM		;GET THE STREAM NUMBER
	SKIPF				;SKIP IF DRIVER SAID DON'T ZERO JOBWKT
	SETZM	JOBWKT(T1)		;CLEAR JOB WAKE TIME
	$RETT				;WAKE UP THE STREAM.
SUBTTL DSCHD -- Deschedule process

; The purpose of this routine is to provide a generalized blocking
; mechanism.  It differs from the old DSCHD in that it will block
; whether in stream context or not.

; DSCHD is called by the $DSCHD macro where the call is:

;	$DSCHD (flags)	where flags are flags and/or a number of seconds
;			to sleep

; ASSUMPTIONS. . .

; 1.  STREAM is assumed to be correct.

; 2.  If not in stream context, it is assumed that J contains the
;     address of the jobpage.  This has a side problem.  If J indicates
;     a jobpage of an already existing stream with a context and
;     the stream is in the overhead context, the old stream context
;     will be destroyed which must be avoided by the caller.

; 3.  If called with an IPCF message currently in use, it is assumed
;     that the user has everything needed from the message and the
;     message will be released.  This assumption is necessary to
;     prevent another message being received before the old message
;     is released.

; All registers are preserved in the JOBPAG.
; Only AC's S1, S2 and T1 are touched before jumping to MAIN.

;     parameters:
;         J / Address of the current jobpage  (if not, expect a stopcd)

;Save the AC's in any case

DSCHD::	MOVEM	0,J$RACS(J)		;Save AC0
	MOVEI	0,J$RACS+1(J)		;Place to put AC1
	HRLI	0,1			;Setup the BLT pointer
	BLT	0,J$RACS+17(J)		;Save the AC's

	MOVE 	T1,STREAM		;Get the current stream number

;Take care of the flags passed

	HRRZ	S2,0(P)			;Get address of JUMP [FLAGS]
	HLLZ	S1,@0(S2)		;Get the flags
	HRRZ	S2,@0(S2)		;Get the sleep time
	IORM	S1,JOBSTW(T1)		;set only the flags

	JUMPE	S2,DSCH.D		;No sleep time to worry about
	$CALL	I%NOW			;Get the current time
	IMULI	S2,3			;Seconds to jiffies
	ADD	S1,S2			;Build wake-up time
	MOVEM	S1,JOBWKT(T1)		;Save the wake-up time

;Check to see our current context

DSCH.D:	HRRZ	S1,P			;Get current address of PDL
	CAIL	S1,J$RPDL(J)		;Less than beginning of current PDL
	CAILE	S1,PDSIZE+J$RPDL(J)	;or Greater than end?
	SKIPA				;No not in stream context
	JRST	DSCH.Z			;Yes - already in stream context

;Since we have to make a stream context, we must do the following:
;   1. Release any IPCF messages
;   2. Given then the stream number:
;	Save JOBACT for this stream and info needed to restore JOBACT
;	Set JOBACT for this stream so it can be selected to run
;   3. Save PDL and AC17

	SKIPE	IMESS			;Any IPCF messages?
	$CALL	C%REL			;Yes, release it
	SETZM	IMESS			;Set no IPCF messages

	SKIPN	JOBACT(T1)		;Stream already active?
	PUSH	P,[EXP FIXACT]		;no - remember to fix JOBACT
	SETOM	JOBACT(T1)		;pretend we are active now in any case

	PUSH	P,[EXP FIXPDL]		;Remember to fix up the stack later
	MOVEI	S1,J$RPDL(J)		;Get stream's PDL location
	HRLI	S1,PDL			;Get beginning of PDL
	HRRZ	T1,P			;Get current PDL pointer
	SUBI	T1,PDL			;Find current length
	ADDI	T1,J$RPDL(J)		;Add stream's base
	HRR	P,T1			;Set new pointer
	BLT	S1,(T1)			;Save PDL
	MOVEM	P,J$RACS+P(J)		;Save new PDL pointer

	JRST	MAIN.6			;Return to restart main loop

DSCH.Z:	MOVE	P,[IOWD PDSIZE,PDL]	;Reset stack pointer
	JRST	MAIN.1			;Return to main loop
SUBTTL	FIXPDL -- Fix PDL routine

;The purpose of this subroutine is to return the pseudo stream
;context back to overhead context.  (See DSCHD)

FIXPDL:	MOVEI	S1,PDL			;Get overhead PDL
	HRLI	S1,J$RPDL(J)		;Get beginning of stream's PDL
	HRRZ	S2,P			;Get current pointer
	SUBI	S2,J$RPDL(J)		;Find the current length
	ADDI	S2,PDL			;Add the base of the PDL
	HRR	P,S2			;Set the new pointer
	BLT	S1,(S2)			;Restore PDL
	MOVE	S1,J$RACS+S1		;Restore S1
	MOVE	S2,J$RACS+S2		;Restore S2
	$RET				;Continue on
SUBTTL FIXACT - Routine to set stream to inactive

;This routine is use to return a stream to an inactive state when
;the stream was descheduled when not in stream context.  It is
; "called" by DSCHD pushing FIXACT on the stack when the need is
;determined.

FIXACT:	$SAVE	<S1>			;Save a register
	MOVE	S1,STREAM		;Get the stream #
	SETZM	JOBACT(S1)		;Make it inactive
	$RET				;Don't change anything
SUBTTL	FORFOR -- Force Forms change mess.

; This routine causes a forms change to occur even if there is no
; job currently scheduled for the printer.

;  Assumes J contains the pointer to the job data base
;	   M contains a pointer to the message
;	   The object block has already been parsed correctly

FORFOR:	MOVE	S1,.OFLAG(M)		;Get the forms type
	MOVEM	S1,.EQLIM(J)		;Save it where NXTJOB does

	MOVE	S1,STREAM		;Get the stream number
	SETOM 	JOBACT(S1)		;Set the stream active

	MOVX	S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL
					;Get a bunch of bits
	ANDCAM	S2,JOBSTW(S1)		;And clear them

	MOVEI	S1,J$RPDL-1(J)		;Point to the context PDL
	HRLI	S1,-PDSIZE		;And the length
	PUSH	S1,[EXP	DOFFOR]		;Push address of the stack
	MOVEM	S1,J$RACS+P(J)		;And save the PDL

	$CALL	TBFINI			;Init the buffer
	$CALL	CHKLPT			;Check for online
	$RET
SUBTTL	DOFFOR -- Do the force forms

; This forces the forms change to occur in stream context.  Is called
; implicitly by being placed on the stream's stack by FORFOR.

; Simply calls the routine to set the forms, sends a reset status message
; to notify QUASAR that the forms change has been effected, and returns
; to the scheduler.

DOFFOR:	$CALL	FORMS			;Try to set the forms

	SKIPF				;Did we succeed?
	$CALL	CHKALN			;Yes, do an alignment if needed

	MOVE	S1,STREAM		;Get the stream number
	SETOM	JOBUPD(S1)		;Say we want an update message
	SETZM	JOBSTW(S1)		;Say we want reset message
					;  defaults since no bits set
	$CALL	DSTATUS			;Tell QUASAR we are done

	SETZM	J$RACS+S(J)		;Clear status bits
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBACT(S1)		;No longer active
	PJRST	MAIN.6			;Go back to the scheduler
SUBTTL	NXTJOB -- 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
	SETZM	JOBCHK(S1)		;CHECKPOINT FIRST CHANCE WE GET !!!
	SETOM	JOBUPD(S1)		;Send update also.
	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,-PDSIZE		;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)/>)

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

NXTJ.5:	PUSHJ	P,LPTTXT		;GENERATE "OUTPUT TO ..." TEXT
	SKIPL	J$LCHN(J)		;KNOW WHERE THE OUTPUT IS GOING?
	$TEXT	(LOGCHR,<^I/LPDAT/^T/J$LOUT(J)/>) ;STUFF IN THE RUN LOG
	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)/)>)
	SKIPE	S1			;CHECK AGAIN
	$TEXT	(<-1,,J$WTOR(J)>,<Invalid account string specified^0>)
	GETLIM	T1,.EQLIM(J),OLIM	;GET PAGE LIMIT
	MOVEM	T1,J$RLIM(J)		;SAVE IT
	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	DOJOB -- Do the Job

DOJOB:	PUSHJ	P,FORMS			;GET FORMS MOUNTED
	JUMPF	ENDREQ			;CANT DO IT,,END THE REQUEST
	$CALL	CHKALN			;DO AN ALIGNMENT IF NEEDED
	PUSHJ	P,@J$BJOB(J)		;DO POSSIBLE FONT LOADS
	TXNE	S,RQB+ABORT		;JOB ABORTED?
	JRST	ENDJOB			;YES, FINISH UP
	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
	TXO	S,INJOB			;We are in a job now
	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
	TXZE	S,BCKFIL		;WERE WE BACKSPACED DURING HEADERS ???
	TXZ	S,SKPFIL		;YES, CLEAR THE SKIP FILE BIT
	SKIPA				;Never use the /START param that follows

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

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.
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBCHK(S1)		;Want a checkpoint soon
	TXZE	S,BCKFIL		;BACKSPACING A FILE?
	JRST	DOJO.4			;YES
	PUSHJ	P,NXTFIL		;BUMP TO NEXT FILE
	JUMPT	DOJO.4			;AND LOOP

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
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:	MOVE	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 'E' AT NEXT FILE.
	SETZM	J$XFOB+FOB.US(J)	;DEFAULT TO NO ACCESS CHECKING
	SETZM	J$XFOB+FOB.CD(J)	;HERE ALSO
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET THE USERS PRIVILGE BITS
	JUMPN	S1,FILD.2		;IF SET, AVOID ACCESS CHECK
	TXNE	T2,FP.SPL		;WAS IT A SPOOLED FILE ???
	JRST	FILD.2			;YES, THEN NO ACCESS CHECK
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

FILD.2:	MOVEI	S1,FOB.SZ		;GET THE FOB LENGTH
	MOVEI	S2,J$XFOB(J)		;AND THE FOB ADDRESS
	TXNE	T2,FP.SPL		;Spool file?
	JRST	FILD.3			;Yes, delete the file in any case
	TXNE	S,ABORT			;Is abort set?
	JRST	FILD.4			;Yes, skip deleting the file
	TXNE	T2,FP.DEL		;/delete?
FILD.3:	$CALL	F%DEL			;Yes, here to delete
FILD.4:	SOJG	T1,FILD.1		;GO PROCESS THE NEXT FILE.
	$RETT				;RETURN.

SUBTTL	FILE -- Print a File

FILE:	TXNE	S,ABORT			;ARE WE IN TROUBLE ???
	$RET				;YES, JUST RETURN.
	$CALL	LIMCHK			;Are we over limit?
	$RETIF				;Yes, just return
	PUSHJ	P,INPOPN		;OPEN THE INPUT FILE UP
	JUMPF	.POPJ			;LOSE, RETURN
	MOVE	S1,J$DFDA(J)		;GET FD ADDRESS
	PUSHJ	P,STRMNT		;MOUNT THE STR

;**;[2774] Change 1 line at FILE+8L. 26-Oct-83  /LWS
	$TEXT(LOGCHR,<^I/LPMSG/Starting File ^F/@J$DFDA(J)/^T/J$GSPL(J)/>) ;[2774]

FILE.1:	PUSHJ	P,INPREW		;REWIND THE INPUT FILE
	JUMPF	FILE.2			;DRIVER SAID NOT TO PROCESS FILE
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBCHK(S1)		;Want a checkpoint
	$CALL	DSTATUS			;Do the status
	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 #.
	 JRST	[TXO	S,FORWRD	;[4005]POSITIVE,,TURN ON FORWARD BIT.
		MOVE	S1,J$FPIG(J)	;[4005]GET STARTING PAGE
		JRST	.+1]		;[4005]AND CONTINUE
	TXNE	S,ABORT!SKPFIL!RQB	;DO WE REALLY WANT TO DO THIS ???
	JRST	FILE.2			;NO, CLEAN UP THE MESS.
	PUSHJ	P,@J$BFIL(J)		;DO BEGINING OF FILE PROCESSING
	JUMPF	FILE.2			;ERROR MEANS WE SHOULD ABORT THE FILE
	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
	PUSHJ	P,@J$EFIL(J)		;DO END OF FILE PROCESSING
	JUMPF	FILE.2			;DRIVER SAID NO MORE
	LOAD	S2,.FPINF(E),FP.FCY	;GET TOTAL NUMBER TO PRINT
	CAML	S1,S2			;PRINTED ENOUGH?
	JRST	FILE.2			;Yes, go finish
	$CALL	LIMCHK			;Check to see if over limit
	JUMPT	FILE.1			;If not, loop

FILE.2:	SKIPE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REL			;RELEASE IT
	SETZM	J$DIFN(J)		;Clear the IFN
;**;[2774] Changed 1 line at FILE.2+3L. 25-Oct-83  /LWS
	$TEXT (LOGCHR,<^I/LPMSG/Finished File ^F/@J$DFDA(J)/^T/J$GSPL(J)/>) ;[2774]
	MOVE	S1,J$DFDA(J)		;GET FD ADDRESS
	PUSHJ	P,STRDMO		;DISMOUNT THE STR
	TXNE	S,SUPFIL		;Are we suppressing forms/file?
	SETZM	J$XTOP(J)		;Yes, set we are not at top of page.
	TXZ	S,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>)
	$TEXT	(LOGCHR,<^I/LPEND/        ^D5/J$ADRD(J)/ Disk Blocks Read>)
	PUSHJ	P,@J$EJOB(J)		;DO END OF JOB PROCESSING
	PUSHJ	P,JOBTRL		;PRINT THE JOB TRAILERS.
	PUSHJ	P,@J$EOF(J)		;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.6			;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.
	$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
	MOVEI	S1,0			;CLEAR FLAGS
	TXNE	S,ABORT			;ABORTING JOB?
	TXO	S1,RF.ABO		;YES--TELL QUASAR
	MOVEM	S1,REL.FL(T1)		;SAVE IN MESSAGE
	TXNE	S,ABORT			;CHECK AGAIN
	$TEXT	(<-1,,REL.TX(T1)>,<^T/J$WTOR(J)/^0>) ;ADD OPR TEXT FOR /NOTIFY
	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.
	SETOM	IMESS			;Have a message
	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.7			;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?
	SKIPA				;Yes, continue on
	JRST	CHKQ.7			;Go to release the message
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.6			;YES, WIN
	AOBJN	S1,CHKQ.3		;NO, LOOP
	PUSH	P,P1			;SAVE P1
	MOVE	P1,DEVLST		;POINT TO START OF DEVICE DRIVER CHAIN
CHKQ.4:	PUSHJ	P,@J$IPCF-J$$DEV(P1)	;TRY TO PROCESS THE MESSAGE
	JUMPT	CHKQ.5			;JUMP IF PROCESSED OK
	SKIPE	P1,0(P1)		;POINT TO NEXT DRIVER
	JRST	CHKQ.4			;LOOP BACK
CHKQ.5:	POP	P,P1			;RESTORE P1
	JRST	CHKQ.7			;GO TO RELEASE THE MESSAGE
CHKQ.6:	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.7			;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 FLAG (DEFAULT TO ALWAYS SAVE)
CHKQ.7:	SKIPE	IMESS			;Any IPCF messages?
	$CALL	C%REL			;Yes, release it
	SETZM	IMESS			;Remember we have released it
	POPJ	P,			;RETURN TO THE SCHEDULER.

MSGTAB:	XWD	KILL,.QOABO		;ABORT MESSAGE
	XWD	DSTATUS,.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	FORFOR,.QOFCH		;FORCE FORMS 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.
	CAIE	S2,.QOFCH		;Is it forms change message?
	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	KILL -- 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))
	$TEXT	(<-1,,J$WTOR(J)>,<Canceled by User ^U/ABO.ID(M)/^0>)
	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,@J$FLSH(J)		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN !!!
	$RETT				;RETURN
SUBTTL	QSRNWA - ROUTINE TO SHUTDOWN A STREAM 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
	SKIPE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REL			;YES, CLOSE IT
	SETZM	J$DIFN(J)		;Clear the IFN
	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	DSTATUS -- Send status info

COMMENT \
	The purpose of this routine is to provide a uniform means
of handling checkpointing within a stream.  It decides whether to
send status messages.

There are 2 kinds of messages.  UPDATE is an update status message
and is sent every time the actual status of the stream changes.
CHKPNT is a checkpoint message that describes the current state
of the job on the stream.

UPDATE is called based on JOBUPD.

CHKPNT is called based on JOBCHK or elapsed time since last CHKPNT.  The
time till next checkpoint is set if called.  If JOBCHK is 0, CHKPNT
is always called.

THIS IS THE ONLY ROUTINE THAT SHOULD CALL UPDATE OR CHKPNT!

	No parameters are passed.
	Always returns $RET.  (Cannot fail)

\	;End of comment

DSTATUS:$SAVE	<P1,P2>			;Save 2 perm. registers
	MOVE	P1,STREAM		;Get the stream number

	SKIPE	JOBUPD(P1)		;Do we need status update?
	$CALL	UPDATE			;Do the status update
	SETZM	JOBUPD(P1)		;Turn flag off

	SKIPN	JOBACT(P1)		;Nothing to checkpoint if not active!
	$RET

	$CALL	I%NOW			;Find the time
	MOVE	P2,S1			;Save the time
	SUB	S1,JOBCHK(P1)		;current time - time to checkpoint
	SKIPGE	S1			;Time to checkpoint yet?
	$RET				;No.

	TXNE	S,INJOB			;Are we in a JOB?
	$CALL	CHKPNT			;Yes, do the checkpoint
	ADDI	P2,CKPTIM*3		;Add number of 1/3s of seconds
					;  to the current time
	MOVEM	P2,JOBCHK(P1)		;Save the time to do next chkpoint
	$RET
SUBTTL	CHKPNT -- Request for Checkpoint

COMMENT	\
This routine is to checkpoint the currently active job on the current stream.
It should only be called by DSTATUS since that routine will verify that the
stream is currently active.  DSTATUS will also update the time for the next
checkpoint to occur.
\

CHKPNT:	MOVEI	T1,MSGBLK		;LOAD THE ADDRESS OF THE MESSAGE BLK.
	MOVX	S1,CH.FST		;REQUEST STATUS UPDATE
	SKIPE	J$POSF(J)		;DRIVER ALLOW FILE POSITIONING?
	TXO	S1,CH.FCH		;YES--REQUEST CHECKPOINTING TOO
	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)/^A>) ;START STATUS MESSAGE
	PUSHJ	P,@J$STST(J)		;FINISH STATUS MESSAGE
	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

LPTSTS::$TEXT	(DEPBP,<, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
	POPJ	P,			;RETURN
SUBTTL	UPDATE -- ROUTINE TO SEND STATUS UPDATES TO QUASAR

COMMENT \
This routine sends a status update message to QUASAR.  It should only
be called by DSTATUS since it depends on DSTATUS to clear the status
request flag and P1 is set by DSTATUS to contain the stream number.
\

UPDATE:	MOVE	S2,JOBPAG(P1)		;Get the jobpage
	MOVE	S2,JOBSTW(P1)		;GET THE JOBS STATUS WORD
	MOVX	S1,%RESET		;DEFAULT TO RESET
	SKIPE	J$APRG(J)		;ARE WE ALIGNING FORMS ???
	MOVX	S1,%ALIGN		;YES, SAY SO
	TXNE	S2,PSF%OR		;ARE WE WAITING FOR OPR RESPONSE ???
	MOVX	S1,%OREWT		;YES, SAY SO
	TXNE	S2,PSF%ST		;ARE WE STOPPED ???
	MOVX	S1,%STOPD		;YES, SAY SO
	TXNE	S2,PSF%MW		;ARE WE IN MOUNT WAIT?
	MOVX	S1,%MWAIT		;YES, SAY SO
	TXNE	S2,PSF%DO		;ARE WE OFFLINE ???
	MOVX	S1,%OFLNE		;YES, SAY SO
	TXNE	S2,PSF%OO		;ARE WE WAITING FOR OPERATOR OUTPUT ???
	MOVX	S1,%OPRWT		;YES, SAY SO
	MOVEI	T1,MSGBLK		;GET THE MESSAGE BLOCK ADDRESS
	MOVEM	S1,STU.CD(T1)		;SAVE THE STATUS
	HRLZ	S1,JOBOBA(P1)		;GET THE OBJECT BLOCK ADDRESS
	HRRI	S1,STU.RB(T1)		;GET DESTINATION ADDRESS
	BLT	S1,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 TO QUASAR
	$RETT				;AND RETURN
SUBTTL	SETUP/SHUTDOWN Message processing

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
	STOPCD	(TMS,HALT,,<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
	CAME	S1,CNTSTA		;IS IT A LOCAL LPT ???
	SETOM  J$LREM(J)		;NO--MAYBE ANF REMOTE
	MOVSI	S1,J$DWDS(J)		;START OF DRIVER DATA
	HRRI	S1,J$DWDS+1(J)		;MAKE A BLT POINTER
	SETZM	J$DWDS(J)		;CLEAR FIRST WORD
	BLT	S1,J$DWDS+DRVWDS-1(J)	;CLEAR ENTIRE BLOCK

	;Continued on the next page
	;Continued from the previous page

	SETOM	J$LCHN(J)		;No output channel yet
	MOVX	S1,SUFLAT		;
	TDNN	S1,SUP.FL(M)		;Is this a LAT server?
	JRST	SETU.3			;No, no need to set up terminal
	MOVE	S1,M			;Get address of SETUP message
	PUSHJ	P,LATSUP		;Set up the terminal
	JUMPT	SETU.3			;Got it: continue
	PUSH	P,TF			;No extra attributes
	PUSH	P,S1			;
	JRST	SETU.7			;Go away

SETU.3:	MOVE	P1,DEVLST		;POINT TO START OF DEVICE DRIVER CHAIN

SETU.4:	PUSHJ	P,@J$INIT-J$$DEV(P1)	;INITIALIZE
	JUMPT	SETU.6			;ALL SET
	JUMPL	S1,SETU.5		;JUMP IF NOT FOR THIS DRIVER
	PUSH	P,TF			;NO EXTRA ATTRIBUTES
	PUSH	P,S1			;SAVE RESPONSE TO SETUP CODE
	JRST	SETU.7			;AND GO AWAY

SETU.5:	SKIPE	P1,(P1)			;POINT TO NEXT DRIVER
	JRST	SETU.4			;LOOP BACK
	PUSH	P,TF			;NO EXTRA ATTRIBUTES
	PUSH	P,[%RSUNA]		;SAY DEVICE NOT AVAILABLE RIGHT NOW
	JRST	SETU.7			;GO CLEAN UP

SETU.6:	PUSH	P,S2			;SAVE EXTRA ATRIBUTES IF ANY
	PUSHJ	P,@J$OPEN(J)		;OPEN CHANNEL FOR OUTPUT
	PUSH	P,S1			;SAVE RESPONSE TO SETUP CODE
	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.
	MOVE	S1,(P)			;GET RESPONSE CODE BACK

SETU.7:	MOVE	S1,(P)			;GET RESPONSE TO SETUP CODE
	MOVE	S2,-1(P)		;GET EXTRA ATTRIBUTES
	PUSHJ	P,RSETUP		;TELL QUASAR WHAT'S GOING ON
	MOVE	S1,STREAM		;GET STREAM NUMBER
	POP	P,S2			;AND RESPONSE CODE AGAIN
	POP	P,(P)			;SYNCH STACK
	$WTO	(<^T/@SETMSG(S2)/>,,@JOBOBA(S1))
	AOS	SSETUP			;ASSUME SETUP WAS OK
	CAIE	S2,%RSUOK		;ALL IS OK?
	JRST	[$CALL	SHUTND		;NO, SHUT IT DOWN
		 $RETT]
	MOVE	S1,J$LTYP(J)		;GET PRINTER TYPE
	CAMN	S1,['DN60  ']		;DN60 PRINTER?
	SETZM	BYEUDT			;KEEP US FROM LOGGING OUT WHEN IDLE
					;LPTSPL HANDLES DN60 REMOTE OPR MSGS
	$RETT
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
	TDZA	T4,T4			;T4 = 1, SHUTDOWN MSG FROM QUASAR
SHUTND::SETOM	T4			;INDICATE 'OUT OF STREAM' CONTEXT
	AOSA	T4			;T4 = 0 'OUT OF STREAM' CONTEXT
SHUTIN::SETOM	T4			;INDICATE 'IN STREAM' CONTEXT
	SKIPL	J$LCHN(J)		;DO WE HAVE AN OUTPUT CHANNEL ???
	PUSHJ	P,@J$CLOS(J)		;YES, RELEASE THE OBJECT
	SKIPE	S1,J$DIFN(J)		;Get the IFN
	PUSHJ	P,F%REL			;YES, CLOSE IT
	SETZM	J$DIFN(J)		;Clear the IFN
	SKIPGE	T4			;ARE WE IN STREAM CONTEXT ???
	MOVE	P,[IOWD PDSIZE,PDL]	;YES, GET A NEW STACK POINTER
	SKIPE	J$SHUT(J)		;Device initialized yet?
	PUSHJ	P,@J$SHUT(J)		;YES, HANDLE DEVICE SPECIFIC SHUTDOWN
	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
	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
	SETZM	JOBWAC(S1)		;Clear it just in case
	SOS	SSETUP			;DECREMENT STREAM SETUP COUNT
	JUMPE	T4,.RETT		;'OUT OF STREAM',,JUST RETURN
	JUMPL	T4,MAIN.6		;'IN STREAM',,RETURN TO THE SCHEDULER
	SKIPN	BYEUDT			;%STCMD PROCESSOR?
	SKIPE	SSETUP			;YES, ANY STREAMS LEFT SETUP?
	$RETT				;NOT %STCMD OR STREAMS STILL SETUP
	PJRST	SHTBYE			;%STCMD AND NO MORE STREAMS
SUBTTL	RSETUP -- ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR

RSETUP::DMOVE	T2,S1			;SAVE THE SETUP CONDITION CODE & ATTRIB
	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
	CAXN	T2,%RSUOK		;GOOD SETUP?
	MOVEM	T3,RSU.FL(T1)		;YES STORE POSSIBLE EXTRA ATTRIBS
	MOVX	S1,%LOWER		;GET LOWER-CASE BIT
	SKIPL	J$LLCL(J)		;IS PRINT LOWER CASE?
	MOVX	S1,%UPPER		;NO, LOAD THE UPPER CASE FLAG
	STORE	S1,RSU.DA(T1),RO.ATR	;STORE THE DEVICE ATRRIBUTES
	MOVE	S1,J$LTYP(J)		;GET SIXBIT UNIT TYPE
	MOVEM	S1,RSU.UT(T1)		;SAVE IN MESSAGE
	PUSHJ	P,SNDQSR		;AND SEND THE MESSAGE
	$RETT				;RETURN.

SUBTTL	OACRSP -- OPERATOR RESPONSE TO A WTOR PROCESSOR.

OACRSP:	SETOM	JOBITS			;DON'T UPDATE STATUS BITS
	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	JOBUPD(S1)		;Update the stream's status
	MOVE	J,JOBPAG(S1)		;GET THE STREAM DB ADDRESS.
	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
	SKIPE	S1,J$DIFN(J)		;GET THE FILE IFN.
	PUSHJ	P,F%REL			;ELSE,,CLOSE IT OUT.
	SETZM	J$DIFN(J)		;Clear the IFN
	MOVEM	S,J$RACS+S(J)		;SAVE THE 'S' AC WITH NEW DSKOPN BITS
;**;[3010] Delete 3 lines at OACC.0+14L and 1 line at OACC.0+19L. /LWS
	SETZM	JOBACT(P1)		;STREAM IS NO LONGER ACTIVE
	PUSHJ	P,QRELEASE 		;RELEASE THE REQUEST
	$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
	$TEXT	(<-1,,J$WTOR(J)>,<Job aborted by the Operator^0>)
	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,@J$FLSH(J)		;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.
	SETZM	JOBCHK(S1)		;SAY WE WANT A CHECKPOINT TAKEN.
	SETOM	JOBUPD(S1)		;Update the status also.
	$RETT				;AND RETURN



SUBTTL OACCON -- Operator CONTINUE request.

OACCON:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%ST!PSF%DO	;LOAD THE BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
	$ACK  (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
	SETOM	JOBUPD(S1)		;Do an update
					;  don't need checkpoint
					;  did one when we stopped
	$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.
	SKIPE	J$POSF(J)		;DRIVER ALLOW POSITIONING?
	JRST	OALI.0			;YES--CONTINUE
	MOVE	S1,STREAM		;GET OUR STREAM
	$ACK	(<ALIGN not valid for ^T/@J$DRIV(J)/ printers>,,@JOBOBA(S1),.MSCOD(M))
	$RETT

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	JOBUPD(S1)		;Update the status
	$RETT				;RETURN.

OALI.3:	MOVE	S1,STREAM		;GET STREAM NUMBER
;**;[3000] Insert 1 line and change 1 line at OALI.3+1L. /LWS
	SETZM	J$APRG(J)		;[3000] AVOID CONFUSION,,CAN'T ALIGN
	$WTO  (<Alignment Not Scheduled>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/ - ^E/[-1]/>,@JOBOBA(S1)) ;[3000]
	$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 Discontinued,,@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.
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SKIPE	J$POSF(J)		;DRIVER ALLOW POSITIONING?
	JRST	OACF.0			;YES--CONTINUE
	MOVE	S1,STREAM		;GET OUR STREAM
	$ACK	(<FORWARDSPACE not valid for ^T/@J$DRIV(J)/ printers>,,@JOBOBA(S1),.MSCOD(M))
	$RETT

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:	SKIPN	J$DIFN(J)		;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.
;**;[4005]INSERT 1 LINE AT FSPACE:+5L 13-MAY-85/CTK
	ADDM	S2,J$FPIG(J)		;[4005]ADD TO FORWARDSPACE PAGE CNT
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
	$ACK  (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),.MSCOD(M))
;**;[2774] Change 1 line at FSPACE+7L. 25-Oct-83  /LWS
$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Forward spaced ^D/J$FPIG(J)/ Pages>) ;[2774]
	$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.
;**;[2774] Changed 1 line at FCOPYS+2L. 25-Oct-83  /LWS
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Forward spaced ^D/S2/ Copies>) ;[2774]
	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))
;**;[2774] Changed 1 line at FFILES+2L. 25-Oct-83  /LWS
	$TEXT	(LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Skipped by Operator>) ;[2774]
	PUSHJ	P,INPFEF		;FORCE AN END OF FILE
	TXO	S,SKPFIL		;TURN ON SKIP FILE FLAG
	$RETT				;AND RETURN

SUBTTL	OACBKS -- 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.
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SKIPE	J$POSF(J)		;DRIVER ALLOW POSITIONING?
	JRST	OACB.0			;YES--CONTINUE
	MOVE	S1,STREAM		;GET OUR STREAM
	$ACK	(<BACKSPACE not valid for ^T/@J$DRIV(J)/ printers>,,@JOBOBA(S1),.MSCOD(M))
	$RETT

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))
;**;[2774] Changed 1 line at BSPACE+3L. 25-Oct-83  /LWS
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Backspaced ^D/T1/ Pages>) ;[2774]
	SKIPN	J$DIFN(J)		;IS THERE A SPOOL FILE OPEN ???
	$RETT				;NO, JUST RETURN.

	ADDM	T1,J$RLIM(J)		;Up the limit to compensate for the
					;  backspace
	TXO	S,FCONV			;We will start next on new line
	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
	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

	MOVEM	S1,J$RNPP(J)		;RESET PAGE POINTER FOR THIS FILE
	MOVEI	S1,1(S2)		;POINT TO NEXT PAGE TBL ENTRY
	CAIL	S1,J$FPAG+PAGSIZ(J)	;Want to wrap around?
	JRST	[MOVEI	S1,J$FPAG(J)	;Yes, start at the beginning
		TXO	S,FBPTOV	;Say we overflowed
		JRST	.+1]		;And continue
	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	BCOPYS -- BACKSPACE 'COPIES'

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.
;**;[2774] Changed 1 line at BCOPYS+4L. 25-Oct-83 /LWS
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/^T/J$GSPL(J)/ Backspaced ^D/T1/ Copies>) ;[2774]
	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.

SUBTTL	BFILES -- BACKSPACE 'FILES'

BFILES:	PUSHJ	P,INPFEF		;FORCE AN END-OF-FILE
	TXO	S,SKPFIL+BCKFIL		;LITE SKIP FILE AND BACKSPACE'ED BITS
	SETOM	J$RNFP(J)		;RESET THE FILE COUNTER
	MOVE	S1,J$RFLN(J)		;GET THE FILE COUNT
	LOAD	S2,.EQSPC(J),EQ.NUM	;GET THE NUMBER OF FILES
	MOVEM	S2,J$RFLN(J)		;SAVE IT
	SUB	S2,S1			;CALC HOW FAR WE HAVE GONE SO FAR
	LOAD	E,.EQLEN(J),EQ.LOH	;GET THE HEADER LENGTH
	ADD	E,J			;POINT TO THE FIRST FP
BFIL.1:	SOJLE	S2,BFIL.2		;LOOP THROUGH THE FP/FD'S TILL
	PUSHJ	P,NXTFIL		;WE GET TO THE CURRENT FILE
	AOS	J$RNFP(J)		;MINUS ONE
	JRST	BFIL.1			;CONTINUE TILL DONE

BFIL.2:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$ACK	(<Backspaced 1 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)/>)
	MOVEM	E,J$RACS+E(J)		;UPDATE AC 'E' IN STREAM DATA BASE
	$RETT

PAGES:	0,,0
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.
	SETZM	JOBCHK(S1)		;SAY WE WANT TO CHECKPOINT.
	SETOM	JOBUPD(S1)		;  send update message also
	$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	IDLBYE AND SHTBYE - SAY GOODBYE TO QUASAR

IDLBYE:	MOVX	T3,IDLMIN		;GET MINUTES OF IDLENESS
	SKIPA	T2,[EXP IDLTXT]		;GET ITEXT FOR WTO
SHTBYE:	MOVEI	T2,SHTTXT
	MOVEI	T1,HELLO		;GET HELLO MSG ADDRESS
	MOVEI	S1,1
	STORE	S1,HEL.FL(T1),HEFBYE	;MAKE IT A GOODBYE MSG
	PUSHJ	P,SNDQSR		;SEND IT OFF
	$WTO	(<LPTSPL logging out>,<^I/(T2)/>,,$WTFLG(WT.SJI))
	$CALL	I%KJOB			;THAT'S ALL FOLKS
	STOPCD	(CNL,HALT,,<Could not logout. Call to I%KJOB failed>)

IDLTXT:	ITEXT	(<All streams have been idle for ^D/T3/ minutes>)
SHTTXT:	ITEXT	(<All streams have been shut down>)
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

	STOPCD	(QSF,HALT,,<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
	MOVE	S1,STREAM		;Get the stream number
	SETOM	JOBUPD(S1)		;Say we want a status update
	$CALL	DSTATUS			;Do it
	SETZM	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
		$CALL	.ZPAGA		; Make sure page is zeroed of residue
		 JRST LOGB.1]		;AND CONTINUE ON
	CAIL	P1,^D10			;NO, WITHIN RANGE?
	STOPCD	(TML,HALT,,<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	ACTBEG -- ACCOUNTING INITIALIZATION ROUTINE

ACTBEG:	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

TOPS20<	MOVX	S1,.FHSLF		;GET FORK HANDLE
	RUNTM   >			;GET MY RUNTIME

TOPS10<
  IFG <NPRINT-1>,<			;If more than one printer
	MOVEI	S1,0			;Dont account for runtime
  >
  IFE <NPRINT-1>,<			;If just one printer
	MOVEI	S1,0			;Get runtime for this job
	RUNTIM	S1,			;from the monitor
  >
>;END TOPS10

	MOVNM	S1,J$ARTM(J)  		;REMEMBER IT NEGATED
	$RETT				;RETURN
SUBTTL	ACTEND -- ACCOUNTING SUMMARY ROUTINE

ACTEND:	SKIPN	S1,DEBUGW		;SKIP IF DEBUGGING
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET THE INVALID ACCT STRING BIT
	JUMPN	S1,.RETT		;IF LIT,,THEN JUST RETURN

IFN FTACNT,<
TOPS20<	MOVX	S1,.FHSLF		;LOAD FORK HANDLE
	RUNTM				;GET RUNTIME
	ADDM	S1,J$ARTM(J)		;STORE IT
	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
> ;END TOPS20 ACCOUNTING

TOPS10<
  IFG <NPRINT-1>,<			;If more than one printer
	SETZM	J$ARTM(J)		;Zap the runtime
  >
  IFE <NPRINT-1>,<			;If just one printer
	SETZM	S1			;Get the runtime for this job
	RUNTIM	S1,			;Ask monitor
	ADDM	S1,J$ARTM(J)		;Calc run time to process the request
  >
	PUSHJ	P,I%NOW			;GET THE CURRENT TIME
	SUB	S1,J$RTIM(J)		;GET JIFFIES OF CONNECT TIME
	IDIVI	S1,3			;GET NUMBER OF SECONDS
	MOVEM	S1,LPCON		;SAVE THE CONNECT TIME
	MOVE	S1,[.NDRNN,,S2]		;GET CONVERT TO NAME FCT CODE
	MOVEI	S2,2			;A BLOCK LENGTH OF 2
	MOVE	T1,.EQROB+.ROBND(J)	;GET THE NODE NUMBER

FACT<	HRLZM	T1,FACTBL+3 >		;STORE NODE NUMBER NOW

	NODE.	S1,			;CONVERT IT
	 SKIPA				;SKIP ON AN ERROR
	MOVEM	S1,.EQROB+.ROBND(J)	;SAVE THE NODE NAME
	MOVE	S1,[ACTLEN,,ACTLST]	;GET THE PARM BLOCK LENGTH,,ADDRESS
	QUEUE.	S1,			;REQUEST ACCOUNTING BE DONE
	 TRNA				;ERROR, ANALYZE THE CODE
	JRST	ACTE.A			;GOOD RETURN, CONTINUE
	CAIE	S1,QUCNR%		;IS ERROR DUE TO COMPONENT NOT RUNNING?
	 PUSHJ	P,ACTE.1		;NO, FAILED,,TELL OPR
ACTE.A:
FACT<	MOVE	S1,LPLNO		;GET LINE NUMBER
	LDB	S2,[POINT 7,LPTRM,6]	;GET TERMINAL DESIGNATOR
	CAIN	S2,"C"			;ON THE CTY
	MOVEI	S1,7777			;YES, CTY DESIGNATOR
	CAIN	S2,"D"			;DETACHED
	MOVEI	S1,7776			;YES, FLAG THAT INSTEAD OF LINE NUMBER
	LSH	S1,6			;PUT IN BITS 18-29
	HRL	S1,LPJOB		;INSERT JOB NUMBER
	IOR	S1,[251000,,13]		;ADD FACT TYPE AND NUMBER OF WORDS
	MOVEM	S1,FACTBL+0		;STORE IN BLOCK
	MOVE	S1,.EQOID(J)		;GET PPN
	MOVEM	S1,FACTBL+1		;STORE
	SETZM	FACTBL+2		;DAEMON FILLS IN THE DATE/TIME
	MOVE	S1,[%CNSER]		;CPU SERIAL NUMBER
	GETTAB	S1,			;ASK FOR IT
	  SETZ	S1,			;USE 0 IF CAN'T FIND IT
	TLO	S1,'LP '		;QUEUE NAME = LPTSPL
	IORM	S1,FACTBL+3		;NODE NUMBER ALREADY STORED FROM ABOVE

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

	MOVE	S1,J$ARTM(J)		;RUN TIME IN MILLISECONDS
	MOVEM	S1,FACTBL+4		;STORE
	SETZM	FACTBL+5		;*** CORE TIME INTERGRAL
	MOVE	S1,J$ADRD(J)		;DISK READS
	MOVEM	S1,FACTBL+6		;STORE
	SETZM	FACTBL+7		;NO DISK WRITES
	MOVE	S1,J$LDEV(J)		;DEVICE NAME
	MOVEM	S1,FACTBL+10		;STORE
	MOVE	S1,J$ASEQ(J)		;SEQUENCE NUMBER
	MOVEM	S1,FACTBL+11		;STORE
	MOVE	S1,J$APRT(J)		;NUMBER OF PAGES PRINTED
	MOVEM	S1,FACTBL+12		;STORE
	MOVE	S1,[FACSIZ+1,,FACTBL-1]	;DAEMON ARGUMENT
	DAEMON	S1,			;MAKE THE FACT ENTRY
	  JRST	ACTE.1			;REPORT THE FAILURE
> ;END FACT ACCOUNTING
> ;END TOPS10 ACCOUNTING
	$RETT				;IF OK,,RETURN

ACTE.1:	MOVE	S1,STREAM		;GET THIS STREAM NUMBER
	$WTO	(System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
> ;END IFN FTACNT

	$RETT				;RETURN

SUBTTL	ACTLST -- SPOOLER ACCOUNTING RECORD

IFN FTACNT,< SEARCH	ACTSYM		;SEARCH THE ACCOUNTING UNV

ACTLST:	USENT.	(.UTOUT,1,1,0)
	USTAD.	(-1)			;CURRENT DATE/TIME
	USPNM.	(<SIXBIT/LPTSPL/>,US%IMM) ;PROGRAM NAME
	USPVR.	(%%.LPT,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(.EQROB+.ROBND(J))	;NODE NAME
	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
	USPRI.	(J$APRI(J))		;JOB PRIORITY

TOPS20<	USJNO.	(-1)			;JOB NUMBER
	USTRM.	(-1)			;TERMINAL DESIGNATOR
	USLNO.	(-1)			;TTY LINE NUMBER
	USTXT.	(<-1,,[ASCIZ / /]>)	;SYSTEM TEXT
	USNM2.	(<POINT 7,.EQOWN(J) >)  ;USER NAME (TOPS20)
	USACT.	(<POINT 7,.EQACT(J) >)	;ACCOUNT STRING POINTER
	0				;END OF LIST
> ;END TOPS20 ACCOUNTING

TOPS10<	USNM1.	(.EQOWN(J))		;USER NAME 1 (TOPS10)
	USNM3.	(.EQOWN+1(J))		;USER NAME 1 (TOPS10)
	USORI.	(.EQRID(J))		;USER REQUEST ID
	USPPN.	(.EQOID(J))		;USER PPN
	USJNO.	(LPJOB)			;JOB NUMBER
	USTRM.	(LPTRM)			;TERMINAL DESIGNATOR
	USLNO.	(LPLNO)			;TTY LINE NUMBER
	USOCN.	(LPCON)			;CONNECT TIME
	USOAC.	(<POINT 7,.EQACT(J) >)	;ACCOUNT STRING POINTER
> ;END TOPS10 ACCOUNTING

	ACTLEN==.-ACTLST		;ACCOUNTING BLOCK LENGTH

FACT<	FACSIZ==13			;Size of fact accounting block
	EXP	.FACT			;DAEMON WRITE FACT FILE FUNCTION
FACTBL:	BLOCK	FACSIZ  >		;FACT BLOCK FILLED IN

> ;END IFN FTACNT
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
	SETZM	J$XFOB+FOB.US(J)	;DEFAULT TO NO ACCESS CHECKING
	SETZM	J$XFOB+FOB.CD(J)	;HERE ALSO
	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
;**;[2774] Insert 7 lines after INPO.1+4L. 25-Oct-83  /LWS
	SETZM	J$GSPL(J)		;[2774] ASSUME NOT SPOOLED
	LOAD	S2,.FPINF(E),FP.SPL	;[2774] GET SPOOLED FILE BIT
	JUMPE	S2,.RETT		;[2774] RETURN IF NOT SPOOLED
	MOVX	S2,FI.SPL		;[2774] GET ATTRIBUTE WE WANT
	$CALL	F%INFO			;[2774] ASK FOR SPOOLED FILE NAME
	JUMPE	S1,.RETT		;[2774] RETURN IF NONE
	$TEXT(<-1,,J$GSPL(J)>,< ^W/S1/^0>) ;[2774] SAVE NAME AS ASCIZ STRING
					; (WITH LEADING SPACE)
	$RETT				;AND RETURN

INPO.2:	ZERO	.FPINF(E),FP.DEL	;CLEAR THE 'DELETE FILE' BIT
	PUSHJ	P,@J$FLER(J)		;DO FILE LOOKUP ERROR PROCESSING
	$RETF				;RETURN

LPTLER::$TEXT(LOGCHR,<^I/LPERR/Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/>)
	$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
	TXO	S,SKPFIL		;SKIP THE REST OF THE FILE
	PUSHJ	P,@J$FIER(J)		;DO FILE INPUT ERROR PROCESSING
	$RETF				;RETURN

LPTIER::$TEXT(LOGCHR,<^I/LPERR/Error reading input file; ^E/[-1]/>)
	$RETF				;AND RETURN
SUBTTL	INPFEF  --  Force end-of-file on next input

INPFEF::SKIPN	S1,J$DIFN(J)		;IS THE SPOOL FILE OPEN ???
	$RETT				;NO, JUST RETURN
	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:	TXNE	S,ABORT			;ARE WE ABORTING?
	$RETF				;YES, END THE REQUEST
	TXZ	S,FRMSOK		;CLEAR FORMS OK FLAG
	GETLIM	S1,.EQLIM(J),FORM	;GET THE FORMS TYPE
	CAMN	S1,J$FORM(J)		;OR ARE FORMS EXACTLY THE SAME?
;**;[3012] Replace one line at FORMS+4L. /LWS
	JRST	FORM4A			;[3012] YES, GO CHECK RAM AND VFU
	HRLZI	S2,J$WTOR(J)		;Get the start address of the buffer
	HRRI	S2,J$WTOR+1(J)		; and +1
	SETZM	J$WTOR(J)		;Want to zero it all
	BLT	S2,J$WTOR+^D50-1(J)	;Zap it
	MOVE	S2,[POINT 7,J$WTOR(J)]	;GET POINTER TO WTOR BUFFER.
	MOVEM	S2,TEXTBP		;AND SAVE IT FOR DEPBP.
	PUSHJ	P,RFORM			;READ FORMS MOUNTED ON PRINTER
	GETLIM	S2,.EQLIM(J),FORM	;GET REQUESTED TYPE
	SKIPF				;IF FAILURE, NOTHING TO DO
	JUMPN	S1,[SETOM J$LVFF(J)	;IF SET, ASSUME NOT 1ST TIME THRU
		    JRST  FORM.0]
	SKIPN	S1,J$FORM(J)		;GET FORMS TYPE
	MOVX	S1,FRMNOR		;USE NORMAL IF NULL
FORM.0:	XOR	S2,S1			;GET COMMON PART
	AND	S2,[EXP FRMSK1]		;AND IT WITH THE IMPORTANT PART
	GETLIM	S1,.EQLIM(J),FORM	;GET FORMS TYPE
	EXCH	S1,J$FORM(J)		;SAVE IT
	MOVEM	S1,J$FPFM(J)		;SAVE OLD ONES
	JUMPN	S2,FORM.1		;IF DIFFERENT, SET WTOR TEXT
	MOVE	S1,J$FTAP(J)		;IF FORMS THE SAME, ASSUME
	MOVEM	S1,J$FLVT(J)		;VFU ALIGNMENT OK
	MOVE	S1,J$LRAM(J)		;AND RAM OK, TOO
	MOVEM	S1,J$FLRM(J)
	TXOA	S,FRMSOK		;FORMS ARE OK
FORM.1:	$TEXT	(DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
	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

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

	PUSHJ	P,FRMINI		;READ THE LPFORM.INI FILE.
	JUMPT	FORM.3			;Skip the message if ok
	TXNN	S,FRMSOK		;FORMS OK (SET BEFORE)?
	SKIPN	J$MNTF(J)		;DEVICE SUPPORT MOUNTABLE FORMS?
	JRST	FORM.3			;NO--IGNORE NOT FOUND ERROR
FRM.2A:	MOVE	S1,STREAM		;Get the stream number
	GETLIM	S2,.EQLIM(J),FORM	;Get forms type
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SETOM	JOBUPD(S1)		;  update status also
	$WTOR	(<Form ^W/S2/ not found, defaults being used>,<^R/.EQJBB(J)/^T/FORMSG/>,@JOBOBA(S1),JOBWAC(S1))		;Tell the operator
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	JRST	FORM.7			;YES, IGNORE THE ERROR
	MOVEI	S1,FRMANS		;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	FRM.2A			;NO, STUPID OPERATOR SO TRY AGAIN
	HRRZ	S1,0(S1)		;GET THE ROUTINE ADDRESS
	JRST	0(S1)			;AND PROCESS THE RESPONSE

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

;  Set up the width and length classes

FORM.3:	MOVEI	S1,3			;START AT THREE FOR BOTH
	MOVEM	S1,J$FWCL(J)		;STORE IT
	MOVEM	S1,J$FLCL(J)		;STORE IT AGAIN
	MOVE	S1,J$FWID(J)		;GET THE WIDTH
	CAIG	S1,F$WCL2		;LE CLASS 2 LIMIT?
	SOS	J$FWCL(J)		;YES, SOS ONCE
	CAIG	S1,F$WCL1		;LE CLASS 1 LIMIT
	SOS	J$FWCL(J)		;YES, SOS AGAIN
	MOVE	S1,J$FLIN(J)		;Get the length
	CAIG	S1,F$LCL2		;LE class 2 limit?
	SOS	J$FLCL(J)		;Yes, sos once
	CAIG	S1,F$LCL1		;LE class 1 limit?
	SOS	J$FLCL(J)		;Yes, sos again

	SKIPN	J$MNTF(J)		;DEVICE SUPPORT MOUNTABLE FORMS?
	$RETT				;NO, JUST RETURN NOW !!
	MOVE	S1,TEXTBP		;GET THE WTOR BYTE POINTER.
	TXNE	S,FRMSOK		;FORMS OK?
	JRST	FORM4A			;YES
	TXNE	S,FRMFND		;Were the forms found?
	 CAMN	S1,[POINT 7,J$WTOR(J)]	;IS THERE A MESSAGE FOR THE OPERATOR ??
	  JRST	FORM4A			;NO, TRY LOADING VFU AND RAM
	$TEXT	(DEPBP,<^T/ENDRSP/^0>)	;ADD THE RESPONSE TO THE END

FORM.4:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTOR  (,<^T/J$WTOR(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SETOM	JOBUPD(S1)		;  update status also
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE.
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	JRST	FORM.7			;Go replace the old forms
	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

;**;[3012] Add code at FORM.4+12L. /LWS
;Here to check the status of the VFU. If bad, load RAM and VFU.

FORM4A:	PUSHJ	P,VFUCHK		;CHECK VFU STATUS
	JUMPT	FORM.5			;[3014] IF OK, DON'T FORCE LOADS
	SETZM	J$FLRM(J)		;[3012] LOAD RAM AND VFU TO BE SAFE
	SETZM	J$FLVT(J)		;[3012]
	MOVE	S2,STREAM		;[3012] GET CURRENT STREAM
	$WTO	(VFU error,<Reloading RAM and VFU>,@JOBOBA(S2)) ;[3012]

FORM.5:	GETLIM	S1,.EQLIM(J),FORM	;FIRST SET FORMS TYPE IF WE CAN
	PUSHJ	P,SFORM
	PUSHJ	P,LODVFU		;[4104] GET THE VFU LOADED
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED ???
	$RETF				;YES, RETURN NOW
	PUSHJ	P,LODRAM		;[4104] LOAD RAM
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED ???
	$RETF				;YES, RETURN NOW
	$RETT				;NO, HE WINS SO FAR !!!

FORM.6:	TXO	S,RQB			;Requeue the job
FORM.7:	MOVE	S1,J$FPFM(J)		;Get old forms
	MOVEM	S1,J$FORM(J)		;Restore it
	$RETF				;And return

ENDRSP:	ASCIZ	/Type 'RESPOND <number> PROCEED' when ready/

FRMANS:	$STAB
	 KEYTAB	(FORM.6,ABORT)		;ABORT
	 KEYTAB	(FORM.3,PROCEED)	;PROCEED
	$ETAB

FORMSG:	ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' after mounting correct forms, to allow the job to continue printing/
FMFD:	$BUILD	(FDXSIZ)		;BLOCK LENGTH
	  $SET	(.FDLEN,FD.LEN,FDXSIZ)	  ;LENGTH OF FILESPEC
	  $SET	(.FDLEN,FD.TYP,.FDNAT)	  ;NATIVE MODE FILESPEC
	  $SET	(.FDSTR,FWMASK,'SYS   ')  ;DEVICE NAME
	  $SET	(.FDNAM,FWMASK,'LPFORM')  ;FILE NAME
	  $SET	(.FDEXT,LHMASK,'INI')	  ;EXTENSION
	$EOB				;END OF BLOCK

RFORM:	TDZA	TF,TF			;INDICATE ENTRY
SFORM:	SETOM	TF
	$SAVE	<T1,T2,T3,T4>		;GET SOME ACS
	MOVE	T1,S1			;SAVE POSSIBLE FORMS TYPE TO SET
	MOVE	S1,[XWD T2,2]		;ASSUME READING FORMS
	MOVEI	T2,.DFFRM
	MOVE	T3,J$LDEV(J)		;GET PRINTER NAME
	JUMPE	TF,RSFRM		;JUMP IF READING
	ADDI	S1,1			;ELSE, NEED ONE MORE ARG
	MOVE	T4,T1			;WHICH IS THE FORMS TYPE
	ADDI	T2,.DFSET		;MAKE SET FUNCTION
RSFRM:	MOVSS	S1			;MAKE UUO AC CORRECT
	DEVOP.	S1,			;READ/SET FORMS TYPE
	$RETF
	$RETT

FRMINI:	TXZ	S,FRMFND		;CLEAR THE FORMS FOUND FLAG
	SETZM	J$APRG(J)		;CLEAR ALIGNMENT NEEDED FLAG
	MOVEI	S1,FMFD			;FD FOR LPFORM.INI
	MOVEI	S2,0			;FOR NOW DON'T DO DATE/TIME CHECKING
	PUSHJ	P,FH$INI		;INIT FILE PROCESSING
	$RETIF				;RETURN ON ERRORS

FRMIN1:	PUSHJ	P,FH$SIX		;GET THE FORMS NAME
	JUMPT	FRMI1B			;Found something (No EOF)
	TXNE	S,FRMFND		;Have we found a match somewhere?
	 $RETT				;Yes, return good
	  $RETF				;No, do otherwise
FRMI1B:	MOVE	T1,S1			;GET RESULT
	GETLIM	T2,.EQLIM(J),FORM	;GET FORMS
	CAMN	T1,T2			;MATCH??
	JRST	FRMIN2			;YES!!
FRMI1A:	PUSHJ	P,FH$EOL		;NO, FIND NEXT LINE
	$RETIF				;EOF without finding the forms
	JRST	FRMIN1			;AND LOOP


FRMIN2:	TXO	S,FRMFND		;Remember we've found it
	CAIN	C," "			; Break on a space?
	 PUSHJ	P,FH$SKP		; Allow spaces, get non-blank char.
;**;[2777] Insert 2 lines at FRMIN2+2L. /LWS
	PUSHJ	P,FH$COM		;FLUSH COMMENT
	$RETIF				;CHECK FOR ERRORS
	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$CVT		;ELSE, GET A CHARACTER
	JUMPT	FRMIN2			;AND LOOP IF WE HAVE A CHARACTER

FRMINX:	PUSHJ	P,FH$XIT		;TERMINATE I/O
	SKIPGE	J$APRG(J)		;NEED ALIGMENT ???
	PUSHJ	P,OALI.2		;YES--DO IT NOW
	$RETT				;RETURN

FRMIN3:	PUSHJ	P,FH$SIX		;GET A LOCATOR
	JUMPF	FRMINX			;EOF!!
	SKIPN	T1,S1			;GET RESULT
	JRST	FRMI3A			;MAYBE PAREN??
	JRST	FRMIN4			;PROCESS THE LOCATOR

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!!
	CAMN	T1,J$LDEV(J)		;COMPARE TO OUR DEVNAM
	JRST	FRMIN5			;MATCH!!

	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
	CAIN	C," "			; Break on space?
	 JRST	FRMI1A			; Yes, get the next line
	PUSHJ	P,FH$SIX		;ELSE, GET THE NEXT LOCATOR
	JUMPF	FRMINX			;EOF, FINISH UP
	SKIPN	T1,S1			;GET RESULT
	JRST	FRMIN9			;BAD FORMAT
	JRST	FRMIN4			;AND LOOP AROUND
;GET HERE IF THIS LINE IS FOR US

FRMIN5:	PUSHJ	P,FH$COM		;FLUSH COMMENT, CHECK LINE CONTINUATION
	$RETIF				;CHECK FOR ERRORS
	CAIN	C,.CHLFD	;WAS THE LAST CHARACTER A LINEFEED?
	JRST	FRMINX		;YES, FINISH UP
	CAIN	C,"/"		;ARE WE AT THE BEGINNING OF A SWITCH?
	JRST	FRMI5A		;YES, DO IT!
	PUSHJ	P,FH$CVT	;NO, GET A CHARACTER
	JUMPF	FRMINX		;EOF!!
	JRST	FRMIN5		;AND LOOP AROUND
FRMI5A:	PUSHJ	P,FH$SIX	;GET THE SWITCH
	JUMPF	FRMINX		;EOF!!
	SKIPE	T1,S1		;GET RESULT
	JRST	FRMIN6		;JUMP IF WE'VE GOT SOMETHING
	CAIN	C,.CHLFD	;EOL?
	JRST	FRMINX		;YES, FINISH UP
	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
	MOVEI	S1,[ITEXT (<Unknown switch ^W/T4/ in line ^D/INILIN/>)]
	MOVEI	S2,[ITEXT (<Unknown switch ^W/T4/ reading ^F/@INIFOB+FOB.FD/>)]
	PJRST	FH$ERR		;REPORT ERROR AND RETURN

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

FRMIN9:	MOVEI	S1,[ITEXT (<File format error encountered in line ^D/INILIN/>)]
	MOVEI	S2,[ITEXT (<File format error reading ^F/@INIFOB+FOB.FD/>)]
	PJRST	FH$ERR		;REPORT ERROR AND RETURN
SUBTTL	Forms Switch Subroutines


S$BANN:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$BANN		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FBAN(J)		;STORE IT
	$RETT				;AND RETURN

S$TRAI:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$TRAI		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FTRA(J)		;STORE IT
	$RETT				;AND RETURN

S$HEAD:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$HEAD		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FHEA(J)		;STORE IT
	$RETT				;AND RETURN

S$LINE:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$LINE		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FLIN(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$WIDT:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$WIDT		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FWID(J)		;SAVE IT
	POPJ	P,			;AND RETURN

S$RIBB:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FRIB(J)		;SAVE IT
	CAME	S1,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
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FDRU(J)		;SAVE IT
	CAME	S1,J$PDRU(J)		;SKIP IF NOT CHANGED
	$TEXT	(DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>)
	POPJ	P,			;AND RETURN

S$NOTE:	SETZM	J$FNBK(J)		;INIT STORAGE
	PUSHJ	P,FH$QST		;GET POSSIBLY QUOTED STRING
	JUMPF	S$NOT1			;EOF
	SKIPN	(S1)			;ANY TEXT RETURNED?
	JRST	S$NOT1			;NO
	HRLZS	S1			;GET ADDR OF RESULT IN LH
	HRRI	S1,J$FNBK(J)		;MAKE A BLT POINTER
	ADDI	S2,J$FNBK(J)		;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY TEXT

S$NOT1:	$TEXT	(DEPBP,<Note: ^T/J$FNBK(J)/>) ;ADD THE MSG TO WTOR.
	$RETT				;RETURN.

S$ALCN:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$ALCN		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FALC(J)		;STORE IT
	SETOM	J$APRG(J)		;FLAG ALIGNMENT NEEDED
	$RETT				;AND RETURN

S$ALSL:	CAIE	C,":"			;ARGUMENT FOLLOWING?
	SKIPA	S1,D$ALSL		;GET DEFAULT
	PUSHJ	P,FH$DEC		;READ IT
	$RETIF				;CHECK FOR ERRORS
	MOVEM	S1,J$FALS(J)		;SAVE IT
	SETOM	J$APRG(J)		;FLAG ALIGNMENT NEEDED
	$RETT				;AND RETURN

S$ALIG:	PUSHJ	P,FH$SIX		;GET THE ALIGN FILENAME ARGUMENT
	$RETIF				;CHECK FOR ERRORS
	SKIPE	S1			;SKIP IF NOTHING THERE
	MOVEM	S1,J$FALI(J)		;SAVE THE ALIGN FILENAME
	SETOM	J$APRG(J)		;FLAG ALIGNMENT NEEDED
	POPJ	P,			;AND RETURN

S$VFU:
S$TAPE:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	JUMPF	.RETT			;EOF
	MOVEM	S1,J$FTAP(J)		;SAVE IT
	CAME	S1,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	S1,J$FRAM(J)		;SAVE IT
	$RETT				;AND RETURN
	SUBTTL	RANDOM DEVICE CONTROL -- LATSUP - SET UP A LAT LINE


; ROUTINE TO GET A REVERSE LAT CONNECTION
; CALL:	MOVE	M,[ADDRESS OF SETUP MESSAGE]
;	MOVE	J,[JOB DATA PAGE]
;	PUSHJ	P,LATSUP

LATSUP:	STKVAR	<<LATOP,.LAPRT+1>>	;
	MOVEI	S1,LATOP		;
	SETZM	(S1)			;
	MOVS	S2,S1			;SOURCE,,0
	HRRI	S2,1(S1)		;SOURCE,,DESTINATION
	BLT	S2,.LAPRT(S1)		;CLEAR THE ENTIRE UUO BLOCK
	MOVX	S2,.LAPRT+1		;LENGTH
	MOVEM	S2,.LAACT(S1)		;
	MOVX	S2,.LARHC		;FUNCTION
	MOVEM	S2,.LAFCN(S1)		;
	MOVX	S2,LA.WAI		;PARAMETERS
	MOVEM	S2,.LAPRM(S1)		;
	MOVEI	S2,SUP.LN+00(M)		;GET ADDRESS OF SERVER NAME
	SKIPE	(S2)			;IS THERE A SERVER NAME?
	MOVEM	S2,.LASVR(S1)		;YES, SAVE THIS ADDRESS
	MOVEI	S2,SUP.LN+04(M)		;GET ADDRESS OF SERVICE NAME
	SKIPE	(S2)			;IS THERE A SERVICE NAME?
	MOVEM	S2,.LASVC(S1)		;YES, SAVE THIS ADDRESS
	MOVEI	S2,SUP.LN+10(M)		;GET ADDRESS OF PORT NAME
	SKIPE	(S2)			;IS THERE A PORT NAME?
	MOVEM	S2,.LAPRT(S1)		;YES, SAVE THIS ADDRESS
	LATOP.	S1,			;REQUEST HOST-INITIATED CONNECT
	  JRST	LATSU3			;ERROR: OBJECT DOES NOT EXIST
	MOVEI	S1,LATOP		;
	MOVE	S1,.LAVAL(S1)		;GET STATUS
	CAIL	S1,.UXTRM+000		;
	CAILE	S1,.UXTRM+777		;DID THE CONNECTION SUCCEED?
	JRST	LATSU2			;NO, EVALUATE THE STATUS CODE
; COME HERE AFTER A SUCCESSFUL CONNECTION

	MOVEM	S1,J$LION(J)		;SAVE THE UDX
	TRZ	S1,.UXTRM		;GET THE TTY NUMBER
	SETZ	T1,			;INITIALIZE THE ACCUMULATOR
LATSU1:	IDIVI	S1,10			;DIVIDE BY THE RADIX
	ADDI	S2,'0'			;CONVERT TO SIXBIT
	LSHC	S2,-6			;SAVE THE CHARACTER
	JUMPN	S1,LATSU1		;CONVERT THE TTY NUMBER TO SIXBIT
	MOVSI	S1,'TTY'		;ASSEMBLE THE TTY DEVICE NAME
	HLR	S1,T1			;
	MOVEM	S1,SUP.ST(M)		;FIX UP THE SETUP MESSAGE
	SETOM	J$LLAT(J)		;MARK THIS AS A LAT LINE
	MOVEI	S1,.RETT		;GET ADDRESS OF NULL ROUTINE
	MOVEM	S1,J$$DEV(J)		;INITIALIZE FIRST DRIVE ROUTINE
	HRLI	S1,J$$DEV(J)		;SOURCE,,0
	HRRI	S1,J$$DEV+1(J)		;SOURCE,,DESTINATION
	BLT	S1,J$$DND(J)		;INITIALIZE THE DISPATCH TABLE
	MOVEI	S1,LPTCLS		;COMMON DEVICE CLOSE ROUTINE
	MOVEM	S1,J$CLOS(J)		;RELEASE THE TERMINAL
	$RETT				;


; COME HERE TO LOOK FOR FATAL STATUS CODES

LATSU2:	MOVSI	S2,-LATERN		;SET UP THE LOOP INDEX
	CAME	S1,LATERR(S2)		;DO THEY MATCH?
	AOBJN	S2,.-1			;NO, KEEP LOOKING
	SKIPG	S2			;NOT FOUND: OBJECT NOT AVAILABLE
LATSU3:	SKIPA	S1,[%RSUDE]		;OBJECT DOES NOT EXIST (EVER)
	MOVX	S1,%RSUNA		;OBJECT NOT AVAILABLE (TRY LATER)
	$RETF				;


LATERR:	EXP	.LAUNK,.LAISC,.LANSS,.LASDI
	EXP	.LASNP,.LANSP,.LAIPW,.LAACD
LATERN=.-LATERR
SUBTTL	COMMON DEVICE CONTROL -- LPTOPR - ASK FOR OPERATOR ACTION


; ROUTINE TO ASK THE OPERATOR FOR HELP
; CALL:	MOVE	T1, WTO TYPE TEXT ADDRESS
;	MOVE	T2, WTO MESSAGE TEXT ADDRESS
;	MOVE	T3, KEYWORD TABLE ADDRESS
;	PUSHJ	P,LPTOPR
;
; TRUE RETURN:	S1 WILL CONTAIN THE KEYWORD TABLE OFFSET
; FALSE RETURN:	STREAM CANCELED OR REQUEUED

LPTOPR::MOVE	T4,STREAM		;GET STREAM NUMBER
	SETOM	JOBCHK(T4)		;FORCE A CHECKPOINT
	$WTOR	(<^I/(T1)/>,<^I/(T2)/>,@JOBOBA(T4),JOBWAC(T4))
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;STREAM CANCELED?
	$RETF				;YES
	MOVEI	S1,(T3)			;POINT TO KEYWORD TABLE
	HRROI	S2,J$RESP(J)		;AND TO OPERATOR RESPONSE
	PUSHJ	P,S%TBLK		;SCAN THE TABLE
	TXNE	S2,TL%NOM!TL%AMB	;NO MATCH OR AMBIGUOUS?
	JRST	LPTOPR			;GO TRY AGAIN
	HRRZ	S1,(S1)			;GET KEYWORD DATA FROM TABLE
	$RETT				;RETURN WITH ANSWER IN S1
SUBTTL	RANDOM DEVICE CONTROL -- LODVFU - LOAD GENERIC VFU

LODVFU:	SKIPN	J$LDVF(J)		;IS VFU LOADABLE?
	 $RETT				;NOPE, PRETEND ALL IS WELL
VFU.1:	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))
	PUSHJ	P,@J$FLSH(J)		;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	VFU.3			;NO, SKIP THIS
	SETOM	J$LVFF(J)		;RESET THE FIRST TIME THROUGH FLAG
	PUSHJ	P,VFUCHK		;CHECK VFU STATUS
	JUMPF	VFU.2			;DONT OUTPUT FORM FEED IF BAD
	MOVX	C,.CHFFD		;GET FORM FEED CODE
	PUSHJ	P,DEVOUT		;PUT IT OUT
	PUSHJ	P,OUTDMP		;ALIGN THE FORMS ON THE PRINTER
	JRST	VFU.3			;AND GO RELOAD THE VFU

VFU.2:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTOR(<Align Forms and Put Online>,<^T/ENDRSP/>,@JOBOBA(S1),JOBWAC(S1))
	SETZM	JOBCHK(S1)		;TAKE A CHECKPOINT WHEN WE CAN
	SETOM	JOBUPD(S1)		;  update status also
	$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	VFU.2			;NO, STUPID OPERATOR -- TRY AGAIN !!

VFU.3:	MOVEI	S1,1			;CODE TO LOAD VFU
	PUSHJ	P,@J$VFU(J)		;TRY TO LOAD THE VFU
	SKIPT				;ANY ERRORS? (DISPATCH IF SO)
	JRST	@[IFIW	HDWVFU		;(0) VFU FILE NOT FOUND, HDW VFU LOADED
		  IFIW	VFUFAI		;(1) LOAD FAILED, OPR ACTION REQUEST
		  IFIW	NODAVF](S1)	;(2) NO DAVFU AFTER ALL
	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,@J$FLSH(J)		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	$RETT
SUBTTL	RANDOM DEVICE CONTROL -- LODRAM - LOAD GENERIC RAM

LODRAM:	MOVE	S1,J$FRAM(J)		;GET THE RAM WE WANT
	 SKIPE	J$LDRM(J)		;IF NOT LOADABLE, 
	CAMN	S1,J$FLRM(J)		;  OR ALREADY LOADED
	 $RETT				;YES, RETURN NOW !!!
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
	PUSHJ	P,@J$RAM(J)		;DO DEVICE DEPENDENT LOAD
	 SKIPT				;ANY ERRORS? (DISPATCH IF SO)
	JRST	@[IFIW	HDWRAM		;(0) RAM LOAD FAILED, HARDWARE RAM USED
		  IFIW	NORAM		;(1) RAM LOAD FAILED, NEED OPR ACTION
		  IFIW	NOTRAM](S1)	;(2) RAM LOAD FAILED, NOT PRESENT
	MOVE	S1,J$FRAM(J)		;GET THE RAM TYPE WE JUST LOADED
	MOVEM	S1,J$FLRM(J)		;SAVE IT AS LOADED RAM TYPE
	POPJ	P,			;LOAD SUCCEEDED

HDWRAM:	MOVE	T1,D$RAM		;GET NAME OF NORMAL
	MOVEM	T1,J$FLVT(J)		;STORE IT
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Error loading RAM, Loaded hardware RAM instead.,@JOBOBA(S1))
	$RETT

NORAM:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTOR	(,<^I/RAMI1/^J^M^T/RAMI2/>,@JOBOBA(S1),JOBWAC(S1))
	SETZM	JOBCHK(S1)		;WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD(S1)		;  Update also
	$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/


NOTRAM:	SETZM	J$LDRM(J)		;NOT LOADABLE AFTER ALL
	$RETT
SUBTTL	COMMON DEVICE CONTROL -- LPTDVN - GENERATE DEVICE NAME


; ROUTINE TO GENERATE A DEVICE NAME
; CALL:	MOVE	S1,[SIXBIT /DEV/]
;	PUSHJ	P,GENDEV

LPTDVN::MOVEM	S1,J$LDEV(J)		;SAVE DEVICE
	TRNE	S1,-1			;GIVEN FULL NAME?
	POPJ	P,			;YES--DONE
	MOVE	T1,STREAM		;PICK UP STREAM NUMBER.
	MOVE	T1,JOBOBA(T1)		;PICK UP OBJECT BLOCK ADDRESS.
	MOVE	T2,OBJ.ND(T1)		;PICK UP THE NODE NUMBER.
	IDIVI	T2,10			;SPLIT NODE NUMBER IN HALF.
	IMULI	T2,100			;SHIFT LEFT 2 DIGITS.
	ADD	T2,T3			;ADD SECOND NODE DIGIT.
	IMULI	T2,100			;SHIFT LEFT ANOTHER 2 DIGITS.
	ADD	T2,OBJ.UN(T1)		;ADD THE UNIT NUMBER.
	ADDI	T2,'000'		;MAKE SIXBIT
	IORB	T2,J$LDEV(J)		;AND SAVE IT
	IONDX.	T2,UU.PHY		;GET I/O INDEX
	  SETZ	T2,			;???
	MOVEM	T2,J$LION(J)		;SAVE IT
	POPJ	P,			;RETURN
SUBTTL	COMMON DEVICE CONTROL -- LPTLIN - GENERATE ANF-10 TTY NAME


; RESOLVE SYSTEM-WIDE TTY NAME TO A SPECIFIC TTY ON A GIVEN
; ANF-10 STATION, CONNECT LINE, AND RUN INITIA
; CALL:	MOVE	S1, SIXBIT/TTYNNN/
;	PUSHJ	P,LPTLIN
;
; TRUE RETURN:	TTY NAME UPDATED IN J$LDEV, I/O INDEX IN J$LION
; FALSE RETURN:	NOT A TTY, NO SUCH TTY, OR CAN'T CONNECT LINE

LPTLIN::MOVE	T1,S1			;COPY TTY NAME
	MOVE	T4,T1			;SAVE DEVICE NAME
	HLRZ	T2,T1			;GET DEVICE MNEMONIC
	CAIN	T2,'TTY'		;BETTER BE TTY
	TRNN	T1,777777		;AND A UNIT NUMBER
	$RETF				;CAN'T HANDLE ANYTHING ELSE
	HRRZS	T1			;REMOVE JUNK
	MOVSI	T3,-3			;LOOP COUNT

LINE.1:	TRNE	T1,77			;DIGIT PRESENT?
	JRST	LINE.2			;YES--GO ENTER LOOP
	LSH	T1,-6			;RIGHT JUSTIFY
	TRO	T3,-1			;INCASE WE JUMP OUT NEXT TIME
	AOBJN	T3,LINE.1		;AND CHECK AGAIN

LINE.2:	SUBI	T1,'0'			;CONVERT TO OCTAL
	LSHC	T1,-3			;SAVE DIGIT
	LSH	T1,-3			;REMOVE JUNK
	AOBJN	T3,LINE.2		;LOOP
	LSHC	T1,3			;SHIFT IN A DIGIT
	SOJG	T3,.-1			;DO THEM ALL
	MOVE	T2,STREAM		;GET STREAM NUMBER
	MOVE	T2,JOBOBA(T2)		;AND THE OBJECT BLOCK
	MOVE	T2,OBJ.ND(T2)		;GET STATION NUMBER
	HRL	T1,T2			;MAKE IT NODE,,LINE
	MOVE	T3,T1			;COPY FOR NODE. UUO
	CAMN	T2,CNTSTA		;LOCAL?
	JRST	LINE.3			;YES
	MOVE	T1,[.NDTCN,,T2]		;SET UP UUO AC
	MOVEI	T2,2			;TWO WORDS
	NODE.	T1,			;TRY TO CONNECT THE LINE
	  SKIPA				;FAILED
	JRST	LINE.4			;LINE CONNECTED
	CAMN	T1,T2			;AC UNCHANGED (NO NETWORK SUPPORT)?
	$RETF				;NO SUCH LINE

LINE.3:	SKIPA	T1,T4			;USE ORIGINAL TTY NAME

LINE.4:	MOVE	T4,T1			;PRESERVE TTY NAME WE HAVE NOW
	DEVCHR	T1,UU.PHY		;GET INTERESTING BITS
	TXNN	T1,DV.TTY		;REALLY A TTY?
	$RETF				;NOPE
	MOVEM	T4,J$LDEV(J)		;SAVE AS DEVICE NAME
	IONDX.	T4,UU.PHY		;TRANSLATE TO I/O INDEX
	  $RETF				;CAN'T
	MOVEM	T4,J$LION(J)		;SAVE
	MOVE	T2,[2,,T3]		;SET UP UUO AC
	MOVX	T3,.TOAPC		;FUNCTION
	TRMOP.	T2,			;GET ASYNCH. PORT CHAR.
	  MOVX	T2,.TOUNK		;ERROR: CAN'T TELL
	CAIN	T2,.TOLAT		;LAT APPLICATION TERMINAL?
	JRST	LINE.5			;YES, RUN INITIA
	MOVE	T1,STREAM		;GET STREAM NUMBER
	MOVE	T1,JOBOBA(T1)		;AND THE OBJECT BLOCK
	MOVE	T1,OBJ.ND(T1)		;GET STATION NUMBER
	CAMN	T1,CNTSTA		;CENTRAL?
	$RETT				;YES--NO NEED TO RUN INITIA
LINE.5:	MOVE	T2,[2,,T3]		;SET UP UUO AC
	MOVE	T3,['INITIA']		;FORCED COMMAND NAME
	FRCUUO	T2,			;RUN INITIA SO TTY PARAMETERS GET SET
	  JFCL				;HOPE FOR THE BEST
	MOVEI	T1,^D30			;WAIT UP TO 30 SECONDS

LINE.6:	MOVEI	T2,1			;GET SLEEP TIME
	SLEEP	T2,			;WAIT FOR INITIA TO FINISH RUNNING
	MOVE	T2,J$LDEV(J)		;GET DEVICE NAME
	DEVCHR	T2,UU.PHY		;AND ITS CHARACTERISTICS
	TXNN	T2,DV.ASP		;ASSIGNED TO SOME OTHER JOB?
	TXNN	T2,DV.AVL		;NO--AVAILABLE TO OUR JOB?
	SOJG	T1,LINE.6		;MUST TRY AGAIN
	JUMPLE	T1,.RETF		;IF TIMED OUT, THEN SAY NOT AVAILABLE
	$RETT				;ELSE RETURN
SUBTTL	COMMON DEVICE CONTROL -- LPTOPN - OPEN DEVICE


; SET UP FOR I/O
; THIS ROUTINE WILL INIT A CHANNEL AND BUILD BUFFERS

LPTOPN::MOVE	S1,J$LDEV(J)		;GET DEVICE NAME
	DEVCHR	S1,			;GET CHARACTERISTICS
	MOVEM	S1,J$DCHR(J)		;SAVE FOR LATER
	TXNN	S1,DV.ASP		;ASSIGNED TO SOME OTHER JOB?
	TXNN	S1,DV.AVL		;NO--AVAILABLE TO OUR JOB?
	$RETF				;NOT RIGHT NOW, RESTORE OPEN BITS
	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
	TXO	T1,UU.AIO		;ASYNCH I/O
	MOVE	T2,J$LDEV(J)		;OUTPUT DEVICE NAME
	MOVSI	T3,J$LBRH(J)		;BUFFER HEADER
	XCT	S1			;AND EXECUTE IT
	  $RETF				;FAILED

OPEN.1:	SETZM	J$LIOS(J)		;[4071] CLEAR STATUS WORDS
	SETZM	J$XIOS(J)		;[4071]
	SKIPGE	J$LREM(J)		;IS THIS A REMOTE PRINTER
	SKIPGE	J$LLAT(J)		; AND NOT A LAT PRINTER?
	TRNA				;NO, IT IS A LOCAL DEVICE
	JRST	OPEN.4			;YES, SETUP BUFFERS FOR REMOTE
	MOVE	T1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE
	SUBI	T1,BUFSIZ		;BACK UP ONE BUFFER
	SETZ	T2,			;CLEAR A COUNTER

OPEN.2:	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,OPEN.2		;NO, LOOP AROUND

OPEN.3:	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
	$RETT				;RETURN

OPEN.4:	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 1]		;MAKE AN INSTRUCTION
	XCT	S2			;AND EXECUTE IT
	MOVEM	S1,.JBFF		;RESTORE JOBFF
	$RETT				;RETURN
SUBTTL	COMMON DEVICE CONTROL -- LPTCLS - CLOSE DEVICE


LPTCLS::TXZE	S,INTRPT		;ARE WE CONNECTED TO INTRPT SYSTEM?
	PUSHJ	P,INTDCL		;YES, RELEASE THE INTERRUPTS
	SKIPN	J$LLAT(J)		;IS THIS A LAT LINE?
	JRST	CLOS.0			;NO, FINISH UP
	PUSHJ	P,CLOS.0		;RELEASE THE DEVICE
	PJRST	LATCLS			;DISCONNECT THE LAT LINE


CLOS.0:	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL
	SKIPE	J$LREM(J)		;NO, ARE WE USING A REMOTE PRINTER?
	JRST	CLOS.1			;YES TO EITHER, ISSUE A CLOSE/RELEASE
	RESDV.	S1,			;RESET THE CHANNEL
	  JFCL				;IGNORE ANY ERRORS
	$RETT				;AND RETURN

CLOS.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


; COME HERE TO DISCONNECT THE LAT LINE

LATCLS:	SKIPN	T2,J$LION(J)		;IS THERE A UDX?
	$RETT				;NO, FINISHED
	MOVEI	T1,.TOSOP		;FUNCTION
	MOVEI	S2,^D30			;MAXIMUM TIME TO WAIT
LATCL1:	MOVE	S1,[2,,T1]		;LENGTH,,ADDRESS
	TRMOP.	S1,			;SKIP IF OUTPUT IS IN PROGRESS
	  JRST	LATCL2			;NO IN PROGRESS: HANG UP
	MOVEI	S1,1			;
	SLEEP	S1,			;ZZZZZZ
	SOJG	S2,LATCL1		;REPEAT
LATCL2:	MOVEI	T1,.TODSF		;FUNCTION
	MOVE	S1,[2,,T1]		;LENGTH,,ADDRESS
	TRMOP.	S1,			;DISCONNECT DATASET FUNCTION
	  JFCL				;
	MOVEI	T1,.TODNT		;DISCONNECT NETWORK TERMINAL
	MOVE	S1,[2,,T1]		;LENGTH,,ADDRESS
	TRMOP.	S1,			;DISCONNECT DATASET FUNCTION
	  JFCL				;
	$RETT				;
SUBTTL	COMMON DEVICE CONTROL -- LPTHDW - SETUP HARDWARE CHARACTERISTICS


LPTHDW::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
	  SETZ	T1,			;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 CONTROLLER TYPE
	MOVEM	S1,J$LCLS(J)		;SAVE IT FOR LATER
	CAIN	S1,.DFS20		;LP20 CLASS DEVICE?
	 SETOM	J$LDRM(J)		;YES, ASSUME LOADABLE RAM
	SKIPE	J$LREM(J)		;OR IF THIS IS A REMOTE LPT
	 SETZM	J$LDRM(J)		;IT ISN'T LOADABLE AFTER ALL

	SETZM	J$LDVF(J)		;DON'T LOAD VFU (FOR NOW)
	LDB	T1,[POINTR(T1,DF.VFT)]	;GET VFU TYPE
	CAIN	T1,.DFVTD		;IS IT A DAVFU?
	SETOM	J$LDVF(J)		;YES, SET THE FLAG
	$RETT				;RETURN
SUBTTL	COMMON DEVICE CONTROL -- LPTVFU - LOAD/CHECK VFU

VFUCHK:	SKIPN	J$LDVF(J)		;[3012] IS THERE A VFU TO LOAD?
	$RETT				;[3012] NOTHING TO DO
	MOVEI	S1,0			;CHECK STATUS FUNCTION
	JRST	@J$VFU(J)		;TRY IT
SUBTTL	HARDWARE VFU LOADED INSTEAD OF REQUESTED VFU

HDWVFU:	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

VFUFAI:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTOR	(,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1))
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SETOM	JOBUPD(S1)		;  update status also
	$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	VFU.1			;TRY LOADING AGAIN.

VFUI1:	ITEXT	(<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2:	ASCIZ	/Respond with VFU type to continue/
SUBTTL	COMMON DEVICE CONTROL -- LPTFLS - FLUSH A JOB


LPTFLS::SKIPE	J$LREM(J)		;SKIP IF LOCAL
	$RETT				;DO NOTHING SINCE ONLY 1 BUFFER
	PUSHJ	P,INTDCL		;DISCONNECT PRINTER INTERRUPTS
	MOVE	S1,J$LCHN(J)		;LOAD THE CHANNEL NUMBER
	RESDV.	S1,			;RESET THE CHANNEL
	  JFCL				;??
	PUSHJ	P,@J$OPEN(J)		;RE-INIT THE DEVICE
	CAIN	S1,%RSUOK		;ARE WE ALL RIGHT ???
	$RETT				;YES, JUST RETURN
	PUSHJ	P,RSETUP		;NO, SEND RESPONSE TO SETUP MSG
	$RETF				;AND RETURN
SUBTTL	COMMON DEVICE CONTROL - LPTOUT - OUTPUT A BUFFER


; 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.

LPTOUT::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$LIOS(J)		;GET I/O STATUS BITS
	MOVE	S2,J$XIOS(J)		;[4071] AND POSSIBLE EXTENDED STATUS
	TXNE	S1,IO.ERR		;[4071] ANY ERROR BITS?
	JRST	OUT.3			;[4071] YES--MUST BE PSEUDO DEVICE NONSENSE
	ANDCAM	S1,J$LIOS(J)		;CLEAR I/O STATUS
	SETZM	J$XIOS(J)		;HERE TOO
	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
		 MOVX	S2,PSF%OB	;GET THE 'OUTPUT-BLOCKED' BIT
		 ANDCAM S2,JOBSTW(S1)	;   AND CLEAR THE OUTPUT BLOCKED BITS
		 $RETT	]		;      NOW WE CAN RETURN
OUT.1:	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 I/O STATUS BITS
	TRC	S1,IO.ERR		;MUST SEE IF
	TRCE	S1,IO.ERR		;[4071] EXTENDED STATUS NEEDED TOO
	JRST	OUT.2			;NO
	MOVE	TF,[2,,S1]		;PREPARE FOR DEVOP. UUO
	MOVEI	S1,.DFRES		;READ EXTENDED ERROR STATUS
	MOVE	S2,J$LCHN(J)		;GET CHANNEL NUMBER
	DEVOP.	TF,
	  SETZ	TF,			;???
	MOVEM	TF,J$XIOS(J)		;SAVE FOR POSTERITY
	MOVE	S1,J$LIOS(J)		;[4071] GET I/O STATUS
	SKIPA	S2,J$XIOS(J)		;[4071] GET EXTENDED STATUS
OUT.2:	SETZB	S2,J$XIOS(J)		;[4071] NO EXTENDED STATUS
OUT.3:	PUSHJ	P,@J$OUTE(J)		;[4071] DO DEVICE SPECIFIC ERROR PROCESSING
	JUMPF	LPTOEX			;JUMP IF UNRECOVERABLE ERROR
	$DSCHD(0)			;BLOCK FOR OUTPUT DONE (See Above)
	PJRST	@J$OUTP(J)		;AND TRY AGAIN
SUBTTL	COMMON DEVICE CONTROL -- LPTOER - OUTPUT ERROR PROCESSING


LPTOER::MOVE	S1,J$LIOS(J)		;GET I/O STATUS
	TRNE	S1,IO.ERR		;ANY ERROR BITS ON?
	JRST	OUTE.1			;YES--MUST INVESTIGATE
	$RETT				;Return good, (Output blocked)

OUTE.1:	PUSHJ	P,.SAVET		;SAVE ALL THE 'T' ACS
	MOVE	T4,STREAM		;GET THE STREAM NUMBER
	MOVX	S1,PSF%OB		;GET OUTPUT BLOCKED BIT
	ANDCAM	S1,JOBSTW(T4)		;CLEAR STATE
	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.2			;AND THEY ARE NOT
	MOVE	T1,J$XIOS(J)		;GET EXTENDED STATUS
	CAIN	T1,IOVFE%		;IS THE ERROR BAD VFU ?
	JRST	VFUOER			;YES, DO SOME SPECIAL PROCESSING
	CAIN	T1,IOPAR%		;RAM PARITY ERROR?
	JRST	RAMOER			;YES
	CAIN	T1,IOUNC%		;UNDEFINED CHARACTER INTERRUPT?
	JRST	UNCOER			;YES

OUTE.2:	HRRZ	S1,J$LIOS(J)		;GET I/O STATUS
	MOVEI	S2,[ITEXT (<>)]		;ASSUME NO EXTENDED STATUS
	SKIPE	J$XIOS(J)		;IS THERE ONE?
	MOVEI	S2,[ITEXT (<Extended error status ^O/J$XIOS(J)/>)]
	$WTO  (<I/O error ^O6R0/S1/>,<^I/(S2)/>,@JOBOBA(T4))
	PJRST	LPTOEX			;GO FINISH UP
; OUTPUT ERROR -- UNDEFINED CHARACTER TRANSLATION
UNCOER:	$WTO	(<Undefined character interrupt>,<Requeueing job>,@JOBOBA(T4))
	SETZM	J$LERR(J)		;NO MORE ERRORS ALLOWED
	TXO	S,ABORT+RQB		;DONE WITH THIS JOB
	MOVE	S1,J$FRAM(J)		;GET RAM NAME
	CAME	S1,['LP64  ']		;NORMAL?
	CAMN	S1,['LP96  ']		;...
	PJRST	LPTDIE			;GO CROAK STREAM
	$RETT				;RETURN

; OUTPUT ERROR -- RAM PARITY
RAMOER:	$WTO	(RAM Parity Error,,@JOBOBA(T4)) ;YES, TELL OPERATOR
	PUSHJ	P,LPTOEX		;PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLRM(J)		;FORCE A RAM RELOAD
	PUSHJ	P,LODRAM		;DO A RELOAD
	SETZM	J$FLVT(J)		;[3012] LOAD THE VFU TOO, TO BE SAFE
	PUSHJ	P,LODVFU		;LOAD VFU
	$RETT				;AND RETURN


; OUTPUT ERROR -- VFU
VFUOER:	TXZN	S,VFULOD		;ARE WE ALREADY LOADING VFU?
	JRST	VFUOE1			;NO...
	$WTO	(VFU error while loading VFU,,@JOBOBA(T4)) ;YES
	MOVEI	S1,2			;ERROR, DISABLE LOAD
	PUSHJ	P,@J$VFU(J)		;DEVICE DEPENDENTLY
	PUSHJ	P,@J$FLSH(J)		;GO RESET THE DEVICE
	SETZM	J$FORM(J)		;SAY FORMS NOT LOADED
	MOVX	S1,%RSUNA		;GET "DEVICE NOT AVAILABLE"
	PUSHJ	P,RSETUP		;TELL QUASAR TO FORGET US FOR NOW
	PJRST	SHUTIN			;SHUTDOWN THE STREAM

VFUOE1:	$WTOR  (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
	SETZM	JOBCHK(T4)		;SAY WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD(T4)		;  update the status also
	$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	VFUOER			;NO, STUPID OPERATOR SO TRY AGAIN
	PUSHJ	P,LPTOEX		;GO PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLRM(J)		;LOAD THE RAM FIRST, ESPECIALLY
	PUSHJ	P,LODRAM		;RELOAD THE RAM
	SETZM	J$FLVT(J)		;FORCE A VFU RELOAD
	PUSHJ	P,LODVFU		;LOAD THE VFU
	$RETT				;AND RETURN

CONANS:	$STAB
	 KEYTAB	(0,PROCEED)
	$ETAB
SUBTTL	COMMON DEVICE CONTROL -- LPTOEX - OUTPUT ERROR EXIT


LPTOEX:	PUSHJ	P,LPTDIE		;SEE IF TOO MANY ERRORS
	PUSHJ	P,@J$FLSH(J)		;RESET THE OUTPUT CHANNEL
	JUMPT	OEX.1			;GO FINISH UP
	MOVX	S1,%RSUNA		;GET 'DEVICE NOT AVAILABLE' ERROR
	PUSHJ	P,RSETUP		;TELL QUASAR TO RESET THE OBJECT
	PJRST	SHUTIN			;SHUT DOWN THE DEVICE

OEX.1:	TXNN	S,VFULOD+BANHDR		;IF LOADING VFU OR PRINTING HDRS
	SKIPN	J$DIFN(J)		;   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/I/O Error occurred during ^F/@J$DFDA(J)/^T/J$GSPL(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
SUBTTL	COMMON DEVICE CONTROL -- LPTRES - RESET OUTPUT BUFFERS


LPTRES::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
SUBTTL	COMMON DEVICE CONTROL - LPTDIE - STOP ON TOO MANY I/O ERRORS


LPTDIE::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	COMMON DEVICE CONTROL -- LPTANF - CHECK ANF-10 STATION


; ROUTINE TO CHECK ANF-10 STATION
; CALL:	MOVE	S1, STATION NUMBER/NAME
;	PUSHJ	P,LPTANF

LPTANF::MOVE	T1,[.NDRNN,,T2]		;SET UP UUO AC
	MOVEI	T2,2			;TWO WORDS FOLLOWING
	MOVE	T3,S1			;ARGUMENT
	NODE.	T1,			;CHECK FOR ANF-10
	  CAMN	T1,[.NDRNN,,T2]		;MAYBE NO NETWORK SUPPORT?
	$RETT				;RETURN
	$RETF				;NOT ANF-10
SUBTTL	COMMON DEVICE CONTROL -- LPTDCN - CHECK DECNET NODE


; ROUTINE TO CHECK DECNET NODE
; CALL:	MOVE	S1, NODE NAME
;	MOVE	S2, KNOWN/REACHABLE/EXECUTOR FLAGS
;	PUSHJ	P,LPTDCN

LPTDCN::TDNN	S1,[-1,,777600]		;NODE NAME?
	$RETF				;NO
	MOVEI	T1,T2			;SET UP UUO AC
	MOVE	T2,[.DNNDI,,2]		;FUNCTION,,LENGTH
	IOR	T2,S2			;INCLUDE INTERESTING FLAGS
	MOVE	T3,S1			;ARGUMENT
	DNET.	T1,			;CHECK STATUS
	  $RETF				;NO SUCH NODE OF NODE DOWN
	$RETT				;RETURN
	$RETF				;NOT DECNET
SUBTTL	COMMON DEVICE CONTROL -- LPTRUL - PRINT A RULER


LPTRUL::$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	MOVSI	P1,-3			;GET COUNTER

RULER1:	MOVE	P2,STARS(P1)		;GET ADDRESS OF TEXT STRING
	MOVE	P3,J$FWID(J)		;GET THE WIDTH
	CAILE	P3,^D132		;IS IT REASONABLE?
	MOVEI	P3,^D132		;NOW IT IS

RULER2:	ILDB	C,P2			;GET A CHARACTER
	PUSHJ	P,DEVOUT		;PUT A CHARACTER
	SOJG	P3,RULER2		;LOOP
	PUSHJ	P,CR23			;SEND LF OR DC3
	AOBJN	P1,RULER1		;LOOP FOR ALL RULER LINES
	POPJ	P,			;AND RETURN
SUBTTL	COMMON DEVICE CONTROL -- LPTLOG - PRINT LPTSPL RUN LOG


LPTLOG::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

RLOG.1:	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
	SOSLE	T3			;DECREMENT COUNT
	AOJA	T2,RLOG.1		;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,5			;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	COMMON DEVICE CONTROL -- LPTTXT - GENERATE "OUTPUT TO ..." TEXT


LPTTXT::SETZM	J$LOUT(J)		;INIT NODE/DEVICE/UNIT TEXT
	MOVE	S1,STREAM		;GET STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;PICK UP OBJECT BLOCK ADDRESS.
	MOVE	S1,OBJ.ND(S1)		;GET NODE NAME/NUMBER
	MOVEI	T1,[ITEXT (<node ^N/S1/ >)]
	SKIPN	S1			;HAVE A NODE?
	MOVEI	T1,[ITEXT (<>)]		;NO
	MOVEI	T2,[ITEXT (<device ^W/T4/ >)]
	SKIPL	T4,J$LCHN(J)		;GET CHANNEL IN USE
	DEVNAM	T4,			;CONVERT TO PHYSICAL DEVICE NAME
	  MOVE	T4,J$LDEV(J)		;USE WHAT'S THERE
	SKIPN	T4			;HAVE A DEVICE NAME?
	MOVEI	T2,[ITEXT (<>)]		;NO
	MOVEI	T3,[ITEXT (<unit type ^W/J$LTYP(J)/ >)]
	SKIPN	J$LTYP(J)		;HAVE A UNIT TYPE?
	MOVEI	T3,[ITEXT (<>)]		;NO
	MOVE	S2,S1			;GET NODE NAME/NUMBER
	IOR	S2,T4			; PLUS DEVICE
	IOR	S2,J$LTYP(J)		;  PLUS UNIT TYPE
	JUMPE	S2,.RETT		;CHECK FOR NOTHING
	$TEXT	(<-1,,J$LOUT(J)>,<Output to ^I/(T1)/^I/(T2)/^I/(T3)/^0>)
	$RETT				;RETURN
SUBTTL	INIT FILE ROUTINES -- FH$ANY/FH$CHR/FH$CVT - READ A CHARACTER


; READ A CHARACTER FROM THE INITIALIZATION FILE
; CALL:	PUSHJ	P,FH$ANY/FH$CHR/FH$CVT
;
; TRUE RETURN:	C CONTAINS CHARACTER.  LOWER CASE AND TAB CONVERSIONS
;		ARE PERFORMED IF CALLED AT THE FH$CVT ENTRY POINT.
; FALSE RETURN:	EOF, IFN RELEASED.

FH$ANY::MOVNI	S1,1			;ACCEPT ANY CHARACTER
	JRST	CHR.1			;ENTER COMMON CODE
FH$CHR::TDZA	S1,S1			;NO CONVERSION
FH$CVT::MOVEI	S1,1			;CONVERT

CHR.1:	PUSH	P,S1			;SAVE FLAG
	SKIPGE	C,INISAV		;GET SAVED CHARACTER (IF ANY)
	JRST	CHR.2			;THERE ISN'T ONE
	SETOM	INISAV			;SAVED CHARACTER INVALID NOW
	JRST	CHR.3			;ENTER COMMON CODE

CHR.2:	MOVE	S1,INIIFN		;IFN
	PUSHJ	P,F%IBYT		;READ A CHARACTER
	JUMPF	CHR.5			;CHECK FOR ERRORS

CHR.3:	SKIPGE	(P)			;ACCEPT ANY CHARACTER?
	JRST	CHR.4			;YES
	MOVEI	C,(S2)			;COPY CHARACTER
	CAIN	C,.CHCRT		;CARRIAGE RETURN?
	JRST	CHR.2			;IGNORE IT
	CAIE	C,.CHFFD		;CONVERT FORM FEEDS
	CAIN	C,.CHVTB		;AND VERTICAL TABS
	MOVEI	C,.CHLFD		;INTO LINEFEED

CHR.4:	SKIPE	INILIN			;COUNTING LINES?
	CAIE	C,.CHLFD		;AND AT EOL?
	SKIPA				;NO TO EITHER
	AOS	INILIN			;COUNT THE LINE
	POP	P,S1			;GET CONVERION FLAG BACK
	JUMPLE	S1,.RETT		;RETURN IF NO CONVERSION WANTED
	CAIN	C,.CHTAB		;TAB?
	MOVEI	C," "			;MAKE IT A SPACE
	CAIL	C,"a"			;LOWER
	CAILE	C,"z"			; CASE?
	SKIPA				;NO
	SUBI	C," "			;MAKE UPPER CASE
	$RETT				;RETURN

CHR.5:	MOVEM	S1,(P)			;SAVE ERROR CODE
	CAIN	S1,EREOF$		;EOF?
	JRST	CHR.6			;YES
	MOVEI	S1,CHRION		;ASSUME NON-LINE ORIENTED FILE
	SKIPLE	INILIN			;LINE NUMBERED?
	MOVEI	S1,CHRIOL		;YES
	MOVEI	S2,CHRRTX		;RUN LOG/REASON TEXT
	PJRST	FH$ERR			;REPORT ERROR AND RETURN TO CALLER

CHR.6:	PUSHJ	P,FH$XIT		;TERMINATE I/O
	POP	P,S1			;GET ERROR CODE BACK
	$RETF				;RETURN EOF

CHRION:	ITEXT	(<I/O error reading ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)

CHRIOL:	ITEXT	(<I/O error reading line ^D/INILIN/
File:  ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)

CHRRTX:	ITEXT	(<I/O error reading ^F/@INIFOB+FOB.FD/>)
SUBTTL	INIT FILE ROUTINES -- FH$BKP - BACKUP ONE CHARACTER


; BACKUP (REEAT) ONE CHARACTER
; CALL:	MOVE	C, CHARACTER
;	PUSHJ	P,FH$BKP
;
; TRUE RETURN:	ALWAYS
; FALSE RETURN:	NEVER

FH$BKP::MOVEM	C,INISAV		;SAVE THE CHARACTER
	$RETT				;RETURN
SUBTTL	INIT FILE ROUTINES -- FH$COM - COMMENT PROCESSING


; CHECK FOR A COMMENT AND FLUSH REMAINDER OF LINE IF NECESSARY
; CALL:	PUSHJ	P,FH$COM
;
; TRUE RETURN:	COMMENT FLUSHED (IF ANY)
; FALSE RETURN:	EOF

FH$COM::CAIE	C,.CHTAB		;TAB?
	CAIN	C," "			;SPACE?
	PUSHJ	P,FH$SKP		;SKIP THEM
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIE	C,";"			;COMMENT?
	CAIN	C,"!"			;NEW-STYLE?
	PJRST	FH$EOL			;YES--FLUSH REMAINDER OF LINE
	$RETT				;ELSE JUST RETURN
SUBTTL	INIT FILE ROUTINES -- FH$CON - LINE CONTINUATION PROCESSING


; HANDLE LINE CONTINUATION
; CALL:	PUSHJ	P,FH$CON
;
; TRUE RETURN:	NOT LINE CONTINUATION OR POSITIONED FOR I/O
;		AT THE START OF THE NEXT LINE FOR INPUT
; FALSE RETURN:	EOF

FH$CON::CAIE	C,"-"			;SITTING ON A DASH?
	$RETT				;NO--CAN'T BE LINE CONTINUATION
	MOVE	S1,INIIFN		;IFN
	PUSHJ	P,F%CHKP		;CHECKPOINT POSITION
	JUMPF	CON.2			;CHECK FOR ERRORS
	PUSH	P,S1			;REMEMBER POSITION FOR LATER
	PUSH	P,INILIN		;SAVE LINE NUMBER
	PUSHJ	P,CONSKP		;SKIP TABS AND SPACES
	JUMPF	CON.1			;CAN'T BE CONTINUATION IF EOF
	CAIE	C,";"			;COMMENT?
	CAIN	C,"!"			;NEW-STYLE?
	PUSHJ	P,CONEOL		;FLUSH REMAINDER OF LINE
	$RETIF				;CHECK FOR ERRORS
	CAIE	C,.CHLFD		;EOL?
	JRST	CON.1			;NOT LINE CONTINUATION
	ADJSP	P,-2			;PHASE STACK
	PUSHJ	P,CONSKP		;SKIP SPACES AT START OF NEXT LINE
	$RETIF				;CHECK FOR ERRORS
	JRST	FH$CON			;SEE IF MULTIPLE CONTINATION LINES

CON.1:	MOVE	S1,INIIFN		;IFN
	POP	P,INILIN		;RESTORE ORIGINAL LINE NUMBER
	POP	P,S2			;GET ORIGINAL POSITION BACK
	PUSHJ	P,F%POS			;REPOSITION FOR I/O
	JUMPF	CON.3			;CHECK FOR ERRORS
	MOVEI	C,"-"			;GET BACK ORIGINAL CHARACTER
	$RETT				;AND RETURN

CON.2:	SKIPA	S2,[CONCPE]		;CHECKPOINT ERROR
CON.3:	MOVEI	S2,CONPSE		;POSITIONING ERROR
	PUSH	P,S1			;SAVE ERROR CODE
	MOVE	S1,S2			;GET MESSAGE TEXT ADDRESS
	MOVEI	S2,CONRTX		;RUN LOG/REASON TEXT
	PJRST	FH$ERR			;REPORT ERROR AND RETURN TO CALLER
CONEOL:	PUSHJ	P,FH$CHR		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	CAIE	C,.CHLFD		;EOL?
	JRST	FH$EOL			;TRY AGAIN
	$RETT				;RETURN


CONSKP:	PUSHJ	P,FH$CVT		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	CAIN	C," "			;SPACE?
	JRST	FH$SKP			;KEEP SEARCHING
	$RETT				;RETURN


CONCPE:	ITEXT	(<Checkpoint failed
File:  ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)

CONPSE:	ITEXT	(<Positioning failed
File:  ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)

CONRTX:	ITEXT	(<Checkpoint/positioning error on ^F/@INIFOB+FOB.FD/>)
SUBTTL	INIT FILE ROUTINES -- FH$EOL - READ UNTIL EOL


; READ UNTIL END OF LINE ENCOUNTERED
; CALL:	PUSHJ	P,FH$EOL
;
; TRUE RETURN:	EOL FOUND
; FALSE RETURN:	EOF

FH$EOL::PUSHJ	P,FH$CHR		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	CAIN	C,"-"			;POSSIBLE LINE CONTINUATION?
	PUSHJ	P,FH$CON		;YES
	$RETIF				;CHECK FOR ERRORS
	CAIE	C,.CHLFD		;EOL?
	JRST	FH$EOL			;TRY AGAIN
	$RETT				;RETURN
SUBTTL	INIT FILE ROUTINES -- FH$ERR - ERROR REPORTING


; REPORT INIT FILE ERROR AND DO ALL APPROPRIATE ERROR LOGGING
; CALL:	PUSH	P,  ERROR CODE TO RETURN TO CALLER (FH$ERR ONLY)
;	MOVE	S1, ADDRESS OF ITEXT BLOCK FOR WTO MESSAGE
;	MOVE	S2, ADDRESS OF ITEXT BLOCK FOR RUN LOG AND REASON TEXT
;	PUSHJ	P,FH$ERR/FH$RPT
;
; TRUE RETURN:	NEVER
; FALSE RETURN:	ONLY IF CALLED AT FH$RPT ENTRY POINT.  S1 WILL CONTAIN
;		THE ERROR CODE PASSED AND THE STACK WILL BE PHASED
;		CORRECTLY FOR FUTURE POPJS.

FH$ERR::TDZA	TF,TF			;REPORT ERROR AND UNWIND
FH$RPT::MOVNI	TF,1			;REPORT ERROR ONLY
	MOVEM	S1,INITMP		;SAVE S1
	MOVE	S1,STREAM		;GET STREAM NUMBER
	ADDI	S1,JOBOBA		;OFFSET TO OBJECT BLOCK
	EXCH	S1,INITMP		;SAVE ADDRESS AND RESTORE S1
	HLLM	TF,INITMP		;SAVE FLAG
	$WTO	(<Initialization file error>,<^I/(S1)/>,@INITMP)
	$TEXT	(LOGCHR,<^I/LPERR/^I/(S2)/>) ;MAKE RUN LOG ENTRY
	$TEXT	(<-1,,J$WTOR(J)>,<^I/(S2)/^0>) ;SET REASON TEXT FOR NOTIFY
	PUSHJ	P,FH$XIT		;TERMINATE I/O
	SKIPGE	INITMP			;CALLER WANT CONTROL?
	$RETF				;YES--RETURN
	POP	P,S1			;GET ERROR CODE BACK
	MOVE	P,INIPDP		;GET SAVED PDL POINTER
	PUSH	P,INIEPC		;SET RETURN PC
	$RETF				;RETURN TO CALLER
SUBTTL	INIT FILE ROUTINES -- FH$INI - INITIALIZE I/O


; INITIALIZE I/O
; CALL:	MOVE	S1, FD ADDRESS
;	MOVE	S2, ADDRESS OF DATE/TIME WORD FOR COMPARRISON
;	PUSHJ	P,FH$INI
;
; TRUE RETURN:	S1 CONTAINS A POSITIVE GALAXY IFN IF THE FILE NEEDS
;		TO BE RE-READ.  REGARDLESS OF THE CONTENTS OF S1, S2
;		WILL CONTAIN THE ADDRESS OF AN UPDATED FD BLOCK FOR THE
;		FILE JUST OPENED.  ALSO, A COPY OF THE PDL POINTER
;		IS SAVED FOR FATAL I/O ERROR RECOVERY.  WHEN AN I/O
;		ERROR IS DETECTED, ALL THE APPROPRIATE ERROR LOGGING
;		WILL HAPPEN, THE IFN WILL BE RELEASED, AND CONTROL
;		RETURNED TO THE FH$INI CALL +1.  THIS SHOULD BE SOME
;		SORT OF GALAXY ERROR CHECKING INSTRUCTION (JUMPF, SKIPF,
;		ETC.).  AT THIS TIME, S1 WILL CONTAIN THE SPECIFIC GALAXY
;		ERROR CODE.
; FALSE RETURN:	ERROR REPORTED TO OPERATOR, IFN RELEASED.

FH$INI::MOVE	TF,P			;COPY PDL POINTER
	POP	TF,INIEPC		;SAVE RETURN PC FOR ERROR RECOVERY
	MOVEM	TF,INIPDP		;SAVE PDL POINTER FOR SAME
	PUSH	P,S2			;SAVE DATE/TIME WORD ADDRESS
	PUSH	P,S1			;SAVE FD ADDRESS
	MOVE	S1,[PFOB,,INIFOB]	;SET UP BLT	
	BLT	S1,INIFOB+FOB.SZ-1	;COPY PROTOTYPE BLOCK
	POP	P,S1			;GET FD ADDRESS BACK
	HRLZS	S1			;PUT IN LH
	HRRI	S1,INIFD		;MAKE A BLT POINTER
	BLT	S1,INIFD+FDXSIZ-1	;COPY PROTOTYPE FILE DESCRIPTOR
	SETOM	INIIFN			;INDICATE FILE NOT OPENED YET
	SETOM	INISAV			;SAVED CHARACTER IS INVALID
	SETZM	INILIN			;THEREFORE NO LINE NUMBER EITHER
	MOVEI	S1,FOB.SZ		;FOB LENGTH
	MOVEI	S2,INIFOB		;FOB ADDRESS
	PUSHJ	P,F%IOPN		;OPEN FILE FOR INPUT
	JUMPF	INI.2			;CHECK FOR ERRORS
	MOVEM	S1,INIIFN		;SAVE IFN
	MOVNI	S2,1			;-1 FOR ACTUAL FILESPEC
	PUSHJ	P,F%FD			;GET FILESPEC
	JUMPF	INI.2			;CHECK FOR ERRORS
	LOAD	S2,.FDLEN(S1),FD.LEN	;GET RETURNED FD LENGTH
	HRLZS	S1			;POINT FD IN LH
	HRRI	S1,INIFD		;AND TO OUR STORAGE
	ADDI	S2,INIFD		;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY RETURNED FD
	MOVE	S1,INIIFN		;IFN FOR INPUT
	MOVEI	S2,FI.CRE		;FUNCTION CODE
	PUSHJ	P,F%INFO		;READ FILE CREATION DATE/TIME
	JUMPF	INI.2			;CHECK FOR ERRORS
	MOVE	S2,S1			;GET CREATION DATE/TIME
	EXCH	S2,(P)			;SWAP WITH STORAGE ADDRESS
	XOR	S1,(S2)			;COMPARE NEW DATE/TIME WITH OLD
	CAIN	S2,0			;WAS AN ADDRESS REALLY SUPPLIED?
	MOVEI	S2,S1			;INSURE S1 IS NON-ZERO TO FORCE RE-READ
	POP	P,(S2)			;UPDATE DATE/TIME FOR CALLER
	JUMPN	S1,INI.1		;JUMP IF FILE HAS CHANGED
	PUSHJ	P,FH$XIT		;TERMINATE I/O
	SETZ	S1,			;INDICATE FILE HAS NOT CHANGED
	MOVEI	S1,INIFD		;POINT TO FILESPEC
	$RETT				;RETURN

INI.1:	AOS	INILIN			;LINE
	MOVE	S1,INIIFN		;CALLER MIGHT WANT THE IFN
	MOVEI	S2,INIFD		;AND MAYBE THE REAL FILESPEC TOO
	$RETT				;RETURN

INI.2:	SKIPA	S2,[INI.4]		;OPEN ERROR
INI.3:	MOVEI	S2,INI.5		;CAN'T READ PARAMETERS
	MOVEM	S1,(P)			;SAVE ERROR CODE
	MOVE	S1,S2			;GET MESSAGE TEXT ADDRESS
	MOVEI	S2,INI.6		;RUN LOG/REASON TEXT
	PJRST	FH$ERR			;REPORT ERROR AND RETURN TO CALLER

INI.4:	ITEXT	(<Open failed for ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)

INI.5:	ITEXT	(<Cannot read file parameters
File:  ^F/@INIFOB+FOB.FD/
Error: ^E/[-1]/>)

INI.6:	ITEXT	(<Initialization failed for ^F/@INIFOB+FOB.FD/>)


; PROTOTYPE FILE OPEN BLOCK
PFOB:	$BUILD	(FOB.SZ)		;BLOCK LENGTH
	  $SET	(FOB.FD,FWMASK,INIFD)	  ;FD POINTER
	  $SET	(FOB.CW,FB.PHY,1)	  ;PHYSICAL OPEN
	  $SET	(FOB.CW,FB.LSN,1)	  ;STRIP OFF LINE SEQUENCE NUMBERS
	  $SET	(FOB.CW,FB.BSZ,7)	  ;7-BIT BYTES
	$EOB				;END OF BLOCK
SUBTTL	INIT FILE ROUTINES -- FH$KEY - READ A POSSIBLY QUOTED STRING


; READ A KEYWORD INTO THE ATOM BUFFER AND COMPARE AGAINST A TABLE OF KEYWORDS
; CALL:	MOVE	S1, KEYWORD TABLE ADDRESS OR ZERO
;	PUSHJ	P,FH$KEY
;
; TRUE RETURN:	S1 CONTAINS ADDRESS OF KEYWORD, S2 CONTAINS DATA FROM
;		KEYWORD TABLE, AND C CONTAINS TERMINATING CHARACTER
; FALSE RETURN:	S1 CONTAINS -1 IF NO INPUT OR ILLEGAL KEYWORD, OR EOF
;		S2 IS INDETERMINATE
;
; *** NOTE *** KEYWORD TEXT MAY NOT BEGIN OR END WITH A DASH

FH$KEY::PUSHJ	P,.SAVE3		;SAVE SOME ACS
	MOVE	P3,S1			;SAVE KEYWORD TABLE ADDRESS
	MOVE	S1,[INIATM,,INIATM+1]	;SET UP BLT
	SETZM	INIATM			;CLEAR FIRST WORD
	BLT	S1,INIATM+INIWDS-1	;CLEAR ATOM BUFFER
	MOVE	P1,[POINT 7,INIATM]	;BYTE POINTER TO STORAGE
	MOVEI	P2,0			;CLEAR COUNT

KEY.1:	PUSHJ	P,FH$CVT		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIN	C,"-"			;DASH IN MIDDLE OF KEYWORD?
	JRST	KEY.3			;YES--WASN'T LINE CONTINUATION

KEY.2:	CAIL	C,"0"			;NUMERIC
	CAILE	C,"9"			; CHARACTER?
	CAIL	C,"A"			;UPPER
	CAILE	C,"Z"			; CASE?
	CAIL	C,"A"+40		;LOWER
	CAILE	C,"Z"+40		; CASE?
	JRST	KEY.4			;NO GOOD

KEY.3:	CAIGE	P2,INISIZ		;BUFFER OVERFLOW?
	IDPB	C,P1			;STORE CHARACTER
	AOJA	P2,KEY.1		;LOOP BACK

KEY.4:	SKIPN	S1,P2			;GET CHARACTER COUNT
	SOJA	S1,.RETF		;RETURN IF NO INPUT
	SKIPE	S1,P3			;GET TABLE ADDRESS
	JRST	KEY.5			;GOT ONE
	MOVEI	S1,INIATM		;ELSE JUST POINT TO PARSED TEXT
	$RETT				;AND RETURN

KEY.5:	HRROI	S2,INIATM		;POINT TO ATOM BUFFER
	PUSHJ	P,S%TBLK		;SCAN THE TABLE FOR A MATCH
	MOVE	TF,S2			;COPY RESULTING FLAGS
	MOVE	S2,S1			;COPY TABLE ADDRESS (IF ANY)
	MOVEI	S1,INIATM		;POINT CALLER AT KEYWORD TEXT
	TXNN	TF,TL%EXM		;MUST HAVE AN EXACT MATCH
	$RETF				;OR IT'S NO GOOD
	HRRZ	S2,(S2)			;GET DATA ASSOCIATED WITH KEYWORD
	$RETT				;RETURN
SUBTTL	INIT FILE ROUTINES -- FH$NUM/FH$DEC/FH$OCT - READ NUMBERS


; READ A NUMBER
; CALL:	MOVE	S1, RADIX
;	PUSHJ	P,FH$NUM
;
; TRUE RETURN:	S1 CONTAINS NUMBER, C CONTAINS TERMINATING CHARACTER
; FALSE RETURN:	EOF

FH$OCT::SKIPA	S1,[EXP 10]		;RADIX 8
FH$DEC::MOVEI	S1,12			;RADIX 10
FH$NUM::PUSHJ	P,.SAVE4		;SAVE SOME ACS
	MOVEI	P1,(S1)			;SAVE RADIX
	SETZB	P2,P3			;CLEAR RESULT, CHARACTER COUNT
	MOVNI	P4,1			;ASSUME NEGATIVE
	PUSHJ	P,FH$CVT		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINATION?
	$RETIF				;CHECK FOR ERRORS
	CAIE	C,"-"			;NEGATIVE?
	TDZA	P4,P4			;NO

NUM.1:	PUSHJ	P,FH$CVT		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIL	C,"0"			;RANGE
	CAILE	C,"0"(P1)		; CHECK
	JRST	NUM.2			;NO GOOD
	IMULI	P2,(P1)			;SHIFT RESULT
	ADDI	P2,-"0"(C)		;ADD DIGIT
	AOJA	P3,NUM.1		;LOOP BACK

NUM.2:	CAIE	P1,12			;RADIX 10?
	JRST	NUM.3			;NO
	CAIN	C,"."			;TRAILING DECIMAL POINT?
	PUSHJ	P,FH$CVT		;YES--READ NEXT CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
NUM.3:	CAIE	P1,10			;OCTAL?
	CAIN	P1,12			;DECIMAL?
	TDZA	S1,S1			;INIT MULTIPLIER SEARCH
	$RETT				;ELSE JUST RETURN NOW
	MOVE	TF,MULPTR		;GET BYTE POINTER TO MULTIPLIERS

NUM.4:	ILDB	S2,TF			;GET A CHARACTER
	JUMPE	S2,NUM.5		;DONE?
	CAIE	S2,(C)			;MATCH?
	AOJA	S1,NUM.4		;NO
	MOVEI	S2,MUL8			;ASSUME OCTAL
	CAIN	P1,12			;DECIMAL?
	MOVEI	S2,MUL10		;YES
	ADDI	S2,(S1)			;INDEX
	IMUL	P2,(S2)			;SHIFT RESULT
	PUSHJ	P,FH$CVT		;GET NEXT CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS

NUM.5:	SKIPGE	P4			;NEGATIVE QUANTITY?
	MOVNS	P2			;YES
	MOVE	S1,P2			;GET RESULT
	$RETT				;AND RETURN


MULSUF:	ASCIZ	/KMG/			;MULTIPLIER SUFFIX CHARACTERS
MULPTR:	POINT	7,MULSUF		;BYTE POINTER TO SUFFIX CHARACTERS
MUL8:	OCT	1K,	1M,	1G	;OCTAL MULTIPLIERS
MUL10:	DEC	1K,	1M,	1G	;DECIMAL MULTIPLIERS
SUBTTL	INIT FILE ROUTINES -- FH$QST - READ A POSSIBLY QUOTED STRING


; READ A POSSIBLY QUOTED STRING INTO THE ATOM BUFFER
; CALL:	PUSHJ	P,FH$QST
;
; TRUE RETURN:	S1 CONTAINS ADDRESS OF STRING, S2 CONTAINS THE LENGTH IN WORDS
;		C CONTAINS TERMINATING CHARACTER
; FALSE RETURN:	S1 CONTAINS -1 IF NO INPUT OR EOF, S2 IS INDETERMINATE

FH$QST::PUSHJ	P,.SAVE3		;SAVE SOME ACS
	MOVE	S1,[INIATM,,INIATM+1]	;SET UP BLT
	SETZM	INIATM			;CLEAR FIRST WORD
	BLT	S1,INIATM+INIWDS-1	;CLEAR ATOM BUFFER
	MOVE	P1,[POINT 7,INIATM]	;BYTE POINTER TO STORAGE
	SETZB	P2,P3			;CLEAR COUNT, QUOTE FLAG
	PUSHJ	P,FH$CHR		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIE	C,"'"			;SINGLE QUOTES?
	CAIN	C,""""			;DOUBLE QUOTES?
	SKIPA	P3,C			;YES--REMEMBER FOR LATER
	JRST	QST.2			;ENTER LOOP

QST.1:	PUSHJ	P,FH$CHR		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS

QST.2:	JUMPE	P3,QST.3		;QUOTED STRING?
	CAIE	C,(P3)			;CLOSING QUOTE?
	JRST	QST.4			;NO--GO STORE
	PUSHJ	P,FH$CHR		;READ NEXT CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	JRST	QST.5			;GO RETURN TO CALLER

QST.3:	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIN	C,"-"			;DASH?
	JRST	QST.4			;GO STORE
	CAIL	C,"0"			;NUMERIC
	CAILE	C,"9"			; CHARACTER?
	CAIL	C,"A"			;UPPER
	CAILE	C,"Z"			; CASE?
	CAIL	C,"A"+40		;LOWER
	CAILE	C,"Z"+40		; CASE?
	JRST	QST.5			;NO GOOD

QST.4:	CAIGE	P2,INISIZ		;BUFFER OVERFLOW?
	IDPB	C,P1			;STORE CHARACTER
	AOJA	P2,QST.1		;LOOP BACK

QST.5:	MOVE	S1,P2			;GET CHARACTER COUNT
	ADDI	S1,5			;ROUND UP
	IDIVI	S1,5			;COMPUTE WORDS
	MOVEI	S2,(S1)			;GET COUNT
	MOVEI	S1,INIATM		;GET BUFFER ADDRESS
	$RETT				;ELSE RETURN GOODNESS
SUBTTL	INIT FILE ROUTINES -- FH$SIX - READ A SIXBIT WORD


; READ A SIXBIT QUANTITY
; CALL:	PUSHJ	P,FH$SIX
;
; TRUE RETURN:	S1 CONTAINS RESULT AND C CONTAINS TERMINATING CHARACTER
; FALSE RETURN:	EOF

FH$SIX::PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P1,[POINT 6,P2]		;BYTE POINTER TO RESULT
	SETZ	P2,			;INIT RESULT

SIX.1:	PUSHJ	P,FH$CVT		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIL	C,"0"			;RANGE
	CAILE	C,"9"			; CHECK
	CAIL	C,"A"			;  THE
	CAILE	C,"Z"			;   CHARACTER
	JRST	SIX.3			;NO GOOD--FINISH UP

SIX.2:	TRNE	P2,77			;OVERFLOW?
	JRST	SIX.1			;YES--IGNORE THE REST
	SUBI	C," "			;CONVERT ASCII TO SIXBIT
	IDPB	C,P1			;STORE CHARACTER
	JRST	SIX.1			;LOOP FOR MORE

SIX.3:	MOVE	S1,P2			;GET RESULT
	$RETT				;ELSE RETURN GOODNESS
SUBTTL	INIT FILE ROUTINES -- FH$SKP - SKIP TABS AND SPACES


; SKIP TABS AND SPACES
; CALL:	PUSHJ	P,FH$SKP
;
; TRUE RETURN:	C CONTAINS THE FIRST NON-TAB/SPACE CHARACTER
; FALSE RETURN:	EOF

FH$SKP::PUSHJ	P,FH$CVT		;READ A CHARACTER
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,FH$CON		;LINE CONTINUATION?
	$RETIF				;CHECK FOR ERRORS
	CAIN	C," "			;SPACE?
	JRST	FH$SKP			;KEEP SEARCHING
	$RETT				;RETURN
SUBTTL	INIT FILE ROUTINES -- FH$XIT - EXIT FILE PROCESSING


; THIS ROUTINE IS CALLED TO PREMATURELY (BEFORE EOF) TERMINATE
; FILE PROCESSING.
; CALL:	PUSHJ	P,FH$XIT
;
; TRUE RETURN:	ALWAYS
; FALSE RETURN:	NEVER

FH$XIT::SKIPLE	S1,INIIFN		;GET IFN
	PUSHJ	P,F%RREL		;RELEASE IT
	$RETT				;RETURN
SUBTTL	OUTGET Exit Subroutines


OUTDDE:	MOVX	S1,%RSUDE		;NEVER AVAILABLE
	$RETF				;RETURN
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
;**;[3007] Change code at OUTWON+2L
	PUSH	P,P1			;[3007] SAVE P1 TOO
	MOVSI	P1,-NPRINT		;[3007] MAKE AOBJN POINTER
OUTW.1:	MOVE	S1,JOBSTW(P1)		;[3007] GET STREAM STATUS
	TXNE	S1,PSF%DO		;[3007] PRINTER OFFLINE?
	$WTO  (<^T/BELL/>,,@JOBOBA(P1))	;[3007] YES, TELL THE OPERATOR.
	AOBJN	P1,OUTW.1		;[3007] CHECK ALL PRINTERS
	POP	P,P1			;[3007] RESTORE P1
	POP	P,S2			;[3007] RESTORE S2
	POP	P,S1			;[3007] RESTORE S1
	$DSCHD(0)			;[3007] BLOCK THE PROCESS
	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	OUTDMP  --  Dump out buffers and wait


OUTDMP::
REPEAT BUFNUM+1,<
	PUSHJ	P,@J$OUTP(J)		;DUMP THE BUFFER
>  ;END REPEAT BUFNUM
	POPJ	P,			;AND RETURN
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>B17+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>B17+DOFRAC ;(20) THIS SKIPS 1/2 PAGE
	EXP	SUPRCH+EOLCHR+DODC1	   ;(21) THIS SKIPS 2 LINES (DC1)
	EXP	SUPRCH+EOLCHR+DODC2	   ;(22) THIS SKIPS 3 LINES (DC2)
	EXP	SUPRCH+EOLCHR+DODC3	   ;(23) DC3 SKIPS 1 LINE
	EXP	SUPRCH+EOLCHR+<6>B17+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
	MOVEM	T1,J$FTYP(J)		;STORE IT
	PUSHJ	P,FILCHR		;AND GO PROCESS THE FILE
	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	FILCHR -- INTERPRET ALL CHARACTERS IN A FILE

;	This routine will parse the file character by character until
;calling the appropriate routines depending on wether the character is
;a special break character that is device dependent, and will call the
;file type dependent routine.

FILCHR:	SKIPN	J$FASC(J)		;ASCII FILE?
	 JRST	@J$FTYP(J)		;Yes, special handling
FILCH1:	PUSHJ	P,INPBYT		;GET A BYTE FROM THE FILE
	 JUMPF	.RETT			;ALL DONE
FILCH2:	SKIPL	J$FASC(J)		;Allowing special interpretations?
	 SKIPN	T3,J$DBRK(J)		;YES, GET THE ADDRESS OF THE BREAK MASK
	  JRST	FILCH3			;No, just process as normal
	MOVEI	T1,(C)			;COPY IT
	IDIVI	T1,^D32			;CALCULATE WETHER IT IS A BREAK CHAR
	ADDI	T3,(T1)			;AND ADD THE WORD OFFSET TO IT
	MOVEI	T1,1			;GET A BIT
	MOVNS	T2			;MAKE CHARACTER NEGATIVE
	LSH	T1,^D35(T2)		;SHIFT IT OVER BY THE MOD(CHR,32) VALUE
	TDNN	T1,(T3)			;IS THIS CHARACTER A BREAK?
	 JRST	FILCH3			;NO CONTINUE TO PROCESS THIS FILE
	PUSHJ	P,@J$BKPR(J)		;ELSE CALL THE HANDLER
	 JUMPF	.RETT			;ERROR RETURNS NOW (Fatal errors given)
	JRST	FILCH1			;LOOP FOR THE WHOLE FILE
FILCH3:	PUSHJ	P,@J$FTYP(J)		;CALL THE FILE CHARACTER PROCESSOR
	JRST	FILCH1			;AND LOOP FOR THE WHOLE FILE
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:	SETZM	J$XCOD(J)		;CLEAR EXISTING REPORT CODE
	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
	JUMPN	S1,SETPFB		;USER SPECIFIED, IGNORE RIB ATTRIBUTES
	MOVE	S1,J$DIFN(J)		;GET THE IFN OF THE OUTPUT FILE
	MOVEI	S2,FI.DCC		;WE WANT THE DATA CARRIAGE CONTROL CODE
	$CALL	F%INFO			;TRY TO GET IT
	JUMPF	SETPFC			;RIB BITS NOT VALID,,EVALUATE EXTENSION
	CAXN	S1,.RBCFO		;FORTRAN CARRIAGE CONTROL?
	 JRST	SETFFO			;YES, GO SET FILE FORTRAN
SETPFC:	MOVE	S1,J$XFOB+FOB.FD(J)	;GET ADDRESS OF OUTPUT FILE DESCRIPTOR
	HLRZ	S1,.FDEXT(S1)		;GET THE EXTENSION OF THE FILE
	CAIN	S1,'DAT'		;DATA FILE?
	 JRST	SETFFO			;YES, GO SET FORTRAN
	MOVE	S1,J$DIFN(J)		;GET BACK THE FILE IFN
	MOVX	S2,FI.MCY		;SEE IF IT IS A MACY11 FILE
	$CALL	F%INFO			;GET THE INFO
	JUMPE	S1,SETPFA		;NOT, GO EVALUATE SWITCHES
	MOVX	S1,.FPF11		;GET MACY11 VALUE
	JRST	SETPFB			;AND GO TO COMMON CODE

SETFFO:	SKIPA	S1,[EXP .FPFFO]		;MAKE LIKE /FILE:FORTRA
	JRST	SETPFB			;AND ACT LIKE THE USER TYPED IT
SETPFA:	LOAD	S1,.FPINF(E),FP.FFF	;GET /FILE
SETPFB:	LOAD	S2,.FPINF(E),FP.FPF	;GET /PRINT
	TXZ	S,ARROW			;CLEAR SOME INITIAL FLAGS
	TXO	S,NEWLIN!FCONV		;AND SET SOME OTHERS

	SETZM	J$FASC(J)		;ASSUME NON-ASCII FILE
	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!ARROW		;YES, LIGHT A BIT, (for arrow mode too)

	MOVEI	T1,LPTFOR		;ASSUME /FILE:FORTRAN
	CAIN	S1,.FPFFO		;IS IT?
	JRST	SETASC			;ALLOW ASCII PROCESSING FOR FONT FILES

	MOVEI	T1,LPTELV		;ASSUME /FILE:ELEVEN
	CAIN	S1,.FPF11		;IS IT?
	POPJ	P,			;YES, RETURN

	MOVEI	T1,LPTRPT		;USE REPORT ROUTINE
	SKIPE	.FPFR1(E)		;UNLESS /REPORT WAS NOT SPECIFIED
	POPJ	P,
	MOVEI	T1,LPTASC		;ASSUME STANDARD ASCII
SETASC:	SETOM	J$FASC(J)		;Flag ascii file type
	CAIN	S2,%FPGRF		;ALLOW GRAPHICS SUPPORT?
	 MOVNS	J$FASC(J)		; YES, ALLOW FONT SPECS
	POPJ	P,			;AND RETURN
SUBTTL	LPTASC  --  Print Regular ASCII on LPT

LPTASC:	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTA.1			;NO, GO HANDLE SPECIAL CHARS
	TXNE	S,FORWRD		;ARE WE FORWARD SPACING ???
	$RET				;YES, RETURN NOW
	SETZM	J$XTOP(J)		;CLEAR TOF FLAG
	JRST	DEVOUT			;Output the character
LPTA.1:	PUSHJ	P,CHKSP			;GO HANDLE SPECIAL CHARS
	$RET
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,@J$OUTP(J)		;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:	JUMPE	C,.POPJ			;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
	JRST	LPTCHR			;OTHERWISE PRINT IT
	$RET

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
	JRST	LPTCHR			; A LINEFEED, SEND IT
	
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,LPTCHR		;SEND THE CHARACTER
	SOSLE	J$XFRC(J)		;COUNT DOWN THE REPEAT COUNTER
	JRST	FORC.3			;AND LOOP
	$RET
SUBTTL	LPTRPT  --  Process REPORT files

LPTRPT:	PUSHJ	P,INPBYT		;GET A BYTE FROM THE FILE
	JUMPF	.RETT			;AND RETURN WHEN DONE
	PUSHJ	P,LPTCHR		;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,LPTCHR
;	RETURN HERE (EOF SET IF OVER LIMIT)

LPTCHR:	CAIGE	C,40			;VISABLE ASCII
	JRST	CHKSP			;NO--SEE IF SPACE
	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
	TXNE	S,SUPFIL!SUPJOB		;IN SUPPRESS MODE?
	TXNN	S1,SUPRCH		;YES, IS THIS CHARACTER SUPPRESSABLE?
	SKIPA				;Skip the suppress stuff
	JRST	DOSUP			;SUPPRESS THE CHARACTER
	TXNN	S1,NCLRFF		;CLEAR FORMFEED FLAG?
	SETZM	J$XTOP(J)		;YES
	JRST	(S1)			;Dispatch 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	LPTCHR		;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!SUPJOB		;ARROW MODE (From OPR SUPPRESS comd
	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 DC1
DODC1:	MOVNI	S1,2			;DC1 SKIPS 2 LINES
	JRST	CNTDWN			;AND COUNT DOWN

;HERE ON A DC2
DODC2:	MOVNI	S1,3			;DC2 SKIPS 3 LINES
	JRST	CNTDWN			;AND COUNT DOWN

;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.
;**;[4005]ADD 6 LINES AT CNTDW1:+3L	13-MAY-85/CTK
	JRST	[TXZ	S,FORWRD	;[4005]TURN OFF FORWARD SPACE BIT
		 SKIPE	J$FPIG(J)	;[4005]JUST FINISH FORWARDSPACE
		 JRST	.+1		;[4005]NEVER DID
		 PUSHJ	P,SENDFF	;[4005]YES, SEND A FORM FEED
		 SETZM	C		;[4005]ZAP THE CHARACTER
		 JRST	.+1]		;[4005]CONTINUE
	AOS	J$RNPP(J)		;ADD 1 TO PAGES PER COPY COUNTER
	TXNE	S,FORWRD		;FORWARD SPACING ???
	JRST	[			;Yes
TOPS10<		MOVE	S1,J$RNPP(J)	;Get pages printed per copy
		IDIVI	S1,FRWSKP	;Divide by DSCHD factor
		SKIPE	S2		;Are we on an evenly divisible page?
		JRST	CNTDW2		;No, skip this
		SETZM	SLEEPT		;No sleeptime wanted
		$DSCHD(0)		;Let the other streams try
> ; End of TOPS10
		JRST	CNTDW2]		;Continue on
	AOS	J$APRT(J)		;NO, ADD 1 TO TOTAL PAGES COUNTER

	;Here we keep track of where we are for backspaceing

CNTDW2:	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-1(J)	;ARE WE AT THE END OF THE PAGE TABLE ???
	JRST	CNTDW3			;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

CNTDW3:	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
;**;[4005]REVAMP CODE AT CNTDW3:+8L	13-MAY-85/CTK
	JRST	[SKIPG	J$FPIG(J)	;[4005]ARE WE FORWARD SPACING
		 SETOM	J$XTOP(J)	;[4005]NO, SET TOP OF FORM
		 JRST	.+1]		;[4005]CONTINUE
	$CALL	LIMCHK			;Go check the limit
	JUMPT	DEVOUT			;Output character and return (not here)
	$CALL	INPFEF			;Error -- force an EOF
	$RET
SUBTTL	LIMCHK -- Check on page limits

Comment\
  The purpose of this routine is to check and see if the current page limit
for the job has been exceeded.  If so, then check with the operator to see
if the job should proceed.  If ignore then set the bit and return.  If the
jobe is to be aborted, then set that bit.  In any case, if the job can be
continued, return true.
\
LIMCHK:	MOVE	S1,J$RLIM(J)		;GET LIMIT
	SUB	S1,J$APRT(J)		;GET AMOUNT PRINTED
;**;[4005]ADD 2 LINES AT LIMCHK:+2L	13-MAY-85/CTK
	SKIPGE	J$FPIG(J)		;[4005]ZERO FORWRD SPACE PAGES?
	SETZM	J$FPIG(J)		;[4005]YES, SET IT
	TXNN	S,ABORT+GOODBY		;ARE WE ON OUR WAY OUT OR
	SKIPL	S1			;   STILL UNDER QUOTA ???
	JRST	LIMC.5			;Yes, return true
	GETLIM	S1,.EQLIM(J),FLEA	;GET FORMS-LIMIT-EXCEED ACTION
	CAIN	S1,.STCAN		;SEE IF CANCEL
	JRST	LIMC.4			;IT WAS, DO IT
	CAIN	S1,.STIGN		;SEE IF IGNORE
	JRST	LIMC.5			;Yes, return true

	;DEFAULT TO ASK IF NOT IGNORE OR CANCEL

LIMC.1:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT
	SETOM	JOBUPD(S1)		;  update the status also
	$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	LIMC.2			;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	LIMC.1			;NO, STUPID OPERATOR SO TRY AGAIN
	HRRZ	S1,0(S1)		;GET THE ROUTINE ADDRESS
	JRST	0(S1)			;AND PROCESS THE RESPONSE

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

	;IF ANSWER WAS 'PROCEED' COME HERE

LIMC.2:	MOVX	S1,.STIGN		;YES, GET THE IGNORE BITS
	STOLIM	S1,.EQLIM(J),FLEA	;SAVE IT AS NEW LIMIT EX ACTION
	JRST	LIMC.5			;Return true

	;IF ANSWER WAS 'ABORT' COME HERE

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

LIMC.4:	$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
	$TEXT	(<-1,,J$WTOR(J)>,<Page limit exceeded^0>)
	$RETF				;Limit exceeded, don't continue

LIMC.5:	$RETT				;OK to proceed

LIMANS:	$STAB
	 KEYTAB	(LIMC.3,ABORT)		;ABORT
	 KEYTAB	(LIMC.2,PROCEED)	;PROCEED
	$ETAB
SUBTTL	DEVOUT - Subroutine to output one char on selected device

;Call DEVOUT with a character to be output on the virtual device.
;Call PHSOUT only from a device driver which is bypassing its own
;character translation RAM or VFU simulations.
; Call:
;	C/	Character to output
;	PUSHJ	P,DEVOUT
;	Return here (HALTs if error)
;

DEVOUT::TXNE	S,FORWRD		;ARE WE FORWRD SPACING ???
	POPJ	P,			;YES, RETURN.
	PUSHJ	P,@J$CHRO(J)		;SEE IF DRIVER NEEDS TO TRANSLATE
	 $RETIF				;IF DRIVER CHOOSES NOT TO, DON'T
PHSOUT::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,@J$OUTP(J)		;DUMP THE BUFFER
	POP	P,S1			;RESTORE S1
	JRST	PHSOUT			;AND TRY AGAIN

;SENDFF - ROUTINE TO SEND A FF IF J$XTOP IS OFF
;
SENDFF::SKIPN	J$FFDF(J)		;DRIVER HANDLE FORM FEEDS?
	POPJ	P,			;NO
	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)		;YES, 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>)

	PUSHJ	P,@J$HDRW(J)		;SET UP HEADER WIDTHS FOR THIS PRINTER
	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
	SKIPN	.EQUSR(J)		;USER NAME GIVEN?
	JRST	BANN.0			;NO
	MOVEI	S1,.EQUSR(J)		;POINT TO NAME
	HRLI	S1,(POINT 8,)		;8-BIT ASCIZ
	$TEXT	(<-1,,J$PUSR(J)>,<^Q/S1/^0>)
	JRST	BANN.1			;ONWARD

BANN.0:
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:	SKIPN	J$ALNF(J)		;PRINTER NEEDS FORMFEEDS?
	PUSHJ	P,SENDFF		;SEND A FORM FEED
	PUSHJ	P,@J$BNRI(J)		;INIT BANNER PAGES (POSSIBLE FONTS)
	JUMPF	.RETT			;THAT'S ALL IF NO BANNERS DESIRED
	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

BANN.3:	SKIPN	.EQBOX(J)		;DISTRIBUTION BOX SPECIFIED?
	JRST	BANN.4			;NO
	MOVEI	S1,.EQBOX(J)		;POINT TO STRING
	HRLI	S1,(POINT 8,)		;8-BIT ASCIZ
	$TEXT	(<-1,,J$PDST(J)>,<^Q/S1/^0>)
	MOVEI	S1,1			;GET THE BLOCKSIZE
	MOVEI	S2,J$PDST(J)		;GET THE ADDRESS
	PUSHJ	P,PICTUR		;AND SEND IT OUT
	MOVEI	S1,^D11			;ACCOUNT FOR LINES
	ADDM	S1,J$XPOS(J)		; JUST WRITTEN

BANN.4:	PUSHJ	P,PLPBUF		;PRINT A LINE
	PUSHJ	P,PLPBUF		;AND ANOTHER
	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
	TXNE	S,SUPFIL!SUPJOB		;Are we suppressing forms?
	SETZM	J$XTOP(J)		;Don't believe we are at top of forms.
	PUSHJ	P,SENDFF		;SEND A FORMFEED
	JUMPE	P3,OUTDMP		;RETURN IF ZERO
	JRST	TRAI.2			;SKIP FORMFEED SEND,,ALREADY DID IT

TRAI.1:	SKIPN	J$ALNF(J)		;PRINTER NEEDS FORM-FEEDS?
	PUSHJ	P,SENDFF		;SEND A FORMFEED
TRAI.2:	PUSHJ	P,@J$BNRI(J)		;GO SET UP FOR BANNER PAGES
	SETZM	J$XPOS(J)		;CLEAR THE VERTICAL POSITION
	JUMPF	.RETT			;THAT'S ALL IF NO BANNERS DESIRED
	PUSHJ	P,LPTLOG		;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
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:	PUSHJ	P,@J$RULR(J)		;DRAW A RULER IF APPROPRIATE
	POPJ	P,

;**;[3004] Change code at CR23. /LWS
CR23:	SKIPE	J$DC3F(J)		;SKIP IF DC3 NOT SUPPORTED
	SKIPA	S1,[[BYTE (7) 15,23,0,0,0]] ;[3004] PRINT OUT CR23
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
	TXNE	S,SUPFIL!SUPJOB		;Are we suppressing forms?
	SETZM	J$XTOP(J)		;Don't believe we are at top of forms.
;**;[4005]ADD AND REVAMP CODE AT HEAD:+3L	13-MAY-85/CTK
	LOAD	P1,.FPINF(E),FP.NFH	;[4005]GET THE NO HEADER BIT
	SKIPE	P1			;[4005]SKIP IF WE WANT HEADERS
	JRST	[MOVE	S1,J$FPIG(J)	;[4005]GET PAGE TO FORWARD SPACE
		CAIG	S1,1		;[4005]FORWARD SPACING ???
		PUSHJ	P,SENDFF	;[4005]NO, SEND FORM FEED
		PJRST	OUTDMP]		;[4005]DUMP BUFFERS AND RETURN
	PUSHJ	P,SENDFF		;[4005]SEND A FORM FEED
	SKIPN	P3,J$FHEA(J)		;GET NUMBER OF PICTURE PAGES
	PJRST	OUTDMP			;DUMP BUFFERS AND RETURN
	PUSHJ	P,@J$HDRW(J)		;Set up the widths for the headers
	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:	PUSHJ	P,@J$HDRI(J)		;SET POSSIBLE HEADER FONTS
	JUMPF	.RETT			;THAT'S ALL IF NO BANNERS DESIRED
	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
	$TEXT(TBFCHR,<^M^JFile ^F/@J$DFDA(J)/^T/J$GSPL(J)/, ^A>)
	MOVEI	S2,[ASCIZ / /]		;GET A STRING
	CAIE	P1,3			;WIDTH CLASS 3?
	MOVEI	S2,[BYTE (7) .CHCRT,.CHLFD,.CHTAB,0]
	MOVE	P1,S2			;Remember for short or long lines
TOPS10 <
	MOVE	S1,J$DIFN(J)		;GET THE IFN
	MOVX	S2,FI.GEN		;WANT THE FILE VERSION NUMBER
	PUSHJ	P,F%INFO		;GET IT
	JUMPE	S1,HED.NV		;NONE
	$TEXT(TBFCHR,<version: ^V/S1/,^T/(P1)/^A>)
	MOVE	S1,J$DIFN(J)		;GET THE IFN
	MOVX	S2,FI.CRE		;WANT CREATION TIME
	PUSHJ	P,F%INFO		;GET IT
	$TEXT(TBFCHR,<created: ^H/S1/,  printed: ^H/[-1]/>) ;[2774]
	JRST	HED.VE			;DONE WITH THIS LINE
>
HED.NV:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	MOVX	S2,FI.CRE		;WANT CREATION TIME
	PUSHJ	P,F%INFO		;GET IT
	$TEXT(TBFCHR,<created: ^H/S1/,^T/(P1)/printed: ^H/[-1]/>) ;[2774]

HED.VE:	PUSHJ	P,TBFDMP		;AND DUMP THE BUFFER

	MOVEI	S1,J$LOUT(J)		;POINT TO NODE/DEVICE/UNIT TEXT
	SKIPN	(S1)			;HAVE SOMETHING?
	JRST	HEAD.2			;NO
	$TEXT	(TBFCHR,<^T/(S1)/>)	;COPY TEXT
	PUSHJ	P,TBFDMP		;AND DUMP THE BUFFER

HEAD.2:	GETLIM	S1,.EQLIM(J),FORM	;GET FORMS NAME
	$TEXT(TBFCHR,<Job parameters: Request created:^H/.EQAFT(J)/   Page limit:^D/J$RLIM(J)/^T/(P1)/  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,<^T/(P1)/  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
TOPS10	<
	LOAD	S1,.FPINF(E),FP.REN	;GET /DISPOSE:RENAME BIT
	SKIPE	S1			;IS IT SET?
	$TEXT(TBFCHR,<   /DISPOSE:RENAME^A>)	;YES, SAY SO
>;END TOPS10
	PUSHJ	P,CRLF			;END THE LINE
	MOVE	S1,J$FPIG(J)		;GET STARTING PAGE
	CAILE	S1,1			;SKIP IF 0 OR 1
;**;[4005]ADD 4 LINES AT HEAD.1:+58L	13-MAY-85/CTK
	JRST	[$TEXT(TBFCHR,<^M^JPrinting will start at page ^D/J$FPIG(J)/>)
		CAIN	P3,1		;[4005]LAST HEADER ???
		PJRST	TBFDMP		;[4005]YES, DUMP THE BUFFER
		JRST	.+1]		;[4005]NO, CONTINUE
	PUSHJ	P,TBFDMP		;DUMP THE BUFFER
	SKIPN	J$ALNF(J)		;PRINTER NEED A FORMFEED
	PJRST	SENDFF			;SEND A FORM FEED
	$RETT				;NO, RETURN NOW


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

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
TOPS10	<
	TXNE	S1,FP.REN		;IS IT /DISPOSE:RENAME?
	JRST	SETH.4			;YES, PROCESS THAT
>;END TOPS10
	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

SETH.4:	$TEXT(<-1,,J$PFL1(J)>,<^W/.FPONM(E)/^0>) ;OUTPUT ORIGINAL NAME
	$TEXT(<-1,,J$PFL2(J)>,<^W3/.FPOXT(E)/^0>) ;AND EXTENSION
	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
	CAMLE	S1,J$FLCL(J)		;Compare with the length class
	MOVE	S1,J$FLCL(J)		;Use the min. of the two.
	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
	MOVE	T3,P2			;COPY POINTER TO TEXT
	ILDB	T3,T3			;GET FOLLOWING CHARACTER
	SKIPN	T3			;IF AT END OF STRING,
	SKIPA	T3,[5]			; DON'T NEED THE 2 SPACES
	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
	MOVSI	S1,.STSPL		;ISSUE 'SETUUO' TO
	SETUUO	S1,			;   CLEAR SPOOLING BITS
	  JFCL				;IGNORE THE ERROR
	PJOB	S1,			;GET OUR JOB NUMBER
	MOVEM	S1,LPJOB		;SAVE IT
	MOVE	S1,[ASCII/D/]		;DEFAULT TO DETACHED
	MOVEM	S1,LPTRM		;SAVE THE DESIGNATOR
	GETLIN	S1,			;GET OUR TTY NUMBER
	TLNN	S1,-1			;ARE WE DEATCHED ???
	JRST	OPDI.1			;YES, SKIP THIS
	GTNTN.	S1,			;GET OUR LINE NUMBER
	 JRST	OPDI.1			;FAILED,,WE ARE DETACHED
	SETOM	S2			;GET A -1
	TRMNO.	S2,			;GET OUR TTY NUMBER
	 JRST	OPDI.1			;FAILED,,WE ARE DETACHED !!!
	GETLCH	S2			;GET OUR LINE CHARACTERISTICS
	MOVE	TF,[ASCII/T/]		;DEFAULT TO A TTY
	TXNE	S2,GL.ITY		;ARE WE A PTY ???
	MOVE	TF,[ASCII/P/]		;YES, MAKE US 'PTY'
	TXNE	S2,GL.CTY		;ARE WE THE CTY ???
	MOVE	TF,[ASCII/C/]		;YES, MAKE US 'CTY'
	MOVEM	TF,LPTRM		;SAVE THE TERMINAL DESIGNATOR
	HRRZM	S1,LPLNO		;SAVE THE LINE NUMBER
	JRST	OPDI.1			;CONTINUE
>  ;END TOPS10 CONDITIONAL

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


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

OPDI.1:	SETZ	M,			;CLEAR MESSAGE ADDRESS
	MOVE	P1,DEVLST		;POINT TO START OF DEVICE DRIVER CHAIN

OPDI.2:	PUSHJ	P,@J$INIT-J$$DEV(P1)	;INITIALIZE
	SKIPE	P1,(P1)			;POINT TO NEXT DRIVER
	JRST	OPDI.2			;LOOP BACK
	SETZM	FMOPN			;CLEAR FORMS.INI OPEN FLAG
	$RETT				;AND RETURN

SUBTTL	Mount and dismount structures -- Entry point


; Here to mount and dismount structures for each file being processed.
; Call:	MOVE	S1, FD address
;	PUSHJ	P,STRMNT	;TO MOUNT
;	PUSHJ	P,STRDMO	;TO DISMOUNT
;
; Note:	Under TOPS-10, the number of structures that may be mounted is
;	limited to the size of a search list. It is conceivable that we
;	could be driving up to 15 devices. When a structure can't be
;	mounted, the operator will be notified.
;
STRMNT:	TDZA	TF,TF			;REMEMBER MOUNT ENTRY POINT
STRDMO:	MOVEI	TF,1			;REMEMBER DISMOUNT ENTRY POINT
TOPS20	<POPJ	P,>
TOPS10<
	$SAVE	<P1,P2>			;SAVE SOME ACS
	MOVE	P1,TF			;SAVE MOUNT/DISMOUNT FLAG
	PUSHJ	P,STRXTR		;EXTRACT THE STRUCTURE NAME
	MOVE	P2,S1			;SAVE FOR LATER
	MOVE	S1,[-STRLEN,,STRTAB]	;GET AOBJN POINTER TO STRUCTURE TABLE
	SETZ	S2,			;CLEAR EMPTY SLOT POINTER

STR.1:	CAMN	P2,0(S1)		;FOUND THE STR?
	JRST	@STRDSP(P1)		;DISPATCH
	SKIPN	0(S1)			;THIS ENTRY IN USE?
	SKIPE	S2			;NO - FOUND AN EMPTY SLOT YET?
	SKIPA				;DO NOTHING
	MOVE	S2,S1			;REMEMBER THE EMPTY SLOT
	ADD	S1,[1,,1]		;ACCOUNT FOR TWO WORD ENTRIES
	AOBJN	S1,STR.1		;LOOP THROUGH STRUCTURE TABLE
	JRST	@STRDSP(P1)		;DISPATCH

STRDSP:	EXP	STRADD			;DISPATCH FOR MOUNT
	EXP	STRREM			;DISPATCH FOR DISMOUNT
SUBTTL	Mount and dismount structures -- Add and remove structures


; Add a structure to our search list
;
STRADD:	SKIPGE	S1			;AOBJN POINTER RUN OUT?
	CAME	P2,0(S1)		;ALREADY HAVE THIS STR MOUNTED?
	JRST	STRA.1			;NEED TO MAKE A NEW ENTRY
	AOS	1(S1)			;INCREMENT USE COUNT
	POPJ	P,			;AND RETURN CUZ IT'S ALREADY MOUNTED

STRA.1:	JUMPE	S2,STRERR		;CHECK FOR NO ROOM IN STRUCTURE TABLE
	MOVE	S1,S2			;GET ADDRESS OF EMPTY SLOT IN TABLE
	MOVEM	P2,0(S1)		;STASH STR NAME
	AOS	1(S1)			;GIVE IT A USE COUNT OF ONE
	PUSHJ	P,STRCHK		;CHECK EXISTANCE OF ALL STRS
	PJRST	STRJSL			;SET NEW JOB SEARCH LIST AND RETURN


; Remove a structure from our search list
;
STRREM:	SKIPGE	S1			;AOBJN POINTER RUN OUT?
	SOSE	1(S1)			;DECREMENT USE COUNT
	POPJ	P,			;STR STILL IN USE
	SETZM	0(S1)			;ZAP STR NAME
	PUSHJ	P,STRCHK		;CHECK EXISTANCE OF STRS
	PJRST	STRJSL			;SET NEW JOB SEARCH LIST AND RETURN
>
SUBTTL	Mount and dismount structures -- Extract structre from FD


; Extract a structure name from an FD
; Call:	MOVE	S1, FD address
;	PUSHJ	P,STRXTR
;
; On return, S1:= sixbit structure name
;
STRXTR:
TOPS10	<
	MOVE	S1,.FDSTR(S1)		;GET STRUCTURE NAME
	MOVEM	S1,DCHBLK+.DCNAM	;PUT IN DSKCHR BLOCK
	MOVE	S1,[.DCSNM+1,,DCHBLK]	;SET UP UUO
	DSKCHR	S1,			;GET THE DISK CHARACTERISTICS
	  SKIPA	S1,.FDSTR(S1)		;CAN'T - ASSUME IT'S OK
	MOVE	S1,DCHBLK+.DCSNM	;GET STRUCTURE NAME
	POPJ	P,			;AND RETURN
> ;END TOPS-10 CONDITIONAL

REPEAT 0,<
TOPS20	<
	HRROI	S1,.FDSTG(S1)		;MAKE IT -1,,ADDR
	$CALL	S%SIXB			;CONVERT ASCII TO SIXBIT
	MOVE	S1,S2			;GET THE NAME
	POPJ	P,			;RETURN
> ;END TOPS-20 CONDITIONAL
>
SUBTTL	Mount and dismount structures -- Check structure existance


; Check the existance of all structures in the structure table. This
; turns out to e cheaper and easier than reading our existing search list
; and then modifying it to accomodate our needs.
; Call:	PUSHJ	P,STRCHK
;
STRCHK:
TOPS10	<
	MOVE	S1,[-STRLEN,,STRTAB]	;GTE AOBJN POINTER

STRC.1:	HRRZ	S2,S1			;POINT TO STR NAME
	SKIPE	(S1)			;AVOID A UUO IF NO STR
	DSKCHR	S2,			;MAKE SURE IT'S STILL THERE
	  SKIPA				;LOSE
	JRST	STRC.2			;ONWARD
	SETZM	0(S1)			;ZAP STR NAME
	SETZM	1(S1)			;AND THE USE COUNT

STRC.2:	ADD	S1,[1,,1]		;ACCOUNT FOR TWO WORD ENTRIES
	AOBJN	S1,STRC.1		;LOOP THROUGH TABLE
	POPJ	P,			;RETURN
> ; END TOPS-10 CONDITIONAL

TOPS20	<POPJ	P,>			;NO-OP FOR THE -20
SUBTTL	Mount and dismount structures -- Change job search list


; Here to build a new job search list
; Call:	PUSHJ	P,STRJSL
;
STRJSL:
TOPS10	<
	MOVEI	S1,.FSDSL		;GET FUNCTION CODE
	MOVEM	S1,STRBLK+.FSFCN	;SAVE IT
	SETOM	STRBLK+.FSDJN		;SET JOB NUMBER TO -1 (US)
	SETOM	STRBLK+.FSDPP		;SET PPN TO -1 (US)
	MOVEI	S1,DF.SRM		;GET A BIT
	MOVEM	S1,STRBLK+.FSDFL	;REMOVE STRS NOT IN NEW S/L
	MOVE	S1,[-STRLEN,,STRTAB]	;GTE AOBJN POINTER
	MOVEI	S2,STRBLK+.FSDSO	;POINT TO FIRST FREE WORD

STRJ.1:	MOVE	TF,0(S1)		;GET A STR NAME
	JUMPE	TF,STRJ.2		;SKIP EMPTY SLOTS
	MOVEM	TF,.DFJNM(S2)		;SAVE IT
	SETZM	.DFJDR(S2)		;CLEAR DIRECTORY
	SETZM	.DFJST(S2)		;NO SPECIAL STATUS BITS
	ADDI	S2,.DFJBL		;POINT TO NEXT FREE ENTRY

STRJ.2:	ADD	S1,[1,,1]		;ACCOUNT FOR TWO WORD ENTRIES
	AOBJN	S1,STRJ.1		;LOOP
	SETOM	.DFJNM(S2)		;MARK THE FENCE
	SUBI	S2,STRBLK		;COMPUTE LENGTH OF S/L BLOCK
	HRLI	S2,STRBLK		;POINT TO S/L BLOCK
	MOVSS	S2			;MAKE IT -LEN,,ADDR
	STRUUO	S2,			;DEFINE OUR NEW S/L
	  JRST	STRERR			;CAN'T
	POPJ	P,			;RETURN
> ;END OF TOPS-10 CONDITIONAL

REPEAT 0,<
TOPS20	<
	MOVEM	P2,STRBLK		;SAVE STR NAME
	SETZM	STRBLK+1		;TERMINATE IT
	MOVE	S1,[POINT 6,STRBLK]	;BYTE POINTER TO SIXBIT STR NAME
	HRROI	S2,STRBLK+3		;GET -1,,ADDRESS
	MOVEM	S2,STRBLK+2		;SAVE IT
	MOVE	S2,[POINT 7,STRBLK+3]	;BYTE POINTER TO ASCIZ STR NAME

STRJ.1:	ILDB	TF,S1			;GET A CHARACTER
	SKIPE	TF			;END?
	ADDI	TF," "			;CONVERT SIXBIT TO ASCII
	IDPB	TF,S2			;PUT A CHARACTR
	JUMPN	TF,STRJ.1		;LOOP
	MOVE	S1,[1,,.MSIMC		;MOUNT FUNCTION
		    1,,.MSDMC](P1)	;DISMOUNT FUNCTION
	MOVEI	S2,STRBLK+2		;POINT TO ASCIZ STR NAME
	MSTR				;CHANGE THE MOUNT COUNT
	  ERJMP	STRERR			;CAN'T
	POPJ	P,			;RETURN
> ;END OF TOPS-20 CONDITIONAL
>
; Here on all STRUUO errors
; We'll try to correct our database so we don't get out of
; synch with the real world. If we ever get here, there's
; a good chance the monitor is F@#$%ed up anyway, so maybe
; it's not so important...
;
STRERR:	MOVE	S1,[[ASCIZ |mount|]	;ASSUME MOUNTING
		    [ASCIZ |dismount|]](P1) ;GET CORRECT TEXT
	$WTO	(<LPTSPL error>,<Cannot ^T/(S1)/ structure ^W/P2/>,,$WTFLG(WT.SJI))
	JUMPN	P1,.POPJ		;RETURN IF A DISMOUNT
	MOVE	S1,[-STRLEN,,STRTAB]	;GET AOBJN POINTER TO STRUCTURE TABLE

STRE.1:	CAME	P2,0(S1)		;[3003] FOUND THE STR?
	JRST	STRE.2			;NOPE
	SOSN	1(S1)			;DECREMENT USE COUNT
	SETZM	0(S1)			;ZAP STR NAME IF COUNT = ZERO
	POPJ	P,			;RETURN

STRE.2:	ADD	S1,[1,,1]		;ACCOUNT FOR TWO WORD ENTRIES
	AOBJN	S1,STRE.1		;LOOP THROUGH TABLE
	POPJ	P,			;REALLY SICK
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

	ZZ==0
REPEAT	NPRINT,<
	MOVEI	S1,INTDEV+<LPHDSZ*ZZ>	;GET ADDRESS OF LPT HEADER
	MOVEM	S1,VECDEV+<4*ZZ>+.PSVNP	;STORE IN THE VECTOR
	ZZ==ZZ+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+PS.RDH ;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:	ZZ==0
	REPEAT NPRINT,<
	LPINHD(ZZ)
	ZZ==ZZ+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 ???
	JRST	[SETZM	JOBCHK(S1)	;YES, SAY WE WANT A CHECKPOINT
		SETOM	JOBUPD(S1)	;  update the status also
		JRST	LPIN.1]		;Go continue
LPIN.1:	TXNE	T1,PS.RDH		;DEVICE HUNG?
	JRST	LPIN.3			;YES
	TXNE	T1,PS.ROL		;IS IT ON-LINE?
;**;[3007] Change code at LPIN.1+3L
	JRST	[MOVX	T2,PSF%DO+PSF%OB ;YES, CLEAR ON-LINE & OUTPUT-BLOCKED
		 SETZM	J$LBCT(J)	;[3007] MAKE SURE WE DON'T USE BUFFER
		 JRST	.+1]		;[3007] CONTINUE
	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.
	MOVE	T2,.PSVIS(S2)		;[3005] GET THE FILE STATUS BITS
	TXC	T2,IO.ERR		;[3005] CHECK TO SEE IF ALL ERROR BITS ARE LIT
	TXNN	T2,IO.ERR		;[3005] ARE THEY ???
	SKIPL	J$LREM(J)		;YES, IS THIS A REMOTE LPT ???
	SKIPA				;NOT ALL BITS LIT OR NOT REMOTE,,SKIP
	$DEBRK				;ELSE REMOTE WENT DOWN,,RETURN NOW !!!
	TXC	T1,PS.RIE!PS.ROE!PS.RDO	;[3005] JUST THE ONES WE WANT
	TXNN	T1,PS.RIE!PS.ROE!PS.RDO	;[3005] CPU CROAK OR JUST LPT OFF-LINE?
	JRST	LPIN.2			;DEAD CPU
	MOVEI	T1,OUTWON		;LPT OFFLINE,,LOAD RESTART ADDR
	EXCH	T1,.PSVOP(S2)		;STORE FOR DEBRK AND GET OLD ADRESS
;**;[3013] Insert 2 lines and change 1 line after LPIN.1+25L. /LWS
	MOVE	T2,STREAM		;[3013] GET ACTIVE STREAM
	MOVE	T2,JOBPAG(T2)		;[3013] GET JOB PAGE ADDR OF ACTIVE STREAM
	MOVEM	T1,J$LIOA(T2)		;[3013] STORE OLD-ADDRESS FOR DEVICE ON AGAIN
	$DEBRK				;DISMISS THE INTERRUPT

;**;[3001] Rework CPU failure and hung device interrupt code.  /LWS
LPIN.2:	SKIPA	T2,[CPUFAI]		;[3001] GET ROUTINE ADDR FOR CPU FAILURE

LPIN.3:	MOVEI	T2,HNGDEV		;[3001] GET ROUTINE ADDR FOR HUNG DEVICE
;**;[2776] Change 1 line at LPTIN.3+0L. 21-Dec-83 /LWS
	SETZM	JOBSTW(S1)		;MAKE JOB RUNABLE
	MOVE	T1,J$RACS+P(J)		;GET STREAM STACK
	PUSH	T1,T2			;[3001] AVOID RACES,,T2 HAS ROUTINE ADDR
	MOVEM	T1,J$RACS+P(J)		;REPLACE PDL POINTER
	CAMN	S1,STREAM		;HUNG DEVICE IN STREAM CONTEXT?
	MOVEM	T2,.PSVOP(S2)		;[3001] SET RETURN ADDRESS
	$DEBRK				;DISMISS THE INTERRUPT
>  ;END TOPS10 CONDITIONAL
SUBTTL	CPU failure and Hung device code


TOPS10	<
CPUFAI:	TDZA	P2,P2			;INDICATE CPU FAILURE
HNGDEV:	MOVEI	P2,1			;INDICATE HUNG DEVICE
	MOVE	P1,STREAM		;GET THE STREAM NUMBER
	MOVE	J,JOBPAG(P1)		;SET UP JOB DATA BASE RELOCATION
	MOVE	S,J$RACS+S(J)		;GET THE STREAM STATUS BITS.
	TXO	S,GOODBY!RQB!ABORT	;ON OUR WAY OUT
	MOVEM	S,J$RACS+S(J)		;UPDATE FLAGS
	MOVE	S1,[[ASCIZ |CPU failure|]
		    [ASCIZ |Hung device|]](P2) ;GET TEXT
	$WTO	(<^T/(S1)/; job requeued>,<^R/.EQJBB(J)/>,@JOBOBA(P1))

HNGD.1:	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

HNGD.2:	SKIPE	S1,J$DIFN(J)		;GET IFN
	PUSHJ	P,F%REL			;CLOSE FILE
	SETZM	J$DIFN(J)		;CLEAR IT
	MOVEM	S,J$RACS+S(J)		;SAVE UPDATED AC 'S'
	SETZM	JOBACT(P1)		;MAKE JOB RUNABLE
	PUSHJ	P,QRELEASE 		;RELEASE THE REQUEST
	MOVX	S1,%RSUDE		;GET NON-EXISTANT DEVICE CODE
	PUSHJ	P,RSETUP		;TELL QUASAR WE'RE DONE
	PJRST	SHUTIN			;SHUT DOWN AND RETURN TO SCHEDULER
> ;END TOPS10 CONDITIONAL
SUBTTL	STARS - Job definition/separation line definitions


STARS::	POINT	7,STARS1		;LINE 1
	POINT	7,STARS2		;LINE 2
	POINT	7,STARS3		;LINE 3


;**;[2770]CHANGE 3 LINES AFTER STARS1:	15-FEB-83/CTK
STARS1:	ASCII	/000000000000000000000000000000000000000000000000000000000000/
	ASCII	/000000000000000000000000000000000000000111111111111111111111/
	ASCII	/111111111111/		;[2770]

STARS2:	ASCII	/000000000111111111122222222223333333333444444444455555555556/
	ASCII	/666666666777777777788888888889999999999000000000011111111112/
	ASCII	/222222222333/		;[2770]

STARS3:	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/123456789012/		;[2770]
LPTEND::PRGEND	LPTSPL
TITLE	LPTVFU - LP20 VFU and RAM Simulator for LPTSPL-10
SUBTTL	T. Litt/TL	30-Dec-85

;
;
;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1987.
;			ALL RIGHTS RESERVED.
;
;     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
	SEARCH	QSRMAC			;SEARCH QUASAR PARAMETERS
	SEARCH	ORNMAC			;SEARCH ORION/OPR PARAMETERS
	SEARCH	LPTMAC			;SEARCH LPTSPL PARAMETERS
	PROLOG	(LPTVFU)

IF2,<PRINTX Assembling GALAXY-10 LPTVFU>


	SALL				;FOR CLEAN LISTINGS
	.DIRECT	FLBLST			;FOR CLEANER LISTINGS

LPTVFU:	ENTRY	LPTVFU			;LOAD IF LIBRARY SEARCH
SUBTTL	VFUINX - VFU Simulator Initialization


; Device initialization.  This routine is called by the
; Device driver's initialization routine (xxxINX).  Ordinarily, 
; the driver can PJRST here instead of returning %RSUOK.
;
; Call:	MOVE	J, job data base address
;	MOVE	M, Page containing SETUP message or 0 if LPTSPL startup
;	PUSHJ	P,VFUINX
;
; TRUE return:	Initialization complete
; FALSE return:	Never

	ENTRY	VFUINX
VFUINX::JUMPE	M,.RETT			;RETURN IF LPTSPL INITIALIZATION
	SETOM	J$FFDF(J)		;VFU Simulator DOES FORM FEEDS
	SETOM	J$DC3F(J)		;VFU Simulator DOES DC3S
	SETOM	J$MNTF(J)		;VFU Simulator SUPPORTS MOUNTABLE FORMS
	MOVEI	S1,%RSUOK		;LOAD THE CODE
	$RETT				;RETURN
SUBTTL	VFUOPX - OPEN device

; This routine will setup device specific information for an OPEN.
; This routine is called by the Device Driver's xxxOPX routine to
; setup the VFU database for an OPEN.
;
; Call:	MOVE	J, job data base address
;	PUSHJ	P,VFUOPX
;
; TRUE return:	Always
; FALSE return:	Never

	ENTRY	VFUOPX
VFUOPX::MOVE	S1,[SIXBIT /LP64/]	;DEFAULT THE RAM TO 64 CHARACTERS
	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.
	SETOM	J$LDVF(J)		;OUR VFU IS ALWAYS LOADABLE
	SETOM	J$LDRM(J)		;AND SO IS OUR RAM
	$RETT
SUBTTL	VFUFVU - Load VFU

; This routine is called to load the VFU for a printer.
; 
; This routine is called by the Device Driver's xxxVFU routine.
; Ordinarily, the device driver routine consists only of a PJRST.
;
; Call:	MOVE	J, job data base address
;	MOVEI	S1,function
;	PUSHJ	P,VFUVFU
;
; TRUE return:	VFU loaded or no VFU needed, C/ LP20 START CODE OF LOADED VFU
; FALSE return:	VFU load failed, error code in S1

	ENTRY	VFUVFU
VFUVFU::JRST	@[IFIW	CHKVFU		;(0) CHECK VFU STATUS
		  IFIW	LODVFU		;(1) LOAD VFU
		  IFIW	.RETT](S1)	;(2) OUTPUT ERROR DURING LOAD

LODVFU:	HLLZS	J$VLIN(J)		;RELOADING VFU SETS IT TO LINE 0
	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	HDWVF0			;FILE NOT FOUND, TRY HARDWARE VFU
	MOVEM	S1,J$FVIF(J)		;ELSE,,SAVE THE IFN
	MOVEI	S1,V$$LEN		;SIZE OF A VFU
	SKIPE	S2,J$VVFU(J)		;ADDRESS
	 $CALL	M%RMEM			;GET RID OF IT
	SETZM	J$VVFU(J)
	MOVE	S1,J$FVIF(J)		;GET THE IFN
	MOVX	S2,FI.SIZ		;FILE SIZE
	$CALL	F%INFO
	CAILE	S1,<V$$LEN-V$DATA>*5	;BETTER FIT
	 JRST	HDWVFU			;OOPS.
	MOVX	S1,V$$LEN		;ALLOCATE FOR THE MAX
	$CALL	M%GMEM			;ALLOCATE SPACE FOR THE VFU
	MOVEM	S2,J$VVFU(J)		;REMEMBER IT
	MOVE	S1,STDVFU+V$PTR		;GET A STANDARD POINTER
	ADDI	S1,-<STDVFU>(S2)	;RELOCATE ADDRESS
	MOVEM	S1,V$PTR(S2)		;SAVE BYTE POINTER TO VFU
	PUSH	P,S1			;HM

VFU.4:	SOSGE	J$FBYT(J)		;CHECK AND SEE IF DATA IS IN BUFFER.
	 JRST	VFU.6			;IF NOT, GET NEXT BUFFER.
	ILDB	C,J$FPTR(J)		;PICK UP A BYTE.
	DPB	C,(P)			;SAVE A BYTE
	IBP	(P)
	JRST	VFU.4			;GO GET ANOTHER.

VFU.6:	MOVE	S1,J$FVIF(J)		;GET VFU IFN.
	PUSHJ	P,F%IBUF		;GET ANOTHER BUFFER.
	 JUMPF	VFU.5			;IF NO MORE,,RETURN
	MOVEM	S1,J$FBYT(J)		;SAVE THE BYTE COUNT
	MOVEM	S2,J$FPTR(J)		;SAVE THE BYTE POINTER.
	JRST	VFU.4			;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
	;HERE IF VFU FILE IS NOT AROUND, TRY TO RECOVER BY LOADING THE
	;HARDWARE VFU
HDWVFU:	MOVE	S1,J$FVIF(J)		;GET IFN OF VFU FILE
	PUSHJ	P,F%REL			;RELEASE FILE

HDWVF0:	MOVEI	S1,V$$LEN		;SIZE OF A VFU
	SKIPE	S2,J$VVFU(J)		;ADDRESS
	 $CALL	M%RMEM			;GET RID OF IT
	SETZM	J$VVFU(J)
	MOVE	T1,J$FTAP(J)		;TYPE WE TRIED TO LOAD
	 CAMN	T1,D$TAPE##		;IS IT THE DEFAULT
VFUHVL:	TDZA	S1,S1			;HARDWARE VFU LOADED INSTEAD
VFUFAI:	 MOVEI	S1,1			;VFU LOAD FAILED
	$RETF
VFU.5:	ADJSP	P,-1			;BYE (TE) POINTER

	;CHECK FOR VALID STOP CODE AND LENGTH??

	MOVE	T1,J$VVFU(J)		;GET ADDRESS OF OUR NEW VFU
	LDB	C,V$PTR(T1)		;FETCH THE FIRST BYTE
	CAIN	C,25			;IF SIMPLE START
	 MOVEI	C,356			;CONVERT TO LP20 SIMPLE START
	CAIN	C,356			;IF SIMPLE START
	 JRST	VFU.5A			;IT'S VALID
	
	CAIN	C,26			;6-LPI START?
	 MOVEI	C,354			;YES, MAKE LP20
	CAIN	C,27			;8-LPI START?
	 MOVEI	C,355			;YES, MAKE LP20

	 CAIE	C,354			;6-LPI?
	CAIN	C,355			;8-LPI?
	 CAIA				;VALID START CODE
	PJRST	HDWVFU			;INVALID START CODE

VFU.5A:	MOVE	S1,J$FVIF(J)		;GET VFU'S IFN
	$CALL	F%REL			;RELEASE THE FILE
	$RETT				;OK,,JUST RETURN

CHKVFU:	SKIPN	J$VVFU(J)		;IS VFU LOADED?
	 $RETF				;NO
	$RETT				;YES
SUBTTL	VFURAM - Load RAM


; This routine is called to load the character translation
; RAM for a printer.  This routine is called from the 
; Device driver's xxxRAM routine, which ordinarily consists only
; of a PJRST.

;
; Call:	MOVE	J, job data base address
;	PUSHJ	P,VFURAM
;
; TRUE return:	RAM loaded or no RAM needed
; FALSE return:	RAM load failed

	ENTRY	VFURAM
VFURAM::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
	SETO	T2,			;FLAG FOR RAM.2 SAYING "FAILED"
	LOOKUP	17,RLKUP		;FIND THE FILE WE WANT
	  JRST	RAM.2			;NOT THERE,,TRY SOMETHING ELSE
	MOVEI	S1,R$$LEN		;SIZE OF A RAM
	SKIPE	S2,J$VRAM(J)		;ADDRESS
	 $CALL	M%RMEM			;GET RID OF IT
	SETZM	J$VRAM(J)
	HLRO	T3,RLKUP+3		;GET -FILE LENGTH
	MOVMS	T3			;WANT POSITIVE LENGTH
	SETOM	T1,			;IF FAIL, WE NEED OPR ACTION
	CAILE	T3,R$$LEN		;BETTER FIT
	 JRST	RAM.2			;OOPS.
	MOVEI	S1,R$$LEN		;ALLOCATE FOR THE MAX
	$CALL	M%GMEM			;ALLOCATE SPACE FOR THE RAM
	MOVEM	S2,J$VRAM(J)		;REMEMBER IT
	MOVE	S1,LP64RM+R$PTR		;GET A STANDARD POINTER
	ADDI	S1,-<LP64RM>(S2)	;RELOCATE ADDRESS
	MOVEM	S1,R$PTR(S2)		;SETUP POINTER
	MOVEI	T1,R$DATA-1(S2)		;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
	TDZA	S2,S2			;CONTINUE ON SUCCESSFUL RETURN

RAM.1:	  SETOM	S2			;INDICATE RAM LOAD ERROR
	MOVE	T1,S2			;SAVE THE RAM LOAD FLAG
	JUMPE	S2,RAM.2		;JUMP IF LOADED OK
	MOVEI	S1,R$$LEN		;SIZE OF BUFFER
	SETZ	S2,			;IT'S (TO BE) GONE
	EXCH	S2,J$VRAM(J)		;BYE
	$CALL	M%RMEM			;DEALLOCATE BUFFER
	SETZM	J$VRAM(J)
	PUSHJ	P,RAM.2			;DEASSIGN THE STUFF
	SETZ	S1,			;RAM LOAD FAILED, HDW RAM LOADED
	$RETF

RAM.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
	$RETT				;AND RETURN

NORAM:	MOVEI	S1,1			;RAM LOAD FAILED, OPR ACTION
	$RETF

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

RLKUP:	BLOCK	4			;LOOKUP BLOCK
SUBTTL	VFUOER - Output error processing


; This routine provides for driver or device-specific I/O error
; processing.  This routine is called by a device driver's xxxOER entry, 
; which may consist solely of a PJRST.  
;
; Call:	MOVE	S1,J$LIOS(J)	;Justed updated with physical GETSTS
;	MOVE	S2,J$XIOS(J)	;Just updated with physical DEVOP.
;	PUSHJ	P,VFUOER
;

	ENTRY	VFUOER
VFUOER::MOVX	S1,VF.UDC		;UNDEFINED CHARACTER PENDING?
	TDNN	S1,J$VFLG(J)		; ...
	 JRST	VFUOE1			;NO - PROCEED NORMALLY
	ANDCAM	S1,J$VFLG(J)		;WELL, WE ARE HANDLING IT NOW
	PUSHJ	P,SETUDC		;SETUP FOR ERROR
	JRST	VFUOE2			;ONLY HANDLE ONE AT A TIME

VFUOE1:	MOVX	S1,VF.PCZ		;PAGE COUNTER INTERRUPT?
	TDNN	S1,J$VFLG(J)		; ...
	 JRST	VFUOE2			;NO - PROCEED NORMALLY
	ANDCAM	S1,J$VFLG(J)		;HANDLING IT NOW
	PUSHJ	P,SETPLE		;SETUP FOR ERROR

VFUOE2:	MOVE	S1,J$LIOS(J)		;GET THE NEW IOS FOR CALLER
	MOVE	S2,J$XIOS(J)		;AND THE XIOS
	PJRST	LPTOER##		;[4071] GO TO GENERIC ERROR ROUTINE

SETUDC:	SKIPA	S1,[IOUNC%]		;THE DEVOP. ERROR
SETPLE:	 MOVX	S1,IOPLE%		;THE DEVOP. ERROR
SETDVP:	MOVEM	S1,J$XIOS(J)		;A PSEUDO-DEVOP. ERROR
	MOVX	S1,IO.ERR		;SET ALL THE ERROR BITS
	IORM	S1,J$LIOS(J)		;FOR LPFOOL TO SEE LATER
	POPJ	P,
SUBTTL	VFUSHT - Stream shutdown


; This routine is called when a stream is shutdown, just
; prior to releasing the job data page.  This routine is called by device 
; driver's xxxSHT entry point.
;
; Call:	MOVE	J, job data base address
;	PUSHJ	P,VFUSHT
;
; TRUE return:	Always
; FALSE return:	Never

	ENTRY	VFUSHT
VFUSHT::MOVEI	S1,V$$LEN		;SIZE OF A VFU
	SKIPE	S2,J$VVFU(J)		;ADDRESS
	 $CALL	M%RMEM			;GET RID OF IT
	SETZM	J$VVFU(J)
	MOVEI	S1,R$$LEN		;SIZE OF A RAM
	SKIPE	S2,J$VRAM(J)		;ADDRESS
	 $CALL	M%RMEM			;GET RID OF IT
	SETZM	J$VRAM(J)
	$RETT				;RETURN
SUBTTL	VFUCHO - Character translator


; This routine will handle character translation.  Called when a character
; is about to be sent to what everyone else thinks is the physical device.
; It simulates a hardware translation RAM, activating the imaginary VFU 
; as necessary.  Called by the device driver's xxxCHO routine, which may
; simply PJRST here.
;
; Call:	MOVE	J, job data base address
;	MOVE	C, intercepted character
;	PUSHJ	P,VFUCHO
; TRUE return:	Character translated if necessary, caller to output
; FALSE return:	Character processed here, nothing to output

	ENTRY	VFUCHO
VFUCHO::PUSHJ	P,.SAVET		;SAFER THAN SORRY

	SKIPN	T2,J$VRAM(J)		;GET ADDRESS OF SIMULATED RAM
	 MOVEI	T2,LP64RM		;NONE, USE LP64.RAM

	MOVE	T1,C			;GET THE CHARACTER TO BE OUTPUT
	ADJBP	T1,R$PTR(T2)		;INDEX INTO THE RAM
	LDB	T1,T1			;GET THE RAM ENTRY FOR THIS CHAR

	;HERE, DEAL WITH THE "DELIMITER" AND "DELIMITER HOLD" STUFF
	MOVE	S1,J$VFLG(J)		;GET SIMULATION FLAGS
	TXZE	S1,VF.DLH		;IS DELIMITER/HOLD SET FROM LAST CHAR?
	 TXO	T1,RD.DLH		;YES, FORCE TRANSLATE WITH FAKE BIT
	TXNE	T1,RD.DEL		;IS DELIMITER SET FOR THIS CHAR?
	 TXO	S1,VF.DLH		;YES, SET DELIMITER/HOLD FOR NEXT CHAR
	MOVEM	S1,J$VFLG(J)		;SAVE SIMULATION FLAGS

	;NEXT, TRY TO DEAL SIMPLY WITH ORDINARY DATA
	TXNE	T1,RD.INT!RD.PMC	;SPECIAL CONDITION?
	 JRST	VFUCH2			;YES, HANDLE SLOWLY
	TXNE	T1,RD.XLT!RD.DEL!RD.DLH	;NO, TRANSLATE ?
VFUR2P:	 LDB	C,[POINTR T1,RD.DAT]	; SIMPLE TRANSLATION, DO SO
	$RETT				;RETURN
	;HERE WITH AN UNUSUAL RAM CONDITION
VFUCH2:	TXNN	T1,RD.INT		;INTERRUPT?
	 JRST	VFUCH3			;NO

	;INTERRUPT IF NO TRANSLATE, OR (TRANSLATE AND DELIM/HOLD)
	TXNE	T1,RD.XLT		;IS TRANSLATE SET?
	 TXNE	T1,RD.DLH		;YES, INTERRUPT ONLY IF DELIM/HOLD
	JRST	VFUCHI			;GENERATE INTERRUPT

	TXNE	T1,RD.DEL		;IF DELIMITER IS SET
	 JRST	VFUCHI			; GENERATE INTERRUPT

	;INTERRUPT BIT IS SET, BUT WE DON'T INTERRUPT.  PRINT OR MOVE.
	TXNE	T1,RD.PMC		;PAPER MOTION?
	 JRST	VFUVFC			;YES, DATA GOES TO VFU
	JRST	VFUR2P			;RAM (XLATED CHAR) TO PRINTER

	;HERE TO GENERATE AN INTERRUPT
VFUCHI:	LDB	S1,[POINTR T1,RD.DAT]	;GET TRANSLATION OF CHARACTER
	HRL	C,S1			;SAVE THAT FOR INTERRUPT ROUTINE
	CAIE	S1,^O136		;IS IT THE MAGIC CODE -20F DOES?
	 JRST	[PUSHJ	P,SETUDC	; MAKE STATUS "UNDEFINED CHAR"
		 MOVX	S1,VF.UDC	; REMEMBER UDC ERROR PENDING
		 IORM	S1,J$VFLG(J)	; FOR ERROR HANDLING
		 $RETF]			; DON'T OUTPUT ANYTHING
	PUSH	P,C			;SAVE THE ACTUAL CHARACTER
	MOVEI	C,"^"			;GET AN UP-ARROW
	PUSHJ	P,DEVOUT##		;PRINT THAT
	POP	P,C			;RESTORE ORIGINAL CHAR
	TRO	C,100			;MAKE IT A PRINTING CHARACTER
	ANDI	C,177			;GET RID OF ANY GARBAGE BITS
	$RETT				;LET DRIVER OUTPUT IT
	;INTERRUPT IS NOT SET
VFUCH3:
;	TXNN	T1,RD.PMC		;PAPER MOTION COMMAND?
;	 HALT	.			;???
	TXNE	T1,RD.DEL!RD.XLT!RD.DLH	;PAPER MOTION ONLY IF TRANSLATE 
	 JRST	VFUVFC			;PAPER MOTION COMMAND, GIVE TO DAVFU
	$RETT				;NO TRANSLATE, JUST PRINT IT

	;HERE TO PASS DATA TO THE VFU
VFUVFC:	MOVEI	C,.CHCRT		;ALL COMMANDS MUST FLUSH BUFFER
	PUSHJ	P,PHSOUT##		;AND RESET COLUMN COUNTER...
	LDB	C,[POINTR T1,RD.DAT]	;GET TRANSLATION OF CHAR
	TXNN	C,RD.SKP		;SKIP OR SLEW?
	 JRST	VFUCHS			;CHANNEL SKIP
	ANDI	C,RD.SKC		;SLEW, GET NUMBER OF LINES
	PUSH	P,C			;SAVE THAT
VFUSL1:	SOSGE	(P)			;SKIP IF MORE TO SLEW
	 JRST	VFUSL2			;DONE, CHARACTER PROCESSED
	MOVEI	C,.CHLFD		;CHARACTER TO SLEW WITH
	PUSHJ	P,PHSOUT##		;PRINT THAT
	PUSHJ	P,VFULIN		;ADVANCE VFU AND TEST PAGE COUNTER
	JRST VFUSL1			;CONTINUE

VFUSL2:	ADJSP	P,-1			;TOSS CONTROL COUNT
	$RETF				;SLEW COMPLETE - NO CALLER OUTPUT

	;HERE TO PERFORM A CHANNEL SKIP
VFUCHS:	ANDI	C,RD.SKC		;GET CHANNEL NUMBER TO SKIP TO
	CAILE	C,^D12-1		;MAKE SURE IT'S LEGAL
	 MOVEI	C,^D8-1			;CHANNEL GT TAPE CHN 12, USE CHANNEL 8
	MOVE	C,VFUBIT(C)		;CONVERT TO VFU BIT
	PUSH	P,C			;SAVE BIT FOR DESTINATION CHANNEL
VFUSK1:	MOVEI	C,.CHLFD		;CHARACTER TO SKIP WITH
	PUSHJ	P,PHSOUT##		;ADVANCE ONE LINE
	PUSHJ	P,VFULIN		;ADVANCE AND GET VFU DATA FOR NEW LINE
	TDNN	T1,(P)			;SEE IF DESIRED HOLE IS PUNCHED
	 JRST	VFUSK1			;IT IS NOT, SKIP ANOTHER LINE

	ADJSP	P,-1			;TOSS DESTINATION CHANNEL
	$RETF				;CHANNEL SKIP COMPLETE - NO CALLER OUTPUT
SUBTTL	VFULIN - ADVANCE VFU AND RETURN DATA

	;SUBROUTINE TO ADVANCE A LINE AND RETURN VFU DATA FOR NEW LINE
	;ACCOUNTS FOR PAGE COUNTER
	;TRASHES T1, T2, RETURNS VFU DATA IN T1
VFULIN:	AOS	T1,J$VLIN(J)		;ADVANCE TO NEXT LINE
	TLZ	T1,-1			;REMOVE PAGE COUNTER
	ASH	T1,1			;THERE ARE 2 NIBBLES/VFU LINE
	SKIPN	T2,J$VVFU(J)		;GET ADDRESS OF SIMULATED VFU
	 MOVEI	T2,STDVFU		;NONE, USE STANDARD VFU
	ADJBP	T1,V$PTR(T2)		;POINT TO THE FIRST
VFULN2:	ILDB	S1,T1			;GET THE FIRST NIBBLE
	CAIN	S1,126			;AN OLD STOP BYTE?
	 MOVEI	S1,357			;YES, CONVERT TO LP20 FORMAT
	CAIN	S1,357			;NOW SEE IF LP20 STOP BYTE
	 JRST	[HLLZS	J$VLIN(J)	;YES - BACK TO LINE ZERO
		 MOVE	T1,V$PTR(T2)	;RESET VFU DATA POINTER
		 JRST	VFULN2]		;AND TRY AGAIN
	ILDB	T1,T1			;GET THE SECOND
	LSH	T1,^D8			;THE SECOND NIBBLE HAS THE HIGH 6 CHNS
	IOR	T1,S1			;THE FIRST HAD THE LOW 6 CHANNELS
	 SKIPGE	S1,J$VLIN(J)		;PAGE COUNTER ENABLED?
	TDNN	T1,VFUBIT+^D1-1		;IF HIT TOP OF FORM (CHANNEL 1)
	 POPJ	P,			;NOT ENABLED OR NOT TOF, RETURN
	LDB	S1,[POINT 17,S1,17]	;AT TOF, GET PAGE COUNTER VALUE
;	ANDI	S1,7777			;LP20 IS 12 BIT COUNTER, MONITOR IS 36
	SOS	S1			;DECREMENT THE PAGE COUNTER
	DPB	S1,[POINT 17,J$VLIN(J),17] ;STORE NEW VALUE
	SKIPE	S1			;PAGE COUNTER = ZERO?
	 POPJ	P,			;NO, MORE TO GO
	MOVX	S1,VF.PCZ		;YES, PAGE COUNTER IS ZERO
	IORM	S1,J$VFLG(J)		;REMEMBER THE ERROR
	PJRST	SETPLE			;SET PAGE LIMIT EXCEEDED AND RETURN
SUBTTL	LP64.RAM

	;RAM Data is 12 bits wide.  Courtesy of the strange behavior
	;of PDP-11s, DTEs, and such, the .RAM file has 12 bits / 1/2 word.
	;Each data byte corresponds to one character code:
	RD.DLH==10000			;DELIM/HOLD (FAKE BIT)
	RD.INT==4000			;INTERRUPT
	RD.DEL==2000			;DELIMITER
	RD.XLT==1000			;TRANSLATE
	RD.PMC==0400			;PAPER MOTION COMMAND
	RD.DAT==0377			;CHARACTER DATA
		RD.SKP==20		;;VFU - SKIP 0-15 LINES
		RD.SKC==17		;;VFU - SKIP COUNT OR CHANNEL #

LP64RM:	PHASE	0
R$PTR:!	POINT	18,LP64RM+R$DATA,17	;BYTE POINTER TO RAM DATA
R$DATA:!				;DATA FOR LP64.RAM
	XLIST			;YOU REALLY DON'T WANT TO KNOW...
	OCT	001000004136		;CHARACTER CODES 0 & 1
	OCT	004136004136		;CHARACTER CODES 2 & 3
	OCT	004136004136		;CHARACTER CODES 4 & 5
	OCT	004136004136		;CHARACTER CODES 6 & 7
	OCT	004136001011		;CHARACTER CODES 10 & 11
	OCT	001407001406		;CHARACTER CODES 12 & 13
	OCT	001400001420		;CHARACTER CODES 14 & 15
	OCT	004136004136		;CHARACTER CODES 16 & 17
	OCT	001401001402		;CHARACTER CODES 20 & 21
	OCT	001403001404		;CHARACTER CODES 22 & 23
	OCT	001405004136		;CHARACTER CODES 24 & 25
	OCT	004136004136		;CHARACTER CODES 26 & 27
	OCT	004136004136		;CHARACTER CODES 30 & 31
	OCT	004136001044		;CHARACTER CODES 32 & 33
	OCT	004136004136		;CHARACTER CODES 34 & 35
	OCT	004136004136		;CHARACTER CODES 36 & 37
	OCT	001040001041		;CHARACTER CODES 40 & 41
	OCT	001042001043		;CHARACTER CODES 42 & 43
	OCT	001044001045		;CHARACTER CODES 44 & 45
	OCT	001046001047		;CHARACTER CODES 46 & 47
	OCT	001050001051		;CHARACTER CODES 50 & 51
	OCT	001052001053		;CHARACTER CODES 52 & 53
	OCT	001054001055		;CHARACTER CODES 54 & 55
	OCT	001056001057		;CHARACTER CODES 56 & 57
	OCT	001060001061		;CHARACTER CODES 60 & 61
	OCT	001062001063		;CHARACTER CODES 62 & 63
	OCT	001064001065		;CHARACTER CODES 64 & 65
	OCT	001066001067		;CHARACTER CODES 66 & 67
	OCT	001070001071		;CHARACTER CODES 70 & 71
	OCT	001072001073		;CHARACTER CODES 72 & 73
	OCT	001074001075		;CHARACTER CODES 74 & 75
	OCT	001076001077		;CHARACTER CODES 76 & 77
	OCT	001100001101		;CHARACTER CODES 100 & 101
	OCT	001102001103		;CHARACTER CODES 102 & 103
	OCT	001104001105		;CHARACTER CODES 104 & 105
	OCT	001106001107		;CHARACTER CODES 106 & 107
	OCT	001110001111		;CHARACTER CODES 110 & 111
	OCT	001112001113		;CHARACTER CODES 112 & 113
	OCT	001114001115		;CHARACTER CODES 114 & 115
	OCT	001116001117		;CHARACTER CODES 116 & 117
	OCT	001120001121		;CHARACTER CODES 120 & 121
	OCT	001122001123		;CHARACTER CODES 122 & 123
	OCT	001124001125		;CHARACTER CODES 124 & 125
	OCT	001126001127		;CHARACTER CODES 126 & 127
	OCT	001130001131		;CHARACTER CODES 130 & 131
	OCT	001132001133		;CHARACTER CODES 132 & 133
	OCT	001134001135		;CHARACTER CODES 134 & 135
	OCT	001136001137		;CHARACTER CODES 136 & 137
	OCT	001100001101		;CHARACTER CODES 140 & 141
	OCT	001102001103		;CHARACTER CODES 142 & 143
	OCT	001104001105		;CHARACTER CODES 144 & 145
	OCT	001106001107		;CHARACTER CODES 146 & 147
	OCT	001110001111		;CHARACTER CODES 150 & 151
	OCT	001112001113		;CHARACTER CODES 152 & 153
	OCT	001114001115		;CHARACTER CODES 154 & 155
	OCT	001116001117		;CHARACTER CODES 156 & 157
	OCT	001120001121		;CHARACTER CODES 160 & 161
	OCT	001122001123		;CHARACTER CODES 162 & 163
	OCT	001124001125		;CHARACTER CODES 164 & 165
	OCT	001126001127		;CHARACTER CODES 166 & 167
	OCT	001130001131		;CHARACTER CODES 170 & 171
	OCT	001132001133		;CHARACTER CODES 172 & 173
	OCT	001134001135		;CHARACTER CODES 174 & 175
	OCT	001136001000		;CHARACTER CODES 176 & 177
	OCT	001000004136		;CHARACTER CODES 200 & 201
	OCT	004136004136		;CHARACTER CODES 202 & 203
	OCT	004136004136		;CHARACTER CODES 204 & 205
	OCT	004136004136		;CHARACTER CODES 206 & 207
	OCT	004136001011		;CHARACTER CODES 210 & 211
	OCT	001407001406		;CHARACTER CODES 212 & 213
	OCT	001400001420		;CHARACTER CODES 214 & 215
	OCT	004136004136		;CHARACTER CODES 216 & 217
	OCT	001401001402		;CHARACTER CODES 220 & 221
	OCT	001403001404		;CHARACTER CODES 222 & 223
	OCT	001405004136		;CHARACTER CODES 224 & 225
	OCT	004136004136		;CHARACTER CODES 226 & 227
	OCT	004136004136		;CHARACTER CODES 230 & 231
	OCT	004136001044		;CHARACTER CODES 232 & 233
	OCT	004136004136		;CHARACTER CODES 234 & 235
	OCT	004136004136		;CHARACTER CODES 236 & 237
	OCT	001040001041		;CHARACTER CODES 240 & 241
	OCT	001042001043		;CHARACTER CODES 242 & 243
	OCT	001044001045		;CHARACTER CODES 244 & 245
	OCT	001046001047		;CHARACTER CODES 246 & 247
	OCT	001050001051		;CHARACTER CODES 250 & 251
	OCT	001052001053		;CHARACTER CODES 252 & 253
	OCT	001054001055		;CHARACTER CODES 254 & 255
	OCT	001056001057		;CHARACTER CODES 256 & 257
	OCT	001060001061		;CHARACTER CODES 260 & 261
	OCT	001062001063		;CHARACTER CODES 262 & 263
	OCT	001064001065		;CHARACTER CODES 264 & 265
	OCT	001066001067		;CHARACTER CODES 266 & 267
	OCT	001070001071		;CHARACTER CODES 270 & 271
	OCT	001072001073		;CHARACTER CODES 272 & 273
	OCT	001074001075		;CHARACTER CODES 274 & 275
	OCT	001076001077		;CHARACTER CODES 276 & 277
	OCT	001100001101		;CHARACTER CODES 300 & 301
	OCT	001102001103		;CHARACTER CODES 302 & 303
	OCT	001104001105		;CHARACTER CODES 304 & 305
	OCT	001106001107		;CHARACTER CODES 306 & 307
	OCT	001110001111		;CHARACTER CODES 310 & 311
	OCT	001112001113		;CHARACTER CODES 312 & 313
	OCT	001114001115		;CHARACTER CODES 314 & 315
	OCT	001116001117		;CHARACTER CODES 316 & 317
	OCT	001120001121		;CHARACTER CODES 320 & 321
	OCT	001122001123		;CHARACTER CODES 322 & 323
	OCT	001124001125		;CHARACTER CODES 324 & 325
	OCT	001126001127		;CHARACTER CODES 326 & 327
	OCT	001130001131		;CHARACTER CODES 330 & 331
	OCT	001132001133		;CHARACTER CODES 332 & 333
	OCT	001134001135		;CHARACTER CODES 334 & 335
	OCT	001136001137		;CHARACTER CODES 336 & 337
	OCT	001100001101		;CHARACTER CODES 340 & 341
	OCT	001102001103		;CHARACTER CODES 342 & 343
	OCT	001104001105		;CHARACTER CODES 344 & 345
	OCT	001106001107		;CHARACTER CODES 346 & 347
	OCT	001110001111		;CHARACTER CODES 350 & 351
	OCT	001112001113		;CHARACTER CODES 352 & 353
	OCT	001114001115		;CHARACTER CODES 354 & 355
	OCT	001116001117		;CHARACTER CODES 356 & 357
	OCT	001120001121		;CHARACTER CODES 360 & 361
	OCT	001122001123		;CHARACTER CODES 362 & 363
	OCT	001124001125		;CHARACTER CODES 364 & 365
	OCT	001126001127		;CHARACTER CODES 366 & 367
	OCT	001130001131		;CHARACTER CODES 370 & 371
	OCT	001132001133		;CHARACTER CODES 372 & 373
	OCT	001134001135		;CHARACTER CODES 374 & 375
	OCT	001136001000		;CHARACTER CODES 376 & 377
	LIST

R$$LEN:!
	DEPHASE
SUBTTL	NORMAL.VFU

VFUBIT:	EXP	00001			;TAPE CHANNEL 1, OUR 0
	EXP	00002
	EXP	00004
	EXP	00010
	EXP	00020
	EXP	00040
	EXP	00400			;TAPE CHANNEL 7, OUR 6
	EXP	01000
	EXP	02000
	EXP	04000
	EXP	10000
	EXP	20000			;TAPE CHANNEL 12, OUR 11

STDVFU:	PHASE	0
V$PTR:!	POINT	7,STDVFU+V$DATA,6	;POINT TO BEFORE FIRST VFU DATA NIBBLE
V$DATA:!			;DATA FOR NORMAL.VFU
	XLIST			;YOU REALLY DON'T WANT TO KNOW
	OCT	125760310004		;START, LINE 1A,1B, 2A,2B
	OCT	120043001050		;LINE 3A, 3B, 4A, 4B, 5A
	OCT	010400216004		;LINE 5B, 6A, 6B, 7A, 7B
	OCT	100042401060		;LINE 8A, 8B, 9A, 9B, 10A
	OCT	011500210004		;LINE 10B, 11A, 11B, 12A, 12B
	OCT	160042001050		;LINE 13A, 13B, 14A, 14B, 15A
	OCT	010600212004		;LINE 15B, 16A, 16B, 17A, 17B
	OCT	100043401040		;LINE 18A, 18B, 19A, 19B, 20A
	OCT	011500314004		;LINE 20B, 21A, 21B, 22A, 22B
	OCT	120042001070		;LINE 23A, 23B, 24A, 24B, 25A
	OCT	010400212004		;LINE 25B, 26A, 26B, 27A, 27B
	OCT	140042401040		;LINE 28A, 28B, 29A, 29B, 30A
	OCT	011740210004		;LINE 30B, 31A, 31B, 32A, 32B
	OCT	120043001050		;LINE 33A, 33B, 34A, 34B, 35A
	OCT	010400216004		;LINE 35B, 36A, 36B, 37A, 37B
	OCT	100042401060		;LINE 38A, 38B, 39A, 39B, 40A
	OCT	011500310004		;LINE 40B, 41A, 41B, 42A, 42B
	OCT	160042001050		;LINE 43A, 43B, 44A, 44B, 45A
	OCT	010600212004		;LINE 45B, 46A, 46B, 47A, 47B
	OCT	100043401040		;LINE 48A, 48B, 49A, 49B, 50A
	OCT	011500214004		;LINE 50B, 51A, 51B, 52A, 52B
	OCT	120042001070		;LINE 53A, 53B, 54A, 54B, 55A
	OCT	010400212004		;LINE 55B, 56A, 56B, 57A, 57B
	OCT	140042401040		;LINE 58A, 58B, 59A, 59B, 60A
	OCT	010400010000		;LINE 60B, 61A, 61B, 62A, 62B
	OCT	100002000040		;LINE 63A, 63B, 64A, 64B, 65A
	OCT	000400053000		;LINE 65B, 66A, 66B, STOP, 67A
	OCT	000000000000		;LINE 67B, 68A, 68B, 69A, 69B
	OCT	000000000000		;LINE 70A, 70B, 71A, 71B, 72A
	OCT	000000000000		;LINE 72B, 73A, 73B, 74A, 74B
	OCT	000000000000		;LINE 75A, 75B, 76A, 76B, 77A
	OCT	000000000000		;LINE 77B, 78A, 78B, 79A, 79B
	OCT	000000000000		;LINE 80A, 80B, 81A, 81B, 82A
	OCT	000000000000		;LINE 82B, 83A, 83B, 84A, 84B
	OCT	000000000000		;LINE 85A, 85B, 86A, 86B, 87A
	OCT	000000000000		;LINE 87B, 88A, 88B, 89A, 89B
	OCT	000000000000		;LINE 90A, 90B, 91A, 91B, 92A
	OCT	000000000000		;LINE 92B, 93A, 93B, 94A, 94B
	OCT	000000000000		;LINE 95A, 95B, 96A, 96B, 97A
	OCT	000000000000		;LINE 97B, 98A, 98B, 99A, 99B
	OCT	000000000000		;LINE 100A, 100B, 101A, 101B, 102A
	OCT	000000000000		;LINE 102B, 103A, 103B, 104A, 104B
	OCT	000000000000		;LINE 105A, 105B, 106A, 106B, 107A
	OCT	000000000000		;LINE 107B, 108A, 108B, 109A, 109B
	OCT	000000000000		;LINE 110A, 110B, 111A, 111B, 112A
	OCT	000000000000		;LINE 112B, 113A, 113B, 114A, 114B
	OCT	000000000000		;LINE 115A, 115B, 116A, 116B, 117A
	OCT	000000000000		;LINE 117B, 118A, 118B, 119A, 119B
	OCT	000000000000		;LINE 120A, 120B, 121A, 121B, 122A
	OCT	000000000000		;LINE 122B, 123A, 123B, 124A, 124B
	OCT	000000000000		;LINE 125A, 125B, 126A, 126B, 127A
	OCT	000000000000		;LINE 127B, 128A, 128B, 129A, 129B
	OCT	000000000000		;LINE 130A, 130B, 131A, 131B, 132A
	OCT	000000000000		;LINE 132B, 133A, 133B, 134A, 134B
	OCT	000000000000		;LINE 135A, 135B, 136A, 136B, 137A
	OCT	000000000000		;LINE 137B, 138A, 138B, 139A, 139B
	OCT	000000000000		;LINE 140A, 140B, 141A, 141B, 142A
	OCT	000000000000		;LINE 142B, 143A, 143B

V$$LEN:!		;LENGTH OF LONGEST POSSIBLE VFU
	DEPHASE
SUBTTL	Literal pool


VFULIT:	LIT

VFUEND::!END