Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/ppnspl.mac
There are no other files named ppnspl.mac in the archive.
;[SRI-NIC]SRC:<5-GALAXY>PPNSPL.MAC.26, 21-Dec-89 15:11:31, Edit by MKL
; turn this into PPNSPL
;[SRI-NIC]SRC:<5-GALAXY>SPDSPL.MAC.17, 10-Oct-89 13:47:15, Edit by MKL
; modify to let unix host do header page
;[SRI-NIC]SRC:<5-GALAXY>SPDSPL.MAC.4, 17-Aug-89 22:27:42, Edit by MKL
; make new PPNSPL into SPDSPL
;[SRI-NIC]SRC:<5-GALAXY>PPNSPL.MAC.15,  9-Jun-89 13:37:37, Edit by MKL
; add timeouts and make PLPT: format be "host.printer"
;[SRI-NIC]SRC:<5-GALAXY>PPNSPL.MAC.2,  2-Jun-89 15:49:28, Edit by MKL
; make PPNSPL spool to Unix LPD instead of tty

;[SRI-NIC]SRC:<5-GALAXY>PPNSPL.MAC.144, 22-Sep-88 16:01:45, Edit by MKL
; seperate pippin and speedy into seperate spoolers (ppnspl and psspl)
;[SRI-NIC]SRC:<5-GALAXY>PSSPL.MAC.140, 31-May-88 14:21:45, Edit by MKL
; add gross hack at JOBTRL to display file name if came from LPD server
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.139, 17-Feb-88 11:51:00, Edit by MKL
;only send control-t's every 7 seconds
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.137, 19-Nov-87 14:55:37, Edit by MKL
; at SETPFT, pretend 36 bit files are 7 bit
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.131,  3-Aug-87 16:20:14, Edit by MKL
; print header page from papertray 0, fix JFNS% output on header page
; make userid bigger (usize) and not inversed.
;XS:<5-GALAXY>PSSPL.MAC.127, 19-May-87 12:27:14, Edit by KNIGHT
;XS:<5-GALAXY>PSSPL.MAC.125, 19-May-87 10:39:15, Edit by KNIGHT
;XS:<5-GALAXY>PSSPL.MAC.124, 19-May-87 09:37:52, Edit by KNIGHT
; Add support for 2up, book and landscape.  Slurp prepend files from SYSTEM:
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.120, 10-Feb-87 14:47:50, Edit by VIVIAN
; Up I/O timeout from 5min to 10min
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.118,  3-Feb-87 13:05:39, Edit by MKL
; only do one header page per print job
;XS:<5-GALAXY>PSSPL.MAC.117, 22-Jan-87 11:26:34, Edit by KNIGHT
; Always output CR's before LF's.
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.116,  2-Dec-86 17:06:08, Edit by MKL
; Change SOUTR% to SOUT% because it seems to work a lot faster.
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.109, 24-Nov-86 13:49:23, Edit by MKL
; inhibit non-job output for device
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.106, 21-Nov-86 15:02:46, Edit by MKL
; send control-D after we hit EOF in PS routine
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.105, 20-Nov-86 16:31:42, Edit by MKL
; when printing errors in header, check if 2nd line is really an error
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.103, 20-Nov-86 15:23:21, Edit by MKL
; add a missing ENDIF. in IDLCHK
;[SRI-NIC]XS:<5-GALAXY>PSSPL.MAC.101, 20-Nov-86 14:02:23, Edit by MKL
; fixed random bugs in header page routine
;;SRC:<5-GALAXY>PSSPL.MAC.80, 23-Sep-86 09:09:26, Edit by KNIGHT
;SRC:<5-GALAXY>PSSPL.MAC.77, 15-Aug-86 14:43:31, Edit by KNIGHT
	TITLE	PPNSPL - PostScript printer spooler

COMMENT \
	This program augments the standard LPTSPL as the lineprinter
	spooler. It features a number of functions in addition to the
	normal ones. It handles any number of devices (streams) up to
	maximum NPRINT which may be changed. Each stream executes in its
	own subfork. Also, by specifying TCP instead of a TTY as the
	printing devices PLPTx:, files will be spooled over the
	net using TCP. 

	Physical LPTs and spooling to mag tape are NOT supported.

	The Forms parameter file SYS:LPFORM.TXT also has a different
	format as compared to LPFORM.INI, see below.

	This stuff was written in the Fall of 1984 by
	Bjorn Lindskog, Computer Science Lab, U of W, Seattle

	Well, this sort of came to me by a roundabout route, and I won't
	claim a lot of responsibility except to say that it seems to work
	for me. 

	I've added compatibility for PostScript printers and for named units
	ala Columbia.

	Bob Knight
	\
	
	SEARCH GLXMAC,QSRMAC,ORNMAC,MACSYM,MONSYM
	PROLOGUE(PPNSPL)
	.DIRECT	FLBLST
	.REQUIRE SYS:MACREL
	SALL				;SUPPRESS MACRO EXPANSIONS

debug==0
ifndef debug,<debug==0>

;VERSION INFORMATION
	LPTVER==1			;MAJOR VERSION NUMBER
	LPTMIN==0			;MINOR VERSION NUMBER
	LPTEDT==0			;EDIT LEVEL
	LPTWHO==0			;WHO LAST PATCHED
	%LPT==<BYTE (3)LPTWHO(9)LPTVER(6)LPTMIN(18)LPTEDT>

;STORE VERSION NUMBER IN JOBVER
	LOC 137
.JBVER::EXP %LPT
	RELOC
	SUBTTL AC definitions

;Accumulator definitions
	M==13		;IPCF message address, used by top fork only
	S==13		;Status flags, used by inferiors only
	E==14		;Points to current file
	J==15		;Stream context pointer
	C==16		;Holds a 'character' i.e. 7 to 36 bits

;Status Flags used in S reg of inferior process
	ARROW==1B0		;ARROW MODE IN EFFECT
	SUPFIL==1B1		;NO USER FORM CONTROL
	ERRFIL==1B3		;Error in file, skip it
;	CHRCNT==1B4		;Dummy transfer to count characters.
	TIMCKP==1B5		;Timed checkpoints enabled
	FCONV==1B6		;THE NEXT CHAR IS FORTRAN FORMAT DATA
	NEWLIN==1B7		;FLAG FOR THE BEGINING OF LINE
	FILXFR==1B9		;Xferring a user file i.e. enable page skipping
	FRMFND==1B10		;Forms found in LPFORM.TXT
	MINUS==1B11		;Reading a neg. number from LPFORM.TXT

; File types (flags in S):
	F%PL7==:1B18			; 7-bit plaintext
	F%PL8==:1B19			; 8-bit plaintext
	F%PS7==:1B20			; 7-bit PostScript
	F%PS8==:1B21			; 8-bit PostScript
	F%PLH7==:1B22			; 7-bit plaintext with page headers
	F%PLH8==:1B23			; 8-bit plaintext with page headers
	F%IM7==:1B24			; 7-bit Impress files
	F%IM8==:1B25			; 8-bit Impress files
	F%CRSN==:1B26			; Last char seen was a CR
	F%2UP==:1B27			; Two-up format
	F%BOOK==:1B28			; Book format
	F%LAND==:1B29			; Landscape format
	F%36==:1B30			; was a 36-bit file
	SUBTTL	Parameters
;Parameters which may be changed at assembly time
	ND CKPTIM,^D30		;Seconds between checkpoints
	ND DISTIM,^D600		;Time-out in secs. when dismissed for I/O
	ND OPBFSZ,^D2000	;Size of output buffer in 8 bit bytes
	ND IPBFSZ,^D2000	;Size of input (file) buffer in 7 bit bytes
	ND LGBFSZ,^D5000	;Size of log buffer in 7 bit bytes
	ND NPRINT,^D5		;Number of devices this spooler handles
	ND FATERT,%RSUNA	;Bit to set if fatal error (formerly %RSUDE)

;Constant parameters
	XP MSBSIZ,30		;Size of a message block
	XP STKSIZ,^D100		;Size of stacks
	XP DDTSEC,37		;section in which DDT resides
	SUBTTL	MACROS
;Macros to generate stream data area
DEFINE LP(SYM,VAL,FLAG),<
	IF1,<
		XLIST
		IFNDEF J...X,<J...X==PAGSIZ>
		IFDEF SYM,<PRINTX  ?PARAM SYM USED TWICE>
		SYM==J...X
		J...X==J...X+VAL
		IFNDEF ...BP,<...BP==1B0>
		IFNDEF ...WP,<...WP==0>
		REPEAT VAL,<
		IFIDN <FLAG><Z>,<LPZ(\...WP,...BP)>
			...BP==...BP_<-1>
			IFE ...BP,<
				...BP==1B0
				...WP==...WP+1
			>  ;;END IFE ...BP
		>  ;;END REPEAT VAL
		LIST
		SALL
	>  ;END IF1

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


DEFINE LPZ(A,B),<
	IFNDEF ...Z'A,<...Z'A==B>
	IFDEF ...Z'A,<...Z'A==...Z'A!B>
>  ;END DEFINE LPZ


;Macros used to build dispatch tables

DEFINE	BDTB,<
	...ST==.
		EXP 0		;;We don't want to use the 0 entry
>

DEFINE	DTE(ADDR,CONST),<
	IF1,<IFDEF CONST,<PRINTX  ?Constant used twice>>
	CONST==.-...ST
	EXP	ADDR
>

DEFINE	EDTB(LEN),<
	LEN==.-...ST
>


;Macros used in inferiors's code

;The TXT macro is a poor man's implementation of the $TEXT macro. It is
;used by the inferiors since the original $TEXT in GLXLIB uses
;non reentrant code.
;This one uses the reentrant routines TXT.xx for the different functions.
;It takes three arguments: TXT(type,address,string)
;Type indicates whether address is the address of routine that outputs the
;char in C or the address of buffer. <> 0 is buffer.
;The string accepted has the following format:
;^<function character><argument>^<function character><argument>...^
;See macro TFUNC for a listing of the functions.
;The first function of the string is defaulted to ^! i.e. no function.
;Note that S1 and S2 are not preserved and cannot be referenced in the
;string.

;Macros used to build the argument strings
;Use CLSTR to init, APPSTR(TXT) to add TXT at the end and
;EXPSTR to get the string back.

DEFINE CLSTR <
    DEFINE APPSTR (FTXT) <
	DEFINE APPSTR (TXT) <
	    APP1 (<TXT>,<FTXT>)
	>
	DEFINE EXPSTR <FTXT>
    >
    DEFINE EXPSTR <>
> ;End def of CLSTR


DEFINE APP1 (NTXT,OTXT) <
    DEFINE APPSTR (TXT) <
	APP1 (<TXT>,<OTXT'NTXT>)
    >
    DEFINE EXPSTR <OTXT'NTXT>
> ;End def of APP1


;Macro used to build the definitions. Two macros TFBx and TFAx are
;created for each function character. TFBX is expanded when the 
;function character is detected. It is used to init the argument
;string if necessary. TFAx is expanded when the 
;argument has been collected i.e. at next ^ or at end of input.

DEFINE	TF(FUNCT,BEFORE,AFTER) <
    IFNB <BEFORE> <DEFINE TFB'FUNCT BEFORE>
    IFNB <AFTER> <DEFINE TFA'FUNCT AFTER> > ;End of TF macro


;Macro to expand the collected argument into code

DEFINE EXPAND <MOVEI S2,EXPSTR>


;The following are definitions of the function characters
;accepted by the TXT macro.

DEFINE TFUNC <
	TF(T,	<APPSTR (<[ASCIZ ~>)>,		;;Insert string prefix
		<APPSTR (<~]>)			;;Insert right delimiter
		EXPAND				;;Make argument into code
		$CALL	TXT.AS>)
	TF(A,,	<EXPAND				;;Arg. points to ASCIZ string
		$CALL	TXT.AS>)
	TF(D,,	<EXPAND				;;Arg. points to decimal number
		$CALL	TXT.DN>)
	TF(S,,	<EXPAND				;;Arg. points to SIXBIT word
		$CALL	TXT.SX>)
	TF(C,,	<EXPAND				;;Arg points to int. time
		$CALL	TXT.DT>)
	TF(H,,	<$CALL	TXT.TI>)		;;Time output as HH:MM:SS
	TF(E,,	<$CALL	TXT.ER>)		;;Last error is output

	TF(7,,	<EXPAND				;;Arg. points to one char word
		$CALL	TXT.CH>)
	TF(M,	<APPSTR (<.CHCRT>)		;;Insert a ^M (CR)
		EXPAND
		$CALL	TXT.CH>,)
	TF(J,	<APPSTR (<.CHLFD>)		;;Insert a ^J (LF)
		EXPAND
		$CALL	TXT.CH>,)
	TF(^,	<APPSTR (<"^">)			;;Insert a ^
		EXPAND
		$CALL	TXT.CH>,)
	TF(0,	<APPSTR (<0>)			;;Insert a NUL
		EXPAND
		$CALL	TXT.CH>,)
	TF(!,,)					;;No function
>;DEFINE TFUNC

	TFUNC				;Generate them


;This macro does the work

DEFINE TX(C)<
    TXF=="!"				;;Current function is 'no function'
    TXD==0				;;And no new function seen
    CLSTR				;;Clear our argument string
    IRPC C <				;;Parse the arg. one char at a time
	IFE TXD <IFDIF <C><^> <		;;Nothing special, append char
		APPSTR <C>>>	

	IFN TXD <CLSTR			;;We saw ^ prev. char, clear string
		TXD==0			;;No ^ seen anymore
		TXF=="C"		;;Save current function
		TPRE (\"TXF)>		;;Do pre-processing

	IFIDN <C><^> <
		TPST (\"TXF)		;;A ^: post process current function
		IFDIF <TXF><^> <
			TXD==1>>	;;Flag a ^ (unless funct was ^)
    > ;;End of IRPC
    TPST (\"TXF)			;;Post process last function
>;DEFINE TX

;Macros to call appropr. handler. Doesn't call if not defined.
;TPRE calls pre-processor, TPST post-processor.

DEFINE TPRE (FUNCT) <
	IFDEF TFB'FUNCT <TFB'FUNCT>>
DEFINE TPST (FUNCT) <
	IFDEF TFA'FUNCT  <TFA'FUNCT>>


;This is the macro that should be called to do all this stuff.

DEFINE TXT (TYPE,ADDR,STR) <
	JRST	[IFE TYPE,<MOVEI S1,ADDR>	;;Address of routine
		IFN TYPE,<MOVE S1,[POINT 7,ADDR]>	;;Address of buffer
		TX	(<STR>)
		JRST	.+1]
>;DEFINE TXT


;Slightly higher level string macros
;The text strings accepted are in TXT style

DEFINE OPRMSG (STR) <
  JRST	[MOVE	S1,[POINT 7,J$SMOP(J)]
	TX (<^T'STR'^0>)		;;Generate code for string (NUL at end)
	MOVX	S1,SIG.MS		;;Tell superior we have a message
	$CALL	SIGNAL
	JRST	.+1]
>;DEFINE OPRMSG

DEFINE ERROR (STR) <
   JRST	[MOVE	S1,[POINT 7,J$SMOP(J)]
	TX (<^T'STR'^0>)		;;Generate code for string (NUL at end)
	MOVX	S1,SIG.ER		;;Tell superior we have a message
	$CALL	SIGNAL
	JRST	.+1]
>;DEFINE ERROR

DEFINE FATAL (STR) <
   JRST	[MOVE	S1,[POINT 7,J$SMOP(J)]
	TX (<^T'STR'^0>)		;;Generate code for string (NUL at end)
	MOVX	S1,SIG.FT		;;Tell superior we have a message
	$CALL	SIGNAL
	JRST	.+1]
>;DEFINE FATAL

DEFINE LOGMSG (STR) <
	TXT (0,LOGCHR,<^H^T  'STR'^M^J>)	;;Generate code for string
> ;End of define LOGMSG
	SUBTTL	Special Forms Handling Parameters

; Forms switches as used in LPFORM.TXT
; Note that the switches recognized are different from those used in
; the LPFORM.INI together with LPTSPL.
;
;	BANNER:NN	Number of job headers
;	TRAILER:NN	Number of job trailers
;			A negative value gives that number of BANNER pages
;	HEADER:NN	Number of file headers (picture pages)
;	LINES:NN	Number of lines per page
;	WIDTH:NN	Number of characters per line
;	FF:NN		When to send FF. NN = <FF before banners> +
;			2*<FF before files> + 4*<FF before trailers> +
;			8*<FF after trailers> + 16*<FF for pagination>
;	TABS:NN		If 0, send TAB as is, else use spaces and NN
;			between stops
;	NAME:AA		Name of printer on remote system
;	TYPE:NORMAL/SCRZAP/8BIT/RAW Type of file being sent. SCRZAP and 8BIT
;			overrides the switches given with PRINT
;			Also tells UNIX which filter to use, see UXT.1
;			

; What the abbreviations mean:
;	NN	is a decimal number
;	AA	is a string of 1 to 20 ASCII characters

; Location specifiers
;	ALL		all lineprinters
;	LOCAL		all lineprinters at the central site
;	REMOTE		all remote lineprinters
;	LPTOOO		lineprinter OOO only

;NOTE:  PPNSPL will use the first entry which meets the location
;	specification for its lineprinter.

DEFINE F,<
	FS	BANNER,0
	FS	TRAILER,0
	FS	HEADER,0
	FS	LINES,^D60
	FS	WIDTH,^D80
	FS	FF,^D16
	FS	NAME,0
	FS	TABS,0
	FS	TYPE,<SIXBIT /RAW/>
>

;Generate table of default parameters
DEFINE FS(X,Y),<
	XLIST
D$'X:	EXP	Y
	LIST
	SALL
>

FFDEFS:	F
	F$NSW==.-FFDEFS

	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


;/FF switch bits
	F$FFBB==1		;FF before banner
	F$FFBF==2		;FF before file
	F$FFBT==4		;FF before trailer
	F$FFAT==8		;FF after trailer
	F$FFPG==16		;Do pagination
	SUBTTL	Stream Data Area

;The area between J$$BEG and J$$END is allocated when the stream is
;started and the inferior is spawned. Deallocated when shutdown and
;inferior killed.

;The LP macro will reserve one page right here to store the 
;request (NEXTJB message)
	LP J$$BEG,0			;Beginning of parameter area

;General stream params
	LP J$SSTK,STKSIZ		;Stack
	LP J$SFRK,1			;Handle on fork
	LP J$PLIST,1			;Printer list entry
	LP J$SDPC,1			;PC where last dismissed for I/O
	LP J$SDTM,1			;Time when last dismissed
	LP J$SIST,1			;Stream stat, set by inferior at end
					; See ISTTAB for values.
	LP J$SMOP,^D<15>		;Buffer for message passed to top fork
	LP J$SICD,1			;Stream command
					;Right half is set when inf. is started
					;See ICDTAB for values.
					;Left half holds cancel command bits
		ICD.AB==1B0		;Abort bit
		ICD.RQ==1B1		;Requeue bit
	LP J$SMLG,^D<15>		;Buffer for message when inferior abort
	LP J$SOBJ,OBJ.SZ		;Object (Printer) parameters
	LP J$SCKP,1			;Time for next checkpoint
	LP J$SPTL,1			;Protocol, see below in PTLTAB
	LP J$SSTG,^D<15>		;Translated device name string

;Current request parameters
	LP J$RFLN,1			;Number of files in request
	LP J$RLIM,1			;Job limit in pages
	LP J$RTIM,1			;Start time of job
	LP J$RLFS,1,Z			;Adr of log file spec
	LP J$RHNM,5,Z			;Name of remote host if used
	LP J$RRST,1			;Status of job in remote queue
	LP J$RLPT,10			;Name of remote printer

;Parameters saved in checkpoints.
;All protocols don't use all fields. PTLTTY uses all fields.
;PTLUNX ignores everything except the flags and device.
	LP J$CBEG,0			;Start of checkpoint params
	LP J$CNFT,1,Z			;Number of files transferred
	LP J$CNCT,1,Z			;Copies of last file transferred
	LP J$CNPT,1,Z			;Pages of last copy transferred
	LP J$CFLG,1,Z			;Status of checkpoint
		CFGCKP==1B0		;Checkpoint taken
		CFGREM==1B1		;Job sits in remote queue
		CFGREQ==1B2		;Job is requeued
	LP J$CEND,1			;End of checkpoint params
	CHKLEN==J$CEND-J$CBEG		;Length of area
	LP J$CMSG,1			;Pointer to routine to generate CKP
					; message output in queue listing

;Output parameters
	LP J$OBFR,OPBFSZ/<36/8>+1	;Output buffer
	LP J$OBPT,1			;Byte pointer
	LP J$OBCT,1			;Byte count
	LP J$OBTZ,1			;Output byte size
	LP J$OJFN,1			;JFN

;Current forms parameters
DEFINE	FS(X,Y),<
	LP J$F'X,1
>

	LP J$FCUR,0			;Start of forms params
	F				;Current forms params
	LP J$LDEV,1			;Actual output device name
	LP J$FORM,1			;Current forms type
	LP J$FWCL,1			;Current width class
	LP J$FLCL,1			;Current length class
	LP J$FJFN,1			;JFN of LPFORM.TXT

;Parameters related to currently printing file
	LP J$ITNM,5			;Temp file name used for UNIX
	LP J$INAM,10			;Filename in recognizable form
	LP J$IEXT,10			;Extension and version no
	LP J$IIPG,1			;Pages to skip if > 0, don't if <=0
	LP J$IJFN,1			;The JFN
	LP J$IFNM,1			;Points to 'real' filename string
	LP J$IBFR,IPBFSZ/<36/7>+1	;Input buffer
	LP J$IBPT,1			;Byte pointer
	LP J$IBCT,1			;Byte count
	LP J$IICT,1			;Max no of bytes in curr size in buffer
	LP J$IIBP,1			;Byte pointer to start of buffer

;Miscellaneous
	LP J$XTOP,1			;Set if at top of form
	LP J$XVPS,1			;Current vertical position
	LP J$XHPS,1			;Current horizontal pos
	LP J$XHBF,^D<20>		;Buffer for banner/header/trailer line
	LP J$XCOD,^D<55>		;/REPORT check routine
	LP J$XFRC,1			;Fortran character repeat count
	LP J$XCNT,1			;Count of chars output with OUTBUF
	LP J$XTMP,^D<25>		;Temporary buffer (strings, param blks)

;Log file parameters
	LP J$LBFR,LGBFSZ/<36/7>+1	;Log buffer
	LP J$LBPT,1			;Byte pointer
	LP J$LBCT,1			;Byte count

;Accounting params
	LP J$ANPT,1,Z			;Total no of pages printed

	TRLBFL==:10000			;Length of buffer for trailer info
	LP TRLBUF,TRLBFL		;Buffer for trailer info
	LP TRLCNT,1
	LP TRLPTR,1
	NERBUF==:100			;Buffer for error information
	LP ERRBUF,NERBUF		;Allocate it
	LP ERRFLG,1			;The error flag

	LP FOOBUF,1000
	LP PRNAME,40
	LP HSTNAM,40
	LP UNIQNM,40
	LP UNIQHN,40
	LP TIMADR,1
	LP PRENAM,1
	LP PREJFN,1
	LP PLAINP,1
	LP FILCNT,1
	LP TCPJFN,1
	LP CFBUF,1000
	LP CFPTR,1
	LP CFCNT,1

	LP J$$END,1			;End of parameter area
	J$$LEN==J$$END-J$$BEG		;Length of parameter area

;Now generate a bit table of which words in the stream data area 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 used by top fork

STACK:	BLOCK STKSIZ		;Top's stack
MESSAG:	BLOCK 1			;Address of message just received
BLKADR:	BLOCK 1			;IPCF message block addr save area
SAB:	BLOCK SAB.SZ		;A send argument block
MSGBLK:	BLOCK 2*MSBSIZ		;A block to build long messages in
STREAM:	BLOCK 1			;Number of current stream, index in STRPAR
INTFLG:	BLOCK 1			;Set to -1 on interrupts, 0 before
RSTFLG:	BLOCK 1			;-1 if main loop may be restarted, 0 otherwise
TMPBUF:	BLOCK ^D20		;Temp. buffer
SYSNAM:	BLOCK ^D15		;Sysname 

;Permanent stream parameters
STRPAR:	BLOCK NPRINT		;Address of the stream's (inferior fork's)
				; parameter Area. 0 if not allocated
	SUBTTL	Message blocks and other constants

	INTVEC==:LEVTAB,,CHNTAB

IB:	$BUILD IB.SZ
	 $SET(IB.PRG,,%%.MOD)			;Program name
	 $SET(IB.INT,,INTVEC)			;Interrupt vector address
	 $SET(IB.PIB,,PIB)			;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,1)			;Interrupt on channel 1
	$EOB

HELLO:	$BUILD HEL.SZ
	  $SET(.MSTYP,MS.TYP,.QOHEL)		;Message type
	  $SET(.MSTYP,MS.CNT,HEL.SZ)		;Message length
	  $SET(HEL.NM,,<'PPNSPL'>)		;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
	SUBTTL 	PPNSPL - Multiple PostScript Printer Spooler.

;All code between here and INFST is only executed by the top fork.

PPNSPL:	RESET%				;As usual.
	MOVE P,[IOWD STKSIZ,STACK]	;Set up the stack.
	MOVEI S1,IB.SZ			;Get the IB size.
	MOVEI S2,IB			;Address of the IB.
	$CALL I%INIT			;Set up GALAXY
	MOVX S1,.FHSLF			;Load my fork handle
	MOVX S2,<1B1!1B19>		;1:IPCF, 19:Inf. term.
	AIC%				;Activate the channels
	MOVX S1,.FHSLF			;Enable privileges
	SETOB S2,T1			;All!
	EPCAP%
	 ERJMP	[$STOP (NEP,Could not enable privileges)]
	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,^D14			;And load loop counter
	DO.
	  MOVS S1,T1			;Get n,,table#
	  GETAB%			;Get the entry
	   MOVEI S1,0			;Use zero if losing
	  MOVEM	S1,SYSNAM(T1)		;Store the result
	  CAILE	T2,(T1)			;Done enuf?
	   AOJA	T1,TOP.			;No, loop
	ENDDO.
	PUSHJ P,P%LPIN##		;Get LPFORM.INI
	MOVEI T1,HELLO			;Get address of hello message.
	$CALL SNDQSR			;Say hi to QUASAR.
	$CALL I%ION			;Turn on interrupts
	;Fall through
	SUBTTL	Main Loop
;Restarted at MAIN on interrupts or after 30 secs
MAIN:	DO.
	  SETZM RSTFLG			;Don't restart us now
	  SETZM INTFLG			;and no interrupts seen yet
	  MOVX P1,NPRINT-1		;Max number of streams
	  DO.
	    SKIPN J,STRPAR(P1)		;Is data area allocated?
	     JRST MAI.9			;No, nothing interesting
	    MOVEM P1,STREAM		;Set STREAM also
	    MOVE S1,J$SFRK(J)		;Get its fork handle
	    RFSTS%			;and its status
	     ERJMP [$STOP (NFS,Can't get fork status)]
	    HLRZ S1,S1			;Get interesting part of status word
	    CAIE S1,.RFSLP		;Is it sleeping?
	    CAIN S1,.RFRUN		;Is it running?
	     JRST MAI.8			;Yes, leave it alone
	    CAIE S1,.RFHLT		;Is it halted?
	    IFSKP.
	      SKIPE S1,J$SIST(J)	;Yes, did it signal?
	       $CALL INFTRM		;Yup, go check the message
	      JRST MAI.8		;No, I guess it's just idle
	    ENDIF.
;Now check for hung streams
	    CAIE S1,.RFIO		;Dismissed for I/O?
	    IFSKP.
	      CAME S2,J$SDPC(J)		;Compare PCs
	      IFSKP.
;	        GTAD%			;Get time
;	        SUBX S1,3*DISTIM	;Subtract max I/O wait time
;	        CAMGE S1,J$SDTM(J)	;Compare with prev. check time
;	         JRST MAI.9		;No time-out yet
;	        $WTO (PPNSPL - Stream I/O wait time-out,,J$SOBJ(J))
;	        MOVX S1,%RSUNA		;Shut it down temporarily
;	        $CALL SUPMSG
	        JRST MAI.9		;Check next stream
	      ENDIF.
	      MOVEM S2,J$SDPC(J)	;Save PC
	      GTAD%
	      MOVEM S1,J$SDTM(J)	;and time
	      JRST MAI.9		;Check next stream
	    ELSE.			;Involuntary termination
	      HRRZ T2,S2		;Save PC
	      MOVE S1,J$SFRK(J)		;Get handle on process
	      $CALL ERRSTR		;and get the error string
	      $WTO (PPNSPL - Inferior abnormal termination,^T/TMPBUF/ at ^O/T2/,J$SOBJ(J))
	      MOVX S1,FATERT		;Shut it down properly
	      $CALL SUPMSG
	    ENDIF.
MAI.8:	    SETZM J$SDPC(J)		;Indicate no I/O wait
MAI.9:	    SOJGE P1,TOP.		;Loop over all streams
	  ENDDO.	
	  $CALL CHKQUE			;Take care of any messages
	  SKIPE INTFLG			;Have we been interrupted?
	   LOOP.			;Yes, do another pass
	  SETOM RSTFLG			;We allow restarts now
	  MOVX S1,^D30000		;Sleep for 30 secs
	  DISMS%			;..or until restarted
	  LOOP.
	ENDDO.
;ERRSTR - Puts the errormessage for the most recent error
;into TMPBUF.
;S1 should contain the fork handle for the process.

ERRSTR:	HRLO S2,S1			;Get handle
	HRROI S1,TMPBUF			;Point to the buffer
	SETZ T1,
	ERSTR%
	 JFCL
	  JFCL
	$RETT
	SUBTTL	Interrupt Routines

LEVTAB:	EXP LEV1PC			;Where to store level 1 int PC
	EXP LEV2PC			;Level 2 in case we need it
	EXP LEV3PC			;and 3

CHNTAB:	BLOCK 1				;Don't use channel 0
	XWD 1,INTIPC			;Chn 1, IPCF message - level 1
	BLOCK 1				;not used
	XWD 2,TIMEUP			;Chn 3, timeouts
	BLOCK ^D15			;We don't use these
	XWD 1,INTINF			;Chn 19, Inferior termination
	BLOCK ^D17			;Rest of the table

LEV1PC:	BLOCK 1				;Where to store the PCs
LEV2PC:	BLOCK 1
LEV3PC:	BLOCK 1
;ADR IN 1, TIME IN 2
TIMSET:	Movem	1,TimAdr
	Move	1,[.FHSLF,,.TIMEL]
	MOVEI	3,3		;channel 3
	TIMER%
	 Erjmp	.+1
	RET

TIMCLR:	Move	1,[.FHSLF,,.TIMAL]
	Setz	2,
	TIMER%
	 Erjmp	.+1
	RET

TimeUp:
ifn debug,<
	tmsg <timezup
>
>
	Move	1,TimAdr
	Txo	1,1B5		;turn on user mode bit
	Movem	1,LEV2PC
	DEBRK%
	 Erjmp	.+1
	HALTF%

;INTIPC - Interrupt routine for IPC message
INTIPC:	$CALL C%INTR			;Flag the interrupt for GLXLIB
	JRST INTALL			;Jump to common code

;INTINF - Interrupt routine for Inferior termination
INTINF:
;	JRST INTALL			;Jump to common code

;INTALL - Common part of interrupt handlers
;Sets the interrupts flag INTFLG and restarts the main loop at MAIN
;if restarting is allowed.
INTALL:	SETOM INTFLG			;Flag the interrupt
	SKIPN RSTFLG			;Should we restart?
	 DEBRK%				;NO!!!
	MOVEI S1,MAIN			;Restart at MAIN
	IORX S1,1B5			;Indicate user mode
	MOVEM S1,LEV1PC
	DEBRK%				;Return to MAIN
	SUBTTL	CHKQUE -- Routine to receive and process IPCF messages

CHKQUE:	$SAVE <P1>
	DO.
	  $CALL C%RECV			;Receive a message
	  JUMPF .POPJ			;Return,,nothing there.
	  SETZM BLKADR			;Clear the IPCF msg blk addr save area
	  LOAD S2,MDB.SI(S1)		;Get special index word
	  IFXN. S2,SI.FLG		;Is there an index there?
	    ANDX S2,SI.IDX		;And out the index
	    CAIE S2,SP.OPR		;Is it from OPR?
	    CAIN S2,SP.QSR		;Is it from QUASAR?
	    IFNSK.
	      LOAD M,MDB.MS(S1),MD.ADR	;Get the message address
  	      LOAD S2,.MSTYP(M),MS.TYP	;Get the message type
	      MOVSI S1,-NMSGT		;Make AOBJN pointer for msg types
	      DO.
	        HRRZ T1,MSGTAB(S1)	;Get a message type
	        CAME S2,T1		;Match?
	        IFSKP.			;Yes
	          HLRZ P1,MSGTAB(S1)	;Pick up the address
	          $CALL CHKOBJ		;Check if the printer exists
	          SKIPE			;It doesn't, forget all this
	           $CALL @P1		;All OK, dispatch
	        ELSE.
	          AOBJN S1,TOP.		;No, loop
	        ENDIF.
	      ENDDO.
	    ENDIF.
	  ENDIF.
	  $CALL C%REL			;Release the message
	  LOOP.
	ENDDO.

MSGTAB:	XWD KILL,.QOABO			;Abort message
	XWD CHKPNT,.QORCK		;Request-for-checkpoint
	XWD NXTJOB,.QONEX		;NEXTJOB
	XWD SETUP,.QOSUP		;Setup/shutdown
	XWD OACCON,.OMCON		;Operator continue request.
	XWD OACRSP,.OMRSP		;Operator WTOR response.
	XWD OACREQ,.OMREQ		;Operator requeue request.
	XWD OACCAN,.OMCAN		;Operator cancel request.
	XWD OACPAU,.OMPAU		;Operator pause/stop request.
	XWD OACFWS,.OMFWS		;Operator forward space request.
	XWD OACALI,.OMALI		;Operator align request.
	XWD OACSUP,.OMSUP		;Operator suppress request.
	XWD OACBKS,.OMBKS		;Operator backspace request.
	XWD QSRNWA,.QONWA		;QUASAR node-went-away message
	XWD OPRD60,.OMDSP		;DN60 operator response message
	XWD FORFOR,.QOFCH		;Force forms message
	NMSGT==.-MSGTAB
	SUBTTL	INFTRM - Called when inferior terminates

;Dispatch table for message (termination reason)
ITMTAB:	BDTB
	 DTE (ITM.0,IST.DN)		;Processing completed
	 DTE (ITM.1,IST.ER)		;Error, message in J$SMOP
	 DTE (ITM.2,IST.FT)		;Fatal error, message in J$SMOP
	 DTE (ITM.3,IST.MS)		;Message, in J$SMOP
	 DTE (ITM.4,IST.CP)		;Request for checkpoint
	 DTE (ITM.5,IST.CR)		;Cancel request and get next
	EDTB (ITMLEN)

;J and STREAM should be set properly before this routine is called.
INFTRM:	MOVE S1,J$SIST(J)		;Get message type
	SKIPL S1			;Make sure it's legal
	 CAIL S1,ITMLEN
	  $STOP	(IMI,Illegal Message from Inferior)
	PJRST @ITMTAB(S1)		;Dispatch

;Processing done (SIG.DN)
ITM.0:	HRRZ S2,J$SICD(J)		;Get last command
	HLLZ S1,J$SICD(J)		;and abort flags
	SETZM J$SICD(J)			;and indicate we're idle
	CAXE S2,ICD.SU			;Was it a set up?
	IFSKP.
	  $WTO (PPNSPL - Stream Started,,J$SOBJ(J))
	  MOVX S1,%RSUOK		;Send a response to setup message
	  PJRST SUPMSG
	ELSE.
	  CAXE S2,ICD.NJ		;Or a new job?
	  IFSKP.
	    PUSH P,S1			;Save the abort flags
	    ANDX S1,ICD.RQ		;Only keep requeue flag
	    $CALL QRELEA		;Release/requeue the job
	    POP P,S1			;Restore flags
	    $CALL FILDIS		;and go clean up
	  ELSE.
	    CAXE S2,ICD.CF		;Or new forms?
	    IFSKP.
	      MOVX S1,%RESET		;Default to reset
	      MOVEI T1,MSGBLK		;Get the message block address
	      MOVEM S1,STU.CD(T1)	;Save the status
	      HRLI S1,J$SOBJ(J)		;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
	      PJRST SNDQSR		;Send it off to QUASAR
	    ENDIF.
	  ENDIF.
	ENDIF.
	$RETT				;Neither, just return

;Error (SIG.ER)
ITM.1:	$WTO (PPNSPL - Error in Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
	MOVX S1,%RSUNA			;Say device is temporarily unavailable
	PJRST SUPMSG			;and shut it down

;Fatal error (SIG.FT)
ITM.2:	$WTO (PPNSPL - Fatal Error in Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
	MOVX S1,FATERT			;Say device permanently gone
	PJRST SUPMSG			;and shut it down

;Message to OPR (SIG.MS)
ITM.3:	$WTO (PPNSPL - Message from Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
	SKIPA

;Request for checkpoint (SIG.CP)
ITM.4:	 $CALL CHKPNT			;Take the checkpoint
	MOVE S1,J$SFRK(J)		;Get inferior's fork handle
	IORX S1,SF%CON			;Set continue bit
	SFORK%				;and continue it
	IFJER.
	  MOVX S1,.FHSLF
	  $CALL ERRSTR			;Get error string
	  $WTO (PPNSPL - Could not continue inferior,^T/TMPBUF/,J$SOBJ(J))
	  MOVX S1,%RSUNA		;Shut down for a while
	  PJRST SUPMSG
	ENDIF.
	$RETT

;Cancel request and continue (SIG.CR)
; We got here because file was unprintable for some reason (did not exist)
ITM.5:	SETZ S1,			;Cancel request
	$CALL QRELEA
	$CALL FILDIS			;Go clean up any files
	$RETT
	SUBTTL	Status and checkpoint routines

;CHKPNT -- Request for Checkpoint
;This routine is to checkpoint the job whose data area is pointed to by J.
;A stream should only be checkpointed when the inferior fork has requested
;it.

;Dispatch table for J$CMSG
CHKDTB:	BDTB
	 DTE (CHK.0,MSG.NOR)		;Standard message
	 DTE (CHK.1,MSG.XFR)		;Message when transferring files
	 DTE (CHK.2,MSG.RQU)		;Message when in remote queue
	EDTB (CKTLEN)

CHKPNT:	$SAVE <P1>			;Save P1
	MOVEI P1,MSGBLK			;And let it point to the block
	MOVX S1,CH.FCH!CH.FST		;Get checkpoint and status flags
	STORE S1,CHE.FL(P1)		;And store them
	LOAD S1,.EQITN(J)		;Get job's ITN
	MOVEM S1,CHE.IT(P1)		;And store it
	MOVX S1,CFGCKP
	ORM S1,J$CFLG(J)
	HRRI S1,CHE.IN(P1)		;Set up for BLT, ?,,dest
	HRLI S1,J$CBEG(J)		;Source,,dest
	BLT S1,J$CEND-J$CBEG+CHE.IN-1(P1)	;Move it
	SKIPN S1,J$CMSG(J)		;Get message type
	 $RETT				;Hasn't been set yet, so forget it
	SKIPL S1			;Make sure type is legal
	 CAIL S1,CKTLEN
	  $STOP (ICM,Illegal Checkpoint Message Specified)
	$CALL @CHKDTB(S1)		;Dispatch
	MOVE S1,[POINT 7,CHE.ST(P1)]	;Point to string just created
	ILDB S2,S1			;Get a byte
	JUMPN S2,.-1			;Get to last NUL
	HRRZ S1,S1			;Just keep address i.e. length
	AOJ S1,				;Add one word
	STORE S1,.MSTYP(P1),MS.CNT	;and save it
	MOVX S1,.QOCHE			;Set the function
	STORE S1,.MSTYP(P1),MS.TYP
	MOVE T1,P1			;Point to the message
	PJRST SNDQSR			;and send it

;Standard checkpoint message
CHK.0:	$TEXT (<-1,,CHE.ST(P1)>,<Started at ^C/J$RTIM(J)/, printed ^D/J$ANPT(J)/ of ^D/J$RLIM(J)/ pages^0>)
	$RETT

;Message when transferring files
CHK.1:	LOAD T1,.EQSPC(J),EQ.NUM	;Get no of files in request
	AOJ T1,				;Add one control file
	SKIPE J$FBAN(J)			;Banner file?
	 AOJ T1,			;Yes, another file
	SKIPE	J$FTRA(J)		;Trailer file?
 	 AOJ T1,			;Yes, another file
	$TEXT (<-1,,CHE.ST(P1)>,<Started at ^C/J$RTIM(J)/, transferred ^D/J$CNFT(J)/ of ^D/T1/ files to ^T/J$RHNM(J)/^0>)
	$RETT

;Message when job is in queue on remote system
CHK.2:	SKIPE T1,J$RRST(J)		;Get position in remote queue
	IFSKP.
	  $TEXT (<-1,,CHE.ST(P1)>,<Now printing on ^T/J$RHNM(J)/^0>)
	ELSE.
	  $TEXT (<-1,,CHE.ST(P1)>,<Number ^D/J$RRST(J)/ in queue on ^T/J$RHNM(J)/^0>)
	ENDIF.
	$RETT
	SUBTTL	Requeue/Release routines

;QRELEASE -- Routine to send a release/requeue msg to QUASAR.
;If S1 = 0 it's a release else a requeue.
QRELEA:	PUSH P,S1			;Save param for a while
	$WTOJ (PPNSPL - End,<^R/.EQJBB(J)/>,J$SOBJ(J)) ;TELL THE OPERATOR.
	$LOG (PPNSPL - Printed ^D/J$ANPT(J)/ pages,,J$SOBJ(J)) ; Log it
	MOVEI S1,MSBSIZ			;Get block length
	MOVEI S2,MSGBLK			;And the address
	$CALL .ZCHNK			;Zero the block
	POP P,S1			;Restore parameter
	IFE. S1				;No requeue
	  MOVEI T1,MSGBLK		;GET ADDRESS OF THE BLOCK
	  LOAD S1,.EQITN(J)		;GET THE ITN
	  STORE S1,REL.IT(T1)		;STORE IT
	  MOVX S1,REL.SZ		;GET RELEASE MESSAGE SIZE
	  MOVX S2,.QOREL		;AND FUNCTION
	ELSE.
	  MOVEI T1,MSGBLK		;Address of the block
	  LOAD S1,.EQITN(J)		;Get the ITN
	  STORE S1,REQ.IT(T1)		;and save it away
	  MOVE S1,J$CFLG(J)		;Set Requeue flag in checkpoint data
	  TXO S1,CFGREQ
	  MOVEM S1,J$CFLG(J)
	  SETZM J$CNFT(J)		;Say no files printed
	  SETZM J$CNCT(J)		;Say no copies of last one printed
	  SETZM J$CNPT(J)		;Say no pages of last copy printed
 	  HRRI S1,REQ.IN(T1)		;set up for BLT, ?,,dest
	  HRLI S1,J$CBEG(J)		;source,,dest
	  BLT S1,J$CEND-J$CBEG+CHE.IN-1(T1)	;and move it
	  MOVX S1,RQ.HBO		;Set hold by operator
	  STORE S1,REQ.FL(T1)
	  MOVX S1,REQ.SZ		;Size
	  MOVX S2,.QOREQ		;and function
	ENDIF.
	STORE S1,.MSTYP(T1),MS.CNT	;STORE SIZE
	STORE S2,.MSTYP(T1),MS.TYP	;AND CODE
	PJRST SNDQSR			;SEND IT TO QUASAR
;FILDIS -- Routine to keep/delete printed files.
;Called when a job is released
;Whether the user has delete access or not to the file has
;already been checked in INPOPN.
;S1 is <> 0 if job was aborted, 0 if normal termination.

FILDIS:	$SAVE <P1,P2>
	MOVE P2,S1			;Save the param
	LOAD E,.EQLEN(J),EQ.LOH		;Get the header length
	ADD E,J				;Point to first file
	LOAD P1,.EQSPC(J),EQ.NUM	;Get the number of files
	DO.
	  LOAD T1,.FPLEN(E),FP.LEN	;Get the FP length
	  ADD T1,E			;Compute the FD address
	  MOVEI S2,.FDSTG		;File name offset
	  ADD S2,T1			;S2 points to file name string
	  MOVE T2,.FPINF(E)		;Get the file info word
	  LOAD E,.FPLEN(E),FD.LEN	;Get the FD length
	  ADD E,T1			;Point E at next FP block
	  HRRO S2,S2			;Make a pointer to file name
	  MOVX S1,<GJ%SHT!GJ%OLD>	;Short form and file must exist
	  GTJFN%			;Get a handle
	  IFNJE.
	    IFXE. T2,FP.SPL		;Is this file spooled?
	      IFE. P2			;Normal termination?
	        IFXN. T2,FP.DEL		;Yes, do we want it deleted?
	  	  DELF%			;Delete it
	  	   ERJMP .+1
	        ENDIF.
	      ENDIF.
	    ELSE.
	      IORX S1,DF%EXP		;Delete and expunge
	      DELF%
	       ERJMP .+1
	    ENDIF.
	    RLJFN%			;Release JFN (just to be sure)
	     ERJMP	.+1		;We get a lot of errors
	  ENDIF.
	  SOJG P1,TOP.			;Go process the next file
	ENDDO.
	$RETT
	SUBTTL	CHKOBJ -- Routine to validate QUASAR/ORION/OPR msg obj blks.

;CALL:  S1/OFFSET INTO MSGTAB
;	S2/MESSAGE TYPE

;RET:	J/Points to stream's data area
;	STREAM/Set to stream number
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 message?
	IFNSK.
	  DO.
	    $CALL GETBLK		;Get a message block
	    JUMPF .RETF			;No more, that's an error
	    CAIE T1,.OROBJ		;Is this the object block?
	     LOOP.
	  ENDDO.
	  MOVE S1,T3			;Get the block data address in S1.
	ELSE.
	    XCT [MOVEI S1,ABO.TY(M)	;Get abort msg obj address.
		 MOVEI S1,RCK.TY(M)	;Get checkpoint msg obj address.
	  	 MOVEI S1,.EQROB(M)](S1) ;Get nextjob msg obj address.
	ENDIF.
	$CALL FNDOBJ			;Go find the object block.
	JUMPF .RETF			;Not there, that's an error.
	$RETT				;Return.
;GETBLK -- Routine to break down an IPCF message 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
;FNDOBJ -- Check if the specified object (printer) exists
;Returns true with J pointing to parameter area and STREAM set
;to stream number if it does. Otherwise false.

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
	DO.
FNDO.1:	SKIPN S1,STRPAR(T4)		;Stream allocated?
	IFSKP.
	  MOVEI S2,J$SOBJ(S1)		;Get address of object block
	  CAMN T1,OBJ.TY(S2)		;Compare
	  CAME T2,OBJ.UN(S2)		;Compare
	  IFSKP.
	    CAMN T3,OBJ.ND(S2)		;Compare
	     JRST ENDLP.
	  ENDIF.
	ENDIF.
	  AOJ T4,			;Increment
	  CAIL T4,NPRINT		;The end of the line?	
	   $RETF			;Yes, return 'object not there'
	  LOOP.
	ENDDO.
	MOVE J,STRPAR(T4)		;Return pointer to parameter area
	MOVEM T4,STREAM			;and which stream it is
	$RETT
	SUBTTL	SNDQSR -- Routine to send a message to QUASAR.

;T1 should point to the message block
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
	$CALL C%SEND			;Send the message
	JUMPT .RETT			;And return
	$STOP (QSF,Send to QUASAR FAILED)
	SUBTTL	SETUP/SHUTDOWN Message processing

;M contains a pointer to the message
;J is not defined yet
SETUP:	$SAVE <P1,P2>			;Save temp regs
	LOAD S1,SUP.FL(M)		;Get the flags
	IFXN. S1,SUFSHT			;Is it a shutdown?
	  CALL SHUTDN			;Yes, do it
	ELSE.
	  SETZ T2,			;Clear a loop reg
	  DO.
	    SKIPN STRPAR(T2)		;A free stream?
	    IFSKP.
	      CAIGE T2,NPRINT-1		;No, loop thru them all?
	       AOJA T2,TOP.		;No, keep going
	      $STOP (TMS,Too many setups)
	    endif.
	  ENDDO.
	  MOVEI S1,J$$END+PAGSIZ-1	;Get LPT DB length rounded up a page
	  IDIVI S1,PAGSIZ		;Get number of pages in S1
	  $CALL M%AQNP			;Allocate them
	  PG2ADR S1			;Convert to an address
	  MOVEM S1,STRPAR(T2)		;And save it
	  MOVE J,S1			;Put it in J
	  MOVEM T2,STREAM		;Set STREAM also
	  SETZM J$SFRK(J)		;We don't have the inferior yet
	  MOVEI S2,J$SOBJ(J)		;Save object block
	  HRLI S2,SUP.TY(M)
	  BLT S2,OBJ.SZ+J$SOBJ-1(J)	;Get it
	  LOAD S2,SUP.FL(M),SPLTAP	;Are we trying to spool to tape?
	  IFN. S2
	    $WTO (PPNSPL - Not started,spooling to tape not supported,J$SOBJ(J))
	    MOVX S1,FATERT		;Signal does not exist
	    JRST SUPMSG
	  ENDIF.
	  MOVEI P1,J$SOBJ(J)		;Get our object block address
	  SETZ S1,			;Default node name of LOCAL
	  MOVE S2,OBJ.UN(P1)		;Get the unit number
	  $CALL P%FUNI##		;Find the printer entry
	  SKIPE
	  IFSKP.			;On failure...
	    $WTOJ (<Setup error>,<Printer not defined for this system>,J$SOBJ(J))
	    MOVX S1,FATERT		;Signal does not exist
	    JRST SUPMSG
	  ENDIF.
	  MOVEM S2,J$PLIST(J)		;Store printer list
	  MOVE S1,OBJ.UN(P1)		;Get unit number
	  IDIVI S1,^D10
	  LSH S1,6			;[wew] Shift top digit one char
	  ADDI S1,(S2)			;[wew] Add in lower digit
	  ADD S1,[SIXBIT/LPT000/]	;Create physical name
	  MOVEM S1,J$LDEV(J)		;Save it
	  $TEXT (<-1,,J$XTMP(J)>,<PLPT^D/OBJ.UN(P1)/^0>) ;create unit name
	  MOVX S1,.LNSSY		;Transl. from logical to physical
	  HRROI S2,J$XTMP(J)		;Point to logical name
	  HRROI T1,J$SSTG(J)		;and where to store translation
	  LNMST% 
	  IFJER.
	    $TEXT (<-1,,J$SSTG(J)>,<PLPT^D/OBJ.UN(P1)/:^0>)
	  ENDIF.

	  MOVX S1,CR%MAP!CR%CAP!CR%ACS	;Same address space and priv's
	  SETZ S2,			;Let it have these ACs to start with
	  CFORK%
	  IFJER.
	    MOVX S1,.FHSLF		;Get handle on myself
	    $CALL ERRSTR		;Get error string
	    $WTO (PPNSPL - Not started,<Can't create inferior, ^T/TMPBUF/>,J$SOBJ(J))
	    MOVX S1,FATERT
	    JRST SUPMSG
	  ENDIF.
	  MOVEM S1,J$SFRK(J)		;Save fork handle
	  HRL S2,S1			
	  HRRI S2,DDTSEC		;source
	  MOVSI S1,.FHSLF		;destination
	  MOVX T1,SM%RD!SM%WR!SM%EX!1	;one section, full access
	  SMAP%				;copy DDT
	   ERJMP .+1
	  MOVE S1,J$SFRK(J)		;get fork handle back
	  MOVX S2,ICD.SU		;Tell her we're starting up
	  MOVEM S2,J$SICD(J)
	  MOVEI S2,INFST		;Get start address
	  SFORK%			;Here we go
	  IFJER.
	    MOVX S1,.FHSLF
	    $CALL ERRSTR
	    $WTO (PPNSPL - Not started,<Can't start inferior, ^T/TMPBUF/>,J$SOBJ(J))
	    MOVX S1,FATERT
	    JRST SUPMSG
	  ENDIF.
	ENDIF.
	$RETT
	SUBTTL	Routines to signal startup OK and errors to QUASAR

;SUPMSG - Startup message. Sends a response to setup message to
;QUASAR. The message type is passed in S1 and is one of %RSUOK,
;%RSUDE or %RSUNA. It is also called on errors, in which case the
;stream is shut down.
SUPMSG:	$CALL RSETUP			;Send the response to setup msg.
	CAXE S1,%RSUOK			;Was it OK
	 CALL SHUTIN			;No, restore everything
	$RETT				;Yes, return

;RSETUP -- Routine to send a response-to-setup msg to QUASAR
; S1 contains condition code
RSETUP:	$SAVE S1			;Save the setup condition code.
	MOVE T2,S1
	MOVEI S1,RSU.SZ			;Get message length
	MOVEI S2,MSGBLK			;And the address of the block
	$CALL .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
	HRLI S1,J$SOBJ(J)		;Get OBJADR,,0
	HRRI S1,RSU.TY(T1)		;And place to move it to
	BLT S1,RSU.TY+OBJ.SZ-1(T1)	;And move the object block
	STORE T2,RSU.CO(T1)		;Store the response code
	MOVX S1,%LOWER			;Some device attributes
	STORE S1,RSU.DA(T1),RO.ATR	;Store the device attributes
	PJRST SNDQSR			;And send the message
	SUBTTL	SHUTDN -- Routine to shut down stream

;This routine has two entry points. SHUTDN is called when the QUASAR
;message is received and has FNDOBJ set the J reg and STREAM.
;SHUTIN is an internal shutdown and assumes that J and STREAM are already
;properly set.
SHUTDN:	MOVEI S1,SUP.TY(M)		;Get the object block address
	$CALL FNDOBJ			;Find the object block
	JUMPF .RETT			;No object,,then nothing to shut down

SHUTIN:	MOVE S1,J$SFRK(J)		;Get handle
	IFN. S1
	  KFORK%			;and kill it
	  IFJER.
	    $STOP (CKI,Could not kill inferior)
	  ENDIF.
	  SETO S1,			;Release all loose handles
	  RFRKH%
	  IFJER.
	    $STOP (CRF,Could not release fork handle)
	  ENDIF.
	ENDIF.

	CALL TCPCLS

	MOVE S1,STREAM			;Get our stream number
	SETZM STRPAR(S1)		;Indicate no allocated Job Area
	MOVEI S1,J$$END+PAGSIZ-1	;Get the lpt data base length
	IDIVI S1,PAGSIZ			;Get number of pages in S1
	MOVE S2,J			;Get the STRPAR address
	ADR2PG S2			;Convert to a page number
	$CALL M%RLNP			;Return them
	$CALL M%CLNC			;GET RID OF UNWANTED PAGES.
	$WTO (PPNSPL - Stream Shutdown,,J$SOBJ(J))
	$RETT
	SUBTTL	NXTJOB -- NEXTJOB Message from QUASAR

;J points to the stream data area
;M points to the message
NXTJOB:	HRR S1,J			;Move the request block into job area
	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
	SKIPN J$SICD(J)			;Is inferior idle?
	IFSKP.
	  $WTO (PPNSPL - QUASAR error,New job received for already busy stream,J$SOBJ(J))
	  MOVX S1,FATERT
	  JRST SUPMSG
	ENDIF.
	MOVX S1,ICD.NJ			;Tell her it's a new job
	MOVEM S1,J$SICD(J)
	MOVE S1,J$SFRK(J)		;Get process handle
	MOVEI S2,INFST			;Get start address
	SFORK%				;Here we go
	IFJER.
	  MOVX S1,.FHSLF		;Get handle on myself
	  $CALL ERRSTR			;and error string
	  $WTO (PPNSPL - New request failed,<Can't restart inferior, ^T/TMPBUF/>,J$SOBJ(J))
	  MOVX S1,FATERT
	  JRST SUPMSG
	ENDIF.
	$WTOJ (PPNSPL - Start,<^R/.EQJBB(J)/>,J$SOBJ(J)) ;Tell OPR
	$RETT
	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
	SKIPN J$SICD(J)			;Is inferior idle?
	IFSKP.
	 $WTO (PPNSPL - QUASAR error,Forms request received for already busy stream,J$SOBJ(J))
	  MOVX S1,%RSUNA
	  JRST SUPMSG
	ENDIF.
	MOVX S1,ICD.CF			;Tell her we want new forms
	MOVEM S1,J$SICD(J)
	MOVE S1,J$SFRK(J)		;Get process handle
	MOVEI S2,INFST			;Get start address
	SFORK%				;Here we go
	IFJER.
	  MOVX S1,.FHSLF
	  $CALL ERRSTR
	  $WTO (PPNSPL - Setting forms failed,<Can't restart inferior, ^T/TMPBUF/>,J$SOBJ(J))
	  MOVX S1,FATERT
	  JRST SUPMSG
	ENDIF.
	$RETT
	SUBTTL Job Cancel and Requeue requests

;KILL - User CANCEL Request
KILL:	MOVE S1,J$SICD(J)		;Have we already told inf. to abort?
	IFXE. S1,ICD.AB
	  $TEXT(<-1,,J$SMLG(J)>,<Job canceled by user ^U/ABO.ID(M)/^0^A>)
	  TXO S1,ICD.AB			;Tell her it's time to stop
	  MOVEM S1,J$SICD(J)
	  $WTOJ (<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,J$SOBJ(J))
	ENDIF.
	$RETT

;CANCEL - Operator Cancel request
OACCAN:	DO.
	  $CALL GETBLK			;Get a message block
	  IFN.
	    CAIE T1,.CANTY		;Is this the cancel type block?
	     LOOP.
	    MOVE S1,0(T3)		;Load the cancel type.
	    CAIE S1,.CNPRG		;Is it /purge?
	     LOOP.
	    MOVE S1,J$SFRK(J)		;Get handle
 	    HFORK%			;and stop it
	    IFJER.
	      $STOP (CKA,Could not halt inferior in purge request)
	    ENDIF.
	    MOVX S1,SIG.DN		;Fake a DONE message from inferior
	    MOVEM S1,J$SIST(J)
	  ELSE.
	    $TEXT(<-1,,J$SMLG(J)>,Job aborted by OPERATOR^0^A) ;Log message
	    MOVX S1,ICD.AB		;Tell her it's time to stop
	    IORM S1,J$SICD(J)
	  ENDIF.
	  $ACK (PPNSPL - Aborting,<^R/.EQJBB(J)/>,J$SOBJ(J),.MSCOD(M))
	  $RETT
	ENDDO.

;OACREQ -- Operator REQUEUE request.
;Jobs are always requeued to start from the beginning.
OACREQ:	$TEXT(<-1,,J$SMLG(J)>,Job requeued by OPERATOR^0^A) ;Log message
	MOVX S1,ICD.RQ			;Tell her it's time to stop
	IORM S1,J$SICD(J)
	$ACK (PPNSPL - requeued,<^R/.EQJBB(J)/>,J$SOBJ(J),.MSCOD(M))
	$RETT
	SUBTTL	Dummy routines for not implemented OPR commands

OACPAU:	$ACK (PPNSPL - ignored,PAUSE not supported,J$SOBJ(J),.MSCOD(M))
	$RETT

OACCON:	$ACK (PPNSPL - ignored,CONTINUE not supported,J$SOBJ(J),.MSCOD(M))
	$RETT

OACSUP:	$ACK (PPNSPL - ignored,SUPPRESS not supported,J$SOBJ(J),.MSCOD(M))
	$RETT

OACALI:	$ACK (PPNSPL - Ignored,ALIGN not supported,J$SOBJ(J),.MSCOD(M))
	$RETT

OACFWS:	$ACK (PPNSPL - Ignored,<FORWARD unsupported, use ABORT>,J$SOBJ(J),.MSCOD(M))
	$RETT

OACBKS:	$ACK (PPNSPL - Ignored,<BACKSPACE unsupported, use REQUEUE>,J$SOBJ(J),.MSCOD(M))
OACRSP:	$RETT				;Simply return
QSRNWA:	$RETT				;Not used here, just return
OPRD60:	$RET				;Should not happen
	SUBTTL	Code for inferior forks

;The following code is executed only by the inferior forks.
;It cannot use the GLXLIB since some parts of it are not reentrant.
;In particular, the $TEXT macro must not be used.
;
;The inferior is always started and restarted at INFST.
;The function depends on the value of the left half of J$SICD.
;The inferior always terminates with a HALTF% prior to which it
;puts the termination reason into J$SIST.
;The right half of J$SICD is used to pass commands while running such
;as abort and requeue.

;Dispatch table for the different functions
ICDTAB:	BDTB
	 DTE (INF.0,ICD.SU)		;Inferior runs first time (Startup)
	 DTE (INF.1,ICD.NJ)		;New job present in message area
	 DTE (INF.2,ICD.CF)		;Change forms command
	EDTB (ICDLEN)

INFST:	RESET%				;Clean up
	MOVX S1,<IOWD STKSIZ,J$SSTK>	;Set up the stack
	ADD S1,J			;Add data area offset to stack pointer
	MOVE P,S1			;and init it

	MOVEI 1,.GTHNS
	HRROI 2,HSTNAM
	SETO 3,
	GTHST%
	 ERJMP [FATAL <Cant get local host name>]

	MOVEI S1,.FHSLF			;Set up the interrupt system
	MOVE S2,[LEVTAB,,CHNTAB]	;Point to the tables
	SIR%
	EIR%
	MOVX S2,<1B2!1B3>		;2:  Watchdog channel, 3: timeouts
	AIC%
	SETZM J$SIST(J)			;Reset termination status
	HRRZ S1,J$SICD(J)		;Get command
	SKIPLE S1			;Make sure it's legal
	 CAIL S1,ICDLEN
	  FATAL	(Illegal Command to Inferior)
	JRST @ICDTAB(S1)		;Dispatch

;Stream startup
INF.0:	MOVX S1,SIG.DN			;Quit right away
	PJRST SIGNAL

;New job request in message area
INF.1:	MOVEI S1,J$$BEG(J)		;Start address
	MOVSI S2,-<J$$LEN+^D35>/^D36	;AOBJN pointer to bit table
	DO.
	  MOVEI T1,^D36			;Bit counter for this word
	  MOVE T2,ZTABLE(S2)		;Get a word from bit table
	  DO.
	    IFN. T2
	      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
	      TXZ T2,1B0		;And get rid of it
	      LOOP.
	    ENDIF.
	  ENDDO.
	  ADD S1,T1			;Account for the rest of the word
	  AOBJN S2,TOP.			;And loop
	ENDDO.
	LOAD S1,.EQSPC(J),EQ.NUM	;Get number of files
	MOVEM S1,J$RFLN(J)		;Store it
	GETLIM T1,.EQLIM(J),OLIM	;Get page limit
	MOVEM T1,J$RLIM(J)		;Save it
	GTAD%				;Get time of day
	MOVEM S1,J$RTIM(J)		;Save it away
	MOVX S1,<POINT 8,0>		;Set byte pointer for output buffer
	MOVEM S1,J$OBTZ(J)
	$CALL OUTRES			;Init output buffer
	MOVX S1,LGBFSZ			;Log buffer
	MOVEM S1,J$LBCT(J)
	MOVE S1,[POINT 7,J$LBFR(J)]
	MOVEM S1,J$LBPT(J)
	SETZ S,				;Reset all flags
	MOVEI T1,LPTVER			;Get version number
	MOVEI T2,LPTMIN
	LOGMSG (PPNSPL version ^DT1^T.^DT2^T on ^ASYSNAM)
	LOAD T1,.EQSEQ(J),EQ.SEQ	;Get sequence number
	MOVE T2,OBJ.UN+J$SOBJ(J)	;Get unit number
	LOGMSG (Job ^S.EQJOB(J)^T sequence #^DT1^T on Printer ^DT2^T)
	SKIPN T1,J$CFLG-J$CBEG+.EQCHK(J)	;Job previously checkpointed?
	IFSKP.
	  HRRI S1,J$CBEG(J)		;Yes, get checkpoint info: ??,,dest
	  HRL S1,.EQCHK(J)		;source,,dest
	  BLT S1,J$CEND-1(J)		;get it
	  MOVE S1,J$CFLG(J)		;Get checkpoint flags
	  IFXE. S1,CFGREQ		;Job requeued or crashed?
	    LOGMSG (Job Restarted after Failure)
	  ELSE.
	    LOGMSG (Job Restarted after Requeuing)
	  ENDIF.
	ENDIF.
	$CALL DONOR
	MOVX S1,SIG.DN			;Tell superior we're done
	PJRST SIGNAL

;Take care of change forms command
INF.2:	SETZ S,				;Reset all flags
	$CALL FORMS			;Set the forms
	MOVX S1,SIG.DN			;Tell superior we're done
	PJRST SIGNAL
;SIGNAL -- Passes messages to superior by setting the J$SIST var
;and halting. Some of the messages expect the superior to continue
;this fork after processing, others generate error if continued.

;Dispatch table
;The .CC function only generates a signal if it's time to checkpoint, returns
;directly normally. .CP always requests a checkpoint
SIGTAB: BDTB
	 DTE (SIG.0,SIG.DN)		;Done with processing
	 DTE (SIG.1,SIG.ER)		;Error (called by ERROR macro)
	 DTE (SIG.2,SIG.FT)		;Fatal error (called by FATAL macro)
	 DTE (SIG.3,SIG.MS)		;Message (called by OPRMSG macro)
	 DTE (SIG.4,SIG.CP)		;Request for checkpoint
	 DTE (SIG.5,SIG.CC)		;Check if checkpoint needed
	 DTE (SIG.6,SIG.CR)		;Cancel request and go to nxt
	EDTB (SIGLEN)

SIGNAL:	SKIPLE S1			;Make sure command is legal
	 CAIL S1,SIGLEN
	  FATAL	(Illegal Signal Requested)
	JRST @SIGTAB(S1)		;Dispatch

;Processing done
SIG.0:	MOVX S1,IST.DN
	JRST SIG.22

;Error
SIG.1:	MOVX S1,IST.ER
	JRST SIG.22

;Fatal Error
SIG.2:	MOVX S1,IST.FT
SIG.22:	SKIPE J$SIST(J)			;Must be reset
	 FATAL (Inferior's Status not Reset)
	MOVEM S1,J$SIST(J)		;Set new value
	HALTF%				;Stop and tell superior
	FATAL (Illegal Attempt to Continue Inferior)	;Not continuable

;Message to OPR
SIG.3:	MOVX S1,IST.MS
	JRST SIG.42

;Request for checkpoint
SIG.4:	GTAD%				;Get time
	ADDX S1,3*CKPTIM		;Add time until next
	HRRZM S1,J$SCKP(J)		;Out with it, without date
	MOVX S1,IST.CP			;Checkpoint message
SIG.42:	SKIPE J$SIST(J)			;No prev. status set, please
	 FATAL (Inferior's status not reset)
	MOVEM S1,J$SIST(J)
	HALTF%				;Stop and tell superior
	SETZM J$SIST(J)			;We're continuable
	$RETT

;Check if time for a timed checkpoint
SIG.5:	TXNN	S,TIMCKP		;Timed checkpoints enabled?
	 $RETT				;No, forget this
	GTAD%				;Get time
	HRRZ S1,S1			;Remove date
	SUB S1,J$SCKP(J)		;Subtract set time
	JUMPGE S1,SIG.4			;It's time: request one
	$RETT				;Not time yet

;Cancel request and get next (file unprintable or something)
SIG.6:	MOVX S1,IST.CR
	JRST SIG.22
;CHKABT -- Checks if superior wants to abort the processing.
;Returns true if time to abort, false otherwise.
CHKABT:	MOVE S1,J$SICD(J)		;Get command word
	TXNN S1,<ICD.AB!ICD.RQ>		;Abort or requeue
	 $RETF				;None, return false
	$RETT				;Say it's time to quit
;The TXT.xx routines are called by code generated by the
;TXT macro.
;S1 contains a byte pointer which must be updated, or the
;address of routine which outputs one char from C.
;S2 points to the argument.
;All ACs are preserved (except S1 if byte pointer)

;TXT.AS - S2 points to an ASCIZ string
TXT.AS:	$SAVE <S2,T1>			;Save some regs
	MOVE T1,S2			;Get the address
	ADD T1,[POINT 7,0]		;Make it a byte pointer
	DO.
	  ILDB S2,T1			;Incr. the byte pointer
	  SKIPN S2			;Check if end of string
	   $RETT			;Yupp, return
	  CAIE S2,^D22			;Hairy patch to remove ctl-Vs
	   $CALL TXT.CH			;Output the char in S2
	  LOOP.
	ENDDO.

;TXT.DN - S2 points to a word to be output as a decimal number
TXT.DN:	$SAVE <S2,T1>
	PUSH P,S1			;Save S1 temporarily
	MOVE S2,@S2			;Get the number
	HRRO S1,J$XTMP(J)		;Point to temp buffer
	MOVX T1,<FLD ^D10,NO%RDX>	;Decimal radix
	NOUT%
	 ERJMP .+1
TXT.D1:	SETZ S2,			;Put a NUL last in buffer
	IDPB S2,S1
	POP P,S1			;Get destination back
	MOVEI S2,J$XTMP(J)		;Point to buffer
	$CALL TXT.AS			;And output string
	$RETT


;TXT.SX - S2 points to a SIXBIT word
TXT.SX:	$SAVE <S2,T1,T2,T3>
	MOVE T1,@S2			;Get the word
	MOVE T2,[POINT 6,T1]		;Make  a byte pointer
	MOVEI T3,^D6			;Loop counter
	DO.
	  ILDB S2,T2			;Get a byte
	  SKIPN S2			;Is it zero (=space)?
	   $RETT			;Yes, return
	  ADDI S2,40			;Make it ASCII
	  $CALL TXT.CH			;Out with it
	  SOJG T3,TOP.			;Loop
	ENDDO.
	$RETT				;All 6 chars translated

;TXT.DT - S2 points to a word in internal time format
TXT.DT:	$SAVE <S2,T1>
	MOVE S2,@S2			;Get the time
	SETZ T1,
	JRST TXT.T1

;TXT.TI - Outputs current time
TXT.TI:	$SAVE	<S2,T1>
	SETO S2,
	MOVX T1,<OT%NDA>		;Only time
TXT.T1:	PUSH P,S1			;Save dest for a while
	HRROI S1,J$XTMP(J)		;Point to temp buffer
	ODTIM%
	PJRST TXT.D1			;Finish up


;TXT.ER - Outputs the most recent error
TXT.ER:	$SAVE <S2,T1>
	MOVX S2,<.FHSLF,,-1>		;Most recent error
	MOVX T1,^D30			;Max number of chars
	PUSH P,S1			;Save dest for a while
	HRROI S1,J$XTMP(J)		;Point to temp buffer
	ERSTR%
	  TRN
	  TRN
	PJRST TXT.D1			;Finish up

;TXT.CH - Outputs the right adjusted char in S2
;Also handles the source designator in S1 properly.
TXT.CH:	$SAVE	<T1,C>
	HLRZ T1,S1			;Get left half of source design.
	IFN. T1
	  IDPB S2,S1			;Out with it
	ELSE.
	  PUSH P,S1			;Save our address
	  MOVE C,S2			;Get the char into right reg
	  $CALL @S1			;Dispatch
	  POP P,S1			;Restore address
	ENDIF.
	$RETT
	SUBTTL	Common routines used by the different DOxxxx handlers

;FINISH -- Does the accounting and other misc stuff.
;Called immediately before outputting the trailer.
FINISH:	MOVE S1,J$SICD(J)		;Were we aborted or requeued?
	TXNE S1,<ICD.AB!ICD.RQ>
	 LOGMSG (^AJ$SMLG(J))		;Yes, insert message into log
	LOGMSG (Total ^DJ$ANPT(J)^T Pages of Output)
	$RETT
	SUBTTL	DONOR -- Print on a normal TTY-LPT

DONOR:	$SAVE <P1>
	$CALL FORMS			;Get forms mounted

	LOGMSG (Printing to local device ^AJ$SSTG(J)^T, Protocol PTLTTY)
	MOVX T1,MSG.NOR			;Normal checkpoint messages
	MOVEM T1,J$CMSG(J)
	MOVE P1,J$CFLG(J)		;Get old flags before they're changed
	TXO S,TIMCKP			;Enable timed checkpoints
	MOVX S1,SIG.CP			;We want a checkpoint now
	$CALL SIGNAL
	LOAD E,.EQLEN(J),EQ.LOH		;Point to first file in request
	ADD E,J
	IFXN. P1,CFGCKP			;Job restarted?
	  MOVE S2,J$CNFT(J)		;Get no of files prev. sent
	  DO.
	    SOJL S2,ENDLP.		;Skip already printed files
	    $CALL NXTFIL		;Bump E to next spec
	    JUMPF DONO.7		;All already printed
	  ENDDO.
	  MOVE T1,J$CNPT(J)		;Get no of pages prev. printed
	  SUBI T1,3			;We want some overlap
	  SKIPGE T1
	   SETZ T1,			;Lowest page no is zero
	ELSE.
	  LOAD T1,.FPFST(E)		;Get /START param
	  SOJ T1,			;Subtract one
	ENDIF.

	CALL TCPOPN			;open TCP connection to LPD
	CALL LPDPRT			;request remote printer
	SETZM FILCNT

	CALL CFINIT			;init Control File buffer

	MOVEI 2,"H"			;host
	CALL CFSCHR
	HRROI 2,HSTNAM			;our host name
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	MOVEI 2,"P"			;user name
	CALL CFSCHR
	HRROI 2,.EQOWN(J)		;user
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	HRROI 2,FOOBUF
	MOVEI 2,"J"			;job header
	CALL CFSCHR
	LOAD 2,.FPLEN(E),FP.LEN
	ADD 2,E
	ADDI 2,.FDSTG
	HRRO 2,2			;pointer to filename 
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	MOVEI 2,"C"			;host
	CALL CFSCHR
	HRROI 2,HSTNAM			;our host name
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	MOVEI 2,"L"			;user name (and do job header)
	CALL CFSCHR
	HRROI 2,.EQOWN(J)		;user
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	DO.
	  MOVEM T1,J$IIPG(J)		;save as initial page
	  $CALL NORFIL			;Print the file with all copies
	  $CALL NXTFIL			;Get next file
	  SKIPN				;Return true?
	  IFSKP.
	    LOAD T1,.FPFST(E)		;Get /START param
	    SOJ T1,			;Subtract one
	    LOOP.
	  ENDIF.
	ENDDO.

	CALL CFSEND			;send LPD control file
	CALL TCPCLS

DONO.7:
;	SKIPE E,J$RLFS(J)		;Any log file to print?
;	 $CALL NORFIL			;Yes, do it
	$CALL FINISH			;Do the accounting etc
	$RETT
;NORFIL -- Print a File on TTY-LPT
;This routine is always called for each of the files in the request even
;when the job has been canceled. (Although nothing is done in such case.)

NORFIL:	STKVAR <DISPCH,PPNAME>
	$CALL CHKABT			;Are we canceled?
	JUMPT .RETT			;Yes, return
	$CALL LIMCHK			;Are we over limit?
	 $RETIF				;Yes, just return

	$CALL SETPFT			;Setup file type
	MOVEM T1,DISPCH			;Save processing routine address
	MOVEM T2,PPNAME			;Save pointer to prepend file name
	$CALL INPOPN			;Open the input file up
	 $RETIF				;Fail, return
	LOGMSG (Starting File ^A@J$IFNM(J))
	DO.
	  $CALL LIMCHK			;Check if we're over page limit
	  MOVX S1,SIG.CP		;Want a checkpoint now
	  $CALL SIGNAL
	  $CALL CHKABT			;Are we aborted?
	   JUMPT ENDLP.			;Yes
	  MOVE T1,DISPCH		;Get dispatch address
	  MOVE T2,PPNAME		;Get pointer to prepend file name
	  $CALL FILOUT			;Print the file
	  TXNN S,ERRFIL			;Was there an error in the file?
	   $CALL CHKABT			;Are we aborted?
	    JUMPT ENDLP.		;Yes
	  LOAD T1,.FPFST(E)		;Get /START param
	  SOJ T1,			;adjust it
	  MOVEM T1,J$IIPG(J)		;and save for next copy
	  AOS J$CNCT(J)			;Bump copy count
	  LOAD T1,.FPINF(E),FP.FCY
	  CAMLE T1,J$CNCT(J)		;All copies printed?
	   LOOP.
	  $CALL OUTBUF			;Empty buffer
	  AOS J$CNFT(J)			;Yes, bump file count
	  SETZM J$CNCT(J)		;and reset copy count
	  MOVX S1,SIG.CP		;Checkpoint now
	  $CALL SIGNAL
	  LOGMSG (Finished File ^A@J$IFNM(J)) ;Finished OK
	ENDDO.
	$CALL HEADER			;Output header information
	$CALL INPCLS			;Close the file
	TXNE S,SUPFIL			;Are we suppressing forms/file?
	 SETZM J$XTOP(J)		;Yes, set we are not at top of page.
	TXZ S,SUPFIL+ERRFIL		;Clear lots of bits
	$RET				;And return
	SUBTTL  CHKPS -- Check if file is a valid PostScript file
; Return false ($RETF) if not valid PostScript
; Return true ($RETT) if valid PostScript

CHKPS:	STKVAR <PSJFN>
	MOVX S1,GJ%SHT!GJ%OLD
	LOAD S2,.FPLEN(E),FP.LEN
	ADD S2,E
	ADDI S2,.FDSTG
	HRRO S2,S2			;Now have pointer to filename 
	GTJFN%
	IFNJE.
	  MOVEM S1,PSJFN
	  MOVE S2,[1,,.FBCTL]		;Get the control/flags word
	  MOVEI T1,S2			;Return the information in S2
	  GTFDB%
	  IFJER.			;JSYS error...
	    SETZ S2,			;Zero S2 for later
	  ENDIF.
	  LOAD S2,S2,FB%FCF		;Get the file class field
	  CAIE S2,.FBPS			;This a PostScript file?
	  IFSKP.	    
	    RLJFN%			;Flush the JFN
	     TRN			;Jeez, can't win
	    $RETT			;Indeed
	  ELSE.
	    HRRZ S2,S1
	    SETZM TRLBUF(J)
	    HRROI S1,TRLBUF(J)		;Check for extension of PS
	    MOVX T1,FLD(.JSAOF,JS%TYP)	;Just output the extension
	    SETZ T2,
	    JFNS%
	     ERJMP .+1
	    MOVE S1,[ASCIZ/PS/]		;Get what was returned
	    CAME S1,TRLBUF(J)		;Is it?
	    IFSKP.			;Yes...
	      MOVE S1,PSJFN		;Get the JFN
	      RLJFN%
	       TRN
	      $RETT			;PS file found
	    ENDIF.
	  ENDIF.
	ENDIF.
	$RETF
	SUBTTL	NXTFIL -- Find and return the next file in the nextjob msg

;E points to current file descriptor
NXTFIL:	DO.
	  SOSG J$RFLN(J)		;Decrement number of files in request
	   $RETF
	  LOAD T1,.FPLEN(E),FP.LEN	;Get the FP length
	  ADD E,T1			;Bump to the FD
	  LOAD T1,.FDLEN(E),FD.LEN	;Get the fd length
	  ADD E,T1			;Bump to the next FP
	  LOAD T1,.FPINF(E),FP.FLG	;Get log file flag
	  JUMPE T1,.RETT		;Return if not the log file
	  MOVEM E,J$RLFS(J)		;Save address of log file spec
	  LOOP.
	ENDDO.
	SUBTTL	Routines to handle the input files

;INPOPN  --  Routine to open the input file
;Called with E pointing to the file parameter (FP) area for the file
;to be opened.
;J$IFNM is set to point to the file name string.
INPOPN:	SETZM J$IJFN(J)			;No file opened yet
	LOAD S2,.FPLEN(E),FP.LEN	;Get the FP length
	ADD S2,E			;Compute the FD address
	ADDI S2,.FDSTG			;Point to file name string
	HRRZM S2,J$IFNM(J)		;Save the address
	HRRO S2,S2			;Make it a generic byte pointer
	MOVX S1,GJ%SHT!GJ%OLD		;GTJFN flags: file must exist
	GTJFN%
	IFNJE.
	  MOVEM S1,J$IJFN(J)		;Success, save the JFN
	  LOAD S1,.EQSEQ(J),EQ.PRV	;Get the users priv's
	  IFE. S1
	    LOAD S1,.FPINF(E),FP.SPL	;Is the file spooled?
	    IFN. S1			;Yes
	      MOVX S1,FP.DEL		;Set the file to be deleted
	      ORM S1,.FPINF(E)
	    ELSE.
	      HRROI S1,.EQOWN(J)	;Point to owner's name
	      MOVEM S1,.CKALD+J$XTMP(J)	;Put it into arg block
	      HRROI S1,.EQCON(J)	;Point to connected directory
	      MOVEM S1,.CKACD+J$XTMP(J)	;and store it
	      SETZM .CKAEC+J$XTMP(J)	;Indicate no priv's (already checked)
	      MOVE S1,J$IJFN(J)		;JFN
	      MOVEM S1,.CKAUD+J$XTMP(J)
	      MOVX S1,.CKARD		;Only interested in read access
	      MOVEM S1,.CKAAC+J$XTMP(J)
	      MOVX S1,CK%JFN!5		;We pass JFN and 5 words of args
	      MOVEI S2,J$XTMP(J)	;Arg. block
	      CHKAC%
	       SETZ S1,
	      IFE. S1			;Sorry
		LOGMSG (Can't Access File ^A@J$IFNM(J)^T, ^E)
		ZERO .FPINF(E),FP.DEL	;Clear the 'delete file' bit
		SETZM J$IJFN(J)		;and the JFN to indicate no file
		$RETF			;And return
	      ENDIF.
	      MOVX S1,.CKAWR		;Write access this time
 	      MOVEM S1,.CKAAC+J$XTMP(J)
	      MOVX S1,CK%JFN!5		;JFN and 5 words of arg
	      CHKAC%
	       SETZ S1,
	      IFE. S1
	        ZERO .FPINF(E),FP.DEL	;Zero the delete bit if no access
	      ENDIF.
	    ENDIF.
	  ENDIF.
	ENDIF.
	MOVEI S2,7			;Assume 7 bit bytes
	TXNE S,F%PL8!F%PS8!F%PLH8!F%IM8	;Any eight bit bytes?
	 MOVEI S2,8			;Yes, then use 8
	MOVX	T1,^D36			;Bits per word
	IDIV	T1,S2			;Get number of bytes per word to T1
	IMULI	T1,IPBFSZ/<36/7>	;Multiply by # of words in buffer
	MOVEM	T1,J$IICT(J)		;Save count 
	MOVE	T1,S2			;Get bits per byte again
	LSH	T1,^D24			;Build a byte pointer to start of buff.
	IORX	T1,<^D36>B5		;Initial position
	IORI	T1,J$IBFR(J)		;address
	MOVEM	T1,J$IIBP(J)		;and save it
	LSH	S2,^D30			;Get size into position
	IORX	S2,OF%RD		;Only read access
	MOVE	S1,J$IJFN(J)
	OPENF%
	IFNJE.
	  SETZM	J$IBCT(J)		;Indicate input buffer is empty	
	  $CALL	GETNAM			;Get a recognizable file name
	  $RETT
	ELSE.
	  LOGMSG (Can't Access File ^A@J$IFNM(J)^T, ^E)
	  ZERO .FPINF(E),FP.DEL		;Clear the 'delete file' bit
	  SETZM J$IJFN(J)		;and the JFN to indicate no file
	  $RETF				;And return
	ENDIF.
; CHKSIZ - Look at file to find its real byte size
; Returns S2/ byte-size
;	Returns false if bad page or byte count
CHKSIZ:	STKVAR <SIZJFN>
	MOVX S1,GJ%SHT+GJ%OLD
	LOAD S2,.FPLEN(E),FP.LEN
	ADD S2,E
	ADDI S2,.FDSTG
	HRRO S2,S2			;Now have pointer to filename 
	GTJFN%
	 ERJMP .RETF
	MOVEM S1,SIZJFN			;Save JFN
	SIZEF%				;Get byte size
	IFNJE.
	  IFG. S2			;Good byte count?
	    IFG. T1			;Good page count?
	      MOVE S1,SIZJFN
	      MOVE S2,[1,,.FBBYV]	;Read byte size from FDB
	      MOVEI T1,T1		;Put it in T1
	      GTFDB%
	      IFNJE.
		MOVE S1,SIZJFN
		RLJFN%			;Now flush the JFN
		 ERJMP .RETF
	 	LOAD S2,T1,FB%BSZ	;Get byte size into S2
		$RETT
	      ENDIF.
	    ENDIF.
	  ENDIF.
	ENDIF.
	MOVE T1,SIZJFN			;Get back the file JFN
	RLJFN%				;Release it
	 ERJMP .+1			;Some error
	$RETF				;Take failure return
;INPBYT  --  Read a byte from the input buffer. Fills the
;buffer if necessary.
;Returns the character in C. Returns False on EOF.

INPBYT:	$CALL CHKABT			;Are we canceled?
	JUMPT .RETF			;Yes, signal EOF
	SKIPLE J$IBCT(J)		;Any chars in buffer?
	IFSKP.
	  $CALL INPBUF			;No, get a bufferful
	  JUMPF .RETF			;Return false if EOF
	ENDIF.
	ILDB C,J$IBPT(J)		;Get the byte
	SOS J$IBCT(J)			;and decrement count
	$RETT

;INPBUF - Inputs a bufferful
;Returns false if attempt to read past EOF
INPBUF:	MOVE S1,J$IJFN(J)		;JFN
	MOVE S2,J$IIBP(J)		;Byte pointer to start of buffer
	MOVEM S2,J$IBPT(J)		;Save as current pos too
	MOVN T1,J$IICT(J)		;Max count
	SIN%
	IFJER.
	  GTSTS%			;Get status
	  IFXE. S2,GS%EOF		;Check if EOF
	    LOGMSG (<Error Reading Input File, ^E>)
	    TXO S,ERRFIL		;Skip the rest of the file
	  ENDIF.
	ENDIF.
	ADD T1,J$IICT(J)		;Get total number read
	MOVEM T1,J$IBCT(J)		;and save as current count
	SKIPE T1			;If 0 we have EOF
	 $RETT
	$RETF

;INPCLS -- Close the input file
INPCLS:	MOVE S1,J$IJFN(J)
	CLOSF%
	 ERJMP .+1			;Forget errors
	SETZM J$IJFN(J)			;Indicate file is closed
	$RETT

;INPREW  --  Rewind the input file
; I.e. position the file pointer at the beginning of the file
INPREW:	SKIPN S1,J$IJFN(J)
	 $RETF				;Don't do it if file not open
	SETZ S2,
	SFPTR%
	IFJER.
	  FATAL (<Could not Rewind File, ^E>)
	ENDIF.
	SETZM J$IBCT(J)		;Indicate buffer empty
	$RETT
;GETNAM -- Figures out a 'real' name for the just opened file
;E should point to the FP block and J$IFNM to the 'real' file name
;The name is put in J$INAM and extension + version in J$IEXT
GETNAM:	LOAD S1,.FPINF(E)		;Get flags for file
	IFXE. S1,FP.SPL			;Is it a spooled file?
	  IFXE. S1,FP.FLG		;No, is it also the log file?
	    MOVE S2,J$IJFN(J)		;No, get JFN
	    HRROI S1,J$INAM(J)		;Filename first
	    MOVX T1,<FLD .JSAOF,JS%NAM>
	    JFNS%
	    HRROI S1,J$IEXT(J)		;Now extension
	    MOVX T1,<FLD .JSAOF,JS%TYP>
	    JFNS%
	    MOVX T2,"."			;Insert a period
	    IDPB T2,S1
	    MOVX T1,<FLD .JSAOF,JS%GEN>	;and generation
	    JFNS%
	    LOAD S1,.FPINF(E),FP.SPL	;Get the spool bit
	    IFN. S1
	      MOVE T1,[POINT 7,J$INAM(J)]	;Restore the filename byte ptr.
	      MOVEI T2,3	;How many dashes to look for
	      MOVE T3,T1	;And an input pointer
	      DO.
	        ILDB S1,T3		;Get a character
		JUMPE S1,ENDLP.
	        CAIE S1,"-"		;A dash?
	         LOOP.			;No, loop
	        SOJG T2,TOP.		;Yes, loop until 4th field
	      ENDDO.
	      IFN. S1	    
	        DO.
		  ILDB S1,T3		;Get a character
		  IDPB S1,T1		;Deposit it
		  JUMPN S1,TOP.		;And loop until a null
	        ENDDO.
	        MOVEI T2,6		;Load a counter
	        IDPB S1,T1		;And deposit more nulls
	        SOJG T2,.-1		;For width calculation
	        MOVE T1,J$INAM(J)	;Get the first word
	        TLNE T1,774000		;Is there at least one character?
	         $RETT			;Yes
	      ENDIF.	 
	    ENDIF.
	    TXT (1,J$INAM(J),^TSpooled^0)
	    TXT (1,J$IEXT(J),^TPrinter File^0)
	  ELSE.
	    TXT (1,J$INAM(J),^TBatch^0)	;Spooled logs have no reasonable name
	    TXT (1,J$IEXT(J),^TLog File^0) 	;So use something descriptive
	  ENDIF.
	ELSE.
	  TXT (1,J$INAM(J),^TBatch^0)	;Spooled logs have no reasonable name
	  TXT (1,J$IEXT(J),^TLog File^0) 	;So use something descriptive
	ENDIF.
	$RETT
	SUBTTL	FORMS change routines

;FORMS   --  Setup Forms for a job
FORMS:	GETLIM S1,.EQLIM(J),FORM	;Get the forms type
	CAMN S1,J$FORM(J)		;Are forms exactly the same?
	 $RETT				;Yes, return immediately
	MOVE S2,J$FORM(J)		;Get current forms type
	MOVEM S1,J$FORM(J)		;Save new form
	XOR S1,S2			;Get common part
	AND S1,[EXP FRMSK1]		;And it with the important part
	IFE. S1
	  OPRMSG (Forms Changed to ^SJ$FORM(J))	;Tell opr
	ELSE.
	  HRLZI S1,-F$NSW		;Get negative switch table length
	  MOVEI T1,J$FCUR(J)		;Point to curr forms params
	  DO.
	    MOVE S2,FFDEFS(S1)		;Get a default
	    CAME S2,[-1]		;Is this supposed to be defaulted?
	     MOVEM S2,(T1)		;Yes, save it
	    AOJ T1,			;Increment new param store ctr
	    AOBJN S1,TOP.		;And loop
	  ENDDO.
	  SETZM J$RLPT(J)		;No name on remote printer yet
	  $CALL FRMINI			;Read the LPFORM.TXT file.
	  SKIPN
	   OPRMSG (<Forms not found in LPFORM.TXT, Defaults Being Used>)
	  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
	ENDIF.
	$RETT
	SUBTTL	Search for form in LPFORM.TXT

FRMINI:	SKIPGE	S1,J$PLIST(J)		;Get pointer to printer list
	JRST .RETT			;None there,,don't bother
	MOVE S2,J$FORM(J)		;Get FORMS name
	PUSHJ P,P%FFRM##		;Find the FORMS entry
	JUMPF .RETT			;Not there,,return with defaults
	MOVE P1,S2			;Save the FORMS entry address
	LOAD S1,FF.LEN(P1),FF.WID	;Get width
	SKIPE S1			;Skip if nothing there
	 MOVEM S1,J$FWID(J)		;Save the width
	LOAD S1,FF.LEN(P1),FF.LIN	;Get page size
	SKIPE S1			;None there
	 MOVEM S1,J$FLIN(J)		;Save the page length
	$RETT				;Return true
	SUBTTL	Routines for the logging
;LOGCHR - Puts the char in C in the log buffer
;No return if buffer overflows.
LOGCHR:	SOSL	J$LBCT(J)		;Decrement the byte cout
	IFSKP.
	  OPRMSG (Aborted - Log File too Big)
	  MOVX S1,SIG.DN		;Tell superior we're done
	  $CALL	SIGNAL
	ENDIF.
	IDPB	C,J$LBPT(J)		;Deposit a byte
	$RETT
	SUBTTL	Routines to handle output

;OUTCHR puts the char in reg C in the outbuffer and dumps it if necessary
;It also keeps track of the horizontal position for simulated TABs and
;skips the output if we're skipping pages.
OUTCHR:	IFXN. S,FILXFR			;Transfering a file?
	  SKIPLE J$IIPG(J)		;Yes, Any pages to skip?
	   $RETT			;Yes, don't output anything
	ENDIF.
	CAIL C," "			;Is it a printable char?
         AOSA J$XHPS(J)			;Yes, increment horz counter
          SETZM J$XHPS(J)               ;No (probably CR or FF), zero counter
	SETZM J$XTOP(J)			;Clear the top-of-form flag
	CAIN C,.CHFFD			;Is it a formfeed?
	 SETOM J$XTOP(J)		;Yes, set it
	DO.
	  SOSGE J$OBCT(J)		;Decrement the byte cout
	  IFSKP.
	    IDPB C,J$OBPT(J)		;Deposit a byte
	    $RETT			;And return
	  ENDIF.
	  $CALL OUTBUF			;Dump the buffer
	  LOOP.
	ENDDO.

;OUTBUF  --  Routine to output a buffer
;Also checks if it's time for a checkpoint.
OUTBUF:	$CALL .SAVET			;Save the 't' acs
	MOVX S1,SIG.CC			;Check if we need a timed CKP
	$CALL SIGNAL
	SKIPGE T1,J$OBCT(J)		;Get bytes remaining in buffer
	 SETZ T1,			;If less,,make it zero
	SUBI T1,OPBFSZ			;Chars in buffer negated
	SKIPN T1			;Is the buffer empty?
	 $RETT				;Yes, forget this
	MOVN T2,T1			;Incr char count
	ADDM T2,J$XCNT(J)
	MOVE S1,J$OJFN(J)		;JFN
	MOVEI S2,J$OBFR(J)		;Get address of buffer
	ADD S2,J$OBTZ(J)		;and make it a byte pointer
	SOUT%				;Output it
	IFJER.
	  ERROR (<SOUTR Failed, ^E>)
      	ENDIF.

; Routine to reset the buffer
OUTRES:	MOVEI S1,OPBFSZ			;Get characters per buffer
	MOVEM S1,J$OBCT(J)		;Save as buffer byte count
	MOVEI S1,J$OBFR(J)		;Get the buffer address
	ADD S1,J$OBTZ(J)		;Add the byte ptr (left half)
	MOVEM S1,J$OBPT(J)		;Save as buffer byte pointer
	$RETT				;And return
	SUBTTL Device independent routine to output a file

;Call with E pointing to the FP block for the open file
;	   J pointing to the Stream data area
;	   T1 pointing to the routine to output the file
FILOUT:	PUSH P,T1			;Save the dispatch address
	PUSH P,T2			;Save pointer to prepend filename
	TXO S,FILXFR			;Say we're transferring a file
	$CALL INPREW			;Rewind the input file
	MOVE T1,J$FLIN(J)		;Start at top of page
	MOVEM T1,J$XVPS(J)		;Save it
	POP P,T2			;Get pointer to prepend filename
	POP P,T1			;Get dispatch address
	$CALL (T1)			;Dispatch
;	$CALL JOBTRL			;Print a trailer page
	$CALL OUTBUF			;Empty buffer
	TXZ S,FILXFR			;Finished with the file
	SKIPE J$XTOP(J)			;Are we at TOF?
	IFSKP.
	  AOS J$ANPT(J)			;No, charge him for rest of page
	ENDIF.
	$RET
	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:
;					Sets flag in S:
;	PLAIN: 7-bit plaintext		F%PL7
;	PLAIN: 8-bit plaintext		F%PL8
;	PS:	7-bit PostScript	F%PS7
;	PS:	8-bit PostScript	F%PS8
;  The following are printed with headers ala IM.EXE:
;	PLH:	7-bit plaintext		F%PLH7
;	PLH:	8-bit plaintext		F%PLH8
;These will be implemented later:
;	IMP:	7-bit Impress		F%IM7
;	IMP:	8-bit Impress		F%IM8
SETPFT:	STKVAR <BYTSIZ>
	$CALL CHKSIZ			;Get the byte size for the file.
	SKIPN
	 MOVEI S2,7			;Invalid page count or byte size
	cain s2,^d36		;if 36 bit file
	 TXO S,F%36
	cain s2,^d36		;if 36 bit file
	 movei s2,7		;then pretend 7 bit
	MOVEM S2,BYTSIZ		;Save the byte size for later
	$CALL CHKPS		;Is this a PostScript file?
	MOVE S2,BYTSIZ		;Get the bytesize
	SKIPN
	IFSKP.				;Yes, then determine 8 bitness
	  CAIE S2,7			;Seven bit?
	  IFSKP.
	    TXO S,F%PS7			;Yes, lite that flag
	  ELSE.
	    TXO S,F%PS8			;No, eight bit...
	  ENDIF.
	  MOVEI T1,PS			;PostScript processor
	ELSE.				;We're looking at a plaintext file
	  CAIE S2,7			;Seven bit?
	  IFSKP.			;Yes...
	    TXO S,F%PL7
	  ELSE.
	    TXO S,F%PL8
	  ENDIF.
	  MOVEI T1,PLAIN		;This routine will be called any case
	  HRROI T2,[ASCIZ/PLAINTEXT/]	;Assume this prepend file
	  LOAD S1,.FPINF(E),FP.2PG	;Get flag for landscape/book/2up
	  HLRZ S2,.FPFR1(E)		;Get formwidth
	  IFN. S1			;Flag set?
	    HRROI T2,[ASCIZ/BOOK/]	;Yes, assume we're booking
	    SKIPE S2			;This guy zero?
	     HRROI T2,[ASCIZ/2UP/]	;No, then 2up
	  ELSE.
	    CAIN S2,^D132		;Form width large?
	     HRROI T2,[ASCIZ/LANDSCAPE/]	;Yes, then landscape it
	  ENDIF.
	ENDIF.
	$RETT
	SUBTTL Routines to send stuff to printers	

; Send a PostScript file to the printer
PLAIN:	MOVEM T2,PRENAM		;save prepend file name
	SETOM PLAINP
	SKIPA
PS:	 SETZM PLAINP
	CALL LPDUNQ		;generate unique names for LPD transfer

	MOVE 1,J$IJFN(J)
	SIZEF%
	 ERJMP TCPDIE

	;only do if 36 bit file
	TXNN S,F%36
	IFSKP.
	 movei 1,5
	 TXNE S,F%PL8!F%PS8!F%PLH8!F%IM8	;Any eight bit bytes?
	  movei 1,4
	 imul 2,1
	ENDIF.

	ADDI 2,2		;plus "%!"
	SKIPE PLAINP		;plaintext?
	 JRST [PUSH P,2		;yes do this stuff
	       CALL PLNSIZ	;gtjfn on prepend file, return size
	       POP P,2
	       ADD 2,1
	       JRST .+1]
	MOVE 1,[POINT 7,FOOBUF]
	MOVEI 3,.CHCNC
	IDPB 3,1
	MOVEI 3,^D10
	NOUT%
	 JFCL
	MOVEI 2,.CHSPC	
	IDPB 2,1
	MOVE 2,[POINT 7,UNIQNM]
	ILDB 3,2
	SKIPE 3
	 IDPB 3,1
	JUMPN 3,.-3
	MOVEI 2,.CHLFD
	IDPB 2,1
	SETZ 2,
	IDPB 2,1
	HRROI 2,FOOBUF
	CALL LPDOUT
	CALL LPDACK		;get an ack

;send file here
	Move 1,TCPJFN
	Hrroi 2,[asciz /%!/]	;make sure its always postscript!
	Setz 3,
	SOUTR%
	 ERJMP .+1

	SKIPE PLAINP		;plaintext?
	 CALL PLNSND		;send prepend file first

	PUSH P,5
SNDFIL:	MOVE 1,J$IJFN(J)
	Hrroi 2,FOOBuf
	Movni 3,1000*5
	SIN%
	 Erjmp .+1
	Move 5,3
	Move 1,TCPJFN
	Hrroi 2,FooBuf
	Movni 3,1000*5
	sub 3,5
	SOUT%
	jumpe 5,sndfil
	POP P,5
ifn debug,<
 tmsg <s:(file):
>
>

	CALL LPDNUL
	CALL LPDACK

	MOVEI 2,"f"		;print this file
	CALL CFSCHR
	HRROI 2,UNIQNM
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	MOVEI 2,"U"		;delete file after printing
	CALL CFSCHR
	MOVE 2,[POINT 7,UNIQNM]
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	MOVEI 2,"N"
	CALL CFSCHR
	HRROI 1,FOOBUF
	MOVE S2,J$IJFN(J)
	MOVE T1,[111110,,000001]
	JFNS%
	 ERJMP .+1
	SETZ 3,
	IDPB 3,1
	HRROI 2,FOOBUF
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	$RETT				;Done here

;gtjfn on prepend file, return size in t1
PLNSIZ:	HRROI S1,PREBUF			;Place to build prepend file name
	HRROI S2,[ASCIZ/SYSTEM:/]	;First part of name
	SETZ T1,
	SOUT%
	MOVE S2,PRENAM			;Prepend filename
	SOUT%
	HRROI S2,[ASCIZ/.PS/]		;Extension
	SOUT%
	IDPB T1,S1			;Tie it off with zip
	MOVX S1,GJ%SHT!GJ%OLD		;Old file
	HRROI S2,PREBUF			;Point to the finished filename
	GTJFN%				;Get a JFN for it
	IFJER.				;Oops...
	 TMSG <?PPNSPL: Prepend file not found.
>
	 JRST TCPDIE
	ENDIF.
	MOVEM S1,PREJFN		;Stash the JFN
	SIZEF%
	 ERJMP TCPDIE
	MOVE 1,2		;ret byte count in ac1
	RET

PLNSND:	MOVE 1,PREJFN
	MOVX S2,OF%RD!FLD(7,OF%BSZ)	;Else slurp this dude
	OPENF%
	 ERJMP TCPDIE

	PUSH P,5
SNDPRE:	MOVE 1,PREJFN
	Hrroi 2,FOOBuf
	Movni 3,1000*5
	SIN%
	 Erjmp .+1
	Move 5,3
	Move 1,TCPJFN
	Hrroi 2,FooBuf
	Movni 3,1000*5
	sub 3,5
	SOUTR%
	JUMPE 5,SNDPRE
	POP P,5
	MOVE 1,PREJFN
	CLOSF%
	 ERJMP .+1
	RET
;PostScript text to prepend to a plaintext file
PREPND: ASCIZ ^
/in. {72 mul} def
/line 1024 string def
/leftmargin where not{/leftmargin .75 in. def}{pop}ifelse
/topmargin where not{/topmargin 10.5 in. def}{pop}ifelse
/newppsn {leftmargin topmargin moveto} bind def
/newpage {showpage newppsn} bind def
/printfile{
	newppsn
	{currentfile cvlit line readline not{exit}if
		 (\f) search{show newpage pop}if
		 show
	 	 leftmargin currentpoint exch 
		 pop 12 sub dup .5 in. le{pop pop newpage}{moveto}ifelse
	}loop
	showpage
}bind def
/Courier findfont 11 scalefont setfont
printfile
^;End of prepended PostScript text
	SUBTTL ERRCHK - Check for error from the printer

ERRCHK: SETZM ERRFLG(J)			;Assume no errors
	MOVE S1,J$OJFN(J)		;Get the JFN
	SIBE%				;Is there anything there?
	IFNSK.
	  SETZM ERRBUF(J)
	  MOVEI S1,ERRBUF(J)		;Get pointer to the buffer
	  HRLS S1
	  AOS S1			;ERRBUF,,ERRBUF+1
	  MOVEI T1,ERRBUF+NERBUF-1(J)
	  BLT S1,T1			;Zero it
	  PUSH P,S2			;Save the count
	  MOVN T1,S2			;Get count of bytes there
	  MOVE S2,[POINT ^D8,ERRBUF+1(J)]	;Point to the input buffer
	  PUSH P,S2			;Save this pointer
	  MOVE S1,J$OJFN(J)
	  SIN%				;Get the junk
	   ERJMP .+1			;Ignore an error, sort of
	  MOVE S1,[POINT 7,ERRBUF(J)]
	  POP P,T2			;Get back 8 bit byte pointer
	  MOVE T1,(P)			;Get the counter
	  DO.				;Convert 8 bit chars to 7 bit
	    ILDB S2,T2			;Get a character
	    IFN. S2
	      IDPB S2,S1		;Stash it back
	      SOJG T1,TOP.
	    ENDIF.
	  ENDDO.
	  POP P,T1			;Get the count back
	  $CALL GETERR			;Get the error type
	  JUMPF .RETT			;None???
	  CAIE S1,1			;PostScript interpreter error?
	  IFSKP.
	    SETOM ERRFLG(J)		;Yes, blow the sucker out of the water
	    $RETF
	  ENDIF.
	ENDIF.
	$RETT
	SUBTTL IDLCHK - Check for printer in idle state
; Check for printer idle
IDLCHK:	STKVAR <NCHARS,DOWAIT,DOBUSY>
	$CALL OUTBUF
	SETZM DOWAIT			;No check for waiting, yet
	SETOM DOBUSY			;Check for busy
	DO.
	  DO.
	    MOVE S1,J$OJFN(J)		;Get the JFN
	    MOVEI S2,.TICCT		;Send a Control-T
	    BOUT%
	    MOVEI S1,^D7000		;Wait a second (seven)
	    DISMS%
	    MOVE S1,J$OJFN(J)		;Get the JFN
	    SIBE%
	    TRNA			;Now it's got something  
	     LOOP.
	  ENDDO.
	  MOVEM S2,NCHARS		;Save number of characters
	  MOVN T1,S2			;Get negative count of characters
	  MOVE S2,[POINT 8,TRLBUF(J)]	;Buffer where they go.
	  SIN%
	   ERJMP .+1			;Should NEVER happen!
	  SKIPN DOBUSY			;Do busy?
	  IFSKP.
	    MOVE S1,[POINT 8,[BYTE(8) ":"," ","b","u","s","y"]]
	    MOVE S2,NCHARS		;Number of characters in the buffer
	    $CALL FNDSTR		;Go look for it
	    IFNSK.
	      SETZM DOBUSY		;Not found, look for waiting state
	      SETOM DOWAIT
	    ENDIF.
	    LOOP.			;Loop while engine busy
	  ELSE.
	    SKIPN DOWAIT		;Look for waiting status?
	    IFSKP.			;Yes
	      MOVE S1,[POINT 8,[BYTE(8) ":"," ","w","a","i","t"]]
	      MOVE S2,NCHARS		;Number of characters in the buffer
	      $CALL FNDSTR		;Go look for it
	      IFSKP.			;Then we found it
		MOVE S1,J$OJFN(J)	;Get the JFN
		MOVEI S2,.TICCD		;Send a control-D
		BOUT%
	      ENDIF.
	      SETZM DOWAIT		;No longer looking for waiting state
	      LOOP.
	    ELSE.
	      MOVE S1,[POINT 8,[BYTE(8) ":"," ","i","d","l","e"]]
	      MOVE S2,NCHARS		;Number of characters in the buffer
	      $CALL FNDSTR		;Go look for it
	       LOOP.			;Loop if we didn't find it
	    ENDIF.
	  ENDIF.
	ENDDO.
	$RETT				;The printer's idle
; FNDSTR - Find the string pointed to by S1, in buffer length S2.  Buffer is
; TRLBUF(J).  This goes from the end of the buffer to the beginning, since
; we're more interested in recency than anything else
FNDSTR:	PUSH P,S1
	SUBI S2,6
	IFL. S2				;At least six characters there?
	  POP P,S1			;No, then get back S1
	  POPJ P,			;If not, then return +1
	ENDIF.
	MOVE T1,S2			;Save counter of characters left left
	MOVE S1,[POINT 8,TRLBUF(J)]	;Point to buffer
	ADJBP S2,S1			;Go almost to the end of the buffer
	POP P,S1
	DO.
	  PUSH P,S1			;Save test string pointer
	  PUSH P,T1			;Save that counter
	  PUSH P,S2			;Save that pointer
	  MOVEI T2,6			;Compare six characters
	  DO.
	    ILDB T1,S1			;Get a test character
	    ILDB C,S2			;Get a buffer character
	    CAMN C,T1			;Equal?
	     SOJG T2,TOP.		;Yes, continue
	  ENDDO.
	  SKIPE T2			;If we exhausted the count,
	  IFSKP.			;...then we're done, having found the
	    POP P,(P)			;...string...Skip return.
	    POP P,(P)			;clean up stack, too
	    POP P,(P)			;clean up stack, too
	    AOS (P)
	    POPJ P,
	  ENDIF.
	  POP P,S1			;Get buffer pointer
	  POP P,T1			;Get count
	  SETO S2,			;Back up buffer pointer
	  ADJBP S2,S1
	  POP P,S1			;Get back test string pointer
	  SOJG T1,TOP.			;Loop some more
	ENDDO.
	POPJ P,				;Non-skip return
	SUBTTL GETERR - Get error type
; We look for the first occurrence of the following in ERRBUF.  We return 
; False if neither found, True if either found
; String		Contents of S1 on return
; %%[PrinterError:	0
; %%[Error:		1
; T1 contains the byte count in ERRBUF upon entry
GETERR:	STKVAR <BUFPTR>
	MOVE S2,[POINT 7,ERRBUF(J)]	;Point to the error buffer
	DO.	
	  MOVEM S2,BUFPTR		;Save this pointer
	  HRROI S1,[ASCIZ/%%[ PrinterError:/]	;Was there this kind?
	  STCMP%
	  IFXN. S1,SC%SUB		;Do we have a match?
	    SETZ S1,			;Set return code...
	    $RETT
	  ENDIF.
	  HRROI S1,[ASCIZ/%%[ Error:/]	;Was there this kind?
	  MOVE S2,BUFPTR		;Get the pointer
	  STCMP%
	  IFXN. S1,SC%SUB		;Do we have a match?
	    MOVEI S1,1			;Set return code...
	    $RETT
	  ENDIF.
	  MOVE S2,BUFPTR
	  IBP S2			;Increment to the next character
	  SOJG T1,TOP.			;Continue on...
	ENDDO.
	$RETF				;No errors found in this crop
	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.
Not implemented since we use unlimited limits at UWCSL.\

LIMCHK: $RETT
	SUBTTL HEADER - prepare to print a file

HEADER: ret

	CALL TRLINI
	HRROI S2,PH1			;Point to initial PostScript text
	CALL TRLOUT
	GTAD%
	CALL CVINET			;Output standard date/time
	HRROI 1,FOOBUF
	MOVEI 3,^D10
	NOUT%
	 JFCL
	SETZ 3,
	IDPB 3,1
	HRROI 2,FOOBUF
	CALL TRLOUT

	HRROI S2,PH1.5
	CALL TRLOUT
	HRROI S2,.EQOWN(J)
	CALL TRLOUT

	HRROI S2,PH2
	CALL TRLOUT
	HRROI 1,FOOBUF
	SETOB S2,T1
	ODTIM%
	 ERJMP .+1
	SETZ 3,
	IDPB 3,1
	HRROI 2,FOOBUF
	CALL TRLOUT

	HRROI S2,PH3
	CALL TRLOUT
	HRROI 1,FOOBUF
	MOVE S2,J$IJFN(J)
	MOVE T1,[111110,,000001]
	JFNS%
	 ERJMP .+1
	SETZ 3,
	IDPB 3,1
	HRROI 2,FOOBUF
	CALL TRLOUT

	HRROI S2,PH4
	CALL TRLOUT
	HRROI S2,PH6
	CALL TRLOUT

;NOW SEND IT
	MOVE 1,[POINT 7,FOOBUF]
	MOVEI 3,.CHCNC
	IDPB 3,1
	MOVE 2,TRLCNT
	MOVEI 3,^D10
	NOUT%
	 JFCL
	MOVEI 2,.CHSPC	
	IDPB 2,1
	MOVE 2,[POINT 7,UNIQHN]
	ILDB 3,2
	SKIPE 3
	 IDPB 3,1
	JUMPN 3,.-3
	MOVEI 2,.CHLFD
	IDPB 2,1
	SETZ 2,
	IDPB 2,1
	HRROI 2,FOOBUF
	CALL LPDOUT
	CALL LPDACK		;get an ack
	CALL TRLSND

	MOVEI 2,"f"		;print this file
	CALL CFSCHR
	HRROI 2,UNIQHN
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	MOVEI 2,"U"		;delete file after printing
	CALL CFSCHR
	MOVE 2,[POINT 7,UNIQHN]
	CALL CFSOUT
	MOVEI 2,.CHLFD
	CALL CFSCHR

	$RETT
;Return RFC738 time format in S2
TMBDIF==^D<365*41+55>		;1858 BASE VS 1900 BASE, IN DAYS

CVINET:	MOVEI T1,(S1)		;TOPS20 FRACTION OF A DAY
	HLRZ S2,S1		;DAYS SINCE NOV 1858
	SUBI S2,TMBDIF		;BRING DOWN TO 1900
	MULI T1,^D<24*60*60>	;CONVERT TO SECONDS FROM 1/3 SEC
	DIV T1,[1,,0]		; ..
	CAIL T2,400000		;ROUND TO NEAREST SECOND
	ADDI T1,1		;ROUND UP
	CAIGE T1,^D<24*60*60>	;WENT TO WHOLE DAY?
	IFSKP.
	  SETZ T1,		;YES, COUNT A DAY
	  AOJA S2,.+1
	ENDIF.
	IMULI S2,^D<24*60*60>	;SECONDS FROM DAYS
	ADDI S2,(T1)		;SECONDS WITHIN TODAY
	RET			;RETURN RFC738 FORMAT TIME IN B
;TCP routines
TCPOPN:	MOVE 1,[POINT 7,FOOBUF]
	HRROI 2,[ASCIZ /TCP:/]
	SETZ 3,
	SOUT%
	PUSH P,1
	GTAD%
	IDIVI 1,^D424
	POP P,1
	ADDI 2,^D600
	MOVEI 3,^D10
	NOUT%
	 JFCL
	HRROI 2,[ASCIZ /./]
	SETZ 3,
	SOUT%
	MOVE 2,[POINT 7,J$SSTG(J)]	;Point to the string (host.printer)
	ILDB 3,2
	CAIN 3,"."
	 JRST HITDOT
	IDPB 3,1
	JRST .-4
HITDOT:	PUSH P,2
	HRROI 2,[ASCIZ /-515;CONNECTION:ACTIVE;TIMEOUT:60;PERSIST:60/]
	SETZ 3,
	SOUT%
	POP P,2
	MOVE 1,[POINT 7,PRNAME]
PRLOOP:	ILDB 3,2
	CAIL 3,"A"
	 CAILE 3,"Z"
	  SKIPA
	   ADDI 3,40		;lowercase it
	IDPB 3,1
	JUMPN 3,PRLOOP

	SETZM TCPJFN
	MOVX 1,GJ%SHT			;Load gtjfn flags
	HRROI 2,FOOBUF			;Point to the string
	GTJFN%				;Get JFN of the device
	IFJER.
	 TMSG <?PPNSPL: Can't get JFN for TCP connection
>
	 JRST TCPORT	 
	ENDIF.
	MOVEM 1,TCPJFN
	MOVX 2,<OF%WR!OF%RD!<FLD 8,OF%BSZ>>	;Write 8 bit bytes
	OPENF%
	IFJER.
	 TMSG <?PPNSPL: Can't open TCP connection
>
	 JRST TCPORT	 
	ENDIF.
	RET

;error.  delay and try again.
TCPORT:	SKIPE 1,TCPJFN
	 RLJFN%
	  ERJMP .+1
	MOVEI 1,^D2*^D60*^D1000	;wait 2 minutes
	DISMS%
	JRST TCPOPN		;try again

TCPERR:	TMSG <?PPNSPL: TCP connection error
>
TCPDIE:	CALL TIMCLR
	CALL TCPCLS
	ERROR (<TCP connection problem>)
	HALTF%
	JRST .-1
	
TCPCLS:	MOVEI 1,TCPCTO
	MOVEI 2,^D60*^D1000
	CALL TIMSET
	MOVE 1,TCPJFN
	CLOSF%
	 ERJMP .+1
	CALL TIMCLR
	SETZM TCPJFN
	RET
TCPCTO:	MOVE 1,TCPJFN
	TXO 1,CZ%ABT
	CLOSF%
	 ERJMP .+1
	SETZM TCPJFN
	RET
;LPD control file handler routines

;init CF file buffer
CFINIT:	MOVE 1,[POINT 7,CFBUF]
	MOVEM 1,CFPTR
	SETZM CFCNT
	RET

;output string t2 to CFBUF
CFSOUT:	MOVE 1,CFPTR
	HLRZ 3,2
	CAIE 3,-1
	  SKIPN 3
	    HRLI 2,440700
CFSOU1:	ILDB 3,2
	JUMPE 3,CFSOUX
	IDPB 3,1
	AOS CFCNT
	JRST CFSOU1
CFSOUX:	MOVEM 1,CFPTR
	IDPB 3,1	
	RET

;output chr in ac2 to CFBUF
CFSCHR:	IDPB 2,CFPTR
	AOS CFCNT
	RET

;send CF file
CFSEND: MOVE 1,[POINT 7,FOOBUF]
	MOVEI 2,.CHCNB
	IDPB 2,1
	MOVE 2,CFCNT
	MOVEI 3,^D10
	NOUT%
	 JFCL
	MOVEI 2,.CHSPC
	IDPB 2,1
	MOVEI 2,"c"
	IDPB 2,1
	MOVE 2,[POINT 7,UNIQNM]
	IBP 2
	ILDB 3,2
	SKIPE 3
	 IDPB 3,1
	JUMPN 3,.-3
	MOVEI 2,.CHLFD
	IDPB 2,1
	SETZ 2,
	IDPB 2,1
	HRROI 2,FOOBUF
	CALL LPDOUT
	CALL LPDACK		;get an ack

ifn debug,<
tmsg <s:>
	MOVEI 1,.PRIOU
	HRROI 2,CFBUF
	MOVN 3,CFCNT
	SOUT%
tmsg <:
>
>
	MOVE 1,TCPJFN
	HRROI 2,CFBUF
	MOVN 3,CFCNT
	SOUTR%
	SETZM CFBUF

	CALL LPDNUL		;send trailing null
	CALL LPDACK		;and wait for an ack
	RET


; unix LPD protocol stuff

;make LPD unique name into UNIQNM
LPDUNQ:	MOVE 1,[POINT 7,UNIQNM]
	MOVEI 2,"d"
	IDPB 2,1
	MOVEI 2,"f"
	IDPB 2,1
	MOVE 2,FILCNT
	IDIVI 2,^d26
	MOVE 2,3
	ADDI 2,"A"
	IDPB 2,1
	LOAD 2,.EQSEQ(J),EQ.SEQ
	ADD 2,FILCNT
	IDIVI 2,^d1000
	MOVE 2,3
	MOVE 3,[NO%LFL+NO%ZRO+FLD(3,NO%COL)+^D10]
	NOUT%
	 JFCL
	MOVE 2,[POINT 7,HSTNAM]
	ILDB 3,2
	IDPB 3,1
	JUMPN 3,.-2

	HRROI 1,UNIQHN
	HRROI 2,UNIQNM
	SETZ 3,
	SOUT%
	MOVE 1,[POINT 7,UNIQHN]
	IBP 1
	IBP 1
	MOVE 2,FILCNT
	IDIVI 2,^d26
	MOVE 2,3
	ADDI 2,"a"
	AOS FILCNT
	IDPB 2,1
	RET

;get ack/nack from remote host
LPDACK:	MOVEI 1,LPDATO
	MOVE 2,[^D2*^D60*^D1000]
	CALL TIMSET
	MOVE 1,TCPJFN
	BIN%
	 ERJMP TCPERR
ifn debug,<
tmsg <r:>
movei 1,.priou
movei 3,10
NOUT%	
 jfcl
tmsg <:
>
>
	PUSH P,2
	CALL TIMCLR
	POP P,2
	CAIN 2,0		;ack?
	 RET			;ok
	CAIN 2,1		;protocol error?
	 JRST [TMSG <?PPNSPL: LPD protocol error (LPDACK called from >
	       MOVEI 1,.PRIOU
	       HRRZ 2,(P)
	       MOVEI 3,10
	       NOUT%
		JFCL
	       TMSG <)
>
	       JRST TCPDIE]
	TMSG <?PPNSPL: remote error:>
LPDERL:	MOVE 1,TCPJFN
	BIN%
	 ERJMP LPDERX
	MOVEI 1,.PRIOU
	BOUT%
	JRST LPDERL
LPDERX:	TMSG <
>
	JRST TCPDIE
LPDATO:	TMSG <?PPNSPL: Timeout waiting for ACK
>
	JRST TCPDIE

;request this printer
LPDPRT:	MOVE 1,[POINT 7,FOOBUF]
	MOVEI 2,.CHCNB
	IDPB 2,1
	HRROI 2,PRNAME
	SETZ 3,
	SOUT%
	MOVEI 2,.CHLFD
	IDPB 2,1
	SETZ 2,
	IDPB 2,1
	HRROI 2,FOOBUF
	CALL LPDOUT
	CALL LPDACK
	RET

; send string t2 to LPD
LPDOUT:	
ifn debug,<
push p,2
tmsg <s:>
movei 1,.priou
move 2,(p)
setz 3,
SOUT%	
tmsg <:
>
pop p,2
>
	MOVE 1,TCPJFN
	SETZ 3,
	SOUTR%
	RET

; send a null to LPD
LPDNUL:
ifn debug,<
tmsg <s:(null):
>
>
	MOVE 1,TCPJFN
	HRROI 2,[0]
	MOVNI 3,1
	SOUTR%
	RET

TRLINI:	MOVE 1,[POINT 8,TRLBUF(J)]	;Point to trailer buffer
	MOVEM 1,TRLPTR
	SETZM TRLCNT
	RET

;output string t2 to TRLBUF
TRLOUT:	MOVE 1,TRLPTR
	HLRZ 3,2
	CAIE 3,-1
	  SKIPN 3
	    HRLI 2,440700
TRLOU1:	ILDB 3,2
	JUMPE 3,TRLOUX
	IDPB 3,1
	AOS TRLCNT
	JRST TRLOU1
TRLOUX:	MOVEM 1,TRLPTR
	IDPB 3,1	
	RET

;output chr in ac2 to TRLBUF
TRLCHR:	IDPB 2,TRLPTR
	AOS TRLCNT
	RET

;Send TRLBUF to net
TRLSND:	MOVE 1,TCPJFN
	MOVE 2,[POINT 8,TRLBUF(J)]	;Point to trailer buffer
	MOVN 3,TRLCNT
	SOUTR%
	 ERJMP .+1
	CALL LPDNUL
	CALL LPDACK
	RET
;PostScript program for the trailer page
PH1:	ASCIZ	|%! NIC header page
/phoon
{
/MD exch def
/Mr exch def
/My exch def
/Mx exch def
/pi 3.1415926535 def
/ANM 2497886484 def
/SP 2551443 def
/temp MD ANM sub def
/IP temp temp SP div truncate SP mul sub def
/AP IP SP div 2 mul pi mul def
/MCAP AP pi div 180 mul cos neg def
Mx Mr sub 10 sub My Mr sub 10 sub moveto Mr 2 mul 20 add dup box 0 setgray fill
AP 0 ge AP pi lt and {RHM} {LHM} ifelse
} def
/RHM
{ Mx My moveto Mx My Mr 270 90 arc 1 setgray fill
MCAP 0 le {0 RE} {1 LE} ifelse
} def
/LHM
{ Mx My moveto Mx My Mr 90 270 arc 1 setgray fill
MCAP 0 le {0 LE} {1 RE} ifelse
} def
/RE
{ Mx My Mr MCAP abs mul Mr 270 90 E setgray fill } def
/LE
{ Mx My Mr MCAP abs mul Mr 90 270 E setgray fill} def

/Edict 8 dict def
Edict /mtrx matrix put
/E
{Edict begin
/endangle exch def
/startangle exch def
/yrad exch def
/xrad exch def
/y exch def
/x exch def
/savematrix mtrx currentmatrix def
x y translate
xrad yrad scale
0 0 1 startangle endangle arc
savematrix setmatrix
end
}def

/box
{currentpoint
newpath
moveto
/y exch def
/x exch def
x 0 rlineto
0 y rlineto
x neg 0 rlineto
closepath
} def

/PF
{pop pop pop pop} def

/inch {72 mul} def
/usize 40 def

/curvedbox
{/r exch def
/y exch def
/x exch def
currentpoint
/cy exch def
/cx exch def
newpath
cx x 2 div add cy moveto
cx x add cy cx x add cy y add r arcto PF
cx x add cy y add cx cy y add r arcto PF
cx cy y add cx cy r arcto PF
cx cy cx x 2 div add cy r arcto PF
closepath
stroke
} def

/font
{exch
findfont
exch scalefont
setfont
} def

statusdict /setpapertray known
{
statusdict begin
0 setpapertray
statusdict end
} if

1 inch 7 inch moveto 6.5 inch 3 inch 25 curvedbox
494 674 16 |

PH1.5:	ASCIZ | phoon

.5 setgray
newpath
.5 inch 1 inch moveto
.5 inch 10 inch lineto
.75 inch 10 inch lineto
.75 inch 1 inch lineto
closepath
fill

newpath
7.75 inch 1 inch moveto
7.75 inch 10 inch lineto
8 inch 10 inch lineto
8 inch 1 inch lineto
closepath
fill

0 setgray

/Helvetica 14 font
1.5 inch 9.5 inch moveto (User:) show
/Helvetica-Bold usize font 2.2 inch 9.5 inch moveto (|

PH2:	ASCIZ |) show /Helvetica 14 font
1.5 inch 9.0 inch moveto (Date:) show 2.2 inch 9.0 inch moveto (|

PH3:	ASCIZ |) show
1.5 inch 8.5 inch moveto (File:) show 2.2 inch 8.5 inch moveto (|

PH4:	ASCIZ |) show
|

PH5:	ASCIZ | /Helvetica-Bold 14 font 1.5 inch 8.0 inch moveto
(ERRORS:) show /Helvetica 14 font 1.75 inch 7.75 inch moveto (|

PH6:	ASCIZ | showpage
|
	LIT
	VAR
PREBUF:	BLOCK ^D<512*10>		;The rest of our world is this buffer
	END PPNSPL