Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/galsrc/lptspl.mac
There are 45 other files named lptspl.mac in the archive. Click here to see a list.
	TITLE	LPTSPL - TOPS-20 Line Printer Driver  
	SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH	LPTMAC			;SEARCH LPTSPL PARAMETERS
	SEARCH	GLXMAC			;SEARCH GALAXY PARAMETERS
	PROLOGUE(LPTSPL)
	SEARCH	QSRMAC			;SEARCH QUASAR PARAMETERS
	SEARCH	ORNMAC			;SEARCH ORION/OPR PARAMETERS
;**;[6051]At SEARCH ORNMAC add 1 line  JCR  11/29/89
	SEARCH	NEBMAC			;[6051]Search NEBULA parameters

IFN FTACNT,<
	SEARCH ACTSYM			;[6000]SEARCH THE ACCOUNTING UNIVERSAL
>
	SEARCH	MACSYM			;[6044]

	.DIRECT	FLBLST

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

	SALL				;SUPPRESS MACRO EXPANSIONS
	SUBTTL	Edit vector and Version numbers

LPTVEC:	BLDVEC	(LPTMAC,LMC,L)		;[6000]
	BLDVEC	(LPTCLU,CLU)		;[6000]
	BLDVEC	(LPTDQS,DQS)		;[6001]
	BLDVEC	(LPTUSR,USR)		;[6005]
	BLDVEC	(LPTSUB,LSB)		;[6007] 
	BLDVEC	(GLXMAC,GMC,L)
	BLDVEC	(ORNMAC,OMC,L)
	BLDVEC	(QSRMAC,QMC,L)
	BLDVEC	(LPTSPL,LPT,L)

	LPTMAN==:6055			;Maintenance edit number
	LPTDEV==:6045			;Development edit number
	VERSIN (LPT)			;Generate edit number

	LPTWHO==0			;WHO LAST PATCHED
	LPTVER==6			;MAJOR VERSION NUMBER
	LPTMIN==0			;MINOR VERSION NUMBER

	LPTVRS==<VRSN.(LPT)>+LMCEDT+CLUEDT+DQSEDT+LSBEDT;+GMCEDT+OMCEDT+QMCEDT

	LOC	137
LPTVNO:	EXP	LPTVRS
	RELOC
	Subttl	Table of Contents

;		     Table of Contents for LPTSPL
;
;				  Section		      Page
;
;
;    1. Edit vector and Version numbers  . . . . . . . . . . .   2
;    2. Revision history . . . . . . . . . . . . . . . . . . .   6
;    3. Definitions
;        3.1    Global Symbols . . . . . . . . . . . . . . . .   7
;        3.2    DN60 Support Definitions . . . . . . . . . . .   8
;        3.3    IB and HELLO message blocks  . . . . . . . . .   9
;        3.4    Interrupt System Database  . . . . . . . . . .  10
;        3.5    Words to Zero in Job Page  . . . . . . . . . .  11
;        3.6    Random Impure Storage  . . . . . . . . . . . .  12
;        3.7    Resident Job Database  . . . . . . . . . . . .  13
;    4. Initialization . . . . . . . . . . . . . . . . . . . .  14
;    5. Idle Loop  . . . . . . . . . . . . . . . . . . . . . .  15
;    6. Scheduler
;        6.1    CHKTIM - Check Stream Wakeup Time  . . . . . .  16
;        6.2    DSCHD - Do Scheduler Pass  . . . . . . . . . .  17
;        6.3    FIXPDL - Fix PDL routine . . . . . . . . . . .  20
;        6.4    FIXACT - Set Stream to Inactive  . . . . . . .  21
;    7. Job Processing
;        7.1    DOJOB - Do the Job . . . . . . . . . . . . . .  22
;        7.2    NXTFIL - Find And Return The Next File . . . .  24
;        7.3    FILDIS - Keep or Delete Printed Files  . . . .  25
;        7.4    DETDEL - Determine Is A File Is To Be Deleted   26
;        7.5    FILE - Print a File  . . . . . . . . . . . . .  27
;        7.6    ENDJOB - End Of Job Processor  . . . . . . . .  28
;        7.7    QRELEA - Send A Requeue/Release Message  . . .  29
;    8. IPCF Interface
;        8.1    CHKQUE - Receive and Schedule IPCF Messages  .  31
;        8.2    CHKOBJ - Validate Object Block . . . . . . . .  32
;        8.3    GETBLK - Break Down An IPCF Message  . . . . .  33
;        8.4    FORFOR - Force Forms Change  . . . . . . . . .  34
;        8.5    DOFFOR - Operator Set Forms  . . . . . . . . .  35
;        8.6    KILL - User (or operator) CANCEL Request . . .  36
;        8.7    QSRNWA - Shutdown stream whose node dropped  .  37
;        8.8    DSTATU - Send status info  . . . . . . . . . .  38
;        8.9    CHKPNT - Request for Checkpoint  . . . . . . .  39
;        8.10   UPDATE - Send Status Updates . . . . . . . . .  40
;        8.11   NXTJOB - Nextjob Message . . . . . . . . . . .  41
;        8.12   SETUP - Setup/Shutdown Message . . . . . . . .  43
;        8.13   SHUTDN - Shut Down A Printer . . . . . . . . .  48
;        8.14   RSETUP - Send A Response-To-Setup  . . . . . .  49
;        8.15   OACRSP - Response to a WTOR  . . . . . . . . .  50
;        8.16   OACCAN - Operator Abort Request  . . . . . . .  51
;        8.17   OACSUP - Operator SUPPRESS Request . . . . . .  53
;        8.18   OACPAU - Operator STOP Request . . . . . . . .  54
;        8.19   OACCON - Operator CONTINUE request . . . . . .  55
;        8.20   OACREQ - Operator REQUEUE request  . . . . . .  56
;        8.21   OACALI - Operator ALIGN request  . . . . . . .  58
	Subttl	Table of Contents (page 2)

;		     Table of Contents for LPTSPL
;
;				  Section		      Page
;
;
;        8.22   OACFWS - Operator Forward Space Command  . . .  60
;        8.23   OACBKS - BACKSPACE Operator Action . . . . . .  61
;        8.24   Backspace
;            8.24.1   BSPACE - Backspace Pages . . . . . . . .  62
;            8.24.2   BCOPYS - Backspace Copies  . . . . . . .  64
;            8.24.3   BFILES - Backspace Files . . . . . . . .  65
;        8.25   OPRD60 - Receive DN60 OPR messages from QUASAR  66
;        8.26   OPRCHK - Check for and Send DN60 Messages  . .  68
;        8.27   Subroutines
;            8.27.1   FNDOBJ - Find The Object Block . . . . .  71
;            8.27.2   TOOBAD - Operator Is Too Late  . . . . .  72
;            8.27.3   SNDQSR - Send A Mesasge To QUASAR  . . .  73
;    9. Align Processor
;        9.1    Align Forms on Printer . . . . . . . . . . . .  74
;        9.2    ALISCD - Schedule Align  . . . . . . . . . . .  75
;        9.3    Create A 10/20 FD For The Align File . . . . .  76
;   10. Printer Output
;       10.1    CHKLPT - Make Sure The Device Is Online  . . .  77
;       10.2    OUTGET - Open The Output Device  . . . . . . .  78
;       10.3    OUTGET Exit Subroutines  . . . . . . . . . . .  79
;       10.4    TAPGET - Setup A Magtape Device For Output . .  80
;       10.5    OUTOUT - Output A Buffer . . . . . . . . . . .  81
;       10.6    OUTERR - Handle Output Device Errors . . . . .  82
;       10.7    Tape Routines  . . . . . . . . . . . . . . . .  87
;       10.8    OUTWON - Wait for on-line  . . . . . . . . . .  88
;       10.9    OUTREL - Release Device On SHUTDOWN  . . . . .  89
;       10.10   OUTEOF - Clear The LPT Output Buffers  . . . .  90
;       10.11   OUTDMP - Dump Out Buffers and Wait . . . . . .  91
;       10.12   OUTFLS - Flush Already Buffered Output . . . .  92
;       10.13   LPT Control Routines . . . . . . . . . . . . .  93
;       10.14   FILOUT - Set Up For LPTIN and LPTOUT . . . . .  95
;       10.15   SETLST - Compile Code For /REPORT  . . . . . .  96
;       10.16   SETPFT - Setup File Processing Type  . . . . .  97
;       10.17   LPTASC - Print Regular ASCII on LPT  . . . . .  98
;       10.18   LPTELV - Print MACY11 File as Regular ASCII  .  99
;       10.19   LPTFOR - Process FORTRAN Data Files  . . . . . 100
;       10.20   LPTRPT - Process REPORT Files  . . . . . . . . 101
;       10.21   LPTOCT - Give an Octal Dump  . . . . . . . . . 102
;       10.22   LPTCOB - Process COBOL Sixbit Files  . . . . . 103
;       10.23   Character Interrogation Routines . . . . . . . 104
;       10.24   CNTDWN - Count Down Line Feeds and Page Feeds  106
;       10.25   LIMCHK - Check On Page Limits  . . . . . . . . 108
;       10.26   Subroutines to Send Messages To Output Device  112
;       10.27   Generate Headers and Trailers  . . . . . . . . 113
;       10.28   BANNER - Print A Banner  . . . . . . . . . . . 114
;       10.29   TRAILR - Print a Trailer . . . . . . . . . . . 115
;       10.30   Utility Routines . . . . . . . . . . . . . . . 117
	Subttl	Table of Contents (page 3)

;		     Table of Contents for LPTSPL
;
;				  Section		      Page
;
;
;       10.31   STARS - Job Separation Lines . . . . . . . . . 118
;       10.32   HEAD - Generate File-Header Pages  . . . . . . 119
;       10.33   SETHDR - Setup Header Name For File  . . . . . 121
;       10.34   PICTUR - Print Block Letters . . . . . . . . . 125
;   11. Interrupt System
;       11.1    Initialization . . . . . . . . . . . . . . . . 128
;       11.2    Connect Lineprinter  . . . . . . . . . . . . . 129
;       11.3    IPCF Interrupt . . . . . . . . . . . . . . . . 130
;       11.4    Device Interrupt . . . . . . . . . . . . . . . 131
;   12. DN60 Routines
;       12.1    Local/Remote I/O Subroutines . . . . . . . . . 132
;       12.2    DN60 I/O Support Routines  . . . . . . . . . . 134
;       12.3    D60SU - DN60 Success Routine To Fix Counts . . 137
;       12.4    D60ER/D60OE - Process DN60 errors  . . . . . . 138
;       12.5    IBMSTS - Send IBMCOM Statistics Message  . . . 141
;   13. Terminal Spooling
;       13.1    TTYGET - Setup A Terminal Printer  . . . . . . 143
;       13.2    TTYG - Setup the terminal for output . . . . . 144
;       13.3    TTYG.6 - error handler for TTYG. . . . . . . . 146
;       13.4    CHKTTY - Check TTY Status  . . . . . . . . . . 147
;       13.5    LODTTY - Load TTY VFU  . . . . . . . . . . . . 149
;       13.6    LATGET - Get LAT Printer . . . . . . . . . . . 150
;       13.7    LAT error handling routines  . . . . . . . . . 152
;       13.8    Errors from the LAT BOX for the LATOP% JSYS. . 153
;       13.9    LATTHC - Terminate the LAT connection  . . . . 154
;   14. End of LPTSPL  . . . . . . . . . . . . . . . . . . . . 155
	SUBTTL	Revision history

COMMENT \

*****  Release 4.2 - begin maintenance edits  *****

3103	4.2.1528	9-Nov-82
	Fix copyright and fix RELOC.

3104	4.2.1543	3-Mar-83
	If needed, make sure we send a form feed after FORWARDSPACE, /BEGIN:xx
	and RELEASEing a REQUEUEd print job.  Forward space the total number of
	pages in numerous FORWARDSPACE commands.  Send a form feed if we have 
	forward space beyond the number of pages in a file so that the trailer
	will begin on a new page.

3105	4.2.1562	1-Dec-83
	Release the JFN if the device is not available and is not remote.
        In either case, indicate no output channel.  Also put the DN60 in 
	OUTDNA under DN60 conditionals.

3106    4.2.1565	22-Dec-83
        In FRMIN4, correct the way locator switches are processed
        to ensure that DN60 remote printers are processed correctly. 

3107	4.2.1568	16-Feb-84
        In FORMS, initialize the pointer TEXTBP after the call to 
        OUTDMP so as to prevent occasional BPN stop codes from occuring due
        to TEXTBP being changed by OPRD60 which is called by OUTDMP if there
        are any DN60 messages pending.

3111	4.2.1585	13-Aug-84
	If end of line characters have not been found after a number of
	characters have been analyzed, inform the operator and give the
	option of either aborting the print request, continuing to print
	the file with end of line checking or continuing to print the file
	with no end of line checking.

3112	4.2.1587	13-Aug-84
	Allow 2780/3780 type remote station to receive console messages
	during forms change by setting PSF%OO at the $DSCHD in FORMS, and
	clearing it when the forms change is completed. This is to prevent
	an active stream awaiting forms change from blocking the remote
	printer.

3113	4.2.1593	18-Sep-84
	In FORMS, reload S1 with the forms type specified in the forms 
	change message prior to determining whether to send to OPR a
	"load forms" message. 

3114	2/28/85		SPR# 20-20303
	In routine OACRSP: don't set the update status word until FORM.4
has confirmed that the response is valid.  Also add some checks for DN60
printer when setting the update status bits.
	GCO 4.2.1611

3115	4/22/85 In routine CHKM2: use index register S1 when updating the flag
word.

3116	4/29/85
	Set the update status flag, JOBUPD, after a valid response is given to
a WTOR.
	GCO	4.2.1616

3117	5/21/85
	If a print job is canceled due to unprintable lines being detected, 
indicate in the trailer page that the job was canceled by the operator.
	GCO 4.2.1617

*****  Release 5.0 - begin development edits  *****

3120	5.1003		10-Jan-83
	Move to new development area.  Add version vector.  Clean up
	edit organization.  Update TOC.

3121	5.1046		21-Oct-83
	Change version number from 104 to 5.

3122	5.1092		13-Feb-84
	Make system process by setting IB.SYS in IB.

3123	5.1197		5-Feb-85
	Make an optional system process using GALGEN.

3124	5.1200		6-Feb-85
	Do GTJFNs with bit GJ%ACC turned on to restrict access to the JFNs.

*****	Release 5.0 - begin maintenance edits	*****

3130	Increment maintenance edit level for version 5 of GALAXY.

3131	5.1226		16-Oct-85
	Reset the EOL  counter (J$PRNT) for each file in a print job

3132	5.1227		17-Oct-85
	Reset the forms characteristics when a request is aborted

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

6000	6.1027		19-Oct-87
	Add support for cluster printing. 

6001	6.1036		24-Oct-87
	Add support for DQS printing, update TOC and create LPTSUB.

6002	6.1049		31-Oct-87
	If LPTSPL detects that it is to be started as a local printer,
cause it to open the LPT device before sending the RESPONSE TO SETUP
message to QUASAR.

6003	6.1050		3-Nov-87
	Do not check for a Cluster LPTSPL type at routine ENDJOB since
Cluster LPTSPL does not go through this code. At routine ENDREQ, clear
all the status bits except the LPT type bit. At routine QRELEA, do
not allow a Cluster LPTSPL to clean up any spooled files or do accounting.
At routine INPOPN, first check if a remote user has access to the file.

6004	6.1056		4-Nov-87
	Remove all references to the checksumming word CHECKS.

6005	6.1061		6-Nov-87
	Add support for spooling to LAT and TTY line terminal printers.
Create the new module, LPTUSR, for terminal characteristic definitions. (User
modifications should be made in LPTUSR.)

6006	6.1062		7-Nov-87
	Simplify LPTSPL's determination of LPT type during SETUP. Modify
routine FNDOBJ to only compare unit number instead of unit number and
attributes.

6007	6.1071		9-Nov-87
	Move forms, logging, input file, and other routines to LPTSUB.
Fix references to FILTYP(J).  Don't set hold bit when requeueing in
QRELEA unless the ABORT bit is also set for LPTDQS.  Note that the 
OPR REQUEUE command will light the ABORT bit.  Remove a lot of TOPS-10 
only code.

6010	6.1071		11-Nov-87
	Fix some things from last edit.

6011	6.1072		12-Nov-87
	In routine OUTSOK, check whether we have a connect ID for a LAT line
and skip trying to connect the LPT.  In routine SETH.W, always use block size
of one when it is a TTY or a LAT printer. In routine TTYG.1, use AC j and not
T1.  In routine TTYG.N, if the printer is a LAT call LATTHC to terminate the
connection.  In routine LATGET, skip the LATOP% if we already have a
connection.  In routine LATTHC, store the address of the LATOP arg block in AC
1 and clear J$CID(J).

6012	6.1074		13-Nov-87
	Move some storage around, replace code lost at HEAD.2-2.  Fix bugs in
trailer routine (LPTSPL should leave printer at TOF after a job because if
the system crashes and reloads, the paper position is assumed to be a TOF
when the VFU is loaded later).  Also remove misguided code in BANNER.

6013	6.1079		16-Nov-87
	Add code to handle LAT errors.  Move label TTYG.2 up one instruction
so that the default TTY characteristic is remembered in J$TTYC.  Add a delay
timer in routine LATTHC before we terminate the LAT connection.  This is a 
work around for a MONITOR bug in which the MONITOR is terminating the LAT
connection before the last buffer is outputted.

6014	6.1082		17-Nov-87
	LPTSPL crashes with LTF.  In routine LATTHC, call $CLOSF to close the
terminal before terminating the LAT connection.

6015	6.1082		18-Nov-87
	In routine LATREP, check for greater or equal to .LAUNK and not just
greater.

6016	6.1086		18-Nov-87
	In routine MXTJ.4:, if we can't get a LAT connect requeue the job.
Breakup TTYGET so that it will only handle the TTY case and have LATGET handle
the LAT case.  TTYG will return true if the terminal printer is setup and false
if not.  LATGET returns true if a LAT connection and the terminal printer is
setup.  False if it is not.

6017	6.1086		19-Nov-87
	If TTYG returns false S1 contains error status.  S1=0 means operator
aborted the setting of the terminal characteristic .  S1=TOPS-20 error code.

6020	6.1087		19-Nov-87
	In routine OUTE.3:, line noise got merge with the code.

6021	6.1088		19-Nov-87
	In routine LATTHC:, if the CLOSF fails do the LATOP% (.LATHC).

6022	6.1091		20-Nov-87
	We didn't output 132 columns of forms ruler.  Also fix location of
the *START* and **END** strings so that they are at the extreme right and left.

6023	6.1092		20-Nov-87
	In routine NXTJ.4:, do not requeue the job if we can't get a LAT
connection.  Instead, release the object and shut down the stream.  In routine
LATREJ:, if the LAT error is .LASIU retry 5 times before we give up.

6024	6.1103		25-Nov-87
	In routine TAPGET and LATGET: (LATGE2:+), do a MOVSI to get the pointer
instead of the HRLI because S1 might contain something in the right half. Also,
in routine LATTHC: after the CLOSF, do a LATHC.

6025	6.1104		27-Nov-87
	In routine KILL: and OACCAN:, return if the job is a LAT printer job.
Don't flush the buffers.  In routine SHUTDOWN:, Call LATTHC to shutdown a LAT
printer.

6026	6.1105		30-Nov-87
	In routine OACR.2:, change the TXNE to TXNN, so that only DQS jobs
get the "DQS job requeued from beginning of job" and not for all jobs.

6027	6.1111		 1-Dec-87
	Make sure that AC S is saved in stream context after setup message.

6030	6.1130		7-Dec-87
	In routine NXTJ.4: call SHUTIN to shut down the stream because we are
in stream context.

6031	6.1132		7-Dec-87
	Do not specify an attribute for a cluster LPTSPL in the RESPONSE-TO-
SETUP message.

6032	6.1153		30-Dec-87
	Let J$FHEA and J$FBAN determine how many header and banner pages to 
print.  Delete two lines at HEAD.1 and BANN.1.

6033	6.1163		6-Jan-88
	Do not specify an attribute for DQS and LAT LPTSPLs in the RESPONSE-
TO-SETUP message.

6034	6.1171		22-Jan-88
	Cause routine FORFOR to correctly check for a cluster printer or not.
This solves the problem of local printers stopping after a SET PRINTER FORMS
command.

6035	6.1225		8-Mar-88
	Update copyright notice.

6036	6.1229		22-Mar-88
	In routine LATREJ: check for error .LAIAR (Immediate Access Reject)
and treat it as a recoverable error.

6037	6.1232		1-Mar-88
	In routine LATTHC: create new entry point, LATABT:, to lit CZ%ABT
for CLOSF if we are terminatung the LAT connection due to an error.

6040	6.1234		6-Apr-88
	Upon receipt of an ALIGN, BACKSPACE, FORWARDSPACE or SUPPRESS message,
do not check if the LPT type if cluster or DQS since QUASAR only sends these
messages to local LPTs.

6041	6.1238		22-APR-88
	No ERJMPs after JSYS calls in routine CHKTTY:. 

6042	6.1249		6-May-88
	In routine DOFFOR:, if we are a LATSPL call LATGET to make a connection
and call LATTHC when we are done.  Also, in routine LATTER: clear J$LCHN.

6043	6.1251		9-May-88
	Add a check for LAT error codes .LAIRS and .LASCS in routine LATREJ.
Also report any LAT errors that are not defined.

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

6045	6.1256		14-May-88
	If a cancel request originated from a remote node in the cluster,
then indicate in the log and in the $WTO sent to ORION the user who canceled
the print request and the node that the request came from.

6046	6.1272		1-Jan-89
	Pages printed is always zero when /MODE:SUPPRESS switch is used.  This
is a day one bug.  In routine DOSUP: don't set J$XTOP, let CNTDWN do it.
LAT connection is not release on a forms change if the print job is canceled.
Do not call LATGET in SETUP: (SETUP message) because NEXTJB: does it too.

6047	6.1274		24-Feb-89
	Since TOPS-20 LPTSPL is a single stream process, process the forms 
change command right away instead of doing it in stream context from the
scheduler.

6050	6.1278		9-May-89
	Add support to print in portrait and landscape mode on a LN03.
In order for us to support landscape and portrait, they must be defined as:
@SET REMOTE-PRINTER CHARACTERISTIC LANDSCAPE 0 and @SET REMOTE-PRINTER
CHARACTERISTIC PORTRAIT 52.

6051	6.1289		29-Nov-89
	Add support for processing messages that originate from a remote node
in the cluster.

6052	6.1290		6-Dec-89
	At SETUP time resolve the /TERMINAL-CHARACTERISTIC switch and setup the
device accordingly, i.e LAT or TTY.  Break routine TTYG into 2, LATCHA and TTYG
LATCHA resolves the /Terminal-Characteristic: switch and TTYG applies the
terminal characteristic when it prints a job.

6053	6.1292		16-Dec-89
	Correct problems with remote OPR CANCEL messages. Add support for 
Kill WTORs that originated from a remote node.

6054	6.1295		27-Dec-89
	Set a flag to say that we are doing a forms change and since we are not
in job context we do not have to send a FF or dump the output buffer.  This
will prevent a printer coming on line during a forms change and sending QUASAR
an update status message which will cause QUASAR to schedule a job while we are
still waiting for a response to the forms change query.

6055	6.1305		19-Jan-90
	Change two $WTOs to $QWTOs in routine ALISCD.

\   ;End of Revision History
	SUBTTL	Definitions -- Global Symbols

;Global symbols in LPTSPL

	INTERN	CNTSTA,DETDEL,DIRNAM,DSCHD,ENDREQ,JOBACT,JOBOBA
	INTERN	LEV1PC,LPTSIZ,LPTVNO,NXTFIL,RSETUP,SHUTIN,SNDQSR
	INTERN	ENDREQ,ENDJOB,LPCNF,JOBCHK,IB,STREAM		;[6001][6007]
	INTERN	CONANS,DEPBP,TEXTBP,JOBUPD,JOBWAC,$MTOPR	;[6007] 
	INTERN	ENDRSP,OUTWON,OUTDMP,SENDFF,ALISCD		;[6007] 
;**;[6054]At ENDRSP+1 add 1 symbol
	INTERN	RMJOBI,JOBCOM					;[6044][6054]
;**;[6051]After INTERN RMJOBI add 1 line  JCR  11/29/89
	INTERN	G$NEBF,G$REMN,JOBNUL,G$NULA,JOBPID		;[6051]

;Globular symbols for LPTCLU

	EXTERN	CLNCLU,CLUEDT,ENDFRK,FIXCLU,INILNK,INTDAV,REMREL,RCVINT
	EXTERN	CLJOB					;[6001] 

;Globular symbols from LPTDQS

	EXTERN	DQSINI,DQSREL,DQSFIX,DQSLOG,DQSJOB,DQSEDT ;[6001][6007]

;Globular symbols from LPTSUB

	EXTERN	LOGCHR,FORMS,LODVFU,LODRAM,LSBEDT,FMOPN	;[6007] 
	EXTERN	LSTAF,LFINF,D$ALCN,D$ALSL,D$TAPE,FILTYP	;[6007] 
	EXTERN	LPMSG,LPDAT,LPOPR,LPEND,LPERR		;[6007]
	EXTERN	INPOPN,INPBUF,INPBYT,INPERR,INPFEF,INPREW,INPCLS ;[6007] 
	EXTERN	ACTBEG,ACTEND		;[6007] 
;**;[6051]At EXTERN ACTBEG,ACTEND add 1 line  JCR  11/29/89
	EXTERN	SNDNUL			;[6051]
;Globular symbols from LPTUSR

	EXTERN  TTYTAB,DEFPRI,TABEND	;[6005]
;**;[6050]At EXTERNAL TTYTAB +1L add 1 line  JYCW  5/8/89
	EXTERN	PORTFT,LANDFT		;[6050]Symbols in LPTUSR
	SUBTTL	Definitions -- DN60 Support Definitions

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

IFN FTDN60,<
	    SEARCH D60UNV		;GET UNIVERSAL

	.Z.==$ER1ST			;SET STARTING VALUE

	DEFINE	ERRS(CODE,TEXT),<XLIST
	CODE==.Z.			;;DEFINE THE ERROR CODE
	EXP	[ASCIZ\TEXT\]		;;DEFINE THE TEXT FOR IT
	.Z.==.Z.+1			;;BUMP ERROR CODE COUNTER
	LIST>

D60TXT:	D60ERR	TEXT			;DEFINE THE ERROR TEXT

	DEFINE	X(ERR,TXT),<XLIST
ER'ERR:	ASCIZ\TXT\
	LIST>

	X	(FCC,<Failed to Close DN60 Console>)
	X	(FCO,<Failed to Close DN60 Output>)
	X	(DOE,<DN60 Output Error>)
	X	(COP,<Can't Open DN60 Printer>)
	X	(COC,<Can't Open DN60 Console>)
	X	(CRP,<Can't Release DN60 Printer>)
	X	(CRC,<Can't Release DN60 Console>)
	X	(COE,<DN60 Console Output Error>)

		PHASE	0

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

> ;END FTDN60 CONDITIONAL
	SUBTTL	Definitions -- IB and HELLO message blocks


INTVEC==:LEVTAB,,CHNTAB

IB:	$BUILD	IB.SZ				;
	 $SET(IB.PRG,,%%.MOD)			;SET UP PROGRAM NAME
	 $SET(IB.INT,,INTVEC)			;SET UP INTERRUPT VECTOR ADDRESS
	 $SET(IB.PIB,,PIB)			;SET UP PIB ADDRESS
	 $SET(IB.FLG,IP.STP,1)			;STOPCODES TO ORION
	 $SET(IB.FLG,IB.SYS,LPT.JP)		;Set process type 
	 $SET(IB.FLG,IB.NAC,1)			;Restrict access to JFNs
	$EOB					;

PIB:	$BUILD	PB.MNS				;
	 $SET(PB.HDR,PB.LEN,PB.MNS)		;PIB LENGTH,,0
	 $SET(PB.FLG,IP.PSI,1)			;PSI ON
	 $SET(PB.INT,IP.CHN,0)			;INTERRUPT CHANNEL
	 $SET(PB.SYS,IP.BQT,-1)			;[6000]MAX SEND/RECEIVE IPCF QUOTA
	 $SET(PB.SYS,IP.MNP,^D2)		;[6000]NUMBER OF PIDS
	$EOB					;


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

;  The following is the message that is sent to QUASAR to indicate
;  activity using the DN60-IBMCOM

IFN FTIBMS,<
IBMSTM:	$BUILD	(MSHSIZ+1)			;Header plus status
						;word
	  $SET	(.MSTYP,MS.CNT,MSHSIZ+1)	;Length of message
	  $SET	(.MSTYP,MS.TYP,.QOIBM)		;IBMCOM statistics is
						;message type
	$EOB					;Everything else is
						;zero
> ;End of FTIBMS
	SUBTTL	Definitions -- Interrupt System Database

;Level table

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

;Channel table

CHNTAB:	XWD	1,INTIPC		;IPCF INT - LEVEL 1
	XWD	1,INTDEV		;DEV OFF LINE INT - LEVEL 1
	XWD	1,INTDAV		;[6000]DATA AVAILABLE OR DISCONNECT
	XWD	1,RCVINT		;[6000]INTERRUPT MESSAGE AVAILABLE
	BLOCK	^D32			;[6000]RESTORE OF THE TABLE

LEV1PC:	BLOCK	1			;LVL 1 INTERRUPT PC STORED HERE
LEV2PC:	BLOCK	1			;LVL 2 INTERRUPT PC STORED HERE
LEV3PC:	BLOCK	1			;LVL 3 INTERRUPT PC STORED HERE
	SUBTTL	Definitions -- Words to Zero in Job Page

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

ZTABLE:					;PUT TABLE HERE

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

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

PDL:	BLOCK	PDSIZE		;PUSHDOWN LIST

MESSAG:	BLOCK	1		;ADDRESS OF MESSAGE JUST RECEIVED
BLKADR:	BLOCK	1		;IPCF MSG BLK ADDR SAVE AREA
SAB:	BLOCK	SAB.SZ		;A SEND ARGUMENT BLOCK
MSGBLK:	BLOCK	MSBSIZ		;A BLOCK TO BUILD MESSAGES IN.

IMESS:	BLOCK	1		;IPCF message -1=one to be released
LPCNF:	BLOCK	<LPCNFL==32>	;[6022] Sysname
LPJOB:	BLOCK	1		;LPTSPL'S JOB NUMBER
LPTRM:	BLOCK	1		;TERMINAL DESIGNATOR
LPCON:	BLOCK	1		;CONNECT TIME
LPLNO:	BLOCK	1		;LINE NUMBER
JOBITS:	BLOCK	1		;SAVE JOB STATUS BITS FLAG.
STRSEQ:	EXP	4000		;STREAM SEQ #'S (START AT 4000)
SCHEDL:	-NPRINT,,0		;STREAM SCHEDULING DATA

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

CNTSTA:	BLOCK	1		;NUMBER OF THE CENTRAL STATION

RUTINE:	BLOCK	1		;MESSAGE PROCESSING ROUTINE ADDRESS.

EMSG:	BLOCK	1		;Address of error message for D60ER

OPRERR:	BLOCK 1			;OPR error - Flag used to indicate source
				;   of DN60 error  -1 - indicates opr cons. fail

DEFINE	X(A),<ASCIZ/A/>		;[6000]MAKE LOGICAL NAME ASCIZ
DIRNAM: L$DIRN			;LOGICAL NAME OF SHARED DIRECTORY
LPTSIZ:	BLOCK	1		;[6000]SIZE OF LPTSPL IN PAGES
RSNFLG:	BLOCK	1		;[6012] Holds addr of ASCIZ abort reason
FDADDR:	BLOCK	1		;[6012] Alignment FD address
LATBLK: BLOCK  7		;[6005] Argument block for LATOP%

;$TEXT utility used to store characters in a string

DEPBP:	IDPB	S1,TEXTBP	;DEPOSIT THE BYTE
	$RETT			;AND RETURN
TEXTBP:	BLOCK	1		;BYTE POINTER FOR DEPBP
	SUBTTL	Definitions -- Resident Job Database

STREAM:	BLOCK	1		;CURRENT STREAM NUMBER

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

JOBOBA:	BLOCK	NPRINT		;TABLE OF OBJECT BLOCK ADDRESSES

JOBSTW:	BLOCK	NPRINT		;JOB STATUS WORD

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

JOBOBJ:	BLOCK	NPRINT*OBJ.SQ	;[6001] List of setup objects

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

JOBCHK:	BLOCK	NPRINT		;STREAM CHECKPOINT INDICATOR
				;Contains the time for the next checkpoint
				;  or 0 if one is requested

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

JOBWAC:	BLOCK	NPRINT		;STREAM WTOR ACK CODE.

;**;[6051]At JOBWAC:+1L add 5 lines  JCR  11/29/89
JOBRFG: G$NEBF: BLOCK NPRINT	;[6051]Remote origins bit (MF.NEB)
JOBREM:	G$REMN: BLOCK NPRINT	;[6051]Remote node message originated from
JOBNUL: G$NULA:	BLOCK NPRINT	;[6051]Null ACK send flag
JOBPID:		BLOCK NPRINT	;[6051]PID of remote OPR
JOBARG:		BLOCK NPRINT	;[6051]Number of arguments in latest IPCF msg
;**;[6054]At JOBARG add 1 line JYCW 12/27/89
JOBCOM:	BLOCK	NPRINT		;[6054]LPTSPL command status word
RMJOBI:	ITEXT(<Job ^W/.EQJBB+JIB.JN(J)/ Req #^D/.EQJBB+JIB.ID(J)/ for ^T/.EQOWN(J)/^A>) ;[6044]
	SUBTTL	Initialization

;Here to start LPTSPL

LPTSPL:	RESET				;AS USUAL.
	MOVE	P,[IOWD PDSIZE,PDL]	;SET UP THE STACK.
	MOVEI	S1,IB.SZ		;GET THE IB SIZE.
	MOVEI	S2,IB			;ADDRESS OF THE IB.
	PUSHJ	P,I%INIT		;SET UP THE WORLD.

	PUSHJ	P,I%HOST		;[6012] Get the host name
	MOVEM	S1,CNTSTA		;[6012] Save it

	MOVX	S1,.MSIIC		;[6012] Get ignore str accounting bit
	MSTR				;[6012] We don't want to mount things
	ERJMP	.+1			;[6012] Ignore any error

	MOVX	S1,'SYSVER'		;[6012] Name of GETAB for system name
	SYSGT				;[6012] Get it
	MOVSI	T2,-LPCNFL		;[6012] and load loop counter
GETSYN:	HRRZ	S1,S2			;[6012] Get table number
	HRLI	S1,(T2)			;[6012] Get word,,table
	GETAB				;[6012] Get the entry
	  MOVEI	S1,0			;[6012] Use zero if losing
	MOVEM	S1,LPCNF(T2)		;[6012] Store the result
	AOBJN	T2,GETSYN		;[6012] Loop for all words

IFN FTDN60,<				;[6012]
	MOVEI	S1,SERFLG		;[6012] Get SYSERR flag
	PUSHJ P,D60INI##		;[6012] Init DN60 data base
> ; End of IFN FTDN60

	SETZM	FMOPN			;[6012] Clear LPFORM.INI open flag

	PUSHJ	P,INTINI		;SET UP THE INTERRUPT SYSTEM.
	PUSHJ	P,I%ION			;TURN ON INTERRUPTS.
	MOVEI	T1,HELLO		;GET ADDRESS OF HELLO MESSAGE.
	PUSHJ	P,SNDQSR		;SAY HI TO QUASAR.
	MOVSI	P1,-NPRINT		;SET UP STREAM COUNTER.

	;FALL THROUGH TO MAIN LOOP.
	SUBTTL	Idle Loop

MAIN:
IFN FTDN60,<
	SKIPE	J,JOBPAG(P1)		;Stream setup?
	$CALL	OPRCHK			;Yes - do DN60 operator output stuff
> ;End of IFN FTDN60
	SKIPN	JOBACT(P1)		;IS THE STREAM ACTIVE?
	JRST	MAIN.2			;NO,,GET THE NEXT STREAM.
	HRRZM	P1,STREAM		;RUNNABLE STREAM
	MOVE	J,JOBPAG(P1)		;YES, GET JOB PAGE
	PUSHJ	P,CHKTIM		;Adjust sleep time if needed
	$CALL	DSTATU			;Do any status stuff
	SKIPE	JOBSTW(P1)		;IS THE STREAM BLOCKED?
	JRST	MAIN.2			;YES,,GET THE NEXT STREAM.
	MOVEM	P1,SCHEDL		;SAVE THE SCHEDULING STREAM.
	MOVSI	0,J$RACS+1(J)		;Setup first source address for BLT
	HRRI	0,1			;Setup first destination address
	BLT	0,17			;GET SOME ACS
	POPJ	P,			;AND RETURN

MAIN.1:	MOVE	P1,SCHEDL		;GET THE LAST SCHEDULED STREAM.
	$CALL	DSTATU			;Do any status stuff
	PUSHJ	P,CHKTIM		;SET THE WAKEUP TIMER

MAIN.2:	AOBJN	P1,MAIN			;LOOP BACK FOR SOME MORE.
	PUSHJ	P,CHKQUE		;CHECK FOR INCOMMING MESSAGES.
	SKIPE	MESSAGE			;DID WE PROCESS A MESSAGE?
	JRST	MAIN.3			;YES,,CONTINUE PROCESSING
	MOVE	S1,SLEEPT		;NO,,PICK UP SLEEP TIME.
	JUMPE	S1,MAIN.3		;Don't sleep if 0 sleep specified
	SKIPG	S1			;Any time specified?
	SETZ	S1,			;No, set to sleep forever
	SKIPE	JOBACT			;CHECK IF STREAM ACTIVE..
	SKIPE	JOBSTW			;ANY BLOCKING CONDITIONS

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

MAIN.3:	MOVE	P,[IOWD PDSIZE,PDL]	;RESET THE STACK POINTER.
	SETOM	SLEEPT			;Start fresh
	MOVSI	P1,-NPRINT		;GET LOOP AC.
	JRST	MAIN			;KEEP ON PROCESSING.
	SUBTTL	Scheduler -- CHKTIM - Check Stream Wakeup Time

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

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

CHKTIM:	PUSHJ	P,I%NOW			;GET CURRENT TIME INTO S1
	MOVE	T1,STREAM		;Get our stream number
	MOVE	S2,JOBWKT(T1)		;Get wakeup time of job
	SETZM	TF			;Remember we are using the console
IFN FTDN60,<
	SKIPN	J$OMSG(J)		;Any console messages?
	JRST	CHKT.0			;No
	SKIPE	S2			;Any time set?
	CAML	S2,J$CWKT(J)		;Yes, console time sooner?
	SKIPN	J$CWKT(J)		;Yes, any console time set?
	JRST	CHKT.0			;No, don't use console time
	SETOM	TF			;Remember we used console time
	MOVE	S2,J$CWKT(J)		;Yes
> ;End of IFN FTDN60
CHKT.0:	JUMPE	S2,.RETF		;No time set, this is irrelevant
	SUB	S2,S1			;CALCULATE THE NUMBER
	IDIVI	S2,3			;   OF SECONDS TO WAKE-UP.
	JUMPLE	S2,CHKT.1		;IF TIME IS UP,,WAKE UP STREAM.
	CAILE	S2,^D60			;IF WAKE UP TIME IS GREATER THEN
	MOVEI	S2,^D60			;   60 SECS,, THEN MAKE IT 60 SECS.
	SKIPL	SLEEPT			;If -1 then none set - go set
	CAMGE	S2,SLEEPT		;IF WAKE UP TIME IS LESS THEN
	MOVEM	S2,SLEEPT		;CURRENT WAKE UP TIME,,THEN RESET IT.
	$RETF				;DO NOT WAKE UP THE JOB.
CHKT.1:	SETZM	SLEEPT			;No sleep time needed
	MOVX	S1,PSF%AL		;PICK UP ALIGN BLOCK BIT.
	MOVE	T1,STREAM		;Get stream number (Clobbered by IDIVI
					;  above)
	SKIPLE	J$LREM(J)		;IS THIS A DN60 LPT?
	TXO	S1,PSF%DO		;YES,,INCLUDE DEVICE OFFLINE
	ANDCAM	S1,JOBSTW(T1)		;TURN OFF STREAM WAIT STATE BIT.
IFN FTDN60<
	SKIPE	TF			;Did we have console time to get here?
	JRST	[SETZM	J$CWKT(J)	;Yes, clear it
		$RETT]			;And return
> ;End of FTDN60
	MOVE	T1,STREAM		;Get the stream number
	SETZM	JOBWKT(T1)		;Clear job wake time
	$RETT				;WAKE UP THE STREAM.
	SUBTTL	Scheduler -- DSCHD - Do Scheduler Pass

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

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

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

; ASSUMPTIONS. . .

; 1.  STREAM is assumed to be correct.

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

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

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

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

;Save the AC's in any case

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

	MOVE 	T1,STREAM		;Get the current stream number

	;Continued on next page
	;Continued from previous page

;Take care of the flags passed

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

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

;Check to see our current context

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

	;Continued on next page
	;Continued from previous page

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

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

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

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

	JRST	MAIN.3			;Return to restart main loop

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

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

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

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

FIXACT:	$SAVE	<S1>			;Save a register
	MOVE	S1,STREAM		;Get the stream #
	SETZM	JOBACT(S1)		;Make it inactive
	$RET				;Don't change anything
	SUBTTL	Job Processing -- DOJOB - Do the Job

DOJOB:	PUSHJ	P,FORMS			;GET FORMS MOUNTED
	JUMPF	ENDREQ			;CANT DO IT,,END THE REQUEST
;**;[6050]At DOJOB+2L add 2 lines  JYCW  5/8/89
	CALL	SETPRT			;[6050Set printer to a known state
	CALL	PORLAN			;[6050]See if we want Landscape or
					;[6050]portrait
	MOVN	S1,J$FWID(J)		;Pick up the form width value
	IMULI	S1,CHKWGT		;Multiply by weighting factor
	MOVEM	S1,J$WITH(J)		;Save value for later use
	MOVEM	S1,J$PRNT(J)		;Initialize the eol check counter
	$CALL	CHKALN			;Do an alignment if needed
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET INVALID ACCOUNT STRING BIT
	STORE	S1,S,ABORT		;SAVE IT AS THE ABORT BIT
	TXO	S,BANHDR		;LITE 'PRINTING BANNERS' FLAG
	PUSHJ	P,JOBHDR		;PRINT THE BANNER
	TXZ	S,BANHDR		;CLEAR 'PRINTING BANNERS' FLAG
	LOAD	E,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	E,J			;POINT TO FIRST FILE
	SETZM	J$RNFP(J)		;ZAP THE # OF FILES PRINTED
	TXO	S,INJOB			;We are in a job now
	SKIPN	.EQCHK+CKFLG(J)		;IS THIS A RESTARTED JOB?
	JRST	DOJO.4			;NO, SKIP ALL THIS STUFF
	MOVE	T1,.EQCHK+CKFIL(J)	;YES, GET NUMBER OF FILES DONE
	MOVEM	T1,J$RNFP(J)		;STORE FOR NEXT CHECKPOINT

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

DOJO.2:	MOVE	S1,.EQCHK+CKCOP(J)	;GET NUMBER OF COPIES PRINTED
	MOVEM	S1,J$RNCP(J)		;SAVE FOR NEXT CHECKPOINT
	ADDM	S1,J$AFXC(J)		;ADD TO THE TOTAL FILE COUNT
	MOVE	S1,.EQCHK+CKTPP(J)	;GET THE TOTAL PAGES PRINTED.
	SUBI	S1,5			;MAKE SURE WE DONT SCREW THINGS UP
	SKIPGE	S1			;ALSO MAKE SURE WE ARE NOT NEGATIVE
	SETZM	S1			;YES,,MAKE IT 0
	MOVEM	S1,J$APRT(J)		;AND SAVE IT
	MOVE	S1,.EQCHK+CKPAG(J)	;GET CHKPNT'ED PAGE
	SUBI	S1,5			;MAKE SURE WE DONT MISS ANYTHING
	SKIPGE	S1			;ALSO MAKE SURE WE ARE NOT NEGATIVE
	SETZM	S1			;YES,,MAKE IT 0
	TXZE	S,BCKFIL		;WERE WE BACKSPACED DURING HEADERS?
	TXZ	S,SKPFIL		;YES,,CLEAR THE SKIP FILE BIT
	SKIPA				;Never use the /START param that follows

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

DOJO.4:	LOAD	S1,.FPFST(E)		;GET /START PARAMETER
	MOVEM	S1,J$FPIG(J)		;SAVE FOR FIRST COPY
	PUSHJ	P,FILE			;NO, PRINT THE FILE
	TXNE	S,RQB			;HAVE WE BEEN REQUEUED?
	JRST	ENDJOB			;YES, END NOW
	AOS	J$RNFP(J)		;BUMP THE FILE COUNT BY 1.
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBCHK(S1)		;Want a checkpoint soon
	TXZE	S,BCKFIL		;BACKSPACING A FILE?
	JRST	DOJO.4			;YES
	PUSHJ	P,NXTFIL		;BUMP TO NEXT FILE
	JUMPT	DOJO.4			;AND LOOP

DOJO.7:	SKIPN	E,J$RLFS(J)		;GET ADR OF LOG-SPEC
	JRST	ENDJOB			;NO, FINISH JOB
	MOVE	S1,J$APRT(J)		;GET NUMBER OF PAGES PRINTED
	ADDI	S1,LOGPAG		;ADD IN GUARANTEED LOG LIMIT
	CAMLE	S1,J$RLIM(J)		;DOES HE HAVE AT LEAST THAT MANY?
	MOVEM	S1,J$RLIM(J)		;NO, GIVE HIM THAT MANY
	TXZ	S,ABORT			;CLEAR ABORT FLAG
	PUSHJ	P,FILE			;PRINT THE FILE
	JRST	ENDJOB			;AND FINISH UP
	SUBTTL	Job Processing -- NXTFIL - Find And Return The Next File 

NXTFIL:	SETZM	J$RNCP(J)		;CLEAR COPIES PRINTED
	SOSG	J$RFLN(J)		;DECREMENT FILE COUNT
	$RETF				;NO MORE, DONE
	MOVE	S1,J$WITH(J)		;[3131]Get the EOL counter value
	MOVEM	S1,J$PRNT(J)		;[3131]Reset the EOL counter
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	E,S1			;BUMP TO THE FD
	LOAD	S1,.FDLEN(E),FD.LEN	;GET THE FD LENGTH
	ADD	E,S1			;BUMP TO THE NEXT FP
	TXNE	S,CLUSPL!DQSSPL		;[6007] Cluster or DQS?
	$RETT				;[6000]YES, DON'T CARE ABOUT LOG FILES
	LOAD	S1,.FPINF(E),FP.FLG	;[6007] Get log file flag
	JUMPE	S1,.RETT		;RETURN IF NOT THE LOG FILE

	MOVEM	E,J$RLFS(J)		;SAVE ADDRESS OF LOG FILE SPEC
	JRST	NXTFIL			;AND LOOP
	SUBTTL	Job Processing -- FILDIS - Keep or Delete Printed Files

FILDIS:	LOAD	E,.EQLEN(J),EQ.LOH	;GET THE HEADER LENGTH.
	ADD	E,J			;POINT TO FIRST FILE .
	LOAD	T1,.EQSPC(J),EQ.NUM	;GET THE NUMBER OF FILES.
FILD.1:	MOVE	T2,.FPINF(E)		;GET THE FILE INFO BITS.
	LOAD	S2,.FPLEN(E),FP.LEN	;GET THE FILE INFO LENGTH.
	ADD	E,S2			;POINT TO FILE SPEC.
	MOVEM	E,J$XFOB+FOB.FD(J)	;SAVE THE FD ADDRESS IN THE FOB
	LOAD	S2,.FDLEN(E),FD.LEN	;[6000]GET THE FD LENGTH.
	ADD	E,S2			;POINT 'E' AT NEXT FILE.
	SETZM	J$XFOB+FOB.US(J)	;DEFAULT TO NO ACCESS CHECKING
	SETZM	J$XFOB+FOB.CD(J)	;HERE ALSO
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET THE USERS PRIVILGE BITS
	JUMPN	S1,FILD.2		;IF SET, AVOID ACCESS CHECK
	TXNE	T2,FP.SPL		;WAS IT A SPOOLED FILE?
	JRST	FILD.2			;YES,,THEN NO ACCESS CHECK

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

FILD.2:	MOVEI	S1,FOB.SZ		;GET THE FOB LENGTH
	MOVEI	S2,J$XFOB(J)		;AND THE FOB ADDRESS
	$CALL	DETDEL			;[6000]DETERMINE IF FILE IS TO BE DELETED
	SKIPF				;[6000]IF FALSE, DO NOT DELETE
	$CALL	F%DEL			;[6000]DELETE THE FILE
	SOJG	T1,FILD.1		;[6000]GO PROCESS THE NEXT FILE.
	$RETT				;RETURN.
	SUBTTL	Job Processing -- DETDEL - Determine Is A File Is To Be Deleted

;DETDEL is called during the creation of a RELEASE message.
;DETDEL determines if a file in the print request is to be deleted or not.
;
;Call is:       T2/File's FP information word (.FPINF)
;Returns true:  The file should be deleted
;Returns false: The file is not to be deleted

DETDEL:	TXNE	T2,FP.SPL		;[6000]IS THIS A SPOOLED FILE?
	$RETT				;[6000]YES, INDICATE DELETE
	TXNE	S,ABORT			;[6000]IN AN ABORT STATE?
	$RETF				;[6000]YES, INDICATE DO NOT DELETE
	TXNN	T2,FP.DEL		;[6000]USER SPECIFIED DELETE?
	$RETF				;[6000]NO, INDICATE DO NOT DELETE
	$RETT				;[6000]INDICATE DELETE
	SUBTTL	Job Processing -- FILE - Print a File

FILE:	TXNE	S,ABORT			;ARE WE IN TROUBLE?
	$RET				;YES,,JUST RETURN.
	$CALL	LIMCHK			;Are we over limit?
	$RETIF				;Yes, just return
	$CALL	INPOPN			;[6007] Open the input file up
	JUMPF	.POPJ			;LOSE, RETURN
	MOVE	S1,J$DFDA(J)		;GET FD ADDRESS
	$CALL	LSTAF			;[6007] Starting file mumble

FILE.1:	PUSHJ	P,INPREW		;REWIND THE INPUT FILE
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBCHK(S1)		;Want a checkpoint
	$CALL	DSTATU			;Do the status
	PUSHJ	P,SETLST		;SETUP /REPORT CODE IF NECESSARY
	TXZ	S,FORWRD		;CLEAR FORWARD SPACE BIT
	TXO	S,BANHDR		;LITE 'PRINTING HEADERS' FLAG
	PUSHJ	P,HEAD			;PRINT THE HEADER
	TXZ	S,BANHDR		;CLEAR 'PRINTING HEADERS' FLAG
	MOVEI	S1,LPTERR		;GET NUMBER OF DEVICE ERRORS ALLOWED
	MOVEM	S1,J$LERR(J)		;AND SAVE IT
	SOSLE	J$FPIG(J)		;SUBTRACT 1 PAGE FROM STARTING PAGE #.
	JRST	[TXO	S,FORWRD	;STILL POS,,TURN ON FORWARD BIT.
		 MOVE	S1,J$FPIG(J)	;SAVE FORWARD SPACE PAGES
		 JRST	.+1]		;AND CONTINUE
	TXNE	S,ABORT!SKPFIL!RQB	;DO WE REALLY WANT TO DO THIS?
	JRST	FILE.2			;NO,,CLEAN UP THE MESS.
	PUSHJ	P,FILOUT		;PRINT THE FILE
	TXNE	S,ABORT!SKPFIL!RQB	;ABORTED OR SKIPPED OR REQUEUED?
	JRST	FILE.2			;YES, CONTINUE ON
	LOAD	T1,.FPFST(E)		;GET /START PARAMETER.
	MOVEM	T1,J$FPIG(J)		;SAVE STARTING POINT FOR THIS COPY.
	AOS	S1,J$RNCP(J)		;INCREMENT AND LOAD COPIES WORD
	AOS	J$AFXC(J)		;ADD 1 TO THE TOTAL FILE COUNT
	LOAD	S2,.FPINF(E),FP.FCY	;GET TOTAL NUMBER TO PRINT
	CAML	S1,S2			;PRINTED ENOUGH?
	JRST	FILE.2			;Yes, go finish
	$CALL	LIMCHK			;Check to see if over limit
	JUMPT	FILE.1			;If not, loop

FILE.2:	$CALL	INPCLS			;[6007] Close input file
	$CALL	LFINF			;[6007] Finished file
	MOVE	S1,J$DFDA(J)		;GET FD ADDRESS
	TXNE	S,SUPFIL		;Are we suppressing forms/file?
	SETZM	J$XTOP(J)		;Yes, set we are not at top of page.
	TXZ	S,SKPFIL+SUPFIL		;CLEAR LOTS OF BITS
	POPJ	P,			;AND RETURN
	SUBTTL	Job Processing -- ENDJOB - End Of Job Processor

ENDJOB:	TXO	S,GOODBY		;FLAG EOJ SEQUENCE
	TXZ	S,FORWRD		;TURN OFF THE FORWARD SPACING BIT.
	MOVEI	S1,[ASCIZ/ Pages of output/] ;[6012] Assume local spooler
	TXNE	S,DQSSPL		;[6003] If DQS
	MOVEI	S1,[ASCIZ/ Bytes transmitted/] ;[6012] then it is bytes
	$TEXT	(LOGCHR,<^I/LPEND/Summary:^D8/J$APRT(J)/^T/(S1)/>) ;[6012]
	$TEXT	(LOGCHR,<^I/LPEND/        ^D8/J$ADRD(J)/ Disk pages read>) ;[6001] 
	MOVX	S1,.FHSLF		;LOAD FORK HANDLE
	RUNTM				;GET RUNTIME
	ADD	S1,J$ARTM(J)		;GET CPU TIME USED
	IDIVI	S1,^D1000		;CONVERT TO SECONDS
	$TEXT	(LOGCHR,<^I/LPEND/      ^D6R /S1/.^D3L0/S2/ Seconds CPU time used>) ;[6001] 
	TXNE	S,DQSSPL		;[6001] DQS Spooling?
	JRST	DQSLOG			;[6001] Print log file

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

;  Call the IBMCOM stats routine if needed.

IFN FTIBMS,<
	SKIPLE	J$LREM(J)		;Is it IBMCOM job?
	JRST	[MOVEI	S1,%TOUT	;Yes, get the STAT code
		$CALL	IBMSTS		;Send it off
		JRST	ENDREQ]		;Continue on
> ; End of FTIBMS

ENDREQ:	PUSHJ	P,QRELEA		;GO SEND THE RELEASE/REQUEUE MSG.
	MOVX	S1,LPTTYP		;[6003]PICK UP LPT TYPE MASK
	ANDM	S1,J$RACS+S(J)		;[6003]RESET THE STATUS
	MOVE	S1,STREAM		;GET STREAM NUMBER
	SETZM	JOBACT(S1)		;NOT BUSY
	JRST	MAIN.3			;RETURN TO THE SCHEDULER.
	SUBTTL	Job Processing -- QRELEA - Send A Requeue/Release Message

;Here to send a release or requeue message to QUASAR.  If RQB is set then we
;want to requeue.  If ABORT is also set then we want to hold the job.

QRELEA:	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At QRELEA:+2L change 4 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QWTOJ(End,<^I/RMJOBI/>,@JOBOBA(S1),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Tell the operator.
	ELSE.				;[6051]
	  $QWTOJ(End,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Tell the operator.
	ENDIF.				;[6044]
	SKIPLE	J$LREM(J)		;[6000]SKIP LOGGING IF NOT A DN60
	$LOG	(Printed ^D/J$APRT(J)/ Pages,,@JOBOBA(S1)) ;LOG # OF PAGES
	MOVEI	S1,MSBSIZ		;GET BLOCK LENGTH
	MOVEI	S2,MSGBLK		;AND THE ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO THE BLOCK
	TXNE	S,LATSPL		;[6005]LAT spool?
	$CALL	LATTHC			;[6005]Yes, terminate the connection
	TXNE	S,RQB			;IS THIS A REQUEUE?
	JRST	RELE.4			;[6000]YES, GO BUILD THE MESSAGE
	TXNE	S,CLUSPL		;[6003]IS THIS A CLUSTER LPTSPL?
	JRST	RELE.3			;[6003]YES, SO SKIP THIS

;Here if Cluster LPTSPL to clean up files and create release message

	SKIPL	J$REMR(J)		;[6000]DID REQUEST ORIGINATE REMOTELY?
	JRST	RELE.2			;[6000]NO, GO CLEAN UP SPOOL FILES
	$CALL	REMREL			;[6000]YES, CLEANUP/CREATE RELEASE MSG
	JRST	RELE.6			;[6000]GO RETURN

;[6001] Here if not Cluster LPTSPL, request has gone fine, clean up and account

RELE.2:	PUSHJ	P,FILDIS		;GO CLEAN UP THE SPOOL FILES.
	PUSHJ	P,ACTEND		;GO DO THE ACCOUNTING
RELE.3:	MOVEI	T1,MSGBLK		;[6003]GET ADDRESS OF THE BLOCK
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REL.IT(T1)		;STORE IT
	MOVX	S1,REL.SZ		;NO, GET RELEASE MESSAGE SIZE
	MOVX	S2,.QOREL		;AND FUNCTION
	JRST	RELE.5			;[6000]AND MEET AT THE PASS
;[6007] Here to requeue the job, set the hold bit if the ABORT bit in S is on.

RELE.4:	MOVEI	T1,MSGBLK		;GET ADDRESS OF THE BLOCK
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REQ.IT(T1)		;STORE IT
	LOAD	S1,J$RNFP(J)		;GET NUMBER OF FILES PRINTED
	STORE	S1,REQ.IN+CKFIL(T1)	;STORE IT
	LOAD	S1,J$RNCP(J)		;GET COPIES PRINTED
	STORE	S1,REQ.IN+CKCOP(T1)	;STORE IT
	LOAD	S1,J$RNPP(J)		;GET PAGES PRINTED
	STORE	S1,REQ.IN+CKPAG(T1)	;AND STORE IT
	LOAD	S1,J$APRT(J)		;GET TOTAL PAGES PRINTED.
	STORE	S1,REQ.IN+CKTPP(T1)	;STORE IT
	MOVX	S1,CKFREQ		;GET REQEUE BIT
	STORE	S1,REQ.IN+CKFLG(T1)	;STORE IT

	TXNN	S,ABORT			;[6007] Aborting as well as requeue?
	SKIPA	S1,[FLD(5,RQ.TIM)]	;[6007] No, requeue after 5 minutes
	MOVX	S1,RQ.HBO		;GET HOLD BY OPERATOR
	MOVEM	S1,REQ.FL(T1)		;[6007] Store in flag word
	MOVX	S1,REQ.SZ		;GET SIZE
	MOVX	S2,.QOREQ		;AND FUNCTION

;Message is all prepared, S1/ size, S2/ function, send it to QUASAR

RELE.5:	STORE	S1,.MSTYP(T1),MS.CNT	;[6000]STORE SIZE
	STORE	S2,.MSTYP(T1),MS.TYP	;AND CODE
	PUSHJ	P,SNDQSR		;SEND IT TO QUASAR
RELE.6:	$RETT				;AND RETURN.
	SUBTTL	IPCF Interface -- CHKQUE - Receive and Schedule IPCF Messages

CHKQUE:	SETZM	MESSAG			;NO MESSAGE YET
	PUSHJ	P,C%RECV		;RECEIVE A MESSAGE
	JUMPF	.POPJ			;RETURN,,NOTHING THERE.
	SETOM	IMESS			;Have a message
	SETZM	BLKADR			;CLEAR THE IPCF MSG BLK ADDR SAVE AREA
	LOAD	S2,MDB.SI(S1)		;GET SPECIAL INDEX WORD
	TXNN	S2,SI.FLG		;IS THERE AN INDEX THERE?
	JRST	CHKQ.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
;**;[6051]At CHKQUE:+13L replace 1 line with 3 lines  JCR  11/29/89
	SKIPE	JOBNUL			;[6051]Need to send a Null ACK?
	$NUL	(JOBPID)		;[6051]Yes, send a Null ACK to ORION
	LOAD	M,MDB.MS(S1),MD.ADR	;[6051]Get the message address
	MOVEM	M,MESSAG		;SAVE IT AWAY
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	MOVSI	S1,-NMSGT		;MAKE AOBJN POINTER FOR MSG TYPES
CHKQ.3:	HRRZ	T1,MSGTAB(S1)		;GET A MESSAGE TYPE
	CAMN	S2,T1			;MATCH?
	JRST	CHKQ.4			;YES, WIN
	AOBJN	S1,CHKQ.3		;NO, LOOP
	JRST	CHKQ.5			;Go to release the message
CHKQ.4:	HLRZ	T2,MSGTAB(S1)		;PICK UP THE PROCESSING ROUTINE ADDRESS.
	MOVEM	T2,RUTINE		;SAVE THE ROUTINE ADDRESS.
;**;[6051]At CHKQ.4:+2L replace 2 lines with 6 lines
	MOVE	T2,.OARGC(M)		;[6051]Pick up number of argument blocks
	MOVEM	T2,JOBARG		;[6051]Save for FNDBLK
	$CALL	CHKOBJ			;[6051]Go find the object block
	JUMPF	CHKQ.5			;[6051]Not there, just delete it
	MOVE	S1,.MSCOD(M)		;[6051]Pick up the PID of the sender
	MOVEM	S1,JOBPID		;[6051]Save for any $Qxxx
	PUSHJ	P,@RUTINE		;DISPATCH THE MESSAGE PROCESSOR.
	SKIPN	JOBITS			;DO WE WANT TO SAVE THE STATUS BITS?
	MOVEM	S,J$RACS+S(J)		;YES,,SAVE THE STATUS BITS.
	SETZM	JOBITS			;CLEAR THE FLAG (DEFAULT TO ALWAYS SAVE)
CHKQ.5:	SKIPE	IMESS			;Any IPCF messages?
	$CALL	C%REL			;Yes, release it
	SETZM	IMESS			;Remember we have released it
	POPJ	P,			;RETURN TO THE SCHEDULER.

MSGTAB:	XWD	KILL,.QOABO		;CANCEL MESSAGE
	XWD	DSTATU,.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 ABORT REQUEST.
	XWD	OACPAU,.OMPAU		;OPERATOR 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	IPCF Interface -- CHKOBJ - Validate Object Block

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


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

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

CHKO.2:	PUSHJ	P,FNDOBJ		;GO FIND THE OBJECT BLOCK.
;**;[6051]At CHKO.2:+1L replace 2 lines with 14 lines  JCR  11/29/89
	JUMPF	.POPJ			;[6051]Not there, that's an error
	SETZM	JOBRFG			;[6051]Assume message originated locally
	MOVX	S1,MF.NEB		;[6051]Pick up the remote origin bit
	TDNN	S1,.MSFLG(M)		;[6051]Is it set?
	$RET				;[6051]No, nothing more to do
;**;[6053]At CHKO.2:+7L replace 5 lines with 10 lines  JCR  12/16/89
	LOAD	S1,.MSTYP(M),MS.TYP	;[6053]Pick up the message type
	CAIE	S1,.QOABO		;[6053]Is it a remote operator cancel?
	JRST	CHKO.3			;[6053]No, look for the node block
	MOVE	S1,ABO.ND(M)		;[6053]Pick up the remote node name
	JRST	CHKO.4			;[6053]Place in the stream data base
CHKO.3:	MOVEI	S1,.NDENM		;[6053]Pick up the block type
	$CALL	FNDBLK			;[6053]Find the remote node block
	JUMPF	.POPJ			;[6053]Quit on an error
	MOVE	S1,0(S1)		;[6053]Pick up the node name
CHKO.4:	MOVEM	S1,JOBREM		;[6053]Store the node name
	SETOM	JOBRFG			;[6051]Indicate remote for $Qxxx
	SETOM	JOBNUL			;[6051]Need to send a Null ACK
	$RET				;[6051]Return


MSGOBJ:	MOVEI	S1,ABO.TY(M)		;GET ABORT MSG OBJ ADDRESS.
	MOVEI	S1,RCK.TY(M)		;GET CHECKPOINT MSG OBJ ADDRESS.
	MOVEI	S1,.EQROB(M)		;GET NEXTJOB MSG OBJ ADDRESS.
	SUBTTL	IPCF Interface -- GETBLK - Break Down An IPCF Message

	;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

;**;[6051]At GETBLK:+10L add routine FNDBLK  JCR  11/29/89
	SUBTTL	FNDBLK - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE

;[6051]FNDBLK is called to find a specified block in an IPCF message.
;[6051]Call is:       M/The message address
;[6051]	             S1/The block type of the block to be found
;[6051]Returns true:  S1/The address of the block's data field
;[6051]Returns false: The block is not in the message

FNDBLK:	$SAVE	<P1,P2>			;[6051]Save these AC
	MOVE	P1,JOBARG		;[6051]Get the message argument count
	MOVE	P2,S1			;[6051]Save the block type
	MOVEI	S1,.OHDRS(M)		;[6051]Point to the first block
	LOAD	TF,.MSTYP(M),MS.CNT	;[6051]Get the message length
	ADD	TF,M			;[6051]Point to the end of the message

FNDB.1:	LOAD	S2,ARG.HD(S1),AR.TYP	;[6051]Get this block type
	CAMN	S2,P2			;[6051]Is this the block?
	JRST	FNDB.2			;[6051]Yes, return with block address
	LOAD	S2,ARG.HD(S1),AR.LEN	;[6051]No, get this block's length
	ADD	S1,S2			;[6051]Address of the next block
	CAIG	TF,0(S1)		;[6051]Still within the message?
	$RETF				;[6051]No, return block not found
	SOJG	P1,FNDB.1		;[6051]Check the next block
	$RETF				;[6051]Block not found

FNDB.2:	MOVEI	S1,ARG.DA(S1)		;[6051]Point to the data field
	$RETT				;[6051]And return
	SUBTTL	IPCF Interface -- FORFOR - Force Forms Change

; 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

;**;[6051]At FORFOR:+0L replace 7 lines with 1 line  JCR  11/29/89
FORFOR:	MOVE	S1,.OFLAG(M)		;[6051]Get the forms type
	MOVEM	S1,.EQLIM(J)		;Save it where NXTJOB does
	MOVE	S1,STREAM		;Get the stream number
	SETOM 	JOBACT(S1)		;Set the stream active
;**;[6054]At FORFOR+4L add 1 line JYCW 12/27/89
	SETOM	JOBCOM(S1)		;[6054]Doing forms change command
	MOVX	S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL+PSF%OO
					;Get a bunch of bits
	ANDCAM	S2,JOBSTW(S1)		;And clear them
;**;[6047]AT FORFO2:+5L Delete 4 lines JYCW Feb-23-89
	$CALL	TBFINI			;Init the buffer
	$CALL	CHKLPT			;Check for online

;**;[6047]AT FORFO2:+7L Delete 1 line JYCW Feb-23-89
;Since TOPS-20 LPTSPL is a single stream process we can fall down to
;DOFFOR to do the forms change right now instead of from the scheduler.
	SUBTTL	IPCF Interface -- DOFFOR - Operator Set Forms

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

DOFFOR:	TXNE	S,LATSPL		;[6042]LAT PRINTER
	$CALL	LATGET			;[6042]Yes, get a LAT connection
	JUMPF	DOFFO1			;[6042]No connection, skip match forms
	$CALL	FORMS			;Try to set the forms

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

DOFFO1:	MOVE	S1,STREAM		;[6042]Get the stream number
	SETOM	JOBUPD(S1)		;Say we want an update message
	SETZM	JOBSTW(S1)		;Say we want reset message
					;  defaults since no bits set
;**;[6054]At DOFFO1+3L add 1 line JYCW 12/27/89
	SETZM	JOBCOM(S1)		;[6054]No longer doing forms change
	$CALL	DSTATU			;Tell QUASAR we are done

	SKIPG	J$LCHN(J)		;[6001] Open device?
	SETZM	J$RACS+S(J)		;[6001] No, clear status bits
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBACT(S1)		;No longer active
	TXNE	S,LATSPL		;[6042]LAT printer?
	$CALL	LATTHC			;[6042]Yes, release the connect
;**;[6047]At DOFFO1:+10L Replace 1 line JYCW Feb-23-89
	$RET				;[6047]Return
	SUBTTL	IPCF Interface -- KILL - User (or operator) CANCEL Request

KILL:	TXNE	S,GOODBY+ABORT		;CHECK SOME BITS
	$RETT				;IF WE LEAVING, IGNORE IT ANYWAY
	TXO	S,ABORT			;[6000]LITE THE ABORT BIT
	MOVE	S1,STREAM		;[6000]GET THE STREAM NUMBER
	MOVX	S2,PSF%OR+PSF%OO	;[6000]GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;[6000]ARE WE WAITING FOR THE OPERATOR?
;**;[6053]At KILL:+6L change 1 line  JCR  12/16/89
	$QKWTO	(JOBWAC(S1))		;[6053]Yes, kill the WTOR
	ANDCAM	S2,JOBSTW(S1)		;[6000]ZAP THE OPR WAIT BIT
	SKIPL	J$OPRA(J)		;[6000]Canceled bacause of no eol
	IFSKP.				;[6044]
	  SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
	  IFSKP.			;[6044]
;**;[6051]At KILL:+11L change 3 lines  JCR  11/29/89
	    $QWTOJ(<Canceled by User OPERATOR>,<^I/RMJOBI/>,@JOBOBA(S1),<$WTACK(JOBPID)>);[6051]
	  ELSE.				;[6051]
	    $QWTOJ(<Canceled by User OPERATOR>,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(JOBPID)>);[6051]
	  ENDIF.			;[6044]
	ELSE.				;[6044]
	  SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
	  IFSKP.			;[6044]
	    MOVE S2,ABO.CD(M)		;[6045]PICK UP WHO CANCELLED THIS JOB
	    CAIE S2,ABORMU		;[6045]A REMOTE USER?
	    IFSKP.			;[6045]
	      $WTOJ(<Canceled by User ^T/ABO.RU(M)/ from node ^N/ABO.ND(M)/>,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6045]
	    ELSE.			;[6045]
;**;[6053]At KILL:+25L change 4 lines  JCR  12/16/89
	      $QWTOJ(<Canceled by User ^U/ABO.ID(M)/>,<^I/RMJOBI/>,@JOBOBA(S1),<$WTACK(JOBPID)>) ;[6053]
	    ENDIF.			;[6053]
	  ELSE.				;[6053]
	    $QWTOJ(<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(JOBPID)>) ;[6053]
	  ENDIF.			;[6044]
	ENDIF.				;[6044]
	TXNE	S,CLUSPL		;[6007] Cluster LPTSPL?
	$RETT				;[6007] Yes, return to the caller
	SKIPL	J$OPRA(J)		;[6007] Canceled because of no eol
	IFSKP.				;[6045]
	  $TEXT(LOGCHR,<^I/LPMSG/Job canceled by user OPERATOR>) ;[6045]
	ELSE.				;[6045]
	  MOVE S2,ABO.CD(M)		;[6045]PICK UP WHO CANCELLED THIS JOB
	  CAIE S2,ABORMU		;[6045]A REMOTE USER?
	  IFSKP.			;[6045]
	    $TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^T/ABO.RU(M)/ from node ^N/ABO.ND(M)/>) 
	  ELSE.				;[6045]
	    $TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^U/ABO.ID(M)/>) 
	  ENDIF.			;[6045]
	ENDIF.				;[6045]
	SETZM	J$OPRA(J)		;Reset the indicator
	PUSHJ	P,INPFEF		;FORCE END OF FILE
	TXNN	S,DQSSPL		;[6007] If DQS then return
	TXNE	S,BANHDR		;ARE WE PRINTING BANNER/HEADER PAGES?
	$RETT				;YES,,JUST RETURN
	TXNE	S,LATSPL!TTYSPL		;[6025]LAT LPTSPL?
	$RETT				;[6025]Yes,, just return
	PUSHJ	P,OUTFLS		;NO,,FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN
	$RETT				;RETURN
	SUBTTL	IPCF Interface -- QSRNWA - Shutdown stream whose node dropped

QSRNWA:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR?
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	$CALL	INPCLS			;[6007] Close input file if any
	MOVX	S1,%RSUNA		;GET NOT AVAILABLE RIGHT NOW BITS
	PUSHJ	P,RSETUP		;TELL QUASAR HE CAN HAVE THE OBJ BACK
	PUSHJ	P,SHUTND		;SHUT THE STREAM DOWN
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- DSTATU - Send status info

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

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

UPDATE is called based on JOBUPD.

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

THIS IS THE ONLY ROUTINE THAT SHOULD CALL UPDATE OR CHKPNT

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

\	;End of comment

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

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

	TXNN	S,CLUSPL		;[6001] Return if cluster LPTSPL
	SKIPN	JOBACT(P1)		;Nothing to checkpoint if not active
	$RET

;See if it is time to checkpoint yet.

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

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

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

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

	MOVEI	S1,CHE.ST(T1)		;GET ADDRESS OF STATUS AREA
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,TEXTBP		;SAVE BYTE POINTER
	TXNN	S,DQSSPL		;[6001] Skip if DQS
	$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
	TXNE	S,DQSSPL		;Skip if not DQS
	$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, transmitted ^D/J$APRT(J)/ bytes, ^D/J$RNFP(J)/ files^0>) ;[6001]
	HRRZ	S1,TEXTBP		;GET THE BYTE POINTER
	SUBI	S1,MSGBLK-1		;SUBTRACT START POINT
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE THE LENGTH
	MOVX	S1,.QOCHE		;GET THE FUNCTION CODE
	STORE	S1,.MSTYP(T1),MS.TYP
	PJRST	SNDQSR			;AND SEND IT
	SUBTTL	IPCF Interface -- UPDATE - Send Status Updates

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

UPDATE:	MOVE	S2,JOBPAG(P1)		;Get the jobpage
	SKIPE	J$OFLN(S2)		;DN60 offline?
	JRST	[MOVX	S1,%OFLNE	;Yes, set offline
		JRST	UPDA.5]		;Go to send status
	MOVE	S2,JOBSTW(P1)		;GET THE JOBS STATUS WORD
	MOVX	S1,%RESET		;DEFAULT TO RESET
	SKIPE	J$APRG(J)		;ARE WE ALIGNING FORMS?
	MOVX	S1,%ALIGN		;YES,,SAY SO
	TXNE	S2,PSF%OR		;ARE WE WAITING FOR OPR RESPONSE?
	MOVX	S1,%OREWT		;YES,,SAY SO
	TXNE	S2,PSF%ST		;ARE WE STOPPED?
	MOVX	S1,%STOPD		;YES,,SAY SO
	TXNE	S2,PSF%DO		;ARE WE OFFLINE?
	MOVX	S1,%OFLNE		;YES,,SAY SO
	TXNE	S2,PSF%OO		;ARE WE WAITING FOR OPERATOR OUTPUT?
	MOVX	S1,%OPRWT		;YES,,SAY SO
UPDA.5:	MOVEI	T1,MSGBLK		;GET THE MESSAGE BLOCK ADDRESS
	MOVEM	S1,STU.CD(T1)		;SAVE THE STATUS
	HRLZ	S1,JOBOBA(P1)		;GET THE OBJECT BLOCK ADDRESS
	HRRI	S1,STU.RB(T1)		;GET DESTINATION ADDRESS
	BLT	S1,STU.RB+OBJ.SQ-1(T1)	;[6002] Copy the obj blk to the msg
	MOVX	S1,STU.SZ		;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE IT
	MOVX	S1,.QOSTU		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(T1),MS.TYP	;SAVE IT
	PUSHJ	P,SNDQSR		;SEND IT OFF TH QUASAR
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- NXTJOB - Nextjob Message

NXTJOB:	HRR	S1,J			;GET 0,,DEST
	HRL	S1,M			;GET SOURCE,,DEST
	LOAD	S2,.MSTYP(M),MS.CNT	;GET LENGTH OF MESSAGE
	ADDI	S2,-1(J)		;GET ADR OF END OF BLT
	BLT	S1,(S2)			;BLT THE DATA
	MOVE	S1,STREAM		;GET STREAM NUMBER
	SETOM	JOBACT(S1)		;MAKE THE STREAM ACTIVE
	SETZM	JOBCHK(S1)		;CHECKPOINT FIRST CHANCE WE GET
	SETOM	JOBUPD(S1)		;Send update also.
	SETZM	J$REMR(J)		;[6000]ASSUME REQUEST ORIGINATED LOCALLY
	LOAD	S1,.EQSEQ(J),EQ.RLT	;[6000]PICK UP PRINT JOB ORIGIN
	SKIPE	S1			;[6000]DID THE REQUEST ORIGINATE LOCALLY?
	SETOM	J$REMR(J)		;[6000]NO, INDICATE SO
	MOVX	S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL+PSF%OO ;GET LOTS OF BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR THEM
	MOVEI	S1,J$RPDL-1(J)		;POINT TO CONTEXT PDL
	HRLI	S1,-PDSIZE		;AND THE LENGTH
	MOVEI	S2,DOJOB		;[6001] Assume local job
	TXNE	S,CLUSPL		;[6001] Cluster spooler?
	MOVEI	S2,CLJOB		;[6001] Yes
	TXNE	S,DQSSPL		;[6001] DQS spooler?
	MOVEI	S2,DQSJOB		;[6001] Point to DQS place
	PUSH	S1,S2			;[6001] Store new stream starting place
	MOVEM	S1,J$RACS+P(J)		;AND STORE THE PDL
	LOAD	S1,.EQSPC(J),EQ.NUM	;GET NUMBER OF FILES
	MOVEM	S1,J$RFLN(J)		;STORE IT
	MOVEI	S1,J$$BEG(J)		;PREPARE TO ZERO SELECTED WORDS JOB AREA
	MOVSI	S2,-<J$$LEN+^D35>/^D36	;AOBJN POINTER TO BIT TABLE
NXTJ.2:	MOVEI	T1,^D36			;BIT COUNTER FOR THIS WORD
	MOVE	T2,ZTABLE(S2)		;GET A WORD FROM BIT TABLE
NXTJ.3:	JUMPE	T2,NXTJ.4		;DONE IF REST OF WORD IS ZERO
	JFFO	T2,.+1			;FIND THE FIRST 1 BIT
	ADD	S1,T3			;MOVE UP TO THE CORRESPONDING WORD
	SETZM	0(S1)			;AND ZERO IT
	SUB	T1,T3			;REDUCE BITS LEFT IN THIS WORD
	LSH	T2,0(T3)		;SHIFT OFFENDING BIT TO BIT 0
	TLZ	T2,(1B0)		;AND GET RID OF IT
	JRST	NXTJ.3			;AND LOOP
NXTJ.4:	ADD	S1,T1			;ACCOUNT FOR THE REST OF THE WORD
	AOBJN	S2,NXTJ.2		;AND LOOP
	TXNE	S,CLUSPL		;[6001] Cluster LPTSPL?
	PJRST	FIXCLU			;[6000] Yes, fixup some
	TXNE	S,DQSSPL		;[6001] DQS Printer?
	$CALL	DQSFIX			;[6001] Yes, perform NXTJOB functions
	TXNN	S,LATSPL		;[6005] LAT printer?
	JRST	NXTJ.5			;[6016] No
	$CALL	LATGET			;[6005] Have to reconnect the LAT line
	JUMPT	NXTJ.5			;[6023] Connect and setup successful
	PUSHJ	P,RSETUP		;[6023] Release the object
	PUSHJ	P,SHUTIN		;[6030] Shut the stream down
	$RETT				;[6023] And return
	
	;Continued on next page
	;Continued from previous page

;[6001] Fill in the log

NXTJ.5:	$TEXT(LOGCHR,<^M^J^I/LPDAT/LPTSPL version ^V/LPTVNO/ ^T93/LPCNF/>) ;[6022] 
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	$TEXT(LOGCHR,<^I/LPDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on ^B/@JOBOBA(S1)/ at ^H/[-1]/>)
	SKIPN	T2,.EQCHK+CKFLG(J)	;GET THE CHECKPOINT FLAGS
	JRST	NXTJ.6			;[6000]AND JUMP IF NEW JOB
	MOVEI	T1,[ASCIZ /system failure/]
	TXNE	T2,CKFREQ		;WAS IT A REQUEUE
	MOVEI	T1,[ASCIZ /requeue by operator or spooler/] ;[6010]
	$TEXT(LOGCHR,<^I/LPMSG/Job being restarted after ^T/0(T1)/>)

NXTJ.6:	LOAD	S1,.EQSEQ(J),EQ.IAS	;[6000]PICK UP INVALID ACCOUNT BIT
	SKIPE	S1			;IS THIS AN INVALID REQUEST?
	$TEXT	(LOGCHR,<^I/LPERR/Invalid account string specified (^T/.EQACT(J)/)>) ;[6010]
	GETLIM	T1,.EQLIM(J),OLIM	;GET PAGE LIMIT
	MOVEM	T1,J$RLIM(J)		;SAVE IT
	PUSHJ	P,ACTBEG		;GO SETUP THE ACCOUNTING PARMS
	PUSHJ	P,I%NOW			;GET TIME OF DAY
	MOVEM	S1,J$RTIM(J)		;SAVE IT AWAY
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	SKIPL	J$REMR(J)		;[6044]DID REQUEST ORIGINATE REMOTELY?
	IFSKP.				;[6044]
	  $WTOJ  (Begin,<^I/RMJOBI/>,@JOBOBA(S1))    ;[6044]
	ELSE.				;[6044]
	  $WTOJ  (Begin,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;[6044]
	ENDIF.				;[6044]
	SKIPGE	J$LREM(J)		;[6001] Skip if local mode
	$RETT				;[6001] Return

	PUSHJ	P,TBFINI		;INITIALIZE THE BUFFER
	PUSHJ	P,CHKLPT		;GO MAKE SURE THE DEVICE IS ONLINE
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- SETUP - Setup/Shutdown Message

;Here to process the SETUP message.

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

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

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

	;Continued on next page
	;Continued from previous page

;Check the setup message to determine what kind of spoooler we are today.
;
;	LOCSPL		local spooler
;	LOCSPL!SPLTAP	Spooling to a device (device will be TTY or MTA)
;	CLUSPL		cluster spooler
;	DQSSPL		DQS spooler
;	(none)		DN60 spooler (SUP.CN in setup message nonzero)

	SETZB	S2,J$LREM(J)		;[6001] Default to local LPT
	MOVE	S,SUP.FL(M)		;[6006] Pick up the LPT type
SETUP0:	SKIPE	SUP.CN(M)		;[6006] Is it a DN60?
	MOVX	S,D60SPL		;[6006] Yes, update the LPT type

;If we are a local/spooling to tape LPTSPL or DN60 LPTSPL, go off and handle.

	TXNE	S,D60SPL		;[6001] DN60?
	JRST	SETU.3			;[6001] Yes
	TXNE	S,LOCSPL		;[6002] Local?
	JRST	SETU.4			;[6002] Check for spooling to tape

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

;Here to set the device name and J$LREM bits for cluster, DQS, LAT LPTSPL.

SETU.F:	TXNN	S,CLUSPL		;[6006] Is it a cluster LPT?
	JRST	SETU.A			;[6001] No
	$CALL	INILNK			;[6001] Init and open decnet link
	MOVX	S2,.JREML!.JLCLU	;[6001] Cluster LPT, indicate so
	MOVX	T1,'CLU'		;[6001] Indicate spooling type
	JRST	SETU.D			;[6001] Continue below

SETU.A:	TXNN	S,DQSSPL		;[6006] Is it a DQS LPT?
	JRST	SETU.C			;[6001] No
	$CALL	DQSINI			;[6001] Maybe open DECnet link
	MOVX	S2,.JREML!.JLDQS	;[6001] DQS LPT, indicate so
	MOVX	T1,'DQS'		;[6001] Indicate spooling type
	JRST	SETU.D			;[6001] Continue below

SETU.C:	TXNN	S,LATSPL		;[6006] LAT LPTSPL?
	JRST	SETU.E			;[6002] No, Unknow printer type
	MOVE	S1,SUP.CR(M)		;[6005] Get terminal characteristic
	MOVEM	S1,J$TTYC(J)		;[6005] Save it
;**;[6046]At SETU.C:+3L replace 1 line with 2 JYCW 1/16/89
;**;[6052]At SETU.C+4L add 2 lines  JYCW 12/6/89
	$CALL	LATCHA			;[6052]Check for /terminal-charact
	JUMPF	SETU.L			;[6052]Operator aborted
	TXO	S,INTRPT		;[6046]Indicate we're connected
	MOVX	S1,%RSUOK		;[6046]Load the code
;**;[6052]At SETU.C:+7L Add a label JYCW 12/6/89
SETU.L:	MOVX	S2,.JREML!.JLLAT	;[6052][6001] Set the flags
	MOVX	T1,'LAT'		;[6001] Indicate spooling type
	JRST	SETU.6			;[6005] Continue below

;Here if a non-local non-TTY non-DN60 LPTSPL, with
;	S1/ response to setup code
;	S2/ remote spooler bits
;	T1/setup with SIXBIT spooler (device) type
;	S/ is setup with the spooler mode bits
;	TF/ TRUE if the setup went OK or FALSE to shutdown

SETU.D:	MOVEM	S2,J$LREM(J)		;[6001] Remember type of printer we are
	MOVEM	T1,J$LDEV(J)		;[6001] Save device type (spooler mode)
	TXNE	S,CLUSPL		;[6001] Cluster LPTSPL?
	JUMPF	SETU.7			;[6000] Yes, shutdown if fatal error
	JRST	SETU.6			;[6000] No, send the setup response

SETU.E:	MOVEI	S1,%RSUDE		;[6002] Unknown printer type, shutdown
	JRST	SETU.6			;[6002] Go send the RESPONSE message

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

;Here on a setup of DN60 spooler

SETU.3:					;[6001] Here if DN60 LPT
 IFN FTDN60,<
	MOVX	S1,.JDN60		;[6000]INDICATE DN60 LPT
	MOVEM	S1,J$LREM(J)		;[6000]REMEMBER THAT DN60 LPT
	HRLI	S1,SUP.CN(M)		;DN60,,GET LINE CONDITIONING BLK ADDRESS
	HRRI	S1,J$DCND(J)		;   AND WHERE TO PUT IT
	BLT	S1,J$DCND+CN$SIZ-1(J)	;COPY IT OVER
	MOVE	S1,SUP.ST(M)		;GET THE DN60 FLAG WORD
	MOVEM	S1,J$DFLG(J)		;SAVE IT FOR LATER
	SETOM	J$ENBR(J)		;We initally don't care about NBR errs.
> ;End IFN DN60
	JRST	SETU.5			;[6000]GO SETUP OUTPUT DEVICE

;Here on setup of a local LPTSPL, check for spooling to tape

SETU.4:	TXNN	S,SPLTAP		;[6006] Spooling to tape or TTY?
	JRST	SETU.5			;[6001] Nope
	MOVE	S2,SUP.ST(M)		;[6000] Get device name
	MOVEM	S2,J$MTAP(J)		;[6001] Save the device name
	MOVEM	S2,J$LDEV(J)		;[6001] Save device for accounting too

;Check to see in the device specified for spooling is a TTY
;*** Add code here to do this ***

	TXC	S,SPLTAP!LOCSPL!TTYSPL	;[6001] It is a TTY spooler now

	;Continued on next page
	;Continued from previous page
;Here to set up output device (DN60, local printer, tape, TTY)

SETU.5:					;[6000]
IFN FTDN60<
	SETZM	J$CWKT(J)		;Init this in any case
> ; End of IFN DN60
	SETOM	J$LCHN(J)		;INDICATE NO OUTPUT CHANNEL YET.
	PUSHJ	P,OUTGET		;GET THE OUTPUT DEVICE

;Here to send the response to setup message or the shutdown message if an
;error setting up.

SETU.6:	PUSH	P,S1			;[6000]SAVE THE RESPONSE CODE
	PUSHJ	P,RSETUP		;SEND THE RESPONSE TO SETUP MSG.
	POP	P,T2			;GET THE RESPONSE CODE BACK
	MOVE	S1,STREAM		;GET STREAM NUMBER
	AOS	S2,STRSEQ		;ADD 1 TO THE STREAM SEQ #, PUT IN S2.
	MOVEM	S2,JOBWAC(S1)		;SAVE IT AS THE OPR WTOR ACK CODE.
;**;[6051]At SETU.6:+6L  change 1 line  JCR  11/29/89
	$QWTO (<^T/@SETMSG(T2)/>,,@JOBOBA(S1),<$WTACK(JOBPID)>);[6051]Tell the OPR whats going on.
	SETZM	JOBITS			;[6027] Insure that S is stored
	CAIE	T2,%RSUOK		;ALL IS OK?
SETU.7:	$CALL	SHUTND			;[6000]NO, SHUT IT DOWN
	$RETT				;RETURN

SETMSG:	[ASCIZ/Started/]		;[6012] %RSUOK
	[ASCIZ/Not available right now/] ;[6012] %RSUNA
	[ASCIZ/Does not exist/]		;[6012] %RSUDE
	SUBTTL	IPCF Interface -- SHUTDN - Shut Down A Printer

SHUTDN:	MOVEI	S1,SUP.TY(M)		;GET THE OBJECT BLOCK ADDRESS
	PUSHJ	P,FNDOBJ		;FIND THE OBJECT BLOCK
	JUMPF	.RETT			;NO OBJECT,,THEN NOTHING TO SHUT DOWN
	
SHUTND:	SKIPA	T4,[EXP 0]		;INDICATE 'OUT OF STREAM' CONTEXT
SHUTIN:	SETOM	T4			;INDICATE 'IN STREAM' CONTEXT
	$CALL	INPCLS			;[6007] Close input file if open
	SKIPE	T4			;ARE WE IN STREAM CONTEXT?
	MOVE	P,[IOWD PDSIZE,PDL]	;YES,,GET A NEW STACK POINTER
	MOVEI	S1,J$$END		;GET THE LPT DATA BASE LENGTH
	ADDI	S1,PAGSIZ-1		;ROUND UP TO NEXT HIGHEST PAGE
	IDIVI	S1,PAGSIZ		;GET NUMBER OF PAGES IN S1
	MOVE	S2,J			;GET THE JOBPAG ADDRESS
	ADR2PG	S2			;CONVERT TO A PAGE NUMBER
	PUSHJ	P,M%RLNP		;RETURN THEM
	SETOM	JOBITS			;SAY WE DONT WANT TO SAVE STATUS BITS.
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	SETZM	JOBPAG(S1)		;CLEAR THE PAGE WORD
	SETZM	JOBACT(S1)		;AND THE ACTIVE WORD
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR?
;**;[6053]At SHUTIN:+16L replace 2 lines with 5 lines  JCR  12/16/89
	$QKWTO	(JOBWAC(S1))		;[6053]Yes, kill the WTOR
	SETZM	JOBWAC(S1)		;[6053]Clear it just in case
	SETZM	JOBREM(S1)		;[6053]Clear remote node name
	SETZM	JOBRFG(S1)		;[6053]Clear MF.NEB
	SETZM	JOBNUL(S1)		;[6053]Clear send Null ACK message
	MOVEI	S2,OUTREL		;[6001] Assume local release routine
	TXNE	S,LATSPL		;[6025] Is this a LAT LPTSPL?
	MOVEI	S2,LATABT		;[6037] LAT LPTSPL release
	TXNE	S,CLUSPL		;[6001] Is this a cluster LPTSPL?	
	MOVEI	S2,CLNCLU		;[6001] Cluster LPTSPL release
	TXNE	S,DQSSPL		;[6001] Is this a DQS LPTSPL?	
	MOVEI	S2,DQSREL		;[6001] No load local release routine	
	TXNN	S,CLUSPL!DQSSPL		;[6001] Is this a DQS/cluster LPTSPL?
	SKIPL	J$LCHN(J)		;[6001] No, do we have an output ch?
	PUSHJ	P,(S2)			;[6001] Release the object
	SKIPE	S1,J$TDEV(J)		;[6005] Get device designator
	RELD				;[6005] Release the TTY
	 JFCL				;[6005] Ignore error

;  THIS IS FOR PROGRAMMABLE TERMINALS
;	HRRZ	S1,J$VJFN(J)		;[6005] Get JFN of TTY VFU
;	SKIPE	S1			;[6005] None
;	CLOSF				;[6005] Close the TTY VFU 
;	 JFCL				;[6005] Ignore error

	JUMPE	T4,.RETT		;'OUT OF STREAM',,JUST RETURN
	JRST	MAIN.3			;'IN STREAM',,RETURN TO THE SCHEDULER
	SUBTTL	IPCF Interface -- RSETUP - Send A Response-To-Setup

;Here to send the response to setup message back to QUASAR.

RSETUP:	MOVE	T2,S1			;SAVE THE SETUP CONDITION CODE.
	MOVEI	S1,RSU.SZ		;GET MESSAGE LENGTH
	MOVEI	S2,MSGBLK		;AND THE ADDRESS OF THE BLOCK
	PUSHJ	P,.ZCHNK		;ZERO IT OUT
	MOVEI	T1,MSGBLK		;GET THE BLOCK ADDRESS
	MOVX	S1,RSU.SZ		;GET MESSAGE SIZE
	STORE	S1,.MSTYP(T1),MS.CNT	;STORE IT
	MOVX	S1,.QORSU		;GET FUNCTION CODE
	STORE	S1,.MSTYP(T1),MS.TYP	;STORE IT
	MOVE	S1,STREAM		;GET STREAM NUMBER
	MOVS	S1,JOBOBA(S1)		;GET OBJADR,,0
	HRRI	S1,RSU.TY(T1)		;AND PLACE TO MOVE IT TO
	BLT	S1,RSU.TY+OBJ.SQ-1(T1)	;[6002] and move the object block
	STORE	T2,RSU.CO(T1)		;STORE THE RESPONSE CODE
	MOVX	S1,%LOWER		;GET LOWER-CASE BIT
	SKIPL	J$LLCL(J)		;IS PRINT LOWER CASE?
	MOVX	S1,%UPPER		;NO, LOAD THE UPPER CASE FLAG
	TXNE	S,CLUSPL!LATSPL!DQSSPL	;[6033]IS THIS A CLUSTER OR REMOTE LPT?
	SETZ	S1,			;[6031]YES, DON'T SET ANY ATTRIBUTES
	STORE	S1,RSU.DA(T1),RO.ATR	;STORE THE DEVICE ATTRIBUTES
	TXNN	S,LATSPL!TTYSPL		;[6005] LAT or TTY spooling?
	JRST	RSETU			;[6005] No need to add TTY charact
	MOVE	S2,J$TTYC(J)		;[6005] Get the terminal characteristic
	MOVEM	S2,RSU.CR(T1)		;[6005] Store it
RSETU:	PUSHJ	P,SNDQSR		;AND SEND THE MESSAGE
	$RETT				;RETURN.
	SUBTTL	IPCF Interface -- OACRSP - Response to a WTOR

;**;[6051]At OACRSP:+0L replace 12 lines with 45 lines  JCR  11/29/89
OACRSP:	SETOM	JOBITS			;[6051]Don't update status bits
	MOVE	S2,.MSCOD(M)		;[6051]Get WTOR ACK code
	CAME	S2,JOBWAC		;[6051]Compare ACK codes
	JRST	RESP.1			;[6051]Response too late
	MOVX	S2,PSF%OR+PSF%OO	;[6051]Get "Operator-response" wait bit
	ANDCAM	S2,JOBSTW		;[6051]And clear it
	MOVE	J,JOBPAG		;[6051]Get the stream db address
	$CALL	CHKREM			;[6051]Check for remote origin of msg
	SKIPF				;[6051]Skip if local origin
	MOVEM	S1,JOBPID		;[6051]Save the operator's PID
	DMOVE	S1,.OHDRS+ARG.DA(M)	;[6051]Get the operator's response
	DMOVEM	S1,J$RESP(J)		;[6051]And save it
	SKIPE	JOBSTW			;[6051]Is the stream blocked?
	$CALL	SNDNUL			;[6051]Yes, Send a Null ACK 
	$RETT				;[6051]And return
RESP.1:	$CALL	CHKREM			;[6051]Check for remote origin of msg
	JUMPF	.RETT			;[6051]Return if local
	MOVEM	S1,JOBPID		;[6051]Save the operator's PID
	$CALL	SNDNUL			;[6051]Send a Null ACK for NEBULA
	$RETT				;[6051]And return
	SUBTTL	CHKREM - Check if a Message Originated Remotely

;[6051]CHKREM determines if a message originated remotely by checking if
;[6051]the remote origin bit (MF.NEB) is set. If it is, then the remote
;[6051]node name is saved and the remote origin indicator (JOBRFG) is set.
;[6051]
;[6051]Call is:       M/Message address
;[6051]Returns true:  The message originated remotely
;[6051]Returns false: The message originated locally

CHKREM:	SETZM	JOBRFG			;[6051]Assume message originated locally
	SETZM	JOBNUL			;[6051]Assume don't need to send Null ACK
	MOVE	S1,.MSFLG(M)		;[6051]Pick up the flag word
	TXNN	S1,MF.NEB		;[6051]Message originate remotely?
	$RETF				;[6051]No, indicate so 
	MOVEI	S1,.ACKID		;[6051]Want to find an ACK block
	$CALL	FNDBLK			;[6051]Check for an ACK block
	$RETIF				;[6051]Shouldn't happen
	MOVE	S2,ARG.DA(S1)		;[6051]Pick up the node name
	MOVEM	S2,JOBREM		;[6051]Save for any $Qxxx
	SETOM	JOBRFG			;[6051]Indicate remote for any $Qxxx
	SETOM	JOBNUL			;[6051]Indicate need to send Null ACK
	MOVE	S1,0(S1)		;[6051]Pick up the PID of the operator
	$RET				;[6051]Indicate remote to caller
	SUBTTL	IPCF Interface -- OACCAN - Operator Abort Request

OACCAN:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,STREAM		;GET STREAM NUMBER.
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At OACCAN:+3L replace 5 lines with 5 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QACK(Aborting,<^I/RMJOBI/>,@JOBOBA(P1),JOBPID)    ;[6051]Tell OPR
	ELSE.				;[6051]
	  $QACK(Aborting,<^R/.EQJBB(J)/>,@JOBOBA(P1),JOBPID) ;[6051]Tell OPR
	ENDIF.				;[6051]
	SETZM	J$APRG(J)		;ALIGNMENT NOT SCHEDULED,,NOT ACTIVE
	SETZM	JOBWKT(P1)		;SET WAKE UP TIME TO NOW.
	SETZM	RSNFLG			;SHOW NO REASON GIVEN.
	MOVX	S1,PSF%OR+PSF%OO	;GET OPR RESP WAIT BIT
	TDNE	S1,JOBSTW(P1)		;ARE WE WAITING FOR THE OPERATOR?
;**;[6053]At OACCAN:+14L change 1 line  JCR  12/16/89
	$QKWTO	(JOBWAC(P1))		;[6053]Yes, kill the WTOR
	ANDCAM	S1,JOBSTW(P1)		;ZAP THE OPR WAIT BIT

;Loop thru the message from ORION and pick it apart.

OACC.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	OACC.2			;NO MORE,,FINISH UP
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK?
	MOVEM	T3,RSNFLG		;YES,,SAVE THE REASON ADDRESS
	CAIE	T1,.CANTY		;IS THIS THE CANCEL TYPE BLOCK?
	JRST	OACC.0			;NO,,SKIP IT AND GET NEXT BLOCK
					;YES...
	MOVE	S1,0(T3)		;LOAD THE CANCEL TYPE.
	CAIE	S1,.CNPRG		;IS IT /PURGE?
	JRST	OACC.0			;NO,,PROCESS THE NEXT MSG BLK
	TXNE	S,CLUSPL		;[6001] Is this a Cluster LPTSPL?
	JRST	OACC.4			;[6000]GO LITE ABORT BIT AND RETURN

;Here to cancel the request when the cancel type block is seen

	$CALL	INPCLS			;[6007] Close the input file if any
	MOVEM	S,J$RACS+S(J)		;SAVE THE 'S' AC WITH NEW DSKOPN BITS
	TXNE	S,DQSSPL		;[6001] DQS spooler?
	JRST	OACC.1			;[6001] Yes, skip flushing output 
	TXNE	S,LATSPL!TTYSPL		;[6025]LAT or TTY spooler?
	JRST	OACC.1			;[6025]Yes, skip flushing output 
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN
	PUSHJ	P,SENDFF		;OUTPUT A FORM FEED FOR NEXT JOB

OACC.1:	SETZM	JOBACT(P1)		;STREAM IS NO LONGER ACTIVE
	PUSHJ	P,QRELEA 		;RELEASE THE REQUEST
	PUSHJ	P,OUTEOF		;OUTPUT AN EOF
	$RETT				;AND RETURN
;Here when all message blocks read to abort the request

OACC.2:	TXNE	S,CLUSPL		;[6001] Cluster LPTSPL?
	JRST	OACC.4			;[6000] Yes, lite ABORT bit and return

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

OACC.4:	TXO	S,ABORT			;[6000]TELL LPTSPL WE ARE LEAVING.
	$RETT				;[6000]RETURN TO THE IPCF PROCESSOR
	SUBTTL	IPCF Interface -- OACSUP - Operator SUPPRESS Request

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

;Here to pick apart the suppress message to get the arguments.

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

	TXZ	S,SUPJOB!SUPFIL		;TURN OFF SUPPRESS FILE AND JOB BIT
	$TEXT (LOGCHR,<^I/LPOPR/Operator stopped carriage control supression>)
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At OACS.0:+13L replace 5 lines with 5 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QACK(Carriage control activated,<^I/RMJOBI/>,@JOBOBA(S1),JOBPID);[6051]
	ELSE.				;[6051]
	  $QACK(Carriage control activated,<^R/.EQJBB(J)/>,@JOBOBA(S1),JOBPID);[6051]
	ENDIF.				;[6051]
	$RETT				;RETURN NOW

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

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

OACS.3:	$TEXT(LOGCHR,<^I/LPOPR/Operator suppressed carriage control for rest of
^T/0(S1)/>)
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At OACS.3:+3L replace 5 lines with 5 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QACK(Carriage control suppressed,<^I/RMJOBI/>,@JOBOBA(S1),JOBPID);[6051]
	ELSE.				;[6051]
	  $QACK(Carriage control suppressed,<^R/.EQJBB(J)/>,@JOBOBA(S1),JOBPID);[6051]
	ENDIF.				;[6051]
	$RETT				;RETURN NOW
	SUBTTL	IPCF Interface -- OACPAU - Operator STOP Request

OACPAU:	MOVX	S2,PSF%ST		;LOAD THE STOP BIT
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	IORM	S2,JOBSTW(S1)		;SET IT
;**;[6051]At OACPAU:+2L change 1 line  JCR  11/29/89
	$QACK (Stopped,,@JOBOBA(S1),JOBPID) ;[6051]Tell the operator
	SETZM	JOBCHK(S1)		;SAY WE WANT A CHECKPOINT TAKEN.
	SETOM	JOBUPD(S1)		;Update the status also.
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- OACCON - Operator CONTINUE request

OACCON:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%ST!PSF%DO	;LOAD THE BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
;**;[6051]At OACCON:+2L change 1 line JCR  11/29/89
	$QACK (Continued,,@JOBOBA(S1),JOBPID) ;[6051]Tell the operator
	SETOM	JOBUPD(S1)		;Do an update
					; don't need checkpoint
					; did one when we stopped
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- OACREQ - Operator REQUEUE request

OACREQ:	TXNE	S,GOODBY		;IS IT TOO LATE FOR THIS?
	PJRST	TOOBAD			;YES,,TOUGH LUCK
	TXO	S,RQB+ABORT		;LITE THE REQUEUE+ABORT BITS
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At OACREQ:+5L change 5 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QACK(Requeued,<^I/RMJOBI/>,@JOBOBA(S1),JOBPID)    ;[6051]Tell OPR
	ELSE.				;[6051]
	  $QACK(Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),JOBPID) ;[6051]Tell OPR
	ENDIF.				;[6051]
	MOVX	S2,PSF%OR!PSF%OO	;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR?
;**;[6053]At OACREQ:+13L change 1 line  JCR  12/16/89
	$QKWTO	(JOBWAC(S1))		;[6053]Yes, kill the WTOR
	ANDCAM	S2,JOBSTW(S1)		;ZAP THE OPR WAIT BIT
	TXNE	S,CLUSPL		;[6001] Yes, is this a cluster LPTSPL?
	$RETT				;[6001] Yes, return to IPCF processor

	PUSHJ	P,INPFEF		;FORCE AN INPUT EOF
	$TEXT(LOGCHR,<^I/LPOPR/Job requeued by the the operator>)
;Loop through the message to look for the request type and reason blocks.

OACR.1:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
;**;[6051]At OACR.1:+1L change 1 line  JCR  11/29/89
	JUMPF	.RETT			;NO MORE,,RETURN
	CAIN	T1,.REQTY		;IS THIS THE REQUEST TYPE BLOCK?
	JRST	OACR.2			;YES,,GO PROGESS IT
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK?
	$TEXT (LOGCHR,<^I/LPOPR/Requeue reason is: ^T/0(T3)/.>)
	JRST	OACR.1			;PROCESS THE NEXT MSG BLOCK

;Here when seeing the request type block

OACR.2:	MOVE	S1,0(T3)		;PICK UP THE REQUEUE CODE.
	TXNN	S,DQSSPL		;[6026] DQS reques from begin of job
	JRST	OACR.6			;[6001] Check other requeue codes
	CAXE	S1,.RQBJB		;[6001] Beginning of job?
;**;[6051]At OACR.2:+4L change 1 line  JCR  11/29/89
	$QWTO	(DQS Requeue,<DQS job requeued from beginning of job>,@JOBOBA,<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]
	JRST	OACR.1			;[6001] Yes, all set

;Fetch requeue type and zero things based on requeue keyword, write to log.

OACR.6:	SETZ	S2,			;ZERO AC 2
	CAXN	S1,.RQCUR		;/CURRENT?
	JRST	OACR.4			;YES, DO IT
	SETZM	J$RNPP(J)		;CLEAR CURRENT PAGE NUMBER
	CAXN	S1,.RQBCP		;BEGINNING OF COPY?
	MOVEI	S2,[ASCIZ /current copy/]
	TXNN	S,DQSSPL		;[6001] DQS reques from begin of job
	JUMPN	S2,OACR.3		;AND CONTINUE ON
	SETZM	J$RNCP(J)		;CLEAR CURRENT COPY NUMBER
	CAXN	S1,.RQBFL		;FROM BEGINING OF FILE?
	MOVEI	S2,[ASCIZ /current file/]
	TXNN	S,DQSSPL		;[6001] DQS reques from begin of job
	JUMPN	S2,OACR.3		;AND CONTINUE ON
OACR.5:	SETZM	J$RNFP(J)		;CLEAR FILE COUNT
	MOVEI	S2,[ASCIZ /job/]	;FROM BEGINNING OF JOB

OACR.3:	$TEXT(LOGCHR,<^I/LPOPR/Job will restart at the beginning of the ^T/0(S2)/>)
	JRST	OACR.1			;Go process the next msg block.

OACR.4:	$TEXT(LOGCHR,<^I/LPOPR/Job will restart at the current position>)
	MOVNI	S1,2			;LOAD -2
	ADDM	S1,J$RNPP(J)		;INSURE NO LOSSAGE OF DATA
	ADDM	S1,J$APRT(J)		;HERE ALSO
	SKIPGE	J$RNPP(J)		;MAKE SURE WE DIDN'T SCREW THINGS UP
	SETZM	J$RNPP(J)		;YES,,ZERO THE PAGES PER COPY
	SKIPGE	J$APRT(J)		;CHECK HERE ALSO
	SETZM	J$APRT(J)		;NO GOOD,,SET IT TO ZERO
	JRST	OACR.1			;[6001] Go process the next msg block
	SUBTTL	IPCF Interface -- OACALI - Operator ALIGN request

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

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

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

OALI.1:	SKIPN	J$APRG(J)		;ARE WE ALREADY ALIGNING?
	JRST	ALISCD			;[6007] NO,,THEN WE'RE OK
	MOVE	S1,STREAM		;YES,,GET STREAM NUMBER.
;**;[6051]At OALI.1:+3L change 1 line  JCR  11/29/89
	$QACK  (ALIGN already in progress,,@JOBOBA(S1),JOBPID) ;[6051]
	$RETT				;RETURN NOW.

	;Continued on next page
	;Continued from previous page

OALI.6:	SKIPE	J$APRG(J)		;ARE WE ALREADY ALIGNING?
	JRST	OALI.7			;IF SO,,CONTINUE PROCESSING.
	MOVE	S1,STREAM		;GET STREAM NUMBER
;**;[6051]At OALI.6:+3L change 1 line  JCR  11/29/89
	$QACK  (</STOP Illegal>,Alignment not in Progress,@JOBOBA(S1),JOBPID);[6051]
	$RETT
OALI.7:	MOVE	S1,J$AIFN(J)		;GET THE ALIGN IFN.
	SETOB	S2,J$ABYT(J)		;SET ALIGN FILE BYTE COUNT TO -1.
	PUSHJ	P,F%POS			;POSITION TO ALIGN EOF.
	SETZM	J$ACNT(J)		;SET REPEAT-COUNT TO 0.
	MOVE	S1,STREAM		;GET STREAM NUMBER
;**;[6051]At OALI.7:+5L change 1 line  JCR  11/29/89
	$QACK  (Alignment Discontinued,,@JOBOBA(S1),JOBPID) ;[6051]
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- OACFWS - Operator Forward Space Command

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

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

FSPACE:	SKIPN	J$DIFN(J)		;IS THERE A SPOOL FILE OPEN?
	$RETT				;NO,,JUST IGNORE THIS
	TXO	S,FORWRD		;TURN ON FORWARD SPACE BIT.
	MOVE	S2,0(T3)		;PICK UP # OF PAGES TO FSPACE.
	ADDM	S2,J$FPIG(J)		;SAVE THE VALUE.
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
;**;[6051]At FSPACE:+6L change 1 line  JCR  11/29/89
	$QACK  (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),JOBPID);[6051]
	MOVE	S1,J$TFIL(J)		;[6007] Load the file type
	$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S1)/ Forward spaced ^D/S2/ pages>) ;[6007]
	$RETT				;AND RETURN


FCOPYS:	MOVE	S2,0(T3)		;PICK UP THE # OF COPIES TO FSPACE.
	ADDM	S2,J$RNCP(J)		;ADD TO # OF COPIES ALREADY PRINTED.
	MOVE	S1,J$TFIL(J)		;[6007] Pick up file type
	$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S1)/ Forward spaced ^D/S2/ copies>) ;[6007] 
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
;[6051]At FCOPYS:+5L change 1 line  JCR  11/29/89
	$QACK  (<Forward Spaced ^D/S2/ Copies>,,@JOBOBA(S1),JOBPID) ;[6051]
	PUSHJ	P,INPFEF		;FORCE AN END-OF-FILE.
	$RETT				;AND RETURN

FFILES:	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER
;**;[6051]At FFILES:+1L change 1 line  JCR  11/29/89
	$QACK	(Forward Spaced 1 File,,@JOBOBA(S1),JOBPID);[6051]
	MOVE	S2,J$TFIL(J)		;[6007] Pick up file type
	$TEXT	(LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S2)/ Skipped by Operator>) ;[6007] 
	PUSHJ	P,INPFEF		;FORCE AN END OF FILE
	TXO	S,SKPFIL		;TURN ON SKIP FILE FLAG
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- OACBKS - BACKSPACE Operator Action

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

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

BSPACE:	MOVE	T1,0(S1)		;PICK UP THE NUMBER OF PAGES TO BSPACE.
	MOVE	S1,STREAM		;PICK UP STREAM NUMBER.
	MOVE	S2,J$TFIL(J)		;[6000]PICK UP FILE TYPE
;**;[6051]At BSPACE:+3L change 1 line  JCR  11/29/89
	$QACK(<Backspaced ^D/T1/ Pages>,,@JOBOBA(S1),JOBPID) ;[6051]
	$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S2)/ Backspaced ^D/T1/ pages>)
	SKIPN	J$DIFN(J)		;IS THERE A SPOOL FILE OPEN?
	$RETT				;NO,,JUST RETURN.

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

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

	MOVEM	S1,J$RNPP(J)		;RESET PAGE POINTER FOR THIS FILE
	MOVEI	S1,1(S2)		;POINT TO NEXT PAGE TBL ENTRY
	CAIL	S1,J$FPAG+PAGSIZ(J)	;Want to wrap around?
	JRST	[MOVEI	S1,J$FPAG(J)	;Yes, start at the beginning
		TXO	S,FBPTOV	;Say we overflowed
		JRST	.+1]		;And continue
	MOVEM	S1,J$FBPT(J)		;AND MAKE THIS THE CUR TBL ENTRY ADDR
	MOVE	S2,0(S2)		;PICK UP THE LISTING PAGE ADDRESS
	MOVEM	S2,J$FTBC(J)		;AND MAKE THIS THE TOTAL BUFR BYTE COUNT
	MOVE	S1,J$DIFN(J)		;GET THE SPOOL FILE IFN
	PUSHJ	P,F%POS			;POSITION TO THAT PAGE IN THE FILE
	$RETT				;AND RETURN

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

BCOPYS:	MOVE	S2,J$RNCP(J)		;PICK UP # OF COPIES ALREADY PRINTED.
	MOVE	T1,0(S1)		;PICK UP # OF COPIES TO BSPACE.
	SUB	S2,T1			;SUBTRACT # OF COPIES TO BSPACE.
	MOVEM	S2,J$RNCP(J)		;SAVE THE NEW COPIES VALUE.
	MOVE	S2,J$TFIL(J)		;[6000]PICK UP THE FILE TYPE
	$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S2)/ Backspaced ^D/T1/ copies>)
	MOVE	S1,STREAM		;PICK UP STREAM NUMBER.
;**;[6051]At BCOPYS:+7L change 1 line  JCR  11/29/89
	$QACK	(<Backspaced ^D/T1/ Copies>,,@JOBOBA(S1),JOBPID) ;[6051]
	PUSHJ	P,INPFEF		;FORCE END OF FILE.
	$RETT				;RETURN.
	SUBTTL	IPCF Interface -- Backspace -- BFILES - Backspace Files

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

BFIL.2:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
;**;[6051]At BFIL.2:+1L change 1 line  JCR  11/29/89
	$QACK(<Backspaced 1 File>,,@JOBOBA(S1),JOBPID) ;[6051]
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	S1,E			;POINT TO THE FD
	$TEXT	(LOGCHR,<^I/LPMSG/Backspaced to Beginning of ^F/0(S1)/>)
	MOVEM	E,J$RACS+E(J)		;UPDATE AC 'E' IN STREAM DATA BASE
	$RETT
	SUBTTL	IPCF Interface -- OPRD60 - Receive DN60 OPR messages from QUASAR

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

IFE FTDN60,<
OPRD60:	$RET				;SHOULD NOT HAPPEN
>

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

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

	;Continued on next page
	;Continued from previous page

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

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

OPRD.9:	$WTO(<DN60 Operator Message Lost>,<Linked List Processor Failure -^E/S1/>)
	$RET				;Complain and return
	SUBTTL	IPCF Interface -- OPRCHK - Check for and Send DN60 Messages

;  The purpose of this routine is to perform stream-related DN60 operator
;  functions that are separate from the normal print functions.
;  This function sends operator messages between normal
;	printouts. (on 2780/3780)

;    Parameters:  J / Address of job parameter area
;		  P1/ The stream being examined
;    Returns:  True always

OPRCHK:	SKIPN	J$OMSG(J)		;is there an operator message waiting?
	$RETT				;no - just return
	LOAD	S1,J$DFLG(J),NT.TYP	;GET THE MODE
	CAXN	S1,DF.HSP		;IS IT HASP?
	JRST	OPRC.X			;YES,,OK TO OUTPUT...
	MOVX	S1,PSF%OO		;GET OPR MSG WAIT CODE
	SKIPE	JOBACT(P1)		;IF THE STREAM IS ACTIVE
	TDNE	S1,JOBSTW(P1)		;   BUT WE ALREADY STARTED OPR MSGS
	SKIPA				;     THEN LETERRIP
	$RETT				;     ELSE RETURN

;Check to see if time to wake up

OPRC.X:	SKIPN	J$CWKT(J)		;Need to check time?
	JRST	OPRC.A			;No, Skip this
	$CALL	I%NOW			;Get the current time
	SUB	S1,J$CWKT(J)		;Subtract console wakeup time
	SKIPGE	S1			;Time to wake up?
	JRST	[$CALL CHKTIM		;No, update sleept
		$RETT]			;Quit
	SETZM	J$CWKT(J)		;Time to continue

OPRC.A:	$SAVE	<P1>			;Save P1
	HRRZM	P1,STREAM		;HERE ALSO

	;Continued on next page
	;Continued from previous page

;Loop on messages

OPRC.0:	MOVE	S1,J$LINK(J)		;GET THE OPR MSG LIST ID
	PUSHJ	P,L%FIRST		;GET THE FIRST MESSAGE ON THE CHAIN
	JUMPF	OPRC.3			;NONE THERE,,CLEAN UP AND RETURN
	MOVE	P1,S2			;SAVE THE MSG ADDRESS
	MOVE	S1,J$D6OP(J)		;GET THE OPR'S CONSOLE ID
	MOVE	S2,OPRPTR(P1)		;GET THE POINTER TO THE TEXT
	MOVE	T1,OPRBCT(P1)		;GET THE TEXT BYTE COUNT
	PUSHJ	P,D60SOUT##		;OUTPUT THE OPERATOR MESSAGE
	JUMPT	[$CALL	D60SU		;Process good return
		MOVE	S1,J$LINK(J)	;Get OPR message list ID
		$CALL	L%DENT		;Delete current message

;		Send a IBMCOM stats message if needed

IFN FTIBMS,<
		MOVEI	S1,%TCNO	;Get the stats code for
					;console message
		$CALL	IBMSTS		;Tell QUASAR
> ; End of FTIBMS
		JRST	OPRC.0]		;Go try again
;Process error

	$D60OE	(ERCOE)			;Process the error
	JUMPT	OPRC.2			;Good error - process it

;Bad error - Assume fatal for console

OPRC.1:	MOVX	S1,%RSUDE		;GET 'DOES NOT EXIST' SETUP CODE
	PUSHJ	P,RSETUP		;TELL QUASAR WHATS GOING ON
	PUSHJ	P,SHUTND		;SHUT EVERYTHING DOWN
	$RETT				;AND RETURN

;Good error - Update pointers and flags

OPRC.2:	MOVEM	S2,OPRPTR(P1)		;SAVE THE NEW TEXT POINTER
	MOVEM	T1,OPRBCT(P1)		;SAVE THE NEW TEXT BYTE COUNT
	$RETT				;And return OK

;Done with messages - Try to clean up

OPRC.3:	MOVE	S1,J$D6OP(J)		;GET THE OPERATOR CONSOLE ID
	$CALL	D60EOF##		;Try to EOF
	JUMPT	[$CALL	D60SU		;Process good error
		SETZM	J$OMSG(J)	;Clear message waiting flag
		$RETT]			;and return
	$D60OE	(ERFCC)			;Go process the error
	JUMPF	OPRC.1			;Bad error
	$RETT				;Good error, return
> ; End of IFN FTDN60
	SUBTTL	IPCF Interface -- Subroutines -- FNDOBJ - Find The Object Block

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

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

FNDO.3:	MOVEM	T4,STREAM		;SAVE STREAM NUMBER
	SKIPN	J,JOBPAG(T4)		;GET ADDRESS OF DATA
	$RETF				;UNLESS ITS NOT REALLY SETUP THEN RETURN
	MOVE	S,J$RACS+S(J)		;GET HIS 'S'
	$RETT				;AND RETURN
	SUBTTL	IPCF Interface -- Subroutines -- TOOBAD - Operator Is Too Late

;Routine to respond to the operator if his command was too late.

TOOBAD:	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At TOOBAD:+2L replace 5 lines with 5 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QACK(Print Request Completed,<^I/RMJOBI/>,@JOBOBA(S1),JOBPID);[6051]
	ELSE.				;[6051]
	  $QACK(Print Request Completed,<^R/.EQJBB(J)/>,@JOBOBA(S1),JOBPID);[6051]
	ENDIF.				;[6051]
	$RETT
	SUBTTL	IPCF Interface -- Subroutines -- SNDQSR - Send A Mesasge To QUASAR

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

	$STOP(QSF,Send to QUASAR FAILED)
	SUBTTL	Align Processor -- Align Forms on Printer

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

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

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

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

ALIG.4:	MOVE	S2,STREAM		;PICK UP STREAM NUMBER.
	PUSHJ	P,I%NOW			;GET CURRENT TIME.
	ADD	S1,J$ASLP(J)		;ADD /PAUSE VALUE.
	MOVEM	S1,JOBWKT(S2)		;SAVE WAKE UP TIME FOR STREAM.
	$DSCHD	(PSF%AL)		;SHOW STREAM BLOCKED FOR ALIGNMENT.
	JRST	ALIGN			;WHEN RETURN,,CONTINUE.
	SUBTTL	Align Processor -- ALISCD - Schedule Align

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

	SKIPG	S1,J$ASLP(J)		;PICK UP USER SLEEP TIME.
	SKIPLE	S1,J$FALS(J)		;ELSE, PICK UP LPFORM.INI SLEEP-TIME.
	SKIPA				;SKIP THE DEFAULT.
	MOVE	S1,D$ALSL		;PICK UP THE DEFUALT SLEEP-TIME.
	IMULI	S1,3			;CONVERT TO UNIVERSAL TIME.
	MOVEM	S1,J$ASLP(J)		;AND SAVE IT.
	SETOM	J$APRG(J)		;SHOW WE ARE DOING AN ALIGN,
					;   AND THAT IT NEEDS TO BE SCHEDULED.
	MOVE	S1,STREAM		;GET STREAM NUMBER
;**;[6055]At ALIS.3:-4L change 1 line  JCR  1/19/90
	$QWTO  (Alignment Scheduled,,@JOBOBA(S1),<$WTPID(JOBPID)>) ;[6055]Tell the operator.
	SETOM	JOBUPD(S1)		;Update the status
	$RETT				;RETURN.

ALIS.3:	MOVE	S1,STREAM		;GET STREAM NUMBER
;**;[6055]At ALIS.3:+1L change 1 line  JCR  1/19/90
	$QWTO  (<^E/[-1]/>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/>,@JOBOBA(S1),<$WTPID(JOBPID)>) ;[6055]
	$RETT
	SUBTTL	Align Processor -- Create A 10/20 FD For The Align File

BLDLFD:	MOVEI	S1,AFDSIZ		;GET THE FD LENGTH
	STORE	S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IT
	$TEXT	(<-1,,J$AFD+.FDSTG(J)>,<SYS:^W/J$FALI(J)/.ALP^0>)
	MOVEI	S1,J$AFD(J)		;PICK UP FD ADDRESS.
	$RETT				;RETURN. . . . . . . . . .
	SUBTTL	Printer Output -- CHKLPT - Make Sure The Device Is Online

CHKLPT:	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	PJRST	CHKTTY			;[6005] Yes check if we do polling
	SKIPE	S1,JOBSTW		;ARE ANY STATUS BITS SET?
	TXNN	S1,PSF%DO		;IF SO,,IS IT DEVICE OFFLINE?
	$RETT				;NO TO EITHER,,JUST RETURN
;**;[6051]At CHKLPT:+5L change 1 line  JCR  11/29/89
	$QWTO	(<^T/BELL/>,,@JOBOBA,<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Tell OPR device is offline
	MOVE	S1,STREAM		;Get the stream number
	SETOM	JOBUPD(S1)		;Say we want a status update
	$CALL	DSTATU			;Do it
	SETZM	JOBCHK			;INDICATE WE WANT ANOTHER WHEN WE CAN
	$RETT				;RETURN
	SUBTTL	Printer Output -- OUTGET - Open The Output Device

;This routine opens the LPT channel and sets up the LPT buffer ring.

GENDEV:	SKIPE	S1,J$MTAP(J)		;IS THERE A SPECIFIC DEVICE TO WRITE ON
	JRST	GEND.1			;YES,,RETURN WITH DEVICE IN S1
	MOVE	T1,STREAM		;PICK UP STREAM NUMBER.
	MOVE	T1,JOBOBA(T1)		;PICK UP OBJECT BLOCK ADDRESS.
	ADD	S1,OBJ.UN(T1)		;ADD THE UNIT NUMBER.
	ADD	S1,[SIXBIT/LPT000/]	;CREATE THE PHYSICAL DEVICE NAME.
GEND.1:	MOVEM	S1,J$LDEV(J)		;AND SAVE IT
	POPJ	P,			;RETURN. . . . .

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


OUTSOK:	SKIPE	J$CID(J)		;[6011]LATSPL?
	JRST	OUTSO1			;[6011]Yes, skip the connect stuff  
	PUSHJ	P,INTCNL		;CONNECT UP THE LPT
	JUMPF	OUTDDE			;DID NOT SUCCEED,,DEVICE DOES NOT EXIST
OUTSO1:	TXO	S,INTRPT		;[6011]INDICATE WE'RE CONNECTED
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN

OUTDNA:	MOVE	S1,J$LCHN(J)		;Get the failed PLPT JFN
	SETOM	J$LCHN(J)		;Indicate no output channel
IFN FTDN60,<
	SKIPLE	J$LREM(J)		; Is this a DN60?
	 JRST	OUTDDE			;All errors fatal on DN60
					;  don't need to release, done already
> ;End of IFN FTDN60
	RLJFN				;Release failed PLPT JFN
	 JFCL				;Don't care about any errors
	MOVX	S1,%RSUNA		;NOT AVAILABLE RIGHT NOW
	$RETF				;AND RETURN

OUTDDE:	MOVX	S1,%RSUDE		;NEVER AVAILABLE
	$RETF				;RETURN
	SUBTTL	Printer Output -- TAPGET - Setup A Magtape Device For Output

TAPGET:	SKIPN	J$LSTG(J)		;DO WE HAVE A DEVICE NAME YET?
	$TEXT	(<-1,,J$LSTG(J)>,<^W/J$MTAP(J)/:^0>) ;NO,,GEN THE DEVICE NAME
	SETZM	J$LREM(J)		;FORCE US TO BE LOCAL
	MOVSI	S1,(POINT 7,0)		;[6024]Get 7 bit byte pointer (output)
	MOVEM	S1,J$LBTZ(J)		;SAVE IT FOR LATER
	MOVX	S1,GJ%SHT+GJ%FOU	;GET GTJFN FLAG BITS
	LOAD	S2,IB+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as the value of the JFN access
	HRROI	S2,J$LSTG(J)		;POINT TO THE DEVICE NAME
	GTJFN				;GET A JFN
	JRST	TAPG.2			;CANT,,TOUGH BREAKEEE
	MOVEM	S1,J$LCHN(J)		;SAVE THE JFN
	DVCHR				;GET THE DEVICE CHARACTERISTICS
	ERJMP	TAPG.1			;SHOULD NOT HAPPEN
	LOAD	S2,S2,DV%TYP		;[6005] Get device type
	CAIN	S2,.DVTTY		;[6005] Is it a terminal ?
	PJRST	TTYGET			;[6005] Yes,setup proper TTY mode
	CAXE	S2,.DVMTA		;[6005] Magtape?
	JRST	TAPG.0			;No, skip the check

	MOVX	S1,DEVX2		;GET ALREADY ASSIGNED ERROR CODE
	HLRZS	T1			;MOVE LEFT TO RIGHT,,ZERO LEFT
	CAIE	T1,-1			;THE TAPE SHOULD NOT BE ASSIGNED
	JRST	TAPG.1			;IT IS,,CAN THE REQUEST
TAPG.0:	MOVE	S1,J$LCHN(J)		;GET THE JFN BACK
	MOVX	S2,OF%WR+7B5		;WRITE+7 BIT BYTES
	OPENF				;OPEN THE MAG TAPE
	JRST	TAPG.1			;CANT,,TOUGH
	MOVE	S1,J$LCHN(J)		;GET THE JFN
	MOVX	S2,.MONOP		;WAIT FOR I/O or SET TTY PAGE WIDTH
	SETZM	T1			;NO ARGS or INFINITE PAGE WIDTH
	MTOPR				;DO IT
	ERJMP	.+1			;IGNORE THE ERROR
	PUSHJ	P,OUTRES		;SETUP THE OUTPUT POINTERS
	PJRST	OUTSOK			;SO FAR HE WINS...
TAPG.1:	MOVE	T1,S1			;SAVE THE ERROR CODE
	SKIPE	S1,J$LCHN(J)		;[6013]GET THE JFN
	RLJFN				;RELEASE IT
	JFCL				;IGNORE THE ERROR
	MOVE	S1,T1			;RESTORE THE ERROR CODE TO S1
TAPG.2:	MOVE	S2,STREAM		;GET OUR STREAM NUMBER
;**;[6051]At TAPG.2:+1L  change 1 line  JCR  11/29/89
	$QWTO	(<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2),<$WTACK(JOBPID)>);[6051]Tell the operator
	PJRST	OUTDDE			;GIVE UP THE SHIP
	SUBTTL	Printer Output -- OUTOUT - Output A Buffer

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

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

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

OUTERR:	MOVE	T4,STREAM		;GET OUR STREAM NUMBER
	PUSHJ	P,$GDSTS		;GET THE DEVICE STATUS
	MOVEM	S1,J$LIOS(J)		;SAVE THE DEVICE STATUS
	MOVE	T1,S1			;SAVE IT HERE ALSO
	TXZ	S1,MO%OL		;CLEAR THE OFFLINE BIT
	PUSHJ	P,$SDSTS		;RESET THE DEVICE STATUS
	SKIPE	J$MTAP(J)		;SPOOLING TO TAPE?
	 JRST	OUTTPE			;YES, CHECK TAPE ERROR BITS
	TXNE	T1,MO%LVF		;NO, VFU ERR?
	JRST	OUTE.4			;YES,,GO PROCESS IT
	TXNE	T1,MO%RPE		;WAS IT A RAM PARITY ERROR
	JRST	OUT.2A			;YES, GO PROCESS IT
	JRST	OUTE.2			;NO,,PROCESS AS AN I/O ERROR

OUTTPE:	TXNE	T1,MT%EOT		;END OF TAPE?
	JRST	OUT.3A			;YES
	TXNE	T1,MT%ILW		;IS IT WRITE PROTECTED
	JRST	OUT.2B			;YES
	JRST	OUTE.2			;NO,,PROCESS AS AN I/O ERROR

	;RAM PARITY ERROR

;**;[6051]At OUT.2A:+0L change 1 line  JCR  11/29/89
OUT.2A:	$QWTO	(RAM Parity Error,,@JOBOBA(T4),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Yes, tell operator
	PUSHJ	P,OUTE.3		;PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLRM(J)		;FORCE A RAM RELOAD
	PUSHJ	P,LODRAM		;GO DO IT
	$RETT				;AND RETURN

	;Continued on next page
	;Continued from previous page

	;Write ring missing

;**;[6051]At OUT.2B+0L change 1 line  JCR  11/29/89
OUT.2B:	$QWTOR	(MTA Write Protected,<Insert Write Ring And Put On Line^m^j^t/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4),<$WTPID(JOBPID)>) ;[6051]
	SETOM	JOBCHK(T4)		;WE WANT A CHECKPOINT
	$DSCHD(PSF%OR)			;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED
;**;[6051]At OUT.2B+4L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH?
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK
	JRST	OUT.2B			;NO, TRY AGAIN
	MOVE	S2,STREAM		;Get the stream number
	SETOM	JOBUPD(S2)		;Yes, update the stream's status
	PUSHJ	P,OUTE.3		;GO PERFORM PRELIMINARY PROCESSING
;**;[6051]At OUT.2B+13L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK

	;Continued on next page
	;Continued from previous page

	;UNKNOWN TYPE I/O ERROR OCCURED

;**;[6051]At OUTE.2:+0L change 1 line  JCR  11/29/89
OUTE.2:	$QWTO (I/O Error,<Status is: ^O/J$LIOS(J)/>,@JOBOBA(T4),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]

	;GENERAL I/O ERROR RECOVERY ROUTINE

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

	;EOT

OUT.3A:	PUSHJ	P,TAPMRK		;WRITE A TAPE MARK
	PUSHJ	P,TAPUNL		;UNLOAD THE TAPE
;**;[6051]At OUT.3B:+0L change 1 line  JCR  11/29/89
OUT.3B:	$QWTOR	(<End of spooled output tape>,<Please mount next volume^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4),<$WTPID(JOBPID)>);NOTIFY OPERATOR ;[6051]
	SETOM	JOBCHK(T4)		;WE WANT A CHECKPOINT
	$DSCHD(PSF%OR)			;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED
;**;[6051]At OUT.3B:+4L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH?
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK
	JRST	OUT.3B			;NO, TRY AGAIN
	MOVE	S2,STREAM		;Get the stream number
	SETOM	JOBUPD(S2)		;Yes, update the stream's status
	PUSHJ	P,OUTE.3		;GO PERFORM PRELIMINARY PROCESSING
;**;[6051]At OUT.3B:+13L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK

	;Continued on next page
	;Continued from previous page

	;VFU ERROR OCCURED

OUTE.4:	TXNE	S,VFULOD		;Are we already loading VFU?
;**;[6051]At OUTE.4:+1L change 3 lines  JCR  11/29/89
	JRST	[$QWTO	(VFU error while loading VFU,,@JOBOBA(T4),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Yes
		JRST SHUTIN]		;[6051]Kill this stream
	$QWTOR  (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4),<$WTPID(JOBPID)>) ;[6051]
	SETZM	JOBCHK(T4)		;SAY WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD(T4)		;  update the status also
	$DSCHD(PSF%OR)			;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED?
;**;[6051]At OUTE.4:+8L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH?
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK?
	JRST	OUTE.4			;NO,,STUPID OPERATOR SO TRY AGAIN
	MOVE	S2,STREAM		;Get the stream number
	SETOM	JOBUPD(S2)		;Yes, update the stream's status
	PUSHJ	P,OUTE.3		;GO PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLVT(J)		;FORCE A VFU RELOAD
	PUSHJ	P,LODVFU		;GO RELOAD THE VFU
;**;[6051]At OUTE.4:+18L  change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

CONANS:	$STAB
	 KEYTAB	(0,PROCEED)
	$ETAB
ENDRSP:	ASCIZ	/Type 'RESPOND <number> PROCEED' when ready/ ;[6012]


OUTDIE:	SOSL	J$LERR(J)		;COUNT DOWN ERRORS
	POPJ	P,			;STILL ALIVE
	MOVE	S1,STREAM		;GET STREAM NUMBER
;**;[6051]At OUTDIE:+3L change 1 line  JCR  11/29/89
	$QWTO  (Too Many Device Errors,,@JOBOBA(S1),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]
DIE:	MOVEI	S1,%RSUDE		;GET DEVICE DOES NOT EXIST BIT.
	PUSHJ	P,RSETUP		;TELL QUASAR PRINTER IS OUT TO LUNCH.
	PJRST	SHUTIN			;AND SHUT IT DOWN
	SUBTTL	Printer Output -- Tape Routines

; Write a tape mark
; Call:	PUSHJ	P,TAPMRK
;
TAPMRK:	SKIPN	J$MTAP(J)		;SPOOLING TO TAPE?
	POPJ	P,			;NO

	MOVE	S1,J$LCHN(J)		;GET JFN
	MOVEI	S2,.MOEOF		;FUNCTION CODE
	SETZ	T1,			;NO SPECIAL ARGUMENTS
	MTOPR				;WRITE A TAPE MARK
	  ERJMP	.+1			;IGNORE ERRORS
	POPJ	P,			;RETURN

; Unload a tape
; Call:	PUSHJ	P,TAPUNL
;
TAPUNL:	SKIPN	J$MTAP(J)		;SPOOLING TO TAPE?
	POPJ	P,			;NO

	MOVE	S1,J$LCHN(J)		;GET JFN
	MOVEI	S2,.MORUL		;FUNCTION CODE
	SETZ	T1,			;NO SPECIAL ARGUMENTS
	MTOPR				;UNLOAD THE TAPE
	  ERJMP	.+1			;IGNORE ERRORS
	POPJ	P,			;RETURN
	SUBTTL	Printer Output -- OUTWON - Wait for on-line

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

OUTWON:	MOVX	S2,PSF%DO		;DEVICE OFFLINE FLAG
	MOVE	S1,STREAM		;AND THE STREAM NUMBER
	TDNN	S2,JOBSTW(S1)		;IS IT OFF-LINE?
	POPJ	P,			;NO, JUST RETURN
;**;[6051]At OUTWON:+4L change 1 line  JCR  11/29/89
	$QWTO(<^T/BELL/>,,@JOBOBA(S1),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Tell the operator
	$DSCHD(0)			;BLOCK FOR DEVICE ONLINE
	POPJ	P,			;NO, RETURN

BELL:	BYTE(7) 07,07,117,146,146
	ASCIZ/line/
	SUBTTL	Printer Output -- OUTREL - Release Device On SHUTDOWN

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

OUTR.1:	MOVE	S1,J$LCHN(J)		;GET THE JFN
	DOBE				;[6005] Wait till TTY output empty
	 ERJMP	.+1			;[6005] Igonre error
	MOVX	S2,.MONOP		;WAIT FOR ALL OUTPUT TO STOP
	SETZM	T1			;NO ARGS
	MTOPR				;DO IT
	ERJMP	.+1			;IGNORE THE ERROR
	PUSHJ	P,TAPMRK		;WRITE A TAPE MARK
	PUSHJ	P,TAPMRK    		;WRITE ANOTHER
	PUSHJ	P,TAPMRK     		;ONE MORE FOR GOOD LUCK
	PUSHJ	P,TAPUNL		;GO UNLOAD THE TAPE
	TXO	S1,CZ%ABT		;LITE THE ABORT BIT
	CLOSF				;CLOSE DOWN THE MAG TAPE
	JFCL				;IGNORE THE ERROR
	$RETT				;AND RETURN
	SUBTTL	Printer Output -- OUTEOF - Clear The LPT Output Buffers

OUTEOF:
IFN FTDN60,<
	SKIPLE	J$LREM(J)		;DN60 printer?
	JRST	EOF.6			;Yes, handle differently
> ; End of IFN FTDN60

	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MOEOF		;GET THE FLUSH BUFFERS CODE
	SETZM	T1			;NO ARGS
	PUSHJ	P,$MTOPR		;DO IT
	$RETT				;AND RETURN

IFN FTDN60,<

;  End of file for DN60

EOF.6:	MOVE	S1,J$LCHN(J)		;Get handle
	$CALL D60EOF##			;Try to do EOF
	$RETIT				;ok - return
	$D60ER(ERFCO)			;Process the error
	JUMPT	EOF.6			;Try again
	$RETT				;Return but still in trouble
> ; End of IFN FTDN60
	SUBTTL	Printer Output -- OUTDMP - Dump Out Buffers and Wait

OUTDMP:	PUSHJ	P,OUTOUT		;DUMP THE INTERNAL BUFFERS
	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	JRST	OUTDM1			;[6005] Yes so don't set width to inf
	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MONOP		;AND NO-OP FUNCTION
	SETZM	T1			;ZAP AC 3
	PUSHJ	P,$MTOPR		;DO IT
	SKIPT				;OK,,CONTINUE
	PUSHJ	P,OUTERR		;ELSE GO PROCESS THE ERROR
OUTDM1:	$RETT				;AND RETURN
	SUBTTL	Printer Output -- OUTFLS - Flush Already Buffered Output

;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE PRINTER WHICH HAS ALREADY BEEN
;	BUFFERED (AND POSSIBLE SENT TO THE PRINTER).

OUTFLS:
IFN FTDN60,<
	MOVE	S1,J$LREM(J)		;Get printer type
	CAMN	S1,[.JDN60]		;[6000]DN60 type?
	JRST	OUTF.2			;Go and only reset buffers
> ;End of FTDN60

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

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

IFN FTDN60,<
OUTF.2:	$CALL	OUTRES			;Reset output buffers
	$RETT				;All to do for DN60
> ;End of FTDN60
	SUBTTL	Printer Output -- LPT Control Routines


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

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

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

FORTAB:	FORCHR	" ",.CHLFD,1
	FORCHR	"0",.CHLFD,2
	FORCHR	"1",.CHFFD,1
	FORCHR	"2",20,1
	FORCHR	"3",13,1
	FORCHR	"/",24,1
	FORCHR	"*",23,1
	FORCHR	"+",.CHCRT,1
	FORCHR	54,21,1
	FORCHR	"-",.CHLFD,3
	FORCHR	".",22,1
		NFORCH==.-FORTAB
	SUBTTL	Printer Output -- FILOUT - Set Up For LPTIN and LPTOUT

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

FILOUT:	MOVE	T1,J$FLIN(J)		;START AT TOP OF PAGE
	MOVEM	T1,J$XPOS(J)		;SAVE IT
	PUSHJ	P,SETPFT		;SETUP FILE TYPE
	PUSHJ	P,(T1)			;DISPATCH
	TXNN	S,RQB			;HAVE WE BEEN REQUEUED?
	SKIPE	J$XTOP(J)		;OR ARE WE AT TOP-OF-FORM?
	POPJ	P,			;YES TO EITHER,,JUST RETURN
	AOS	J$APRT(J)		;NO, CHARGE HIM FOR THE REST
	AOS	J$RNPP(J)		;HERE ALSO
	POPJ	P,			;AND RETURN
	SUBTTL	Printer Output -- SETLST - Compile Code For /REPORT

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



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


;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA:	PUSHJ	P,INPBYT
SETLSB:	JUMPF	.RETT
SETLSC:	CAIE	C,0
SETLSD:	JRST	FLUSH7
	SUBTTL	Printer Output -- SETPFT - Setup File Processing Type

;CALLED TO DETERMINE WHICH TYPE OF PROCESSING SHOULD BE DONE ON THE
;	INPUT FILE.
;
;RETURNS WITH T1 CONTAINING  ADDRESS OF PROCESSING ROUTINE AS FOLLOWS:
;
;	LPTOCT	<-->	/PRINT:OCTAL
;	LPTCOB	<-->	/FILE:COBOL
;	LPTFOR	<-->	/FILE:FORTRAN /PRINT:(ARROW,ASCII,SUPPRESS)
;	LPTRPT	<-->	/FILE:ASCII /REPORT:XXX /PRINT:(ARROW,ASCII,SUP)
;	LPTASC	<-->	/FILE:ASCII /PRINT:(ARROW,ASCII,SUPPRESS)
;	LPTELV	<-->	/FILE:ELEVEN

;THE DETERMINATION IS DONE IN THE ABOVE ORDER


SETPFT:	LOAD	S1,.FPINF(E),FP.FFF	;GET /FILE
	LOAD	S2,.FPINF(E),FP.FPF	;GET /PRINT
	TXZ	S,ARROW			;CLEAR SOME INITIAL FLAGS
	TXO	S,NEWLIN!FCONV		;AND SET SOME OTHERS

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

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

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

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

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

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


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

LPTA.2:	AOSL	J$PRNT(J)		;Add to the check for eol counter
	$CALL	CHKMOT			;Check if eol has been detected
	ILDB	C,J$DBPT(J)		;GET A CHARACTER
	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTA.5			;NO, GO HANDLE SPECIAL CHARS
	TXNE	S,FORWRD		;ARE WE FORWARD SPACING?
	JRST	LPTASC			;YES,,SKIP THIS.
	SETZM	J$XTOP(J)		;CLEAR TOF FLAG
LPTA.3:	SOSGE	J$LBCT(J)		;ANY ROOM IN BUFFER?
	JRST	LPTA.4			;NO, FILL IT
	IDPB	C,J$LBPT(J)		;YES, DEPOSIT IN BUFFER
	JRST	LPTASC			;AND GET ANOTHER

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

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

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

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

LPTE.3:	AOSL	J$PRNT(J)		;Add to the check for eol counter
	$CALL	CHKMOT			;Check if eol has been detected
	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTE.6			;NO, GO HANDLE SPECIAL CHARS
	TXNE	S,FORWRD		;ARE WE FORWARD SPACING?
	POPJ	P,			;YES,,SKIP THIS.
	SETZM	J$XTOP(J)		;CLEAR TOF FLAG
LPTE.4:	SOSGE	J$LBCT(J)		;ANY ROOM IN BUFFER?
	JRST	LPTE.5			;NO, FILL IT
	IDPB	C,J$LBPT(J)		;YES, DEPOSIT IN BUFFER
	POPJ	P,			;AND GET ANOTHER

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

LPTE.6:	PUSHJ	P,CHKSP			;GO HANDLE SPECIAL CHARS
	POPJ	P,			;AND LOOP AROUND
	SUBTTL	Printer Output -- LPTFOR - Process FORTRAN Data Files

LPTFOR:	SOSLE	J$DBCT(J)		;AND CHARACTERS LEFT
	JRST	LPTF.1			;YUP, GET THEM
	PUSHJ	P,INPBUF		;NO, GET MORE DATA
	JUMPF	.RETT			;RETURN AT EOF
LPTF.1:	AOSL	J$PRNT(J)		;Add to the check for eol counter
	$CALL	CHKMOT			;Check if eol has been detected
	ILDB	C,J$DBPT(J)		;GET ONE
	JUMPE	C,LPTFOR		;IGNORE NULLS
	TXZE	S,FCONV			;CHECK FOR CTL CHAR
	JRST	FORCNV			;GO DO IT
	CAIN	C,.CHLFD		;LINEFEED?
	TXOA	S,FCONV!LFTMAR		;FLAG NEXT CHAR AS CTL CHAR
	PUSHJ	P,LPTOUT		;OTHERWISE PRINT IT
	JRST	LPTFOR			;AND LOOP AROUND AGAIN.

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

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

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

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

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


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

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

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

COBOL5:	MOVEI	C,.CHFFD		;GET A FORM FEED.
	PUSHJ	P,DEVOUT		;PUT IT OUT.
	$RETT				;AND RETURN.
	SUBTTL	Printer Output -- Character Interrogation Routines

;SUBROUTINE TO PLACE A CHAR ON THE LINE PRINTER
;CALL WITH:
;	PUSHJ	P,LPTOUT
;	RETURN HERE (EOF SET IF OVER LIMIT)

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

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




;HERE TO THROW AWAY A LINE

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


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

;HERE TO PROCESS A FORM FEED
DOFORM:	SKIPE	J$XTOP(J)		;SKIP IF NOT AT TOP OF FORM
	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	SKIPA				;[6005] Not at top, or top and TTY
	POPJ	P,			;[6005] Do not print blank page on LPT
	MOVN	S1,J$XPOS(J)		;THIS TAKES ALL WE HAVE ON PAGE
	SKIPL	S1			;WAS VPOS NEGATIVE?
	CLEAR	S1,			;DONT CHARGE FOR ANYTHING THEN.
					;THIS MIGHT GIVE THE USER A
					;BONUS OF 1-3 FREE LINES.
	JRST	CNTDWN			;COUNT DOWN THE LIMIT

;HERE IF /PRINT:SUPPRESS
DOSUP:	MOVEI	C,.CHLFD		;MAKE IT A LINEFEED, REGARDLESS
	SKIPE	J$XTOP(J)		;SKIP IF NOT TOP
	POPJ	P,			;ONLY 1 LINE FEED IN A ROW
;**;[6046]At DOSUP:+3L delete 1 line JYCW 1/16/89
	SETO	S1,
	JRST	CNTDWN			;CHARGE FOR THE LINE

;HERE TO DO ARROW MODE STUFF IF NEEDED
CHKARO:	TXNN	S,ARROW!SUPJOB		;ARROW MODE (From OPR SUPPRESS comd
	JRST	DEVOUT			;NO--JUST PRINT
DOARO:	PUSH	P,C			;SAVE C
	MOVEI	C,"^"			;LOAD A ^
	PUSHJ	P,DEVOUT		;PRINT THE ^
	POP	P,C			;RESTORE C
	MOVEI	C,100(C)		;MAKE INTO REAL LETTER
	PJRST	DEVOUT			;PRINT

;HERE ON A DC3
DODC3:	SETOM	S1			;DC3 SKIPS 1 LINE
	JRST	CNTDWN			;AND COUNT DOWN

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

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

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

CNTDW1:	MOVE	S1,J$FLIN(J)		;BACK TO TOP OF PAGE
	MOVEM	S1,J$XPOS(J)		;SAVE POSITION
	SOSG	J$FPIG(J)		;DECREMENT THE FORWARD SPACING COUNT.
	JRST	[TXZ	S,FORWRD	;TURN OFF THE FORWARD SPACE BIT.
		 SKIPE	J$FPIG(J)	;DID WE JUST FINISH FORWRD SPACE
		 JRST	.+1		;NO, CONTINUE
		 PUSHJ	P,SENDFF	;JUST FINISH, SEND A FF
		 SETZM	C		;ZAP THE CHARACTER
		 JRST	.+1]		;AND CONTINUE
	AOS	J$RNPP(J)		;ADD 1 TO PAGES PER COPY COUNTER
	TXNE	S,FORWRD		;FORWARD SPACING?
	JRST	CNTDW2			;Continue on
	AOS	J$APRT(J)		;NO,,ADD 1 TO TOTAL PAGES COUNTER

	;Continued on next page
	;Continued from previous page

	;Here we keep track of where we are for backspaceing

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

CNTDW3:	PUSH	P,C			;SAVE THE CURRENT CHAR
	PUSHJ	P,CHKALN		;CHECK FOR ALIGNMENT
	POP	P,C			;RESTORE THE OLD CHARACTER
	MOVEI	S1,3			;LOAD A 3
	CAIN	C,23			;GET HERE VIA DC3?
	ADDM	S1,J$XPOS(J)		;YES, GIVE HIM 3 XTRA LINES
	CAIE	C,23			;WAS IT A DC3
	JRST	[SKIPG	J$FPIG(J)	;FORWARD SPACE?
		 SETOM	J$XTOP(J)	;NO, SET TOP OF FORM
		 JRST	.+1]		;CONTINUE
	$CALL	LIMCHK			;Go check the limit
	JUMPT	DEVOUT			;Output character and return (not here)
	$CALL	INPFEF			;Error - force an EOF
	$RET
	SUBTTL	Printer Output -- LIMCHK - Check On Page Limits

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

	;DEFAULT TO ASK IF NOT IGNORE OR CANCEL

LIMC.1:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT
	SETOM	JOBUPD(S1)		;UPDATE THE STATUS ALSO
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
	IFSKP.				;[6044]
;**;[6051]At LIMC.1:+5L change 3 lines  JCR  11/29/89
	  $QWTOR(Page Limit Exceeded,<^I/RMJOBI/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(JOBPID)>) ;[6051]
	ELSE.				;[6051]
	  $QWTOR(Page Limit Exceeded,<^R/.EQJBB(J)/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(JOBPID)>) ;[6051]
	ENDIF.				;[6044]
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED?
	JRST	LIMC.2			;YES,,IGNORE THE ERROR
	MOVEI	S1,LIMANS		;POINT TO THE LIMIT ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH?
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK?
	JRST	LIMC.1			;NO,,STUPID OPERATOR SO TRY AGAIN
	MOVE	S2,STREAM		;Get the stream number
	SETOM	JOBUPD(S2)		;Yes, update the stream's status
	HRRZ	S1,0(S1)		;GET THE ROUTINE ADDRESS
	JRST	0(S1)			;AND PROCESS THE RESPONSE

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

	;IF ANSWER WAS 'PROCEED' COME HERE

LIMC.2:	MOVX	S1,.STIGN		;YES,,GET THE IGNORE BITS
	STOLIM	S1,.EQLIM(J),FLEA	;SAVE IT AS NEW LIMIT EX ACTION
;**;[6051]At LIMC.2:+2L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]May need to send a Null ACK

	;IF ANSWER WAS 'ABORT' COME HERE

LIMC.3:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
;**;[6051]At LIMC.3:+2L change 4 lines  JCR  11/29/89
	IFSKP.				;[6051]
	  $QWTO(Aborting,<^I/RMJOBI/>,@JOBOBA(S1),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]TELL THE OPERATOR
	ELSE.				;[6051]
	  $QWTO(Aborting,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]TELL THE OPERATOR
	ENDIF.				;[6044]

LIMC.4:	$TEXT(LOGCHR,<^I/LPERR/Page Limit Exceeded>)
	SETZM	J$XTOP(J)		;CLEAR TOP-OF-FORM FLAG
	PUSHJ	P,SENDFF		;SEND A FORM FEED
	TXO	S,ABORT			;LIGHT THE ABORT BIT
	$RETF				;Limit exceeded, don't continue

LIMC.5:	$RETT				;OK to proceed

LIMANS:	$STAB
	 KEYTAB	(LIMC.3,ABORT)		;ABORT
	 KEYTAB	(LIMC.2,PROCEED)	;PROCEED
	$ETAB

LIMSG:	ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue printing/ ;[6012]
	;SUBROUTINE TO DETERMINE IF EOL CHARACTER HAS BEEN DETECTED
CHKMOT:	MOVE	S1,J$WITH(J)		;Pick up the counter size
	MOVEM	S1,J$PRNT(J)		;Reset the eol counter
	TXZE	S,LFTMAR		;EOL character been detected?
	$RET				;Yes
CHKM2:	MOVE	S1,STREAM		;Pick up the stream number
;**;[6051]At CHKM2:+1L change 1 line  JCR  11/29/89
	$QWTOR(<Unprintable line detected>,<^T/CONMSG/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(JOBPID)>) ;[6051]
	SETZM	JOBCHK(S1)		;Checkpoint 
	SETOM	JOBUPD(S1)		;Send update also
	$DSCHD (PSF%OR)			;Wait for OPERATOR respond
	TXNE	S,ABORT+RQB		;Canceled or requeued?
;**;[6051]At CHKM2:+6L change 1 line  JCR  11/29/89
	PJRST	SNDNUL			;[6051]Yes, may need to send a Null ACK
	MOVEI	S1,LONLIN		;Point to response possibilities
	HRROI	S2,J$RESP(J)		;Point to operator's response
	$CALL	S%TBLK			;See if have valid response
	TXNE	S2,TL%NOM+TL%AMB	;Match
	JRST	CHKM2			;No, try again
	MOVE	S2,STREAM		;Get the stream number
	SETOM	JOBUPD(S2)		;Yes, update the stream's status
	HRRZ	S1,0(S1)		;Pick up processing routine adr
	JRST	0(S1)			;Go do it
CHKM3:  SETZM	S1			;Zero out
	TLO	S1,(1B0)		;Pick up a large negative number
	MOVEM	S1,J$PRNT(J)		;A very large file
;**;[6051]At CHKM4:+0L replace 8 lines with 10 lines  JCR  11/29/89
CHKM4:	PJRST	SNDNUL			;[6051]May need to send a Null ACK
CHKM5:	SETZM	JOBITS			;[6051]Turn off the Status bits
	SKIPE	IMESS			;[6051]Any messages?
	$CALL	C%REL			;[6051]Yes, so cancel
	SETZM	IMESS			;[6051]No outstanding messages
	TXNE	S,GOODBY+ABORT		;[6051]Job being aborted?
	PJRST	SNDNUL			;[6051]Yes, may need to send a Null ACK	
	SETOM	J$OPRA(J)		;[6051]OPERATOR canceled this job
	$CALL	KILL			;[6051]This job is being aborted
	$RET				;[6051]And return

LONLIN:	$STAB				;
	KEYTAB (CHKM5,ABORT)		;
	KEYTAB (CHKM4,ASK)		;
	KEYTAB (CHKM3,PROCEED)		;
	$ETAB				;
;**;[6051]At CONMSG:+3L replace 2 lines with 1 line  JCR  11/29/89
CONMSG:	ASCIZ/
Type 'RESPOND <number> ABORT' to terminate printing of the job
Type 'RESPOND <number> ASK' to continue printing  with checking
Type 'RESPOND <number> PROCEED' to continue printing with no checking/ ;[6051]
	;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
;	PUSHJ	P,DEVOUT
;	RETURN HERE (HALTS IF ERROR)
;

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

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

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


CHKALN:	SKIPL	J$APRG(J)		;IS AN ALIGNMENT SCHEDULED?
	POPJ	P,			;NO,,RETURN.
	PUSHJ	P,ALIGN			;YES,,THEN DO IT.
	$RETT				;RETURN TO HIS CALLER.
	SUBTTL	Printer Output -- Subroutines to Send Messages To Output Device

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


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


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


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

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

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

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

;JOB HEADERS AND TRAILERS

JOBTRL:	MOVEI	T4,[ASCIZ /END/]	;ADDRESS OF END TEXT
	TXNE	S,RQB			;CLEAR REQUE AND SKIP IF NOT SET
	MOVEI	T4,[ASCIZ /REQUE/] 	;SAY SO
	PUSHJ	P,GIVHDR		;GO SETUP THE LINE
	JRST	TRAILR			;AND NOW GO PRINT THE TRAILER

JOBHDR:	MOVEI	T4,LPTERR		;ALLOW FOR LPT ERRORS HERE
	MOVEM	T4,J$LERR(J)		;STORE COUNTER
	MOVEI	T4,[ASCIZ /START/]	;ADDRESS OF START TEXT
	PUSHJ	P,GIVHDR		;GO SET THE LINE
	JRST	BANNER			;AND GO PRINT THE BANNER PAGES

GIVHDR:	SKIPL	J$REMR(J)		;[6044]REQUEST ORIGINATE REMOTELY?
	IFSKP.				;[6044]
	  $TEXT	(<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^I/RMJOBI/ Date ^H/[-1]/ Monitor ^T65L /LPCNF/^A>) 
	ELSE.				;[6044]
	  $TEXT	(<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^R/.EQJBB(J)/ Date ^H/[-1]/ Monitor ^T65L /LPCNF/^A>) 
	ENDIF.				;[6044]
	MOVE	S1,J$FWID(J)		;GET THE PAGE WIDTH
	SUBI	S1,10			;[6022] Back over the *stuff*
	MOVEI	S2,J$XHBF(J)		;[6022] Point to start of string
	HRLI	S2,(Point 7)		;[6022] Make that a byte pointer
	ADJBP	S1,S2			;[6022] Point to the last-7th column
	MOVEM	S1,TEXTBP		;[6022] Save it there
	$TEXT	(DEPBP,< ^T7C*/0(T4)/^0>) ;[6022] Put the *stuff* at end
	$RETT				;RETURN.
	SUBTTL	Printer Output -- BANNER - Print A Banner

BANNER:	PUSHJ	P,.SAVE3		;SAVE P1 THRU P3
	SKIPN	P3,J$FBAN(J)		;GET NUMBER OF BANNER PAGES
	POPJ	P,			;RETURN WHEN DONE

	$TEXT(<-1,,J$PUSR(J)>,<^T/.EQOWN(J)/^0>) ;[6012] Copy user name over

BANN.1:	PUSHJ	P,SENDFF		;SEND A FORM FEED
	SETZM	J$XPOS(J)		;AND SET 0 POSITION
;[6012]	MOVEI	T1,4			;LOAD AN OFFSET
;[6012]	CAIN	P3,1			;IS THIS THE LAST BANNER?
;[6012]	ADDM	T1,J$XPOS(J)		;YES, DON'T PRINT OVER CREASE
	PUSHJ	P,BANN.2		;PRINT A BANNER PAGE
	SOJG	P3,BANN.1		;AND LOOP
	POPJ	P,			;RETURN

BANN.2:	PUSHJ	P,PLPBUF		;PRINT A LINE
	MOVE	S1,J$TCHR+$TDFLG(J)	;[6005] Get flag bits
	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	TXNE	S1,FL$FUL		;[6005] Full banner,header,trailer?
	SKIPA				;[6005] Yes, full pages or real printer
	JRST	BANN.3			;[6005] Yes, first line and note only
	PUSHJ	P,PLPBUF		;PRINT ANOTHER LINE
	PUSHJ	P,CRLF			;TYPE A CRLF
	MOVEI	S1,1			;LOAD THE BLOCKSIZE
	MOVEI	S2,J$PUSR(J)		;AND THE STRING ADDRESS
	PUSHJ	P,PICTUR		;AND PRINT A PICTURE
	MOVEI	T1,^D12			;COUNT'EM
	ADDM	T1,J$XPOS(J)		;...
	PUSHJ	P,PLPBUF		;PRINT A LINE
	PUSHJ	P,PLPBUF		;AND ANOTHER
	PUSHJ	P,PLPBUF		;AND A THIRD
BANN.3:	MOVEI	T1,[0,,0]		;LOAD A NULL.
	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAIN	S1,3			;ROOM ENOUGH FOR THE TITLE?
	MOVEI	T1,[ASCIZ /Note:/]	;YES, LOAD IT
	GETLIM	T2,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	JUMPE	T2,PLINES		;NO NOTE, FINISH THE PAGE
	GETLIM	T3,.EQLIM(J),NOT2	;AND THE SECOND HALF
	$TEXT(<-1,,J$PNOT(J)>,<^T/0(T1)/^W6/T2/^W/T3/^0>)
	MOVEI	S1,1			;GET THE BLOCKSIZE
	MOVEI	S2,J$PNOT(J)		;GET THE ADDRESS
	PUSHJ	P,PICTUR		;AND SEND IT OUT
	MOVEI	S1,^D11			;LOAD NUMBER OF LINES
	ADDM	S1,J$XPOS(J)		;AND MOVE DOWN THE PAGE
	PJRST	PLINES			;GO TO EOP AND RETURN
	SUBTTL	Printer Output -- TRAILR - Print a Trailer

TRAILR:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	MOVE	P3,J$FTRA(J)		;AND THE NUMBER OF TRAILERS
	TXNE	S,SUPFIL!SUPJOB		;Are we suppressing forms?
	SETZM	J$XTOP(J)		;Don't believe we are at top of forms.
	PUSHJ	P,SENDFF		;SEND A FORMFEED
	JUMPE	P3,OUTDMP		;RETURN IF ZERO

TRAI.1:	SETZM	J$XPOS(J)		;[6012] Clear the vertical position
	PUSHJ	P,TRAI.3		;PRINT THE INTERNAL LOG
	PUSHJ	P,PLINES		;PRINT TILL END OF PAGE
	$CALL	SENDFF			;[6012] Send a final form feed
	SOJG	P3,TRAI.1		;LOOP UNTIL DONE
	PJRST	OUTDMP			;AND DUMP BUFFERS AND RETURN
;HERE TO PRINT THE INTERNAL LOG

TRAI.3:	SKIPN	J$GNLN(J)		;ANYTHING IN THE INTERNAL LOG?
	POPJ	P,			;NO, RETURN
	PUSHJ	P,PLPBUF		;YES PRINT A LINE
	MOVE	S1,J$TCHR+$TDFLG(J)	;[6005] Get flag bits
	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	TXNE	S1,FL$FUL		;[6005] Full banner,header,trailer?
	SKIPA				;[6005] Yes, full pages or real printer
	PJRST	SENDFF			;[6005] Yes, save paper on selected TTY
	PUSHJ	P,PLPBUF		;AND ANOTHER LINE
	MOVEI	C,.CHTAB		;LOAD A TAB
	MOVE	T1,J$FWCL(J)		;GET THE WIDTH CLASS
	PUSHJ	P,DEVOUT		;PRINT A TAB
	SOJG	T1,.-1			;PRINT N OF THEM
	MOVEI	S1,[ASCIZ /* * * L P T S P L  R u n  L o g * * *

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

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

PLINES:	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	POPJ	P,			;[6005] YES, SAVE PAPER AND LAYOUT
	MOVE	T2,J$FLIN(J)		;GET LINES/PAGE
	ADDI	T2,1			;ACCOUNT FOR MARGIN
	SUB	T2,J$XPOS(J)		;SUBTRACT AMOUNT PRINTED
	JUMPLE	T2,PEOP			;JUMP IF DONE
	IDIVI	T2,4			;ELSE GET NUMBER OF LINES TO PRINT
PLINE1:	SOJL	T2,PEOP			;JUMP IF DONE
	PUSHJ	P,PLPBUF		;PRINT A LINE (4 LINES)
	JRST	PLINE1			;AND LOOP

PEOP:	MOVE	T2,J$FLIN(J)		;GET NUMBER OF LINES/PAGE
	SUB	T2,J$XPOS(J)		;SUBTRACT THOSE PRINTED
	ADDI	T2,1			;COUNT THE MARGIN
	SKIPE	J$LREM(J)		;[6005] IS THIS A REMOTE LPT ???
	POPJ	P,			;[6005] YES,,RETURN
PEOP1:	JUMPLE	T2,PEOP2		;GO FINISH OFF
	PUSHJ	P,CR23			;PRINT A CR23
	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,^D132		;[6022] Is it reasonable?
	MOVEI	P3,^D132		;[6022] Now it is
PEOP4:	ILDB	C,P2			;GET A CHARACTER
	PUSHJ	P,DEVOUT		;PUT A CHARACTER
	SOJG	P3,PEOP4		;LOOP
	PUSHJ	P,CR23			;SEND LF OR DC3
	AOBJN	P1,PEOP3		;LOOP FOR ALL RULER LINES
	POPJ	P,			;AND RETURN

CR23:	SKIPE	J$MTAP(J)		;SPOOLING TO TAPE?
	JRST	CRLF			;YES,,JUST INSERT CRLF
	MOVEI	S1,[BYTE (7) 15,23,0,0,0] ;PRINT OUT CR23
	SKIPA				;SKIP CRLF ENTRY POINT
CRLF:	MOVEI	S1,[BYTE (7) 15,12,0,0,0] ;PRINT AT CRLF
	PUSHJ	P,STGOUT		;PUT IT OUT
	$RET				;AND RETURN
	SUBTTL	Printer Output -- STARS - Job Separation Lines

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


STARS1:	ASCII	/000000000000000000000000000000000000000000000000000000000000/
	ASCII	/000000000000000000000000000000000000000111111111111111111111/
	ASCIZ	/111111111111/		;[6022] 

STARS2:	ASCII	/000000000111111111122222222223333333333444444444455555555556/
	ASCII	/666666666777777777788888888889999999999000000000011111111112/
	ASCIZ	/222222222333/		;[6022] 

STARS3:	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCIZ	/123456789012/		;[6022] 
	SUBTTL	Printer Output -- HEAD - Generate File-Header Pages

HEAD:	PUSHJ	P,.SAVE3		;SAVE SOME ACS
	TXNE	S,SUPFIL!SUPJOB		;Are we suppressing forms?
	SETZM	J$XTOP(J)		;Don't believe we are at top of forms.
	LOAD	P1,.FPINF(E),FP.NFH	;GET THE NO HEADER BIT
	SKIPE	P1			;SKIP IF WE WANT HEADERS
	JRST	[MOVE	S1,J$FPIG(J)	;GET THE /BEGIN:X PAGES
		CAIG	S1,1		;NO PAGES
		PUSHJ	P,SENDFF	;SEND FORM FEED
		PJRST	OUTDMP]		;DUMP BUFFERS AND RETURN
	PUSHJ	P,SENDFF		;NOW SEND A FORM FEED
	SKIPN	P3,J$FHEA(J)		;GET NUMBER OF PICTURE PAGES
	PJRST	OUTDMP			;DUMP BUFFERS AND RETURN
	PUSHJ	P,SETHDR		;SETUP THE FILENAME FOR BLOCK LETTERS
	PUSHJ	P,HEAD.1		;PRINT THE HEADER
	SOJG	P3,.-1			;LOOP FOR THE WHOLE WORKS
	PJRST	OUTDMP			;FORCE EVERYTHING OUT, AND RETURN

HEAD.1:	MOVE	S1,J$TCHR+$TDFLG(J)	;[6005] Get flag bits
	TXNE	S,LATSPL!TTYSPL		;[6013] LAT or TTY
	TXNE	S1,FL$FUL		;[6005] Full banner,header,trailer?
	SKIPA				;[6005] Yes, full pages or real printer
	JRST	HEAD.2			;[6005] Yes, no block letters
	MOVE	S1,J$PFLS(J)		;GET BLOCKSIZE
	MOVEI	S2,J$PFL1(J)		;AND ADDRESS OF FIRST LINE
	PUSHJ	P,PICTUR		;PRINT THE LINE
	MOVE	S1,J$PFLS(J)		;[6012] Get blocksize
	MOVEI	S2,J$PFL2(J)		;[6012] and address of second line
	PUSHJ	P,PICTUR		;[6012] and print the second line

HEAD.2:	MOVE	P1,J$FWCL(J)		;LOAD THE WIDTH CLASS
	MOVEI	S1,J$XHBF(J)		;LOAD ADDRESS OF BANNER LINE
	PUSHJ	P,STGOUT		;AND SEND IT
	MOVE	S1,J$DIFN(J)		;GET THE IFN
	MOVX	S2,FI.CRE		;WANT CREATION TIME
	PUSHJ	P,F%INFO		;GET IT
	MOVEI	S2,[ASCIZ / /]		;GET A STRING
	CAIE	P1,3			;WIDTH CLASS 3?
	MOVEI	S2,[BYTE (7) .CHCRT,.CHLFD,.CHTAB,0]
	MOVE	P1,S2			;Remember for short or long lines
	MOVE	T1,J$TFIL(J)		;[6000]PICK UP IF TEMPORARY FILE OR NOT
	$TEXT(TBFCHR,<^M^JFile ^I/@FILTYP(T1)/, created: ^H/S1/,^T/(P1)/printed: ^H/[-1]/>)
	PUSHJ	P,TBFDMP		;AND DUMP THE BUFFER

	GETLIM	S1,.EQLIM(J),FORM	;GET FORMS NAME
	$TEXT(TBFCHR,<Job parameters: Request created:^H/.EQAFT(J)/   Page limit:^D/J$RLIM(J)/^T/(P1)/  Forms:^W/S1/  Account:^T/.EQACT(J)/^A>)

	;Continued on next page
	;Continued from previous page

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

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


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

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

SPCTAB:	SIXBIT	/SINGLE/
	SIXBIT	/DOUBLE/
	SIXBIT	/TRIPLE/
	SUBTTL	Printer Output -- SETHDR - Setup Header Name For File

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

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

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

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

	;Continued on next page
	;Continued from previous page

;Here if not log file and not report

SETH.2:
SETH.3:	MOVE	P1,[POINT 7,J$PFL1(J)]	;GET THE FILENAME BYTE PTR
	MOVE	P2,[POINT 7,J$PFL2(J)]	;GET THE EXTEN BYTE PTR
	MOVX	S1,GJ%SHT!GJ%OFG	;PARSE-ONLY + SHORT-GTJFN
	MOVE	S2,J$DFDA(J)		;GET THE FD ADDRESS
	SKIPE	J$TFIL(J)		;[6000]IS THIS A TEMPORARY FILE?
	MOVE	S2,J$ORFD(J)		;[6000]YES, SO PICK UP ORIGINAL FD	
	HRROI	S2,.FDFIL(S2)		;AND POINT TO THE FILESPEC
	GTJFN				;GET A JFN FOR THE FILE
	 ERJMP	SETH.S			;ERROR,,GIVE NON-DESCRIPT NAME
	EXCH	S1,P1			;SAVE JFN IN P1, GET POINTER IN S1
	MOVE	S2,P1			;GET JFN IN S2
	MOVX	T1,1B8			;FILENAME ONLY
	JFNS				;GET IT
	MOVE	S1,P2			;GET THE 2ND LINE POINTER
	MOVE	S2,P1			;GET THE JFN
	MOVX	T1,1B11			;EXTENSION ONLY
	JFNS				;GET THE EXTENSION
	MOVEI	T2,"."			;FIRST, LOAD A BLANK
	IDPB	T2,S1			;AND DEPOSIT IT
	MOVX	T1,1B14			;GET THE GENERATION NUMBER
	JFNS				;DO IT
	MOVE	S1,P1			;GET THE JFN
	RLJFN				;RELEASE IT
	ERJMP	.+1			;IGNORE THE ERROR

	;Continued on next page
	;Continued from previous page

;Check to see if this is a spooled printer file and if so repair the filename
;to remove the junk that makes it unique.

	LOAD	S1,.FPINF(E),FP.SPL	;GET THE SPOOL BIT
	JUMPE	S1,SETH.W		;IF NOT SPOOLED, THERE WE'RE DONE

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

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

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

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

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

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

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

SETH.W:	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAMLE	S1,J$FLCL(J)		;Compare with the length class
	MOVE	S1,J$FLCL(J)		;Use the min. of the two.
	MOVE	S2,J$PFL1+1(J)		;GET 2ND WORD OF LINE 1
	IOR	S2,J$PFL2+1(J)		;OR IN SECOND WORD OF LINE 2
	TLNN	S2,003760		;[6011]IS THE 7TH CHAR THERE IN EITHER?
	TXNE	S,TTYSPL!LATSPL		;[6012] No, is it a TTY?
	MOVEI	S1,1			;YES, USE BLOCKSIZE 1
	MOVEM	S1,J$PFLS(J)		;SAVE IT
	$RETT				;AND RETURN
	SUBTTL	Printer Output -- PICTUR - Print Block Letters

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

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

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

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

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

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

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

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

PICT.6:	POP	P,T4			;RESTORE T4
	PJRST	CRLF			;TYPE A CR AND RETURN
CHRTAB:	BYTE (5) 00,00,00,00,00,00,00	;SP
	BYTE (5) 04,04,04,04,04,00,04	;!
	BYTE (5) 12,12,00,00,00,00,00	;"
	BYTE (5) 12,12,37,12,37,12,12	;#
	BYTE (5) 04,37,24,37,05,37,04	;$
	BYTE (5) 31,31,02,04,10,23,23	;%
	BYTE (5) 10,24,10,24,23,22,15	;&
	BYTE (5) 06,02,00,00,00,00,00	;'
	BYTE (5) 04,10,20,20,20,10,04	;(
	BYTE (5) 04,02,01,01,01,02,04	;)
	BYTE (5) 00,25,16,33,16,25,00	;*
	BYTE (5) 00,04,04,37,04,04,00	;+
	BYTE (5) 00,00,00,00,00,06,02	;,
	BYTE (5) 00,00,00,37,00,00,00	;-
	BYTE (5) 00,00,00,00,00,06,06	;.
	BYTE (5) 00,00,01,02,04,10,20	;/

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

	BYTE (5) 16,21,21,27,25,25,07	;@
	BYTE (5) 16,21,21,21,37,21,21	;A
	BYTE (5) 36,21,21,36,21,21,36	;B
	BYTE (5) 17,20,20,20,20,20,17	;C
	BYTE (5) 36,21,21,21,21,21,36	;D
	BYTE (5) 37,20,20,36,20,20,37	;E
	BYTE (5) 37,20,20,36,20,20,20	;F
	BYTE (5) 17,20,20,20,27,21,16	;G
	BYTE (5) 21,21,21,37,21,21,21	;H
	BYTE (5) 16,04,04,04,04,04,16	;I
	BYTE (5) 01,01,01,01,21,21,16	;J
	BYTE (5) 21,21,22,34,22,21,21	;K
	BYTE (5) 20,20,20,20,20,20,37	;L
	BYTE (5) 21,33,25,21,21,21,21	;M
	BYTE (5) 21,21,31,25,23,21,21	;N
	BYTE (5) 16,21,21,21,21,21,16	;O
	BYTE (5) 36,21,21,36,20,20,20	;P
	BYTE (5) 16,21,21,21,25,22,15	;Q
	BYTE (5) 36,21,21,36,24,22,21	;R
	BYTE (5) 17,20,20,16,01,01,36	;S
	BYTE (5) 37,04,04,04,04,04,04	;T
	BYTE (5) 21,21,21,21,21,21,37	;U
	BYTE (5) 21,21,21,21,21,12,04	;V
	BYTE (5) 21,21,21,21,25,33,21	;W
	BYTE (5) 21,21,12,04,12,21,21	;X
	BYTE (5) 21,21,12,04,04,04,04	;Y
	BYTE (5) 37,01,02,04,10,20,37	;Z
	BYTE (5) 14,10,10,10,10,10,14	;[
	BYTE (5) 00,00,20,10,04,02,01	;\
	BYTE (5) 06,02,02,02,02,02,06	;]
	BYTE (5) 04,12,21,00,00,00,00	;^
	BYTE (5) 00,00,00,00,00,00,37	;_

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

	BYTE (5) 04,10,10,20,10,10,04	;OPEN BRACE
	BYTE (5) 04,04,04,00,04,04,04	;VERTICAL BAR
	BYTE (5) 04,02,02,01,02,02,04	;CLOSE BRACE
	BYTE (5) 00,10,25,02,00,00,00	;TILDE
	BYTE (5) 00,00,00,00,00,00,00	;RUBOUT
	SUBTTL	Interrupt System -- Initialization

INTINI:	MOVE	S1,[1,,ENDFRK]		;[6000]INFERIOR FORK TERMINATION
	MOVEM	S1,CHNTAB+.ICIFT	;[6000]PLACE IN THE CHANNEL TABLE
	MOVEI	S1,.FHSLF		;[6000]PICK UP THE FORK HANDLE
	MOVX	S2,1B0!1B1!1B2!1B3!1B19	;[6000]CHANNELS 0, 1, 2, 3 AND 19
	AIC%				;[6000]ACTIVATE THE CHANNELS
	 ERJMP	INII.1			;[6001] Catch error
	$RET				;[6000]AND RETURN

INII.1:	$STOP(CAI,Can't activate the interrupt system) ;[6001]
	SUBTTL	Interrupt System -- Connect Lineprinter

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

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

	SKIPN	J,JOBPAG		;DOES A STREAM EXIST?
	$DEBRK				;NO,,JUST FINISH UP HERE.
	JRST	INTDON			;FINISH UP -20 INTERRUPT PROCESSING.
	SUBTTL	Interrupt System -- Device Interrupt

;Here on device interrupts on the -20.  Since all i/o is done by calling a
;subroutine, if an interrupt occurs while we are i/o active, we don't want to
;just DEBRK back into the SOUT (unless we are processing a remote LPT).  For
;local LPTs, we just want to return from the subroutine, with the updated byte
;pointer and byte count.  This is why we alter the return PC for local LPTs if
;we are i/o active.  In this case we just return to the calling routine
;(OUTOUT).

INTDEV:	$BGINT	1,			;SETUP FOR INTERRUPT
	SKIPN	J,JOBPAG		;DOES A STREAM EXIST?
	$DEBRK				;NO,,DEBREAK
	SETZM	JOBCHK			;SAY WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD			;  update the status also
	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MORST		;READ-STATUS FUNCTION
	MOVEI	T1,T2			;AND ADDRESS OF ARGS
	MOVEI	T2,3			;LENGTH OF ARG BLOCK
	PUSHJ	P,$MTOPR		;GET THE LPT STATUS
	MOVX	S1,PSF%DO		;DEVICE OFFLINE FLAG
	ANDCAM	S1,JOBSTW		;CLEAR THE VALUE
	TXNE	T3,MO%OL		;IS IT OFF-LINE?
	IORM	S1,JOBSTW		;YES, SET FLAG
INTDON:	SKIPE	J$LREM(J)		;IS THIS A REMOTE PRINTER?
	JRST	INTD.1			;YES,,SKIP THIS 'LOCAL' STUFF
	MOVEI	S1,.RETT		;YES,,POINT TO EXIT ADDRESS
	SKIPE	J$LIOA(J)		;WERE WE I/O ACTIVE?
	MOVEM	S1,LEV1PC		;DEBRK ADDRESS, SO SAVE IT.
INTD.1:	SETZM	J$LIOA(J)		;CLEAR I/O ACTIVE.
	$DEBRK				;DISMISS THE INTERRUPT.
	SUBTTL	DN60 Routines -- Local/Remote I/O Subroutines

$SOUT:	SETOM	J$LIOA(J)		;INDICATE I/O IS ACTIVE
	SKIPE	JOBSTW			;ANY STATUS BITS SET?
	JRST	SOUT.T			;YES,,RETURN NOW
	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT?
	JRST	SOUT.6			;[6001] Yes, must be a DN60
	SOUT				;LOCAL,,ISSUE THE SOUT NORMALLY
	 ERJMP	SOUT.F			;ON ERROR,,TAKE FAIL RETURN
SOUT.T:	SETZM	J$LIOA(J)		;CLEAR I/O ACTIVE
	$RETT				;AND RETURN
SOUT.F:	SETZM	J$LIOA(J)		;CLEAR I/O ACTIVE
	$RETF				;AND RETURN

$GTJFN:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT?
	JRST	GTJF.6			;[6001] Yes, must be DN60
	GTJFN				;LOCAL,,ISSUE THE GTJFN NORMALLY
	$RETF				;NO GOOD,,RETURN FALSE
	$RETT				;ELSE RETURN OK

$OPENF:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT?
	JRST	OPEN.6			;[6001] Yes, must be DN60
	OPENF				;LOCAL,,OPEN THE LPT NORMALLY
	$RETF				;NO GOOD,,RETURN FALSE
	$RETT				;ELSE RETURN OK

$CLOSF:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT?
	JRST	CLOS.6			;[6001] Yes, must be DN60
	CLOSF				;LOCAL,,CLOSE IT DOWN NORMALLY
	$RETF				;NO GOOD,,RETURN FALSE
	$RETT				;ELSE RETURN OK

$MTOPR:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT?
	JRST	MTOP.6			;[6001] Yes, must be DN60
	MTOPR				;LOCAL,,DO THE MTOPR NORMALLY
	ERJMP	.RETF			;ON AN ERROR,,RETURN NO GOOD
	$RETT				;ELSE RETURN OK

	;Continued on next page
	;Continued from previous page

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

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

IFN FTDN60,<

SOUT.6:	SETZM	J$LIOA(J)		;ZAP I/O ACTIVE (NONE FOR DN60)
	PUSHJ	P,D60SOUT##		;OUTPUT THE DATA
	JUMPT	[$CALL D60SU		;Process success
		$RETT]			;Return
	$D60ER(ERDOE)			;Process the error
	$RETIT				;Return if good error
	$CALL	DIE			;One bad error is too many, and do not
					;  return

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

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

OPEN.6:	SETOM	J$LINK(J)		;INDICATE NO OPR MSG LIST YET
	SETZM	J$OMSG(J)		;Indicate no operator messages either
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;GET OUR OBJECT BLOCK ADDRESS
	MOVE	S1,OBJ.UN(S1)		;GET OUR UNIT NUMBER
	STORE	S1,J$D6OB(J),OP$UNT	;SAVE THE UNIT NUMBER IN OPEN BLOCK
	MOVX	S1,.OPLPT		;WANT 'LPT' DEVICE
	STORE	S1,J$D6OB(J),OP$TYP	;SAVE THE DEVICE TYPE IN THE OPEN BLOCK
	LOAD	S1,J$DCND(J),CN$PRT	;GET THE PORT NUMBER
	STORE	S1,J$D6OB(J),OP$PRT	;SAVE IT IN THE OPEN BLOCK
	LOAD	S1,J$DCND(J),CN$LIN	;GET THE LINE NUMBER
	STORE	S1,J$D6OB(J),OP$LIN	;SAVE IT IN THE OPEN BLOCK
	LOAD	S1,J$DCND(J),CN$SIG	;GET THE LINE SIGNATURE
	STORE	S1,J$D6OB(J),OP$SIG	;SAVE IT IN THE OPEN BLOCK
OPN6.1:	HRROI	S1,-OP$SIZ		;GET THE NEGATIVE BLOCK LENGTH
	MOVEI	S2,J$D6OB(J)		;GET THE PARM BLOCK ADDRESS
	PUSHJ	P,D60OPN##		;OPEN THE PRINTER
	JUMPF	[$D60ER(ERCOP)		;Process the error
		$RETIF			;Return if bad error
		JRST	OPN6.1]		;Try again
	$CALL	D60SU			;Successful counters

	MOVEM	S1,J$LCHN(J)		;SAVE THE LPT HANDLE
	HRLZI	S1,.OPCOU		;WANT OUTPUT CONSOLE FOR REMOTE
	MOVEM	S1,J$D6OB(J)		;SAVE THE DEV-TYP,,UNIT NUMBER IN WORD 0
OPN6.2:	HRROI	S1,-OP$SIZ		;GET THE NEGATIVE PARM BLOCK LENGTH
	MOVEI	S2,J$D6OB(J)		;GET THE PARM BLOCK ADDRESS
	PUSHJ	P,D60OPN##		;OPEN THE OUTPUT CONSOLE
	JUMPT	OPN6.4			;o.k.  proceed
	$D60ER(ERCOC)			;Process the error
	JUMPT	OPN6.2			;Good error, try again

	;Continued on next page
	;Continued from previous page

; Need to release LPT since can't get console

OPN6.3:	MOVE	S1,J$LCHN(J)		;Get LPT id
	$CALL	D60RLS##		;Try to release it
	JUMPF	[$D60ER(ERCRP)		;Process the error
		JUMPT	OPN6.3		;Try again
		$RETF]			;Quit
	$RETF				;Return false in any case
OPN6.4:	$CALL	D60SU			;Successful check counters
	MOVEM	S1,J$D6OP(J)		;SAVE THE OPERATORS CONSOLE ID
	PUSHJ	P,L%CLST		;CREATE A LIST FOR OPERATOR MESSAGES
	MOVEM	S1,J$LINK(J)		;SAVE THE LIST ID
	$RETT				;AND RETURN

MTOP.6:	CAXE	S2,.MOEOF		;IS THIS END OF FILE?
	$RETT				;NO,,JUST RETURN
	$CALL	EOF.6			;Do the EOF
	$RETT				;AND RETURN

CLOS.6:	SETZM	J$OMSG(J)		;No more operator msgs.
	MOVEI	S1,NENBR		;Want this to terminate
	MOVEM	S1,J$ENBR(J)		;Set a threshold
CLO6.1:	MOVE	S1,J$LCHN(J)		;MAKE SURE WE HAVE JUST THE HANDLE
	PUSHJ	P,D60RLS##		;CLOSE DOWN THE DN60
	JUMPF	[$D60ER(ERCRP)		;process error
		JUMPT	CLO6.1		;Try again if approp.
		JRST	CLO6.2]		;Try to continue
CLO6.2:	MOVE	S1,J$D6OP(J)		;GET THE CONSOLE ID
	PUSHJ	P,D60RLS##		;CLOSE DOWN THE OPERATORS CONSOLE
	JUMPF	[$D60ER(ERCRC)		;process error
		JUMPT	CLO6.2		;Try again if approp.
		JRST	CLO6.3]		;Try to continue
	$CALL	D60SU			;fix counts
CLO6.3:	SKIPL	S1,J$LINK(J)		;CHECK AND GET THE OPERATORS LIST ID
	PUSHJ	P,L%DLST		;DELETE THE LIST IF THERE IS ONE
	$RETT				;AND RETURN (NO JFN HERE)
	SUBTTL	DN60 Routines -- D60SU - DN60 Success Routine To Fix Counts

;purpose:	To maintain counters etc. relating to a successful
;		DN60 return

; Parameters:	J / Address of current jobpage

D60SU:	$SAVE	<S1,S2,T1>		;Save some registers
	SKIPN	J$OFLN(J)		;Were we offline before this?
	$RETT				;No - just return
	SETZM	J$OFLN(J)		;Clear off-line flag
	MOVE	T1,STREAM		;Get current stream number
	CAMN	J,JOBPAG(T1)		;Are we setup?
	SETOM	JOBUPD(T1)		;Request status update
	$RETT				;Return
	SUBTTL	DN60 Routines -- D60ER/D60OE - Process DN60 errors

; The purpose of D60ER is to process DN60 errors that deal with
; LPT device (operator console are processed as part of the routine
; OPRCHK).  The following actions are taken:

; 1.  Determine if error is "good" i.e. D6DOL or D6NBR
; 2.  If good error has overflowed threshold, then it is a bad error
; 3.  If good, DSCHD and then return true

; - Bad error --

; 4.  Output error message if requested
; 5.  Return false

; The purpose/use of D60OE is the same as D60ER except the DSCHD must
; not occur.

; Parameters:

;	S1 / Last DN60 error
;	(P) / Error message address

;	Called by $D60ER macro

;		$D60ER (msg)
;		    Where msg is either error message address or
;					0 for no error to be output

D60OE:	SETOM	OPRERR			;This is an operator error
	SKIPA
D60ER:	SETZM	OPRERR			;This is the normal stream error
	MOVEM	S1,J$D6ER(J)		;Save the last DN60 error

	;Continued on next page
	;Continued from previous page

;NBR error?

	CAIE	S1,D6NBR		;Non-blocking return?
	JRST	D60E.1			;no, go process other
	SKIPGE	J$ENBR(J)		;Do we care about errors?
	JRST	D60E.6			;No, skip this
	SOSG	J$ENBR(J)		;Out of errors?
	JRST	D60E.3			;Yes - process bad error
	JRST	D60E.6			;No, go process good error

;OAB error?

D60E.1:	CAIE	S1,D6OAB		;Output abort error?
	JRST	D60E.2			;No, go try for other
	SKIPE	OPRERR			;Is this during operator output?
	$RETT				;Yes, ignore it

;  Here when abort occurs in printer stream.
;  Requeue current job and shutdown stream.

	MOVE	S1,STREAM		;Get the stream number
	$WTO	(<Job terminated due to IBMCOM output abort>,,@JOBOBA(S1))
	MOVEI	S1,%RSUNA		;Set the unit unavailable
	$CALL	RSETUP			;Cause the current job to be requeued
	PJRST	SHUTIN			;Shut the stream down till restarted

;DOL error?

D60E.2:	MOVE	TF,STREAM		;Get the stream number
	SKIPL	J$OFLN(J)		;Are we already off line?
	SETOM	JOBUPD(TF)		;No, indicate need for status message
	SETOM	J$OFLN(J)		;Indicate we are offline at least
	CAIN	S1,D6DOL		;Device off-line error?
	JRST	D60E.6			;Yes, finish processing good error
					;Else continue and process bad error

	;Continued on next page
	;Continued from previous page

;Bad error

D60E.3:	MOVEM	T1,EMSG			;Save T1 a second
	HRRZ	T1,@0(P)		;Get error message
	SKIPN	T1			;Want error message output?
	JRST	[MOVE	T1,EMSG		;No - Restore T1
		JRST	D60E.5]		;and return
	EXCH	T1,EMSG			;Save error message
	$SAVE	<T1,T2>			;Get a couple of free registers
	MOVE	T2,STREAM		;Get current stream
	SUBI	S1,$ER1ST		;Set DN60 error message
	MOVE	T1,EMSG			;Get error message again
	$WTO	(<^T/0(T1)/>,<^T/@D60TXT(S1)/>,@JOBOBA(T2)) ;Yes tell opr
D60E.5:	$RETF

;  Here on DOL or NBR error, set new sleeptime based on polling estimate

D60E.6:	$SAVE	<S1,S2,T1>		;Save some acs
	$CALL	I%NOW			;Get the current time
	ADD	S1,POLEST##		;Get wakeup time from D60JSY
	SKIPE	OPRERR			;Are we at a console error?
	JRST	[MOVEM	S1,J$CWKT(J)	;Yes, set that wakeup time
		$CALL	CHKTIM		;Adjust sleeptime
		JRST D60E.8]		;And rejoin common code
	MOVE	S2,STREAM		;Get the stream number
	MOVEM	S1,JOBWKT(S2)		;Save job wake time
	$CALL	CHKTIM			;Adjust sleep time
	SKIPE	S1,SLEEPT		;Get sleep time if any
	$CALL	I%SLP			;Have some, sleep
	SETOM	SLEEPT			;And reset sleep time
D60E.8:	$RETT				;And quit good
> ;End of IFN FTDN60

IFE FTDN60,<
SOUT.6:
GTJF.6:
OPEN.6:
MTOP.6:
CLOS.6:
GDST.6:
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(DN60 Type Remote not Supported,,@JOBOBA(S1))
	$RETF				;RETURN
> ;End of IFE FTDN60
	SUBTTL	DN60 Routines -- IBMSTS - Send IBMCOM Statistics Message

;  Given the statistics code in S1, this routine sends the message to
;  QUASAR.

;  Parameters:

;	S1 / Code type

;  Uses:

;	S1 and any ACs used by the send to QUASAR routine.
;	T1 is needed as a parameter and is restored.

;  Returns after QUASAR send routine without changing TF
;  Simply returns if statistics are not wanted.

IBMSTS:
IFN FTIBMS,<
	$SAVE	T1			;Save T1
	MOVEM	S1,IBMSTM+MSHSIZ	;Save the statistics code in
					;the message
	MOVEI	T1,IBMSTM		;Get the address of message
	$CALL	SNDQSR			;Send it off to QUASAR
> ;End of FTIBMS
	$RET				;Pass any errors up
PRCHMS:	ASCIZ	/
Type 'RESPOND <number> NO' to terminate the START command
Type 'RESPOND <number> YES' to use default
Type 'RESPOND <number> terminal characteristic' to use specified
terminal characteristics/

PRCHAN:	$STAB
	 KEYTAB (TTYG.N,NO)
	 KEYTAB (TTYG.Y,YES)
	$ETAB
	SUBTTL	Terminal Spooling -- TTYGET - Setup A Terminal Printer

;TTYGET - Start a TTY printer.
;Accepts - S1/device designator
;Returns 

TTYGET:	SETZM	J$TDEV(J)		;NO DEVICE DESIGNATOR YET
	ASND				;TRY TO ASSIGN THE TERMINAL LINE
	PJRST	TTYERR			;[6016]Take error return if unavailable

	MOVEM	S1,J$TDEV(J)		;SAVE THE DEVICE DESIGNATOR
	MOVE	S1,SUP.CR(M)		;GET TERMINAL CHARACTERISTIC
	MOVEM	S1,J$TTYC(J)		;SAVE IT
;**;[6052]At TTYGET:+6L add 2 lines  JYCW 12/6/89
	$CALL	LATCHA			;[6052]Check for /TERMINAL-CHARACT
	JUMPF	TTYER			;[6052]Operator aborted
	$CALL	TTYG			;[6016]Go setup the terminal printer
	JUMPF	TTYERR			;[6016]Something went wrong
	PUSHJ	P,OUTRES		;SETUP THE OUTPUT POINTERS
	PJRST	OUTG.1			;NOW WE FAKE TO BE A LINE PRINTER

;**;[6052]At TTYGET:+11L add 1 line  JYCW 12/6/89
TTYER:	TDZA 	T1,T1			;[6052]No errors
TTYERR:	MOVE	T1,S1			;[6016]SAVE THE ERROR CODE
	SKIPE	S1,J$LCHN(J)		;[6016]GET THE JFN
	RLJFN				;[6016]RELEASE IT
	JFCL				;[6016]IGNORE THE ERROR
	SKIPN	S1,T1			;[6017]Do we have a TOPS-20 error?
	JRST	TTYER1			;[6017]No
	MOVE	S2,STREAM		;[6016]GET OUR STREAM NUMBER
;**;[6051]At TTYER1:-1L change 1 line  JCR  11/29/89
	$QWTO (<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2),<$WTACK(JOBPID)>);[6051]Tell the operator
TTYER1:	PJRST	OUTDDE			;[6016]GIVE UP THE SHIP
	SUBTTL	Terminal Spooling -- LATCHA - Setup the terminal for output

;**;[6052]At TTYER1+1L add rotuine LATCHA  JYCw 12/6/89
;LATCHA - Check for /TERMINAL-CHARACTERISTIC: switch in START command
;Loop through terminal data base for correct terminal characteristic

LATCHA:	SKIPE	S2,J$TTYC(J)		;[6052]GET THE TERMINAL CHARACTERISTIC
	JRST	LATCH2			;[6052]GO FIND IT 

;LATCH0 - Will send a WTOR asking the operator to identify the terminal
;characteristics that we are trying to setup.

;Setup AC 2 before calling this routine

LATCH0:	MOVE	S1,STREAM		;[6052]GET STREAM NUMBER
	SETZM	JOBCHK(S1)		;[6052]SAY WE WANT CHECKPOINT
	SETOM	JOBUPD(S1)		;[6052] AND UPDATE STATUS
	MOVE	T1,DEFPRI		;[6052]GET THE ASCIZ  DEFAULT NAME
	$QWTOR	(<^M^JTerminal characteristic not found ^W/S2/. Default ^W/T1/ being used>,<^T/PRCHMS/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(JOBPID)>) ;[6052][6011]Tell the OPR
	$DSCHD	(PSF%OR)		;[6052]Wait for OPERATOR RESPONSE

	MOVEI	S1,PRCHAN		;[6052]POINT TO THE CONTINUE ANSWER BLK
	HRROI	S2,J$RESP(J)		;[6052]POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;[6052]DO THEY MATCH
	TXNE	S2,TL%NOM+TL%AMB	;[6052]DID WE FIND IT OK ???
	JRST	LATCH1			;[6052]NO, MUST HAVE TYPE IN ONE
	MOVE	S2,STREAM		;[6052]Get the stream number
	SETOM	JOBUPD(S2)		;[6052]Yes, update the stream's status
	HRRZ	S1,0(S1)		;[6052]GET THE ROUTINE ADDRESS
	JRST	0(S1)			;[6052]AND PROCESS THE RESPONSE

LATCH1:	HRROI	S1,J$RESP(J)		;[6052]POINT TO THE ANSWER
	PUSHJ	P,S%SIXB		;[6052]CONVERT IT TO SIXBIT
LATCH2:	MOVEM	S2,J$TTYC(J)		;[6052][6011][6013]Save The TTY charact
	MOVEI	S1,TABEND		;[6052]GET AOBJN POINTER
	MOVEI	T4,TTYTAB		;[6052]GET ADDRESS OF TERMINAL CHARACT
LATCH3:	CAMN	S2,$TDCHR(T4)		;[6052]SAME?
	JRST	LATCH4			;[6052]YES
	ADDI	T4,$TDLEN		;[6052]NO, GO TO THE NEXT ONE
	SOJG	S1,LATCH3		;[6052]NEXT
	JRST	LATCH0			;[6052]NOT HERE, GO ASK THE OPERATOR

	;Continued on next page
	;Continued from previous page

;We have a match

LATCH4:	MOVEI	S2,J$TCHR(J)		;[6052]GET DESTINATION OF BLT INTO S2
	HRLI	S2,(T4)			;[6052]MAKE A BLT POINTER
	MOVEI	S1,J$TCHR(J)		;[6052][6011]GET START OF TTY CHARACT
					;  BLK
	BLT	S2,$TDLEN-1(S1)		;[6052]BLT THE TERMINAL BLOCK
	$RETT				;[6052]

;**;[6052]Move label TTYG:
TTYG:	MOVE	S1,J$TDEV(J)		;[6052]GET DEVICE DESINGATOR
	MOVE	S2,J$TCHR+$TDTYP(J) 	;GET THE TERMINAL TYPE
	STTYP%				;SET THE TERMINAL TYPE
	 ERJMP	TTYG.4			;
	JRST	TTYG.5			;

TTYG.4:	JUMPL	S2,TTYG.6		;IF NEGATIVE, NOT A SPOOLER
	MOVEI	S2,.TTDEF		;NUMBER NOT DEFINED IN STG, USE DEFAULT
	STTYP%				;
	 ERJMP	.+1			;SHOULDN'T FAILED

TTYG.5:	MOVE	S2,J$TCHR+$TDFLG(J)	;[6011]GET FLAG BITS
	TXNN	S2,FL$XOF+FL$POL	;POLLING NEEDED, OR XON/XOFF PROTOCOL ?
	JRST	TTYG.7			;NO, OTHERS NOT SUPPORTED YET
	SETZ	T3,			;CLEAR PRINTER STATUS BITS
	TXNN	S2,FL$PGM+FL$VFU	;PROGRAMMABLE TERMINAL ?
	TXO	T3,MO%LVU		;NO, FAKE OPTICAL
	MOVX	S2,OF%WR+OF%RD+7B5	;OPEN FOR R/W SEVEN BIT BYTES
	MOVE	S1,J$LCHN(J)		;GET JFN
	OPENF				;OPEN THE TERMINAL
	 $RETF				;[6016]Error
	MOVEI	S2,.MOSNT		;DO WE WANT SYSTEM MESSAGES ?
	MOVEI	T1,.MOSMN		;NO
	MTOPR				;SET SYSTEM MESSAGE FLAG
	 ERJMP	.+1
	MOVEI	S2,.MOXOF		;DO WE WANT PAUSE-END-PAGE ?
	MOVEI	T1,.MOOFF		;NO
	MTOPR				;SET PAUSE-END-PAGE FLAG
	 ERJMP	.+1
	DMOVE	S2,J$TCHR+$TDCC1(J)	;[6011]GET THE TERMINAL CCOC WORDS
	SKIPE	S2			;[6011]ANYTHING THERE ?
	SFCOC				;YES, SET CONTROL CHAR OUTP CONT WORD
	 ERJMP	.+1
	SKIPE	S2,J$TCHR+$TDMOD(J)	;[6011]GET THE MODE WORD (IF ANY)
	STPAR				;SET TERMINAL DEVICE MODE
	MOVX	S2,FLD(.TTASC,TT%DAM)	;DISCARD SUPPLIED PROGRAM RELATED MODE
	SFMOD				;
	 ERJMP	.+1
	RFMOD				;READ THE MODE WORD AGAIN
	 ERJMP	.+1
	TXNE	S2,TT%LCA		;DOES TERMINAL HAVE LOWER CASE ?
	TXO	T3,MO%LCP		;YES
	TXNE	S2,TT%MFF		;DOES TERMINAL HAVE MECHANICAL FORMS ?
	TXZ	S2,TT%LEN		;YES, NO SIMULATED PAGING
	TXO	S2,TT%PGM		;ENABLE XON/XOFF
	STPAR				; 
	 ERJMP	.+1
	SFMOD				;MAKE LINE CHARACTERISTICS OK
	 ERJMP	.+1
	HRRZ	S1,J$TDEV(J)		;GET DEVICE DESIGNATOR
	ADDI	S1,.TTDES		;MAKE TTY DESIGNATOR
	TXO	S1,TL%SAB!TL%STA	;SET RECEIVE ADVICE/LINK
	TLINK				; TO REFUSE
	 ERJMP	.+1			;IGNORE ERRORS
	$RETT				;[6016]Return success 
	SUBTTL	Terminal Spooling -- TTYG.6 - error handler for TTYG.

; Error handling routines

TTYG.6:	MOVX	S1,.FHSLF		; 
	GETER				;GET MOST RECENT ERROR IN OUR PROCES
	HRRZ	T1,S2			;REMEMBER ERROR CODE
	MOVE	S1,J$LCHN(J)		;NO,,GET THE JFN AGAIN
	TXO	S1,CZ%ABT		;ABORT ALL OUTPUT OPERATIONS
	PUSHJ	P,$CLOSF		;CLOSE IT DOWN
	$RETT				;NO,, RETURN
	MOVE	S1,T1			;RESTORE THE ERROR CODE TO S1
TTYG.7:	MOVE	S2,STREAM		;GET OUR STREAM NUMBER
;**;[6051]At TTYG.7:+1L change 1 line  JCR  11/29/89
	$QWTO(<Initialization failed for ^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2),<$WTACK(JOBPID)>);[6051]
	$RETF				;[6016]GIVE UP THIS TERMINAL

;USE DEFAULT
TTYG.Y:	MOVE	S2,DEFPRI		;GET THE DEFAULT NAME
	JRST	LATCH2			;GO USE DEFAULT

;ABORT START COMMAND
;**;[6052]At TTYG.N:+0L replace 4 lines with 1 JYCW 12/6/89
TTYG.N:	MOVX	S1,%RSUDE		;[6052]Shut it down
	$RETF
	SUBTTL	Terminal Spooling -- CHKTTY - Check TTY Status

CHKTTY:	SKIPN	J$LCHN(J)		;[6041]Do we have a printer
	$RETT				;[6041]No
	MOVE	S1,J$TCHR+$TDFLG(J)	;GET FLAG BITS
	TXNN	S1,FL$POL		;POLLING NEEDED ?
	JRST	CHKTT9			;NO,GO SEE IF VFU SHOULD BE LOADED
	MOVE	S1,J$LCHN(J)		;GET THE JFN OF THE TERMINAL
	DOBE				;MAKE SURE FINISHED OUTPUT
	 ERJMP	.+1			;[6041]Don't care about error
	CFIBF				;CLEAR FILE INPUT BUFFER
	 ERJMP	.+1			;[6041]Don't care about error
	MOVEI	T1,^D5			;LOOP FOR 5 PERIODS
CHKTT1:	MOVE	S1,J$LCHN(J)		;GET THE JFN OF THE TERMINAL
	HLRZ	S2,J$TCHR+$TDPOL(J)	;GET THE POLLING CHARACTER
	BOUT				;SEND POLLING CHARACTER
	 ERJMP	.+1			;[6041]Don't care about error
	MOVEI	S1,^D1000		;WAIT OFR A SECOND
	DISMS
	MOVE	S1,J$LCHN(J)		;GET TTY JFN
	SIBE				;ANY RESPONSE ?
	 JRST	CHKTT3			;YES, GO CHECK THE REPLY
CHKTT2:	SOJG	T1,CHKTT1		;KEEP TRYING
	JUMPE	S2,.RETT		;[6011]NOT A TTY MUST BE A PRINTER
	JRST	TTYOFL			;AFTER 5 SECONDS COMPLAIN
CHKTT3:	PUSHJ	P,CHKTT6		;CORRECT ANSWER ?
	 JRST	CHKTT2			; NO
CHKTT9:	PUSHJ	P,PGMTTY		; CHECK IF WE HAVE TO PROGRAM VFU
	$RETT				;DEVICE IS ONLINE

	;Continued on next page
	;Continued from previous page

TTYOFL:	MOVX	S1,PSF%DO		;GET DEVICE OFFLINE BIT
	ORM	S1,JOBSTW		;ARE ANY STATUS BITS SET ???
;**;[6051]At TTYOFL:+2L change 1 line  JCR  11/29/89
	$QWTO	(<^T/BELL/>,,@JOBOBA,<$WTACK(JOBPID),$WTFLG(WT.SUP)>);[6051]Tell OPR device is offline
	SETZM	JOBCHK(S1)		;TAKE A CHECKPOINT WHEN WE CAN
	SETOM	JOBUPD(S1)		;  update status also
	$CALL	DSTATU			;SEND A STATUS UPDATE
CHKTT4:	MOVE	S1,J$LCHN(J)		;GET THE JFN OF THE TERMINAL
	HLRZ	S2,J$TCHR+$TDPOL(J)	;GET THE POLLING CHARACTER
	BOUT				;SEND POLLING CHARACTER
	MOVEI	S1,^D1000		;WAIT OFR A SECOND
	DISMS
	MOVE	S1,J$LCHN(J)		;GET TTY JFN
	SIBE				;ANY RESPONSE ?
	 JRST	CHKTT5			;YES, GO CHECK THE REPLY
	MOVEI	S1,^D10000		;NO, TRY AGAIN
	DISMS				;AFTER 10 SECOND
	JRST	CHKTT4			;KEEP TRYING
CHKTT5:	PUSHJ	P,CHKTT6		;CORRECT ANSWER ?
	 JRST	CHKTT4			; NO
	PUSHJ	P,PGMTTY		; CHECK IF WE HAVE TO PROGRAM VFU
	JRST	TTYONL			; YES
CHKTT6:	MOVE	S1,J$LCHN(J)		;GET THE JFN OF THE TERMINAL
	BIN				;GET REPLY FROM TERMINAL
	HRRZ	S1,J$TCHR+$TDPOL(J)	;GET THE EXPECTED CHARACTER
	SKIPE	S1			;IF NO EXPECTED DEFINED, ACCEPT ALL
	CAMN	S1,S2			;REPLY EQUALS EXPECTED CHARACTER ?
	AOS	(P)			; YES, INCREMENT RETURN ADDRESS
	POPJ	P,			; NO, NON-SKIP RETURN
TTYONL:	MOVX	S1,PSF%DO		;GET DEVICE OFFLINE BIT
	ANDCAM	S1,JOBSTW		;ARE ANY STATUS BITS SET ???
	SETZM	JOBCHK(S1)		;TAKE A CHECKPOINT WHEN WE CAN
	SETOM	JOBUPD(S1)		; update status also
	$CALL	DSTATU			;SEND A STATUS UPDATE
	$RETT				;RETURN IF FINALLY ONLINE
PGMTTY:	MOVE	S1,J$TCHR+$TDFLG(J)	;GET FLAG BITS
	TXNE	S1,FL$PGM		;PROGRAM TERMINAL AFTER EACH FILE?
	PUSHJ	P,LODTTY		; YES, REPROGRAM TERMINAL
	$RETT
	SUBTTL	Terminal Spooling -- LODTTY - Load TTY VFU

LODTTY:	HRRZ	S1,J$VJFN(J)		;DO WE HAVE A "VFU" FILE OPEN ?
	JUMPN	S1,LODTT0		; YES, USE IT
	$TEXT(<-1,,J$XTBF(J)>,<SYS:^W/J$FTAP(J)/.VFU^0>)
	MOVX	S1,GJ%OLD+GJ%SHT	;SHORT, OLD FILE ONLY
	HRROI	S2,J$XTBF(J)		;POINT TO STRING
	GTJFN				;GO GET THE JFN FOR THE FILE
	 ERJMP	LODTT2			;ERROR, IGNORE LOADING
	MOVX	S2,FLD(7,OF%BSZ)!OF%RD	;7-BIT READ
	OPENF				;OPEN THE "VFU" FILE
	 JRST	LODTT2			;
	HRRZM	S1,J$VJFN(J)		;REMEMBER THE JFN
	MOVE	S2,[1,,.FBBYV]		;WE WANT TO KNOW BYTE SIZE
	MOVEI	T1,S2			;STORE RESULT IN AC
	GTFDB				;GET IT FROM FILE DESCRIPTOR BLOCK
	LDB	S2,[POINTR(S2,FB%BSZ)]	;GET THE BYTE SIZE
	CAIE	S2,^D7			;SHOULD BE SEVEN BIT ASCII
	JRST	LODTT2			;IGNORE FILE IF NOT 7-BIT
LODTT0:	MOVE	T3,S1			;COPY THE JFN OVER
	MOVEI	S2,0			;POINT TO FIRST BYTE IN FILE
	SFPTR				;REWIND "VFU" FILE
	 JFCL				;
LODTT1:	BIN				;GET "VFU" BYTE
	 ERJMP LODTT2			;ON ERRRO ASSUME END OF FILE
	MOVE	S1,J$LCHN(J)		;GET THE JFN OF THE TERMINAL
	BOUT				;SEND CHARACTER TO TERMINAL
	MOVE	S1,T3			;GET THE VFU JFN ONCE MORE
	JRST LODTT1			;LOOP TILL END OF FILE
LODTT2:	MOVE	T1,J$FTAP(J)		;GET THE VFU TYPE
	MOVEM	T1,J$FLVT(J)		;SAVE AS CURRENTLY LOADED
	POPJ	P,			;AND RETURN
	SUBTTL	Terminal Spooling --  LATGET - Get LAT Printer

; USE THE LATOP% TO ASSIGN A TTY.
;ACCEPTS J OBJECT BLOCK
;RETURNS +1  TRUE if a LAT connection is made and the terminal printer is
;setup.  FALSE if either a LAT connection is made or the terminal printer
;is not setup

LATGET:	SKIPE	J$CID(J)		;[6011]DO WE HAVE A CONNECTION?
	$RETT				;[6011]YES

;  Set up to do LATOP to assign a TTY line.

	SETZ	S1,			;
	SETZ	S2,
	DMOVEM	S1,LATBLK+.LASVC	;[6013]Clear port and service
	HRR	S2,JOBOBJ+OBJ.QN	;[6013]Get header
	HRROI	S1,JOBOBJ+OBJ.QN+1	;POINT TO PORT/SERVICE NAME
	CAIN	S2,.KYPOR		;[6013]Port?
	MOVEM	S1,LATBLK+.LAPRT	;YES, USE PORT
	CAIN	S2,.KYSER		;[6013]Service?
	MOVEM	S1,LATBLK+.LASVC	;YES, USE SERVICE
	$TEXT	(<-1,,J$SERN(J)>,<^W/JOBOBJ+OBJ.ND/^0>)	;[6012]
	HRROI	S1,J$SERN(J)		
	MOVEM	S1,LATBLK+.LASVR	;SAVE IT IN ARG BLK
	MOVEI	S1,7			;GET THE LENGTH
	MOVEM	S1,LATBLK+.LAACT	;SAVE IT IN ARG BLK
	MOVEI	S1,.LARHC		;GET FUNCTION CODE
	MOVEM	S1,LATBLK+.LAFCN	;SAVE IT IN ARG BLK
	SETZM	LATBLK+.LAPRM		;NO PSI
	SETZM	LATBLK+.LAVAL		;NO PSI CHANNEL
	MOVEI	S1,LATBLK		;GET ADDRESS OF LATOP ARG BLOCK
	LATOP%
	 ERJMP  LATERR			;Bad setup.  MONITOR reject call
	MOVE	S1,LATBLK+.LAVAL	;[6013]Get terminal designator
	TXZN	S1,.TTDES		;Do we have one?
	JRST	LATREJ			;NO, LAT BOX REJECT 

	;Continued on next page
	;Continued from previous page

;  We have a terminal designator.  Now make it a device designation
;  Make it an ASCIZ string and SIXBIT string.  use like a terminal printer

LATGE2:	HRLI	S1,.DVDES+.DVTTY	;[6023]Make it device designator
	MOVEM	S1,J$TDEV(J)		;SAVE IT
	MOVE	S2,S1			;GET THE DEVICE DESIGNATOR
	HRROI	S1,J$LSTG(J)		;DESTINATION DESIGNATOR
	DEVST				;CONVERT IT TO ASCIZ STRING
	 ERJMP	.+1			;SHOULD NOT FAIL

	HRROI	S1,J$LSTG(J)		;POINT TO THE ACSIZ STRING
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,J$MTAP(J)		;SAVE IT
	$TEXT	(<-1,,J$LSTG(J)>,<^W/J$MTAP(J)/:^0>) ;[6011]GEN THE DEVICE NAME
	HRRZ	S1,LATBLK+.LAPRM	;GET THE CONNECT ID
	MOVEM	S1,J$CID(J)		;SAVE IT

;  Get a JFN on the terminal.

	SETZM	J$LREM(J)		;FORCE US TO BE LOCAL
	MOVSI	S1,(POINT 7,0)		;[6024]Get 7 bit byte pointer (output)
	MOVEM	S1,J$LBTZ(J)		;SAVE IT FOR LATER
	MOVX	S1,GJ%SHT+GJ%FOU	;GET GTJFN FLAG BITS
	LOAD	S2,IB+IB.FLG,IB.NAC	;Get the access bit value
	SKIPE	DEBUGW			;Debugging?
	SETZ	S2,			;Yes, do not restrict
	STORE	S2,S1,GJ%ACC		;Store as the value of the JFN access
	HRROI	S2,J$LSTG(J)		;POINT TO THE DEVICE NAME
	GTJFN				;GET A JFN
	 JRST	LATERR			;[6013]Cant,,tough breakeee
	MOVEM	S1,J$LCHN(J)		;SAVE THE JFN
	$CALL	TTYG			;[6016]GO SETUP THE TERMINAL.
	JUMPF	LATGER			;[6017]Failed 
	$CALL	OUTRES			;[6016]Setup the output pointer
	PJRST	OUTSOK			;[6016]Now we are a printer
	SUBTTL	Terminal Spooling -- LAT error handling routines

LATGER:	$CALL	TTYERR			;[6017]Report the error and fall down

;LATERR - LATOP JSYS FAILED.  Terminate the START command and shut it down

LATERR:	TXO	S,RQB			;[6016]Requeue the job
	$CALL	LATABT			;[6037]Terminate the connection
	MOVX	S1,%RSUDE		;[6017]Shut it down
	$RETF				;[6016]Error return 

;  LATREJ - The LAT box rejected the host connect.  The recoverable errors are
;  .LASIU (6), "Service is in use", and .LAIAR (13), "Immediate Acceess
;  Rejected" .  In these cases we should inform the  operator, try 5 times to
;  make the connection.  If after 5 times we still get .LASIU shut the stream
;  down, set the object unavailable and tell QUASAR.  If the error is other
;  then .LASIU, shut the device down.
;  Accepts S1/LAT error code
;  If success goto LATGE2: to continue with the setup procedure for a LAT
;  If Fail return false.

LATREJ:	CAIE	S1,.LASIU		;[6013]Is the service in use?
	CAIN	S1,.LAIAR		;[6036]Is it Immediate Access Reject?
	JRST	LATRE0			;[6036]Yes we can recover
	CAIE	S1,.LAIRS		;[6043]Is insufficient resource ?
	CAIN	S1,.LASCS		;[6043]Is start-slot can't be sent?
	JRST	LATRE0			;[6043]Yes we can recover
	$CALL	LATREP			;[6036]No, report error
 	JRST	LATERR			;[6036]and return failure

LATRE0:	$CALL	LATREP			;[6036]Report the error
	MOVEI	T1,5			;[6024]Get LATOP% try counter
LATRY:	MOVEI	S1,^D15			;[6023]Sleep for 15 sec
	PUSHJ	P,I%SLP			;[6023]Go wait
	SETZM	LATBLK+.LAVAL		;[6023]No PSI channel
	MOVEI	S1,LATBLK		;[6023]Get the address of LATBLK
	LATOP%				;[6023]Ask for it
	 ERJMP	LATCF			;[6023]Crash for now
	MOVE	S1,LATBLK+.LAVAL	;[6023]Get terminal designator
	TXZE	S1,.TTDES		;[6023]Do we have one?
	JRST	LATGE2			;[6032]We have a TTY!
	CAIE	S1,.LASIU		;[6023]No, still in use
	CAIN	S1,.LAIAR		;[6036]or immediate access rejected
	SOJG	T1,LATRY		;[6024]Yes, try again
	$CALL	LATREP			;[6023]Report error and return false
	MOVX	S1,%RSUNA		;[6023]Not available right now.
;**;[6051]At LATRY:+14L change 1 line  JCR  11/29/89
	$QWTO (<^T/@SETMSG(S1)/>,,@JOBOBA,<$WTACK(JOBPID)>);[6051]Tell OPR whats going on.
	$RETF

;  LATREP - Prints an error string which corresponds to the LAT error code
;  Accept the LAT error in S1
;  Always return +1

LATREP:	$SAVE	<S1>			;[6013]Save AC S1
	CAIGE	S1,.LAUNK		;[6015]	Within LAT error range?
	JRST	LATRE2			;[6043] No, report unknow LAT error 

	CAIG	S1,.LAIRP		;[6013] Within LAT error range?
	JRST	LATRE1			;[6013] Yes

	CAIE	S1,.LATMO		;[6013] Is it TOPS-20 time out?
	JRST	LATRE2			;[6043] No, report unknow LAT error
	MOVEI	S1,.LAIRP+1		;[6013] Yes, pickup error code

LATRE1:	MOVE	T1,LATETB(S1)		;[6013]Point to the LAT error table 
	MOVE	S1,STREAM		;[6013]Get the stream number
;**;[6051]At LATRE1:+2L change 1 line  JCR  11/29/89
	$QWTO (<LAT error>,<^T/(T1)/>,@JOBOBA(S1),<$WTACK(JOBPID)>);[6051]
	$RETT

LATRE2:	MOVE	S2,STREAM		;[6043]Get the stream number
;**;[6051]At LATRE2:+1L change 1 line  JCR  11/29/89
	$QWTO  (<Unknow LAT error>,<^D/S1/>,@JOBOBA(S2),<$WTACK(JOBPID)>);[6043]
	$RETT
	SUBTTL	Terminal Spooling -- Errors from the LAT BOX for the LATOP% JSYS.

;  LATETB is in LAT error code order.  the zeroth entry is .LAUNK and so on.
;  The last error is the TOPS-20 timed out, since the error code for this is
;  37774, we index into this table with index of 20.
;  The error numbers are in decimal

LATETB:	[ASCIZ/Reason is unknown/]		;[6016] 0 .LAUNK
        [ASCIZ/User requested disconnect/]	;[6016] 1 .LAURD
	[ASCIZ/System shutdown in progress/]	;[6016] 2 .LASSP
	[ASCIZ/Invalid slot received/]	        ;[6016] 3 .LAISR
	[ASCIZ/Invalid service class/]        	;[6016] 4 .LAISC
	[ASCIZ/Insufficient resources to satisfy request/] ;[6016] 5 .LAIRS
	[ASCIZ/Service in use/]	        	;[6016] 6 .LASIU
	[ASCIZ/No such service/]	        ;[6016] 7 .LANSS
        [ASCIZ/Service is disabled/]		;[6016] 8 .LASDI
        [ASCIZ/Service is not offered by requested port/] ;[6016] 9 .LASNP
        [ASCIZ/No such port/]			;[6016] 10 .LANSP
        [ASCIZ/Invalid password/]		;[6016] 11 .LAIPW
        [ASCIZ/Entry is not in the queue/]	;[6016] 12 .LAENQ
        [ASCIZ/Immediate access rejected/]	;[6016] 13 .LAIAR
        [ASCIZ/Access denied/]			;[6016] 14 .LAACD
        [ASCIZ/Corrupted solicit request/]	;[6016] 15 .LACSR
        [ASCIZ/Command message Type is illegal/]  ;[6016] 16 .LACTI
        [ASCIZ/Start-slot Can't be Sent/]	;[6016] 17 .LASCS
        [ASCIZ/Queue entry Deleted by Local node/];[6016] 18 .LAQED
        [ASCIZ/Inconsistant or illegal request parameters/];[6016] 19 .LAIRP
	[ASCIZ/Request has timed out/]		;[6016] 37774 .LATMO 
 
	SUBTTL	Terminal Spooling -- LATTHC - Terminate the LAT connection 

;LATTHC - If we have a LAT connection then we must terminate the connection
;so that others can use the same service/port.  
;LATABT - Terminate the LAT connection when we have an error, therefore abort
;all output first.

LATABT:	TXO	S1,CZ%ABT		;[6037]ABORT ALL OUTPUT OPERATIONS

LATTHC:	HRR	S1,J$LCHN(J)		;[6037]Get the JFN for $CLOSF
	SKIPN	J$CID(J)		;[6016]Do we have a connection?
	JRST	LATTER			;[6016]No just return
;**;[6050]At LATTHC+3L add 1 line  JYCW  5/8/89
;**;[6052]At LATTHC+3L add 1 line  JYCW  12/6/89
	PUSH	P,S1			;[6052]Save the JFN
	CALL	SETPRT			;[6050]Set the printer back to its
					;initial state
;**;[6052]At LATTHC+5L add 1 line  JYCW  12/6/89
	POP	P,S1			;[6052]Get it back
	PUSHJ	P,$CLOSF		;[6014]CLOSE IT DOWN
	MOVEI	S1,.LATHC		;GET TERMINATE FUNCTION
	MOVEM	S1,LATBLK+.LAFCN	;SAVE IT
	MOVEI	S1,LATBLK		;[6011]ARG BLOCK
	LATOP%
	 ERJMP	LATSTP			;[6013]Shouldn't fail
	SETZM	J$CID(J)		;[6011]CLEAR CONNECT ID
LATTER:	SETZM	J$LCHN(J)		;[6042]Clear JFN
	$RETT				;[6013]NO,, RETURN

LATSTP:	$STOP (LTF,LAT termination failed) ;[6023]Crash for now
LATCF: $STOP (LCF,LAT connection failed) ;[6023]Crash for now
	SUBTTL	LAT and TTY support  -- SETPRT -- Set the Printer to its initial state
;**;[6050]At LATCF+1L add routines SETPRT and PORLAN.

;SETPRT - Set the printer to its initial state. 
;Returns +1 always

SETPRT:	MOVE	S1,J$TCHR+$TDFLG(J)	;[6050] Get flag bits
	TXNE	S,LATSPL!TTYSPL		;[6050]LAT or TTY
	TXNN	S1,FL$RST		;[6050]Reset
	RET				;[6050]No
	HRROI	S2,J$TCHR+$TDREP(J)	;[6050]Get the address of reset ESC seq
	MOVE	S1,J$LCHN(J)		;[6050]GET THE LPT JFN
	SETZ	T1,			;[6050]Terminate on null byte
	SOUT				;[6050]Send the ESC seq characters
	 ERJMP .+1			;[6050]Shouldn't fail
	RET				;[6050]All done

;Set the printer to print Landscape or Portrait on a LN03.
;Returns +1 always

PORLAN:	TXNN	S,LATSPL!TTYSPL		;[6050]LAT or TTY
	JRST	PORLAX			;[6050]No
	MOVE	S2,[SIXBIT/LN03/]	;[6050]Load SIXBIT 'LN03'
	CAME	S2,J$TCHR+$TDCHR(J)	;[6050]Are we a LN03?
	JRST	PORLAX			;[6050]No, just return
	MOVE	S1,.EQCHR(J)		;[6050]Get the Characteristic switch
	TXNN	S1,FT%LND		;[6050]Landscape
	JRST	PORLA0			;[6050]No, HAVE to be portrait
	HRROI	S2,LANDFT		;[6050]Yes, point to the ESC seq 
	MOVE	S1,J$LCHN(J)		;[6050]GET THE LPT JFN
	SETZ	T1,			;[6050]Terminate on null byte
	SOUT				;[6050]Send the ESC seq characters
	 ERJMP .+1			;[6050]For Now
	MOVEI	S1,^D132		;[6050]Landscape width is 132 
	MOVEM	S1,J$FWID(J)		;[6050]Set new width
	JRST	PORLAX			;[6050]All done
PORLA0:	HRROI	S2,PORTFT		;[6050]Assume Portrait
	MOVE	S1,J$LCHN(J)		;[6050]GET THE LPT JFN
	SETZ	T1,			;[6050]Terminate on null byte
	SOUT				;[6050]Send the ESC seq characters
	 ERJMP .+1			;[6050]For Now
	MOVEI	S1,^D80			;[6050]portrait width is 80
	MOVEM	S1,J$FWID(J)		;[6050]Set new width
PORLAX:	RET				;[6050]
	SUBTTL	End of LPTSPL

LPTEND::END	LPTSPL