Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/smpspl.mac
There are no other files named smpspl.mac in the archive.
;SRC:<5-GALAXY>SMPSPL.MAC.11, 19-Sep-86 12:43:43, Edit by KNIGHT
; Respond to .OTLPT
;SRC:<5-GALAXY>SMPSPL.MAC.10, 27-Feb-86 08:18:23, Edit by KNIGHT
; Send a FF after the banner.
;SRC:<5-GALAXY>SMPSPL.MAC.9, 26-Feb-86 15:12:06, Edit by KNIGHT
; BOUT% the flippin' FFs 
;SRC:<5-GALAXY>SMPSPL.MAC.8, 26-Feb-86 12:38:23, Edit by KNIGHT
; More delays after sending initial and trailing formfeeds.
;SRC:<5-GALAXY>SMPSPL.MAC.7, 25-Feb-86 13:45:04, Edit by KNIGHT
; Tell superior we're done so job doesn't hang in queue (and we don't hang,
; either)
;SRC:<5-GALAXY>SMPSPL.MAC.6, 25-Feb-86 11:43:36, Edit by KNIGHT
; More sophisticated code at TCPC.2.
;SRC:<5-GALAXY>SMPSPL.MAC.5, 25-Feb-86 11:25:37, Edit by KNIGHT
;SRC:<5-GALAXY>SMPSPL.MAC.4, 25-Feb-86 10:59:43, Edit by KNIGHT
; Set up the interrupt system in the inferior - not the superior
;SRC:<5-GALAXY>SMPSPL.MAC.3, 25-Feb-86 09:54:30, Edit by KNIGHT
; Send FF before and after the job.  Watchdog the TCP CLOSF%
;SRC:<5-GALAXY>SMPSPL.MAC.2, 15-Jan-86 13:23:38, Edit by KNIGHT
; Respond to object type .OTPLT
;SRC:<5-GALAXY>SMPSPL.MAC.1, 14-Jan-86 14:26:43, Edit by KNIGHT
; Create SMPSPL from TCPSPL - simple (and dumb) lineprinter spooler
	TITLE	SMPSPL - Simple and Dumb Net LPT 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
	\
	
	SEARCH	GLXMAC			;Search GALAXY's symbols
	PROLOGUE(SMPSPL)
	SEARCH	QSRMAC			;Search QUASAR's symbols
	SEARCH	ORNMAC			;And ORION's
	SEARCH 	MACSYM

	.DIRECT	FLBLST

	IF1,<PRINTX Assembling SMPSPL, Pass 1>
	IF2,<PRINTX Starting Pass 2>

	SALL				;SUPPRESS MACRO EXPANSIONS

;VERSION INFORMATION

	LPTVER==1			;MAJOR VERSION NUMBER
	LPTMIN==1			;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 defs

;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		;Transferring a user file i.e. enable page skipping
	FRMFND==1B10		;Forms found in LPFORM.TXT
	MINUS==1B11		;Reading a neg. number from LPFORM.TXT

	.DVTCP==25	;What is DEC doing????
	SUBTTL	Parameters

;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME

	ND	CKPTIM,^D30	;Seconds between checkpoints
	ND	DISTIM,^D300	;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,^D15	;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
> ;End of TFUNC definition

	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
> ;;End of 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]
> ;End of 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]
> ;End of 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]
> ;End of 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]
> ;End of 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:  SMPSPL 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 SWITCH NAMES
DEFINE FS(A,C),<
	XLIST
	<<SIXBIT /A/>&777777B17>+S$'A
	LIST
	SALL
>

FFNAMS:	F

;GENERATE TABLE OF DEFAULT PARAMTERS
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$SDPC,1		;PC where last dismissed for I/O
	LP	J$SDTM,1		;Time when last dismissed

	LP	J$SIST,1		;Stream status, set by inferior before termination
					; 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 aborting inferior
	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

;CHKDVI definitions and storage
	DMGNUM==^D223		;MAGIC NUMBER IN DVI TRAILER
	MAXDVR==^D3		;MAXIMUM DVI VERSION (CURRENTLY MIGHT BE 2)
	PSTBFL==50		;LENGTH OF BUFFER FOR READING DVI TRAILER
	LP	J$PSTB,PSTBFL	;BUFFER FOR READING DVI TRAILER


	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 MSG BLK 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 
ME:	BLOCK	^D30		;Name of this host
FRMFIL:	ASCIZ	/SYS:LPFORM.TXT/	;File with forms params

;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,,<'SMPSPL'>)		;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)			;FOREIGN LPT OBJECT TYPE
	$EOB
	SUBTTL 	SMPSPL - Multiple Line Printer Spooler.

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

SMPSPL:	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
	$CALL	INTINI			;SET UP THE INTERRUPT SYSTEM.

;Some system stuff

	MOVX	S1,.FHSLF		;Enable priv's
	SETOM	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
TCPS.1:	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,TCPS.1		;NO, LOOP

	MOVEI	S1,.GTHNS		;Get host name
	HRROI	S2,ME
	SETO	T1,
	GTHST%
	 ERJMP	.+1			;Should add default

	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:	SETZM	RSTFLG			;Don't restart us now
	SETZM	INTFLG			;and no interrupts seen yet

	MOVX	P1,NPRINT-1		;Max number of streams
MAI.1:	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

	CAIN	S1,.RFRUN		;Is it running?
	 JRST	MAI.8			;Yes, leave it alone
	CAIN	S1,.RFSLP		;Is it sleeping?
	 JRST	MAI.8			;Don't wake it
	CAIE	S1,.RFHLT		;Is it halted?
	 JRST	MAI.2			;No
	SKIPE	S1,J$SIST(J)		;Yes, did it signal?
	 $CALL	INFTRM			;Yupp, go check the message
	JRST	MAI.8			;No, I guess it's just idle

;Now check for hung streams

MAI.2:	CAIE	S1,.RFIO		;Dismissed for I/O?
	 JRST	MAI.3			;Nope, serious error
	CAME	S2,J$SDPC(J)		;Compare PCs
	 JRST	MAI.21			;Halted some place else this time
	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	(SMPSPL - Stream I/O Wait Time-out,,J$SOBJ(J))
	MOVX	S1,%RSUNA		;Shut it down temporarily
	$CALL	SUPMSG
	JRST	MAI.9			;Check next stream

MAI.21:	MOVEM	S2,J$SDPC(J)		;Save PC
	GTAD%
	MOVEM	S1,J$SDTM(J)		;and time
	JRST	MAI.9			;Check next stream

;Involuntary termination

MAI.3:	HRRZ	T2,S2			;Save PC
	MOVE	S1,J$SFRK(J)		;Get handle on process
	$CALL	ERRSTR			;and get the error string
	$WTO (SMPSPL -  Inferior Terminated Involuntarily,^T/TMPBUF/ at ^O/T2/,J$SOBJ(J))
	MOVX	S1,FATERT		;Shut it down properly
	$CALL	SUPMSG
	;Fall through

MAI.8:	SETZM	J$SDPC(J)		;Indicate no I/O wait

MAI.9:	SOJGE	P1,MAI.1		;Loop over all streams
	$CALL	CHKQUE			;Take care of any messages

;Sleep for 30 secs unless interrupted

	SKIPE	INTFLG			;Have we been interrupted?
	 JRST	MAIN			;Yes, do another pass
	SETOM	RSTFLG			;We allow restarts now
	MOVX	S1,^D30000		;Sleep for 30 secs
	DISMS%				;..or until restarted
	JRST	MAIN
;;;;;;;;;;;;;;;;;;;
;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
	SETZM	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
	XWD	1,CLSTIM		;Chn 2, TCP CLOSF% WD - level 1
	BLOCK	^D16			;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
;;;;;;;;;;;;;;;;;;;;;;;;
;INTINI - Enable interrupts
;(Interrupt system is initialized in I%INIT and I%ION)
;Note that EIR% and DIR% cannot be used reliably because of
;GLXLIB.

INTINI:	MOVX	S1,.FHSLF		;Load my fork handle
	MOVX	S2,<1B1!1B19>		;1:IPCF, 19:Inf. term.
	AIC%				;Activate the channels
	$RETT
; CLSTIM - Here on interrupt from TCP CLOSF% watchdog
CLSTIM:	MOVEI	S1,TCPC.2		;Go there, young man
	MOVEM	S1,LEV1PC
	DEBRK%

;;;;;;;;;;;;;;;;;;;;;;;;
;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>
	$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
	TXNN	S2,SI.FLG		;IS THERE AN INDEX THERE?
	 JRST	CHKQ.5			;NO, IGNORE IT
	ANDX	S2,SI.IDX		;AND OUT THE INDEX
	CAIE	S2,SP.OPR		;IS IT FROM OPR?
	 CAIN	S2,SP.QSR		;IS IT FROM QUASAR?
	  SKIPA				;Yes, continue on
	   JRST	CHKQ.5			;Go to release the message

CHKQ.2:	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
CHKQ.3:	HRRZ	T1,MSGTAB(S1)		;GET A MESSAGE TYPE
	CAMN	S2,T1			;MATCH?
	 JRST	CHKQ.4			;YES, WIN
	AOBJN	S1,CHKQ.3		;NO, LOOP
	JRST	CHKQ.5			;Go to release the message

CHKQ.4:	HLRZ	P1,MSGTAB(S1)		;Pick up the address
	$CALL	CHKOBJ			;Check if the printer exists
	JUMPF	CHKQ.5			;It doesn't, forget all this

;STREAM and J are correctly set now. Dispatch.

	$CALL	@P1			;All OK, dispatch

CHKQ.5:	$CALL	C%REL			;Release the message
	JRST	CHKQUE			;Check for more

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
	CAILE	S1,0			;Make sure it's legal
	 CAIL	S1,ITMLEN
	  $STOP	(IMI,Illegal Message from Inferior)
	PJRST	@ITMTAB(S1)		;Dispatch
	;No return

;;;;
;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
	CAXN	S2,ICD.SU		;Was it a set up?
	 JRST	ITM.01			;Yes
	CAXN	S2,ICD.NJ		;Or a new job?
	 JRST	ITM.02			;Yes
	CAXN	S2,ICD.CF		;Or new forms?
	 JRST	ITM.04
	$RETT				;Neither, just return

ITM.01:	$WTO	(SMPSPL - Stream Started,,J$SOBJ(J))
	MOVX	S1,%RSUOK		;Send a response to setup message
	PJRST	SUPMSG

ITM.02:	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
	$RETT

ITM.04:	PJRST	UPDATE			;Send a reset message to QUASAR


;;;;
;Error (SIG.ER)

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

;;;;
;Fatal error (SIG.FT)

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

;;;;
;Message to OPR (SIG.MS)

ITM.3:	$WTO (SMPSPL - Message from Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
	JRST	ITM.41			;Continue inferior

;;;;
;Request for checkpoint (SIG.CP)

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

;;;;
;Cancel request and continue (SIG.CR)
; we got here because file was unprintable for some reason (did not exist)

ITM.5:	SETZM	S1		;cancel request
	$CALL 	QRELEA		;go do it
	$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 Jobs ITN
	MOVEM	S1,CHE.IT(P1)		;and store it

;Put our info into the CHE.IN field

	MOVE	S1,J$CFLG(J)		;Set checkpoint taken flag
	TXO	S1,CFGCKP
	MOVEM	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)	;and move it

;Put a message string into the CHE.ST (status) field.

	SKIPN	S1,J$CMSG(J)		;Get message type
	 $RETT				;Hasn't been set yet, so forget it
	CAILE	S1,0			;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
	AOS	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
	ADDI	T1,1			;Add one control file
	SKIPE	J$FBAN(J)		;Banner file?
	ADDI	T1,1			;Yes, another file
	SKIPE	J$FTRA(J)		;Trailer file?
 	ADDI	T1,1			;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
	 JRST	CHK.21			;Still waiting
	$TEXT	(<-1,,CHE.ST(P1)>,<Now printing on ^T/J$RHNM(J)/^0>)
	$RETT
CHK.21:	$TEXT	(<-1,,CHE.ST(P1)>,<Number ^D/J$RRST(J)/ in queue on ^T/J$RHNM(J)/^0>)
	$RETT


;;;;;;;;;;;;;;;;;;
;UPDATE -- Routine to send status updates to QUASAR

;J points to the stream's data area

UPDATE:	MOVX	S1,%RESET		;DEFAULT TO RESET
;	TXNE	S2,PSF%ST		;ARE WE STOPPED ???
;	 MOVX	S1,%STOPD		;YES,,SAY SO
UPDA.5:	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
	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	(SMPSPL - End,<^R/.EQJBB(J)/>,J$SOBJ(J)) ;TELL THE OPERATOR.
	$LOG	(SMPSPL - 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 param
	JUMPN	S1,RELA.1		;Jump if requeue

;Here if release

	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
	JRST	RELA.2

;Here on requeue (Job always restarted from beginning)

RELA.1:	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
	;Fall through

;Common code

RELA.2:	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

FILD.1:	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
	 ERJMP	FILD.4			;Oh, well

	TXNE	T2,FP.SPL		;Is this file spooled?
	 JRST	FILD.2			;Yes, always delete and expunge
	SKIPE	P2			;Normal termination?
	 JRST	FILD.4			;No, don't delete
	TXNN	T2,FP.DEL		;Yes, do we want it deleted?
	 JRST	FILD.4			;Nope, try next
	JRST	FILD.3			;Yes, delete but don't expunge

FILD.2:	IORX	S1,DF%EXP		;Delete and expunge

FILD.3:	DELF%				;Delete it
	 ERJMP	FILD.4

FILD.4:	RLJFN%				;Release JFN (just to be sure)
	 ERJMP	.+1			;We get a lot of errors
	SOJG	P1,FILD.1		;Go process the next file
	$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 MSG ??
	  JRST	CHKO.1			;YES,,GO SET UP THE OBJ SEARCH.
	XCT	MSGOBJ(S1)		;GET THE OBJ BLK ADDRESS.
	JRST	CHKO.2			;LETS MEET AT THE PASS.

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

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

MSGOBJ:	MOVEI	S1,ABO.TY(M)		;GET ABORT MSG OBJ ADDRESS.
	MOVEI	S1,RCK.TY(M)		;GET CHECKPOINT MSG OBJ ADDRESS.
	MOVEI	S1,.EQROB(M)		;GET NEXTJOB MSG OBJ ADDRESS.


;GETBLK -- ROUTINE TO BREAK DOWN AN IPCF MSG INTO ITS DATA BLOCKS

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

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


;;;;;;;;;;;;;;;;;;;
;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
	SETZM	T4			;CLEAR AN INDEX REGISTER

FNDO.1:	SKIPN	S1,STRPAR(T4)		;Stream allocated?
	 JRST	FNDO.2			;Nope, try next
	MOVEI	S2,J$SOBJ(S1)		;Get address of object block
	CAMN	T1,OBJ.TY(S2)		;COMPARE
	 CAME	T2,OBJ.UN(S2)		;COMPARE
	  JRST	FNDO.2			;NOPE
	CAMN	T3,OBJ.ND(S2)		;COMPARE
	JRST	FNDO.3			;WIN, SETUP THE CONTEXT
FNDO.2:	ADDI	T4,1			;INCREMENT
	CAIL	T4,NPRINT		;THE END OF THE LINE?
	 $RETF				;YES,,RETURN 'OBJECT NOT THERE'
	JRST	FNDO.1			;OK, LOOP

FNDO.3:	MOVE	J,STRPAR(T4)		;Return pointer to param 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
	TXNE	S1,SUFSHT		;IS IT A SHUTDOWN?
	 JRST	SHUTDN			;IF SO,,SHUT IT DOWN !!!
	SETZM	T2			;CLEAR A LOOP REG

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

;Allocate memory for stream
;J will point at stream's parameter area 
;STREAM is also set here.

SETU.2:	MOVEI	S1,J$$END		;GET THE LPT DATA BASE LENGTH
	ADDI	S1,PAGSIZ-1		;ROUND UP TO NEXT HIGHEST PAGE
	IDIVI	S1,PAGSIZ		;GET NUMBER OF PAGES IN S1
	$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

;Save object block in J$SOBJ

	MOVEI	S2,J$SOBJ(J)		;Point at dest
	HRLI	S2,SUP.TY(M)		;and source
	BLT	S2,OBJ.SZ+J$SOBJ-1(J)	;Get it

	LOAD	S2,SUP.FL(M),SPLTAP	;Are we trying to spool to tape?
	JUMPN	S2,[$WTO (SMPSPL - Not started,Spooling to Tape not Supported,J$SOBJ(J))
		MOVX	S1,FATERT	;Signal does not exist
		JRST	SUPMSG]

;Get the translation of PLPTx: into J$SSTG

	MOVEI	P1,J$SOBJ(J)		;GET OUR OBJECT BLOCK ADDRESS
	MOVE	S1,OBJ.UN(P1)		;Get unit number
	IDIVI	S1,^D10			;[wew]
	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%
	 ERJMP	[$TEXT	(<-1,,J$SSTG(J)>,<PLPT^D/OBJ.UN(P1)/:^0>)
		JRST	.+1]

	MOVX	S1,GJ%SHT		;LOAD GTJFN FLAGS
	HRROI	S2,J$SSTG(J)		;POINT TO THE STRING
	GTJFN%				;Get JFN of the device
	 ERJMP	[$WTO	(SMPSPL - Not Started,<Can't find device ^T/J$SSTG(J)/>,J$SOBJ(J))
		MOVX	S1,FATERT
		JRST	SUPMSG]
	MOVEM	S1,J$OJFN(J)		;Save JFN for a millisecond

;See what type of device we have and select protocol accordingly

	DVCHR%
	 ERJMP	[$STOP	(IJS,Internal JFN Screwup)]
	LOAD	T1,S2,DV%TYP		;Get device type
	MOVE	S1,J$OJFN(J)		;Get JFN again (trashed by DVCHR%)
	RLJFN%				;We don't need the JFN any more
	 ERJMP	[$STOP	(CRJ,Can't Release JFN)]

	SETZM	S1			;Indicate no protocol yet
	CAIN	T1,.DVTTY		;TTY?
	 MOVX	S1,PTLTTY		;Yes, say so
	CAIN	T1,.DVTCP		;TCP?
	 MOVX	S1,PTLUNX		;Yes, say so
	JUMPN	S1,SETU.4		;Protocol found
	$WTO	(SMPSPL - Not Started,No Protocol for Device ^T/J$SSTG(J)/,J$SOBJ(J))
	MOVX	S1,FATERT
	JRST	SUPMSG

SETU.4:	MOVEM	S1,J$SPTL(J)		;Save protocol
	;Fall through

;Spawn inferior fork and start it

	MOVX	S1,CR%MAP!CR%CAP!CR%ACS	;Same address space and priv's
	MOVEI	S2,0			;Let it have these ACs to start with
	CFORK%
	 ERJMP	[MOVX	S1,.FHSLF	;Get handle on myself
		$CALL	ERRSTR		;Get error string
		$WTO	(SMPSPL - Not started,<Can't create inferior, ^T/TMPBUF/>,J$SOBJ(J))
		MOVX	S1,FATERT
		JRST	SUPMSG]
	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
	 ERJMP	[MOVX	S1,.FHSLF
		$CALL	ERRSTR
		$WTO	(SMPSPL - Not started,<Can't start inferior, ^T/TMPBUF/>,J$SOBJ(J))
		MOVX	S1,FATERT
		JRST	SUPMSG]
	$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
	 PJRST 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 dev. attributes
	STORE	S1,RSU.DA(T1),RO.ATR	;STORE THE DEVICE ATRRIBUTES
	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

;Kill inferior process

SHUTIN:	MOVE	S1,J$SFRK(J)		;Get handle
	JUMPE	S1,SHUT.1		;Zero, i.e. fork not spawned
	KFORK%				;and kill it
	 ERJMP	[$STOP (CKI,Could not kill inferior)]
	SETOM	S1			;Release all loose handles
	RFRKH%
	 ERJMP	[$STOP (CRF,Could not release fork handle)]

;Deallocate Job Area

SHUT.1:	MOVE	S1,STREAM		;Get our stream number
	SETZM	STRPAR(S1)		;Indicate no allocated Job Area

	MOVEI	S1,J$$END		;GET THE LPT DATA BASE LENGTH
	ADDI	S1,PAGSIZ-1		;ROUND UP TO NEXT HIGHEST PAGE
	IDIVI	S1,PAGSIZ		;GET NUMBER OF PAGES IN S1
	MOVE	S2,J			;GET THE STRPAR ADDRESS
	ADR2PG	S2			;CONVERT TO A PAGE NUMBER
	$CALL	M%RLNP			;RETURN THEM
	$CALL	M%CLNC			;GET RID OF UNWANTED PAGES.

	$WTO	(SMPSPL - 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

;Tell inferior a new job is in

	SKIPE	J$SICD(J)		;Is inferior idle?
	 JRST	[$WTO	(SMPSPL - QUASAR error,New job received for already busy stream,J$SOBJ(J))
		MOVX	S1,FATERT
		JRST	SUPMSG]

	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
	 ERJMP	[MOVX	S1,.FHSLF	;Get handle on myself
		$CALL	ERRSTR		;and error string
		$WTO	(SMPSPL - New request failed,<Can't restart inferior, ^T/TMPBUF/>,J$SOBJ(J))
		MOVX	S1,FATERT
		JRST	SUPMSG]
	$WTOJ	(SMPSPL - 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

;Tell inferior a change form request is in

	SKIPE	J$SICD(J)		;Is inferior idle?
	 JRST	[$WTO	(SMPSPL - QUASAR error,Forms request received for already busy stream,J$SOBJ(J))
		MOVX	S1,%RSUNA
		JRST	SUPMSG]

	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
	 ERJMP	[MOVX	S1,.FHSLF
		$CALL	ERRSTR
		$WTO	(SMPSPL - Setting forms failed,<Can't restart inferior, ^T/TMPBUF/>,J$SOBJ(J))
		MOVX	S1,FATERT
		JRST	SUPMSG]
	$RETT
	SUBTTL Job Cancel and Requeue requests

;;;;;;;;;;;;;;;;;;;;;;;;;
;KILL - User CANCEL Request

KILL:	MOVE	S1,J$SICD(J)		;Have we already told inf. to abort?
	TXNE	S1,ICD.AB
	 $RETT				;Yes, forget this
	$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))
	$RETT


;;;;;;;;;;;;;;;;;;;;;;;;;
;CANCEL - Operator Cancel request

OACCAN:	$CALL	GETBLK			;GET A MESSAGE BLOCK
	JUMPF	OACC.1			;No more i.e. normal ABORT
	CAIE	T1,.CANTY		;IS THIS THE CANCEL TYPE BLOCK ???
	 JRST	OACCAN			;NO,,SKIP IT AND GET NEXT BLOCK

;Cancel type block found

	MOVE	S1,0(T3)		;LOAD THE CANCEL TYPE.
	CAIE	S1,.CNPRG		;IS IT /PURGE ???
	 JRST	OACCAN			;NO,,PROCESS THE NEXT MSG BLK

;Tough cancel

	MOVE	S1,J$SFRK(J)		;Get handle
	HFORK%				;and stop it
	 ERJMP	[$STOP (CKA,Could not halt inferior in purge request)]
	MOVX	S1,SIG.DN		;Fake a DONE message from inferior
	MOVEM	S1,J$SIST(J)
	JRST	OACC.2

;Normal, careful cancel

OACC.1:	$TEXT(<-1,,J$SMLG(J)>,Job aborted by OPERATOR^0^A) ;Message for the log
	MOVX	S1,ICD.AB		;Tell her it's time to stop
	IORM	S1,J$SICD(J)
OACC.2:	$ACK  (SMPSPL - Aborting,<^R/.EQJBB(J)/>,J$SOBJ(J),.MSCOD(M))
	$RETT


;;;;;;;;;;;;;;;;;;;;;;;;;
;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	(SMPSPL - Requeued,<^R/.EQJBB(J)/>,J$SOBJ(J),.MSCOD(M))
	$RETT
	SUBTTL	Dummy routines for not implemented OPR commands

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

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

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

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

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

OACBKS:	$ACK	(SMPSPL - Ignored,<BACKSPACE not supported, use REQUEUE>,J$SOBJ(J),.MSCOD(M))
	$RETT


OACRSP:	$RETT				;Simply return
QSRNWA:	$RETT				;Not used here, just return
OPRD60:	$RET				;SHOULD NOT HAPPEN
	SUBTTL	Code for inferior forks
	PRINTX	[Processing inferior's code]

;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	S1,.FHSLF		;Set up the interrupt system
	MOVE 	S2,[LEVTAB,,CHNTAB]	;Point to the tables
	SIR%
	EIR%
	MOVX	S2,1B2			;2:  Watchdog channel
	AIC%

	SETZM	J$SIST(J)		;Reset termination status

	HRRZ	S1,J$SICD(J)		;Get command
	CAILE	S1,0			;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: ;Zero words related to job in stream data area

	MOVEI	S1,J$$BEG(J)		;Start address
	MOVSI	S2,-<J$$LEN+^D35>/^D36	;AOBJN POINTER TO BIT TABLE
INF.11:	MOVEI	T1,^D36			;BIT COUNTER FOR THIS WORD
	MOVE	T2,ZTABLE(S2)		;GET A WORD FROM BIT TABLE
INF.12:	JUMPE	T2,INF.13		;DONE IF REST OF WORD IS ZERO
	JFFO	T2,.+1			;FIND THE FIRST 1 BIT
	ADD	S1,T3			;MOVE UP TO THE CORRESPONDING WORD
	SETZM	0(S1)			;AND ZERO IT
	SUB	T1,T3			;REDUCE BITS LEFT IN THIS WORD
	LSH	T2,0(T3)		;SHIFT OFFENDING BIT TO BIT 0
	TLZ	T2,(1B0)		;AND GET RID OF IT
	JRST	INF.12			;AND LOOP
INF.13:	ADD	S1,T1			;ACCOUNT FOR THE REST OF THE WORD
	AOBJN	S2,INF.11		;AND LOOP

	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

;Initialize all buffers
;Input buffer is init when file is opened and UNIX control file
;buffer in UNXCTL.

	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)

	SETZM	S			;Reset all flags

;Some log info

	MOVEI	T1,LPTVER		;Get version number
	MOVEI	T2,LPTMIN
	LOGMSG (SMPSPL 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 at ^AME)

;Restore checkpoint info

	SKIPN	T1,J$CFLG-J$CBEG+.EQCHK(J)	;Job previously checkpointed?
	 JRST	INF.15			;No, new job
	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
	TXNE	S1,CFGREQ		;Job requeued or crashed?
	 JRST	INF.14			;Requeued
	LOGMSG (Job Restarted after Failure)
	SKIPA
INF.14:	LOGMSG (Job Restarted after Requeuing)

;Get protocol and dispatch to appropriate routine

INF.15:	MOVE	S1,J$SPTL(J)
	$CALL	@PTLTAB(S1)		;Go do it

	MOVX	S1,SIG.DN		;Tell superior we're done
	PJRST	SIGNAL

;PTLTAB, dispatch table for the different protocols

PTLTAB:	BDTB
	 DTE (DONOR,PTLTTY)		;PTLTTY i.e. print on local TTY - LPT
	 DTE (DOUNX,PTLUNX)		;PTLUNX i.e. send to remote UNIX 4.2
	EDTB (PTLEN)


;;;;
;Take care of change forms command

INF.2:	SETZM	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:	CAILE	S1,0			;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
TXT.A1:	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
	JRST	TXT.A1

;;;;;;;;
;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
	HRROI	S1,J$XTMP(J)		;Point to temp buffer
	MOVX	T1,<FLD ^D10,NO%RDX>	;Decimal radix
	NOUT%
	 ERJMP	.+1

TXT.D1:	SETZM	S2			;Put a NUL last in buffer
	IDPB	S2,S1
	POP	P,S1			;Get dest. 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
TXT.S1:	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,TXT.S1		;Loop
	$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
	MOVX	T1,0
	JRST	TXT.T1

;;;;;;;;
;TXT.TI - Outputs current time

TXT.TI:	$SAVE	<S2,T1>
	SETOM	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%
	 ERJMP .+1
	  JFCL
	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.
	JUMPE	T1,TXT.C1		;Zero i.e. address of routine

;Left half of S1 is non-zero i.e. byte pointer

	IDPB	S2,S1			;Out with it
	$RETT

;Left half is zero i.e. address of routine

TXT.C1:	PUSH	P,S1			;Save our address
	MOVE	C,S2			;Get the char into right reg
	$CALL	@S1			;Dispatch
	POP	P,S1			;Restore address
	$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)

;;;Do a USAGE JSYS account update
	$RETT
	SUBTTL	DONOR -- Print on a normal TTY-LPT

DONOR:	$SAVE <P1>
	$CALL	FORMS			;GET FORMS MOUNTED

;Open the TTY

	MOVX	S1,GJ%SHT		;LOAD GTJFN FLAGS
	HRROI	S2,J$SSTG(J)		;POINT TO THE STRING
	GTJFN%				;Get JFN of the device
	 ERJMP	[FATAL (<GTJFN Failed Second Time on ^AJ$SSTG(J)^T, ^E>)]
	MOVEM	S1,J$OJFN(J)		;Save JFN

	MOVX	S2,<OF%WR!<FLD 8,OF%BSZ>>	;Write 8 bit bytes
	OPENF%
	 ERJMP	[ERROR (<Can't Open Device ^AJ$SSTG(J)^T, ^E>)]

;Set the device characteristics

	MOVE	S1,J$OJFN(J)
	MOVX	S2,<TT%LCA!TT%PGM>	;Set LC and ctl-S/ctl-Q
	STPAR%
	 ERJMP	[ERROR (<Can't Set Params for Device ^AJ$SSTG(J)^T, ^E>)]
	MOVE	S1,J$OJFN(J)		;and image mode
	MOVX	S2,<FLD .TTBIN,TT%DAM>
	SFMOD%
	 ERJMP	[ERROR (<Can't Set Params for Device ^AJ$SSTG(J)^T, ^E>)]

;Start printing stuff

	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

	$CALL	JOBHDR			;Print banners

;Process files

	LOAD	E,.EQLEN(J),EQ.LOH	;Point to first file in request
	ADD	E,J
	TXNN	P1,CFGCKP		;Job restarted?
	 JRST	DONO.3			;No, new job

;Restarted job, skip things already done

	MOVE	S2,J$CNFT(J)		;Get no of files prev. sent
DONO.1:	SOJL	S2,DONO.2		;Skip already printed files
	$CALL	NXTFIL			;Bump E to next spec
	JUMPF	DONO.7			;All already printed
	JRST	DONO.1

DONO.2:	MOVE	T1,J$CNPT(J)		;Get no of pages prev. printed
	SUBI	T1,3			;We want some overlap
	SKIPGE	T1
	 SETZM	T1			;Lowest page no is zero
	JRST	DONO.4

;New job

DONO.3:	LOAD	T1,.FPFST(E)		;Get /START param
	SOS	T1			;Subtract one
DONO.4:	MOVEM	T1,J$IIPG(J)		;save as initial page
	$CALL	NORFIL			;Print the file with all copies
	$CALL	NXTFIL			;Get next file
	JUMPT	DONO.3

;All files printed, finish up

DONO.7:	SKIPE	E,J$RLFS(J)		;Any log file to print?
	 $CALL	NORFIL			;Yes, do it

	$CALL	FINISH			;Do the accounting etc
	$CALL	JOBTRL			;Print the trailer

	MOVE	S1,J$OJFN(J)		;Get JFN
	CLOSF%				;and close down
	 ERJMP	.+1
	$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:	$CALL	CHKABT			;Are we canceled?
	JUMPT	.RETT			;Yes, return
	$CALL	LIMCHK			;Are we over limit?
	$RETIF				;Yes, just return
	$CALL	INPOPN			;OPEN THE INPUT FILE UP
	$RETIF				;Fail, return
	LOGMSG (Starting File ^A@J$IFNM(J))

NORF.1:	$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	NORF.4			;Yes
	$CALL	FILOUT			;PRINT THE FILE
	TXNE	S,ERRFIL		;Was there an error in the file?
	 JRST	NORF.4			;Yes, skip rest of it
	$CALL	CHKABT			;Are we aborted?
	JUMPT	NORF.4			;Yes

	LOAD	T1,.FPFST(E)		;Get /START param
	SOS	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?
	 JRST	NORF.1			;No
	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

NORF.4:	$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	DOUNX -- Transfer files to remote UNIX 4.2 spooler

;Everything is transferred twice. The first time is a dummy transfer to
;count the number of characters. The second time is the real transfer.
;Note that files/headers/banners etc must not change in size between
;the two events.

DOUNX:	CALL OPNCON			;Open connection, get remote host name 

	$CALL	FORMS			;GET FORMS MOUNTED
	LOGMSG (<Transfering to TCP Device ^AJ$SSTG(J)^T, Protocol PTLUNX>)

;Start printing stuff.

;Send the banner file
	$CALL	CHKABT			;Are we canceled?
	JUMPT	DOUN.9			;Yes, go clean up
	SKIPN	J$FBAN(J)		;Do we want banners?
	 JRST	DOUN.1			;No, don't bother

	SETZM	J$XCNT(J)		;Reset character count
	TXO	S,CHRCNT		;count chars first time
	$CALL	JOBHDR
	TXZ	S,CHRCNT
	MOVE	S1,J$XCNT(J)		;Get the char count
	PUSH	P,S1			;and save it for a while
	LOGMSG (<Starting Transfer of Banner, Charcount ^DJ$XCNT(J)>)

	MOVE	S1,J$OJFN(J)
	MOVEI	S2,.CHFFD		;Send a FF before the header
	BOUT%
	MOVEI	S1,^D5000		;Wait for the TAC to do its thing
	DISMS%				;...

	SETZM	J$XCNT(J)		;Reset char count again
	$CALL	JOBHDR			;Now send it
	POP	P,S1			;Get prev count back
	SUB	S1,J$XCNT(J)		;Check if equal
	SKIPE	S1
	  LOGMSG (<Header Charcount Different Second Time - ^DS1>)

	MOVX	S1,SIG.CP		;Take a CKP to update message
	$CALL	SIGNAL

	MOVEI	C,.CHFFD		;Send a FF
	$CALL	OUTCHR

;Process files
DOUN.1:	LOAD	E,.EQLEN(J),EQ.LOH	;Point to first file in request
	ADD	E,J
DOUN.2:	$CALL	NORFIL			;Send the file
	JUMPF	DOUN.9			;Some error, abort transfer
	$CALL	NXTFIL			;Get next file
	JUMPT	DOUN.2

;All files sent, finish up

DOUN.3:	SKIPE	E,J$RLFS(J)		;Any log file to print?
	 $CALL	NORFIL			;Yes, do it

	$CALL	FINISH			;Do the accouting

;Send trailer file

	$CALL	CHKABT			;Are we canceled?
	JUMPT	DOUN.9
	SKIPN	J$FTRA(J)		;Do we want trailers?
	 JRST	DOUN.5			;No, forget it

	LOGMSG (<Starting Transfer of Trailer, Goodbye...>)

	SETZM	J$XCNT(J)		;Reset character count
	TXO	S,CHRCNT		;count chars first time
	$CALL	JOBTRL
	TXZ	S,CHRCNT
	MOVE	S1,J$XCNT(J)		;Save count for a while
	PUSH	P,S1

	SETZM	J$XCNT(J)		;Reset char count again
	$CALL	JOBTRL			;Now send it
	POP	P,S1			;Check that we sent the same number
	SUB	S1,J$XCNT(J)
	SKIPE	S1
	 LOGMSG (<Trailer Charcount Different Second Time - ^DS1>)

	MOVX	S1,SIG.CP		;Take a CKP to update message
	$CALL	SIGNAL

DOUN.5:	$CALL	CHKABT			;Are we canceled?
	JUMPT	DOUN.9			;Yes, go clean up

	$CALL	TCPCLS			;Close connection
	AOS	J$CNFT(J)		;One more file transferred

	MOVX	S1,SIG.CP		;and take the checkpoint
	$CALL	SIGNAL

DOUN.9:	$RETT
;;;;
;Open connection
;Also set up name of foreign host in J$RHNM
OPNCON:	$CALL	TCPOPN			;Open connection
	MOVE	S1,J$OJFN(J)		;Get JFN of connection
	GDSTS%				;Get some status
	 ERJMP	[FATAL (JFN lost)]
	MOVX	S1,.GTHNS		;We want name of remote host
	HRROI	S2,J$RHNM(J)		;...into J$RHNM
	GTHST%
	 ERJMP UXC.51
	JRST UXC.52
UXC.51: HRROI S1,J$RHNM(J)	;WRITE REMOTE HOST ADDR HERE 
	PUSH P,T2		;SAVE T2
	PUSH P,T3		;SAVE T3
	PUSH P,T4		;SAVE T4
	MOVEI T4,4		;4 BYTES TO PRINT
	MOVE T2,T1
	MOVX T1,FLD(^D10,NO%RDX)!NO%MAG ;UNSIGNED DECIMAL OUTPUT
	HRROI S1,J$RHNM(J)	;INTO THIS LOCATION
	MOVE T3,[POINT 8,T2,3]	;POINT AT OCTETS
UXC.50:	ILDB S2,T3		;GET ONE
	NOUT%			;WRITE IT OUT
	 ERJMP .+1
	MOVEI S2,"."		;SEPARATE WITH A DOT
	IDPB S2,S1
	SOJG T4,UXC.50		;DO IT 4 TIMES
	MOVE S2,S1		;ACT LIKE GTHST
	POP P,T4		;RESTORE THESE ACS (DO THEY NEED TO BE SAVED?)
	POP P,T3
	POP P,T2
UXC.52:	SETZM	S1			;Put a zero last in name
	IDPB	S1,S2

	MOVEI	C,2			;Command character
	$CALL	OUTCHR			;Put it in the buffer
	;Remote printer is J$RLPT
	TXT (0,OUTCHR,^AJ$RLPT(J)^J)
	LOGMSG (<Connection Opened to Server on ^AJ$RHNM(J)^T, Printer "^AJ$RLPT(J)^T", Type "^SJ$FTYP(J)^T">)
	$RETT
;;;;;;;;;;;;;;;;;;
;TCPOPN -- Open the TCP connection
;Get the JFN again first!! (oh no, DEC)
;Failures don't return

TCPOPN:	MOVEI	T1,^D10			;Number of times to try reopening

TCPO.1:	MOVX	S1,GJ%SHT		;LOAD GTJFN FLAGS
	HRROI	S2,J$SSTG(J)		;POINT TO THE STRING
	GTJFN%				;Get JFN of the device
	 ERJMP	[FATAL (<GTJFN Failed Second Time on ^AJ$SSTG(J)^T, ^E>)]
	MOVEM	S1,J$OJFN(J)		;Save JFN
	MOVX	S2,<OF%WR!OF%RD!<FLD 8,OF%BSZ>!<FLD .TCMWIB9,OF%MOD>>	;Send 8 bit bytes in interactive mode
	OPENF%
	 ERJMP	TCPO.2
	$RETT				;We made it

;Here on OPEN failure. Often because old connection was not yet gone.
TCPO.2:	MOVE	S1,J$OJFN(J)		;Get JFN
	CLOSF%				;Close (just in case)
	 ERJMP	.+1			;Oh, well
	MOVE	S1,J$OJFN(J)
	RLJFN%				;Free JFN! (In case it wasn't open)
	 ERJMP	.+1
	MOVX	S1,^D5000		;Sleep for 5 secs
	DISMS%
	SOJGE	T1,TCPO.1		;Try more?
	ERROR (<Can't Open Connection ^AJ$SSTG(J)^T, ^E>)	;No, that's it
	;No return
;;;;;;;;;;;;;;;;;;
;TCPCLS - close connection
;Errors don't return

TCPCLS:	MOVE	S1,J$OJFN(J)
	MOVEI 	S2,.CHFFD		;Send formfeed
	BOUT%
	MOVEI	S1,^D5000
	DISMS%

	MOVE	S1,[.FHSLF,,.TIMEL]	;Self, elapsed time
	MOVEI	S2,^D1500		;Timeout after 1.5 seconds
	MOVEI 	T1,2			;Interrupt on channel 2
	TIMER%				;Fire that sucker up
	 TRN				;Won't lose - famous last words

	MOVEI	S1,
	MOVE	S1,J$OJFN(J)		;Get JFN
	CLOSF%				;close and release JFN
	 ERJMP	[ERROR (<Can't Close Connection ^AJ$SSTG(J)^T, ^E>)]
	$RETT
TCPC.2:	MOVE	S1,[.FHSLF,,.TIMAL]	;Flush pending interrupt requests
	SETZ	S2,			;Don't think this is used
	TIMER%
	 TRN
	MOVE	S1,J$OJFN(J)		;Try closing it again
	CLOSF%
	 TRN
	MOVE	S1,J$OJFN(J)
	RLJFN%
	 TRN
	$RETT				;Done here
	SUBTTL  CHKDVI -- Check if file is a valid DVI file
; RETURN FALSE ($RETF) IF NOT VALID DVI POSTAMBLE
; RETURN TRUE ($RETT) IF VALID DVI POSTAMBLE
; DVI FILE SHOULD END WITH:
; <POSTAMBLE ADDR> n 223 ... 223 <eof>
; WHERE N <= MAXDVR
; TECHNIQUE FROM <CANON.MAKIMP>DVIINP.SAI

CHKDVI:	STKVAR <DVIJFN,NBYTES>
	MOVX	S1,GJ%SHT!GJ%OLD
	HRRO	S2,J$IFNM
	GTJFN%
	 ERJMP	CKPERR
	MOVEM	S1,DVIJFN
	MOVX 	S2,FLD(^D8,OF%BSZ)!OF%RD ;DVI FILES IN 8BIT (ALWAYS?)
	OPENF%			;OPEN THE SUCKER
	 ERJMP 	CKPERR
	SETOM 	S2		;GO TO EOF
	SFPTR%
	 ERJMP 	CKPERR
	RFPTR%			;READ THAT POSITION
	 ERJMP 	CKPERR
	SUBI	S2,PSTBFL*4	;BACK UP LENGTH OF OUR BUFFER
	SFPTR%			;GO TO THAT POINT IN FILE
	 ERJMP	CKPERR
	MOVE	S2,[POINT 8,J$PSTB(J)] ;POINT AT OUR BUFFER
	MOVNI	T1,PSTBFL*4	;READ AT MOST A BUFFER-FULL
	SIN%			;READ THOSE CHARACTERS
	IFJER.
	 MOVE 	T1,S2		;SAVE S2
	 GTSTS%
	 TXNN 	S2,GS%EOF	;EOF?  DON'T WORRY
	  JRST	CKPERR		;SOMETHING ELSE, WORRY ABOUT IT
	 MOVE	S2,T1		;RESTORE S2
	ENDIF.
	MOVE	S1,DVIJFN
	CLOSF%			;NOW WE CAN FLUSH FILE
	 NOP
	SETZM 	DVIJFN		;ZERO OUT JFN, JUST IN CASE
	MOVE	T1,S2		;GET UPDATED BYTE POINTER TO T1
	LDB	S2,T1		;GET LAST BYTE WE READ
	CAIE	S2,DMGNUM	;OUR MAGIC NUMBER
	 $RETF			;MUST NOT BE A DVI FILE, PUNT
	DO.
	 LDB	S2,T1
	 CAIE	S2,DMGNUM	;DMGNUM==^D223
	  EXIT.
	 SETOM	T2
	 ADJBP	T2,T1		;BUMP BYTEPOINTER BACK BY ONE
	 MOVE	T1,T2
	 HRRZS 	T2		;GET LOC POINTED AT BY BP
	 CAIGE	T2,J$PSTB(J)	;BEFORE BEGINNING OF OUR BUFFER?
	  $RETF			;YES, FAIL RETURN (MAYBE DO SOMETHING ELSE?)
	 LOOP.
	ENDDO.
	CAILE	S2,MAXDVR	;BIGGER THAN MAX DVI VERSION?
	 $RETF
	$RETT

;CKPERR - CKDPST ERRORS COME HERE
CKPERR:	SKIPN 	S1,DVIJFN	;HAD A JFN ON FILE?
	IFSKP.
	 CLOSF%			;TRY TO CLOSE IT
	 IFJER.			;IF FAILED, TRY TO FLUSH IT
	  MOVE S1,DVIJFN
	  RLJFN%
	   NOP			;DON'T WORRY TOO MUCH
	 ENDIF.
	ENDIF.
	$RETF			;PROPAGATE FAILURE RETURN
	SUBTTL	NXTFIL -- Find and return the next file in the nextjob msg

;E points to current file descriptor

NXTFIL:	SOSG	J$RFLN(J)		;Decr. 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
	JRST	NXTFIL			;AND LOOP
	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%
	 ERJMP	INPO.9
	MOVEM	S1,J$IJFN(J)		;Success, save the JFN
	
;Do some access checking
;Also set bit to indicate if file should be deleted after processing.

	LOAD	S1,.EQSEQ(J),EQ.PRV	;Get the users priv's
	JUMPN	S1,INPO.4		;Set, he can do everything
	LOAD	S1,.FPINF(E),FP.SPL	;Is the file spooled?
	JUMPE	S1,INPO.2		;No, do normal access check

;File is always to be deleted (since it is spooled)

	MOVE	S1,.FPINF(E)		;Get the file info bits
	TXO	S1,FP.DEL		;Set the delete bit
	MOVEM	S1,.FPINF(E)
	JRST	INPO.4			;Go open it

;Check if user has read access rights to this file

INPO.2:	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%
	 ERJMP	INPO.9			;Fail, deny access
	JUMPE	S1,INPO.9		;Sorry

;Now check if he's allowed to delete this file

	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%
	 ERJMP	.+2			;Deny delete on failure
	JUMPE	S1,INPO.4		;Delete according to bit

	MOVE	S1,.FPINF(E)		;Refuse to delete this file
	TXZ	S1,FP.DEL		;Reset the delete bit
	MOVEM	S1,.FPINF(E)

;Done with access checking. Set up for file opening.
;Get correct byte size into S2

INPO.4:	MOVEI	S2,7			;Load probable (7 bit) byte size
	MOVE	S1,J$FTYP(J)		;See if special mode
	CAXN	S1,<SIXBIT /SCRZAP/>	;Scribe?
	 JRST	INPO.5			;Yes
	MOVEI	S2,^D8			;Assume 8 bit bytes
	CAXN	S1,<SIXBIT /8BIT/>	;Do we want it?
	 JRST	INPO.5			;Yes
	$CALL	CHKSIZ			;Get FDB byte size into S2
	JUMPF	INPO.A			;Some failure
IFN STANSW,<
	CAIN	S2,^D36			;36 bits?
	 MOVEI	S2,^D7			;Yes, probably mean 7 bits
>;IFN STANSW
	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	S2,^D8			;YES,,LOAD 8 BIT BYTE SIZE
	CAXN	T1,.FPF11		;WAS IT /FILE:ELEVEN?
	 MOVEI	S2,^D36			;YES,,LOAD 36 BIT BYTE SIZE
	CAIE	T1,.FPFCO		;/FILE:COBOL?
	 CAIN	T2,%FPLOC		;OR /PRINT:OCTAL?
	  MOVEI	S2,^D36			;YES, USE FULL WORDS

;Byte size in S2, see how many will fit in buffer

INPO.5:	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%
	 ERJMP	INPO.9

	SETZM	J$IBCT(J)		;Indicate input buffer is empty	
	$CALL	GETNAM			;Get a recognizable file name
	$RETT

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

INPO.A:	LOGMSG (<Failure finding byte size for 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
; CHKSIZ - LOOK AT FILE TO FIND ITS REAL BYTE SIZE
;	RETURNS   S2/ BYTE-SIZE
;	RETURNS FALSE IF BAD PAGE OR BYTE ACCOUNT

CHKSIZ:	STKVAR <SIZJFN>
	MOVX 	S1,GJ%SHT+GJ%OLD
	HRRO	S2,J$IFNM(J)	;FILENAME
	GTJFN%
	 ERJMP	.RETF
	MOVEM 	S1,SIZJFN	;SAVE JFN
	SIZEF%			;GET BYTE SIZE
	 ERJMP 	CHKSZY		;SOME ERROR
	JUMPLE	S2,CHKSZY	;PUNT IF BAD BYTE COUNT
	JUMPLE	T1,CHKSZY	;PUNT IF BAD PAGE COUNT
	MOVE	S1,SIZJFN
	MOVE	S2,[1,,.FBBYV]	;READ BYTE SIZE FROM FDB
	MOVEI	T1,T1		;PUT IT IN T1 (NOTE THIS IS AC3, *NOT* AC1)
	GTFDB%
	 ERJMP  CHKSZY		;SOMETHING WENT WRONG
	MOVE	S1,SIZJFN
	RLJFN%			;NOW FLUSH THE JFN 
	 ERJMP 	.RETF
	LOAD	S2,T1,FB%BSZ	;GET BYTE SIZE INTO S2
	$RETT

CHKSZY:	MOVE	T1,SIZJFN	;GET BACK THE FILE JFN
	RLJFN%			;RELEASE IT
	 ERJMP 	.RETF		;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?
	 JRST	INPB.2			;Yes
INPB.1:	$CALL	INPBUF			;No, get a bufferful
	JUMPF	.RETF			;Return false if EOF

INPB.2:	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%
	 ERJMP	INPU.2			;EOF or error?

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

;Handle 'errors'

INPU.2:	GTSTS%				;Get status
	TXNE	S2,GS%EOF		;Check if EOF
	 JRST	INPU.1			;Yupp, return
	LOGMSG (<Error Reading Input File, ^E>)
	TXO	S,ERRFIL		;Skip the rest of the file
	$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
	SETZM	S2
	SFPTR%
	 ERJMP	[FATAL (<Could not Rewind File, ^E>)]
	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:	SKIPN	.FPFR1(E)		;IS THERE A /REPORT KEY?
	 JRST	GETN.1			;NO, CONTINUE ON
	TXT (1,J$INAM(J),^TReport:^0)	;FIRST LINE
	TXT (1,J$IEXT(J),^S.FPFR1(E)^S.FPFR2(E)^0)
	$RETT

GETN.1:	LOAD	S1,.FPINF(E)		;GET FLAGS FOR FILE
	TXNN	S1,FP.SPL		;IS IT A SPOOLED FILE?
	 JRST	GETN.2			;NO, CONTINUE ON
	TXNN	S1,FP.FLG		;YES, IS IT ALSO THE LOG FILE?
	 JRST	GETN.2			;NO, JUST A PLAIN SPOOLED FILE
	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
	$RETT

;Get the open file's name

GETN.2:	MOVE	S2,J$IJFN(J)		;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
	JUMPE	S1,.RETT		;Not spooled: we're done

;Strip off prefix from spooled files

	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

GETN.3:	ILDB	S1,T3			;GET A CHARACTER
	JUMPE	S1,GETN.S		;NO, SPOOLED NAME IF NULL
	CAIE	S1,"-"			;A DASH?
	 JRST	GETN.3			;NO, LOOP
	SOJG	T2,GETN.3		;YES, LOOP UNTIL 4TH FIELD

GETN.5:	ILDB	S1,T3			;GET A CHARACTER
	IDPB	S1,T1			;DEPOSIT IT
	JUMPN	S1,GETN.5		;AND LOOP UNTIL A NULL

	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
	;Fall through			;No, no name: make up one

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

GETN.S:	TXT (1,J$INAM(J),^TSpooled^0)
	TXT (1,J$IEXT(J),^TPrinter File^0)
	$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
	SKIPN	S1
	 JRST	FORM.1			;No need to change forms
	OPRMSG (Forms Changed to ^SJ$FORM(J))		;Tell OPR

;Intialize with default params

FORM.1:	HRLZI	S1,-F$NSW		;GET NEGATIVE SWITCH TABLE LEN
	MOVEI	T1,J$FCUR(J)		;POINT TO CURR 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

	SETZM	J$RLPT(J)		;No name on remote printer yet

	$CALL	FRMINI			;READ THE LPFORM.TXT FILE.
	JUMPT	.+2			;Skip the message if ok
	OPRMSG (<Forms not Found in LPFORM.TXT, Defaults Being Used>)

	MOVE	S1,J$SPTL(J)		;Get protocol
	CAIN	S1,PTLTTY		;Local?
	 JRST	FORM.4			;Yes
	SKIPN	J$RLPT(J)		;Any name on remote printer?
	 FATAL (<LPFORM.TXT Error, No Name on Remote Printer Specified>)

;Set up the width and length classes

FORM.4:	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
	$RETT
	SUBTTL	Search for form in LPFORM.TXT

FRMINI:	MOVX	S1,<GJ%OLD!GJ%SHT>	;Short form, file must exist
	HRROI	S2,FRMFIL		;Point to name string
	GTJFN%
	 ERJMP	.RETF			;Fail
	MOVEM	S1,J$FJFN(J)		;Save JFN
	MOVX	S2,<<FLD 7,OF%BSZ>!OF%RD!OF%THW>	;Flags for opening
	OPENF%
	 ERJMP	[MOVE	S1,J$FJFN(J)	;Fail, clean up
		CLOSF%
		 ERJMP	.+1
		JRST	.RETF]

	TXZ	S,FRMFND		;Clear the forms found flag
	$CALL	FRMIN1			;Parse the file
	MOVE	S1,J$FJFN(J)		;and close it
	CLOSF%
	 ERJMP	.+1			;Ignore errors
	TXNE	S,FRMFND		;Did we find it?
	 $RETT				;Yes
	$RETF				;Nope

;Routines to parse the open file

FRMIN1:	$CALL	FH$SIX			;GET THE FORMS NAME
	JUMPT	FRMI1B			;Found something (No EOF)
	$RET				;Nope, return

FRMI1B:	GETLIM	T2,.EQLIM(J),FORM	;GET FORMS
	CAMN	T1,T2			;MATCH??
	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

FRMI3A:	CAIN	C,"/"			;A SWITCH?
	JRST	FRMIN5			;YES!
	CAIE	C,"("			;A LIST?
	JRST	FRMIN9			;NO, ERROR
FRMIN4:	HLRZ	T2,T1			;GET THE FIRST THREE CHARS
	CAIN	T2,'ALL'		;IS IT "ALL"?
	 JRST	FRMIN5			;YES, STOP CHECKING
	MOVE	S1,J$SPTL(J)		;Are we printing to remote?
	CAIE	S1,PTLTTY
	 JRST	FRMI4A			;Yes, not 'Normal' protocol
	CAIN	T2,'LOC'
	 JRST	FRMIN5			;Local and LOC qualifier
	JRST	FRMI4B			;Local but not LOC qualifer, try dev.
FRMI4A:	CAIN	T2,'REM'		;DOES IT SAY "REMOTE"?
	 JRST	FRMIN5			;YES!!
FRMI4B:	CAMN	T1,J$LDEV(J)		;COMPARE TO OUR DEVNAM
	JRST	FRMIN5			;MATCH!!

	CAIN	C,.CHLFD		;BREAK ON EOL?
	JRST	FRMIN1			;YES, GET NEXT LINE
	CAIE	C,"/"			;IS IT A SLASH?
	CAIN	C,")"			;NO, CLOSE PAREN?
	JRST	FRMI1A			;YES, GET THE NEXT LINE
	CAIN	C," "			; Break on space?
	 JRST	FRMI1A			; Yes, get the next line
	$CALL	FH$SIX			;ELSE, GET THE NEXT LOCATOR
	JUMPF	.RETT			;EOF, RETURN
	JUMPE	T1,FRMIN9		;BAD FORMAT
	JRST	FRMIN4			;AND LOOP AROUND

;GET HERE IF THIS LINE IS FOR US

FRMIN5:	CAIN	C,.CHLFD	;WAS THE LAST CHARACTER A LINEFEED?
	$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
	OPRMSG (<LPFORM.TXT Error, Unrecognized Switch>)
	JRST	FRMIN5		;AND LOOP

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

FRMIN9:	OPRMSG (Bad Format in LPFORM.TXT)
	$RET
	SUBTTL	Forms Switch Subroutines

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

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

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

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

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

S$FF:	MOVE	T1,D$FF			;Get default
	CAIN	C,":"			;Any argument?
	 $CALL	FH$DEC			;Yes, get it
	MOVEM	T1,J$FFF(J)		;Save it
	$RET

S$TABS:	MOVE	T1,D$TABS		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 $CALL	FH$DEC			;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FTAB(J)		;SAVE IT
	$RET

S$TYPE:	MOVE	T1,D$TYPE		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 $CALL	FH$SIX			; Yes, get a SIXBIT keyword
	JUMPF	.RETF			;Return if EOF
	MOVEM	T1,J$FTYP(J)		;Save it
	$RET

S$NAME:	MOVE	T1,[POINT 7,J$RLPT(J)]
	SETZM	T2			;CLEAR THE COUNTER

S$NAM1:	$CALL	FH$CHR			;GET A CHARACTER
	JUMPF	S$NAM2			;EOF, FINISH UP!!
	CAIG	C,40			;MAKE SURE ITS GREATER THAN SPACE
	 JRST	S$NAM2			;ITS NOT!, FINISH UP
	CAIN	C,"/"			;ALSO STOP ON SLASH
	 JRST	S$NAM2			;IT IS!!
	IDPB	C,T1			;DEPOSIT IT
	CAIGE	T2,^D19			;LOOP FOR 20 CHARACTERS
	 AOJA	T2,S$NAM1		;INCR AND LOOP

S$NAM2:	SETZM	S1			;GET A NULL BYTE
	IDPB	S1,T1			;MAKE THE STRING ASCIZ
	$RETT
	SUBTTL	I/O Subroutines for LPFORM.TXT

;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. False return 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"		;LC char?
	 SUBI	C,^O40		;Make it UC
	CAIL	C,"A"		;CHECK FOR ALPHA
	CAILE	C,"Z"
	  SKIPA			;ITS NOT!!
	JRST	FH$SX2		;IT IS, DEPOSIT IT

	CAIL	C,"0"		;CHECK FOR NUMBER
	CAILE	C,"9"
	$RETT			;NO REASONALBE

FH$SX2:	SUBI	C,40		;CONVERT TO SIXBIT
	TLNE	T2,770000	;GET SIX YET?
	IDPB	C,T2		;NO, DEPOSIT ANOTHER
	JRST	FH$SX1		;AND LOOP AROUND


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

;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C

FH$CHR:	MOVE	S1,J$FJFN(J)		;Get JFN for LPFORM.TXT
	BIN%
	 ERJMP	.RETF			;Quit on error or EOF
	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
	$RETT

;ROUTINE TO SEARCH FOR EOL IN LPFORM.TXT

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!

;Routine to pick up a decimal number, a minus sign is accepted.
;Returned in T1

FH$DEC:	CLEAR	T1,		;PLACE TO ACCUMULATE RESULT
	TXZ	S,MINUS		;Not negative
	$CALL	FH$CHR		;Get a char
	JUMPF	FH$DE9		;Return if EOF
	CAIE	C,"-"		;Minus sign?
	 JRST	FH$DE2		;No
	TXO	S,MINUS		;Yes, indicate that
FH$DE1:	$CALL	FH$CHR		;GET A CHARACTER
	JUMPF	FH$DE9		;EOF, RETURN
FH$DE2:	CAIL	C,"0"		;CHECK THE RANGE
	CAILE	C,"9"		;0-9
	  JRST	FH$DE9		;RETURN
	IMULI	T1,12		;SHIFT A PLACE
	ADDI	T1,-"0"(C)	;ADD IN A DIGIT
	JRST	FH$DE1		;AND LOOP AROUND

FH$DE9:	TXNE	S,MINUS		;Did we have a minus sign?
	 MOVN	T1,T1		;Yes, negate
	$RETT
	SUBTTL	Routines for the logging

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;LOGCHR - Puts the char in C in the log buffer
;No return if buffer overflows.

LOGCHR:	SOSGE	J$LBCT(J)		;DECREMENT THE BYTE COUT
	 JRST	[OPRMSG (Aborted - Log File too Big)
		MOVX	S1,SIG.DN	;Tell superior we're done
		$CALL	SIGNAL]
		;No return
	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:	TXNN	S,FILXFR		;Transfering a file?
	 JRST	OUTC.0			;No
	SKIPLE	J$IIPG(J)		;Yes, Any pages to skip?
	 $RETT				;Yes, don't output anything

OUTC.0:	CAIL    C,40			;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

OUTC.1:	SOSGE	J$OBCT(J)		;DECREMENT THE BYTE COUT
	 JRST	OUTC.2			;LOSE, GO DUMP THE BUFFER
	IDPB	C,J$OBPT(J)		;DEPOSIT A BYTE
	$RETT				;AND RETURN

OUTC.2:	$CALL	OUTBUF			;DUMP THE BUFFER
	JRST	OUTC.1			;AND TRY AGAIN


;;;;;;;;;;;;;;;;;;;;;;
;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
	 SETZM	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)
	TXNE	S,CHRCNT		;Dummy output?
	 JRST	OUTRES			;Yes

	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
	SOUTR%				;Output it
	 ERJMP	[ERROR (<SOUTR Failed, ^E>)]
	;Fall through

; 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 LPT CONTROL ROUTINES
	PRINTX	[Processing LPT code]

;The following routines handle the device independant character
;translation and formatting of the output.
;All routines hereafter only use OUTCHR and OUTBUF to output stuff
;and the input file routines to input stuff.

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

CHTAB:	EXP	<NCLRFF+.POPJ>		   ;(00) NULL
	EXP	CHKARO			   ;(01) CONTROL-A
	EXP	CHKARO			   ;(02) CONTROL-B
	EXP	CHKARO			   ;(03) CONTROL-C
	EXP	CHKARO			   ;(04) CONTROL-D
	EXP	CHKARO			   ;(05) CONTROL-E
	EXP	CHKARO			   ;(06) CONTROL-F
	EXP	CHKARO			   ;(07) CONTROL-G
	EXP	CHKARO			   ;(10) CONTROL-H
	EXP	NCLRFF+DOTAB		   ;(11) THIS IS A TAB
	EXP	SUPRCH+EOLCHR+DOLF	   ;(12) THIS IS A LINE FEED
	EXP	CHKARO			   ;(13) Vert Tab
	EXP	SUPRCH+NCLRFF+EOLCHR+DOFORM   ;(14) THIS IS A FORM-FEED
	EXP	NCLRFF+EOLCHR+OUTCHR	   ;(15) CARRIAGE RETURN
	EXP	CHKARO			   ;(16) CONTROL-N
	EXP	CHKARO			   ;(17) CONTROL-O
	EXP	CHKARO			   ;(20)
	EXP	CHKARO			   ;(21) DC1
	EXP	CHKARO			   ;(22) DC2
	EXP	SUPRCH+EOLCHR+DODC3	   ;(23) DC3 SKIPS 1 LINE
	EXP	CHKARO			   ;(24) DC4
	EXP	CHKARO			   ;(25) CONTROL-U
	EXP	CHKARO			   ;(26) CONTROL-OL-V
	EXP	CHKARO			   ;(27) CONTROL-W
	EXP	CHKARO			   ;(30) CONTROL-X
	EXP	CHKARO			   ;(31) CONTROL-Y
	EXP	CHKARO			   ;(32) CONTROL-Z
	EXP	CHKARO			   ;(33) ESCAPE
	EXP	CHKARO			   ;(34) CONTROL-\
	EXP	CHKARO			   ;(35) CONTROL-]
	EXP	CHKARO			   ;(36) CONTROL-^
	EXP	CHKARO			   ;(37) CONTROL-

;FORTRAN CONTROL CHARACTOR TRANSLATION TABLE

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

FORTAB:	FORCHR	" ",.CHLFD,1
	FORCHR	"0",.CHLFD,2
	FORCHR	"1",.CHFFD,1
	FORCHR	"2",20,1
	FORCHR	"3",13,1
	FORCHR	"/",24,1
	FORCHR	"*",23,1
	FORCHR	"+",.CHCRT,1
	FORCHR	54,21,1
	FORCHR	"-",.CHLFD,3
	FORCHR	".",22,1
		NFORCH==.-FORTAB
	SUBTTL 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

FILOUT:	$CALL	HEAD			;PRINT THE HEADER and a FF

	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
	$CALL	SETLST			;Setup report code (if needed)
	$CALL	SETPFT			;Setup file type
	$CALL	(T1)			;DISPATCH
	$CALL	OUTBUF			;Empty buffer

	TXZ	S,FILXFR		;Finished with the file
	SKIPE	J$XTOP(J)		;Are we at TOF?
	 $RET				;Yes, just return
	TXNN	S,CHRCNT		;If dummy output, don't charge
	 AOS	J$ANPT(J)		;No, charge him for rest of page
	$RET

;SETLST -- Subroutine to compile code to test each line for a match against
; the /REPORT value.

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

;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA:	$CALL	INPBYT
SETLSB:	JUMPF	.RETT
SETLSC:	CAIE	C,0
SETLSD:	JRST	FLUSH7
	SUBTTL	SETPFT  --  Setup file processing type

;Called to determine which type of processing should be done on the
;input file.
;
;Returns with T1 containing  address of processing routine as follows:
;
;	LPTRAW, 7 bit bytes <--> /TYPE:SCRZAP
;	LPTRAW, 8 bit bytes <--> /TYPE:8BIT or /FILE:ASCII8
;	LPTRAW, 7 or 8 bit bytes <--> /TYPE:RAW 
;	LPTOCT	<-->	/PRINT:OCTAL
;	LPTCOB	<-->	/FILE:COBOL
;	LPTFOR	<-->	/FILE:FORTRAN /PRINT:(ARROW,ASCII,SUPPRESS)
;	LPTRPT	<-->	/FILE:ASCII7 /REPORT:XXX /PRINT:(ARROW,ASCII,SUP)
;	LPTASC	<-->	/FILE:ASCII7 /PRINT:(ARROW,ASCII,SUPPRESS)
;	LPTELV	<-->	/FILE:ELEVEN
;
;The determination is done in the above order

SETPFT:	MOVE	S1,J$FTYP(J)		;Get /TYPE switch (from LPFORM.TXT)
	MOVEI	T1,LPTRAW		;Assume special mode
	CAME	S1,[SIXBIT/RAW/]
	 CAMN	S1,[SIXBIT/SCRZAP/]	;Special?
	  $RET				;Yes	
	CAMN	S1,[SIXBIT/8BIT/]	;Always 8 bit ASCII?
	 $RET				;Yes
	LOAD	S1,.FPINF(E),FP.FFF	;GET /FILE
	LOAD	S2,.FPINF(E),FP.FPF	;GET /PRINT
	TXZ	S,ARROW			;CLEAR SOME INITIAL FLAGS
	TXO	S,NEWLIN!FCONV		;AND SET SOME OTHERS

	CAIN	S1,.FPF8B		;/FILE:ASCII8
	 $RET				;Yes

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

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

	CAIN	S2,%FPLAR		;/PRINT:ARROW?
	 TXO	S,ARROW			;YES, LIGHT A FLAG
	CAIN	S2,%FPLSU		;/PRINT:SUPPRESS?
	 TXO	S,SUPFIL!ARROW		;YES, LIGHT A BIT, (for arrow mode too)

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

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

	MOVEI	T1,LPTASC		;ASSUME STANDARD ASCII
	SKIPE	.FPFR1(E)		;UNLESS /REPORT WAS SPECIFIED
	 MOVEI	T1,LPTRPT		;USE REPORT ROUTINE
	$RET				;AND RETURN
	SUBTTL	LPTASC  --  Print Regular ASCII on LPT

LPTASC:	$CALL	INPBYT			;Get a character
	JUMPF	.RETT			;If false, EOF
	$CALL	LPTOUT			;else go output it
	JRST	LPTASC			;Get the next char
	SUBTTL	LPTRAW  --  Print the file verbatim

LPTRAW:	$CALL	INPBYT			;Get a char
	JUMPF	.RETT			;Return on EOF
	$CALL	OUTCHR			;Send the char as is
	JRST	LPTRAW
	SUBTTL	LPTELV  --  Print MACY11 file as regular ASCII

LPTELV:	$CALL	INPBYT			;Get a byte (36 bit word)
	JUMPF	.RETT			;Return if EOF

	MOVE	T1,C			;Save the word
	LDB	C,[POINT 8,T1,17]	;GET THE FIRST BYTE
	$CALL	LPTOUT			;PRINT IT
	LDB	C,[POINT 8,T1,9]	;GET SECOND BYTE
	$CALL	LPTOUT			;PRINT IT
	LDB	C,[POINT 8,T1,35]	;GET THIRD BYTE
	$CALL	LPTOUT			;PRINT IT
	LDB	C,[POINT 8,T1,27]	;GET FOURTH BYTE
	$CALL	LPTOUT			;PRINT IT
	JRST	LPTELV			;GET THE NEXT FOUR BYTES
	SUBTTL	LPTFOR  --  Process FORTRAN data files

LPTFOR:	$CALL	INPBYT			;Get a byte
	JUMPF	.RETT			;Return if EOF
	JUMPE	C,LPTFOR		;IGNORE NULLS

	TXZE	S,FCONV			;CHECK FOR CTL CHAR
	JRST	FORCNV			;GO DO IT
	CAIN	C,.CHLFD		;LINEFEED?
	TXOA	S,FCONV			;FLAG NEXT CHAR AS CTL CHAR
	$CALL	LPTOUT			;OTHERWISE PRINT IT
	JRST	LPTFOR			;AND LOOP AROUND AGAIN.

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

FORC.2:	HRRZ	C,FORTAB(T1)		;GET TRANS CHAR AND REPEAT COUNT
	LDB	T1,[POINT 9,C,26] 	;GET REPEAT COUNT IN T1
	MOVEM	T1,J$XFRC(J)		;SAVE THE REPEAT COUNT
	ANDI	C,177			;AND DOWN TO CHARACTER
FORC.3:	$CALL	LPTOUT			;SEND THE CHARACTER
	SOSLE	J$XFRC(J)		;COUNT DOWN THE REPEAT COUNTER
	JRST	FORC.3			;AND LOOP
	JRST	LPTFOR			;AND CONTINUE
SUBTTL	LPTRPT  --  Process REPORT files

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

LPTOCT:	$CALL	.SAVE3			;SAVE P1 -- P3
	LOAD	T1,.FPINF(E),FP.FSP	;GET THE SPACING CODE
	CAIE	T1,1			;SINGLE SPACE?
	SKIPA	P2,[22,,1]		;NO--THEN TRIPLE SPACE, DOUBLE SPACE
					;IS UGLY --DO NOT ALLOW IT
	MOVE	P2,[12,,3]		;SINGLE SPACE THE LISTING
OCT1:	MOVEI	T1,(P2)			;BLOCK PER PAGE
OCT2:	MOVEI	T2,^D16			;LINES PER BLOCK
OCT3:	MOVEI	T3,^D8			;WORDS PER LINE
	MOVE	P1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIN	P1,2			;IS IT 2?
	MOVEI	T3,4			;YES, USE 4 WORDS/LINE
	CAIN	P1,1			;IS IT 1?
	MOVEI	T3,2			;YES, USE 2 WORDS/LINE
OCT4:	MOVEI	T4,^D12			;DIGITS PER WORD
	MOVEI	C," "			;EACH WORD BEGINS WITH 3 BLANKS
	$CALL	OUTCHR			;ONE
	$CALL	OUTCHR			;TWO
	$CALL	OUTCHR			;THREE
	$CALL	INPBYT			;GET A WORD
	JUMPF	.RETT			;DONE!!
	MOVE	P3,C			;COPY WORD
	SETZM	J$XTOP(J)		;FLAG MIDDLE OF FORM
	MOVE	P1,[POINT 3,P3]		;LOAD BYTE POINTER
OCT5:	ILDB	C,P1			;GET NEXT DIGIT
	MOVEI	C,60(C)			;MAKE ASCII
	$CALL	OUTCHR			;PRINT CHAR
	SOJG	T4,OCT5			;END OF WORD?
	SOJG	T3,OCT4			;END OF LINE?
	HLRZ	C,P2			;GET MOTION CHARACTER
	$CALL	OUTCHR
	SOJG	T2,OCT3			;END OF BLOCK?
	$CALL	OUTCHR			;YES--2 EXTRA LINE FEEDS
	$CALL	OUTCHR
	SOJG	T1,OCT2			;END OF PAGE?
	MOVEI	C,.CHFFD		;PRINT A FORM FEED
	$CALL	DOFORM			;AND ENFORCE QUOTA ETC.
	JRST	OCT1			;PRINT NEXT PAGE
	SUBTTL	LPTCOB  --  Process COBOL Sixbit Files

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

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

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

COBOL3:	$CALL	INPBYT			;GET A DATA WORD
	JUMPF	.RETT			;END OF FILE-- ACTUALY THIS SHOULD
					; NEVER HAPPEN SINCE THE COUNT IS EXACT.
	MOVEI	T1,6			;CHARS PER WORD.
	CAIG	P1,6			;ARE WE DOWN TO LAST DREGS?
	MOVEI	T1,(P1)			;YES--USE EXACT COUNT TO AVOID FREE
					; CRLF ON EXTRA BLANKS.
	MOVE	T2,C			;COPY WORD
	MOVE	P2,[POINT 6,T2]		;POINT TO WORD
COBOL4:	ILDB	C,P2			;AND GET THE CHARACTER
	MOVEI	C,40(C)			;MAKE ASCII
	$CALL	OUTCHR			;PRINT
	SOJG	T1,COBOL4		;LOOP FOR NEXT CHAR
	SUBI	P1,6			;COUNT 6 MORE CHARS
	JUMPG	P1,COBOL3		;GET MORE
	MOVEI	C,.CHCRT		;LOAD A CARRIAGE RETURN
	$CALL	OUTCHR			;PRINT IT
	MOVEI	C,.CHLFD		;LOAD A LINE FEED
	$CALL	DOLF			;AND SEND EOL
	JRST	COBOL1			;LOOP FOR MORE.

COBOL5:	MOVEI	C,.CHFFD		;GET A FORM FEED.
	$CALL	OUTCHR			;PUT IT OUT.
	$RETT				;AND RETURN.
	SUBTTL	Character Interrogation Routines

;Subroutine to place a char in the output buffer, possibly translated
;Call with the char in C

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

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

;;;;;
;HERE TO THROW AWAY A LINE. Used with /REPORT code.

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


ISEOL:	CAIL	C," "			;IS IT PRINTABLE?
	$RETF				;YES, ITS NOT AN EOL
	MOVE	S1,CHTAB(C)		;NO, GET TABLE ENTRY
	TXNN	S1,EOLCHR		;IS IT AN EOL?
	$RETF				;NO, JUST RETURN
	TXO	S,NEWLIN		;YES, SET NEW LINE
	$RETT				;AND RETURN

;;;;;
;Here on a TAB

DOTAB:	SKIPN	S1,J$FTAB(J)		;Get TAB form data
	 JRST	DOT.2			;Zero: don't translate TAB

;Simulate TAB by spaces
	
	MOVE    T1,J$XHPS(J)		;Get horiz position
	IDIV	T1,S1			;Get HPOS mod (stop distance) to T2
	MOVN	T2,T2			;Negate it
	ADD	T2,J$FTAB(J)		;Comp. no of blanks to insert
DOT.1:  MOVEI   C," "			;Get a space
	$CALL	OUTCHR			;and output it
        SOJG    T2,DOT.1                ;loop
	$RETT

DOT.2:	MOVEI	C,.CHTAB		;Don't translate the TAB
	$CALL	OUTCHR
	$RETT

;;;;;
;HERE ON A LINE FEED

DOLF:	LOAD	T1,.FPINF(E),FP.FSP	;GET SPACING PARAMETER
	SETO	S1,			;START WITH 1 LINE
DOLF1:	SOJLE	T1,CNTDWN		;ANY MORE?
	MOVEI	C,.CHLFD		;LOAD A LINE-FEED
	$CALL	OUTCHR			;YES--GIVE IT
	SOJA	S1,DOLF1		;AND SUBTRACT FROM QUOTA

;;;;;
;HERE TO PROCESS A FORM FEED

DOFORM:	SKIPE	J$XTOP(J)		;SKIP IF NOT AT TOP OF FORM
	 $RET				;DO NOT PRINT BLANK PAGES
	MOVN	S1,J$XVPS(J)		;THIS TAKES ALL WE HAVE ON PAGE
	SKIPL	S1			;WAS VPOS NEGATIVE?
	 CLEAR	S1,			;DONT CHARGE FOR ANYTHING THEN.
					;THIS MIGHT GIVE THE USER A
					;BONUS OF 1-3 FREE LINES.
	JRST	CNTDWN			;COUNT DOWN THE LIMIT

;;;;;
;HERE IF /PRINT:SUPPRESS

DOSUP:	MOVEI	C,.CHLFD		;MAKE IT A LINEFEED, REGARDLESS
	SKIPE	J$XTOP(J)		;SKIP IF NOT TOP
	$RET				;ONLY 1 LINE FEED IN A ROW
	SETOM	J$XTOP(J)		;AND SET TOP
	SETO	S1,
	JRST	CNTDWN			;CHARGE FOR THE LINE

;;;;;
;HERE TO DO ARROW MODE STUFF IF NEEDED

CHKARO:	TXNN	S,ARROW			;ARROW MODE?
	 PJRST	OUTCHR			;NO--JUST PRINT
DOARO:	PUSH	P,C			;SAVE C
	MOVEI	C,"^"			;LOAD A ^
	$CALL	OUTCHR			;PRINT THE ^
	POP	P,C			;RESTORE C
	MOVEI	C,100(C)		;MAKE INTO REAL LETTER
	PJRST	OUTCHR			;PRINT

;;;;;
;HERE ON A DC3

DODC3:	SETOM	S1			;DC3 SKIPS 1 LINE
	JRST	CNTDWN			;AND COUNT DOWN
	SUBTTL	CNTDWN -- COUNT DOWN LINE FEEDS AND PAGE FEEDS

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

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

;Here when we are to start on next page

CNTDW1:	MOVE	S1,J$FLIN(J)		;BACK TO TOP OF PAGE
	MOVEM	S1,J$XVPS(J)		;SAVE POSITION
	SOSL	J$IIPG(J)		;Decr. page skip count
	 JRST	CNTDW2			;Still skipping, don't charge
	TXNN	S,CHRCNT		;If dummy output, don't charge
	 AOS	J$ANPT(J)		;Incr. total number printed (but not skipped)

CNTDW2:	AOS	J$CNPT(J)		;ADD 1 TO PAGES PER COPY COUNTER
	$CALL	LIMCHK			;Check the page limit
	CAIN	C,23			;Is the char a DC3?
	 JRST	CNTDW3			;Yes, special handling
	SETZM	J$XTOP(J)		;We always want the FF
	MOVE	S1,J$FFF(J)		;Get FF switch
	TXNE	S1,F$FFPG		;Skip if we don't want pagination
	 PJRST	SENDFF			;FF to skip crease
	PJRST	OUTCHR			;Just output char

CNTDW3:	MOVEI	S1,3			;Here if DC3
	ADDM	S1,J$XVPS(J)		;GIVE HIM 3 XTRA LINES
	MOVEI	C,.CHLFD		;Make it a LF
	PJRST	OUTCHR			;Output it and return

;;;;;;;;;
;SENDFF - Routine to send a FF if J$XTOP is cleared

SENDFF:	MOVEI	C,.CHFFD		;LOAD A FF
	SKIPN	J$XTOP(J)		;SKIP IF ALREADY AT TOP
	 $CALL	OUTCHR			;NO, SEND IT
	SETOM	J$XTOP(J)		;Indicate we are at top of form
	$RETT
	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	Routines to generate headers and trailers

;;;;;;;;;;;;;;;;;;;;;
;JOBTRL - Generates trailer pages

JOBTRL:	$SAVE	<P1,P2,P3>
	MOVEI	T1,[ASCIZ /END/]	;ADDRESS OF END TEXT
	$CALL	GIVHDR			;GO SETUP THE LINE

	TXNE	S,SUPFIL		;Are we suppressing forms?
	 SETZM	J$XTOP(J)		;Don't believe we are at top of forms.
	MOVE	S1,J$FFF(J)		;Get FF field
	TXNE	S1,F$FFBT		;No FF before trailer?
	 $CALL	SENDFF	

	SKIPGE	P3,J$FTRA(J)		;Get no of pages to print
	 JRST	JOBT.1			;Negative i.e. we want banner pages
	$CALL	TRAILR			;Print ordinary trailer pages
	JRST	JOBT.9

JOBT.1:	MOVN	P3,P3			;We don't want neg. page count
	$CALL	BANNER			;but we do want banners!!!

JOBT.9:	MOVE	S1,J$FFF(J)		;Get FF field
	TXNE	S1,F$FFAT		;No FF after trailer?
	 $CALL	SENDFF
	PJRST	OUTBUF			;Finish up


;;;;;;;;;;;;;;;;
;JOBHDR - Generates banner pages

JOBHDR:	$SAVE	<P1,P2,P3>
	MOVEI	T1,[ASCIZ /START/]	;ADDRESS OF START TEXT
	$CALL	GIVHDR			;GO SET THE LINE

	MOVE	S1,J$FFF(J)		;Do we want a FF?
	TXNE	S1,F$FFBB
	 $CALL	SENDFF
	MOVE	P3,J$FBAN(J)		;Get number of pages
	$CALL	BANNER
	PJRST	OUTBUF			;Dump the buffer


;;;;;;;;;;;;;;;;;;;
;GIVHDR - Sets up the header line

GIVHDR:	MOVEI	T2,LPTVER		;Get version number
	MOVEI	T3,LPTMIN
	LOAD	T4,.EQSEQ(J),EQ.SEQ	;Get job sequence number
	GTAD%				;Get current time
	MOVE	P1,S1
	TXT (1,J$XHBF(J),<^T*** ^A0(T1)^T *** Job ^S.EQJOB(J)^T, Seq. #^DT4^T for ^A.EQOWN(J)^T at ^CP1^T  SMPSPL version ^DT2^T.^DT3^T Running on ^ASYSNAM^T *** ^A(T1)^T ***^0>)

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

PTRS:	POINT	7,0(S1)
	POINT	7,0(S1),6
	POINT	7,0(S1),13
	POINT	7,0(S1),20
	POINT	7,0(S1),27
	POINT	7,0(S1),34
	SUBTTL	BANNER  --  Routine to print a banner

;P3 should contain number of pages to print

BANNER:	MOVEI	C,.CHCRT		;Send a CR to stupid printer
	$CALL	OUTCHR
	SKIPN	P3			;Get number of banner pages
	 $RETT				;Zero, forget this
	TXT (1,J$XTMP(J),^A.EQOWN(J)^0)	;Get user name

	SKIPA				;FF has already been sent
BANN.1: $CALL	SENDFF			;SEND A FORM FEED
	SETZM	J$XVPS(J)		;AND SET 0 POSITION
	MOVEI	T1,4			;LOAD AN OFFSET
	CAIN	P3,1			;IS THIS THE LAST BANNER?
	 ADDM	T1,J$XVPS(J)		;YES, DON'T PRINT OVER CREASE
	$CALL	BANN.2			;PRINT A BANNER PAGE
	SOJG	P3,BANN.1		;AND LOOP
	$RETT				;Return

;Subroutine to output one banner page

BANN.2:	$CALL	PLPBUF			;PRINT A LINE
	$CALL	PLPBUF			;PRINT ANOTHER LINE
	$CALL	CRLF			;TYPE A CRLF
	MOVEI	S1,1			;LOAD THE BLOCKSIZE
	MOVEI	S2,J$XTMP(J)		;AND THE STRING ADDRESS
	$CALL	PICTUR			;AND PRINT A PICTURE
	MOVEI	T1,^D12			;COUNT'EM
	ADDM	T1,J$XVPS(J)		;...
	$CALL	PLPBUF			;PRINT A LINE
	$CALL	PLPBUF			;AND ANOTHER
	$CALL	PLPBUF			;AND A THIRD
	MOVEI	T1,0			;LOAD A NULL.
	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIN	S1,3			;ROOM ENOUGH FOR THE TITLE?
	MOVEI	T1,[ASCIZ /Note:/]	;YES, LOAD IT
	GETLIM	T2,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	JUMPE	T2,PLINES		;NO NOTE, FINISH THE PAGE
	GETLIM	T3,.EQLIM(J),NOT2	;AND THE SECOND HALF
	TXT (1,J$XTMP(J),^A0(T1)^ST2^ST3^0)
	MOVEI	S1,1			;GET THE BLOCKSIZE
	MOVEI	S2,J$XTMP(J)		;GET THE ADDRESS
	$CALL	PICTUR			;AND SEND IT OUT
	MOVEI	S1,^D11			;LOAD NUMBER OF LINES
	ADDM	S1,J$XVPS(J)		;AND MOVE DOWN THE PAGE
	PJRST	PLINES			;GO TO EOP AND RETURN
	SUBTTL	TRAILR  --  Routine to Print a Trailer

;P3 should contain the number of pages to print

TRAILR:	MOVEI	C,.CHCRT		;Send a CR to stupid printer
	$CALL	OUTCHR
	SKIPN	P3			;Get number of trailer pages
	 $RETT				;Zero, return now

	SKIPA				;Already done the FF
TRAI.1:	$CALL	SENDFF			;SEND A FORMFEED
	SETZM	J$XVPS(J)		;CLEAR THE VERTICAL POSITION
	$CALL	TRAI.2			;PRINT THE INTERNAL LOG
	$CALL	PLINES			;PRINT TILL END OF PAGE
	SOJG	P3,TRAI.1		;LOOP UNTIL DONE
	$RETT				;Return

;Here to print the internal log

TRAI.2:	$CALL	PLPBUF			;PRINT A LINE
	$CALL	PLPBUF			;AND ANOTHER LINE

	MOVE	T1,J$FWCL(J)		;GET THE WIDTH CLASS
	TXT (0,OUTCHR,<^T        >)	;Output a "TAB"
	SOJG	T1,.-1			;PRINT N OF THEM
	TXT (0,OUTCHR,<^T* * * T C P S P L  R u n  L o g * * *^M^J^J>)

	MOVEI	P1,2			;Keep track of how many lines we print

;Output log buffer

	TXT	(0,LOGCHR,^0)		;Put a NUL last in buffer
	TXT	(0,OUTCHR,^AJ$LBFR(J))	;and dump it

	MOVE	T1,[POINT 7,J$LBFR(J)]	;Now count the number of lines
TRAI.3:	ILDB	S1,T1
	CAIN	S1,.CHLFD
	 AOS	P1			;One more line
	JUMPN	S1,TRAI.3		;Continue until NUL

	$CALL	CRLF			;Skip a couple of lines
	$CALL	CRLF
	$CALL	CRLF
	ADDI	P1,3			;Incr. no of lines in log
	ADD	P1,J$XVPS(J)		;Compute vert. pos.
	IDIV	P1,J$FLIN(J)		;DID WE OVERFLOW A PAGE?
	MOVEM	P2,J$XVPS(J)		;SAVE CURRENT POSITION
	SUB	P3,P1			;REDUCE PAGES TO PRINT
	$RETT
	SUBTTL	Utility routines for header printing

PLPBUF:	TXT (0,OUTCHR,^AJ$XHBF(J)^M^J^J^J^J)	;Dump line and skip 3 lines
	MOVEI	S1,4			;We printed 4 lines
	ADDM	S1,J$XVPS(J)		;Add to count
	$RET


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

PEOP:	MOVE	T2,J$FLIN(J)		;GET NUMBER OF LINES/PAGE
	SUB	T2,J$XVPS(J)		;SUBTRACT THOSE PRINTED
	ADDI	T2,1			;COUNT THE MARGIN
PEOP1:	JUMPLE	T2,PEOP2		;GO FINISH OFF
	$CALL	CRLF			;PRINT A CRLF
	SOJA	T2,PEOP1		;AND LOOP
PEOP2:	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	MOVSI	P1,-3			;GET COUNTER
PEOP3:	MOVE	P2,STARS(P1)		;GET ADDRESS OF TEXT STRING
	MOVE	P3,J$FWID(J)		;GET THE WIDTH
	CAILE	P3,^D130		;IS IT REASONABLE?
	MOVEI	P3,^D130		;NOW IT IS
PEOP4:	ILDB	C,P2			;GET A CHARACTER
	$CALL	OUTCHR			;PUT A CHARACTER
	SOJG	P3,PEOP4		;LOOP
	$CALL	CRLF			;SEND LF
	AOBJN	P1,PEOP3		;LOOP FOR ALL RULER LINES
	$RET				;AND RETURN

CRLF:	TXT (0,OUTCHR,^M^J)		;Print CRLF
	$RETT				;AND RETURN
	SUBTTL	HEAD  --  Generate File-header pages

;E should point to the FP block and J$INAM, J$IEXT have correct contents

HEAD:	$SAVE	<P1,P2,P3>		;Save some ACs
	TXNE	S,SUPFIL		;Are we suppressing forms?
	 SETZM	J$XTOP(J)		;Don't believe we are at top of forms.

	MOVE	S1,J$FFF(J)		;Get FF field
	TXNE	S1,F$FFBF		;No FF before file
	 $CALL	SENDFF
REPEAT 0,<		;This louses things royally up at Stanford
	MOVEI	C,.CHCRT		;Send a CR for stupid printers
	$CALL	OUTCHR
>;REPEAT 0
	LOAD	S2,.FPINF(E),FP.NFH	;Get the no header bit
	SKIPE	S2			;Skip if we want headers
	 JRST	OUTBUF			;No header: Dump buffers and return
	MOVE	P3,J$FHEA(J)		;Get number of header pages
	JUMPE	P3,OUTBUF		;None wanted: Dump buffer and return

HEA.01:	$CALL	HEAD.1			;Print one header page
	$CALL	SENDFF			;and a FF
	SOJGE	HEA.01			;Loop until done
	PJRST	OUTBUF			;Force everything out and return

;Subroutine to print one header page

HEAD.1:	MOVEI	S1,1			;Set blocksize
	MOVEI	S2,J$INAM(J)		;and address of first line
	$CALL	PICTUR			;PRINT THE LINE
	MOVEI	S1,1			;Blocksize again
	MOVEI	S2,J$IEXT(J)		;AND ADDRESS OF SECOND LINE
	$CALL	PICTUR			;AND PRINT THE SECOND LINE
	TXT (0,OUTCHR,^AJ$XHBF(J))	;Output banner line

;Output some info on the file

	MOVE	S1,J$IJFN(J)		;Get JFN
	MOVEI	S2,J$XTMP(J)		;Arg block
	MOVEI	T1,.RSCRV+1		;Only interested in creation time
	RFTAD%
	MOVE	T1,.RSCRV+J$XTMP(J)	;Get creation time
	GTAD%				;Get current time
	MOVE	T2,S1

	TXT (0,OUTCHR,<^M^J^J^J^TFile ^A@J$IFNM(J)^T, Created: ^CT1^T, Printed: ^CT2>)
	GETLIM	T1,.EQLIM(J),FORM	;GET FORMS NAME
	TXT (0,OUTCHR,<^M^J^TJob parameters:  Request created: ^C.EQAFT(J)^T   Page limit: ^DJ$RLIM(J)^T  Forms: ^ST1^T  Account: ^A.EQACT(J)>)
	GETLIM	T1,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	GETLIM	T2,.EQLIM(J),NOT2	;GET SECOND HALF OF NOTE
	SKIPE	T1			;IS THERE A NOTE?
	 TXT (0,OUTCHR,<^M^J^T                 Note:^ST1^ST2^M^J>)

	LOAD	T1,.FPINF(E),FP.FSP	;GET /SPACING
	LOAD	T2,.FPINF(E),FP.FCY	;GET THE TOTAL COPY COUNT
	LOAD	T3,J$CNCT(J)		;GET THE COPIES DONE SO FAR
	ADDI	T3,1			;MAKE THIS THE CURRENT COPY
	TXT (0,OUTCHR,<^M^J^TFile parameters: Copy: ^DT3^T of ^DT2^T   Spacing: ^SSPCTAB-1(T1)>)
	LOAD	T1,.FPINF(E),FP.FPF	;GET /PRINT
	LOAD	T2,.FPINF(E),FP.FFF	;GET /FILE
	CAXN	T2,.FPF8B		;/FILE:8-BIT?
	 MOVEI	T2,4			;YES, RECORD THE VALUE
	CAXN	T2,.FPF11		;/FILE:ELEVEN?
	 MOVEI	S2,5			;YES,,RECODE THE VALUE
	TXT (0,OUTCHR,<^M^J^T                 Format: ^SFFMTAB-1(T2)^T   Print mode: ^SFMTAB-1(T1)>)
	LOAD	S1,.FPINF(E),FP.DEL	;GET /DELETE BIT
	SKIPE	S1			;IS IT SET?
	 TXT (0,OUTCHR,<^T /DELETE>)	;YES,,SAY SO
	MOVE	S1,J$IIPG(J)		;GET STARTING PAGE
	CAILE	S1,1			;SKIP IF 0 OR 1
	 JRST	[TXT (0,OUTCHR,<^M^J^TPrinting will start at page ^DJ$IIPG(J)>)
		 JRST	.+1]		;[3104] MORE HEADER LETS CONTINUE
	$RETT


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

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

SPCTAB:	SIXBIT	/SINGLE/
	SIXBIT	/DOUBLE/
	SIXBIT	/TRIPLE/
	SUBTTL	PICTUR  --  Routine to print block letters

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

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

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

	TXT (0,OUTCHR,^M^J^J^J^J)		;Print four blank lines
	$RETT

;HERE TO PRINT ONE LINE OF THE CURRENT SEGMENT

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

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

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

PICT.5:	MOVE	T2,P1			;GET THE BLOCKSIZE
	$CALL	OUTCHR			;PRINT IT
	SOJG	T2,.-1			;LOOP
	$RET				;AND RETURN

PICT.6:	POP	P,T4			;RESTORE T4
	PJRST	CRLF			;TYPE A CR AND RETURN
	SUBTTL	Tables for the block letters

CHRTAB:	BYTE (5) 00,00,00,00,00,00,00	;SP
	BYTE (5) 04,04,04,04,04,00,04	;!
	BYTE (5) 12,12,00,00,00,00,00	;"
	BYTE (5) 12,12,37,12,37,12,12	;#
	BYTE (5) 04,37,24,37,05,37,04	;$
	BYTE (5) 31,31,02,04,10,23,23	;%
	BYTE (5) 10,24,10,24,23,22,15	;&
	BYTE (5) 06,02,00,00,00,00,00	;'
	BYTE (5) 04,10,20,20,20,10,04	;(
	BYTE (5) 04,02,01,01,01,02,04	;)
	BYTE (5) 00,25,16,33,16,25,00	;*
	BYTE (5) 00,04,04,37,04,04,00	;+
	BYTE (5) 00,00,00,00,00,06,02	;,
	BYTE (5) 00,00,00,37,00,00,00	;-
	BYTE (5) 00,00,00,00,00,06,06	;.
	BYTE (5) 00,00,01,02,04,10,20	;/

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

	BYTE (5) 16,21,21,27,25,25,07	;@
	BYTE (5) 16,21,21,21,37,21,21	;A
	BYTE (5) 36,21,21,36,21,21,36	;B
	BYTE (5) 17,20,20,20,20,20,17	;C
	BYTE (5) 36,21,21,21,21,21,36	;D
	BYTE (5) 37,20,20,36,20,20,37	;E
	BYTE (5) 37,20,20,36,20,20,20	;F
	BYTE (5) 17,20,20,20,27,21,16	;G
	BYTE (5) 21,21,21,37,21,21,21	;H
	BYTE (5) 16,04,04,04,04,04,16	;I
	BYTE (5) 01,01,01,01,21,21,16	;J
	BYTE (5) 21,21,22,34,22,21,21	;K
	BYTE (5) 20,20,20,20,20,20,37	;L
	BYTE (5) 21,33,25,21,21,21,21	;M
	BYTE (5) 21,21,31,25,23,21,21	;N
	BYTE (5) 16,21,21,21,21,21,16	;O

	BYTE (5) 36,21,21,36,20,20,20	;P
	BYTE (5) 16,21,21,21,25,22,15	;Q
	BYTE (5) 36,21,21,36,24,22,21	;R
	BYTE (5) 17,20,20,16,01,01,36	;S
	BYTE (5) 37,04,04,04,04,04,04	;T
	BYTE (5) 21,21,21,21,21,21,37	;U
	BYTE (5) 21,21,21,21,21,12,04	;V
	BYTE (5) 21,21,21,21,25,33,21	;W
	BYTE (5) 21,21,12,04,12,21,21	;X
	BYTE (5) 21,21,12,04,04,04,04	;Y
	BYTE (5) 37,01,02,04,10,20,37	;Z
	BYTE (5) 14,10,10,10,10,10,14	;[
	BYTE (5) 00,00,20,10,04,02,01	;\
	BYTE (5) 06,02,02,02,02,02,06	;]
	BYTE (5) 04,12,21,00,00,00,00	;^
	BYTE (5) 00,00,00,00,00,00,37	;_

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

	BYTE (5) 04,10,10,20,10,10,04	;OPEN BRACE
	BYTE (5) 04,04,04,00,04,04,04	;VERTICAL BAR
	BYTE (5) 04,02,02,01,02,02,04	;CLOSE BRACE
	BYTE (5) 00,10,25,02,00,00,00	;TILDE
	BYTE (5) 00,00,00,00,00,00,00	;RUBOUT
SUBTTL	STARS - Job definition/separation line definitions


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


STARS1:	ASCII	/000000000000000000000000000000000000000000000000000000000000/
	ASCII	/000000000000000000000000000000000000000111111111111111111111/
	ASCII	/1111111111/

STARS2:	ASCII	/000000000111111111122222222223333333333444444444455555555556/
	ASCII	/666666666777777777788888888889999999999000000000011111111112/
	ASCII	/2222222223/

STARS3:	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/1234567890/

LPTEND::END	SMPSPL