Google
 

Trailing-Edge - PDP-10 Archives - bb-d868e-bm_tops20_v41_2020_dist_1of2 - language-sources/lptspl.mac
There are 45 other files named lptspl.mac in the archive. Click here to see a list.
	TITLE	LPTSPL - TOPS10/TOPS20 LINE PRINTER DRIVER

;
ASCIZ /
         COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
	   1975,1976,1977,1978,1979,1980,1981,1982
/
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.
;

	SEARCH	GLXMAC			;SEARCH GALAXY PARAMETERS
	PROLOGUE(LPTSPL)
	SEARCH	QSRMAC			;SEARCH QUASAR PARAMETERS
	SEARCH	ORNMAC			;SEARCH ORION/OPR PARAMETERS

	.DIRECT	FLBLST

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

	SALL				;SUPPRESS MACRO EXPANSIONS

;VERSION INFORMATION
	LPTVER==104			;MAJOR VERSION NUMBER
	LPTMIN==0			;MINOR VERSION NUMBER
	LPTEDT==3103			;EDIT LEVEL
	LPTWHO==0			;WHO LAST PATCHED

	%LPT==<BYTE (3)LPTWHO(9)LPTVER(6)LPTMIN(18)LPTEDT>

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

	ND	FTACNT,-1		;Turn on accounting

	DEFINE	FACT,<IFN FTFACT>
	SUBTTL	Table of Contents

;               TABLE OF CONTENTS FOR LPTSPL
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. RJE SUPPORT DEFINITIONS...................................   3
;    3. Revision History..........................................   4
;    4. AC and I/O Channel Definitions............................   5
;    5. Parameters................................................   6
;    6. MACROS....................................................   7
;    7. Special Forms Handling Parameters.........................   8
;    8. Flag Definitions..........................................  10
;    9. Job Parameter Area........................................  11
;   10. Random Impure Storage.....................................  15
;   11. Resident JOB Database.....................................  16
;   12. IB and HELLO message blocks...............................  17
;   13. $TEXT Utilities...........................................  18
;   14. LPTSPL - Multiple Line Printer Spooler....................  19
;   15. Idle Loop.................................................  20
;   16. CHKTIM - ROUTINE TO WAKE UP A STREAM AT A FUTURE TIME.....  21
;   17. DSCHD -- Deschedule process...............................  22
;   18. FIXPDL -- Fix PDL routine.................................  23
;   19. FIXACT - Routine to set stream to inactive................  23
;   20. FORFOR -- Force Forms change mess.........................  24
;   21. DOFFOR -- Do the force forms..............................  25
;   22. NXTJOB -- NEXTJOB Message from QUASAR.....................  26
;   23. DOJOB -- Do the Job.......................................  28
;   24. NXTFIL -- FIND AND RETURN THE NEXT FILE IN THE NEXTJOB MSG  30
;   25. FILDIS -- ROUTINE TO KEEP/DELETE PRINTED SPOOL FILES......  30
;   26. FILE -- Print a File......................................  31
;   27. ENDJOB -- END OF JOB PROCESSOR............................  32
;   28. QRELEASE -- ROUTINE TO SEND A REQUEUE/RELEASE MSG TO QUASAR.  33
;   29. CHKQUE -- ROUTINE TO RECIEVE AND SCHEDULE IPCF MESSAGES...  34
;   30. CHKOBJ -- ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.  35
;   31. GETBLK -- ROUTINE TO BREAK DOWN AN IPCF MSG INTO ITS DATA BLOCKS  36
;   32. KILL -- User CANCEL Request...............................  37
;   33. QSRNWA - ROUTINE TO SHUTDOWN A STREAN WHOSE NODE HAS DROPPED  37
;   34. DSTATUS -- Send status info...............................  38
;   35. CHKPNT -- Request for Checkpoint..........................  39
;   36. UPDATE -- ROUTINE TO SEND STATUS UPDATES TO QUASAR........  40
;   37. SETUP/SHUTDOWN Message processing.........................  41
;   38. SHUTDN -- ROUTINE TO SHUT DOWN A LINE-PRINTER.............  43
;   39. RSETUP -- ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR  43
;   40. OACRSP -- OPERATOR RESPONSE TO A WTOR PROCESSOR...........  44
;   41. OACCAN -- Operator CANCEL request.........................  45
;   42. OACSUP -- Operator SUPPRESS request.......................  46
;   43. OACPAU -- Operator PAUSE request..........................  47
;   44. OACCON -- Operator CONTINUE request.......................  47
;   45. OACREQ -- Operator REQUEUE request........................  48
;   46. OACALI -- Routine to process Operator ALIGN request.......  49
;   47. OACFWS -- OPERATOR FORWARD SPACE COMMAND PROCESSOR........  51
;   48. OACBKS -- BACK SPACE operator action routine..............  52
;   49. BCOPYS -- BACKSPACE 'COPIES'..............................  54
;   50. BFILES -- BACKSPACE 'FILES'...............................  54
;   51. OPRD60 -- Receive DN60 OPR messages from QUASAR...........  55
;   52. OPRCHK -- Check for DN60 OPR msgs and send them...........  56
;   53. BLDL -- CREATE A 10/20 FD FOR THE ALIGN FILE..............  58
;   54. ALIGN -- Processor........................................  59
;   55. FNDOBJ -- ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE....  60
;   56. SNDQSR -- ROUTINE TO SEND A MESASGE TO QUASAR.............  61
;   57. CHKLPT -- ROUTINE TO MAKE SURE THE DEVICE IS ONLINE.......  61
;   58. TOOBAD -- ROUTINE TO RESPOND TO THE OPERATOR IF HIS REQUEST IS TOO LATE.  61
;   59. LOGCHR  --  Type a character in the log file..............  62
;   60. LOGBUF  --  Get a buffer page for LOG.....................  62
;   61. ACTBEG -- ACCOUNTING INITIALIZATION ROUTINE...............  63
;   62. ACTEND -- ACCOUNTING SUMMARY ROUTINE......................  64
;   63. ACTLST -- SPOOLER ACCOUNTING RECORD.......................  66
;   64. INPOPN  --  Routine to open the input file................  67
;   65. INPBUF  --  Read a buffer from the input file.............  68
;   66. INPBYT  --  Read a byte from the input file...............  68
;   67. INPERR  --  Handle an input failure.......................  68
;   68. INPFEF  --  Force end-of-file on next input...............  68
;   69. INPREW  --  Rewind the input file.........................  68
;   70. FORMS   --  Setup Forms for a job.........................  69
;   71. Forms Switch Subroutines..................................  74
;   72. LODVFU  --  Load the Vertical Forms Unit..................  76
;   73. TOPS10 VFU LOADING ROUTINES...............................  77
;   74. HERE IF VFU FILE THAT WE ARE LOOKING FOR IS NOT AROUND....  80
;   75. LODRAM -- ROUTINE TO LOAD THE TRANSLATION RAM.............  81
;   76. NORAM -- ROUTINE TO PROCESS RAM LOADING ERRORS............  83
;   77. I/O Subroutines for LPFORM.INI............................  84
;   78. OUTGET  --  OPEN the output device........................  86
;   79. OUTGET Exit Subroutines...................................  89
;   80. TAPGET -- ROUTINE TO SETUP A MAG TAPE DEVICE FOR OUTPUT...  90
;   81. OUTOUT  --  Routine to output a buffer....................  91
;   82. OUTERR  --  Handle Output Device Errors...................  93
;   83. OUTWON  --  Wait for on-line..............................  96
;   84. OUTREL  --  Release device on SHUTDOWN....................  97
;   85. OUTEOF -- ROUTINE TO CLEAR THE LPT OUTPUT BUFFERS.........  98
;   86. OUTDMP  --  Dump out buffers and wait.....................  99
;   87. OUTFLS  --  Flush already buffered output................. 100
;   88. LPT CONTROL ROUTINES...................................... 101
;   89. FILOUT -- SUBROUTINE TO SET UP FOR LPTIN AND LPTOUT....... 102
;   90. SETLST -- SUBROUTINE TO COMPILE CODE TO TEST EACH LINE FOR A MATCH AGAINST 103
;   91. SETPFT  --  Setup file processing type.................... 104
;   92. LPTASC  --  Print Regular ASCII on LPT.................... 105
;   93. LPTELV  --  Print MACY11 file as regular ASCII............ 106
;   94. LPTFOR  --  Process FORTRAN data files.................... 107
;   95. LPTRPT  --  Process REPORT files.......................... 107
;   96. LPTOCT  --  Give an Octal Dump............................ 108
;   97. LPTCOB  --  Process COBOL Sixbit Files.................... 109
;   98. Character Interrogation Routines.......................... 110
;   99. CNTDWN -- COUNT DOWN LINE FEEDS AND PAGE FEEDS............ 112
;  100. LIMCHK -- Check on page limits............................ 113
;  101. Subroutines to send messages to the output device......... 116
;  102. ROUTINES TO GENERATE HEADERS AND TRAILERS................. 117
;  103. BANNER  --  Routine to print a banner..................... 118
;  104. TRAILR  --  Routine to Print a Trailer.................... 119
;  105. UTILITY ROUTINES.......................................... 120
;  106. HEAD  --  Generate File-header pages...................... 121
;  107. SETHDR  --  Setup header name for file.................... 123
;  108. PICTUR  --  Routine to print block letters................ 126
;  109. SYSTEM INITIALIZATION FUNCTIONS........................... 129
;  110. OPNFRM  --  Routine to open LPFORM.INI.................... 131
;  111. Interrupt Module.......................................... 132
;  112. INTERRUPT SYSTEM DATABASE................................. 133
;  113. TOPS-20 I/O LOCAL/REMOTE SUBROUTINES ($SOUT).............. 138
;  114. DN200 I/O SUPPORT ROUTINES................................ 140
;  115. TOPS10 DN60 SUPPORT ROUTINES.............................. 141
;  116. DN60 I SUPPORT ROUTINES................................... 142
;  117. D60SU -- DN60 success routine to fix counts............... 144
;  118. D60ER/D60OE -- Process DN60 errors........................ 145
;  119. STARS - JOB DEFINITION/SEPARATION LINE DEFINITIONS........ 146
;  115. D60ER/D60OE -- Process DN60 errors........................ 142
;  116. STARS - JOB DEFINITION/SEPARATION LINE DEFINITIONS........ 143
	SUBTTL	RJE SUPPORT DEFINITIONS


	;IF WE HAVE RJE,,GET SIMULATION PACKAGE (TOPS20)
TOPS20 <
IFN FTRJE,<.REQUIRE NURD.REL>		;LOAD THE DN200 I/O PACKAGE
>

	;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	Revision History

COMMENT \

2550	Delete all references to user name and job number.
	Replace them with ^R Library $Text Function.

2551	Add code to support new QUASAR device status message.

2552	Add RJE support

2553	Fix a Restart page count bug by not including the job
	headers and trailers in the final page count.

2554	Replace ERRSTP ITEXT with LPERR ITEXT. Make sure when LPT comes
	online or goes offline, the status is updated. Add a check to
	ACTEND so that if the request had an invalid account string,
	no USAGE entry is made.

2555	Fix a bug in which INPOPN was doing a LOAD S1,EQ.PRV to get
	the users privilge bits. This translated to MOVE S1,400
	and 400 was SPLDIR (which was never 0). Given this, the
	JUMPN S1,INPO.1 always jumped to INPO.1 and avoided the
	access check. The LOAD was changed to LOAD S1,.EQSEQ(J),EQ.PRV.

2556	Changed the IB to conform to the new IB/PIB structure.

2557	Fix a bug in OUTOUT which caused to stack to be out of phase.
	Basic re-write of OUTOUT, elimination of OUTINT, and
	modification of $SOUT.

2560	Change the scheduler loop to use P1 instead of T2.
	Change the scheduler loop so that at MAIN.1 it
	checks to see if the stream status needs to be updated,
	and if so, it sends a status update and checkpoint
	message to QUASAR.

2561	Delete the flag bit HDRTRL and the supporting code.

2562	Add Calls to S%SIXB & S%TBLK for WTOR response parsing.
	Move the call to FILDIS from ENDJOB to QRELEASE.

2563	Fix line count for narrow forms.
	Fix DEVOUT to save S1 across OUTOUT call
	Add code to cut off the header/trailer line at 'J$FWID' Length

2564	Add DN60 Support.

2565	Add 'Ignore Structure Accounting' MSTR JSYS.

2566	Change the $WTOR's for killing OPR requests from $WTOR to $KWTOR.

2567	Add spooling to mag tape support

2570	Fix a page count problem (on restarts).
	Spell cancelled right (canceled)

2571	Spell Canceling correctly
	add 40 (decimal) words to the context PDL

2572	Fix a bug in which it was possible for LPTSPL to set the output
	blocked scheduling bit and then deschedule for a page limit
	exceeded error. When this happened, LPTSPL would wait for
	the output done interrupt, which, of course, would never come.

2573	Clear J$RNPP IN DOJOB Just before checkpointing the next file
	Clear J$RNPP and checkpoint the number of copies in FILE.1

2574	If a job is cancelled while in OPR response wait from LODVFU or
	LODRAM then zero J$FORM to force the next job to go through
	new forms processing.

2575	Add DN60 operator response support (What a Crock !!)

2576	Delete FTRMTE feature test.

2577	At OUTERR move the PUSHJ P,.SAVET & MOVE T4,STREAM to OUTE.1
	under TOPS-10 conditional.

	Change the scheduler so that for both TOPS-10 & TOPS-20 we
	check to see if we processed a message and if so, dont sleep.

	Change OPRCHK so that as long as the output succeeds, we
	continue printing operator messages.

	For TOPS-10 make OUTDMP call OUTOUT BUFNUM+1 times.

	Add Spooling to Tape support for TOPS-10.

2600	Make LPTSPL sleep forever by removing the 60 second timer.

2601	TOPS10 - Detect EOF on spool to magtape.  Ask OPR to mount next reel

2602	Fix a bug in SHUTIN code. Get a new stack pointer if shutting
	down from 'IN STREAM' context.

2603	Fix a bug - reverse the compare in S$VFU which checks for
	optical VFU.

2604	Fix a bug - In OUTGET, if the default RAM and VFU are already set,
	then, dont set them.

2605	Fix a bug - if printing either the banner or header pages, dont
	flush the buffers in KILL or OACCAN.

2606	Add code to send a form feed if the printer VFU is ok and
	we are about to load the VFU.

2607	Delete the TOPS-20 mag tape code that assigns/deassigns the tape drive.
	Also make sure that the mat tape is not already assigned to anyone.

2610	Delete the RAM variable from the forms default macro and add
	J$FRAM.

2611	Change IPCF send/recieve quotas from max to 20.

2612	Change DN60 D60OPN parameters for new port/line handle.

2613	Fix a bug - prevent LPTSPL from deleting DN60'S link'd list.

2614	Delete the Send/Recieve Quotas from the PIB.

2615	Make OUTREL do a CLOSE instead of a RESDV. if we are spooling to tape

2616	Pick up non-existant printer status bits on the -20.

2617	Fix a bug in TAPGET; The correct value returned by the DVCHR for
	unassigned devices is -1,,unit # - Not -1.

2620	In SHUTDN, After the call to FNDOBJ check to see that the object
	was actually found, and if not, just return.
	In OPDINI, add a SETZM FMOPN and a $RETT at the end of the routine.
	In OPEN.6 add a SETOM J$LINK(J) to indicate that there is no DN60
	operator message list.
	In CLOSE.6, change the MOVE S1,J$LINK(J) to a SKIPL S1,J$LINK(J) so
	that we dont delete a list which may not exist.

2621	TOPS-10: Delete the call to F%FCHN and use the stream number as the
	channel number.

2622	Fix a job restart problem which allows -pages to be printed.

2623	Fix a -10 problem caused by converting to extended channels in the
	library. Must re-write the load VFU and RAM sections for front
	end lint printers

2624	Fix a -10 problem - Clear the PSF%DO and PSF%OB bits in the
	OUTGET routine since we may wait forever after resetting the channel.
	Change all occurances of DC3 output to CRLF except for the ruler.

2625	Add a CRLF to the end of the header page file info line.

2626	Fix a bug in the /REPORT: code for COBOL report files.

2627	Fix a bug in deleting files. Make F%DEL use an in your behalf FOB.

2630	Delete the support for the old forms parameters.

2631	Convert DN60 support to new SETUP message format.

2632	Rework the Backspace /pages support to fix U.S. Railways QAR.

2633	Finally get the backspace code right.

2634	Add 8 bit input support. Also, make output byte sizes variable by
	adding J$LBTZ to keep track of output byte size.

2635	Add /FILE:ELEVEN support to print MACY11 files as standard ascii
	Requires that a new FP bit or field be defined for 8-BIT

2636	TOPS20 QAR (20-00608) Add code to OUTREL so that when closing
	a device other then the line printer, we write out
	trailing tape marks.

2637	Fix a bug in which the ABORT bit was being lit in the NXTJOB code,
	before the forms were set up. This caused the request to be trashed
	without the headers or trailers being printed

2640	Fix a bug - Make the TAPGET OPENF open the device in 7 bit Mode.

2641	Fix Another bug - make OUTGET open device for 8 bit bytes.

2642	Make PICTURE put out line feeds, not DC3's.

2643	Fix a bug in OUTERR code so that is the OUTFLS call fails, then
	send a Response-to-Setup message to QUASAR before shutting down.

2644	Add support for /RAM: in LPFORM.INI for -10 & -20.

2645	Fix an accounting problem in which usage accounting was being done
	twice.

2646	Fix QAR # 20-00805 such that multiple ALIGN commands do not
	add to the sleep time of previous ALIGN commands

2647	Add a SETZM T1 to the .MONOP MTOPR call in OUTDMP.
	Add a .MONOP MTOPR call to TAPGET to wait for I/O to finish or
	if a TTY, set the TTY page width to infinite.

2650	Delete OBDLLC & OBDLUC attribute bits and return %LOWER & %UPPER for
	the new device attributes

2651	Add accounting support for TOPS10 (USAGE)

2652	If NPRINT = 1 then accumulate cpu time used to process a request.

2653	Move search for DN60 universal to FTDN60 conditional

2654	Add code to interrupt routine to check for all error bits on and if
	so, and this is a remote LPT, then don't change restart address. If
	all error bits are on for a local LPT, then the CPU went down, so
	just ignore the problem and wait for it to come back.

2655	Delete the DSKOPN status bit and just check J$DIFN for non-zero.

2656	Add DN60 Support

2657	Force the align that is part of a forms type to occur immediately
	after the form is set.  QAR # 10-04593

2660	Add support for new style /DISPOSE:RENAME

2661	Remove SETNAM that turned off JACCT since it also turns off x-only.
	No LPTSPL needs to have JACCT so correct solution is to eventually
	remove all GALAXY components from PRVTAB.

2662	Use new feature IB.DET to detach from FRCLIN.

2663	Fix CHKTIM to set SLEEPT if zero (not set)
	Delete IB.DET (GLXLIB always detaches)

2664	Remove the system text portion of the account record.  The system
	text portion is to contain any disposition explanation.

2665	Fix a bug in INPOPN and FILDIS so that spooled files are handled
	correctly

2666	QAR # 10-04856  Change all definitions of Z to ZZ to prevent
	MACRO from getting confused during processing of $SAVE

2667	Fix OUTFLS to only reset the line buffers for a DN60 error.

2670	Do call to SHUTND instead of jrsting to SHUTDN since there is
	no need to do the FNDOBJ and that may fail if the message is
	already released.

2671	Add a check in OPRCHK to make sure that a job is not being
	printed before we output the OPR messages for the DN60.

2672	Fix bit settings in CHTAB.  We are currently displacing into
	DOFRAC routine.

2673	Fix formfeed at trailer routine (SPR 20-14654)
	Clear old report code in SETLST so other files work (SPR 20-14635)
	Add indirect (@) to J$DFDA use in $TEXT (SPR 20-14817)
	Fix backspace code (SPR 20-15172)

2674	Clear J$WTOR(J) when it is used to overlaid messages.

2675	Remove decision to do accounting as a runtime decision and make it
	an assembly parameter based on the new feature test FTACNT.

2676	Add check to CHKPNT verifying that the stream is active.

2677	Work with checkpoint mechanism:
		Break checkpoint into two parts, status, and job checkpoint
		Create new status mechanism contained in DSTATUS
		Cause checkpoints to occur internally without QUASAR requests
	Add table of nonsense.
	Reopen LPFORM.INI with every forms change to allow LPFORM.INI changes

2700	Do not do accounting if debugging

2701	Fix setting JOBUPD flag in the interrupt code

2702	Misc. changes:
		Be more clever on checking limits when printing files less than
			one page
		Clear trailer log
		Remove DSTATUS call in dojo.4 since it happens anyway at next
			file or is implied with release message

2703	Fix stupid error where ^D100 was used to define a PDL size.
	(Stupid since PDSIZE is defined in the symbols and is defined to be
	100 octal

2704	Add FACT file accounting support.

2705	Add immediate forms change support which includes routines FORFOR
	and DOFFOR.
	Allow listings queued for a remote LPT be spooled to a special device

2706	Fix context change so the PDL pointer is not clobbered.
	Remove require for d60jsy and include it in lptspl.cmd so symbols
	can be included
	Do not set IO.SFF in open if not a real line printer

2707	3/13/81  Force UPDATE routine to check for DN60 offline.
	Request status update message in D60ER routine.
	Increase size of PDL to 120 octal (PDSIZE)

2710	3/19/81  Do NOT try to $CALL P,NNN.
	Add an argument block to be used for D60OPN per stream since
	MSGBLK (which was used formerly) got clobbered during DSCHD

2711	3/24/81 Make LPFORM.INI /NOTE be an asciz string

2712	3/26/81  Split DN60 errors so there is a different wait time for
	NBR errors and DOL errors.

2713	3/27/81 Use symbol FTFACT from GALGEN dialogue and remove references
	to FTOACT.

2714	4/14/81  Fix DOFFOR to call CHKALN.

2715	4/16/81  Remove last reference to UPDTST replacing with call to DSTATUS.

2716	5/1/81  Clear up any pending WTORs as part of the shutdown code.
	Remove some jrst .+n's.
	Make J$RNPP always our current location in pages with respect to
	the file being printed.  Adjust it as we pass pages, not as part
	of the forward space code.
	Remove BUFSPC since it is not really used.
	Fix bad test by changing TXNN to TXNE in CHKSP to clear J$XTOP
	only when needed.
	If suppressing when doing headers and trailers, don't believe J$XTOP.
	If already processing VFU, do not allow additional VFU errors @OUTE.4.

2717	5/15/81  Delete files in FILDIS only if they are spooled or if
	they are /delete and have not been aborted.

2720	5/15/81 Add 1 word to LPCNF and reorder ACTLST to make accounting work
	on TOPS20.

2721	5/21/81  Do the check for suppress before clearing J$XTOP and hope
	that multiple form feeds will be always suppressed.

2722	6/1/81  Use page length in calculating block size to use on header page.
	Allow CKPTIM to be defined in GALGEN by using ND macro for definition.
	Remove label FRMI4B since it is not referenced.
	Remove the unneeded restriction of checking for LPT when checking actual
	device names in parsing LPFORM.INI.
	Send a warning if the forms requested is unknown which includes
	having FRMINI return false if none found.
	Set FCONV in bspace to indicate a backspace starts a new line.
	Also in BSPACE check to see if the table is wrapped around.
	Make GENDEV work for both T10 and T20.  Have it set J$LDEV.
	Call GENDEV from the routine OUTGET on the 20.

2723	6/9/81  Change GENDEV to always set J$LDEV even if it is a magtape.
	Add a new status bit to indicate that we are processing a job.  The
	purpose of this is to determine whether there is a need for a
	checkpoint.  If forms are being mounted, for example, no checkpoint.
	If the job is requeued before the operator responds to a forms
	change, restore forms to their previous type.

2724	6/12/81  Add LPTBAN, LPTTRL, and LPTHDR to try to use the GALGEN params.
	For T10 only, change the countdown code at CNTDW1+7 to cause
	a DSCHD if: we are forwardspacing and the number of pages is
	evenly divisible by FRWSKP (which allows a DSCHD every FRWSKP pages.

2725	6/22/81  Remote printers should only have one buffer since the network
	only uses one buffer at a time (there is no great advantage) and since
	having only one buffer allows OUTFLS to be skipped for remotes.(that
	caused lots of problems)

2726	6/23/81  Update job limit when backspacing.
	Change size of fact accounting table to a symbol.
	Only check for device assignment if it is a magtape in TAPGET.
	Open LPFORM.INI with sequence numbers suppressed.
	Fix edit 2711 by using AC TF in S$NOT2.
	Make the header information a little more clever for narrow headers.

2727	Use byte I/O instead of buffered I/O for input from LPFORM.INI so
	sequence numbers are suppressed correctly.

2730	7/7/81  Zero out IMESS @CHKQ.5 after releasing the message to
	prevent releasing it twice.

2731	9/10/81  Clear top of form if SUPFIL is set before clearing SUPFIL
	@FILE.2.

2732	9/24/81  In FRMINI return false if the OPNFRM fails.

2733	9/29/81  Add IBM status message support (IBMSTS).
	Remove the zeroing out of J$GNLN in NXTJOB since ZTABLE loop does it.
	If IBMCOM abort, then requeue the job and shutdown the stream.

2734	Made sure suppress mode also implies arrow mode as stated in the
	manuals.

2735	Fixed problem with BACKSPACE when printer goes off line, and
	more than likely, even when it doesn't.

2736	Fixed problem with trailers not being cleared from previous jobs.

2737	11/25/81  Use a generalized routine EOF.6 for EOF on DN60.

2740	12/7/81  Lots of changes...
	1.  Make it so we don't run out of NBR errors unless we
	are trying to shut things down.
	2.  Save last DN60 error in J$D6ER.
	3.  Generalize the CHKTIM routine.  Make it the only one that
	sets SLEEPT.  Have it also check J$CWKT if DN60 opr mess. pending.
	If we clear the sleeptime, clear also variable that started it all.
	4.  DIE immediately if any bad errors in DN60.
	5.  Use polling estimate from D60JSY (POLEST) for sleeptime.
	6.  On TOPS20 have D60ER sleep instead of DSCHD since that version
	is set up more for blocking types of output.
	7.  Make SLEEPT -1 if none set, 0 if no sleep should occur, number
	of seconds to sleep otherwise.

2741	12/16/81  If we are in hasp, do not set operator output wait bit since
	that blocks the print stream which shouldn't happen in HASP.

2742	TJW Fix the continue command to clear the device offline bit.

2743	1/4/82 Clarify all $WTORs to allow ABORT or PROCEED only
		Dont do extra RUNTIM UUOs if NPRINT .GT. 1
		as we zero the runtime in the account entry anyway

2744	1/7/82  Restore T1 that is clobbered by IDIVI in CHKTIM before using
	again.

2745	2/26/82  Set sleep time to 0 if we are allowing sleeptime during
	forwardspacing.
	Never again will LPTSPL run out of DOL errors since I have removed
	the counters.

2746	3/26/82  Fix CPU failure interrupts and add hung device support.

2747	4/6/82  Mount and dismount structures for files we processes. GCO 1302

2750	5/18/82  Do not RESDV remote printers when shutting down @OUTREL.
	GCO 4.2.1342

2751	6/1/82 Correct the count of overhead lines at TRAI.4
	GCO 4.2.1351

2752	6/3/82 Make BACKSPACE/FILE work. GCO 1356

2753	6/3/82  Handle false returns from GLXLNK routines in OPRD60.
	GCO 4.2.1358

2754	6/4/82 Correct definition of BUFCHR.  GCO 1365

2755	6/4/82 Prevent line printer abuse by having differnt STARS text for
	each width class.  GCO 1366

2756	6/9/82 Check for write ring when spooling output to tape.
	If the ring is missing, ask operator to insert it. PCO 20-LPTSPL-48

2757	6/9/82 Add routine to check for eot when spooling to tape.
	Add routine to unload tape and request next mount. PCO 20-LPTSPL-49

2760	6/15/82 More of edit 2755.  GCO 1387

2761	6/15/82 Fix up 2756/2757 to use new subroutines to write tape marks
	and to unload tapes. GCO 1389

2762	6/25/82 Don't update stream status bits on .OMRSP messages.  GCO 1398

2763	6/28-82 Check for ABORT while off-line. GCO 1460 PCO 20-LPTSPL-56

2764	7/6/82 Fix a problem with forms changes not notifying the operator.
	GCO 1420

2765	7/7/82 Fix 'System accounting failure' messages if the site does
	not run ACTDAE, but it's own system. GCO: 1422

2766	7/9/82	Fix edit 2764 so that it works right this time.
	If forms type can be found it will just ask the operator to
	mount them and type proceed. If they aren't however, the
	operator will have the choice of aborting the request.

2767	7/9/82 Resolve structure name before doing STRUUOs.  GCO 1430

2770	8/1/82 Don't print job data if we can't find the forms on a forms
	change. GCO 1474

;; Released with TOPS-10 GALAXY 4.1

3100	8/3/82 Fix error recovery stuff so that tape errors are handled
	seperately from LPT errors. GCO 4.2.1476

3101	8/6/82 Remove junk at end of STARS text.  GCO 1478

3102	8/6/82 Always be at top of forms when changing forms.  GCO 4.2.1483

3103	11/9/82 Update COPYRIGHT and fix RELOC.  GCO 4.2.1528

[End of Revision History]
\
	SUBTTL	AC and I/O Channel Definitions

;ACCUMULATOR DEFINITIONS

	M==12		;IPCF MESSAGE ADDRESS
	S==13		;STATUS FLAGS
	E==14		;POINTS TO CURRENT FILE
	J==15		;JOB CONTEXT POINTER
	C==16		;HOLDS A CHARACTER - ALMOST NEVER PRESERVED




	SYSPRM	.MOEOF,16,.MOEOF
	SYSPRM	ERRVFU,DF.LVE,MO%LVF
	SUBTTL	Parameters

;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME
	ND	PDSIZE,120	;SIZE OF PUSHDOWN LIST
	ND	LPTERR,2	;NUMBER OF LPT I/O ERRS BEFORE QUITTING
	ND	LOGPAG,12	;PAGE LIMIT FOR LOG IF OVER QUOTA
	ND	CKPTIM,^D60	;# of seconds between checkpoints
	ND	LPTBAN,2	;Default number of banner pages
	ND	LPTTRL,2	;Default number of trailer pages
	ND	LPTHDR,2	;Default number of header pages
	ND	FRWSKP,5	;DSCHD every n pages when forwardspacing


;CONSTANT PARAMETERS
	XP	MSBSIZ,30		;SIZE OF A MESSAGE BLOCK
	XP	AFDSIZ,10		;ALIGN FILE FD SIZE.

;CHECKPOINT BLOCK OFFSETS
	XP	CKFIL,0			;NUMBER OF FILES PRINTED
	XP	CKCOP,1			;NUMBER OF COPIES OF LAST FILE
	XP	CKPAG,2			;NUMBER OF PAGES OF LAST COPY
	XP	CKTPP,3			;TOTAL PAGES PRINTED
	XP	CKFLG,4			;FLAGS
		XP CKFREQ,1B0		;JOB WAS REQUEUED BY OPR
		XP CKFCHK,1B1		;JOB WAS CHECKPOINTED


	SYSPRM	BUFNUM,4,1		;NUMBER OF BUFFERS
	SYSPRM	BUFSIZ,<1000/BUFNUM>,<1000/BUFNUM>
					;SIZE OF EACH BUFFER
	SYSPRM	BUFCHR,<<BUFSIZ-3>*5>,<BUFSIZ*4>
					;NUMBER OF CHARS PER BUFFER
	SYSPRM	NPRINT,17,1		;NUMBER OF DEVICES THIS SPOOLER HANDLES

	SYSPRM	(STRNUM,^D10,NPRINT)	;NUMBER OF STRS MAXIMUM
	STRLEN==2*STRNUM		;LENGTH OF STRUCTURE TABLE
	SYSPRM	(STRSLS,<.FSDSO+<3*STRNUM>+3>,5) ;SIZE OF SEARCH LIST BLOCK

	SYSPRM	RAMNOR,SIXBIT/LP96/,SIXBIT/LP96/
	SYSPRM	SERFLG,0,0		;SYSERR flag -- 0=no entries to be made
	SYSPRM	NBRRT,2,2		;Non-blocking rest time
	SYSPRM	DOLRT,10,10		;Device off-line rest time
	SYSPRM	CONRT,3,3		;Console rest time
	SYSPRM	NENBR,25,25		;# of errors allowed for NBR return
					;  when shutting down
	SUBTTL	MACROS

DEFINE LP(SYM,VAL,FLAG),<
	IF1,<
		XLIST
		IFNDEF J...X,<J...X==1000>
		IFDEF SYM,<PRINTX  ?PARAM SYM USED TWICE>
		SYM==J...X
		J...X==J...X+VAL
		IFNDEF ...BP,<...BP==1B0>
		IFNDEF ...WP,<...WP==0>
		REPEAT VAL,<
		IFIDN <FLAG><Z>,<LPZ(\...WP,...BP)>
			...BP==...BP_<-1>
			IFE ...BP,<
				...BP==1B0
				...WP==...WP+1
			>  ;;END IFE ...BP
		>  ;;END REPEAT VAL
		LIST
		SALL
	>  ;END IF1

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


DEFINE LPZ(A,B),<
	IFNDEF ...Z'A,<...Z'A==B>
	IFDEF ...Z'A,<...Z'A==...Z'A!B>
>  ;END DEFINE LPZ
	SUBTTL	Special Forms Handling Parameters





;FORMS SWITCHES:
;	BANNER:NN	NUMBER OF JOB HEADERS
;	TRAILER:NN	NUMBER OF JOB TRAILERS
;	HEADER:NN	NUMBER OF FILE HEADERS (PICTURE PAGES)
;	LINES:NN	NUMBER OF LINES PER PAGE
;	WIDTH:NN	NUMBER OF CHARACTERS PER LINE
;	ALIGN:SS	NAME OF ALIGN FILE
;	ALCNT:NN	NUMBER OF TIMES TO PRINT ALIGN FILE
;	ALSLP:NN	NUMBER OF SECS TO SLEEP BETWEEN COPIES OF ALIGN
;	RIBBON:SS	RIBBON TYPE
;	TAPE:SS		VFU CONTROL TAPE
;	VFU:SS		(SAME AS /TAPE)
;	RAM:SS		TRANSLATION RAM TO USE
;	DRUM:SS		DRUM TYPE
;	CHAIN:SS	CHAIN TYPE (DRUM/CHAIN ARE THE SAME)
;	NOTE:AA		TYPE NOTE TO THE OPERATOR


;IN THE ABOVE AND BELOW EXPLANATIONS:
;	NN	IS A DECIMAL NUMBER
;	SS	IS A 1-6 CHARACTER STRING
;	AA	IS A STRING OF 1 TO 50 CHARACTERS
;	OO	IS AN OCTAL NUMBER



;LOCATION SPECIFIERS
;	ALL		ALL LINEPRINTERS
;	CENTRAL		ALL LINEPRINTERS AT THE CENTRAL SITE
;	REMOTE		ALL REMOTE LINEPRINTERS
;	LPTOOO		LINEPRINTER OOO ONLY

;NOTE:  LPTSPL WILL USE THE FIRST ENTRY WHICH MEETS THE LOCATION
;	SPECIFICATION FOR ITS LINEPRINTER.
DEFINE F,<
	FF	BANNER,LPTBAN
	FF	TRAILER,LPTTRL
	FF	HEADER,LPTHDR
	FF	LINES,^D60
	FF	WIDTH,^D132
	FF	ALIGN,0
	FF	ALCNT,5
	FF	ALSLP,7
	FF	RIBBON,FRMNOR
	FF	TAPE,FRMNOR
	FF	VFU,FRMNOR
	FF	DRUM,FRMNOR
	FF	CHAIN,FRMNOR
	FF	NOTE,0
	FF	RAM,-1
>


;GENERATE TABLE OF SWITCH NAMES
DEFINE FF(A,C),<
	XLIST
	<<SIXBIT /A/>&777777B17>+S$'A
	LIST
	SALL
>

FFNAMS:	F

;GENERATE TABLE OF DEFAULT PARAMTERS
DEFINE FF(X,Y),<
	XLIST
D$'X:	EXP	Y
	LIST
	SALL
>

FFDEFS:	F
	F$NSW==.-FFDEFS
	PURGE	D$VFU,D$CHAI

	F$WCL1==^D60	;WIDTH CLASS ONE IS 1 TO F$WCL1
	F$WCL2==^D100	;WIDTH CLASS TWO IS F$WCL1 TO F$WCL2
	F$LCL1==^D41	;Length class one is 1 to F$LCL1
	F$LCL2==^D55	;Length class two is F$LCL1 to F$LCL2
	SUBTTL	Flag Definitions

	ARROW==1B0		;ARROW MODE IN EFFECT
	SUPFIL==1B1		;NO USER FORM CONTROL
	RQB==1B3		;JOB HAS BEEN REQUED
	SUPJOB==1B4		;SUPPRESS /JOB
	ABORT==1B5		;THE SHIP IS SINKING
	FCONV==1B6		;THE NEXT CHAR IS FORTRAN FORMAT DATA
	NEWLIN==1B7		;FLAG FOR THE BEGINING OF LINE
	SKPFIL==1B8		;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
	GOODBY==1B9		;IN JOB TERMINATION SEQUENCE
	FBPTOV==1B10		;SPACING PAGE TABLE OVERFLOW BIT.
	FORWRD==1B11		;FORWARD SPACING REQUEST IN PROGRESS.
	INTRPT==1B12		;STREAM IS CONNECTED TO THE INTERRUPT SYSTEM
	BCKFIL==1B13		;REQUEST WAS BACKSPACED 1 FILE
	BANHDR==1B14		;PRINTING BANNER/HEADER PAGES
	VFULOD==1B15		;VFU LOAD IS IN PROGRESS
	INJOB==1B16		;In a print job (Checkpoint should be done)
	FRMFND==1B17		;No such forms in LPFORM.INI
	SUBTTL	Job Parameter Area

	LP	J$$BEG,0		;BEGINNING OF PARAMETER AREA
;REQUEST PARAMETERS
	LP	J$RFLN,1		;NUMBER OF FILES IN REQUEST
	LP	J$RLIM,1,Z		;JOB LIMIT IN PAGES
	LP	J$RTIM,1		;START TIME OF JOB
	LP	J$RLFS,1,Z		;ADR OF LOG FILE SPEC
	LP	J$RNFP,1,Z		;NUMBER OF FILES PRINTED
	LP	J$RNCP,1,Z		;NUMBER OF COPIES OF CURRENT FILE
	LP	J$RNPP,1,Z		;NUMBER OF PAGES IN CURRENT COPY PRINTED
	LP	J$RACS,20		;CONTEXT ACS
	LP	J$RPDL,PDSIZE		;CONTEXT PUSHDOWN LIST

;LPT PARAMETERS
	LP	J$LBUF,1		;ADDRESS OF LPT BUFFER
	LP	J$LBFR,PAGSIZ		;LINE PRINTER BUFFER
	LP	J$LBRH,1		;BUFFER RING HEADER
	LP	J$LBPT,1		;BYTE POINTER
	LP	J$LBCT,1		;BYTE COUNT
	LP	J$LDEV,1		;ACTUAL OUTPUT DEVICE NAME
	LP	J$LERR,1		;LPT ERROR DOWNCOUNTER
	LP	J$LRAM,1		;DEFAULT RAM FILE NAME (LP64 or LP96)
	LP	J$LLCL,1		;-1 IF UPPER/LOWER CASE PRINTER
	LP	J$LDVF,1		;-1 IF DAVFU ON PRINTER
	LP	J$LPCR,1		;-1 IF DEVICE HAS A PAGE CNTR
	LP	J$LREM,1		; 0 = LOCAL LPT
					;-1 = DEC TYPE REMOTE LPT
					;+1 = DN60 TYPE REMOTE LPT
IFN FTDN60,<
	LP	J$DCND,CN$SIZ		;DN60 LINE CONDITIONING BLOCK
	LP	J$CWKT,1		;DN60 console wake-up time
	LP	J$ENBR,1		;Threshold for NBR returns
	LP	J$EDOL,1		;Threshold for DOL returns
	LP	J$D6ER,1		;Last DN60 error
	LP	J$OMSG,1,Z		;DN60 OPERATOR MESSAGE AVAILABLE FLAG
					;On(-1) if have a message or if message
					;not completed
	LP	J$D6OB,OP$SIZ		;Parameter block for D60OPN
> ;End of IFN FTDN60
	LP	J$DFLG,1		;DN60 FLAG WORD
	LP	J$D6OP,1		;DN60 OPERATOR CONSOLE ID
	LP	J$LINK,1		;DN60 OPERATORS MSG LIST ID
	LP	J$OFLN,1		;DN60 PRINTER IS OFFLINE FLAG
	LP	J$LCLS,1		;LPT CONTROLLER CLASS
	LP	J$LIOA,1		;-1 IF WE ARE IN A SOUT OR OUT
	LP	J$LLPT,1		;-1 IF DEVICE REALLY IS A LPT
	LP	J$LIOS,1		;LPT IO ERROR STATUS
	LP	J$MTAP,1		;SIXBIT MAG TAPE DEVICE NAME
	LP	J$LCHN,1		;LPT I/O CHANNEL
	LP	J$LBTZ,1		;LPT OUTPUT BYTE SIZE
	LP	J$LSTG,2		;DEVICE NAME STRING
	LP	J$LIBC,1		;INITIAL BYTE COUNT
	LP	J$LIBP,1		;INITIAL BYTE POINTER

	;CONTINUED ON NEXT PAGE
	;CONTINUED FROM PREVIOUS PAGE

;CURRENT FORMS PARAMETERS

DEFINE	FF(X,Y),<
	LP	J$F'X,1
>

	LP	J$FCUR,0		;START OF FORMS PARAMS
	F				;CURRENT FORMS PARAMS

	LP	J$FORM,1		;CURRENT FORMS TYPE
	LP	J$FPFM,1		;PREVIOUS FORMS TYPE
	LP	J$PDRU,1		;PREVIOUS LOADED DRUM
	LP	J$PRIB,1		;PREVIOUS LOADED RIBBON
	LP	J$PTAP,1		;PREVIOUS LOADED CARRAIGE CONTROL TAPE
	LP	J$FMSP,1,Z		;FORMS WTO/WTOR PAGE ADDRESS
	LP	J$FWCL,1		;CURRENT WIDTH CLASS
	LP	J$FLCL,1		;Current length class
	LP	J$FLVT,1		;CURRENTLY 'LOADED' VFU TYPE
	LP	J$FLRM,1		;CURRENTLY 'LOADED' TRANSLATION RAM
	LP	J$FVIF,1		;IFN OF VFU FILE ON -10
	LP	J$FBYT,1,Z		;VFU INPUT BYTE COUNT.
	LP	J$FPTR,1		;VFU INPUT BYTE POINTER.
	LP	J$LVFF,1		;FIRST TIME THROUGH FLAG FOR LPT VFU'S
	LP	J$FNBK,16		;OPERATOR NOTE BLOCK

IF2,<	PURGE	J$FVFU,J$FCHA		;DON'T USE THESE   >

;ALIGN FILE PARAMETERS
	LP	J$APRG,1		;-1 IF ALIGN IS IN PROGRESS
	LP	J$AIFN,1		;ALIGN FILE IFN
	LP	J$ABYT,1		;ALIGN BUFFER BYTE COUNT.
	LP	J$APTR,1		;ALIGN BUFFER BYTE POINTER.
	LP	J$ASLP,1,Z		;SECONDS TO SLEEP
	LP	J$ACNT,1,Z		;LOOP COUNT
	LP	J$AFD,AFDSIZ		;THE FD FOR THE ALIGN FILE

;MISCELLANY
	LP	J$XTOP,1		;WE ARE AT TOP OF FORM
	LP	J$XFOB,FOB.SZ		;A FILE OPEN BLOCK
	LP	J$XPOS,1		;CURRENT VERTICAL POSITION
	LP	J$XHBF,<45>		;BUFFER TO BUILD HEADER LINE
	LP	J$XCOD,<^D55>		;COMPILE A ROUTINE TO CHECK
					; FOR MATCH ON /REPORT
	LP	J$XFRC,1		;FORTRAN CHARACTER REPEAT COUNT
	LP	J$XTBF,50		;$TEXT BUFFER FOR OUTPUT DEVICE
	LP	J$XTBP,1		;BYTE POINTER FOR J$XTBF.
	LP	J$RESP,2,Z		;OPERATOR RESPONSE BUFFER.
	LP	J$WTOR,^D50		;WTOR MESSAGE BUFFER.
	;ACCOUNTING PARAMETERS.

	LP	J$APRT,1,Z		;PAGE COUNT.
	LP	J$ADRD,1,Z		;DISK BLOCKS READ.
	LP	J$APRI,1,Z		;JOBS PRIORITY
	LP	J$ARTM,1,Z		;JOBS RUN TIME (CPU)
	LP	J$ASEQ,1,Z		;JOBS SEQUENCE NUMBER
	LP	J$AFXC,1,Z		;TOTAL FILES PRINTED (FILES*COPIES)

	;FORWARD SPACE / BACK SPACE PARAMETERS

	LP	J$FBPT,1		;CURRENT PAGE TABLE POSITION
	LP	J$FPAG,PAGSIZ		;BACKSPACE PAGE TABLE
	LP	J$FCBC,1,Z		;CURRENT INPUT BUFFER BYTE COUNT
	LP	J$FTBC,1,Z		;TOTAL INPUT BYTE COUNT
	LP	J$FPIG,1,Z		;NUMBER OF PAGES TO IGNORE

	;DISK FILE PARAMETERS

	LP	J$DIFN,1		;THE IFN
	LP	J$DFDA,1		;THE FD ADDRESS
	LP	J$DBPT,1		;BUFFER BYTE POINTER
	LP	J$DBCT,1,Z		;BUFFER BYTE COUNT

	;LOG FILE PARAMETERS

	LP	J$GBUF,^D10		;ADDRESS OF LOG FILE BUFFERS
	LP	J$GBFR,PAGSIZ		;FIRST LOG FILE BUFFER
	LP	J$GNLN,1,Z		;NUMBER OF LINES WRITTEN IN LOG
	LP	J$GIBC,1,Z		;INTERNAL LOG BYTE COUNT
	LP	J$GIBP,1,Z		;INTERNAL LOG BYTE POINTER
	LP	J$GINP,1,Z		;NUMBER OF INTERNAL LOG PAGES

	;PICTURE BLOCKS

	LP	J$PUSR,10		;USER NAME
	LP	J$PNOT,4		;/NOTE
	LP	J$PFL1,10		;FIRST LINE OF FILE NAME
	LP	J$PFL2,12		;SECOND LINE OF FILE NAME
	LP	J$PFLS,1		;BLOCKSIZE FOR FILENAME


	LP	J$$END,1		;END OF PARAMETER AREA

	J$$LEN==J$$END-J$$BEG		;LENGTH OF PARAMETER AREA

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

ZTABLE:					;PUT TABLE HERE

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

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

PDL:	BLOCK	PDSIZE		;PUSHDOWN LIST

MESSAG:	BLOCK	1		;ADDRESS OF MESSAGE JUST RECEIVED
BLKADR:	BLOCK	1		;IPCF MSG BLK ADDR SAVE AREA
TEXTBP:	BLOCK	1		;BYTE POINTER FOR DEPBP
SAB:	BLOCK	SAB.SZ		;A SEND ARGUMENT BLOCK
MSGBLK:	BLOCK	MSBSIZ		;A BLOCK TO BUILD MESSAGES IN.
FOB:	BLOCK	FOB.SZ		;A FILE OPEN BLOCK

FMOPN:	BLOCK	1		;SET TO -1 WHEN LPFORM IN OPEN
FMIFN:	BLOCK	1		;THE IFN FOR LPFORM.INI
IMESS:	BLOCK	1		;IPCF message -1=one to be released
LPCNF:	BLOCK	11		;SYSNAME
LPJOB:	BLOCK	1		;LPTSPL'S JOB NUMBER
LPTRM:	BLOCK	1		;TERMINAL DESIGNATOR
LPCON:	BLOCK	1		;CONNECT TIME
LPLNO:	BLOCK	1		;LINE NUMBER
JOBITS:	BLOCK	1		;SAVE JOB STATUS BITS FLAG.
STRSEQ:	EXP	4000		;STREAM SEQ #'S (START AT 4000)
SCHEDL:	-NPRINT,,0		;STREAM SCHEDULING DATA

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

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

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

TOPS20 <
SPLDIR:	BLOCK	1		;DIRECTORY NUMBER OF PS:<SPOOL>
>  ;END TOPS20 CONDITIONAL
	SUBTTL	Resident JOB Database

STREAM:	BLOCK	1		;CURRENT STREAM NUMBER

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

JOBOBA:	BLOCK	NPRINT		;TABLE OF OBJECT BLOCK ADDRESSES

JOBSTW:	BLOCK	NPRINT		;JOB STATUS WORD

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

JOBOBJ:	BLOCK	3*NPRINT	;LIST OF SETUP OBJECTS

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

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

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

JOBWAC:	BLOCK	NPRINT		;STREAM WTOR ACK CODE.


;SCHEDULER FLAGS
	PSF%OB==1B1		;OUTPUT BLOCKED
	PSF%DO==1B2		;DEVICE IS OFF-LINE
	PSF%ST==1B3		;STOPPED BY OPERATOR
	PSF%OR==1B4		;OPERATOR RESPONSE WAIT
	PSF%AL==1B5		;ALIGNMENT TIMER WAIT STATE.
	PSF%OO==1B6		;WAITING FOR 2780/3780 OPERATOR OUTPUT

DEFINE $DSCHD(FLAGS),<
	PUSHJ	P,DSCHD
	XLIST
	JUMP	[EXP FLAGS]
	LIST
	SALL
>  ;END DEFINE $DSCHD

DEFINE $D60ER(ADD),<
	PUSHJ	P,D60ER
	XLIST
	JUMP	ADD
	LIST
	SALL
>  ;END DEFINE $D60ER
DEFINE $D60OE(ADD),<
	PUSHJ	P,D60OE
	XLIST
	JUMP	ADD
	LIST
	SALL
>  ;END DEFINE $D60OE
	SUBTTL	IB and HELLO message blocks


	TOPS10	<INTVEC==VECTOR>

	TOPS20	<INTVEC==:LEVTAB,,CHNTAB>



IB:	$BUILD	IB.SZ				;
	 $SET(IB.PRG,,%%.MOD)			;SET UP PROGRAM NAME
	 $SET(IB.INT,,INTVEC)			;SET UP INTERRUPT VECTOR ADDRESS
	 $SET(IB.PIB,,PIB)			;SET UP PIB ADDRESS
	 $SET(IB.FLG,IP.STP,1)			;STOPCODES TO ORION
	$EOB					;


PIB:	$BUILD	PB.MNS				;
	 $SET(PB.HDR,PB.LEN,PB.MNS)		;PIB LENGTH,,0
	 $SET(PB.FLG,IP.PSI,1)			;PSI ON
	 $SET(PB.INT,IP.CHN,0)			;INTERRUPT CHANNEL
	$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

OACERR:	BLOCK	1			;'OUTGET' ROUTINE RETURN CODE

SETMSG:	[ASCIZ/Started/]
	[ASCIZ/Not available right now/]
	[ASCIZ/Does not exist/]


LIMSG:	ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue printing/
	SUBTTL	$TEXT Utilities


DEPBP:	IDPB	S1,TEXTBP		;DEPOSIT THE BYTE
	$RETT				;AND RETURN


;OPERATING SYSTEM DEPENDENT ITEXTS


;LOG FILE STAMPS
LPMSG:	ITEXT(<^C/[-1]/ LPMSG	>)
LPDAT:	ITEXT(<^C/[-1]/ LPDAT	>)
LPOPR:	ITEXT(<^C/[-1]/ LPOPR	>)
LPEND:	ITEXT(<^C/[-1]/ LPEND	>)
LPERR:	ITEXT(<^C/[-1]/ LPERR	? >)
DATMON:	ITEXT(<  Date ^H/[-1]/ Monitor: ^T/LPCNF/ ^T7C*/0(T4)/>)
	SUBTTL 	LPTSPL - Multiple Line Printer Spooler.

LPTSPL:	RESET				;AS USUAL.
	MOVE	P,[IOWD PDSIZE,PDL]	;SET UP THE STACK.
	MOVEI	S1,IB.SZ		;GET THE IB SIZE.
	MOVEI	S2,IB			;ADDRESS OF THE IB.
	PUSHJ	P,I%INIT		;SET UP THE WORLD.
	PUSHJ	P,INTINI		;SET UP THE INTERRUPT SYSTEM.
	PUSHJ	P,OPDINI		;GET OPERATING SYSTEM INFO.
	PUSHJ	P,I%ION			;TURN ON INTERRUPTS.
	MOVEI	T1,HELLO		;GET ADDRESS OF HELLO MESSAGE.
	PUSHJ	P,SNDQSR		;SAY HI TO QUASAR.
	MOVSI	P1,-NPRINT		;SET UP STREAM COUNTER.

	;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	DSTATUS			;Do any status stuff
	SKIPE	JOBSTW(P1)		;IS THE STREAM BLOCKED ???
	JRST	MAIN.2			;YES,,GET THE NEXT STREAM.
	MOVEM	P1,SCHEDL		;SAVE THE SCHEDULING STREAM.
	MOVSI	0,J$RACS+1(J)		;Setup first source address for BLT
	HRRI	0,1			;Setup first destination address
	BLT	0,17			;GET SOME ACS
	POPJ	P,			;AND RETURN

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

MAIN.2:	AOBJN	P1,MAIN			;LOOP BACK FOR SOME MORE.
	PUSHJ	P,CHKQUE		;CHECK FOR INCOMMING MESSAGES.
	SKIPE	MESSAGE			;DID WE PROCESS A MESSAGE ???
	JRST	MAIN.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
TOPS20 <
	SKIPE	JOBACT			;CHECK IF STREAM ACTIVE..
	SKIPE	JOBSTW			;ANY BLOCKING CONDITIONS
>;END TOPS20 CONDITIONAL

	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	CHKTIM - ROUTINE TO CHECK WAKEUP TIME BASED ON CURRENT STREAM

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

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

CHKTIM:	PUSHJ	P,I%NOW			;GET CURRENT TIME INTO S1
	MOVE	T1,STREAM		;Get our stream number
	MOVE	S2,JOBWKT(T1)		;Get wakeup time of job
	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 DSCHD -- Deschedule process

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

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

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

; ASSUMPTIONS. . .

; 1.  STREAM is assumed to be correct.

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

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

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

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

;Save the AC's in any case

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

	MOVE 	T1,STREAM		;Get the current stream number

;Take care of the flags passed

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

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

;Check to see our current context

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

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

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

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

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

	JRST	MAIN.3			;Return to restart main loop

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

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

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

	SUBTTL FIXACT - Routine to set stream to inactive

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

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

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

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

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

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

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

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

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

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

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

DOFFOR:	$CALL	FORMS			;Try to set the forms

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

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

	SETZM	J$RACS+S(J)		;Clear status bits
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBACT(S1)		;No longer active
	PJRST	MAIN.3			;Go back to the scheduler
	SUBTTL	NXTJOB -- NEXTJOB Message from QUASAR

NXTJOB:	HRR	S1,J			;GET 0,,DEST
	HRL	S1,M			;GET SOURCE,,DEST
	LOAD	S2,.MSTYP(M),MS.CNT	;GET LENGTH OF MESSAGE
	ADDI	S2,-1(J)		;GET ADR OF END OF BLT
	BLT	S1,(S2)			;BLT THE DATA
	MOVE	S1,STREAM		;GET STREAM NUMBER
	SETOM	JOBACT(S1)		;MAKE THE STREAM ACTIVE
	SETZM	JOBCHK(S1)		;CHECKPOINT FIRST CHANCE WE GET !!!
	SETOM	JOBUPD(S1)		;Send update also.
	MOVX	S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL ;GET LOTS OF BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR THEM
	MOVEI	S1,J$RPDL-1(J)		;POINT TO CONTEXT PDL
	HRLI	S1,-PDSIZE		;AND THE LENGTH
	PUSH	S1,[EXP DOJOB]		;PUSH THE FIRST ADR ON THE STACK
	MOVEM	S1,J$RACS+P(J)		;AND STORE THE PDL
	SETZB	S,J$RACS+S(J)		;CLEAR FLAGS AC
	LOAD	S1,.EQSPC(J),EQ.NUM	;GET NUMBER OF FILES
	MOVEM	S1,J$RFLN(J)		;STORE IT
	MOVEI	S1,J$$BEG(J)		;PREPARE TO ZERO SELECTED WORDS JOB AREA
	MOVSI	S2,-<J$$LEN+^D35>/^D36	;AOBJN POINTER TO BIT TABLE
NXTJ.2:	MOVEI	T1,^D36			;BIT COUNTER FOR THIS WORD
	MOVE	T2,ZTABLE(S2)		;GET A WORD FROM BIT TABLE
NXTJ.3:	JUMPE	T2,NXTJ.4		;DONE IF REST OF WORD IS ZERO
	JFFO	T2,.+1			;FIND THE FIRST 1 BIT
	ADD	S1,T3			;MOVE UP TO THE CORRESPONDING WORD
	SETZM	0(S1)			;AND ZERO IT
	SUB	T1,T3			;REDUCE BITS LEFT IN THIS WORD
	LSH	T2,0(T3)		;SHIFT OFFENDING BIT TO BIT 0
	TLZ	T2,(1B0)		;AND GET RID OF IT
	JRST	NXTJ.3			;AND LOOP
NXTJ.4:	ADD	S1,T1			;ACCOUNT FOR THE REST OF THE WORD
	AOBJN	S2,NXTJ.2		;AND LOOP
	$TEXT(LOGCHR,<^M^J^I/LPDAT/LPTSPL version ^V/[%LPT]/	^T/LPCNF/>)
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	$TEXT(LOGCHR,<^I/LPDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on ^B/@JOBOBA(S1)/ at ^H/[-1]/>)
	SKIPN	T2,.EQCHK+CKFLG(J)	;GET THE CHECKPOINT FLAGS
	JRST	NXTJ.5			;AND JUMP IF NEW JOB
	MOVEI	T1,[ASCIZ /system failure/]
	TXNE	T2,CKFREQ		;WAS IT A REQUEUE
	MOVEI	T1,[ASCIZ /requeue by operator/]
	$TEXT(LOGCHR,<^I/LPMSG/Job being restarted after ^T/0(T1)/>)

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

NXTJ.5:	LOAD	S1,.EQSEQ(J),EQ.IAS	;IS THIS AN INVALID REQUEST ???
	SKIPE	S1			;IS THIS AN INVALID REQUEST ???
	$TEXT	(LOGCHR,<^I/LPERR/Invalid Account String Specified (^T/.EQACT(J)/)>)
	GETLIM	T1,.EQLIM(J),OLIM	;GET PAGE LIMIT
	MOVEM	T1,J$RLIM(J)		;SAVE IT
	PUSHJ	P,ACTBEG		;GO SETUP THE ACCOUNTING PARMS
	PUSHJ	P,I%NOW			;GET TIME OF DAY
	MOVEM	S1,J$RTIM(J)		;SAVE IT AWAY
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	$WTOJ  (Begin,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	PUSHJ	P,TBFINI		;INITIALIZE THE BUFFER
	PUSHJ	P,CHKLPT		;GO MAKE SURE THE DEVICE IS ONLINE
	$RETT				;AND RETURN
	SUBTTL	DOJOB -- Do the Job

DOJOB:	PUSHJ	P,FORMS			;GET FORMS MOUNTED
	JUMPF	ENDREQ			;CANT DO IT,,END THE REQUEST
	$CALL	CHKALN			;Do an alignment if needed
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET INVALID ACCOUNT STRING BIT
	STORE	S1,S,ABORT		;SAVE IT AS THE ABORT BIT
	TXO	S,BANHDR		;LITE 'PRINTING BANNERS' FLAG
	PUSHJ	P,JOBHDR		;PRINT THE BANNER
	TXZ	S,BANHDR		;CLEAR 'PRINTING BANNERS' FLAG
	LOAD	E,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	E,J			;POINT TO FIRST FILE
	SETZM	J$RNFP(J)		;ZAP THE # OF FILES PRINTED
	TXO	S,INJOB			;We are in a job now
	SKIPN	.EQCHK+CKFLG(J)		;IS THIS A RESTARTED JOB?
	JRST	DOJO.4			;NO, SKIP ALL THIS STUFF
	MOVE	T1,.EQCHK+CKFIL(J)	;YES, GET NUMBER OF FILES DONE
	MOVEM	T1,J$RNFP(J)		;STORE FOR NEXT CHECKPOINT

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

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

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

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

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


NXTFIL:	SETZM	J$RNCP(J)		;CLEAR COPIES PRINTED
	SOSG	J$RFLN(J)		;DECREMENT FILE COUNT
	$RETF				;NO MORE, DONE
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	E,S1			;BUMP TO THE FD
	LOAD	S1,.FDLEN(E),FD.LEN	;GET THE FD LENGTH
	ADD	E,S1			;BUMP TO THE NEXT FP
	LOAD	S1,.FPINF(E),FP.FLG	;GET LOG FILE FLAG
	JUMPE	S1,.RETT		;RETURN IF NOT THE LOG FILE
	MOVEM	E,J$RLFS(J)		;SAVE ADDRESS OF LOG FILE SPEC
	JRST	NXTFIL			;AND LOOP



	SUBTTL	FILDIS -- ROUTINE TO KEEP/DELETE PRINTED SPOOL 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,.FPLEN(E),FD.LEN	;GET THE FD LENGTH.
	ADD	E,S2			;POINT 'E' AT NEXT FILE.
	SETZM	J$XFOB+FOB.US(J)	;DEFAULT TO NO ACCESS CHECKING
	SETZM	J$XFOB+FOB.CD(J)	;HERE ALSO
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET THE USERS PRIVILGE BITS
	JUMPN	S1,FILD.2		;IF SET, AVOID ACCESS CHECK
	TXNE	T2,FP.SPL		;WAS IT A SPOOLED FILE ???
	JRST	FILD.2			;YES,,THEN NO ACCESS CHECK
TOPS10<	MOVE	S1,.EQOID(J)		;GET THE PPN
	STORE	S1,J$XFOB+FOB.US(J)	;AND SAVE IT
>  ;END TOPS10 CONDITIONAL

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

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

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

FILE.1:	PUSHJ	P,INPREW		;REWIND THE INPUT FILE
	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBCHK(S1)		;Want a checkpoint
	$CALL	DSTATUS			;Do the status
	PUSHJ	P,SETLST		;SETUP /REPORT CODE IF NECESSARY
	TXZ	S,FORWRD		;CLEAR FORWARD SPACE BIT
	TXO	S,BANHDR		;LITE 'PRINTING HEADERS' FLAG
	PUSHJ	P,HEAD			;PRINT THE HEADER
	TXZ	S,BANHDR		;CLEAR 'PRINTING HEADERS' FLAG
	MOVEI	S1,LPTERR		;GET NUMBER OF DEVICE ERRORS ALLOWED
	MOVEM	S1,J$LERR(J)		;AND SAVE IT
	SOSLE	J$FPIG(J)		;SUBTRACT 1 PAGE FROM STARTING PAGE #.
	TXO	S,FORWRD		;STILL POSITIVE,,TURN ON FORWARD BIT.
	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:	SKIPE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REL			;RELEASE IT
	SETZM	J$DIFN(J)		;Clear the IFN
	$TEXT (LOGCHR,<^I/LPMSG/Finished File ^F/@J$DFDA(J)/>)
	MOVE	S1,J$DFDA(J)		;GET FD ADDRESS
	PUSHJ	P,STRDMO		;DISMOUNT THE STR
	TXNE	S,SUPFIL		;Are we suppressing forms/file?
	SETZM	J$XTOP(J)		;Yes, set we are not at top of page.
	TXZ	S,SKPFIL+SUPFIL		;CLEAR LOTS OF BITS
	POPJ	P,			;AND RETURN
	SUBTTL	ENDJOB -- END OF JOB PROCESSOR.

ENDJOB:	TXO	S,GOODBY		;FLAG EOJ SEQUENCE
	TXZ	S,FORWRD		;TURN OFF THE FORWARD SPACING BIT.
	$TEXT	(LOGCHR,<^I/LPEND/Summary:^D5/J$APRT(J)/ Pages of Output>)

TOPS10 <
	$TEXT	(LOGCHR,<^I/LPEND/        ^D5/J$ADRD(J)/ Disk Blocks Read>)
> ;END TOPS10 CONDITIONAL

TOPS20 <
	MOVE	S1,J$ADRD(J)		;GET THE NUMBER OF I/O REQUESTS
	IMULI	S1,SZ.BUF		;CALC NUMBER OF WORDS PROCESSED
	IDIVI	S1,PAGSIZ		;CALC NUMBER OF PAGES PROCESSED
	SKIPE	S2			;ANY REMAINDER ???
	ADDI	S1,1			;YES,,ADD 1 PAGE
	MOVEM	S1,J$ADRD(J)		;SAVE THE # 0F PAGES FOR ACCOUNTING
	$TEXT	(LOGCHR,<^I/LPEND/        ^D5/J$ADRD(J)/ Disk Pages Read>)
	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/      ^D3R /S1/.^D3L0/S2/ Seconds CPU Time Used>)
> ;END TOPS20 CONDITIONAL

	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,QRELEASE		;GO SEND THE RELEASE/REQUEUE MSG.
	SETZM	J$RACS+S(J)		;CLEAR ALL THE STATUS BITS.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	SETZM	JOBACT(S1)		;NOT BUSY
	JRST	MAIN.3			;RETURN TO THE SCHEDULER.
	SUBTTL	QRELEASE -- ROUTINE TO SEND A REQUEUE/RELEASE MSG TO QUASAR.

QRELEA:	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	$WTOJ	(End,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;TELL THE OPERATOR.
	SKIPE	J$LREM(J)		;IF THIS IS A LOCAL LPT,,SKIP LOGGING
	$LOG	(Printed ^D/J$APRT(J)/ Pages,,@JOBOBA(S1)) ;LOG # OF PAGES
	MOVEI	S1,MSBSIZ		;GET BLOCK LENGTH
	MOVEI	S2,MSGBLK		;AND THE ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO THE BLOCK
	TXNE	S,RQB			;IS THIS A REQUEUE?
	JRST	RELE.1			;YES
	PUSHJ	P,FILDIS		;GO CLEAN UP THE SPOOL FILES.
	PUSHJ P,ACTEND			;GO DO THE ACCOUNTING
	MOVEI	T1,MSGBLK		;GET ADDRESS OF THE BLOCK
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REL.IT(T1)		;STORE IT
	MOVX	S1,REL.SZ		;NO, GET RELEASE MESSAGE SIZE
	MOVX	S2,.QOREL		;AND FUNCTION
	JRST	RELE.2			;AND MEET AT THE PASS

RELE.1:	MOVEI	T1,MSGBLK		;GET ADDRESS OF THE BLOCK
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REQ.IT(T1)		;STORE IT
	LOAD	S1,J$RNFP(J)		;GET NUMBER OF FILES PRINTED
	STORE	S1,REQ.IN+CKFIL(T1)	;STORE IT
	LOAD	S1,J$RNCP(J)		;GET COPIES PRINTED
	STORE	S1,REQ.IN+CKCOP(T1)	;STORE IT
	LOAD	S1,J$RNPP(J)		;GET PAGES PRINTED
	STORE	S1,REQ.IN+CKPAG(T1)	;AND STORE IT
	LOAD	S1,J$APRT(J)		;GET TOTAL PAGES PRINTED.
	STORE	S1,REQ.IN+CKTPP(T1)	;STORE IT
	MOVX	S1,CKFREQ		;GET REQEUE BIT
	STORE	S1,REQ.IN+CKFLG(T1)	;STORE IT
	MOVX	S1,RQ.HBO		;GET HOLD BY OPERATOR
	STORE	S1,REQ.FL(T1)		;STORE IN FLAG WORD
	MOVX	S1,REQ.SZ		;GET SIZE
	MOVX	S2,.QOREQ		;AND FUNCTION

RELE.2:	STORE	S1,.MSTYP(T1),MS.CNT	;STORE SIZE
	STORE	S2,.MSTYP(T1),MS.TYP	;AND CODE
	PUSHJ	P,SNDQSR		;SEND IT TO QUASAR
	$RETT				;AND RETURN.
	SUBTTL	CHKQUE -- ROUTINE TO RECIEVE AND SCHEDULE IPCF MESSAGES

CHKQUE:	SETZM	MESSAG			;NO MESSAGE YET
	PUSHJ	P,C%RECV		;RECEIVE A MESSAGE
	JUMPF	.POPJ			;RETURN,,NOTHING THERE.
	SETOM	IMESS			;Have a message
	SETZM	BLKADR			;CLEAR THE IPCF MSG BLK ADDR SAVE AREA
	LOAD	S2,MDB.SI(S1)		;GET SPECIAL INDEX WORD
	TXNN	S2,SI.FLG		;IS THERE AN INDEX THERE?
	JRST	CHKQ.5			;NO, IGNORE IT
	ANDX	S2,SI.IDX		;AND OUT THE INDEX
	CAIE	S2,SP.OPR		;IS IT FROM OPR?
	CAIN	S2,SP.QSR		;IS IT FROM QUASAR?
	SKIPA				;Yes, continue on
	JRST	CHKQ.5			;Go to release the message
CHKQ.2:	LOAD	M,MDB.MS(S1),MD.ADR	;GET THE MESSAGE ADDRESS
	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.
	PUSHJ	P,CHKOBJ		;GO FIND THE OBJECT BLOCK.
	JUMPF	CHKQ.5			;NOT THERE,,JUST DELETE IT
	PUSHJ	P,@RUTINE		;DISPATCH THE MESSAGE PROCESSOR.
	SKIPN	JOBITS			;DO WE WANT TO SAVE THE STATUS BITS ??
	MOVEM	S,J$RACS+S(J)		;YES,,SAVE THE STATUS BITS.
	SETZM	JOBITS			;CLEAR 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		;ABORT MESSAGE
	XWD	DSTATUS,.QORCK		;REQUEST-FOR-CHECKPOINT
	XWD	NXTJOB,.QONEX		;NEXTJOB
	XWD	SETUP,.QOSUP		;SETUP/SHUTDOWN
	XWD	OACCON,.OMCON		;OPERATOR CONTINUE REQUEST.
	XWD	OACRSP,.OMRSP		;OPERATOR WTOR RESPONSE.
	XWD	OACREQ,.OMREQ		;OPERATOR REQUEUE REQUEST.
	XWD	OACCAN,.OMCAN		;OPERATOR CANCEL REQUEST.
	XWD	OACPAU,.OMPAU		;OPERATOR PAUSE/STOP REQUEST.
	XWD	OACFWS,.OMFWS		;OPERATOR FORWARD SPACE REQUEST.
	XWD	OACALI,.OMALI		;OPERATOR ALIGN REQUEST.
	XWD	OACSUP,.OMSUP		;OPERATOR SUPPRESS REQUEST.
	XWD	OACBKS,.OMBKS		;OPERATOR BACKSPACE REQUEST.
	XWD	QSRNWA,.QONWA		;QUASAR NODE-WENT-AWAY MESSAGE
	XWD	OPRD60,.OMDSP		;DN60 OPERATOR RESPONSE MESSAGE
	XWD	FORFOR,.QOFCH		;Force forms message

	NMSGT==.-MSGTAB
	SUBTTL	CHKOBJ -- ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.

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


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

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

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

MSGOBJ:	MOVEI	S1,ABO.TY(M)		;GET ABORT MSG OBJ ADDRESS.
	MOVEI	S1,RCK.TY(M)		;GET CHECKPOINT MSG OBJ ADDRESS.
	MOVEI	S1,.EQROB(M)		;GET NEXTJOB MSG OBJ ADDRESS.
	SUBTTL	GETBLK -- ROUTINE TO BREAK DOWN AN IPCF MSG INTO ITS DATA BLOCKS

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

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

KILL:	TXNE	S,GOODBY+ABORT		;CHECK SOME BITS
	$RETT				;IF WE LEAVING, IGNORE IT ANYWAY
	$TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^U/ABO.ID(M)/>)
	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	ANDCAM	S2,JOBSTW(S1)		;ZAP THE OPR WAIT BIT
	$WTOJ	(<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	TXO	S,ABORT			;LITE THE ABORT BIT
	PUSHJ	P,INPFEF		;FORCE END OF FILE
	TXNE	S,BANHDR		;ARE WE PRINTING BANNER/HEADER PAGES ???
	$RETT				;YES,,JUST RETURN
	PUSHJ	P,OUTFLS		;NO,,FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN !!!
	$RETT				;RETURN





	SUBTTL	QSRNWA - ROUTINE TO SHUTDOWN A STREAN WHOSE NODE HAS DROPPED

QSRNWA:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	SKIPE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REL			;YES,,CLOSE IT
	SETZM	J$DIFN(J)		;Clear the IFN
	MOVX	S1,%RSUNA		;GET NOT AVAILABLE RIGHT NOW BITS
	PUSHJ	P,RSETUP		;TELL QUASAR HE CAN HAVE THE OBJ BACK
	PUSHJ	P,SHUTND		;SHUT THE STREAM DOWN
	$RETT				;AND RETURN
	SUBTTL	DSTATUS -- Send status info

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

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

UPDATE is called based on JOBUPD.

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

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

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

\	;End of comment

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

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

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

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

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

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

CHKPNT:	MOVEI	T1,MSGBLK		;LOAD THE ADDRESS OF THE MESSAGE BLK.
	MOVX	S1,CH.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
	$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
	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	UPDATE -- ROUTINE TO SEND STATUS UPDATES TO QUASAR

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

UPDATE:	MOVE	S2,JOBPAG(P1)		;Get the jobpage
	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.SZ-1(T1)	;COPY THE OBJ BLK OVER TO THE MSG
	MOVX	S1,STU.SZ		;GET THE MESSAGE LENGTH
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE IT
	MOVX	S1,.QOSTU		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(T1),MS.TYP	;SAVE IT
	PUSHJ	P,SNDQSR		;SEND IT OFF TH QUASAR
	$RETT				;AND RETURN
	SUBTTL	SETUP/SHUTDOWN Message processing

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

SETU.1:	SKIPN	JOBPAG(T2)		;A FREE STREAM?
	JRST	SETU.2			;YES!!
	CAIGE	T2,NPRINT-1		;NO, LOOP THRU THEM ALL?
	AOJA	T2,SETU.1		;NO, KEEP GOING
	$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.SZ		;GET OFFSET OF OBJECT BLOCK
	ADDI	T2,JOBOBJ		;ADD IN THE BASE
	MOVEM	T2,JOBOBA(S2)		;STORE OBJECT ADDRESS
	MOVE	S2,T2			;GET DESTINATION OF BLT INTO S2
	HRLI	S2,SUP.TY(M)		;MAKE A BLT POINTER
	BLT	S2,OBJ.SZ-1(T2)		;BLT THE OBJECT BLOCK

	SETZM	J$LREM(J)		;DEFAULT TO LOCAL LPT
	MOVE	S1,SUP.NO(M)		;GET THIS GUYS NODE NAME
	CAMN	S1,CNTSTA		;IS IT A LOCAL LPT ???
	JRST	SETU.3			;YES,,SKIP THIS
	SKIPN	SUP.CN(M)		;IS THIS A DN60 REMOTE ???
	JRST	[SETOM  J$LREM(J)	;NO,,MUST BE DN200 - SET DN200 FLAG
		 JRST	SETU.3    ]	;AND CONTINUE PROCESSING

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

IFN FTDN60,<
	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
	MOVEI	S1,1			;GET A 1 (DN60 FLAG)
	MOVEM	S1,J$LREM(J)		;MAKE THIS A DN60 REMOTE
	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.4			;GO SETUP OUTPUT DEVICE

SETU.3:	MOVE	S1,SUP.ST(M)		;GET A POSSIBLE MAG TAPE DEVICE NAME
	LOAD	S2,SUP.FL(M),SPLTAP	;GET THE SPOOL-TO-TAPE BIT
	SKIPE	S2			;ARE WE SPOOLING TO TAPE ???
	MOVEM	S1,J$MTAP(J)		;YES,,SAVE THE DEVICE NAME

SETU.4:
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
	PUSH	P,S1			;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.
	$WTO  (<^T/@SETMSG(T2)/>,,@JOBOBA(S1))  ;TELL THE OPR WHATS GOING ON.
	CAIE	T2,%RSUOK		;ALL IS OK?
	$CALL	SHUTND			;NO, SHUT IT DOWN
	$RETT				;RETURN
	SUBTTL	SHUTDN -- ROUTINE TO SHUT DOWN A LINE-PRINTER


SHUTDN:	MOVEI	S1,SUP.TY(M)		;GET THE OBJECT BLOCK ADDRESS
	PUSHJ	P,FNDOBJ		;FIND THE OBJECT BLOCK
	JUMPF	.RETT			;NO OBJECT,,THEN NOTHING TO SHUT DOWN
SHUTND:	SKIPA	T4,[EXP 0]		;INDICATE 'OUT OF STREAM' CONTEXT
SHUTIN:	SETOM	T4			;INDICATE 'IN STREAM' CONTEXT
	SKIPL	J$LCHN(J)		;DO WE HAVE AN OUTPUT CHANNEL ???
	PUSHJ	P,OUTREL		;YES,,RELEASE THE OBJECT
	SKIPE	S1,J$DIFN(J)		;Get the IFN
	PUSHJ	P,F%REL			;YES,,CLOSE IT
	SETZM	J$DIFN(J)		;Clear the IFN
	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
	PUSHJ	P,M%CLNC		;GET RID OF UNWANTED PAGES.
	SETOM	JOBITS			;SAY WE DONT WANT TO SAVE STATUS BITS.
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	SETZM	JOBPAG(S1)		;CLEAR THE PAGE WORD
	SETZM	JOBACT(S1)		;AND THE ACTIVE WORD
	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	SETZM	JOBWAC(S1)		;Clear it just in case
	JUMPE	T4,.RETT		;'OUT OF STREAM',,JUST RETURN
	JRST	MAIN.3			;'IN STREAM',,RETURN TO THE SCHEDULER


	SUBTTL	RSETUP -- ROUTINE TO SEND A RESPONSE-TO-SETUP MSG 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.SZ-1(T1)	;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
	STORE	S1,RSU.DA(T1),RO.ATR	;STORE THE DEVICE ATRRIBUTES
	PUSHJ	P,SNDQSR		;AND SEND THE MESSAGE
	$RETT				;RETURN.
	SUBTTL	OACRSP -- OPERATOR RESPONSE TO A WTOR PROCESSOR.

OACRSP:	SETOM	JOBITS			;DON'T UPDATE STATUS BITS
	MOVE	S2,.MSCOD(M)		;GET WTOR ACK CODE.
	MOVSI	S1,-NPRINT		;CREATE AOBJN AC.
RESP.1:	CAME	S2,JOBWAC(S1)		;COMPARE ACK CODES..
	JRST	[AOBJN S1,RESP.1	;NOT EQUAL,,CHECK NEXT STREAM.
		 $RETT	]		;NOT THERE,,FLUSH THE MSG.
	MOVX	S2,PSF%OR		;GET "OPERATOR-RESPONSE" WAIT BIT
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR IT
	SETOM	JOBUPD(S1)		;Update the stream's status
	MOVE	J,JOBPAG(S1)		;GET THE STREAM DB ADDRESS.
	DMOVE	S1,.OHDRS+ARG.DA(M)	;GET THE OPERATORS RESPONSE.
	DMOVEM	S1,J$RESP(J)		;AND SAVE IT.
	$RETT				;AND RETURN
	SUBTTL OACCAN -- Operator CANCEL request.

OACCAN:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,STREAM		;GET STREAM NUMBER.
	$ACK  (Aborting,<^R/.EQJBB(J)/>,@JOBOBA(P1),.MSCOD(M)) ;TELL THE OPR.
	SETZM	J$APRG(J)		;ALIGNMENT NOT SCHEDULED,,NOT ACTIVE !!
	SETZM	JOBWKT(P1)		;SET WAKE UP TIME TO NOW.
	SETZM	RSNFLG			;SHOW NO REASON GIVEN.
	MOVX	S1,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S1,JOBSTW(P1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(P1))		;YES,,KILL THE WTOR
	ANDCAM	S1,JOBSTW(P1)		;ZAP THE OPR WAIT BIT

OACC.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	OACC.2			;NO MORE,,FINISH UP
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	MOVEM	T3,RSNFLG		;YES,,SAVE THE REASON ADDRESS
	CAIE	T1,.CANTY		;IS THIS THE CANCEL TYPE BLOCK ???
	JRST	OACC.0			;NO,,SKIP IT AND GET NEXT BLOCK
					;YES...
	MOVE	S1,0(T3)		;LOAD THE CANCEL TYPE.
	CAIE	S1,.CNPRG		;IS IT /PURGE ???
	JRST	OACC.0			;NO,,PROCESS THE NEXT MSG BLK
	SKIPE	S1,J$DIFN(J)		;GET THE FILE IFN.
	PUSHJ	P,F%REL			;ELSE,,CLOSE IT OUT.
	SETZM	J$DIFN(J)		;Clear the IFN
	MOVEM	S,J$RACS+S(J)		;SAVE THE 'S' AC WITH NEW DSKOPN BITS
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTND			;CANT,,SHUT IT DOWN
	PUSHJ	P,SENDFF		;OUTPUT A FORM FEED FOR NEXT JOB
	SETZM	JOBACT(P1)		;STREAM IS NO LONGER ACTIVE
	PUSHJ	P,QRELEASE 		;RELEASE THE REQUEST
	PUSHJ	P,OUTEOF		;OUTPUT AN EOF
	$RETT				;AND RETURN

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

RSNFLG:	0,,0
	SUBTTL OACSUP -- Operator SUPPRESS request.

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

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

	TXZ	S,SUPJOB!SUPFIL		;TURN OFF SUPPRESS FILE AND JOB BIT
	$TEXT (LOGCHR,<^I/LPOPR/Operator stopped carriage control supression>)
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	$ACK  (Carriage control activated,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	$RETT				;RETURN NOW

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

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

OACS.3:	$TEXT(LOGCHR,<^I/LPOPR/Operator suppressed carriage control for rest of ^T/0(S1)/>)
	MOVE	S1,STREAM		;GET STREAM NUMBER.
	$ACK (Carriage control suppressed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	$RETT				;RETURN NOW
	SUBTTL OACPAU -- Operator PAUSE request.

OACPAU:	MOVX	S2,PSF%ST		;LOAD THE STOP BIT
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	IORM	S2,JOBSTW(S1)		;SET IT
	$ACK  (Stopped,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
	SETZM	JOBCHK(S1)		;SAY WE WANT A CHECKPOINT TAKEN.
	SETOM	JOBUPD(S1)		;Update the status also.
	$RETT				;AND RETURN



	SUBTTL OACCON -- Operator CONTINUE request.

OACCON:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%ST!PSF%DO	;LOAD THE BITS
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
	$ACK  (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
	SETOM	JOBUPD(S1)		;Do an update
					;  don't need checkpoint
					;  did one when we stopped
	$RETT				;AND RETURN
	SUBTTL	OACREQ -- Operator REQUEUE request.

OACREQ:	TXNE	S,GOODBY		;IS IT TOO LATE FOR THIS ???
	PJRST	TOOBAD			;YES,,TOUGH LUCK !!!
	PUSHJ	P,INPFEF		;FORCE AN INPUT EOF
	TXO	S,RQB+ABORT		;LITE THE REQUEUE+ABORT BITS
	$TEXT(LOGCHR,<^I/LPOPR/Job requeued by the the operator>)
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	$ACK	(Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR

	MOVX	S2,PSF%OR		;GET OPR RESP WAIT BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR THE OPERATOR ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL THE WTOR
	ANDCAM	S2,JOBSTW(S1)		;ZAP THE OPR WAIT BIT

OACR.0:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	.RETT			;NO MORE,,RETURN
	CAIN	T1,.REQTY		;IS THIS THE REQUEST TYPE BLOCK ???
	JRST	OACR.1			;YES,,GO PROGESS IT
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	$TEXT (LOGCHR,<^I/LPOPR/Requeue reason is: ^T/0(T3)/.>)
	JRST	OACR.0			;PROCESS THE NEXT MSG BLOCK

OACR.1:	MOVE	S1,0(T3)		;PICK UP THE REQUEUE CODE.
	SETZ	S2,			;ZERO AC 2
	CAXN	S1,.RQCUR		;/CURRENT?
	JRST	OACR.3			;YES, DO IT
	SETZM	J$RNPP(J)		;CLEAR CURRENT PAGE NUMBER
	CAXN	S1,.RQBCP		;BEGINNING OF COPY?
	MOVEI	S2,[ASCIZ /current copy/]
	JUMPN	S2,OACR.2		;AND CONTINUE ON
	SETZM	J$RNCP(J)		;CLEAR CURRENT COPY NUMBER
	CAXN	S1,.RQBFL		;FROM BEGINING OF FILE?
	MOVEI	S2,[ASCIZ /current file/]
	JUMPN	S2,OACR.2		;AND CONTINUE ON
	SETZM	J$RNFP(J)		;CLEAR FILE COUNT
	MOVEI	S2,[ASCIZ /job/]	;FROM BEGINNING OF JOB
OACR.2:	$TEXT(LOGCHR,<^I/LPOPR/Job will restart at the beginning of the ^T/0(S2)/>)
	JRST	OACR.0			;GO PROCESS THE NEXT MSG BLOCK.

OACR.3:	$TEXT(LOGCHR,<^I/LPOPR/Job will restart at the current position>)
	MOVNI	S1,2			;LOAD -2
	ADDM	S1,J$RNPP(J)		;INSURE NO LOSSAGE OF DATA
	ADDM	S1,J$APRT(J)		;HERE ALSO
	SKIPGE	J$RNPP(J)		;MAKE SURE WE DIDN'T SCREW THINGS UP
	SETZM	J$RNPP(J)		;YES,,ZERO THE PAGES PER COPY
	SKIPGE	J$APRT(J)		;CHECK HERE ALSO
	SETZM	J$APRT(J)		;NO GOOD,,SET IT TO ZERO
	JRST	OACR.0			;GO PROCESS THE NEXT MSG BLOCK
	SUBTTL	OACALI -- Routine to process Operator ALIGN request.

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

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

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

OALI.1:	SKIPN	J$APRG(J)		;ARE WE ALREADY ALIGNING ???
	JRST	OALI.2			;NO,,THEN WE'RE OK
	MOVE	S1,STREAM		;YES,,GET STREAM NUMBER.
	$ACK  (ALIGN already in progress,,@JOBOBA(S1),.MSCOD(M))
	$RETT				;RETURN NOW.

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

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

	SKIPG	S1,J$ASLP(J)		;PICK UP USER SLEEP TIME.
	SKIPLE	S1,J$FALS(J)		;ELSE, PICK UP LPFORM.INI SLEEP-TIME.
	SKIPA				;SKIP THE DEFAULT.
	MOVE	S1,D$ALSL		;PICK UP THE DEFUALT SLEEP-TIME.
	IMULI	S1,3			;CONVERT TO UNIVERSAL TIME.
	MOVEM	S1,J$ASLP(J)		;AND SAVE IT.
	SETOM	J$APRG(J)		;SHOW WE ARE DOING AN ALIGN,
					;   AND THAT IT NEEDS TO BE SCHEDULED.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Alignment Scheduled,,@JOBOBA(S1)) ;TELL THE OPERATOR.
	SETOM	JOBUPD(S1)		;Update the status
	$RETT				;RETURN.

OALI.3:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (<^E/[-1]/>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/>,@JOBOBA(S1))
	$RETT

OALI.6:	SKIPE	J$APRG(J)		;ARE WE ALREADY ALIGNING ???
	JRST	OALI.7			;IF SO,,CONTINUE PROCESSING.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$ACK  (</STOP Illegal>,Alignment not in Progress,@JOBOBA(S1),.MSCOD(M))
	$RETT
OALI.7:	MOVE	S1,J$AIFN(J)		;GET THE ALIGN IFN.
	SETOB	S2,J$ABYT(J)		;SET ALIGN FILE BYTE COUNT TO -1.
	PUSHJ	P,F%POS			;POSITION TO ALIGN EOF.
	SETZM	J$ACNT(J)		;SET REPEAT-COUNT TO 0.
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$ACK  (Alignment Discontinued,,@JOBOBA(S1),.MSCOD(M))
	$RETT				;AND RETURN

FDADDR:	0,,0
	SUBTTL	OACFWS -- OPERATOR FORWARD SPACE COMMAND PROCESSOR.

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

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.
	MOVEM	S2,J$FPIG(J)		;SAVE THE VALUE.
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
	$ACK  (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),.MSCOD(M))
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Forward spaced ^D/J$FPIG(J)/ Pages>)
	$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.
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Forward spaced ^D/S2/ Copies>)
	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER.
	$ACK  (<Forward Spaced ^D/S2/ Copies>,,@JOBOBA(S1),.MSCOD(M))
	PUSHJ	P,INPFEF		;FORCE AN END-OF-FILE.
	$RETT				;AND RETURN

FFILES:	MOVE	S1,STREAM		;PICK UP THE STREAM NUMBER
	$ACK	(Forward Spaced 1 File,,@JOBOBA(S1),.MSCOD(M))
	$TEXT	(LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Skipped by Operator>)
	PUSHJ	P,INPFEF		;FORCE AN END OF FILE
	TXO	S,SKPFIL		;TURN ON SKIP FILE FLAG
	$RETT				;AND RETURN
	SUBTTL	OACBKS -- BACK SPACE operator action routine.

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

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

BSPACE:	MOVE	T1,0(S1)		;PICK UP THE NUMBER OF PAGES TO BSPACE.
	MOVE	S1,STREAM		;PICK UP STREAM NUMBER.
	$ACK (<Backspaced ^D/T1/ Pages>,,@JOBOBA(S1),.MSCOD(M))
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ 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	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.
	$TEXT (LOGCHR,<^I/LPMSG/File ^F/@J$DFDA(J)/ Backspaced ^D/T1/ Copies>)
	MOVE	S1,STREAM		;PICK UP STREAM NUMBER.
	$ACK  (<Backspaced ^D/T1/ Copies>,,@JOBOBA(S1),.MSCOD(M))
	PUSHJ	P,INPFEF		;FORCE END OF FILE.
	$RETT				;RETURN.

	SUBTTL	BFILES -- BACKSPACE 'FILES'

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

BFIL.2:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$ACK	(<Backspaced 1 File>,,@JOBOBA(S1),.MSCOD(M))
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	S1,E			;POINT TO THE FD
	$TEXT	(LOGCHR,<^I/LPMSG/Backspaced to Beginning of ^F/0(S1)/>)
	MOVEM	E,J$RACS+E(J)		;UPDATE AC 'E' IN STREAM DATA BASE
	$RETT

PAGES:	0,,0
	SUBTTL	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

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 OPRCHK -- Check for DN60 OPR msgs and send them

;  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

;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
		MOVX	S1,PSF%OO	;GET 'OPERATOR OUTPUT WAIT' BITS
		MOVE	S2,STREAM	;GET OUR STREAM NUMBER
		ANDCAM	S1,JOBSTW(S2)	;CLEAR 'OPERATOR OUTPUT WAIT' BITS
		$RETT]			;and return
	$D60OE	(ERFCC)			;Go process the error
	JUMPF	OPRC.1			;Bad error
	$RETT				;Good error, return
> ; End of IFN FTDN60
	SUBTTL BLDL -- CREATE A 10/20 FD FOR THE ALIGN FILE.


BLDLFD:
TOPS10 <
	MOVEI	S1,FDMSIZ		;PICK UP 10 FD SIZE.
	STORE	S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IN FD.
	MOVSI	S1,'SYS'		;PICK UP STRUCTURE NAME.
	MOVEM	S1,J$AFD+.FDSTR(J)	;SAVE IN FD.
	MOVE	S1,J$FALI(J)		;PICK UP FILE NAME (FORMS TYPE).
	MOVEM	S1,J$AFD+.FDNAM(J)	;SAVE IN FD.
	MOVSI	S1,'ALP'		;PICK UP FILE EXT.
	MOVEM	S1,J$AFD+.FDEXT(J)	;SAVE IN FD.
	MOVEI	S1,J$AFD(J)		;PICK UP FD ADDRESS.
	$RETT				;RETURN. . . . . . . . . .
> ;END TOPS10 CONDITIONAL

TOPS20 <
	MOVEI	S1,AFDSIZ		;GET THE FD LENGTH
	STORE	S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IT
	$TEXT	(<-1,,J$AFD+.FDSTG(J)>,<SYS:^W/J$FALI(J)/.ALP^0>)
	MOVEI	S1,J$AFD(J)		;PICK UP FD ADDRESS.
	$RETT				;RETURN. . . . . . . . . .
> ;END TOPS20 CONDITIONAL
	SUBTTL	ALIGN -- Processor.

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

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

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

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

ALIG.4:	MOVE	S2,STREAM		;PICK UP STREAM NUMBER.
	PUSHJ	P,I%NOW			;GET CURRENT TIME.
	ADD	S1,J$ASLP(J)		;ADD /PAUSE VALUE.
	MOVEM	S1,JOBWKT(S2)		;SAVE WAKE UP TIME FOR STREAM.
	$DSCHD	(PSF%AL)		;SHOW STREAM BLOCKED FOR ALIGNMENT.
	JRST	ALIGN			;WHEN RETURN,,CONTINUE.
	SUBTTL	FNDOBJ -- ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE.

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

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

FNDO.3:	MOVEM	T4,STREAM		;SAVE STREAM NUMBER
	SKIPN	J,JOBPAG(T4)		;GET ADDRESS OF DATA
	$RETF				;UNLESS ITS NOT REALLY SETUP THEN RETURN
	MOVE	S,J$RACS+S(J)		;GET HIS 'S'
	$RETT				;AND RETURN
	SUBTTL	SNDQSR -- ROUTINE TO SEND A MESASGE TO QUASAR.

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

	$STOP(QSF,Send to QUASAR FAILED)



	SUBTTL	CHKLPT -- ROUTINE TO MAKE SURE THE DEVICE IS ONLINE

CHKLPT:

TOPS20 <
	SKIPE	S1,JOBSTW		;ARE ANY STATUS BITS SET ???
	TXNN	S1,PSF%DO		;IF SO,,IS IT DEVICE OFFLINE ???
	$RETT				;NO TO EITHER,,JUST RETURN
	$WTO	(<^T/BELL/>,,@JOBOBA)	;TELL OPR DEVICE IS OFFLINE
	MOVE	S1,STREAM		;Get the stream number
	SETOM	JOBUPD(S1)		;Say we want a status update
	$CALL	DSTATUS			;Do it
	SETZM	JOBCHK			;INDICATE WE WANT ANOTHER WHEN WE CAN
> ;END TOPS20 CONDITIONAL

	$RETT				;RETURN


	SUBTTL	TOOBAD -- ROUTINE TO RESPOND TO THE OPERATOR IF HIS REQUEST IS TOO LATE.


TOOBAD:	MOVE	S1,STREAM		;GET THE STREAM NUMBER.
	$ACK	(Print Request Completed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	$RETT
	SUBTTL	LOGCHR  --  Type a character in the log file


LOGCHR:	CAIE	S1,.CHLFD		;IS IT A LINE-FEED
	CAIN	S1,23			;OR A DC 3?
	AOS	J$GNLN(J)		;YES, COUNT ANOTHER LINE
LOGC.1:	SOSGE	J$GIBC(J)		;IS THERE ROOM?
	JRST	LOGC.2			;NO, GET ANOTHER PAGE
	IDPB	S1,J$GIBP(J)		;YES, DEPOSIT THE CHARACTER
	$RETT				;AND RETURN

LOGC.2:	PUSH	P,S1			;SAVE THE CHARACTER FOR A MINUTE
	PUSHJ	P,LOGBUF		;GET ANOTHER PAGE
	POP	P,S1			;RESTORE THE CHARACTER
	JRST	LOGC.1			;AND TRY AGAIN


	SUBTTL	LOGBUF  --  Get a buffer page for LOG

LOGBUF:	PUSHJ	P,.SAVE1		;SAVE P1
	AOS	P1,J$GINP(J)		;INCREMENT BUFFER PAGE COUNT
	CAIN	P1,1			;IS THIS THE FIRST PAGE?
	JRST	[MOVE S1,J$GBUF(J)	;YES, USE THE PRE-ALLOCATED PAGE
		$CALL	.ZPAGA		; Make sure page is zeroed of residue
		 JRST LOGB.1]		;AND CONTINUE ON
	CAIL	P1,^D10			;NO, WITHIN RANGE?
	$STOP(TML,TOO MANY LOG BUFFERS REQUIRED) ;NO,,COMMIT SUICIDE
	PUSHJ	P,M%GPAG		;GET A PAGE
	ADDI	P1,-1(J)		;POINT TO LOCATION IN J$GBUF
	MOVEM	S1,J$GBUF(P1)		;STORE THE ADDRESS
LOGB.1:	HRLI	S1,(POINT 7,0)		;MAKE A BYTE POINTER
	MOVEM	S1,J$GIBP(J)		;AND STORE IT
	MOVEI	S1,<5*1000>-1		;GET A COUNT
	MOVEM	S1,J$GIBC(J)		;STORE IT
	POPJ	P,			;AND RETURN
	SUBTTL	ACTBEG -- ACCOUNTING INITIALIZATION ROUTINE

ACTBEG:	LOAD	S1,.EQSEQ(J),EQ.SEQ	;GET SEQUENCE NUMBER
	STORE	S1,J$ASEQ(J)		;STORE IT
	LOAD	S1,.EQSEQ(J),EQ.PRI	;GET EXTERNAL PRIORITY
	STORE	S1,J$APRI(J)		;STORE IT

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

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

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

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

IFN FTACNT,<
TOPS20<	MOVX	S1,.FHSLF		;LOAD FORK HANDLE
	RUNTM				;GET RUNTIME
	ADDM	S1,J$ARTM(J)		;STORE IT
	MOVX	S1,.USENT		;WRITE AN ENTRY
	MOVEI	S2,ACTLST		;POINT TO THE LIST
	USAGE				;DO THE JSYS
	 ERJMP	ACTE.1			;ON AN ERROR,,TELL THE OPERATOR
> ;END TOPS20 ACCOUNTING

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

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

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

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

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

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

	$RETT				;RETURN
	SUBTTL	ACTLST -- SPOOLER ACCOUNTING RECORD

IFN FTACNT,< SEARCH	ACTSYM		;SEARCH THE ACCOUNTING UNV

ACTLST:	USENT.	(.UTOUT,1,1,0)
	USTAD.	(-1)			;CURRENT DATE/TIME
	USPNM.	(<SIXBIT/LPTSPL/>,US%IMM) ;PROGRAM NAME
	USPVR.	(%LPT,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(.EQROB+.ROBND(J))	;NODE NAME
	USSRT.	(J$ARTM(J))		;RUN TIME
	USSDR.	(J$ADRD(J))		;DISK READS
	USSDW.	(0,US%IMM)		;DISK WRITES
	USJNM.	(.EQJOB(J))		;JOB NAME
	USQNM.	(<SIXBIT /LPT/>,US%IMM)	;QUEUE NAME
	USSDV.	(J$LDEV(J))		;DEVICE NAME
	USSSN.	(J$ASEQ(J))		;JOB SEQUENCE NUMBER
	USSUN.	(J$APRT(J))		;TOTAL PAGES PRINTED
	USSNF.	(J$AFXC(J))		;TOTAL FILES PROCESSED
	USCRT.	(.EQAFT(J))		;CREATION DATE/TIME OF REQUEST
	USSCD.	(J$RTIM(J))		;SCHEDULED DATE/TIME
	USFRM.	(J$FORM(J))		;FORMS TYPE
	USDSP.	(<SIXBIT/NORMAL/>,US%IMM) ;DISPOSITION
	USPRI.	(J$APRI(J))		;JOB PRIORITY

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

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

	ACTLEN==.-ACTLST		;ACCOUNTING BLOCK LENGTH

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

> ;END IFN FTACNT
	SUBTTL	INPOPN  --  Routine to open the input file

;INPOPN IS CALLED WITH AC "E" POINTING TO THE FP AREA FOR THE FILE
;	TO BE OPENED.

INPOPN:	MOVEI	S1,FOB.SZ		;GET THE FOB SIZE
	MOVEI	S2,J$XFOB(J)		;AND THE FOR ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO IT OUT
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	S1,E			;GET THE FD ADDRESS
	MOVEM	S1,J$DFDA(J)		;SAVE THE ADDRESS
	STORE	S1,J$XFOB+FOB.FD(J)	;SAVE IN THE FOB
	MOVEI	S1,7			;LOAD PROBABLE (7 BIT) BYTE SIZE
	LOAD	T1,.FPINF(E),FP.FFF	;GET /FILE:
	LOAD	T2,.FPINF(E),FP.FPF	;GET /PRINT:
	CAXN	T1,.FPF8B		;WAS IT /FILE:8-BIT???
	MOVEI	S1,^D8			;YES,,LOAD 8 BIT BYTE SIZE
	CAXN	T1,.FPF11		;WAS IT /FILE:ELEVEN???
	MOVEI	S1,^D36			;YES,,LOAD 36 BIT BYTE SIZE
	CAIE	T1,.FPFCO		;/FILE:COBOL?
	CAIN	T2,%FPLOC		;OR /PRINT:OCTAL?
	MOVEI	S1,^D36			;YES, USE FULL WORDS
	STORE	S1,J$XFOB+FOB.CW(J),FB.BSZ  ;AND SAVE THE BYTE SIZE
	SETZM	J$XFOB+FOB.US(J)	;DEFAULT TO NO ACCESS CHECKING
	SETZM	J$XFOB+FOB.CD(J)	;HERE ALSO
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET THE USERS PRIVILGE BITS
	JUMPN	S1,INPO.1		;IF SET, AVOID ACCESS CHECK
	LOAD	S1,.FPINF(E),FP.SPL	;LIKEWISE IF SPOOLED
	JUMPN	S1,INPO.1		; ...

TOPS10 <
	MOVE	S1,.EQOID(J)		;GET THE PPN
	STORE	S1,J$XFOB+FOB.US(J)	;AND SAVE IT
>  ;END TOPS10 CONDITIONAL

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

INPO.1:	MOVEI	S1,FOB.SZ		;GET FOB SIZE
	MOVEI	S2,J$XFOB(J)		;AND ADDRESS
	PUSHJ	P,F%IOPN		;OPEN THE FILE
	JUMPF	INPO.2			;JUMP IF FAILED
	MOVEM	S1,J$DIFN(J)		;ELSE, SAVE THE IFN
	$RETT				;AND RETURN

INPO.2:	$TEXT(LOGCHR,<^I/LPERR/Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/>)
	ZERO	.FPINF(E),FP.DEL	;CLEAR THE 'DELETE FILE' BIT
	$RETF				;AND RETURN
	SUBTTL	INPBUF  --  Read a buffer from the input file

INPBUF:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%IBUF		;GET A BUFFERFUL
	JUMPF	INPERR			;LOSE
	MOVEM	S1,J$DBCT(J)		;SAVE THE BYTE COUNT
	MOVEM	S2,J$DBPT(J)		;AND THE BYTE POINTER
	AOS	J$ADRD(J)		;ADD 1 TO BUFFER READ COUNT.
	EXCH	S1,J$FCBC(J)		;GET OLD BUFR BYTE CNT AND SAVE NEW
	ADDM	S1,J$FTBC(J)		;BUMP TOTAL BYTES PROCESSED
	$RETT				;THEN RETURN.

	SUBTTL	INPBYT  --  Read a byte from the input file

INPBYT:	SOSGE	J$DBCT(J)		;MAKE SURE THERE IS DATA IN THE BUFFER.
	JRST	INPB.1			;IF NOT,,GET ANOTHER BUFFER.
	ILDB	C,J$DBPT(J)		;PICK UP A BYTE FROM THE BUFFER.
	$RETT				;AND RETURN.
INPB.1:	PUSHJ	P,INPBUF		;READ THE NEXT BUFFER.
	JUMPF	.RETF			;NO MORE,,RETURN.
	JRST	INPBYT			;ELSE GET THE NEXT BYTE.

	SUBTTL	INPERR  --  Handle an input failure

INPERR:	CAXN	S1,EREOF$		;WAS IT EOF?
	$RETF				;WAS JUST RETURN
	$TEXT(LOGCHR,<^I/LPERR/Error reading input file -  ^E/[-1]/>)
	TXO	S,SKPFIL		;SKIP THE REST OF THE FILE
	$RETF				;AND RETURN

	SUBTTL	INPFEF  --  Force end-of-file on next input

INPFEF:	SKIPN	S1,J$DIFN(J)		;IS THE SPOOL FILE OPEN ???
	$RETT				;NO,,JUST RETURN
	SETOB	S2,J$DBCT(J)		;CLEAR BYTE COUNT AND SET EOF POS
	PUSHJ	P,F%POS			;AND POSITION IT
	$RETT				;AND RETURN

	SUBTTL	INPREW  --  Rewind the input file

INPREW:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	PUSHJ	P,F%REW			;REWIND IT
	SETOM	J$DBCT(J)		;AND SET THE BYTE COUNT
	SETZM	J$RNPP(J)		;AND SET PAGE 0
	MOVEI	S1,J$FPAG(J)		;GET THE PAGE COUNTER TABLE ADDRESS
	MOVEM	S1,J$FBPT(J)		;AND SAVE IT.
	SETZM	J$FCBC(J)		;CLEAR CURRENT INPUT BUFFER BYTE COUNT
	SETZM	J$FTBC(J)		;CLEAR TOTAL INPUT BYTE COUNT
	TXZ	S,FBPTOV		;CLEAR PAGE TABLE OVERFLOW BIT
	MOVX	S1,PAGSIZ		;GET THE TABLE LENGTH.
	MOVEI	S2,J$FPAG(J)		;GET THE START ADDRESS.
	PJRST	.ZCHNK			;RETURN, ZEROING THE PAGE TABLE
	SUBTTL	FORMS   --  Setup Forms for a job

FORMS:	TXNE	S,ABORT			;ARE WE ABORTING?
	$RETF				;YES, END THE REQUEST
	GETLIM	S1,.EQLIM(J),FORM	;GET THE FORMS TYPE
	CAMN	S1,J$FORM(J)		;OR ARE FORMS EXACTLY THE SAME?
	$RETT				;YES,,VFU AND RAM MUST BE SAME TO !!!
	HRLZI	S2,J$WTOR(J)		;Get the start address of the buffer
	HRRI	S2,J$WTOR+1(J)		; and +1
	SETZM	J$WTOR(J)		;Want to zero it all
	BLT	S2,J$WTOR+^D50-1(J)	;Zap it
	MOVE	S2,[POINT 7,J$WTOR(J)]	;GET POINTER TO WTOR BUFFER.
	MOVEM	S2,TEXTBP		;AND SAVE IT FOR DEPBP.
	SKIPN	S2,J$FORM(J)		;GET FORMS TYPE
	MOVX	S2,FRMNOR		;USE NORMAL IF NULL
	XOR	S1,S2			;GET COMMON PART
	AND	S1,[EXP FRMSK1]		;AND IT WITH THE IMPORTANT PART
	GETLIM	S2,.EQLIM(J),FORM	;GET FORMS TYPE
	EXCH	S2,J$FORM(J)		;SAVE IT
	MOVEM	S2,J$FPFM(J)		;SAVE OLD ONES
	SKIPE	S1			;NO NEED TO CHANGE FORMS.
	$TEXT	(DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
	SKIPN	J$FPFM(J)		;Any previous forms??
	JRST	FORM.1			;No, don't try to send FF
	PUSHJ	P,OUTDMP		;Clear any previous output
	PUSHJ	P,SENDFF		;Send FF if needed
	PUSHJ	P,OUTDMP		;Clear it out

FORM.1:	MOVE	S1,J$FDRU(J)		;GET THE CURRENT DRUM TYPE
	MOVEM	S1,J$PDRU(J)		;AND SAVE IT
	MOVE	S1,J$FRIB(J)		;GET THE CURRENT RIBBON TYPE
	MOVEM	S1,J$PRIB(J)		;AND SAVE IT
	MOVE	S1,J$FTAP(J)		;GET THE CURRENT CARRIAGE CONTROL TAPE
	MOVEM	S1,J$PTAP(J)		;AND SAVE IT
	MOVE	S1,J$LRAM(J)		;GET THE DEFAULT RAM FILE NAME
	MOVEM	S1,J$FRAM(J)		;AND MAKE IT THE CURRENT RAM TYPE
	HRLZI	S1,-F$NSW		;GET NEGATIVE SWITCH TABLE LEN
	MOVEI	T1,J$FCUR(J)		;POINT TO CURRENT FORMS PARAMS

FORM.2:	MOVE	S2,FFDEFS(S1)		;GET A DEFAULT
	CAME	S2,[-1]			;IS THIS SUPPOSED TO BE DEFAULTED ???
	MOVEM	S2,(T1)			;YES,,SAVE IT
	ADDI	T1,1			;INCREMENT NEW PARAM STORE CTR
	AOBJN	S1,FORM.2		;AND LOOP

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

	PUSHJ	P,FRMINI		;READ THE LPFORM.INI FILE.
	JUMPT	FORM.3			;Skip the message if ok
FRM.2A:	MOVE	S1,STREAM		;Get the stream number
	GETLIM	S2,.EQLIM(J),FORM	;Get forms type
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SETOM	JOBUPD(S1)		;  update status also
	$WTOR	(<Form ^W/S2/ not found, defaults being used>,<^T/FORMSG/>,@JOBOBA(S1),JOBWAC(S1))		;Tell the operator
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	JRST	FORM.7			;YES,,IGNORE THE ERROR
	MOVEI	S1,FRMANS		;POINT TO THE LIMIT ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	FRM.2A			;NO,,STUPID OPERATOR SO TRY AGAIN
	HRRZ	S1,0(S1)		;GET THE ROUTINE ADDRESS
	JRST	0(S1)			;AND PROCESS THE RESPONSE

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

;  Set up the width and length classes

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

	SKIPE	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	$RETT				;YES,,JUST RETURN NOW !!
	MOVE	S1,TEXTBP		;GET THE WTOR BYTE POINTER.
	TXNE	S,FRMFND		;Were the forms found?
	 CAMN	S1,[POINT 7,J$WTOR(J)]	;IS THERE A MESSAGE FOR THE OPERATOR ??
	  JRST	FORM.5			;NO,,TRY LOADING VFU AND RAM
	$TEXT	(DEPBP,<^T/ENDRSP/^0>)	;ADD THE RESPONSE TO THE END

FORM.4:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTOR  (,<^T/J$WTOR(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SETOM	JOBUPD(S1)		;  update status also
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE.
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	JRST	FORM.7			;Go replace the old forms
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	FORM.4			;NO,,STUPID OPERATOR SO TRY AGAIN

FORM.5:	PUSHJ	P,LODRAM		;TRY TO LOAD THE RAM
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED ???
	$RETF				;YES,,RETURN NOW
	PUSHJ	P,LODVFU		;TRY TO LOAD THE VFU
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED ???
	$RETF				;YES,,RETURN NOW
	$RETT				;NO,,HE WINS SO FAR !!!

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

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

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

FORMSG:	ASCIZ	/
Type 'RESPOND <number> ABORT' to terminate the forms change now
Type 'RESPOND <number> PROCEED' after mounting correct forms/
FRMINI:	$CALL	OPNFRM			;Reopen ini file
	$RETIF				;Quit if none
	TXZ	S,FRMFND		;Clear the forms found flag

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


FRMIN2:	TXO	S,FRMFND		;Remember we've found it
	CAIN	C," "			; Break on a space?
	 PUSHJ	P,FH$GNB		; Allow spaces, get non-blank char.
	CAIN	C,"/"			;BEGINNING OF SWITCH?
	JRST	FRMIN5			;YES, LOCATOR IS "ALL"
	CAIN	C,":"			;BEGINNING OF LOCATOR?
	JRST	FRMIN3			;YES, GO GET IT
	CAIN	C,.CHLFD		;EOL?
	JRST	FRMIN1			;YES, GO THE NEXT LINE
	PUSHJ	P,FH$CHR		;ELSE, GET A CHARACTER
	JUMPF	.RETT			;EOF
	JRST	FRMIN2			;AND LOOP

FRMIN3:	PUSHJ	P,FH$SIX		;GET A LOCATOR
	JUMPF	.RETT			;EOF!!
	JUMPE	T1,FRMI3A		;MAYBE PAREN??
	JRST	FRMIN4			;AE	S2,TL%NOM+TL%

FRMI3A:	CAIN	C,"/"			;A SWITCH?
	JRST	FRMIN5			;YES!
	CAIE	C,"("			;A LIST?
	JRST	FRMIN9			;NO, ERROR
FRMIN4:	HLRZ	T2,T1			;GET THE FIRST THREE CHARS
	CAIN	T2,'ALL'		;IS IT "ALL"?
	JRST	FRMIN5			;YES, STOP CHECKING
	CAIN	T2,'LOC'		;IS IT LOCAL?
	SKIPGE	J$LREM(J)		;YES, ARE WE?
	  SKIPA				;NO, NO
	JRST	FRMIN5			;YES, YES!
	CAIN	T2,'REM'		;DOES IT SAY "REMOTE"?
	SKIPL	J$LREM(J)		;YES, ARE WE REMOTE
	  SKIPA				;NO!!!
	JRST	FRMIN5			;YES!!
	CAMN	T1,J$LDEV(J)		;COMPARE TO OUR DEVNAM
	JRST	FRMIN5			;MATCH!!

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

FRMIN5:	CAIN	C,.CHLFD	;WAS THE LAST CHARACTER A LINEFEED?
	POPJ	P,		;YES, RETURN
	CAIN	C,"/"		;ARE WE AT THE BEGINNING OF A SWITCH?
	JRST	FRMI5A		;YES, DO IT!
	PUSHJ	P,FH$CHR	;NO, GET A CHARACTER
	JUMPF	.RETT		;EOF!!
	JRST	FRMIN5		;AND LOOP AROUND
FRMI5A:	PUSHJ	P,FH$SIX	;GET THE SWITCH
	JUMPF	.RETT		;EOF!!
	JUMPN	T1,FRMIN6	;JUMP IF WE'VE GOT SOMETHING
	CAIN	C,.CHLFD	;EOL?
	POPJ	P,		;YES, RETURN
	JRST	FRMIN5		;ELSE, KEEP TRYING

FRMIN6:	MOVE	T4,T1		;SAVE SWITCH NAME FOR LATTER
	HLLZS	T1		;GET FIRST THREE CHARACTERS OF SWITCH
	MOVSI	T2,-F$NSW	;MAKE AOBJN POINTER

FRMIN7:	HLLZ	T3,FFNAMS(T2)	;GET A SWITCH NAME
	CAMN	T3,T1		;MATCH??
	JRST	FRMIN8		;YES, DISPATCH
	AOBJN	T2,FRMIN7	;NO, LOOP
	MOVE	T4,T1		;GET SWITCH NAME
	MOVE	S1,STREAM	;GET THE STREAM NUMBER.
	$WTOJ	(LPFORM.INI Error,<Unrecognized switch ^W/T1/ found.>,@JOBOBA(S1))
	JRST	FRMIN5		;AND LOOP

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

FRMIN9:	MOVE	S1,STREAM	;GET THE STREAM NUMBER.
	$WTOJ	(Bad format in LPFORM.INI,,@JOBOBA(S1))
	POPJ	P,		;AND RETURN
	SUBTTL	Forms Switch Subroutines


S$BANN:	MOVE	T1,D$BANN		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FBAN(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$TRAI:	MOVE	T1,D$TRAI		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FTRA(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$HEAD:	MOVE	T1,D$HEAD		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FHEA(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$LINE:	MOVE	T1,D$LINE		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FLIN(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$WIDT:	MOVE	T1,D$WIDT		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FWID(J)		;SAVE IT
	POPJ	P,			;AND RETURN

S$RIBB:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FRIB(J)		;SAVE IT
	CAME	T1,J$PRIB(J)		;SKIP IF NOT CHANGED
	$TEXT	(DEPBP,<Load Ribbon type '^W/J$FRIB(J)/'>)
	POPJ	P,			;AND RETURN

S$DRUM:
S$CHAI:	PUSHJ	P,FH$SIX		;GET SIXBIT ARG
	JUMPF	.RETT			;EOF!!
	MOVEM	T1,J$FDRU(J)		;SAVE IT
	CAME	T1,J$PDRU(J)		;SKIP IF NOT CHANGED
	$TEXT	(DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>)
	POPJ	P,			;AND RETURN

S$NOTE:	MOVE	T1,[POINT 7,J$FNBK(J)]
	SETZ	T2,			;CLEAR THE COUNTER

S$NOT1:	PUSHJ	P,FH$CHR		;GET A CHARACTER
	JUMPF	S$NOT2			;EOF, FINISH UP!!
	CAIGE	C,40			;MAKE SURE ITS GREATER THAN SPACE
	  JRST	S$NOT2			;ITS NOT!, FINISH UP
	CAIN	C,"/"			;ALSO STOP ON SLASH
	JRST	S$NOT2			;IT IS!!
	IDPB	C,T1			;DEPOSIT IT
	CAIGE	T2,^D49			;LOOP FOR 50 CHARACTERS
	AOJA	T2,S$NOT1		;INCR AND LOOP

S$NOT2:	SETZM	TF			;GET A NULL BYTE
	IDPB	TF,T1			;MAKE THE STRING ASCIZ
	$TEXT	(DEPBP,<Note: ^T/J$FNBK(J)/>) ;ADD THE MSG TO WTOR.
	$RETT				;RETURN.

S$ALCN:	MOVE	T1,D$ALCN		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FALC(J)		;STORE IT
	POPJ	P,			;RETURN

S$ALSL:	MOVE	T1,D$ALSL		; Get the default setting
	CAIN	C,":"			; Did he put a real arguement
	 PUSHJ	P,FH$DEC		;  Yes, GET DECIMAL ARGUMENT
	MOVEM	T1,J$FALS(J)		;SAVE IT
	POPJ	P,			;AND RETURN

S$ALIG:	CAIN	C,"/"			;ARE WE AT THE BEGINNING OF A SWITCH ??
	PJRST	OALI.2			;YES,,JUST USE FORMS NAME AS ALIGN FILE
	PUSHJ	P,FH$SIX		;GET THE ALIGN FILENAME ARGUMENT
	SKIPE	T1			;SKIP IF NOTHING THERE
	MOVEM	T1,J$FALI(J)		;SAVE THE ALIGN FILENAME
	PUSHJ	P,OALI.2		;SCHEDULE THE FORMS ALIGNMENT
	POPJ	P,			;AND RETURN

S$VFU:
S$TAPE:	PUSHJ	P,FH$SIX		;GET SIXBIT ARGUMENT
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FTAP(J)		;SAVE IT
	CAME	T1,J$PTAP(J)		;ARE OLD AND NEW THE SAME?
	SKIPE	J$LDVF(J)		;OR DOES DEVICE HAVE A DAVFU?
	$RETT				;OLD=NEW OR SOFTWARE VFU,,RETURN
	$TEXT	(DEPBP,<Load CARRIAGE CONTROL TAPE '^W/J$FTAP(J)/'>)
	$RETT

S$RAM:	PUSHJ	P,FH$SIX		;GET THE SIXBIT ARGUMENT
	JUMPF	.RETT			;EOF
	MOVEM	T1,J$FRAM(J)		;SAVE IT
	$RETT				;AND RETURN
	SUBTTL	LODVFU  --  Load the Vertical Forms Unit

LODVFU:	SKIPN	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	SKIPN	J$LDVF(J)		;OR DOES THIS PRINTER HAVE A VFU ???
	$RETT				;TO TAPE OR NO VFU,,JUST RETURN.
	MOVE	S1,J$FTAP(J)		;GET NECESSARY VFU TYPE
	CAMN	S1,J$FLVT(J)		;IS IT IN THERE ALREADY?
	$RETT				;YES, RETURN
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Loading VFU with '^W/J$FTAP(J)/',,@JOBOBA(S1))

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

LODV.2:	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	NOVFU			;ERROR,,LETS TRY SOMETHING ELSE
LODV.3:	MOVE	T3,S1			;COPY THE JFN OVER
	MOVE	S1,J$LCHN(J)		;GET THE LPT JFN
	MOVX	S2,.MOLVF		;GET LOAD VFU FUNCTION
	MOVEI	T1,T2			;ADDRESS OF ARG BLOCK
	MOVEI	T2,2			;LENGTH OF ARG BLOCK
	PUSHJ	P,$MTOPR		;LOAD THE VFU
	MOVE	S1,T3			;GET THE VFU JFN ONCE MORE
	RLJFN				;RELEASE IT
	JFCL				;IGNORE ANY ERRORS
	 JUMPF	LODV.4			;CANT LOAD VFU,,GO FIND OUT WHY.
	MOVE	T1,J$FTAP(J)		;GET THE VFU TYPE
	MOVEM	T1,J$FLVT(J)		;SAVE AS CURRENTLY LOADED
	POPJ	P,			;AND RETURN

LODV.4:	MOVX	S1,.FHSLF		;GET MY HANDLE
	GETER				;GET THE LAST ERROR CODE
	HRRZS	S2,S2			;GET JUST THE ERROR CODE
	CAXE	S2,MTOX17		;IS THE ERROR 'DEVICE OFFLINE' ???
	JRST	NOVF.1			;NO,,LETS TRY SOME OTHER
	PUSHJ	P,OUTWON		;SAY 'DEVICE OFFLINE'
	JRST	LODV.2			;AND TRY AGAIN

>  ;END TOPS20 CONDITIONAL
	SUBTTL	TOPS10 VFU LOADING ROUTINES

TOPS10 <
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	TXO	S,VFULOD		;FLAG THE FACT WE'RE LOADING THE VFU

	;ON SYSTEM STARTUP, SEE IF THE VFU IS VALID AND IF SO THROW OUT A
	;FORM FEED. IF NOT, ASK OPR TO ALIGN FORMS BEFORE LOADING VFU.

	SKIPE	J$LVFF(J)		;IS THIS THE FIRST TIME THROUGH ???
	JRST	LODV.0			;NO,,SKIP THIS
	SETOM	J$LVFF(J)		;RESET THE FIRST TIME THROUGH FLAG
	MOVE	T1,[2,,T2]		;GET THE DEVOP. PARAMETERS
	MOVX	T2,.DFRDS		;GET 'READ DEVICE STATUS' FUNCTION CODE
	MOVE	T3,J$LDEV(J)		;GET THE SIXBIT DEVICE NAME
	DEVOP.	T1,			;GET THE DEVICE STATUS
	 $STOP	(LDF,Line Printer Device Status DEVOP. Failed) ;SHOULD'NT HAPPEN
	TXNE	T1,DF.LVE		;DOES THE LPT HAVE A GOOD VFU ???
	JRST	LOD.0A			;NO,,DONT OUTPUT FORM FEED
	MOVX	C,.CHFFD		;GET FORM FEED CODE
	PUSHJ	P,DEVOUT		;PUT IT OUT
	PUSHJ	P,OUTDMP		;ALIGN THE FORMS ON THE PRINTER
	JRST	LODV.0			;AND GO RELOAD THE VFU

LOD.0A:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTOR(<Align Forms and Put Online>,<^T/ENDRSP/>,@JOBOBA(S1),JOBWAC(S1))
	SETZM	JOBCHK(S1)		;TAKE A CHECKPOINT WHEN WE CAN
	SETOM	JOBUPD(S1)		;  update status also
	$DSCHD	(PSF%OR)		;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;ARE WE STILL IN BUSINESS ???
	JRST	[SETZM J$FORM(J)	;NO,,ZAP THE LOADED FORMS TYPE
		 TXZ   S,VFULOD		;CLEAR THE VFU LOAD FLAG
		 $RETT ]		;AND RETURN
	MOVEI	S1,CONANS		;GET THE ANSWER BLOCK ADDRESS
	HRROI	S2,J$RESP(J)		;POINT TO THE OPERATORS RESPONSE
	$CALL	S%TBLK			;CHECK ONE AGAINST THE OTHER
	TXNE	S2,TL%NOM+TL%AMB	;DO THEY MATCH ???
	JRST	LOD.0A			;NO,,STUPID OPERATOR -- TRY AGAIN !!

LODV.0:	LOAD	S1,J$LCLS(J)		;GET THE PRINTER CONTROLLER CLASS
	CAXN	S1,.DFS20		;FRONT END LPT ???
	JRST	LODV.4			;YES,,DO THINGS A LITTLE DIFFERENTLY

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

	MOVE	S1,J$FTAP(J)		;GET FILENAME
	STORE	S1,VFUFD+.FDNAM		;AND STORE IN THE FD
	MOVEI	S1,FOB.SZ		;GET THE FOB SIZE
	MOVEI	S2,FOB			;AND FOB ADDRESS
	PUSHJ	P,.ZCHNK		;AND ZERO IT
	MOVEI	S1,VFUFD		;GET FD ADDRESS
	STORE	S1,FOB+FOB.FD		;STORE
	MOVEI	S1,7			;GET 7 BIT BYTE SIZE
	STORE	S1,FOB+FOB.CW,FB.BSZ	;AND STORE
	MOVEI	S1,FOB.SZ		;GET FOB SIZE
	MOVEI	S2,FOB			;AND FOB ADDRESS
	PUSHJ	P,F%IOPN		;SETUP TO READ IT
	 JUMPF	NOVFU			;FILE NOT THERE,,HE LOSES !!!
	MOVEM	S1,J$FVIF(J)		;ELSE,,SAVE THE IFN
	MOVE	T1,[2,,T2]		;ARGS FOR DEVOP
	MOVX	T2,.DFENV		;ENABLE VFU LOAD
	MOVE	T3,J$LDEV(J)		;FOR I/O DEVICE
	DEVOP.	T1,			;DO IT
	  JRST	NODAVF			;ASSUME NO DAVFU
LODV.1:	SOSGE	J$FBYT(J)		;CHECK AND SEE IF DATA IS IN BUFFER.
	JRST	LODV.3			;IF NOT,,GET NEXT BUFFER.
	ILDB	C,J$FPTR(J)		;PICK UP A BYTE.
	PUSHJ	P,DEVOUT		;WRITE IT OUT.
	JRST	LODV.1			;GO GET ANOTHER.
LODV.2:	PUSHJ	P,OUTDMP		;FORCE OUT THE BUFFERS
	MOVE	T1,[2,,T2]		;LOAD ARG POINTER
	MOVX	T2,.DFDVL		;DISABLE VFU LOAD
	MOVE	T3,J$LCHN(J)		;AND CHANNEL NUMBER
	DEVOP.	T1,			;DO IT!
	  JRST	NODAVF			;LOSE
	MOVE	S1,J$FVIF(J)		;GET THE IFN
	PUSHJ	P,F%REL			;RELEASE IT
	MOVE	T1,J$FTAP(J)		;GET TAPE NAME
	MOVEM	T1,J$FLVT(J)		;SAVE AS TYPE LOADED
	TXZ	S,VFULOD		;CLEAR THE VFU LOAD FLAG
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	$RETT				;OK,,JUST RETURN
LODV.3:	MOVE	S1,J$FVIF(J)		;GET VFU IFN.
	PUSHJ	P,F%IBUF		;GET ANOTHER BUFFER.
	 JUMPF	LODV.2			;IF NO MORE,,RETURN
	MOVEM	S1,J$FBYT(J)		;SAVE THE BYTE COUNT
	MOVEM	S2,J$FPTR(J)		;SAVE THE BYTE POINTER.
	JRST	LODV.1			;CONTINUE PROCESSING.

VFUFD:	$BUILD	FDMSIZ
	 $SET(.FDLEN,FD.LEN,VFUFDL)	;FD LENGTH
	 $SET(.FDEXT,,<SIXBIT/VFU/>)	;FILENAME EXTENSION
	 $SET(.FDSTR,,<SIXBIT/SYS/>)	;FILE STRUCTURE
	$EOB

	VFUFDL==.-VFUFD			;FD LENGTH
	;FOR FRONT END LINE PRINTERS, WE MUST DO THINGS A LITTLE DIFFERENTLY !!

LODV.4:	OPEN	17,VFUFOB		;OPEN THE STRUCTURE
	 JRST	NOVFU			;CANT,,TRY SOMETHING ELSE
	MOVE	S1,J$FTAP(J)		;GET THE VFU WE WANT
	MOVEM	S1,VLKUP+0		;SAVE IN THE LOOKUP BLOCK
	MOVSI	S1,'VFU'		;GET THE EXTENSION
	MOVEM	S1,VLKUP+1		;SAVE IN THE LOOKUP BLOCK
	SETZM	VLKUP+2			;CLEAR 3'RD WORD OF LOOKUP BLOCK
	SETZM	VLKUP+3			;CLEAR 4'TH WORD OF LOOKUP BLOCK
	LOOKUP	17,VLKUP		;FIND THE FILE WE WANT
	 JRST	VDON.2			;NOT THERE,,TRY SOMETHING ELSE
	PUSHJ	P,M%GPAG		;GET A PAGE FOR A BUFFER
	MOVE	T4,S1			;SAVE THE ADDRESS FOR LATER
	MOVEI	T1,-1(S1)		;GET BUFFER ADDRESS-1
	HLL	T1,VLKUP+3		;GET -FILE LENGTH,,BUFFER ADDR-1
	SETZM	T2			;END CCW
	IN	17,T1			;READ THE VFU FILE
	SKIPA				;CONTINUE ON SUCCESSFUL RETURN
	 JRST	VDON.1			;AN ERROR,,TRY SOMETHING ELSE
	HLRO	T3,VLKUP+3		;GET -FILE LENGTH
	MOVMS	T3			;WANT POSITIVE LENGTH
	IMULI	T3,5			;CALC NUMBER OF VFU BYTES
	MOVEI	T1,.DFLV2		;WANT LOAD VFU FUNCTION
	MOVE	T2,J$LCHN(J)		;WANT LPT CHANNEL NUMBER
	MOVE	S1,[4,,T1]		;GET ARG COUNT,,BLOCK ADDRESS
	SETZM	S2			;FLAG S2 (IF 0 THEN VFU LOADED OK)
	DEVOP.	S1,			;LOAD THE VFU
VDON.1:	 SETOM	S2			;FLAG THAT VFU LOAD FAILED
	MOVE	T1,S2			;SAVE THE VFU LOAD FLAG

	MOVE	S1,T4			;GET THE BUFFER ADDRESS BACK
	PUSHJ	P,M%RPAG		;RELEASE THE PAGE

VDON.2:	MOVEI	S1,17			;GET THE CHANNEL NUMBER
	RESDV.	S1,			;WIPE IT OUT
	JFCL				;IGNORE ANY ERROR RELEASING THE DEVICE
	JUMPN	T1,NOVF.1		;LOAD FAILED,,TRY SOMETHING ELSE

	MOVE	S1,J$FTAP(J)		;GET THE VFU TYPE WE JUST LOADED
	MOVEM	S1,J$FLVT(J)		;SAVE IT AS LOADED VFU TYPE
	TXZ	S,VFULOD		;CLEAR THE VFU LOAD FLAG
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	JUMPF	SHUTIN			;CANT,,SHUT IT DOWN
	$RETT				;OK,,RETURN

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

VLKUP:	BLOCK	4			;LOOKUP BLOCK

>  ;END TOPS10 CONDITIONAL
	SUBTTL	HERE IF VFU FILE THAT WE ARE LOOKING FOR IS NOT AROUND

NOVFU:	MOVE	T1,J$FTAP(J)		;TYPE WE TRIED TO LOAD
	CAME	T1,D$TAPE		;IS IT THE DEFAULT
	JRST	NOVF.1			;NO, GIVE UP

TOPS10 <
	MOVE	T1,[2,,T2]		;ARGS FOR DEVOP
	MOVEI	T2,.DFLLV		;LOAD HARDWARE VFU
	MOVE	T3,J$LCHN(J)		;FOR CHANNEL
	DEVOP.	T1,			;DO IT
	  JRST	NOVF.1			;LOSE
	MOVE	T1,D$TAPE		;GET NAME OF NORMAL
	MOVEM	T1,J$FLVT(J)		;STORE IT
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (Error loading VFU,Loaded hardware VFU instead.,@JOBOBA(S1))
	TXZ	S,VFULOD		;CLEAR THE VFU LOAD FLAG
	$RETT				;AND RETURN

;HERE WHEN DEVOP FAILS...CLEAR DAVFU FLAG AND RETURN

NODAVF:	SETZM	J$LDVF(J)		;CLEAR THE FLAG
	MOVE	S1,J$FTAP(J)		;GET THE FORMS TYPE.
	MOVEM	S1,J$FLVT(J)		;   AND SAVE THEM AS LAST USED.
	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL

NOVF.1:	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTOR	(,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1))
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT.
	SETOM	JOBUPD(S1)		;  update status also
	$DSCHD	(PSF%OR)		;WAIT FOR THE REPLY.
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ??
	JRST	[SETZM J$FORM(J)	;YES,,ZAP THE LOADED FORMS TYPE
		 TXZ   S,VFULOD		;CLEAR THE VFU LOAD FLAG
		 $RETT ]		;AND RETURN
	HRROI	S1,J$RESP(J)		;GET THE OPERATORS RESPONSE
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,J$FTAP(J)		;SAVE THE FORMS TYPE
	JRST	LODVFU			;TRY LOADING AGAIN.

VFUI1:	ITEXT	(<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2:	ASCIZ	/Respond with VFU type to continue/
	SUBTTL	LODRAM -- ROUTINE TO LOAD THE TRANSLATION RAM

LODRAM:	SKIPN	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	SKIPE	J$LREM(J)		;OR IS THIS A REMOTE LPT ???
	$RETT				;YES,,RETURN NOW !!!
	MOVE	S1,J$FRAM(J)		;GET THE RAM WE WANT
	CAMN	S1,J$FLRM(J)		;IS IT IN THERE ALREADY ???
	$RETT				;YES,,RETURN NOW !!!

TOPS20 <
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
	$TEXT	(<-1,,J$XTBF(J)>,<SYS:^W/J$FRAM(J)/.RAM^0>) ;GEN RAM FILE NAME

LODR.1:	MOVX	S1,GJ%OLD+GJ%SHT	;SHORT, OLD FILE ONLY
	HRROI	S2,J$XTBF(J)		;POINT TO FILE NAME
	GTJFN				;GET A JFN FOR THE TRANSLATION RAM
	 ERJMP	NORAM			;CANT GET A JFN,,TRY SOMETHING ELSE

LODR.2:	MOVE	T3,S1			;SAVE THE JFN
	MOVE	S1,J$LCHN(J)		;GET THE PRINTER JFN
	MOVX	S2,.MOLTR		;WANT 'LOAD RAM' MTOPR FUNCTION
	MOVEI	T1,T2			;GET ARG BLOCK ADDRESS
	MOVEI	T2,2			;GET ARG BLOCK LENGTH
	PUSHJ	P,$MTOPR		;GO DO THE MTOPR
	MOVE	S1,T3			;GET THE JFN BACK
	RLJFN				;RELEASE IT
	JFCL				;IGNORE ANY ERRORS
	JUMPF	LODR.3			;COULD NOT LOAD RAM,,FIND OUT WHY
	MOVE	S1,J$FRAM(J)		;GET THE RAM TYPE WE LOADED
	MOVEM	S1,J$FLRM(J)		;SAVE IT
	$RETT				;AND RETURN

LODR.3:	MOVX	S1,.FHSLF		;GET MY HANDLE
	GETER				;GET THE LAST ERROR
	HRRZS	S2,S2			;GET JUST THE ERROR CODE
	CAXE	S2,MTOX17		;IS THE ERROR 'LPT OFFLINE' ???
	JRST	NORAM			;NO,,LETS TRY SOME OTHER
	PUSHJ	P,OUTWON		;WAIT FOR THE LPT TO COME ONLINE
	JRST	LODR.1			;AND TRY AGAIN

>  ;END TOPS20 CONDITIONAL
TOPS10 <
	MOVE	S1,J$LCLS(J)		;GET THE CONTROLLER CLASS
	CAIE	S1,.DFS20		;IS THIS A CONSOLE FRONT END LPT ???
	$RETT				;NO,,THEN WE DONT LOAD THE RAM
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTO	(Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
	OPEN	17,RAMFOB		;OPEN THE STRUCTURE
	 JRST	NORAM			;CANT,,TRY SOMETHING ELSE
	MOVE	S1,J$FRAM(J)		;GET THE RAM WE WANT
	MOVEM	S1,RLKUP+0		;SAVE IN THE LOOKUP BLOCK
	MOVSI	S1,'RAM'		;GET THE EXTENSION
	MOVEM	S1,RLKUP+1		;SAVE IN THE LOOKUP BLOCK
	SETZM	RLKUP+2			;CLEAR 3'RD WORD OF LOOKUP BLOCK
	SETZM	RLKUP+3			;CLEAR 4'TH WORD OF LOOKUP BLOCK
	LOOKUP	17,RLKUP		;FIND THE FILE WE WANT
	 JRST	RDON.2			;NOT THERE,,TRY SOMETHING ELSE
	PUSHJ	P,M%GPAG		;GET A PAGE FOR A BUFFER
	MOVE	T4,S1			;SAVE THE ADDRESS FOR LATER
	MOVEI	T1,-1(S1)		;GET BUFFER ADDRESS-1
	HLL	T1,RLKUP+3		;GET -FILE LENGTH,,BUFFER ADDR-1
	SETZM	T2			;END CCW
	IN	17,T1			;READ THE RAM FILE
	SKIPA				;CONTINUE ON SUCCESSFUL RETURN
	 JRST	RDON.1			;AN ERROR,,TRY SOMETHING ELSE
	HLRO	T3,RLKUP+3		;GET -FILE LENGTH
	MOVMS	T3			;WANT POSITIVE LENGTH
	LSH	T3,2			;CONVERT TO 8 BIT BYTE COUNT
	MOVEI	T1,.DFLR2		;WANT LOAD RAM FUNCTION
	MOVE	T2,J$LCHN(J)		;WANT LPT CHANNEL NUMBER
	MOVE	S1,[4,,T1]		;GET ARG COUNT,,BLOCK ADDRESS
	SETZM	S2			;FLAG S2 (IF 0 THEN RAM LOADED OK)
	DEVOP.	S1,			;LOAD THE RAM
RDON.1:	 SETOM	S2			;INDICATE RAM LOAD ERROR
	MOVE	T1,S2			;SAVE THE RAM LOAD FLAG

	MOVE	S1,T4			;GET THE BUFFER ADDRESS BACK
	PUSHJ	P,M%RPAG		;RELEASE THE PAGE

RDON.2:	MOVEI	S1,17			;GET OUR CHANNEL NUMBER
	RESDV.	S1,			;WIPE IT OUT
	JFCL				;IGNORE ANY ERROR RELEASING THE DEVICE
	JUMPN	T1,NORAM		;IF AN ERROR,,GO TRY SOMETHING ELSE
	MOVE	S1,J$FRAM(J)		;GET THE RAM TYPE WE JUST LOADED
	MOVEM	S1,J$FLRM(J)		;SAVE IT AS LOADED RAM TYPE
	$RETT				;AND RETURN

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

RLKUP:	BLOCK	4			;LOOKUP BLOCK
>  ;END TOPS10 CONDITIONAL
	SUBTTL	NORAM -- ROUTINE TO PROCESS RAM LOADING ERRORS

NORAM:	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	$WTOR	(,<^I/RAMI1/^J^M^T/RAMI2/>,@JOBOBA(S1),JOBWAC(S1))
	SETZM	JOBCHK(S1)		;WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD(S1)		;  Update also
	$DSCHD	(PSF%OR)		;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;CANCELED OR REQUEUED ???
	JRST	[SETZM J$FORM(J)	;YES,,ZAP THE LOADED FORMS TYPE
		 $RETT ]		;AND RETURN
	HRROI	S1,J$RESP(J)		;GET THE RESPONSE ADDRESS
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,J$FRAM(J)		;SAVE THE NEW RAM TYPE
	JRST	LODRAM			;AND TRY AGAIN

RAMI1:	ITEXT	(<RAM Error, Can't Load RAM '^W/J$FRAM(J)/'>)
RAMI2:	ASCIZ	/Respond With RAM Type to Continue/
	SUBTTL	I/O Subroutines for LPFORM.INI


;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. SKIPS NORMALLY, NON-SKIP ON EOF.
FH$SIX:	CLEAR	T1,		;CLEAR FOR RESULT
	MOVE	T2,[POINT 6,T1]	;POINTER FOR RESULT
FH$SX1:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	JUMPF	.RETF		;FAIL IF EOF
	CAIL	C,"A"		;CHECK FOR ALPHA
	CAILE	C,"Z"
	  SKIPA			;ITS NOT!!
	JRST	FH$SX2		;IT IS, DEPOSIT IT

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

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


FH$GNB:	PUSHJ	P,FH$CHR		; Get a character
	 $RETIF				; Return if error
	CAIN	C," "			; A space?
	 JRST	FH$GNB			; No, do it again
	$RETT				; Return good
	;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C

FH$CHR:	MOVE	S1,FMIFN		;Get IFN for LPFORM.INI
	$CALL	F%IBYT			;Get next character
	JUMPF	.RETF			;Quit if bad or done
	MOVE	C,S2			;Move the character into C
	CAIE	C,.CHTAB		;CONVERT TABS
	CAIN	C,.CHCRT		;AND CARRIAGE RETURNS
	MOVEI	C,40			;INTO SPACES
	CAIE	C,.CHFFD		;CONVERT FORM FEEDS
	CAIN	C,.CHVTB		;AND VERTICAL TABS
	MOVEI	C,.CHLFD		;INTO LINEFEED
	CAIL	C,141			;CHECK LOWER CASE
	CAILE	C,172			;141-172
	$RETT				;ITS NOT
	SUBI	C,40			;YUP, CONVERT TO UPPER
	$RETT				;AND SKIP BACK
;ROUTINE TO SEARCH FOR EOL IN LPFORM.INI

FH$EOL:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	JUMPF	.RETF		;FAIL IF EOF
	CAIE	C,.CHLFD	;EOL?
	JRST	FH$EOL		;NO, LOOP
	$RETT			;YES, RETURN!


;ROUTINE TO PICK UP A DECIMAL NUMBER

FH$DEC:	CLEAR	T1,		;PLACE TO ACCUMULATE RESULT
FH$DE1:	PUSHJ	P,FH$CHR	;GET A CHARACTER
	JUMPF	.RETF		;EOF, RETURN
	CAIL	C,"0"		;CHECK THE RANGE
	CAILE	C,"9"		;0-9
	  POPJ	P,		;RETURN
	IMULI	T1,12		;SHIFT A PLACE
	ADDI	T1,-"0"(C)	;ADD IN A DIGIT
	JRST	FH$DE1		;AND LOOP AROUND
	SUBTTL	OUTGET  --  OPEN the output device

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

TOPS10 <
OUTGET:	SKIPLE	J$LREM(J)		;IS THIS A DN60 LPT ???
	JRST	[PUSHJ P,$OPEN		;YES,,GO OPEN IT UP
		 JUMPF OUTDDE		;NO GOOD,,TOO BAD !!!!!
		 PUSHJ P,OUTRES		;SETUP THE OUTPUT BUFFERS
		 JRST  OUTSOK ]		;AND CONTINUE

	;Here for local and normal remote LPT's

	PUSHJ	P,GENDEV		;CREATE THE PHYSICAL DEVICE NAME.
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVEM	S1,J$LCHN(J)		;SAVE IT AS THE CHANNEL NUMBER
	MOVX	S2,PSF%DO+PSF%OB	;GET OFFLINE+OUTPUT BLOCKED BITS
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR THE SCHEDULING BITS
	LSH	S1,^D23			;SHIFT CHANNEL # TO RIGHT PLACE

	IOR	S1,[OPEN T1]		;MAKE IT AN INSTRUCTION
	MOVX	T1,.IOASC+IO.SFF+UU.PHS+UU.AIO
					;ASCII+SUPRESS FF+PHONLY+NBIO
	SKIPE	J$MTAP(J)		;Is it really a printer?
	MOVX	T1,.IOASC+UU.PHS+UU.AIO ;No, don't set device dependent bit
	MOVE	T2,J$LDEV(J)		;OUTPUT DEVICE NAME
	MOVSI	T3,J$LBRH(J)		;BUFFER HEADER
	XCT	S1			;AND EXECUTE IT
	   JRST	OUTDNA			;LOSE GIVE ERROR

	MOVE	T1,[2,,T2]		;ARG POINTER
	MOVX	T2,.DFHCW		;HARDWARE CHARACTERISTICS WORD
	MOVE	T3,J$LCHN(J)		;GET CHANNEL NUMBER
	DEVOP.	T1,			;READ THE CHARS
	  JRST	OUTDDE			;SHOULDN'T HAPPEN

	TXNE	T1,DF.LCP		;IS IT A LOWER-CASE PRINTER?
	SETOM	J$LLCL(J)		;YES, SET THE FLAG
	MOVE	S1,[SIXBIT/LP64/]	;DEFAULT RAM TO 64 CHARACTER
	SKIPE	J$LLCL(J)		;UNLESS ITS LOWER CASE
	MOVE	S1,[SIXBIT/LP96/]	;THEN DEFAULT TO 96 CHARACTER SET
	MOVEM	S1,J$LRAM(J)		;SAVE THE DEFAULT RAM FILE NAME
	MOVE	S1,D$TAPE		;GET THE DEFAULT VFU TYPE.
	SKIPN	J$FTAP(J)		;HAS THE VFU ALREADY BEEN DEFAULTED ???
	MOVEM	S1,J$FTAP(J)		;NO,,SAVE AS THE VFU DEFAULT.
	LDB	S1,[POINTR(T1,DF.CLS)]	;GET THE COBTROLLER TYPE
	MOVEM	S1,J$LCLS(J)		;SAVE IT FOR LATER
	LDB	T1,[POINTR(T1,DF.VFT)]	;GET VFU TYPE
	CAIN	T1,.DFVTD		;IS IT A DAVFU?
	SETOM	J$LDVF(J)		;YES, SET THE FLAG
	SKIPGE	J$LREM(J)		;SKIP IF LOCAL PRINTER
	JRST	OUTG.2			;SETUP REGULAR BFRS FOR REMOTE

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

	MOVE	T1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE
	SUBI	T1,BUFSIZ		;BACK UP ONE BUFFER
	SETZ	T2,			;CLEAR A COUNTER

OUTG.1:	ADDI	T1,BUFSIZ		;POINT TO NEXT BUFFER
	MOVEI	S1,BUFSIZ+1(T1)		;GET LINK TO NEXT BUFFER
	HRLI	S1,BUFSIZ-2		;AND NUMBER DATAWORDS+1
	MOVEM	S1,1(T1)		;AND STORE IT AWAY IN BUFFER
	CAIGE	T2,BUFNUM-1		;GOT THEM ALL?
	AOJA	T2,OUTG.1		;NO, LOOP AROUND

	MOVNI	T2,BUFSIZ*BUFNUM	;LOAD -<COMPLETE BUFFER SIZE>
	ADDM	T2,1(T1)		;MAKE LAST BUFFER POINT TO FIRST
	MOVE	T1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE BACK
	ADDI	T1,1			;POINT TO WORD 1
	TXO	T1,BF.VBR		;MAKE IT A VIRGIN RING
	MOVEM	T1,J$LBRH(J)		;AND PUT IT WHERE MONITOR WILL FIND IT
	JRST	OUTSOK			;AND CONTINUE ON

OUTG.2:	MOVE	S1,J$LBUF(J)		;GET ADR OF BUFFER PAGE
	EXCH	S1,.JBFF		;SWAP IT WITH JOBFF
	MOVE	S2,J$LCHN(J)		;GET THE CHANNEL NUMBER
	LSH	S2,^D23			;POSITION IT
	IOR	S2,[OUTBUF 1]		;MAKE AN INSTRUCTION
	XCT	S2			;AND EXECUTE IT
	MOVEM	S1,.JBFF		;RESTORE JOBFF
	JRST	OUTSOK			;AND CONTINUE ON
>  ;END TOPS10 CONDITIONAL



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.
TOPS10<
	MOVE	S1,OBJ.ND(T1)		;PICK UP THE NODE NUMBER.
	CAME	S1,CNTSTA		;IS IT THE CENTRAL SITE ???
	SETOM	J$LREM(J)		;NO,,THEN ITS A REMOTE LPT.
	IDIVI	S1,10			;SPLIT NODE NUMBER IN HALF.
	IMULI	S1,100			;SHIFT LEFT 2 DIGITS.
	ADD	S1,S2			;ADD SECOND NODE DIGIT.
	IMULI	S1,100			;SHIFT LEFT ANOTHER 2 DIGITS.
>  ;END TOPS10 CONDITIONAL
	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. . . . .
TOPS20 <
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
	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'
	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
>  ;END TOPS20 CONDITIONAL
	SUBTTL	OUTGET Exit Subroutines


OUTSOK:	PUSHJ	P,INTCNL		;CONNECT UP THE LPT
	JUMPF	OUTDDE			;DID NOT SUCCEED,,DEVICE DOES NOT EXIST
	TXO	S,INTRPT		;INDICATE WE'RE CONNECTED
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN

OUTDNA:	SKIPLE	J$LREM(J)		; Is this a DN60?
	 JRST	OUTDDE			; Yes all errs fatal
	MOVX	S1,%RSUNA		;NOT AVAILABLE RIGHT NOW
	$RETF				;AND RETURN

OUTDDE:	MOVX	S1,%RSUDE		;NEVER AVAILABLE
	$RETF				;RETURN
	SUBTTL	TAPGET -- ROUTINE TO SETUP A MAG TAPE DEVICE FOR OUTPUT

TOPS20 <

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
	HRLI	S1,(POINT 7,0)		;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
	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	S1,S2,DV%TYP		;Get device type
	CAXE	S1,.DVMTA		;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
	MOVE	S1,J$LCHN(J)		;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
	$WTO	(<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2)) ;TELL THE OPERATOR
	PJRST	OUTDDE			;GIVE UP THE SHIP
>
	SUBTTL	OUTOUT  --  Routine to output a buffer


TOPS10 <


	;NOTE:	The 'Output-Blocked' bit is set here in order to avoid
	;	a race condition which would allow LPTSPL to miss the
	;	'Output-Done' Interrupt. In particular, this avoids
	;	the problem of getting the 'Output-Done' interrupt
	;	before LPTSPL has set the 'Output-Blocked' bit when
	;	de-scheduling the stream. This situation would cause
	;	the stream to block forever, waiting for an interrupt
	;	which it had already received.



OUTOUT:	SKIPLE	J$LREM(J)		;IS THIS A DN60 LPT ???
	JRST	$OUT60			;YES,,GO PROCESS IT !!!

	;Here for local and normal remote LPT's

	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%OB		;GET THE 'OUTPUT-BLOCKED' BIT
	IORM	S2,JOBSTW(S1)		;TURN ON THE 'OUTPUT-BLOCKED' BIT
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL NUMBER
	LSH	S1,^D23			;POSITION IT
	TLO	S1,(OUT 0,0)		;MAKE IT AN OUTPUT UUO
	XCT	S1			;OUTPUT THE BUFFER
	JRST	[MOVE   S1,STREAM	;NO ERROR,,GET OUR STREAM NUMBER
		 ANDCAM S2,JOBSTW(S1)	;   AND CLEAR THE OUTPUT BLOCKED BITS
		 $RETT	]		;      NOW WE CAN RETURN
	PJRST	OUTERR			;ERROR,,GO PROCESS IT
>  ;END TOPS10 CONDITIONAL

TOPS20 <

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
>  ;END TOPS20 CONDITIONAL


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	OUTERR  --  Handle Output Device Errors

OUTERR:
TOPS10 <
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL NUMBER
	LSH	S1,^D23			;POSITION IT
	IOR	S1,[GETSTS J$LIOS(J)]	;MAKE IT AN INSTRUCTION
	XCT	S1			;AND EXECUTE IT
	MOVE	S1,J$LIOS(J)		;GET THE IOERROR STATUS
	TXNE	S1,IO.ERR!IO.EOT	;WAS THERE AN ERROR? OR HIT END OF TAPE?
	JRST	OUTE.1			;YES, GIVE THE ERROR
	$DSCHD(0)			;BLOCK FOR OUTPUT DONE (See Above)
	JRST	OUTOUT			;AND TRY AGAIN

OUTE.1:	PUSHJ	P,.SAVET		;SAVE ALL THE 'T' ACS
	MOVE	T4,STREAM		;GET THE STREAM NUMBER
	MOVE	S1,J$LIOS(J)		;GET THE ERROR STATUS
	TRC	S1,IO.ERR		;TEST FOR ALL FOUR ERROR BITS
	TRCE	S1,IO.ERR		;BEING SET.
	JRST	OUTE.5			;AND THEY ARE NOT
	MOVE	T1,[2,,T2]		;PREPARE FOR DEVOP. UUO
	MOVEI	T2,.DFRES		;READ EXTENDED ERROR STATUS
	MOVE	T3,J$LCHN(J)		;GET CHANNEL NUMBER
	DEVOP.	T1,
	  JRST	OUTE.2			;LOSE, JUST GIVE STATUS
	CAXN	T1,IOVFE%		;IS THE ERROR BAD VFU ?
	JRST	OUTE.4			;YES,,DO SOME SPECIAL PROCESSING
	CAXE	T1,IOPAR%		;IS IT RAM TROUBLE ???
	JRST	OUTE.2			;NO,,GENERAL I/O ERROR
					;YES,,FALL THROUGH AND PROCESS IT
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	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

>  ;END TOPS20 CONDITIONAL		;YES,,PROCESS IT

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

	;RAM PARITY ERROR

OUT.2A:	$WTO	(RAM Parity Error,,@JOBOBA(T4)) ;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

	;Write ring missing

OUT.2B:	$WTOR	(MTA Write Protected,<Insert Write Ring And Put On Line^m^j^t/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
	SETOM	JOBCHK(T4)		;WE WANT A CHECKPOINT
	$DSCHD(PSF%OR)			;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED
	$RETT				;YES,, JUST RETURN
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ??
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK
	JRST	OUT.2B			;NO, TRY AGAIN
	PUSHJ	P,OUTE.3		;GO PERFORM PRELIMINARY PROCESSING
	$RETT				;AND RETURN

	;UNKNOWN TYPE I/O ERROR OCCURED

OUTE.2:	$WTO  (I/O Error,<Status is: ^O/J$LIOS(J)/>,@JOBOBA(T4))

	;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		;IF LOADING VFU OR PRINTING HDRS
	SKIPN	J$DIFN(J)		;   OR IF WE ARE NOT IN A FILE?
	$RETT				;THEN JUST RETURN
	MOVE	S1,J$RNCP(J)		;GET NUMBER OF COPIES PRINTED
	AOS	S1			;MAKE INTO CURRENCT COPY NUMBER
	$TEXT	(LOGCHR,<^I/LPERR/LPT I/O Error occurred during ^F/@J$DFDA(J)/, Copy:^D/S1/, Page:^D/J$RNPP(J)/; Status is: ^O/J$LIOS(J)/>)
	MOVEI	S1,[EXP 5]		;PREPARE TO BACKSPACE 5 PAGES
	PUSHJ	P,BSPACE		;BACKSPACE 5 PAGES
	$RETT				;RETURN

	;EOT

OUT.3A:	PUSHJ	P,TAPMRK		;WRITE A TAPE MARK
	PUSHJ	P,TAPUNL		;UNLOAD THE TAPE
OUT.3B:	$WTOR	(<End of spooled output tape>,<Please mount next volume^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))	;NOTIFY OPERATOR
	SETOM	JOBCHK(T4)		;WE WANT A CHECKPOINT
	$DSCHD(PSF%OR)			;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED
	$RETT				;YES,, JUST RETURN
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ??
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK
	JRST	OUT.3B			;NO, TRY AGAIN
	PUSHJ	P,OUTE.3		;GO PERFORM PRELIMINARY PROCESSING
	$RETT				;AND RETURN

	;VFU ERROR OCCURED

OUTE.4:	TXNE	S,VFULOD		;Are we already loading VFU?
	JRST	[$WTO	(VFU error while loading VFU,,@JOBOBA(T4)); Yes
		JRST SHUTIN]		;Kill this stream
	$WTOR  (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
	SETZM	JOBCHK(T4)		;SAY WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD(T4)		;  update the status also
	$DSCHD(PSF%OR)			;WAIT FOR THE OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	$RETT				;YES,,JUST RETURN
	MOVEI	S1,CONANS		;POINT TO THE CONTINUE ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	OUTE.4			;NO,,STUPID OPERATOR SO TRY AGAIN
	PUSHJ	P,OUTE.3		;GO PERFORM SOME PRELIMINARY PROCESSING
	SETZM	J$FLVT(J)		;FORCE A VFU RELOAD
	PUSHJ	P,LODVFU		;GO RELOAD THE VFU
	$RETT				;AND RETURN
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;NO STOCK ERROR BITS SET, TRY EOF (END OF TAPE)
TOPS10<
OUTE.5:	SKIPE	J$MTAP(J)		;ARE WE SPOOLING TO TAPE?
	TRZN	S1,IO.EOT		;YES, HIT EOT?
	JRST	OUTE.2			;NO, UNKNOWN ERROR
	MOVE	T1,J$LCHN(J)		;GET CHANNEL NUMBER
	LSH	T1,^D23			;MOVE INTO PLACE (AC FIELD)
	TLO	T1,(SETSTS (S1))	;MAKE INTO A UUO
	XCT	T1			;CLEAR THE ERROR (EOT)
	MOVE	T1,[XWD 2,T2]		;AIM AT ARGUMENT BLOCK FOR TAPOP.
	MOVX	T2,.TFWTM		;CODE TO WRITE A TAPE MARK
	MOVE	T3,J$LCHN(J)		;DEVICE ON THIS CHANNEL
	TAPOP.	T1,			;WRITE ONE MARK
	JFCL				;OH WELL
	TAPOP.	T1,			;WRITE ANOTHER (MARK END OF TAPE)
	JFCL				;ITS A BAD DAY (AND A BAD TAPE!)
	MOVX	T2,.TFUNL		;CODE TO GET RID OF THE TAPE
	TAPOP.	T1,			;UNLOAD THIS FULL REEL
	JFCL				;HAVE TO LIVE WITH IT
OUT.5A:	$WTOR	(End of tape,<Mount next reel on ^W/J$MTAP(J)/^M^JType 'RESPOND ^7/[.CHLAB]/number/^7/[.CHRAB]/PROCEED' when ready>,@JOBOBA(T4),JOBWAC(T4))
	SETZM	JOBCHK(T4)		;SAY WE WANT A CHECKPOINT TAKEN
	SETOM	JOBUPD(T4)		;  update the status also
	$DSCHD	(PSF%OR)		;DROP THE STREAM TILL RESPONSE COMES IN
	TXNE	S,ABORT+RQB		;HAVE WE BEEN GIVEN THE GONG?
	$RETT				;YES, QUIT NOW
	MOVEI	S1,CONANS		;POINT TO THE VALID RESPONSES
	HRROI	S2,J$RESP(J)		;AIM AT WHAT THE OPR TYPED
	$CALL	S%TBLK			;BOUNCE RESPONSE OFF TABLE
	TXNE	S2,TL%NOM+TL%AMB	;MATCH?
	JRST	OUT.5A			;NO, ASK OPR AGAIN
	JRST	OUTOUT			;NEW REEL IS UP, TRY OUTPUT AGAIN
>;END OF TOPS10

CONANS:	$STAB
	 KEYTAB	(0,PROCEED)
	$ETAB



OUTDIE:	SOSL	J$LERR(J)		;COUNT DOWN ERRORS
	POPJ	P,			;STILL ALIVE
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (TOO MANY DEVICE ERRORS,,@JOBOBA(S1))
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	Tape routines


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

TOPS10	<				;TOPS-10
	MOVE	TF,[2,,S1]		;SET UP UUO
	MOVEI	S1,.TFWTM		;FUNCTION CODE
	MOVE	S2,J$LCHN(J)		;GET CHANNEL NUMBER
	TAPOP.	TF,			;WRITE A TAPE MARK
	  JFCL				;CAN'T
	POPJ	P,			;RETURN
>					;END OF TOPS-10 CONDITIONAL

TOPS20	<				;TOPS-20
	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
>					;END OF TOPS-20 CONDITIONAL


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

TOPS10	<				;TOPS-10
	MOVE	TF,[2,,S1]		;SET UP UUO
	MOVEI	S1,.TFUNL		;FUNCTION CODE
	MOVE	S2,J$LCHN(J)		;GET CHANNEL NUMBER
	TAPOP.	TF,			;UNLOAD THE TAPE
	  JFCL				;CAN'T
	POPJ	P,			;RETURN
>					;END OF TOPS-10 CONDITIONAL

TOPS20	<				;TOPS-20
	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
>					;END OF TOPS-20 CONDITIONAL
	SUBTTL	OUTWON  --  Wait for on-line

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


TOPS10 <
OUTWON:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	MOVE	S1,STREAM		;GET STREAM NUMBER
	$WTO  (<^T/BELL/>,,@JOBOBA(S1))	;TELL THE OPERATOR.
	$DSCHD(0)			;BLOCK THE PROCESS
	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	JRST	@J$LIOA(J)		;AND CONTINUE ON
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTWON:	MOVX	S2,PSF%DO		;DEVICE OFFLINE FLAG
	MOVE	S1,STREAM		;AND THE STREAM NUMBER
	TDNN	S2,JOBSTW(S1)		;IS IT OFF-LINE?
	POPJ	P,			;NO, JUST RETURN
	$WTO	(<^T/BELL/>,,@JOBOBA(S1))	;TELL THE OPERATOR.
	$DSCHD(0)			;BLOCK FOR DEVICE ONLINE
	POPJ	P,			;NO, RETURN
>  ;END TOPS20 CONDITIONAL

BELL:	BYTE(7) 07,07,117,146,146
	ASCIZ/line/
	SUBTTL	OUTREL  --  Release device on SHUTDOWN

TOPS10 <
OUTREL:
IFN FTDN60,<
	SKIPLE	J$LREM(J)		;Is this a DN60?
	PJRST	CLOS.6			;Go close it
> ;End of IFN FTDN60
	TXZE	S,INTRPT		;ARE WE CONNECTED TO INTRPT SYSTEM ??
	PUSHJ	P,INTDCL		;YES,,RELEASE THE INTERRUPTS
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL
	SKIPN	J$MTAP(J)		;ARE WE SPOOLING TO TAPE ???
	SKIPE	J$LREM(J)		;No, are we using a remote printer?
	JRST	OUTR.1			;YES TO EITHER, ISSUE A CLOSE/RELEASE
	RESDV.	S1,			;RESET THE CHANNEL
	JFCL				;IGNORE ANY ERRORS
	$RETT				;AND RETURN
OUTR.1:	LSH	S1,^D23			;POSITION THE CHANNEL NUMBER
	TLO	S1,(CLOSE 0,0)		;MAKE IT A CLOSE UUO
	XCT	S1			;CLOSE THE MAG TAPE
	MOVE	S1,J$LCHN(J)		;GET THE CHANNEL NUMBER AGAIN
	LSH	S1,^D23			;POSITION IT
	TLO	S1,(RELEASE 0,0)	;MAKE IT A RELEASE UUO
	XCT	S1			;RELEASE THE DEVICE
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <
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
	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
>;END TOPS20 CONDITIONAL
	SUBTTL	OUTEOF -- ROUTINE TO CLEAR THE LPT OUTPUT BUFFERS


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

TOPS10 <
	$SAVE	<T1>			;SAVE T1 FOR A MINUTE
	MOVX	S1,.TFWTM		;GET WRITE TAPE MARK CODE
	MOVE	S2,J$LCHN(J)		;GET THE DEVICE CHANNEL #
	MOVE	T1,[XWD 2,S1]		;GET LENGTH,,PARM BLOCK ADDRESS
	TAPOP.	T1,			;DO IT
	JFCL				;IGNORE ANY ERRORS
	$RETT				;AND RETURN
>  ;End of TOPS10

TOPS20 <
	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
>  ;End of TOPS20

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	OUTDMP  --  Dump out buffers and wait

TOPS10 <
OUTDMP:
REPEAT BUFNUM+1,<
	PUSHJ	P,OUTOUT		;DUMP THE BUFFER
>  ;END REPEAT BUFNUM
	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTDMP:	PUSHJ	P,OUTOUT		;DUMP THE INTERNAL BUFFERS
	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
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL
	SUBTTL	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
	CAIN	S1,1			;DN60 type?
	JRST	OUTF.2			;Go and only reset buffers
> ;End of FTDN60
TOPS10 <
	SKIPE	J$LREM(J)		;Skip if local
	$RETT				;Do nothing if remote since only 1 buf.
	PUSHJ	P,INTDCL		;DISCONNECT PRINTER INTERRUPTS
	MOVE	S1,J$LCHN(J)		;LOAD THE CHANNEL NUMBER
	RESDV.	S1,			;RESET THE CHANNEL
	  JFCL				;??
	PUSHJ	P,OUTGET		;GO RESET UP THE OUTPUT DEVICE
	CAIN	S1,%RSUOK		;ARE WE ALL RIGHT ???
	$RETT				;YES,,JUST RETURN
	PUSHJ	P,RSETUP		;NO,,SEND RESPONSE TO SETUP MSG
	$RETF				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	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
>  ;END TOPS20 CONDITIONAL

IFN FTDN60,<
OUTF.2:	$CALL	OUTRES			;Reset output buffers
	$RETT				;All to do for DN60
> ;End of FTDN60
	SUBTTL LPT CONTROL ROUTINES


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

CHTAB:	EXP	<NCLRFF+.POPJ>		   ;(00) NULL
	EXP	CHKARO			   ;(01) CONTROL-A
	EXP	CHKARO			   ;(02) CONTROL-B
	EXP	CHKARO			   ;(03) CONTROL-C
	EXP	CHKARO			   ;(04) CONTROL-D
	EXP	CHKARO			   ;(05) CONTROL-E
	EXP	CHKARO			   ;(06) CONTROL-F
	EXP	CHKARO			   ;(07) CONTROL-G
	EXP	CHKARO			   ;(10) CONTROL-H
	EXP	NCLRFF+DEVOUT		   ;(11) THIS IS A TAB
	EXP	SUPRCH+EOLCHR+DOLF	   ;(12) THIS IS A LINE FEED
	EXP	SUPRCH+EOLCHR+<3>B17+DOFRAC ;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
	EXP	SUPRCH+NCLRFF+EOLCHR+DOFORM   ;(14) THIS IS A FORM-FEED
	EXP	NCLRFF+EOLCHR+DEVOUT	   ;(15) CARRIAGE RETURN
	EXP	CHKARO			   ;(16) CONTROL-N
	EXP	CHKARO			   ;(17) CONTROL-O
	EXP	SUPRCH+EOLCHR+<2>B17+DOFRAC ;(20) THIS SKIPS 1/2 PAGE
	EXP	SUPRCH+EOLCHR+<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 FILOUT -- SUBROUTINE TO SET UP FOR LPTIN AND LPTOUT

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

FILOUT:	MOVE	T1,J$FLIN(J)		;START AT TOP OF PAGE
	MOVEM	T1,J$XPOS(J)		;SAVE IT
	PUSHJ	P,SETPFT		;SETUP FILE TYPE
	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	SETLST -- SUBROUTINE TO COMPILE CODE TO TEST EACH LINE FOR A MATCH AGAINST

;	 THE /REPORT VALUE.
;	CALL WITH:
;		PUSHJ	P,SETLST
;		RETURN HERE
;



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


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

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

;THE DETERMINATION IS DONE IN THE ABOVE ORDER


SETPFT:	LOAD	S1,.FPINF(E),FP.FFF	;GET /FILE
	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	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:	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	LPTELV  --  Print MACY11 file as regular ASCII


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

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

LPTE.3:	CAIGE	C,40			;PRINTABLE ASCII?
	JRST	LPTE.6			;NO, GO HANDLE SPECIAL CHARS
	TXNE	S,FORWRD		;ARE WE FORWARD SPACING ???
	POPJ	P,			;YES,,SKIP THIS.
	SETZM	J$XTOP(J)		;CLEAR TOF FLAG
LPTE.4:	SOSGE	J$LBCT(J)		;ANY ROOM IN BUFFER?
	JRST	LPTE.5			;NO, FILL IT
	IDPB	C,J$LBPT(J)		;YES, DEPOSIT IN BUFFER
	POPJ	P,			;AND GET ANOTHER

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

LPTE.6:	PUSHJ	P,CHKSP			;GO HANDLE SPECIAL CHARS
	POPJ	P,			;AND LOOP AROUND
	SUBTTL	LPTFOR  --  Process FORTRAN data files

LPTFOR:	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:	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			;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	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	LPTOCT  --  Give an Octal Dump

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

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


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

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

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

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

;SUBROUTINE TO PLACE A CHAR ON THE LINE PRINTER
;CALL WITH:
;	PUSHJ	P,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		;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
	POPJ	P,			;DO NOT PRINT BLANK PAGES
	MOVN	S1,J$XPOS(J)		;THIS TAKES ALL WE HAVE ON PAGE
	SKIPL	S1			;WAS VPOS NEGATIVE?
	CLEAR	S1,			;DONT CHARGE FOR ANYTHING THEN.
					;THIS MIGHT GIVE THE USER A
					;BONUS OF 1-3 FREE LINES.
	JRST	CNTDWN			;COUNT DOWN THE LIMIT

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

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

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

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

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

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

CNTDW1:	MOVE	S1,J$FLIN(J)		;BACK TO TOP OF PAGE
	MOVEM	S1,J$XPOS(J)		;SAVE POSITION
	SOSG	J$FPIG(J)		;DECREMENT THE FORWARD SPACING COUNT.
	TXZ	S,FORWRD		;TURN OFF THE FORWARD SPACE BIT.
	AOS	J$RNPP(J)		;ADD 1 TO PAGES PER COPY COUNTER
	TXNE	S,FORWRD		;FORWARD SPACING ???
	JRST	[			;Yes
TOPS10<		MOVE	S1,J$RNPP(J)	;Get pages printed per copy
		IDIVI	S1,FRWSKP	;Divide by DSCHD factor
		SKIPE	S2		;Are we on an evenly divisible page?
		JRST	CNTDW2		;No, skip this
		SETZM	SLEEPT		;No sleeptime wanted
		$DSCHD(0)		;Let the other streams try
> ; End of TOPS10
		JRST	CNTDW2]		;Continue on
	AOS	J$APRT(J)		;NO,,ADD 1 TO TOTAL PAGES COUNTER

	;Here we keep track of where we are for backspaceing

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

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

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

	;DEFAULT TO ASK IF NOT IGNORE OR CANCEL

LIMC.1:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBCHK(S1)		;SAY WE WANT TO TAKE A CHECKPOINT
	SETOM	JOBUPD(S1)		;  update the status also
	$WTOR	(Page Limit Exceeded,<^R/.EQJBB(J)/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1))
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE
	TXNE	S,ABORT+RQB		;HAVE WE BEEN CANCELED OR REQUEUED ???
	JRST	LIMC.2			;YES,,IGNORE THE ERROR
	MOVEI	S1,LIMANS		;POINT TO THE LIMIT ANSWER BLOCK
	HRROI	S2,J$RESP(J)		;POINT TO THE ANSWER
	PUSHJ	P,S%TBLK		;DO WE MATCH ???
	TXNE	S2,TL%NOM+TL%AMB	;DID WE FIND IT OK ???
	JRST	LIMC.1			;NO,,STUPID OPERATOR SO TRY AGAIN
	HRRZ	S1,0(S1)		;GET THE ROUTINE ADDRESS
	JRST	0(S1)			;AND PROCESS THE RESPONSE

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

	;IF ANSWER WAS 'PROCEED' COME HERE

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

	;IF ANSWER WAS 'ABORT' COME HERE

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

LIMC.4:	$TEXT(LOGCHR,<^I/LPERR/Page Limit Exceeded>)
	SETZM	J$XTOP(J)		;CLEAR TOP-OF-FORM FLAG
	PUSHJ	P,SENDFF		;SEND A FORM FEED
	TXO	S,ABORT			;LIGHT THE ABORT BIT
	$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
	;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	Subroutines to send messages to the output device

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


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


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


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

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

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

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

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

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

GIVHDR:	$TEXT	(<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^R/.EQJBB(J)/  ^I/DATMON/^0>)

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

	$RETT				;RETURN.

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

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

TOPS10 <
	$TEXT(<-1,,J$PUSR(J)>,<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/^0>)
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	$TEXT(<-1,,J$PUSR(J)>,<^T/.EQOWN(J)/^0>)
>  ;END TOPS20 CONDITIONAL

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

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

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

TRAI.1:	PUSHJ	P,SENDFF		;SEND A FORMFEED
	SETZM	J$XPOS(J)		;CLEAR THE VERTICAL POSITION
	PUSHJ	P,TRAI.3		;PRINT THE INTERNAL LOG
	PUSHJ	P,PLINES		;PRINT TILL END OF PAGE
	SOJG	P3,TRAI.1		;LOOP UNTIL DONE
	PJRST	OUTDMP			;AND DUMP BUFFERS AND RETURN

;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
	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	UTILITY ROUTINES

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



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

PEOP:	MOVE	T2,J$FLIN(J)		;GET NUMBER OF LINES/PAGE
	SUB	T2,J$XPOS(J)		;SUBTRACT THOSE PRINTED
	ADDI	T2,1			;COUNT THE MARGIN
PEOP1:	JUMPLE	T2,PEOP2		;GO FINISH OFF
	PUSHJ	P,CR23			;PRINT A CR23
	SOJA	T2,PEOP1		;AND LOOP
PEOP2:	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	MOVSI	P1,-3			;GET COUNTER
PEOP3:	MOVE	P2,STARS(P1)		;GET ADDRESS OF TEXT STRING
	MOVE	P3,J$FWID(J)		;GET THE WIDTH
	CAILE	P3,^D130		;IS IT REASONABLE?
	MOVEI	P3,^D130		;NOW IT IS
PEOP4:	ILDB	C,P2			;GET A CHARACTER
	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	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.
	PUSHJ	P,SENDFF		;SEND A FORMFEED
	LOAD	P1,.FPINF(E),FP.NFH	;GET THE NO HEADER BIT
	SKIPN	P1			;SKIP IF WE DON'T WANT HEADERS
	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$PFLS(J)		;GET BLOCKSIZE
	MOVEI	S2,J$PFL1(J)		;AND ADDRESS OF FIRST LINE
	PUSHJ	P,PICTUR		;PRINT THE LINE
	MOVE	S1,J$PFLS(J)		;GET BLOCKSIZE
	MOVEI	S2,J$PFL2(J)		;AND ADDRESS OF SECOND LINE
	PUSHJ	P,PICTUR		;AND PRINT THE SECOND LINE
	MOVE	P1,J$FWCL(J)		;LOAD THE WIDTH CLASS
	MOVEI	S1,J$XHBF(J)		;LOAD ADDRESS OF BANNER LINE
	PUSHJ	P,STGOUT		;AND SEND IT
	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
	$TEXT(TBFCHR,<^M^JFile ^F/@J$DFDA(J)/, 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>)
	GETLIM	S1,.EQLIM(J),NOT1	;GET FIRST HALF OF NOTE
	GETLIM	S2,.EQLIM(J),NOT2	;GET SECOND HALF OF NOTE
	SKIPE	S1			;IS THERE A NOTE?
	$TEXT(TBFCHR,<   Note:^W6/S1/^W/S2/^A>)
	PUSHJ	P,CRLF			;END THE LINE
	PUSHJ	P,TBFDMP		;AND DUMP IT
	LOAD	S1,.FPINF(E),FP.FSP	;GET /SPACING
	LOAD	S2,.FPINF(E),FP.FCY	;GET THE TOTAL COPY COUNT
	LOAD	T1,J$RNCP(J)		;GET THE COPIES DONE SO FAR
	ADDI	T1,1			;MAKE THIS THE CURRENT COPY
	$TEXT(TBFCHR,<File parameters: Copy: ^D/T1/ of ^D/S2/   Spacing:^W/SPCTAB-1(S1)/^A>)

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

	PUSHJ	P,TBFDMP		;SEND THE LINE
	LOAD	S1,.FPINF(E),FP.FPF	;GET /PRINT
	LOAD	S2,.FPINF(E),FP.FFF	;GET /FILE
	CAXN	S2,.FPF8B		;/FILE:8-BIT?
	MOVEI	S2,4			;YES, RECORD THE VALUE
	CAXN	S2,.FPF11		;/FILE:ELEVEN?
	MOVEI	S2,5			;YES,,RECODE THE VALUE
	$TEXT(TBFCHR,<^T/(P1)/  File format:^W/FFMTAB-1(S2)/   Print mode:^W/FMTAB-1(S1)/^A>)
	LOAD	S1,.FPINF(E),FP.DEL	;GET /DELETE BIT
	SKIPE	S1			;IS IT SET?
	$TEXT(TBFCHR,<   /DELETE^A>)	;YES,,SAY SO
TOPS10	<
	LOAD	S1,.FPINF(E),FP.REN	;GET /DISPOSE:RENAME BIT
	SKIPE	S1			;IS IT SET?
	$TEXT(TBFCHR,<   /DISPOSE:RENAME^A>)	;YES,,SAY SO
>;END TOPS10
	PUSHJ	P,CRLF			;END THE LINE
	MOVE	S1,J$FPIG(J)		;GET STARTING PAGE
	CAILE	S1,1			;SKIP IF 0 OR 1
	$TEXT(TBFCHR,<^M^JPrinting will start at page ^D/J$FPIG(J)/>)
	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	SETHDR  --  Setup header name for file

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

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

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

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

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

TOPS20 <
SETH.2:
SETH.3:	MOVE	P1,[POINT 7,J$PFL1(J)]	;GET THE FILENAME BYTE PTR
	MOVE	P2,[POINT 7,J$PFL2(J)]	;GET THE EXTEN BYTE PTR
	MOVX	S1,GJ%SHT!GJ%OFG	;PARSE-ONLY + SHORT-GTJFN
	MOVE	S2,J$DFDA(J)		;GET THE FD ADDRESS
	HRROI	S2,.FDFIL(S2)		;AND POINT TO THE FILESPEC
	GTJFN				;GET A JFN FOR THE FILE
	 ERJMP	SETH.S			;ERROR,,GIVE NON-DESCRIPT NAME
	EXCH	S1,P1			;SAVE JFN IN P1, GET POINTER IN S1
	MOVE	S2,P1			;GET JFN IN S2
	MOVX	T1,1B8			;FILENAME ONLY
	JFNS				;GET IT
	MOVE	S1,P2			;GET THE 2ND LINE POINTER
	MOVE	S2,P1			;GET THE JFN
	MOVX	T1,1B11			;EXTENSION ONLY
	JFNS				;GET THE EXTENSION
	MOVEI	T2,"."			;FIRST, LOAD A BLANK
	IDPB	T2,S1			;AND DEPOSIT IT
	MOVX	T1,1B14			;GET THE GENERATION NUMBER
	JFNS				;DO IT!!
	MOVE	S1,P1			;GET THE JFN
	RLJFN				;RELEASE IT
	ERJMP	.+1			;IGNORE THE ERROR
	LOAD	S1,.FPINF(E),FP.SPL	;GET THE SPOOL BIT
	JUMPE	S1,SETH.W		;IF NOT SPOOLED, THERE WE'RE DONE

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

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

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

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

TOPS10 <
SETH.2:	MOVE	S1,J$DIFN(J)		;GET THE FILE'S IFN
	MOVX	S2,FI.SPL		;GET THE SPOOL NAME INFO CODE
	PUSHJ	P,F%INFO		;GET THE SPOOLED NAME (.RBSPL)
	JUMPE	S1,SETH.S		;NO SPOOLED NAME
	$TEXT(<-1,,J$PFL1(J)>,<^W/S1/^0>) ;GENERATE THE SPOOLED NAME
	SETZM	J$PFL2(J)	 	;AND NO EXTENSION
	JRST	SETH.W			;AND FINISH UP

SETH.3:	MOVE	P1,J$DFDA(J)		;GET THE FD ADDRESS
	$TEXT(<-1,,J$PFL1(J)>,<^W/.FDNAM(P1)/^0>)
	$TEXT(<-1,,J$PFL2(J)>,<^W3/.FDEXT(P1)/^0>)
	JRST	SETH.W			;FINISH UP AND RETURN

SETH.4:	$TEXT(<-1,,J$PFL1(J)>,<^W/.FPONM(E)/^0>) ;OUTPUT ORIGINAL NAME
	$TEXT(<-1,,J$PFL2(J)>,<^W3/.FPOXT(E)/^0>) ;AND EXTENSION
	JRST	SETH.W			;FINISH UP AND RETURN
>  ;END TOPS10 CONDITIONAL

;COMMON SUBROUTINES

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

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

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

SETH.W:	MOVE	S1,J$FWCL(J)		;GET THE WIDTH CLASS
	CAMLE	S1,J$FLCL(J)		;Compare with the length class
	MOVE	S1,J$FLCL(J)		;Use the min. of the two.
	MOVE	S2,J$PFL1+1(J)		;GET 2ND WORD OF LINE 1
	IOR	S2,J$PFL2+1(J)		;OR IN SECOND WORD OF LINE 2
	TLNE	S2,003760		;IS THE 7TH CHARACTER THERE IN EITHER?
	MOVEI	S1,1			;YES, USE BLOCKSIZE 1
	MOVEM	S1,J$PFLS(J)		;SAVE IT
	$RETT				;AND RETURN
	SUBTTL	PICTUR  --  Routine to print block letters

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

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

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

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

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

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

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

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

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

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

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

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

	BYTE (5) 04,10,10,20,10,10,04	;OPEN BRACE
	BYTE (5) 04,04,04,00,04,04,04	;VERTICAL BAR
	BYTE (5) 04,02,02,01,02,02,04	;CLOSE BRACE
	BYTE (5) 00,10,25,02,00,00,00	;TILDE
	BYTE (5) 00,00,00,00,00,00,00	;RUBOUT
	SUBTTL	SYSTEM INITIALIZATION FUNCTIONS

TOPS10 <
OPDINI:	MOVEI	T3,4			;NUMBER OF WORDS IN SYSNAM - 1
	MOVS	T1,[%CNFG0]		;ADR OF FIRST WORD
GETSYN:	MOVS	T2,T1			;GET THE GETTAB ADR
	GETTAB	T2,			;GET THE WORD
	  JFCL				;IGNORE THIS
	MOVEM	T2,LPCNF(T1)		;SAVE NAME
	CAILE	T3,(T1)			;DONE?
	AOJA	T1,GETSYN		;NO, LOOP

	PUSHJ	P,I%HOST		;GET THE HOST NAME AND NUMBER
	MOVEM	S2,CNTSTA		;SAVE THE NUMBER
	MOVSI	S1,.STSPL		;ISSUE 'SETUUO' TO
	SETUUO	S1,			;   CLEAR SPOOLING BITS
	  JFCL				;IGNORE THE ERROR
	PJOB	S1,			;GET OUR JOB NUMBER
	MOVEM	S1,LPJOB		;SAVE IT
	MOVE	S1,[ASCII/D/]		;DEFAULT TO DETACHED
	MOVEM	S1,LPTRM		;SAVE THE DESIGNATOR
	GETLIN	S1,			;GET OUR TTY NUMBER
	TLNN	S1,-1			;ARE WE DEATCHED ???
	JRST	OPDI.1			;YES,,SKIP THIS
	GTNTN.	S1,			;GET OUR LINE NUMBER
	 JRST	OPDI.1			;FAILED,,WE ARE DETACHED
	SETOM	S2			;GET A -1
	TRMNO.	S2,			;GET OUR TTY NUMBER
	 JRST	OPDI.1			;FAILED,,WE ARE DETACHED !!!
	GETLCH	S2			;GET OUR LINE CHARACTERISTICS
	MOVE	TF,[ASCII/T/]		;DEFAULT TO A TTY
	TXNE	S2,GL.ITY		;ARE WE A PTY ???
	MOVE	TF,[ASCII/P/]		;YES,,MAKE US 'PTY'
	TXNE	S2,GL.CTY		;ARE WE THE CTY ???
	MOVE	TF,[ASCII/C/]		;YES,,MAKE US 'CTY'
	MOVEM	TF,LPTRM		;SAVE THE TERMINAL DESIGNATOR
	HRRZM	S1,LPLNO		;SAVE THE LINE NUMBER
	JRST	OPDI.1			;CONTINUE
>  ;END TOPS10 CONDITIONAL

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


TOPS20 <
OPDINI:	PUSHJ	P,I%HOST		;GET THE HOST NAME
	MOVEM	S1,CNTSTA		;SAVE IT
	MOVX	S1,.MSIIC		;GET 'IGNORE STR ACCTING' FUNCTION
	MSTR				;WE WANT TO IGNORE STRUCTURE ACCOUNTING
	ERJMP	.+1			;IGNORE ANY ERROR
	MOVX	S1,'SYSVER'		;NAME OF GETTAB FOR SYSNAME
	SYSGT				;GET IT
	HRLZ	T1,S2			;GET TABLE#,,0
	MOVEI	T2,10			;AND LOAD LOOP COUNTER
GETSYN:	MOVS	S1,T1			;GET N,,TABLE#
	GETAB				;GET THE ENTRY
	  MOVEI	S1,0			;USE ZERO IF LOSING
	MOVEM	S1,LPCNF(T1)		;STORE THE RESULT
	CAILE	T2,(T1)			;DONE ENUF?
	AOJA	T1,GETSYN		;NO, LOOP

	MOVX	S1,RC%EMO		;EXACT MATCH
	HRROI	S2,[ASCIZ /PS:<SPOOL>/]	;DIRECTORY NAME
	RCDIR				;GET THE NUMBER
	MOVEM	T1,SPLDIR		;SAVE IT
>  ;END TOPS20 CONDITIONAL

OPDI.1:
IFN FTDN60,<
	MOVEI	S1,SERFLG		;Get SYSERR flag
	PUSHJ P,D60INI##		;INIT DN60 DATA BASE
> ; End of IFN FTDN60
	SETZM	FMOPN			;CLEAR FORMS.INI OPEN FLAG
	$RETT				;AND RETURN
	SUBTTL	OPNFRM  --  Routine to open LPFORM.INI

OPNFRM:	SKIPN	FMOPN			;OPEN ALREADY?
	JRST	OPNF.1			;NO, CONTINUE ON
	MOVE	S1,FMIFN		;YES, GET THE IFN
	PUSHJ	P,F%REL			;AND RELEASE IT
	SETZM	FMOPN			;CLEAR "OPEN"

OPNF.1:	MOVEI	S1,FOB.SZ		;FOB SIZE
	MOVEI	S2,FOB			;FOB ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO IT
	MOVEI	S1,FMFD			;GET FD ADDRESS
	STORE	S1,FOB+FOB.FD		;STORE IT
	MOVX	S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN)
					;Byte size and ignore line #'s if any
	MOVEM	S1,FOB+FOB.CW		;Save it
	MOVEI	S1,FOB.SZ		;LOAD THE FOB SIZE
	MOVEI	S2,FOB			;AND THE FOB ADDRESS
	PUSHJ	P,F%IOPN		;AND OPEN THE FILE
	JUMPF	.RETF			;LOSE?
	MOVEM	S1,FMIFN		;SAVE THE IFN
	SETOM	FMOPN			;SET "OPEN"
	$RETT				;AND RETURN

TOPS10 <
FMFD:	XWD	FMFDL,0			;FD SIZE
	SIXBIT	/SYS/			;DEVICE
	SIXBIT	/LPFORM/		;FILE NAME
	SIXBIT	/INI/			;EXTENSION
	EXP	0			;AND PPN WORD
	FMFDL==.-FMFD			;FD SIZE
>  ;END TOPS10 CONDITIONAL

TOPS20 <
FMFD:	XWD	FMFDL,0			;FD SIZE
	ASCIZ	/SYS:LPFORM.INI/	;AND THE STRING
	FMFDL==.-FMFD			;THE FD SIZE
>  ;END TOPS20 CONDITIONAL
SUBTTL	Mount and dismount structures -- Entry point


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

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

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


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

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


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


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

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


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

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

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

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


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

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

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

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

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

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

STRE.2:	ADD	S1,[1,,1]		;ACCOUNT FOR TWO WORD ENTRIES
	AOBJN	S1,STRE.1		;LOOP THROUGH TABLE
	POPJ	P,			;REALLY SICK
	SUBTTL	Interrupt Module

;		INTINI		INITIALIZE INTERRUPT SYSTEM
;		INTON		ENABLE INTERRUPTS
;		INTOFF		DISABLE INTERRUPTS
;		INTCNL		CONNECT THE LINEPRINTER
;		INTDCL		DISCONNECT THE LINEPRINTER
;		INTIPC		INTERRUPT ROUTINE  --  IPCF
;		INTDEV		INTERRUPT ROUTINE  --  LPT OFF-LINE
	SUBTTL	INTERRUPT SYSTEM DATABASE

TOPS10 <

VECTOR:	BLOCK	0			;BEGINNING OF INTERRUPT VECTOR
VECIPC:	BLOCK	4			;IPCF INTERRUPT BLOCK
VECDEV:	BLOCK	4*NPRINT		;DEVICE INTERRUPT BLK
	ENDVEC==.-1			;END OF INTERRUPT VECTOR

>  ;END TOPS10 CONDITIONAL

TOPS20 <

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

CHNTAB:	XWD	1,INTIPC		;IPCF INT - LEVEL 1
	XWD	1,INTDEV		;DEV OFF LINE INT - LEVEL 1
	BLOCK	^D34			;RESTORE OF THE TABLE

LEV1PC:	BLOCK	1			;LVL 1 INTERRUPT PC STORED HERE
LEV2PC:	BLOCK	1			;LVL 2 INTERRUPT PC STORED HERE
LEV3PC:	BLOCK	1			;LVL 3 INTERRUPT PC STORED HERE
>  ;END TOPS20 CONDITIONAL


TOPS10 <
DEFINE LPINHD(Z),<
	XLIST
	$BGINT	1,
	MOVEI	S1,Z
	MOVEI	S2,VECDEV+<4*Z>
	JRST	LPINTR
	LPHDSZ==4
	LIST
>  ;END DEFINE LPINHD
>  ;END TOPS10 CONDITIONAL
TOPS10 <
INTINI:	MOVEI	S1,INTIPC		;GET ADDRESS OF IPCF INT RTN
	MOVEM	S1,VECIPC+.PSVNP	;SAVE IN VECTOR

	ZZ==0
REPEAT	NPRINT,<
	MOVEI	S1,INTDEV+<LPHDSZ*ZZ>	;GET ADDRESS OF LPT HEADER
	MOVEM	S1,VECDEV+<4*ZZ>+.PSVNP	;STORE IN THE VECTOR
	ZZ==ZZ+1
>  ;END REPEAT NPRINT

	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <
INTINI:	MOVX	S1,.FHSLF		;LOAD MY FORK HANDLE
	MOVX	S2,1B0!1B1		;CHANNELS 0 AND 1
	AIC				;ACTIVATE THE CHANNELS
	POPJ	P,			;AND RETURN
>  ;END TOPS20 CONDITIONAL
TOPS10 <

INTDCL:	SKIPA	S1,[PS.FRC+T1]		;REMOVE CONDITION USINGS ARGS IN T1
INTCNL:	MOVX	S1,PS.FAC+T1		;ADD CONDITION USING ARGS IN T1
	SKIPLE	J$LREM(J)		;IS THIS A DN60 LPT ???
	$RETT				;YES,,JUST RETURN
	MOVE	T1,J$LCHN(J)		;USE CHANNEL AS CONDTION
	MOVE	T2,STREAM		;GET STREAM NUMBER
	IMULI	T2,4			;GET BLOCK OFFSET
	ADDI	T2,VECDEV-VECTOR	;GET OFFSET FROM BEGINNING
	HRLZS	T2			;GET OFFSET,,0
	HRRI	T2,PS.RDO+PS.ROD+PS.ROL+PS.RDH ;AND CONDITIONS
	SETZ	T3,			;ZERO T3
	PISYS.	S1,			;TO THE INTERRUPT SYSTEM
	 $RETF				;WE FAILED !!!
	$RETT				;RETURN OK.
>  ;END TOPS10 CONDITIONAL

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


	;INTERRUPT ROUTINES

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

TOPS10 <
	$DEBRK				;DISMISS THE INTERRUPT.
>  ;END TOPS10 CONDITIONAL

TOPS20 <
	SKIPN	J,JOBPAG		;DOES A STREAM EXIST ??
	$DEBRK				;NO,,JUST FINISH UP HERE.
	JRST	INTDON			;FINISH UP -20 INTERRUPT PROCESSING.
>  ;END TOPS20 CONDITIONAL
;Here on device interrupts on the -10.  This routine consists of multiple
;	interrupt headers (one for each stream) which load S1 and S2 and
;	call the main interrupt body, LPINTR.  Note that on the -10, while
;	it is assumed that 'output done' and 'on-line' interrupts can happen
;	anytime and anywhere, it is also assumed that 'device off-line'
;	interrupts ONLY HAPPEN IN THE STREAM CONTEXT.

TOPS10 <
INTDEV:	ZZ==0
	REPEAT NPRINT,<
	LPINHD(ZZ)
	ZZ==ZZ+1 	      >

LPINTR:	MOVE	J,JOBPAG(S1)		;GET THE JOB PARAMETER PAGE
	HRRZ	T1,.PSVFL(S2)		;GET I/O REASON FLAGS
	ANDCAM	T1,.PSVFL(S2)		;AND CLEAR THEM
	SETZ	T2,			;CLEAR AN AC
	TXNE	T1,PS.ROL+PS.RDO	;IS IT DEVICE ONLINE OR OFFLINE ???
	JRST	[SETZM	JOBCHK(S1)	;YES,,SAY WE WANT A CHECKPOINT
		SETOM	JOBUPD(S1)	;  update the status also
		JRST	LPIN.1]		;Go continue
LPIN.1:	TXNE	T1,PS.RDH		;DEVICE HUNG?
	JRST	LPIN.3			;YES
	TXNE	T1,PS.ROL		;IS IT ON-LINE?
	MOVX	T2,PSF%DO+PSF%OB	;YES,,CLEAR ON-LINE & OUTPUT-BLOCKED
	TXNE	T1,PS.ROD		;IS IT OUTPUT DONE?
	TXO	T2,PSF%OB		;YES, GET SCHEDULER BIT
	ANDCAM	T2,JOBSTW(S1)		;CLEAR THE SCHEDULER FLAGS
	TXNN	T1,PS.RDO		;IS IT DEVICE OFF-LINE?
	$DEBRK				;NO,,DISMISS THE INTERRUPT.
	TXNE	T1,PS.ROL		;IF BOTH OFFLINE AND ONLINE,
	$DEBRK				;DISMISS THE INTERRUPT.
	MOVX	T2,PSF%DO		;GET OFF-LINE BIT.
	IORM	T2,JOBSTW(S1)		;   AND SET IT.
	MOVE	T1,.PSVIS(S2)		;GET THE FILE STATUS BITS
	TXC	T1,IO.ERR		;CHECK TO SEE IF ALL ERROR BITS ARE LIT
	TXNN	T1,IO.ERR		;ARE THEY ???
	SKIPL	J$LREM(J)		;YES,,IS THIS A REMOTE LPT ???
	SKIPA				;NOT ALL BITS LIT OR NOT REMOTE,,SKIP
	$DEBRK				;ELSE REMOTE WENT DOWN,,RETURN NOW !!!
	TXCN	T1,IO.ERR		;CPU CROAK OR JUST LPT OFF-LINE?
	JRST	LPIN.2			;DEAD CPU
	MOVEI	T1,OUTWON		;CPU DOWN OR OFFLINE,,LOAD RESTART ADDR
	EXCH	T1,.PSVOP(S2)		;STORE FOR DEBRK AND GET OLD ADRESS
	MOVEM	T1,J$LIOA(J)		;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
	$DEBRK				;DISMISS THE INTERRUPT

LPIN.2:	MOVEI	T1,CPUFAI		;CPU FAILURE
	MOVEM	T1,.PSVOP(S2)		;STORE FOR DEBRK. UUO
	$DEBRK				;DISMISS THE INTERRUPT.

LPIN.3:	SETZM	JOBSTW(J)		;MAKE JOB RUNABLE
	MOVE	T1,J$RACS+P(J)		;GET STREAM STACK
	PUSH	T1,[HNGDEV]		;AVOID RACES
	MOVEM	T1,J$RACS+P(J)		;REPLACE PDL POINTER
	MOVEI	T1,HNGDEV		;GET ADDR OF HUNG DEVICE PROCESSOR
	CAMN	S1,STREAM		;HUNG DEVICE IN STREAM CONTEXT?
	MOVEM	T1,.PSVOP(S2)		;SET RETURN ADDRESS
	$DEBRK				;DISMISS THE INTERRUPT
>  ;END TOPS10 CONDITIONAL
SUBTTL	CPU failure and Hung device code


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

HNGD.1:	MOVNI	S1,2			;LOAD -2
	ADDM	S1,J$RNPP(J)		;INSURE NO LOSSAGE OF DATA
	ADDM	S1,J$APRT(J)		;HERE ALSO
	SKIPGE	J$RNPP(J)		;MAKE SURE WE DIDN'T SCREW THINGS UP
	SETZM	J$RNPP(J)		;YES,,ZERO THE PAGES PER COPY
	SKIPGE	J$APRT(J)		;CHECK HERE ALSO
	SETZM	J$APRT(J)		;NO GOOD,,SET IT TO ZERO

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

	;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 DONT WANT TO JUST DEBRK BACK INTO THE SOUT
	;	(UNLESS WE ARE PROCESSING A REMOTE LPT).
	;	FOR LOCAL LPT'S, 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
	;	LPT'S IF WE ARE I/O ACTIVE. IN THIS CASE WE JUST
	;	RETURN TO THE CALLING ROUTINE (OUTOUT)


TOPS20 <
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.
>  ;END TOPS20 CONDITIONAL
	SUBTTL	TOPS-20 I/O LOCAL/REMOTE SUBROUTINES ($SOUT)

TOPS20 <

$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	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  SOUT.2		;YES,,GO PROCESS IT
		 JRST  SOUT.6 ]		;NO,,MUST BE 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	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  GTJF.2		;YES,,GO PROCESS IT
		 JRST  GTJF.6 ]		;NO,,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	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  OPEN.2		;YES,,GO PROCESS IT
		 JRST  OPEN.6 ]		;NO,,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	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  CLOS.2		;YES,,GO PROCESS IT
		 JRST  CLOS.6 ]		;NO,,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	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  MTOP.2		;YES,,GO PROCESS IT
		 JRST  MTOP.6 ]		;NO,,MUST BE DN60
	MTOPR				;LOCAL,,DO THE MTOPR NORMALLY
	ERJMP	.RETF			;ON AN ERROR,,RETURN NO GOOD
	$RETT				;ELSE RETURN OK

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

$GDSTS:	SKIPE	J$LREM(J)		;IS THIS A REMOTE LPT ???
	JRST	[SKIPG J$LREM(J)	;YES,,IS THIS A DN200 REQUEST ???
		 JRST  GDST.2		;YES,,GO PROCESS IT
		 JRST  .RETT ]		;NO,,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	DN200 I/O SUPPORT ROUTINES

IFN FTRJE,<

SOUT.2:	PUSHJ	P,USOUT##		;OUTPUT THE DATA
	ERJMP	SOUT.F			;ON ERROR,,TAKE FAIL RETURN
	JRST	SOUT.T			;OK,,JUST RETURN

GTJF.2:	PUSHJ	P,UGTJFN##		;MAKE GTJFN CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

OPEN.2:	PUSHJ	P,UOPENF##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

CLOS.2:	PUSHJ	P,UCLOSF##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

MTOP.2:	PUSHJ	P,UMTOPR##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE HE WINS

GDST.2:	MOVE	S1,J$LCHN(J)		;GET THE JFN
	MOVX	S2,.MORST		;GET READ DEVICE FUNCTION
	MOVEI	T1,T2			;AND ADDRESS OF ARGS
	MOVEI	T2,3			;ARG BLOCK LENGTH
	PUSHJ	P,UMTOPR##		;MAKE CALL VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	MOVE	S1,T3			;RETURN STATUS BITS IN S1
	$RETT				;HE WINS
>

IFE FTRJE,<
SOUT.2:
GTJF.2:
OPEN.2:
CLOS.2:
MTOP.2:
GDST.2:
	MOVE	S1,STREAM		;GET OUT STREAM NUMBER
	$WTO	(DN200 Remote not Supported,,@JOBOBA(S1))
	$RETF				;RETURN
>
> ;END TOPS20 CONDITIONAL
	SUBTTL	TOPS10 DN60 SUPPORT ROUTINES

TOPS10 <

$OPEN:	MOVSI	S1,(POINT 8,0)		;GET 8 BIT BYTE POINTER
	MOVEM	S1,J$LBTZ(J)		;SAVE IT FOR LATER
	PJRST	OPEN.6			;OPEN THE DEVICE

$OUT60:	PUSHJ	P,.SAVET		;SAVE THE 'T' ACS
$OUT.1:	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.6		;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
	SKIPLE	J$LIBC(J)		;ANY BYTES LEFT IN THE BUFFER ???
	JRST	$OUT.1			;YES,,GO PUT THEM OUT
	PUSHJ	P,OUTRES		;RESET THE OUTPUT BUFFERS
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	DN60 I 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

; 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

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

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

;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
;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
TOPS10<	$DSCHD	(0)>			;Sleep one way
TOPS20<	SKIPE	S1,SLEEPT		;Get sleep time if any
	$CALL	I%SLP			;Have some, sleep
	SETOM	SLEEPT			;And reset sleep time
> ;End of TOPS20
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	IBMSTS - Routine to 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
SUBTTL	STARS - Job definition/separation line definitions


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


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

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

STARS3:	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/123456789012345678901234567890123456789012345678901234567890/
	ASCII	/1234567890/
LPTEND::END	LPTSPL