Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - galaxy-sources/lptsub.mac
There are 8 other files named lptsub.mac in the archive. Click here to see a list.
	TITLE	LPTSUB - Subroutines for LPTSPL/LPTCLU/LPTDQS
	
	SUBTTL	Preliminaries		
	.DIRECTIVE FLBLST

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 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 THAT IS NOT SUPPLIED BY DIGITAL.



	SEARCH	GLXMAC			;Search GLXLIB's symbols
	SEARCH	LPTMAC			;Search LPTSPL's symbols
	SEARCH	QSRMAC			;Search QUASAR's symbols
	SEARCH	ORNMAC			;Search ORION's symbols
IFN FTACNT,<
	SEARCH	ACTSYM			;Search for accounting symbols
>
	SEARCH	MACSYM			;[7]Search monitor's macros

	SALL				;Suppress macro expansion
	RELOC				;Relocatable code follows

	PROLOGUE(LPTSUB)		;Generate the necessary symbols


	LSBMAN==:0			;Maintenance edit number
	LSBDEV==:7			;Development edit number
	VERSIN (LSB)			;Generate edit number
	Subttl	Table of Contents

;		     Table of Contents for LPTSUB
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   3
;    2. Global Symbols . . . . . . . . . . . . . . . . . . . .   4
;    3. Storage  . . . . . . . . . . . . . . . . . . . . . . .   5
;    4. Read Print File
;        4.1    INPOPN - Routine to open the input file  . . .   6
;        4.2    INPBUF - Read a buffer from the input file . .   8
;        4.3    INPBYT - Read a byte from the input file . . .   9
;        4.4    INPERR - Handle an input failure . . . . . . .  10
;        4.5    INPFEF - Force end-of-file on next input . . .  11
;        4.6    INPREW - Rewind the input file . . . . . . . .  12
;        4.7    INPCLS - Close the input file  . . . . . . . .  13
;    5. DECnet Connections
;        5.1    GETLNK - Get DECnet JFN  . . . . . . . . . . .  14
;        5.2    FNDCER - Find DECnet Error . . . . . . . . . .  15
;        5.3    DNERR - DECnet Disconnect Codes  . . . . . . .  16
;        5.4    ABTLNK - Close DECnet Link . . . . . . . . . .  17
;    6. DECnet Inactivity
;        6.1    SETIM - Set the DECnet inactivity timer  . . .  18
;        6.2    PROTIM - DECnet Inactivity Timer Processor . .  19
;        6.3    CLRTIM - Clear the DECnet inactivity timer . .  20
;    7. Logging Routines
;        7.1    Common Messages  . . . . . . . . . . . . . . .  21
;        7.2    LOGCHR - Type a character in the log file  . .  22
;        7.3    LOGBUF - Get a buffer page for LOG . . . . . .  23
;    8. Forms Routines
;        8.1    Format of LPFORM.INI . . . . . . . . . . . . .  24
;        8.2    Default Forms Switches . . . . . . . . . . . .  25
;        8.3    FORMS - Setup Forms For A Job  . . . . . . . .  26
;        8.4    Read LPFORM.INI  . . . . . . . . . . . . . . .  30
;        8.5    Forms Switch Subroutines . . . . . . . . . . .  33
;        8.6    I/O Subroutines for LPFORM.INI . . . . . . . .  37
;        8.7    OPNFRM - Routine to open LPFORM.INI  . . . . .  39
;    9. VFU/RAM Routines
;        9.1    LODVFU - Load the Vertical Forms Unit  . . . .  40
;        9.2    NOVFU - VFU File Not Found . . . . . . . . . .  41
;        9.3    LODRAM - Load The Translation RAM  . . . . . .  42
;        9.4    NORAM - Process RAM Loading Errors . . . . . .  43
;   10. Accounting
;       10.1    ACTBEG - Accounting Initialization Routine . .  44
;       10.2    ACTEND - Accounting Summary Routine  . . . . .  45
;       10.3    ACTLST - Spooler Accounting Record . . . . . .  46
;   11. End of LPTSUB  . . . . . . . . . . . . . . . . . . . .  48
	SUBTTL	Revision history

COMMENT \

*****  Release 6.0 -- begin development edits  *****

1	6.1036		21-Oct-87
	Add LPTSUB as the subroutine module for LPTSPL/LPTCLU/LPTDQS.

2	6.1063		8-Nov-87
	Add a new entry point to routine GETLNK to indicate the call is
for a Cluster LPTSPL so as to be able to open the DECnet link with 36
bit bytes.

3	6.1064		8-Nov-87
	Last edit broke LPTDQS.

4	6.1071		9-Nov-87
	Move logging routines, forms routines, and other routines here
since they are called by LPTDQS as well as LPTSPL.  The routines added
are LOGCHR, FORMS, LSTAF, LFINF, LODVFU, LODRAM, INPOPN, INPBUF,
INPBYT, INPERR, INPFEF, INPREW, INPCLS ACTBEG, and ACTEND along with
other symbols needed for this change to work

5	6.1153		30-Dec-87
	In routine FRMIN4: check for 'LAT' as a valid indicator in LPFORM.INI.

6	6.1225		8-Mar-88
	Update copyright notice.

7	6.1255		13-May-88
	When displaying information about print requests that originated on a
remote node in the cluster, do not use the job information block to pick up
the user number to obtain the user name. Instead, use the user name that was
stored in .EQOWN by the remote QUASAR.

\
	SUBTTL	Global Symbols

;Global symbols defined in LPTSUB

	INTERN	ABTLNK,CASTIM,SETIM,GETLIK,GETLNK,FNDCER,PROTIM
	INTERN	LOGCHR,FORMS,LSTAF,LFINF,LODVFU,LODRAM			;[4] 
	INTERN	D$ALSL,D$ALCN,D$TAPE,FMOPN,FILTYP			;[4]
	INTERN	LPMSG,LPDAT,LPOPR,LPEND,LPERR				;[4] 
	INTERN	INPOPN,INPBUF,INPBYT,INPERR,INPFEF,INPREW,INPCLS	;[4]
	INTERN	ACTBEG,ACTEND						;[4] 

;Global symbols defined in LPTSPL

	EXTERN	JOBACT,DEPBP,TEXTBP,JOBCHK,JOBOBA,JOBUPD,JOBWAC 	;[4]
	EXTERN	CONANS,ENDRSP,OUTWON,OUTDMP,STREAM,ALISCD		;[4] 
	EXTERN	LPTVNO,DSCHD,SENDFF,IB,$MTOPR				;[4] 
	EXTERN	RMJOBI							;[7]

;Global symbols defined in LPTCLU

	EXTERN	SETFD							;[4] 
	SUBTTL	Storage

;Storage used to read LPFORM.INI

FOB:	BLOCK	FOB.SZ			;[4] A file open block for LPFORM.INI
FMOPN:	BLOCK	1			;[4] Set to -1 when LPFORM.INI open
FMIFN:	BLOCK	1			;[4] The IFN for LPFORM.INI
	SUBTTL	Read Print File -- INPOPN - Routine to open the input file

;[4] INPOPN is called with ac "E" pointing to the FP area for the file
;[4] to be opened.

INPOPN:	MOVEI	S1,FOB.SZ		;Get the FOB size
	MOVEI	S2,J$XFOB(J)		;And the FOB address
	$CALL	.ZCHNK			;Zero it out
	SETZM	J$TFIL(J)		;Assume no temporary file
	LOAD	S1,.FPINF(E),FP.NRA	;Remote user access to the file?
	JUMPN	S1,INPO.5		;If no, indicate in log
	LOAD	S1,.FPINF(E),FP.CPY	;Pick up if temporary file or not
	MOVEM	S1,J$TFIL(J)		;Save the file type
	JUMPE	S1,INPO.1		;Not a temp file, pick up fd
	$CALL	SETFD			;Set up the temporary file's fd
	JRST	INPO.2			;Go determine byte size

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

INPO.2:	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.3		;If set, avoid access check
	LOAD	S1,.FPINF(E),FP.SPL	;Likewise if spooled
	JUMPN	S1,INPO.3		; ...

	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

	;Continued on next page
	;Continued from previous page

;Ready to open file

INPO.3:	MOVEI	S1,FOB.SZ		;Get fob size
	MOVEI	S2,J$XFOB(J)		;And address
	$CALL	F%IOPN			;Open the file
	JUMPF	INPO.4			;Jump if failed
	MOVEM	S1,J$DIFN(J)		;Else, save the ifn
	$RETT				;And return

INPO.4:	TXNE	S,CLUSPL		;Is this a cluster LPTSPL?
	$RETF				;Yes, return now
	JRST	INPO.6			;Go indicate can't access file
INPO.5:	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
INPO.6:	MOVE	S1,J$TFIL(J)		;Pick up temporary file or not
	$TEXT(LOGCHR,<^I/LPERR/Can't access file ^I/@FILTYP(S1)/, ^E/[-1]/>)
	ZERO	.FPINF(E),FP.DEL	;Clear the 'delete file' bit
	$RETF				;And return
	SUBTTL	Read Print File -- INPBUF - Read a buffer from the input file

;[4] Here to get a buffer from the input file

INPBUF:	MOVE	S1,J$DIFN(J)		;Get the ifn
	$CALL	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	Read Print File -- INPBYT - Read a byte from the input file

;[4] Get a byte from the file in S1, returns FALSE if EOF.

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:	$CALL	INPBUF			;Read the next buffer
	JUMPF	.RETF			;No more return
	JRST	INPBYT			;Else get the next byte.
	SUBTTL	Read Print File -- INPERR - Handle an input failure

;[4] Here to handle input errors

INPERR:	CAXN	S1,EREOF$		;Was it eof?
	$RETF				;Was just return
	$TEXT(LOGCHR,<^I/LPERR/Error reading input file -  ^E/[-1]/>)
	TXO	S,SKPFIL		;Skip the rest of the file
	$RETF				; and return
	SUBTTL	Read Print File -- INPFEF - Force end-of-file on next input

;[4] Here to 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
	$CALL	F%POS			;And position it
	$RETT				;And return
	SUBTTL	Read Print File -- INPREW - Rewind the input file

;[4] Here to rewind input file

INPREW:	MOVE	S1,J$DIFN(J)		;Get the ifn
	$CALL	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	Read Print File -- INPCLS - Close the input file 

;[4] Here to close the input file if any.

INPCLS:	SKIPE	S1,J$DIFN(J)		;Get the IFN
	$CALL	F%REL			;Release it
	SETZM	J$DIFN(J)		;Clear the IFN
	$RET				;Return
	SUBTTL	DECnet Connections -- GETLNK - Get DECnet JFN

;GETLNK is called by routine OPNLNK to obtain a DECnet JFN to the remote
;
;Call is:       J/Job Context Pointer
;Returns true:  The JFN has been obtained and opened
;Returns false: S1/Address of ASCIZ error text
;               The JFN could not be obtained or opened

GETLNK:	SKIPA	S1,[FLD(^D8,OF%BSZ)!OF%WR!OF%RD] ;[3] Indicate from LPTDQS
GETLIK:	MOVX	S1,<FLD(^D36,OF%BSZ)!OF%WR!OF%RD> ;[3] Indicate from LPTCLU
	$SAVE	<T1,T2,T3>		;[2]SAVE THESE AC
	MOVE	T3,S1			;[3] Save OPENF bits

;Get the JFN and open it

	MOVX	S1,GJ%SHT		;Short jfn
	HRROI	S2,J$CDCN(J)		;Pick up DECnet dcn: device name
	GTJFN%				;Pick up the jfn
	 ERJMP	SGTLN2			;Return false if can't obtain jfn
	MOVEM	S1,J$LCHN(J)		;Save the jfn in sender block
	MOVE	S2,T3			;[3] Reclaim the OPENF bits
	OPENF%				;Open the jfn
	 ERJMP	SGTLN2			;Return false if can't obtain jfn
	$RETT				;Return true on success

;An error occurred.  Pick up the address of the error string.

SGTLN2:	$CALL	S%ERR			;Pick up error string address
	SKIPT				;Unable to pick up error string adr?
	MOVEI	S1,[ASCIZ/Fatal error detected in opening DECnet link/]
	MOVEM	S1,J$ERRA(J)		;Save the error string address
	SKIPGE	J$LCHN(J)		;Is there a DECnet connection?
	$RETF				;No, so return now
	$CALL	ABTLNK			;Close and release the DECnet dcn: jfn
	MOVE	S1,J$ERRA(J)		;Retrieve the error string address
	$RETF				;Return false on a failure 
	SUBTTL	DECnet Connections -- FNDCER - Find DECnet Error

;FNDCER is called when LPTSPL has not been able to make a DECnet connection to
;the DQS system.  FNDCER finds the error text using the error code returned by
;the .MORLS function.
;
;Call is:       J/Job Context Pointer
;Returns true:  A known error occurred
;               S1/Address of the error string
;Returns false: An unknown error occurred
;               S1/Address of unknown error string

FNDCER:	$SAVE	<P1>			;SAVE THIS AC

;Pick up the error string using the error code returned by .MORLS

	HRRZ	S1,J$LSTS(J)		;Pick up the error code
	MOVSI	S2,-DNELEN		;Pick up negative length of table
FNDCE2:	HLRZ	P1,DNERR(S2)		;Pick up the error code
	CAME	S1,P1			;Is this the error?
	AOBJN	S2,FNDCE2		;No, check the next entry
	SKIPL	S2			;Was the entry found?
	JRST	FNDCE3			;No, make unknown error
	HRRZ	S1,DNERR(S2)		;Pick up address of error text
	$RETT				;Indicate a known error
FNDCE3:	MOVEI	S1,[ASCIZ/Unknown error/] ;Pick up error address
	$RETF				;Indicate an unknown error
	SUBTTL	DECnet Connections -- DNERR - DECnet Disconnect Codes

;The DECnet disconnect codes.

DNERR:	.DCX0,,[ASCIZ/Reject or disconnect by object/]
	.DCX1,,[ASCIZ/Resource allocation failure/]
	.DCX2,,[ASCIZ/Destination node does not exist/]
	.DCX3,,[ASCIZ/Remote node shutting down/]
	.DCX4,,[ASCIZ/Destination process does not exist/]
	.DCX5,,[ASCIZ/Invalid process name field/]
	.DCX6,,[ASCIZ/Object is busy/]
	.DCX7,,[ASCIZ/Unspecified error/]
	.DCX8,,[ASCIZ/Third party aborted link/]
	.DCX9,,[ASCIZ/User abort (asynchronous disconnect)/]
	.DCX10,,[ASCIZ/Invalid node name/]
	.DCX11,,[ASCIZ/Local node shut down/]
	.DCX21,,[ASCIZ/Connect initiate with illegal destination address/]
	.DCX22,,[ASCIZ/Connect confirm with illegal destination address/]
	.DCX23,,[ASCIZ/Connect initiate or connect confirm with zero source address/]
	.DCX24,,[ASCIZ/Flow control violation/]
	.DCX32,,[ASCIZ/Too many connections to node/]
	.DCX33,,[ASCIZ/Too many connections to destination process/]
	.DCX34,,[ASCIZ/Access not permitted/]
	.DCX35,,[ASCIZ/Logical link services mismatch/]
	.DCX36,,[ASCIZ/Invalid account/]
	.DCX37,,[ASCIZ/Segment size too small/]
	.DCX38,,[ASCIZ/No response from destination, process aborted/]
	.DCX39,,[ASCIZ/No path to destination node/]
	.DCX40,,[ASCIZ/Link aborted due to data loss/]
	.DCX41,,[ASCIZ/Destination process does not exist/]
	.DCX42,,[ASCIZ/Confirmation of disconnect initiate/]
	.DCX43,,[ASCIZ/Image data field too long/]

DNELEN==.-DNERR				;Length of error table
	SUBTTL	DECnet Connections -- ABTLNK - Close DECnet Link

;ABTLNK is called after Cluster LPTSPL detects that a fatal error has
;occurred. The DECnet DCN: DEVICE JFN is closed with abort and released
;ABTLNK ignores any errors in closing or releasing the JFN
;
;Call is: J/Job Context Pointer
;Returns: The link has been closed and the JFN released

ABTLNK:	$SAVE	<T1,T2>			;Save these ac, destroyed by JSYS
	SKIPG	S1,J$LCHN(J)		;Pick up the DECnet jfn
	JRST	ABTLN3			;None there
	TXO	S1,CZ%ABT		;Close with abort
	CLOSF%				;Close the DECnet link
	 ERJMP	ABTLN2			;Shouldn't happen
	JRST	ABTLN3			;Go indicate no longer have a jfn

ABTLN2:	MOVE	S1,J$LCHN(J)		;Pick up the DECnet jfn again
	RLJFN%				;Release the jfn
	 ERJMP	.+1			;Shouldn't happen

ABTLN3:	SETOM	J$LCHN(J)		;Indicate no longer have a jfn
	PJRST	CLRTIM			;Clear the DECnet timer
	SUBTTL	DECnet Inactivity -- SETIM - Set the DECnet inactivity timer

;CASTIM is called to clear and reset the DECnet inactivity timer. After
;a NEXTJOB request has been processed, the timer is set. If no other
;NEXTJOB request is processed during the time the timer is set, then
;the DECnet link is aborted.
;
;Call is: J/Job Context Pointer
;Returns: The DECnet inactivity timer has been cleared and reset

CASTIM:	$CALL	CLRTIM			;Clear the timer
SETIM:	$CALL	I%NOW			;Pick up the current time
	ADDI	S1,TIMITL		;Time the timer will go off
	MOVEM	S1,.TITIM+J$TEVT(J)	;Place in the time event block
	MOVEI	S1,.TIMDT		;Pick up the timer function
	MOVEM	S1,.TIFNC+J$TEVT(J)	;Place in the time event block
	MOVEI	S1,PROTIM		;Pick up the timer processing routine
	MOVEM	S1,.TIMPC+J$TEVT(J)	;Place in the time event block
	MOVEI	S1,.TIMPC+1		;Pick up length of time event block
	MOVEI	S2,J$TEVT(J)		;Pick up address of time event block
	$CALL	I%TIMR			;Set the timer
	$RET				;Return to the caller
	SUBTTL	DECnet Inactivity -- PROTIM - DECnet Inactivity Timer Processor

;PROTIM is the "interrupt handler" for the DECnet inactivity timer.
;PROTIM is invoked when the DECnet inactivity timer goes off. 
;If there is an active job, then PROTIM resets the timer. If there
;is no active job, then PROTIM aborts the DECnet link.
;
;CALL is: No arguments
;Returns: The timer has been reset or the DECnet link is aborted

PROTIM:	SKIPE	JOBACT			;IS THERE AN ACTIVE STREAM?
	$CALL	SETIM			;YES, RESET THE TIMER
	SKIPN	JOBACT			;IS THERE AN ACTIVE STREAM?
	$CALL	ABTLNK			;NO, ABORT THE LINK
	$RET				;RETURN TO I%SLP
	SUBTTL	DECnet Inactivity -- CLRTIM - Clear the DECnet inactivity timer

;CLRTIM is called to clear the DECnet inactivity timer.
;
;Call is: J/Job Context Pointer
;Returns: The DECnet inactivity timer has been cleared

CLRTIM:	MOVEI	S1,.TIMDD		;Pick up the function
	MOVEM	S1,.TIFNC+J$TEVT(J)	;Place in the time event block
	MOVEI	S1,.TITIM+1		;Pick up length of time event block
	MOVEI	S2,J$TEVT(J)		;Pick up address of time event block
	$CALL	I%TIMR			;Clear the timer
	$RET				;Return to the caller
	SUBTTL	Logging Routines -- Common Messages

;[4] Here are some common messages used throughout LPTSPL

LSTAF:	MOVE	S1,J$TFIL(J)		;[4] Pick up file is temporary or not
	$TEXT(LOGCHR,<^I/LPMSG/Starting File ^I/@FILTYP(S1)/>)	;[4] 
	$RET				;[4] Return

;[4] Here to give the finished file message

LFINF:	MOVE	S1,J$TFIL(J)		;[4] Pick up file is temporary or not
	$TEXT (LOGCHR,<^I/LPMSG/Finished File ^I/@FILTYP(S1)/>)	;[4] 
	$RET				;[4] 

;[4] Log file stamps, used all over LPTSPL

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	? >)

;[4] Used to output the file name to the run log

FILTYP:	[ITEXT(<^F/@J$DFDA(J)/>)]	;Temporary file's FD
	[ITEXT(<^F/@J$ORFD(J)/>)]	;Original file's FD
	SUBTTL	Logging Routines -- LOGCHR - Type a character in the log file

;[4] LOGCHR is used in many $TEXTs.

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
	$CALL	LOGBUF			;Get another page
	POP	P,S1			;Restore the character
	JRST	LOGC.1			;And try again
	SUBTTL	Logging Routines -- LOGBUF - Get a buffer page for LOG

;[4] Here to get another buffer for the run log, the first one is preallocated.

LOGBUF:	$CALL	.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?
	$STOP(TML,Too many log buffers required) ;No, commit suicide
	$CALL	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
	$RET				; and return
	SUBTTL Forms Routines -- Format of LPFORM.INI

;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 or file
;	VFU:SS		(Same as /TAPE)
;	RAM:SS		Translation RAM to use
;	DRUM:SS		Drum type
;	CHAIN:SS	Chain type (drum and chain are the same)
;	NOTE:AA		Type note to the operator
;	NUMBER:NN	DQS forms number

;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 (except LAT and DQS)
;	LPTn		Lineprinter n only
;	TTYn		Terminal n only
;	DQS		DQS printers only

;NOTE:  LPTSPL will use the first entry which meets the location
;	specification for its lineprinter.
	SUBTTL Forms Routines -- Default Forms Switches

;[4] Generate table of switch names

DEFINE FF(A,C),<
	XLIST
	<<SIXBIT /A/>&777777B17>+S$'A
	LIST
	SALL
>

FFNAMS:	F

;[4] 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
	SUBTTL	Forms Routines -- FORMS - Setup Forms For A Job

;Here to setup forms for a job.

FORMS:	TXNE	S,ABORT			;Are we aborting?
	$RETF				;Yes, end the request
	GETLIM	S1,.EQLIM(J),FORM	;Get the forms type
	CAMN	S1,J$FORM(J)		;Or are forms exactly the same?
	$RETT				;Yes, VFU and RAM must be same too
	TXNN	S,DQSSPL		;Don't send if DQS LPTSPL
	SKIPN	J$FORM(J)		;Any previous forms?
	JRST	FORM.1			;No, don't try to send ff
	$CALL	OUTDMP			;Clear any previous output
	$CALL	SENDFF			;Send ff if needed
	$CALL	OUTDMP			;Clear it out

FORM.1:	HRLZI	S2,J$WTOR(J)		;Get 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.
	SKIPN	S2,J$FORM(J)		;Get forms type
	MOVX	S2,FRMNOR		;Use normal if null
	GETLIM	S1,.EQLIM(J),FORM	;Get forms type
	TXNE	S,DQSSPL		;Spooling DQS?
	MOVE	S2,S1			;Yes, never ask for form change
	XOR	S1,S2			;Get common part
	AND	S1,[EXP FRMSK1]		;And it with the important part
	GETLIM	S2,.EQLIM(J),FORM	;Get forms type
	EXCH	S2,J$FORM(J)		;Save it
	MOVEM	S2,J$FPFM(J)		;Save old ones
	SKIPE	S1			;No need to change forms.
	$TEXT	(DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
	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

	;Continued on next page
	;Continued from previous page

;Read the LPFORM.INI file to find the parameters associated with the form.

	$CALL	FRMINI			;Read the LPFORM.INI file
	JUMPT	FORM.3			;Skip the message if ok

;Get operator to load forms.

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)		; and update status also
	TXNE	S,DQSSPL		;DQS spooler?
	JRST	FRM.2B			;Yes
	$WTOR	(<Form ^W/S2/ not found, defaults being used>,<^T/FORMSG/>,@JOBOBA(S1),JOBWAC(S1)) ;Tell the operator
	SKIPLE	J$LREM(J)		;Is this a DN60 lpt?
	JRST	[$DSCHD	(PSF%OR!PSF%OO)	;Yes,
		 JRST .+2]
	$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
	$CALL	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
	MOVE	S2,STREAM		;Get the stream number
	SETOM	JOBUPD(S2)		;Yes, update the stream's status
	HRRZ	S1,0(S1)		;Get the routine address
	JRST	0(S1)			;And process the response

;Here if DQS spooler and the form wasn't found.  Use form number 0.

FRM.2B:	$WTO	(<Form Not Found>,<Form ^W/S2/ not found, default form being used>,@JOBOBA(S1))	; 
	SETZM	J$FNUM(J)		; Use form number 0 for DQS
					; Fall through to FORM.3
	;Continued on next page
	;Continued from previous page

;Form is mounted, 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

	SKIPE	J$MTAP(J)		;Are we spooling to tape?
	SKIPE	J$TDEV(J)		;Output to TTY?
	SKIPA				;No
	$RETT				;Yes, just return now
	MOVE	S1,TEXTBP		;Get the WTOR byte pointer
	TXNE	S,FRMFND		;Were the forms found?
	 CAMN	S1,[POINT 7,J$WTOR(J)]	;Is there a message for the operator?
	  JRST	FORM.5			;No, try loading VFU and RAM

	;Continued on next page
	;Continued from previous page

;Here to ask operator for something like forms.

	$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
	SKIPLE	J$LREM(J)		;Is this a dn60 lpt?
	JRST	[$DSCHD	(PSF%OR!PSF%OO)	;Yes,
		 JRST .+2]
	$DSCHD	(PSF%OR)		;NO, 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
	$CALL	S%TBLK			;Do we match?
	TXNE	S2,TL%NOM+TL%AMB	;Did we find it ok?
	JRST	FORM.4			;No stupid operator so try again

FORM.5:	MOVE	S1,STREAM		;Get the stream
	SETOM	JOBUPD(S1)		;Update the object status
	$CALL	LODRAM			;Try to load the RAM
	TXNE	S,ABORT+RQB		;Have we been canceled?
	$RETF				;Yes, return now
	$CALL	LODVFU			;Try to load the VFU
	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
	$CALL	FRMINI			;[3132] Reset the forms characteristics
	$RETF				;And return

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

FORMSG:	ASCIZ	/
Type 'RESPOND <number> ABORT' to terminate the forms change now
Type 'RESPOND <number> PROCEED' after mounting correct forms/
	SUBTTL	Forms Routines -- Read LPFORM.INI

;Here to read LPFORM.INI, return TRUE if form found, FALSE otherwise.
;Also returns bit FRMFND in S.

FRMINI:	$CALL	OPNFRM			;Reopen ini file
	$RETIF				;Quit if none
	TXZ	S,FRMFND		;Clear the forms found flag

FRMIN1:	$CALL	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:	CAMN	T1,J$FORM(J)		;[3132]Match against currect forms type
	JRST	FRMIN2			;YES
FRMI1A:	$CALL	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?
	 $CALL	FH$GNB			;Allow spaces, get non-blank char.
	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
	$CALL	FH$CHR			;Else, get a character
	JUMPF	.RETT			;Eof
	JRST	FRMIN2			;And loop

FRMIN3:	$CALL	FH$SIX			;Get a locator
	JUMPF	.RETT			;EOF
	JUMPE	T1,FRMI3A		;Maybe paren?
	JRST	FRMIN4			;Check for ALL, LOC, etc.

FRMI3A:	CAIN	C,"/"			;A switch?
	JRST	FRMIN5			;Yes
	CAIE	C,"("			;A list?
	JRST	FRMIN9			;No, error

	;Continued on next page
	;Continued from previous page

;Here when a forms match has been found.

FRMIN4:	HLRZ	T2,T1			;Get the first three chars
	TXNE	S,DQSSPL		;DQS spooling?
	CAIE	T2,'DQS'		; and DQS form number?
	CAIA				;No, skip and check more
	JRST	FRMIN5			;Yes
	CAIN	T2,'ALL'		;Is it "all"?
	JRST	FRMIN5			;Yes, stop checking
	CAIN	T2,'LOC'		;Is it local?
	SKIPE	J$LREM(J)		;Yes, are we?
	  SKIPA				;No, no
	JRST	FRMIN5			;Yes
	CAIN	T2,'REM'		;Does it say "remote"?
	SKIPN	J$LREM(J)		;Yes, are we remote
	 SKIPA				;No
	JRST	FRMIN5			;Yes
	TXNE	S,LATSPL		;[5]LAT spooling?
	CAIE	T2,'LAT'		;[5]does it say "LAT"
	 SKIPA				;[5]No
	JRST	FRMIN5			;[5]Yes
	CAMN	T1,J$LDEV(J)		;Compare to our devnam
	JRST	FRMIN5			;Match

FRMI4B:	CAIN	C,.CHLFD		;Break on eol?
	JRST	FRMIN1			;Yes, get next line
	CAIE	C,"/"			;Is it a slash?
	CAIN	C,")"			;No, close paren?
	JRST	FRMI1A			;Yes, get the next line
	CAIN	C," "			;Break on space?
	 JRST	FRMI1A			;Yes, get the next line
	$CALL	FH$SIX			;Else, get the next locator
	JUMPF	.RETT			;Eof, return
	JUMPE	T1,FRMIN9		;Bad format
	JRST	FRMIN4			;And loop around

	;Continued on next page
	;Continued from previous page

;Here if not DQS and this line is for us

FRMIN5:	CAIN	C,.CHLFD		;Was the last character a linefeed?
	$RET				;Yes, return
	CAIN	C,"/"			;Are we at the beginning of a switch?
	JRST	FRMI5A			;Yes, do it
	$CALL	FH$CHR			;No, get a character
	JUMPF	.RETT			;Eof
	JRST	FRMIN5			;And loop around
FRMI5A:	$CALL	FH$SIX			;Get the switch
	JUMPF	.RETT			;Eof
	JUMPN	T1,FRMIN6		;Jump if we've got something
	CAIN	C,.CHLFD		;Eol?
	$RET				;Yes, return
	JRST	FRMIN5			;Else, keep trying

FRMIN6:	MOVE	T4,T1			;Save switch name for latter
	HLLZS	T1			;Get first three characters of switch
	MOVSI	T2,-F$NSW		;Make aobjn pointer

FRMIN7:	HLLZ	T3,FFNAMS(t2)		;Get a switch name
	CAMN	T3,T1			;Match?
	JRST	FRMIN8			;Yes, dispatch
	AOBJN	T2,FRMIN7		;No, loop
	MOVE	T4,T1			;Get switch name
	MOVE	S1,STREAM		;Get the stream number.
	$WTOJ	(LPFORM.INI Error,<Unrecognized switch ^W/T1/ found.>,@JOBOBA(S1))
	JRST	FRMIN5			;And loop

FRMIN8:	HRRZ	T3,FFNAMS(T2)		;Get dispatch address
	$CALL	(T3)			;Go
	JRST	FRMIN5			;And loop

FRMIN9:	MOVE	S1,STREAM		;Get the stream number.
	$WTOJ	(Bad format in LPFORM.INI,,@JOBOBA(S1))
	$RET				;And return
	SUBTTL	Forms Routines -- Forms Switch Subroutines

;/BANNERS:n switch

S$BANN:	MOVE	T1,D$BANN		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FBAN(J)		;Store it
	$RET				;And return

;/TRAILERS:n switch

S$TRAI:	MOVE	T1,D$TRAI		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FTRA(J)		;Store it
	$RET				;And return

;/HEADERS:n switch

S$HEAD:	MOVE	T1,D$HEAD		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FHEA(J)		;Store it
	$RET				;And return

;/LINES:n switch

S$LINE:	MOVE	T1,D$LINE		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FLIN(J)		;Store it
	$RET				;And return

;/WIDTH:n switch

S$WIDT:	MOVE	T1,D$WIDT		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FWID(J)		;Save it
	$RET				;And return
;/RIBBON:s switch

S$RIBB:	$CALL	FH$SIX			;Get SIXBIT argument
	JUMPF	.RETT			;Eof
	MOVEM	T1,J$FRIB(J)		;Save it
	CAME	T1,J$PRIB(J)		;Skip if not changed
	$TEXT	(DEPBP,<Load Ribbon type '^W/J$FRIB(J)/'>)
	$RET				;and return

;/DRUM:s and /CHAIN:s switch

S$DRUM:
S$CHAI:	$CALL	FH$SIX			;Get SIXBIT arg
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FDRU(J)		;Save it
	CAME	T1,J$PDRU(J)		;Skip if not changed
	$TEXT	(DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>) ;
	$RET				; and return

;/NODE:text-to-slash-or-eol switch

S$NOTE:	MOVE	T1,[POINT 7,J$FNBK(J)]	;Make pointer to area
	SETZ	T2,			;Clear the counter

S$NOT1:	$CALL	FH$CHR			;Get a character
	JUMPF	S$NOT2			;Eof, finish up
	CAIGE	C,40			;Make sure its greater than space
	  JRST	S$NOT2			;Its not, finish up
	CAIN	C,"/"			;Also stop on slash
	JRST	S$NOT2			;It is
	IDPB	C,T1			;Deposit it
	CAIGE	T2,^D49			;Loop for 50 characters
	AOJA	T2,S$NOT1		;Incr and loop

S$NOT2:	SETZM	TF			;Get a null byte
	IDPB	TF,T1			;Make the string asciz
	$TEXT	(DEPBP,<Note: ^T/J$FNBK(J)/>) ;Add the msg to WTOR
	$RETT				;Return
;/ALCNT:n switch

S$ALCN:	MOVE	T1,D$ALCN		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FALC(J)		;Store It
	$RET				;Return

;/ALSLP:n switch

S$ALSL:	MOVE	T1,D$ALSL		;Get the default setting
	CAIN	C,":"			;Did he put a real arguement
	 $CALL	FH$DEC			; Yes, get decimal argument
	MOVEM	T1,J$FALS(J)		;Save it
	$RET				;And return

;/ALIGN[:file] switch

S$ALIG:	CAIN	C,"/"			;Are we at the beginning of a switch?
	PJRST	ALISCD			;Yes, just use forms name as align file
	$CALL	FH$SIX			;Get the align filename argument
	SKIPE	T1			;Skip if nothing there
	MOVEM	T1,J$FALI(J)		;Save the align filename
	$CALL	ALISCD			;Schedule the align
	$RET				; and return
;/VFU:file and /TAPE:name switch

S$VFU:
S$TAPE:	$CALL	FH$SIX			;Get SIXBIT argument
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FTAP(J)		;Save it
	CAME	T1,J$PTAP(J)		;Are old and new the same?
	SKIPE	J$LDVF(J)		;Or does device have a davfu?
	$RETT				;Old=new or software VFU, return
	$TEXT	(DEPBP,<Load CARRIAGE CONTROL TAPE '^W/J$FTAP(J)/'>) 
	$RETT

;/RAM:file switch

S$RAM:	$CALL	FH$SIX			;Get the SIXBIT argument
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FRAM(J)		;Save it
	$RETT				;And return

;/NUMBER:n switch for DQS forms number

S$NUMB:	MOVE	T1,D$NUMB		;Get the default setting
	CAIN	C,":"			;Argument coming?
	$CALL	FH$DEC			;Yes, get decimal argument
	MOVEM	T1,J$FNUM(J)		;Save this as forms number
	$RETT				;Return true
	SUBTTL	Forms Routines -- I/O Subroutines for LPFORM.INI

;[4] Routine to return a sixbit word in T1
;[4] Returns with word in T1.  Skips normally, non-skip on EOF.

FH$SIX:	CLEAR	T1,			;Clear for result
	MOVE	T2,[POINT 6,T1]		;Pointer for result
FH$SX1:	$CALL	FH$CHR			;Get a character
	JUMPF	.RETF			;Fail if eof
	CAIL	C,"A"			;Check for alpha
	CAILE	C,"Z"
	  SKIPA				;Its not
	JRST	FH$SX2			;It is, deposit it

	CAIL	C,"0"			;Check for number
	CAILE	C,"9"
	$RETT				;Not SIXBIT, return

FH$SX2:	SUBI	C,40			;Convert to SIXBIT
	TLNE	T2,770000		;Get six yet?
	IDPB	C,T2			;No, deposit another
	JRST	FH$SX1			;And loop around

FH$GNB:	$CALL	FH$CHR			;Get a character
	 $RETIF				;Return if error
	CAIN	C," "			;A space?
	 JRST	FH$GNB			;No, do it again
	$RETT				;Return good

;[4] Routine to return 1 character in accumulator C

FH$CHR:	MOVE	S1,FMIFN		;Get IFN for LPFORM.INI
	$CALL	F%IBYT			;Get next character
	JUMPF	.RETF			;Quit if bad or done
	MOVE	C,S2			;Move the character into C
	CAIE	C,.CHTAB		;Convert tabs
	CAIN	C,.CHCRT		;And carriage returns
	MOVEI	C,40			;Into spaces
	CAIE	C,.CHFFD		;Convert form feeds
	CAIN	C,.CHVTB		;And vertical tabs
	MOVEI	C,.CHLFD		;Into linefeed
	CAIL	C,141			;Check lower case
	CAILE	C,172			;141-172
	$RETT				;Its not
	SUBI	C,40			;Yup, convert to upper
	$RETT				;And skip back
;[4] Routine to search for eol in LPFORM.INI

FH$EOL:	$CALL	FH$CHR			;Get a character
	JUMPF	.RETF			;Fail if EOF
	CAIE	C,.CHLFD		;EOL?
	JRST	FH$EOL			;No, loop
	$RETT				;Yes, return

;[4] Routine to pick up a decimal number

FH$DEC:	CLEAR	T1,			;Place to accumulate result
FH$DE1:	$CALL	FH$CHR			;Get a character
	JUMPF	.RETF			;Eof, return
	CAIL	C,"0"			;Check the range
	CAILE	C,"9"			;0-9
	  $RET				;Return
	IMULI	T1,12			;Shift a place
	ADDI	T1,-"0"(C)		;Add in a digit
	JRST	FH$DE1			;And loop around
	SUBTTL	Forms Routines -- OPNFRM - Routine to open LPFORM.INI

;[4] Open LPFORM.INI

OPNFRM:	SKIPN	FMOPN			;Open already?
	JRST	OPNF.1			;No, continue on
	MOVE	S1,FMIFN		;Yes, get the ifn
	$CALL	F%REL			;And release it
	SETZM	FMOPN			;Clear "open"

OPNF.1:	MOVEI	S1,FOB.SZ		;FOB size
	MOVEI	S2,FOB			;FOB address
	$CALL	.ZCHNK			;Zero it
	MOVEI	S1,FMFD			;Get FD address
	STORE	S1,FOB+FOB.FD		;Store it
	MOVX	S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN) ;Byte size and ignore line #'s
	MOVEM	S1,FOB+FOB.CW		;Save it
	MOVEI	S1,FOB.SZ		;Load the FOB size
	MOVEI	S2,FOB			;And the FOB address
	$CALL	F%IOPN			;And open the file
	JUMPF	.RETF			;Lose?
	MOVEM	S1,FMIFN		;Save the ifn
	SETOM	FMOPN			;Set "open"
	$RETT				;And return

FMFD:	XWD	FMFDL,0			;FD size
	ASCIZ	/SYS:LPFORM.INI/	;And the string
	FMFDL==.-FMFD			;The FD size
	SUBTTL	VFU/RAM Routines -- LODVFU - Load the Vertical Forms Unit

;[4] Here to load VFU as needed.

LODVFU:	SKIPN	J$MTAP(J)		;Are we spooling to tape?
	SKIPN	J$LDVF(J)		;Or does this printer have a VFU?
	$RETT				;To tape or no VFU, just return.
	MOVE	S1,J$FTAP(J)		;Get necessary VFU type
	CAMN	S1,J$FLVT(J)		;Is it in there already?
	$RETT				;Yes, return
	MOVE	S1,STREAM		;Get stream number
	$WTO  (Loading VFU with '^W/J$FTAP(J)/',,@JOBOBA(S1))

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

LODV.2:	MOVX	S1,GJ%OLD+GJ%SHT	;Short, old file only
	LOAD	S2,IB+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as the value of the JFN access
	HRROI	S2,J$XTBF(J)		;Point to string
	GTJFN				;Go get the JFN for the file
	 ERJMP	NOVFU			;Error, let's try something else
LODV.3:	MOVE	T3,S1			;Copy the jfn over
	MOVE	S1,J$LCHN(J)		;Get the lpt jfn
	MOVX	S2,.MOLVF		;Get load vfu function
	MOVEI	T1,T2			;Address of arg block
	MOVEI	T2,2			;Length of arg block
	$CALL	$MTOPR			;Load the VFU
	MOVE	S1,T3			;Get the VFU JFN once more
	RLJFN				;Release it
	JFCL				;Ignore any errors
	 JUMPF	LODV.4			;Can't load VFU, go find out why
	MOVE	T1,J$FTAP(J)		;Get the VFU type
	MOVEM	T1,J$FLVT(J)		;Save as currently loaded
	$RET				; and return

LODV.4:	MOVX	S1,.FHSLF		;Get my handle
	GETER				;Get the last error code
	HRRZS	S2,S2			;Get just the error code
	CAXE	S2,MTOX17		;Is the error 'device offline'?
	JRST	NOVF.1			;No, let's try some other
	$CALL	OUTWON			;Say 'device offline'
	JRST	LODV.2			; and try again
	SUBTTL	VFU/RAM Routines -- NOVFU - VFU File Not Found

NOVFU:	MOVE	T1,J$FTAP(J)		;Type we tried to load
	CAME	T1,D$TAPE		;Is it the default
	JRST	NOVF.1			;No, give up

NOVF.1:	MOVE	S1,STREAM		;Get stream number
	$WTOR	(,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1)) ;Tell me
	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
	MOVE	S1,STREAM		;Get the stream number
	SETOM	JOBUPD(S1)		;Yes, update the stream's status
	HRROI	S1,J$RESP(J)		;Get the operators response
	$CALL	S%SIXB			;Convert it to SIXBIT
	MOVEM	S2,J$FTAP(J)		;Save the forms type
	JRST	LODVFU			;Try loading again

VFUI1:	ITEXT	(<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2:	ASCIZ	/Respond with VFU type to continue/
	SUBTTL	VFU/RAM Routines -- LODRAM - Load The Translation RAM

;[4] Load the translation RAM into a LP20

LODRAM:	SKIPN	J$MTAP(J)		;Are we spooling to tape?
	SKIPE	J$LREM(J)		;Or is this a remote lpt?
	$RETT				;Yes, return now
	MOVE	S1,J$FRAM(J)		;Get the ram we want
	CAMN	S1,J$FLRM(J)		;Is it in there already?
	$RETT				;Yes, return now

	MOVE	S1,STREAM		;Get our stream number
	$WTO	(Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
	$TEXT	(<-1,,J$XTBF(J)>,<SYS:^W/J$FRAM(J)/.RAM^0>) ;Gen RAM file name

LODR.1:	MOVX	S1,GJ%OLD+GJ%SHT	;Short, old file only
	LOAD	S2,IB+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as the value of the JFN access
	HRROI	S2,J$XTBF(J)		;Point to file name
	GTJFN				;Get a jfn for the translation ram
	 ERJMP	NORAM			;Can't get a JFN, try something else

LODR.2:	MOVE	T3,S1			;Save the jfn
	MOVE	S1,J$LCHN(J)		;Get the printer jfn
	MOVX	S2,.MOLTR		;Want 'load ram' mtopr function
	MOVEI	T1,T2			;Get arg block address
	MOVEI	T2,2			;Get arg block length
	$CALL	$MTOPR			;Go do the MTOPR
	MOVE	S1,T3			;Get the jfn back
	RLJFN				;Release it
	JFCL				;Ignore any errors
	JUMPF	LODR.3			;Could not load RAM, find out why
	MOVE	S1,J$FRAM(J)		;Get the ram type we loaded
	MOVEM	S1,J$FLRM(J)		;Save it
	$RETT				;And return

LODR.3:	MOVX	S1,.FHSLF		;Get my handle
	GETER				;Get the last error
	HRRZS	S2,S2			;Get just the error code
	CAXE	S2,MTOX17		;Is the error 'lpt offline'?
	JRST	NORAM			;No, try some other
	$CALL	OUTWON			;Wait for the LPT to come online
	JRST	LODR.1			; and try again
	SUBTTL	VFU/RAM Routines -- NORAM - Process RAM Loading Errors

;[4] Here if error loading RAM

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
	MOVE	S1,STREAM		;Get the stream number
	SETOM	JOBUPD(S1)		;Yes, update the stream's status
	HRROI	S1,J$RESP(J)		;Get the response address
	$CALL	S%SIXB			;Convert it to SIXBIT
	MOVEM	S2,J$FRAM(J)		;Save the new RAM type
	JRST	LODRAM			; and try again

RAMI1:	ITEXT	(<RAM Error, Can't Load RAM '^W/J$FRAM(J)/'>)
RAMI2:	ASCIZ	/Respond With RAM Type to Continue/
	SUBTTL	Accounting -- ACTBEG - Accounting Initialization Routine

;[4] Here to save information needed for accounting

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

	MOVX	S1,.FHSLF		;Get fork handle
	RUNTM				;Get my runtime

	MOVNM	S1,J$ARTM(J)  		;Remember it negated
	$RETT				;Return
	SUBTTL	Accounting -- ACTEND - Accounting Summary Routine

;[4] Here to write the accounting data

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,<
	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
	$RETT				;If ok return

ACTE.1:	MOVE	S1,STREAM		;Get this stream number
	SKIPL	J$REMR(J)		;[7]Request originate remotely?
	IFSKP.				;[7]
	  $WTO	(System Accounting Failure,<^I/RMJOBI/>,@JOBOBA(S1))   ;[7]
	ELSE.				;[7]
	  $WTO	(System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1));[7]
	ENDIF.				;[7]
>;END IFN FTACNT
	$RETT				;Return
	SUBTTL	Accounting -- ACTLST - Spooler Accounting Record

;[4] Argument block used for USAGE JSYS.

IFN FTACNT,<

ACTLST:	USENT.	(.UTOUT,1,1,0)		;Output spooler
	USTAD.	(-1)			;Current date/time
	USPNM.	(<SIXBIT/LPTSPL/>,US%IMM) ;Program name
	USPVR.	(LPTVNO)		;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

	;Continued on next page
	;Continued from previous page

	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 
	USACT.	(<POINT 7,.EQACT(J) >)	;Account string pointer
	0				;End of list

	ACTLEN==.-ACTLST		;Accounting block length
> ;END IFN FTACNT
	SUBTTL	End of LPTSUB

	END

;;;Local modes:
;;;Mode: MACRO
;;;Comment begin: ";"
;;;Comment column: 40
;;;End: