Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/galsrc/sprout.mac
There are 33 other files named sprout.mac in the archive. Click here to see a list.
	TITLE	SPROUT	- Spooling PRocessor for OUTput
	SUBTTL	Preliminaries

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


	SEARCH	GLXMAC			;SEARCH GLXLIB SYMBOLS
	PROLOGUE(SPROUT)		;DO STANDARD PROLOG
	SEARCH	QSRMAC			;GET QUASAR SYMBOLS
	SEARCH	ORNMAC			;GET OPERATOR SYMBOLS
;**;[6002]At SEARCH ORNMAC:+1L add 1 line  JCR  1/11/90
	SEARCH	NEBMAC			;[6002]Get NEBULA's symbols
	SUBTTL	Edit vector and Version numbers

SPOVEC:	BLDVEC	(GLXMAC,GMC,L)
	BLDVEC	(ORNMAC,OMC,L)
	BLDVEC	(QSRMAC,QMC,L)
	BLDVEC	(SPROUT,SPO,L)

	SPOMAN==:6002			;Maintenance edit number
	SPODEV==:6001			;Development edit number
	VERSIN (SPO)			;Generate edit number

	SPOWHO==0
	SPOVER==6
	SPOMIN==0

	SPOVRS==<VRSN.(SPO)>+GMCEDT+OMCEDT+QMCEDT

	LOC	137
	EXP	SPOVRS
	RELOC
	Subttl	Table of Contents

;		     Table of Contents for SPROUT
;
;				  Section		      Page
;
;
;    1. Edit vector and Version numbers  . . . . . . . . . . .   2
;    2. Revision history . . . . . . . . . . . . . . . . . . .   5
;    3. Constants (Conditional and Unconditional)  . . . . . .   6
;    4. MACROS . . . . . . . . . . . . . . . . . . . . . . . .   7
;    5. Special Forms Handling Parameters  . . . . . . . . . .   8
;    6. Flag Definitions . . . . . . . . . . . . . . . . . . .  10
;    7. Job Parameter Area . . . . . . . . . . . . . . . . . .  11
;    8. Random Impure Storage  . . . . . . . . . . . . . . . .  14
;    9. Resident JOB DaTABase  . . . . . . . . . . . . . . . .  15
;   10. Non-zero daTABase  . . . . . . . . . . . . . . . . . .  16
;   11. $TEXT Utilities  . . . . . . . . . . . . . . . . . . .  17
;   12. Program Initialization . . . . . . . . . . . . . . . .  18
;   13. Idle Loop  . . . . . . . . . . . . . . . . . . . . . .  19
;   14. Deschedule Process . . . . . . . . . . . . . . . . . .  20
;   15. Do the Job . . . . . . . . . . . . . . . . . . . . . .  21
;   16. Process a File . . . . . . . . . . . . . . . . . . . .  22
;   17. End of Job . . . . . . . . . . . . . . . . . . . . . .  23
;   18. CHKQUE Routine to process IPCF messages  . . . . . . .  24
;   19. CHKOBJ Routine to validate QUASAR/ORION/OPR MSG Object  25
;   20. FNDOBJ Routine to establish STREAM context . . . . . .  26
;   21. GETBLK Routine to return next argument from an OPR/ORI  27
;   22. NEXTJOB Message from QUASAR  . . . . . . . . . . . . .  28
;   23. User CANCEL Request  . . . . . . . . . . . . . . . . .  29
;   24. UPDATE Routine to send status update . . . . . . . . .  30
;   25. CHKPNT Routine to send checkpoint message  . . . . . .  31
;   26. SETUP/SHUTDOWN Message . . . . . . . . . . . . . . . .  32
;   27. Response to setup message  . . . . . . . . . . . . . .  33
;   28. Operator CANCEL command  . . . . . . . . . . . . . . .  34
;   29. Operator STOP command  . . . . . . . . . . . . . . . .  35
;   30. Operator REQUEUE command . . . . . . . . . . . . . . .  36
;   31. CLRMSG and SNDQSR routines . . . . . . . . . . . . . .  37
;   32. Accounting routines  . . . . . . . . . . . . . . . . .  39
;   33. FORMS - Setup Forms for a job  . . . . . . . . . . . .  42
;   34. Forms switch Subroutines . . . . . . . . . . . . . . .  46
;   35. Plotter only switches  . . . . . . . . . . . . . . . .  47
;   36. I/O Subroutines for SPFORM.INI . . . . . . . . . . . .  48
;   37. INPOPN - Routine to open the input file  . . . . . . .  50
;   38. INPBUF - Read a buffer from the input file . . . . . .  51
;   39. OUTGET - OPEN the output device  . . . . . . . . . . .  52
;   40. OUTBYT - Deposit a byte in the output buffer . . . . .  55
;   41. OUTOUT - Routine to output a buffer  . . . . . . . . .  56
;   42. DEVERR - Handle Output Device Errors . . . . . . . . .  57
;   43. OUTREL - Release output device . . . . . . . . . . . .  58
;   44. OUTWON - Wait for on-line  . . . . . . . . . . . . . .  59
;   45. OUTFLS Routine to flush output buffers . . . . . . . .  60
	Subttl	Table of Contents (page 2)

;		     Table of Contents for SPROUT
;
;				  Section		      Page
;
;
;   46. Card punch service
;       46.1    Dispatch table . . . . . . . . . . . . . . . .  61
;       46.2    Checkpoint text generation . . . . . . . . . .  62
;       46.3    File processing  . . . . . . . . . . . . . . .  63
;       46.4    File headers . . . . . . . . . . . . . . . . .  69
;       46.5    File trailers  . . . . . . . . . . . . . . . .  70
;       46.6    Banners  . . . . . . . . . . . . . . . . . . .  71
;       46.7    Word punching  . . . . . . . . . . . . . . . .  72
;       46.8    Letters  . . . . . . . . . . . . . . . . . . .  73
;       46.9    Byte output  . . . . . . . . . . . . . . . . .  74
;   47. Plotter service
;       47.1    Dispatch table . . . . . . . . . . . . . . . .  75
;       47.2    Checkpoint text generation . . . . . . . . . .  76
;       47.3    File processing  . . . . . . . . . . . . . . .  77
;       47.4    Devout output errors . . . . . . . . . . . . .  79
;       47.5    Banners  . . . . . . . . . . . . . . . . . . .  80
;       47.6    File headers . . . . . . . . . . . . . . . . .  81
;       47.7    File trailers  . . . . . . . . . . . . . . . .  82
;       47.8    Job trailers . . . . . . . . . . . . . . . . .  83
;       47.9    Solid lines  . . . . . . . . . . . . . . . . .  84
;       47.10   Dashed lines . . . . . . . . . . . . . . . . .  85
;       47.11   Job information plotting . . . . . . . . . . .  86
;       47.12   Alignment and testing  . . . . . . . . . . . .  87
;       47.13   Pen calibration  . . . . . . . . . . . . . . .  88
;       47.14   Compute chracter size  . . . . . . . . . . . .  89
;       47.15   Letters  . . . . . . . . . . . . . . . . . . .  90
;       47.16   Line segments  . . . . . . . . . . . . . . . .  91
;       47.17   Rotation and XY20 translation  . . . . . . . .  93
;       47.18   Pen movement generation  . . . . . . . . . . .  94
;       47.19   Character set  . . . . . . . . . . . . . . . .  96
;   48. Paper tape punch service
;       48.1    Dispatch table . . . . . . . . . . . . . . . . 101
;       48.2    Checkpoint text generation . . . . . . . . . . 102
;       48.3    File processing  . . . . . . . . . . . . . . . 103
;       48.4    Banners  . . . . . . . . . . . . . . . . . . . 108
;       48.5    File headers . . . . . . . . . . . . . . . . . 109
;       48.6    File trailers  . . . . . . . . . . . . . . . . 110
;       48.7    Trailers . . . . . . . . . . . . . . . . . . . 111
;       48.8    Blank folds  . . . . . . . . . . . . . . . . . 112
;       48.9    Letters  . . . . . . . . . . . . . . . . . . . 113
;       48.10   Byte output  . . . . . . . . . . . . . . . . . 114
;   49. Character Bit Array for 5 X 7 Character Matrix . . . . 115
;   50. Common Utilities . . . . . . . . . . . . . . . . . . . 117
;   51. Interrupt Module . . . . . . . . . . . . . . . . . . . 119
;   52. IPCF and DEVICE Interrupt service for TOPS10 . . . . . 123
;   53. IPCF and DEVICE interrupt service for TOPS20 . . . . . 124
SUBTTL	Revision history

COMMENT \

2533	4.2.1528	9-Nov-82
	Fix copyright.

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

2535	4.2.1566	12-Jan-84
	Move 2 lines from ENDJOB+8 to ENDJOB+10.

2536	4.2.1567	16-Jan-84
	Send error messages to OPR on file input error and
	file inaccessibility.

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

2550	5.1003		30-Dec-82
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

2551	5.1046		21-Oct-83
	Change version number from 4 to 5.

2552	5.1202		13-Feb-85
	Fix bug in FILD.1. The /DELETE switch was improperly processed,
when the job was cancelled, the file was deleted.
*****	Release 5.0 -- begin maintenance edits	*****

2560	Increment maintenance edit level for version 5 of GALAXY.

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

6000	6.1037		26-Oct-87
	Move sources from G5: to G6:

6001	6.1225		8-Mar-88
	Update copyright notice.

*****	Release 6.0 -- begin maintenance edits	*****

6002	6.1299		11-Jan-90
	Add support for remote IPCF processing.

\   ;End of Revision History
SUBTTL	Constants  (Conditional and Unconditional)

;ACCUMULATORS
	M==12				;MESSAGE ADDRESS
	S==13				;STATUS FLAGS
	J==14				;BASE ADDRESS OF CONTEXT DATA
	C==15				;I/O CHARACTER
	E==16				;POINTER TO CURRENT FP

;SYSTEM DEPENDENT PARAMETERS

	DEFINE	FACT,<IFN FTFACT>
	SYSPRM	PTPBSZ,^D36,^D8		;OUTPUT BYTESIZE FOR PTP

;RANDOM CONSTANTS
	ND	PDSIZE,100		;SIZE OF PUSHDOWN LIST
	ND	FACTSW,-1		;-1 TO INCLUDE ACCOUNTING
	ND	NSTRMS,5		;NUMBER OF STREAMS
	ND	ACCTSW,1		;TURN ACCOUNTING ON/OFF
	ND	TXT$LN,^D50		;LENGTH OF JOB TEXT BUFFER
	ND	ERR$LN,^D20		;LENGTH OF JOB ERROR TEXT BUFFER
	ND	NBFRS,2			;NUMBER OF BUFFERS TO CREATE
	ND	NJBPGS,3		;NUMBER OF JOB PAGES TO CREATE

	ND	CKPTIM,^D120		;# of seconds between chkpnts
	XP	MSBSIZ,50		;SIZE OF A MESSAGE BLOCK

;CHECKPOINT BLOCK OFFSETS
	XP	CKFIL,0			;NUMBER OF FILES COMPLETED
	XP	CKCOP,1			;NUMBER OF COPIES COMPLETED
	XP	CKPAG,2			;NUMBER OF UNITS OF LAST COPY
	XP	CKTPP,3			;NUMBER OF TOTAL UNITS processed
	XP	CKFLG,4			;CHECKPOINT FLAGS
	  XP	CKFREQ,1B0		;REQUED BY OPERATOR
	  XP	CKFCHK,1B1		;JOB WAS CHECKPOINTED


;DEVICE DISPATCH TABLE OFFSETS
	XP	DHEAD,0			;ADDRESS OF FILE HEADER ROUTINE
	XP	DTAIL,1			;ADDRESS OF FILE TRAILER (EOF) ROUTINE
	XP	DNAME,2			;DEVICE GENERIC NAME IN 6BIT
	XP	DBYTE,3			;OUTPUT BYTE SIZE
	XP	DPROC,4			;ADDRESS OF FILE processing ROUTINE
	XP	DBANN,5			;ADDRESS OF JOB BANNER ROUTINE
	XP	DEOJ,6			;ADDRESS OF JOB TRAILER (EOJ) ROUTINE
	XP	DLETR,7			;ADDRESS OF CHARACTER processing ROUTINE
	XP	DERR,10			;ADDRESS OF ERROR HANDLER
	XP	DACCT,11		;ADDRESS OF END ACCOUTING ROUTINE
	XP	DCHKP,12		;ADDRESS OF CHECKPOINT TEXT ROUTINE

	CONT.	(Constants)		;FORCE NEW LISTING PAGE

; Card punch constants
;
	XP	CPC,^D80		;CHARACTERS PER CARD


; Plotter constants
;
	XP	PNUP,40			;RAISE PEN
	XP	PNDN,20			;LOWER PEN
	XP	PEN2,14			;SELECT PEN 2
	XP	PEN3,03			;SELECT PEN 3
	XP	CNGP,17			;CHANGE PENS
	XP	XYU,10			;-X   MOVE UP
	XP	XYD,4			;+X   MOVE DOWN
	XP	XYL,2			;+Y   MOVE LEFT
	XP	XYR,1			;-Y   MOVE RIGHT
	XP	XYUL,XYL!XYU		;-X+Y MOVE UP+LEFT
	XP	XYDL,XYL!XYD		;+X+Y MOVE DOWN+LEFT
	XP	XYUR,XYR!XYU		;-X-Y MOVE UP+RIGHT
	XP	XYDR,XYR!XYD		;+X-Y MOVE DOWN+RIGHT
	XP	PLTPEN,^D9		;# TICS FOR PLOT PEN UP/DOWN
	XP	PLTMOV,1		;# TICS FOR PEN MOVEMENT
	XP	CHRPLN,^D90		;# CHARACTERS PER LINE MAXIMUM


; Paper tape punch constants
;
	XP	CHPFLD,^D85		;CHARACTERS PER FOLD OF PTP
	XP	FRMPFT,^D120		;FRAMES PER FOOT OF TAPE
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
	IFL 2000-J...X,<PRINTX ?PARAMETER AREA LONGER THAN A PAGE>
		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:

;FOR ALL DEVICES

;	BANNER:NN	NUMBER OF JOB HEADERS
;	TRAILER:NN	NUMBER OF JOB TRAILERS
;	HEADER:NN	NUMBER OF FILE HEADERS (PICTURE PAGES)
;	NOTE:AA		TYPE NOTE TO THE OPERATOR


;FOR PLOTTER ONLY

;	SPU:NN		STEPS PER UNIT (FACTOR OF ALL XX AND YY)
;	SIZE:XX:YY	NUMBER OF STEPS IN X AND Y AXIS
;	MAXIMUM:XX:YY	STEP FOR FORMS LIMIT IN X AND Y AXIS
;	MINIMUM:XX:YY	STEP FOR FROMS LIMIT IN X AND Y AXIS

;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
;	XX	INTEGER STEP NUMBER IN X AXIS
;	YY	INTEGER STEP NUMBER IN Y AXIS



;LOCATION SPECIFIERS
;	ALL		ALL DEVICES
;	CENTRAL		ALL DEVICES AT THE CENTRAL SITE
;	REMOTE		ALL REMOTE DEVICES

;NOTE:  SPROUT WILL USE THE FIRST ENTRY WHICH MEETS THE LOCATION
;	SPECIFICATION FOR ITS DEVICE.

;	SPROUT ACCEPTS FORMS SPECIFICATIONS FOR ALL THREE DEVICES
;	ALTHOUGH SOME SWITCHES ARE LEGAL ONLY FOR PLOTTERS

;TYPICAL SPFORM.INI FORMS SPECIFICATION

;	CDP NORMAL/BANNER:6/HEADER:1/TRAILER:6-
;	/NOTE:Load NORMAL Cards in Card Punch
;
;	PLT NORMAL/BANNER:200/HEADER:200/TRAILER:200-
;	/MINIMUM:0:0/MAXIMUM:0:5900-
;	/NOTE:Set Plotter Controls to 200 Steps per inch
DEFINE SWITCHES,<
	FF	BANNER
	FF	TRAILER
	FF	HEADER
	FF	NOTE
	FF	SPS
	FF	SPU
	FF	MINIMUM
	FF	MAXIMUM
>


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

FFNAMS:	SWITCHES
	F$NSW==.-FFNAMS			;NUMBER OF SWITCHES
SUBTTL	Flag Definitions

	DSKOPN==1B2			;DISK DATA READ GOING ON
	RQB==1B3			;JOB HAS BEEN REQUED
	ABORT==1B5			;THE SHIP IS SINKING
	SKPFIL==1B8			;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
	GOODBY==1B9			;IN JOB TERMINATION SEQUENCE
	NOSTRM==1B10			;NOT IN STREAM CONTEXT
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$RNFP,1,Z		;NUMBER OF FILES processed
	LP	J$RNCP,1,Z		;NUMBER OF COPIES OF CURRENT FILE
	LP	J$RNPP,1,Z		;NUMBER OF PAGES IN CURRNET FILE
	LP	J$RACS,20		;CONTEXT ACS
	LP	J$RPDL,PDSIZE		;CONTEXT PUSHDOWN LIST

;DEV PARAMETERS
	LP	J$LBUF,1		;ADDRESS OF DEV BUFFER
	LP	J$LBRH,1		;BUFFER RING HEADER
	LP	J$LBPT,1		;BUFFER BYTE POINTER
	LP	J$LBCT,1		;BUFFER BYTE COUNT
	LP	J$TBCT,1		;TOTAL BYTE COUNT FOR DEVICE
	LP	J$LIOA,1		;-1 IF WE ARE IN A SOUT OR OUT
	LP	J$LREM,1		;-1 IF WE ARE A REMOTE DEVICE
	LP	J$LSER,1		;ADDRESS OF DEVICE SERVICE DISPATCH


TOPS10 <
	LP	J$LJFN,1		;DEV I/O CHANNEL (OR JFN)
	LP	J$LDEV,1		;DEVICE NAME (SIXBIT)
	LP	J$LIOS,2		;DEVICE STATUS
	LP	J$LIOE,1		;-1 IF DEVICE ERROR
> ;END TOPS10 CONDITIONAL

TOPS20 <
	LP	J$LJFN,1		;JFN FOR THE DEV
	LP	J$LDEV,2		;DEVICE NAME STRING
	LP	J$LIOS,2		;DEVICE STATUS
	LP	J$LIOE,1		;-1 IF DEVICE ERROR
	LP	J$LIBP,1		;INITIAL BYTE POINTER
	LP	J$LIBC,1		;INITIAL BYTE COUNT FOR BUFFERS
>  ;END TOPS20 CONDITIONAL

;CURRENT FORMS PARAMETERS
	LP	J$FIFN,1		;TEMPORARY IFN FOR FORM FILE
	LP	J$FORM,1		;CURRENT FORMS TYPE
	LP	J$FPFM,1		;PREVIOUS FORMS TYPE
	LP	J$FPLT,1		;FORMS TYPE FOR PLOTTER

;STORAGE FOR CURRENT FORMS SWITCHS

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

	LP	J$FCUR,0		;ORIGIN OF CURRENT SWITCH VALUES
	SWITCHES			;ONE ENTRY PER SWITCH


;MISCELLANY
	LP	J$XFOB,FOB.SZ		;A FILE OPEN BLOCK
	LP	J$XTBF,TXT$LN,Z		;$TEXT BUFFER FOR OUTPUT DEVICE
	LP	J$XERR,ERR$LN,Z		;$TEXT BUFFER FOR ERROR MESSAGES

;CARD PUNCH VARIABLES
	LP	J$XCD1,1		;1 SCRATCH LOCATION FOR CDP OUTPUT
	LP	J$CMSK,1		;SPECIAL MASK FOR BLOCK CARD LETTERS
	LP	J$XCHB,40		;CHECKSUM BLOCK
;PLOTTER VARIABLES

	LP	J$PAUS,1		;PAUSE FOR EVERY FORM
	LP	J$XPOS,1		;CURRENT PLOTTER X COORDINATE
	LP	J$XORG,1		;ORIGINAL X MINIMUM
	LP	J$XLIM,1,Z		;HIGHEST XSTEP SEEN THIS PLOT
	LP	J$XMIN,1		;X MINIMUM POINT IN FORM
	LP	J$XMAX,1		;X MAXIMUM POINT IN FORM
	LP	J$YPOS,1		;CURRENT PLOTTER Y COORDINATE
	LP	J$YLIM,1		;HIGHEST YSTEP SEEN THIS PLOT
	LP	J$YMIN,1		;MINIMUM Y POINT IN FORM
	LP	J$YMAX,1		;MAXIMUM ALLOWABLE Y COORDINATE
	LP	J$ROTA,1		;GRID ROTATION (0-3)
	LP	J$PPOS,1		;PEN POSITION (UP 0  DOWN -1)
	LP	J$CSIZ,1		;CHARACTER SIZE
	LP	J$XBAS,1		;CHARACTER X BASE
	LP	J$YBAS,1		;CHARACTER Y BASE
	LP	J$FUDG,1		;CHARACTER WIDTH FUDG
	LP	J$SPTR,1		;POINTER TO CHARACTER SEGMENT BYTES
	LP	J$STEP,1		;STEP FUNCTION DETERMINES MOVEMENT

; Paper tape punch variables
;
	LP	J$TFRM,1,Z		;FRAMES OF TAPE PUNCHED

;ACCOUNTING BLOCK

	LP	J$PTPM,1		;PLOTTER TICS PER MINUTE
	LP	J$PTIC,1,Z		;ACCOUNTING FOR PLOTTER
	LP	J$APRT,1,Z		;NUMBER OF PAGES processed
	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 processed (FILES*COPIES)
	LP	J$ADSP,1,Z		;DISPOSITION (SIXBIT)
	LP	J$AQUE,1,Z		;QUEUE NAME (SIXBIT)
;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		;BUFFER BYTE COUNT
	LP	J$DBSZ,1		;INPUT BYTE SIZE
	LP	J$DMOD,1		;I/O MODE OF DISK FILE
	LP	J$DSPN,1		;SPOOLED FILE NAME IF ANY
	LP	J$DSPX,1		;SPOOLED FILE EXTENTION
;**;[6002]At LP J$DSPX,1 add 6 lines  JCR  1/11/90
;[6002]Remote IPCF message

	LP	J$RPID,1,Z		;[6002]Remote operator PID
	LP	J$RNOD,1,Z		;[6002]Remote operator node name
	LP	J$NULA,1,Z		;[6002]Need to reply to NEBULA
	LP	J$NEBF,1,Z		;[6002]Response msg originated remotely

	LP	J$$END,1		;END OF PARAMETER AREA
		J$$LEN==J$$END		;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 <^D512+^D35>/^D36,<
	XLIST
	ZTAB(\ZZ)
	ZZ==ZZ+1
	LIST
>  ;END REPEAT
SUBTTL	Random Impure Storage

PDL:	BLOCK	PDSIZE			;PUSHDOWN LIST

LOWBEG:					;BEGINNING OF AREA TO CLEAR ON STARTUP
L.JOB:	BLOCK	1			;SPROUT job number
L.TTY:	BLOCK	1			;SPROUT node,,line
L.LIN:	BLOCK	1			;SPROUT line number
L.CON:	BLOCK	1			;SPROUT conntect time in seconds

MESSAG:	BLOCK	1			;ADDRESS OF RECEIVED MESSAGE
BLKADR:	BLOCK	1			;ADDRESS OF CURRENT ARG IN MESSAGE
MSGBLK:	BLOCK	MSBSIZ			;BLOCK FOR BUILDING MESSAGES
TEXTBP:	BLOCK	1			;BYTE POINTER FOR $TEXT ROUTINES
TEXTBC:	BLOCK	1			;BYTE COUNT OF CURRENT TEXT BUFFER
SAB:	BLOCK	SAB.SZ			;SEND ARGUMENT BLOCK

ACTFLG:	BLOCK	1			;-1 IF WE ARE DOING ACCOUNTING
ACTRNN:	BLOCK	1			;OLD SPOOLER RUNTIME
ACTPAG:	BLOCK	1			;OLD STREAM PAGE BLOCK ADDRESS
CNTSTA:	BLOCK	1			;CENTRAL STATION IDENTIFIER
TOPS20 <
FILNAM:	BLOCK	10			;ROOM FOR A TOPS-20 FILENAME
> ;END TOPS20 CONDITIONAL
;**;[6002]At FILNAM:+2L add 4 lines  JCR  1/11/90
G$NEBF:	BLOCK	1			;[6002]Remote message flag
G$REMN:	BLOCK	1			;[6002]Remote node where msg originated
G$NULA:	BLOCK	1			;[6002]Null ACK indicator
JOBARG:	BLOCK	1			;[6002]IPCF message argument number
SUBTTL	Resident JOB DaTABase

STREAM:	BLOCK	1			;(LH) -1 WHILE IN STREAM CONTEXT
					;      0 WHILE IN SCHED CONTEXT
					;(RH) CURRENT STREAM NUMBER

JOBPAG:	BLOCK	NSTRMS			;ADDRESS OF A THREE PAGE BLOCK
					; ONE FOR REQUEST, ONE FOR JOB PARAMS, ONE FOR BUFFER

JOBOBA:	BLOCK	NSTRMS			;TABLE OF OBJECT BLOCK ADDRESSES

JOBSTW:	BLOCK	NSTRMS			;JOB STATUS WORD

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

JOBOBJ:	BLOCK	3*NSTRMS		;LIST OF SETUP OBJECTS

JOBWAC:	BLOCK	NSTRMS			;WTOR ACK CODE (TIME SETUP WAS RECIEVED)

JOBCHK:	BLOCK	NSTRMS			;Stream checkpoint indicator
					;Contains the time for the next chkpnt
					;  or 0 if one is requested

	LOWEND==.-1

TOPS10 <

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

>  ;END TOPS10 CONDITIONAL

TOPS20 <

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

;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%NP==1B5			;GO TO NEXT PROCESS

DEFINE $DSCHD(FLAGS),<
	$CALL	DSCHD
	XLIST
	JUMP	[EXP FLAGS]
	LIST
	SALL
>  ;END DEFINE $DSCHD
SUBTTL	Non-zero daTABase

	TOPS10	<INTVEC==VECTOR>

	TOPS20	<INTVEC==LEVTAB,,CHNTAB>

IB:	$BUILD	IB.SZ
	  $SET	(IB.PRG,,%%.MOD)	;PROGRAM NAME IS SPROUT
	  $SET	(IB.PIB,,PIB)		;SET UP PIB ADDRESS
	  $SET	(IB.INT,,INTVEC)	;POINT TO INTERRUPT VECTOR
	  $SET	(IB.FLG,IP.STP,1)	;STOP CODES 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)	; CHANNEL 0
	  $SET	(PB.SYS,IP.BQT,-1)	;MAX IPCF QUOTAS
	$EOB

HELLO:	$BUILD	HEL.SZ
	  $SET(.MSTYP,MS.TYP,.QOHEL)	;MESSAGE TYPE
	  $SET(.MSTYP,MS.CNT,HEL.SZ)	;MESSAGE LENGTH
	  $SET(HEL.NM,,<'SPROUT'>)	;PROGRAM NAME
	  $SET(HEL.FL,HEFVER,%%.QSR)	;QUASAR VERSION
	  $SET(HEL.NO,HENNOT,3)		;NUMBER OF OBJ TYPES
	  $SET(HEL.NO,HENMAX,NSTRMS)	;MAX NUMBER OF JOBS
	  $SET(HEL.OB,,.OTPTP)		;PAPERTAPE PUNCH
	  $SET(HEL.OB+1,,.OTCDP)	;CARD PUNCH
	  $SET(HEL.OB+2,,.OTPLT)	;PLOTTER
	$EOB

FRMFOB:	$BUILD	FOB.SZ			;FILE OPEN BLOCK FOR SPFORM.INI
	  $SET	(FOB.FD,,FRMFD)		;POINT TO FILE DESCRIPTOR
	  $SET	(FOB.CW,FB.BSZ,7)	;SET FILE BYTE SIZE TO 7
	  $SET	(FOB.CW,FB.LSN,1)	;AND STRIP LINE SEQUENCE NUMBERS
	$EOB

TOPS10 <

FRMFD:	XWD	FFD$LN,0		;FILE DESCRIPTOR LENGTH
	SIXBIT	/SYS/			;DEVICE
	SIXBIT	/SPFORM/		;FILENAME
	SIXBIT	/INI/			;EXTENSION
	EXP	0			;PPN
	FFD$LN==.-FRMFD			;COMPUTE FD LENGTH
> ;END TOPS10 CONDITIONAL

TOPS20 <

FRMFD:	XWD	FFD$LN,0		;FILE DESCRIPTOR LENGTH
	ASCIZ	/SYS:SPFORM.INI/
	FFD$LN==.-FRMFD			;COMPUTE FD LENGTH
> ;END TOPS20 CONDITIONAL
SUBTTL	$TEXT Utilities


;HERE ARE SOME TEXT-OUTPUT-ROUTINES
DEP6BP:	SUBI	S1," "			;CONVERT TO ASCII
DEPBP:	SOSL	TEXTBC			;CHECK BYTE COUNT
	IBP	TEXTBP			;OK -- INCR POINTER
	DPB	S1,TEXTBP		;STORE BYTE
	$RETT				;AND RETURN
SUBTTL	Program Initialization

SPROUT:	JFCL				;NO CCL ENTRY
	RESET				;CLEAR ALL ACTIVE I/O
	MOVE	P,[IOWD PDSIZE,PDL]

	MOVEI	S1,IB.SZ		;GET SIZE OF IB
	MOVEI	S2,IB			;GET ADDR OF IB
	$CALL	I%INIT			;START UP THE WORLD
	MOVEI	S1,<LOWEND-LOWBEG>+1	;LOAD LENGTH OF RESIDENT IMPURE DATA
	MOVEI	S2,LOWBEG		;AND ITS ADDRESS
	$CALL	.ZCHNK			;AND ZERO IT OUT
	$CALL	INTINI			;INITIALIZE THE INTERRUPT SYSTEM
IFN ACCTSW,<
	SETOM	ACTFLG			;UNLESS HE DOESN'T WANT IT
	PUSHJ	P,ACTINI		;SET UP ACCOUNTING DATA
>  ;END IFE ACCTSW
TOPS20 <
	HRRZI	S1,.MSIIC		;BYPASS MOUNTS
	MSTR
	 ERJMP	.+1
> ;END TOPS20 CONDITIONAL

	$CALL	I%ION			;TURN ON INTERRUPTS
	MOVEI	T1,HELLO		;GET HELLO MESSAGE
	$CALL	SNDQSR			;SEND IT

TOPS10<	MOVSI	S1,.STSPL		;PULL A SETUUO TO 
	SETUUO	S1,			;    CLEAR ANY SPOOLING BITS
	   JFCL				;IGNORE THE ERROR
>
	$CALL	I%HOST			;GET LOCAL HOST STUFF
TOPS10 <MOVEM	T2,CNTSTA>		;SAVE NUMBER AS CENTRAL STATION
TOPS20 <MOVEM	T1,CNTSTA>		;SAVE NAME AS CENTRAL STATION

	JRST	MAIN			;AND GO!!!!
SUBTTL	Idle Loop


MAIN:	MOVE	P,[IOWD PDSIZE,PDL]	;SETUP A NEW PDL
	HRROS	STREAM			;SET SCHEDULER CONTEXT
	$CALL	CHKQUE			;PROCESS MESSAGES

	MOVX	P2,PSF%NP		;GET NEXT PASS FLAG
MAIN.1:	MOVSI	P1,-NSTRMS		;SET UP DISPATCH AC

MAIN.2:	SKIPN	JOBACT(P1)		;IS THIS STREAM ACTIVE ???
	JRST	MAIN.3			;NO,,GET THE NEXT STREAM.
	HRROM	P1,STREAM		;YES -- SAVE NUMBER (IN SCHED CONTEXT)
	MOVE	J,JOBPAG(P1)		;GET ADDRESS OF JOB PAGES
	PUSHJ	P,CHKPNT		;CHECKPOINT JOB IF NECESSARY
	SKIPN	JOBSTW(P1)		;IS THE STREAM BLOCKED ???
	JRST	MAIN.4			;NO -- SETUP STREAM CONTEXT
MAIN.3:	ANDCAM	P2,JOBSTW(P1)		;CLEAR NEXT PASS BIT
	AOBJN	P1,MAIN.2		;TRY NEXT STREAM
	TXZE	P2,PSF%NP		;ON SECOND PASS?
	 JRST	MAIN.1			;NOT YET..TRY AGAIN

;HERE IF NO STREAM IS RUNNABLE

	MOVEI	S1,0			;SNOOZE FOR INTERRUPT
	$CALL	I%SLP			;GO WAIT
	$CALL	CHKQUE			;PROCESS MESSAGES
	JRST	MAIN.1			;AND TRY AGAIN

MAIN.4:	CAME	J,ACTPAG		;SAME STREAM?
	$CALL	ACTRNT			;NO..INIT RUNTIME VALUES
	MOVEM	J,ACTPAG		;SAVE THIS AS ACCOUNTING PAGE
	HRLZI	0,J$RACS+1(J)		;SET UP STREAM CONTEXT BLT
	HRRI	0,1			;START WITH AC 1
	BLT	0,17			;RESTORE THE ACS
	HRRZS	STREAM			;SET STREAM CONTEXT
	POPJ	P,			;AND RESTORE STREAM PC

;NOTE:	Stream is now active and will return via DSCHD (see next page)
SUBTTL	Deschedule Process

;DSCHD is called by the $DSCHD macro to cause the "current" stream to
;	be un-scheduled.  The call is:
;
;	$DSCHD(flags)
;
;which generates:
;
;	PUSHJ   P,DSCHD
;	JUMP    [EXP flags]

DSCHD:	HRROS	STREAM			;SET SCHED CONTEXT
	MOVEM	0,J$RACS(J)		;SAVE AC 0
	MOVEI	0,J$RACS+1(J)		;PLACE TO PUT AC 1
	HRLI	0,1			;SETUP THE BLT POINTER
	BLT	0,J$RACS+17(J)		;SAVE STREAM ACS
	HRRZ	S1,0(P)			;GET ADDRESS OF "JUMP [FLAGS]"
	MOVE	S1,@0(S1)		;GET THE FLAGS
	HRRZ	S2,STREAM		;GET STREAM NUMBER
	IORM	S1,JOBSTW(S2)		;SET THE FLAGS
	JRST	MAIN			;AND GO LOOP
SUBTTL	Do the Job

DOJOB:	$CALL	FORMS			;GET FORMS MOUNTED
	MOVE	S1,J$LSER(J)		;GET DEVICE DISPATCH TABLE
	PUSHJ	P,DBANN(S1)		;AND DO A BANNER IF NECESSARY
	LOAD	E,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	E,J			;POINT TO FIRST FILE
	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
	PUSH	P,T1			;ELSE, SAVE T1
	$CALL	NXTFIL			;BUMP E TO NEXT SPEC
	POP	P,T1			;RESTORE T1
	JUMPF	ENDJOB			;FINISH OFF IF DONE
	JRST	DOJO.1			;LOOP SOME MORE

DOJO.2:	MOVE	T1,.EQCHK+CKCOP(J)	;GET NUMBER OF COPIES processed
	MOVEM	T1,J$RNCP(J)		;SAVE FOR NEXT CHECKPOINT

DOJO.4:	MOVE	S1,STREAM		;Get the stream number
	SETZM	JOBCHK(S1)		;Ask for a checkpoint
	PUSHJ	P,CHKPNT		;CHECKPOINT JOB
	$CALL	FILE			;NO, Process THE FILE
	TXNE	S,RQB+ABORT		;HAVE WE BEEN REQUEUED OR WORSE?
	JRST	ENDJOB			;YES, END NOW!!
	$CALL	NXTFIL			;BUMP TO NEXT FILE
	JUMPT	DOJO.4			;AND LOOP
	JRST	ENDJOB			;AND FINISH UP

NXTFIL:	SETZM	J$RNCP(J)		;CLEAR COPIES processed
	SOSG	J$RFLN(J)		;DECREMENT FILE COUNT
	$RETF				;NO MORE, DONE
	LOAD	T1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	E,T1			;BUMP TO THE FD
	LOAD	T1,.FDLEN(E),FD.LEN	;GET THE FD LENGTH
	ADD	E,T1			;BUMP TO THE NEXT FP
	AOS	J$RNFP(J)		;ONE MORE FILE DOWN
	$RETT				;AND RETURN
SUBTTL	Process a File

FILE:	TXNE	S,ABORT			;HAS JOB BEEN ABORTED?
	$RETT				;YES..JUST RETURN AND CLEAN UP
	$CALL	INPOPN			;NO..OPEN THE FILE
	JUMPF	.POPJ			;RETURN IF NO FILE

FILE.1:	$CALL	INPREW			;REWIND THE INPUT FILE
	MOVE	S1,J$LSER(J)		;GET DISPATCH ADDRESS
	PUSHJ	P,DHEAD(S1)		;AND DO HEADER
	MOVE	S1,J$LSER(J)		;GET DISPATCH ADDRESS
	PUSHJ	P,DPROC(S1)		;AND PROCESS THE FILE
	MOVE	S1,J$LSER(J)		;GET ADDRESS OF DEVICE DISPATCH
	PUSHJ	P,DTAIL(S1)		;AND DO A  FILE TRAILER
	TXNE	S,ABORT!SKPFIL!RQB	;ABORTED OR SKIPPED OR REQUEUED?
	JRST	FILE.2			;YES, CONTINUE ON
	AOS	S1,J$RNCP(J)		;INCREMENT AND LOAD COPIES WORD
	LOAD	S2,.FPINF(E),FP.FCY	;GET TOTAL NUMBER TO Process
	CAMGE	S1,S2			;processed ENOUGH?
	JRST	FILE.1			;NO LOOP


FILE.2:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	TXZE	S,DSKOPN		;CLEAR AND CHECK FILE OPEN BIT
	$CALL	F%REL			;CLOSE AND RELEASE
	POPJ	P,			;AND RETURN
SUBTTL	End of Job

ENDJOB:	TXO	S,GOODBY		;FLAG EOJ SEQUENCE
	MOVE	S1,J$LSER(J)		;GET DEVICE DISPATCH TABLE
	$CALL	DEOJ(S1)		;DO A TRAILER IF NECESSARY

TOPS10 <
	$CALL	OUTWAT			;OUTPUT AND WAIT UNTIL DONE
> ;;END TOPS10
TOPS20 <
	$CALL	OUTOUT			;FORCE EVERYTHING OUT
> ;;END TOPS20

;**;[6002]At ENDJOB:+11L replace 1 line with 3 lines  JCR  1/11/90
	$CALL	SETREM			;[6002]Set up remote origin parameters
	HRRZ	S1,STREAM		;[6002]Point to the current stream
	$QWTOJ	(End,^R/.EQJBB(J)/,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
	$CALL	QRELEASE		;RELEASE THE JOB
	$CALL	ACTEND			;DO FINAL ACCOUNTING
TOPS20 <
	PUSHJ	P,OUTOUT		;FORCE OUTPUT
> ;;END TOPS20
	HRRZ	S1,STREAM		;GET STREAM NUMBER
	SETZM	JOBACT(S1)		;NOT BUSY
	JRST	MAIN			;AND LOOP TO THE BEGINNING

QRELEA:	TXNE	S,RQB			;REQUEUEING?
	JRST	QREQUE			;YES..GO REQUE IT
	$CALL	FILDIS			;DISPOSE OF SPOOLED FILES
	MOVX	S1,REL.SZ		;NO..RELEASE IT
	MOVX	S2,.QOREL
	$CALL	CLRMSG			;INIT MESSAGE
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REL.IT(T1)		;STORE IT
	PJRST	SNDQSR			;SEND IT OFF AND RETURN

QREQUE:	MOVX	S1,REQ.SZ		;GET REQUE MESSAGE SIZE
	MOVX	S2,.QOREQ		;AND REQUE FUNCTION
	$CALL	CLRMSG			;INIT MESSAGE
	LOAD	S1,.EQITN(J)		;GET THE ITN
	STORE	S1,REQ.IT(T1)		;STORE IT
	LOAD	S1,J$RNFP(J)		;GET NUMBER OF FILES processed
	STORE	S1,REQ.IN+CKFIL(T1)	;STORE IT
	LOAD	S1,J$RNCP(J)		;GET COPIES processed
	STORE	S1,REQ.IN+CKCOP(T1)	;STORE IT
	MOVX	S1,RQ.HBO		;GET HOLD BY OPERATOR
	STORE	S1,REQ.FL(T1)		;STORE IN FLAG WORD
	PJRST	SNDQSR			;SEND THE MESSAGE TO QUASAR

SUBTTL	FILDIS	Routine to KEEP/DELETE requested 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:	LOAD	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.
	MOVE	T3,E			;PUT FD ADDRESS INTO T3 (FOB).
	LOAD	S2,.FPLEN(E),FD.LEN	;GET THE FD LENGTH.
	ADD	E,S2			;POINT TO NEXT FILE.
	DMOVE	S1,[EXP 1,T3]		;GET F%DEL PARMS.
;**;[2552]Replace 1 line with 3 lines at FILD.1:+7L  JCR  2/14/85
	TXNN	T2,ABORT		;[2552]Abort set?
	TXNN	T2,FP.DEL		;[2552]No, /DELETE?
	TXNE	T2,FP.SPL		;[2552]SPOOL file?
	PUSHJ	P,F%DEL			;YES,,DELETE THE FILE
	SOJG	T1,FILD.1		;GO PROCESS THE NEXT FILE.
	$RETT				;RETURN.
SUBTTL	CHKQUE	Routine to process IPCF messages

CHKQUE:	$SAVE	<STREAM>		;PRESERVE CURRENT STREAM

CHKQ.1:	SETZM	MESSAG			;ZERO MESSAGE ADDRESS
	SETZM	BLKADR			;CLEAR ARG ADDRESS
	$CALL	C%RECV			;RECEIVE A MESSAGE
	JUMPF	.POPJ			;RETURN IF NO MESSAGES

CHKQ.2:	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			;NO -- IGNORE IT
	LOAD	M,MDB.MS(S1),MD.ADR	;GET THE MESSAGE ADDRESS
	MOVEM	M,MESSAG		;SAVE ADDRESS
	LOAD	S1,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	MOVSI	T2,-NMSGT		;NO -- SEARCH QUASAR TYPES

CHKQ.3:	HRRZ	T1,MSGTBL(T2)		;GET A MESSAGE TYPE
	CAMN	S1,T1			;MATCH?
	JRST	CHKQ.4			;YES, WIN
	AOBJN	T2,CHKQ.3		;NO, LOOP
	JRST	CHKQ.5			;UNKNOWN TYPE -- IGNORE IT

CHKQ.4:	HLRZ	T1,MSGTBL(T2)		;GET THE ROUTINE ADDRESS
	MOVX	S,NOSTRM		;ASSUME NO STREAM CONTEXT
;**;[6002]At CHKQ.4:+1L add 4 lines  JCR  1/11/90
	LOAD	S2,.MSFLG(M),MF.NEB	;[6002]Pick up the remote origin bit
	MOVEM	S2,G$NEBF		;[6002]Save for any $Qxxx macro
	MOVE	S2,.OARGC(M)		;[6002]Pick up the argument count
	MOVEM	S2,JOBARG		;[6002]Save for routine FNDBLK
	$CALL	CHKOBJ			;SET UP STREAM CONTEXT
	JUMPF	CHKQ.5			;BAD NEWS..GET NEXT MESSAGE
	PUSHJ	P,0(T1)			;DISPATCH
	TXNN	S,NOSTRM		;IN STREAM CONTEXT?
	MOVEM	S,J$RACS+S(J)		;YES..SAVE STATUS REG

CHKQ.5:	$CALL	C%REL			;RELEASE MESSAGE
CHKQ.6:	JRST	CHKQ.1			;GET NEXT MESSAGE


MSGTBL:	XWD	KILL,.QOABO		;ABORT MESSAGE
	XWD	NXTJOB,.QONEX		;NEXTJOB
	XWD	SETUP,.QOSUP		;SETUP
	XWD	OACCAN,.OMCAN		;CANCEL
	XWD	OACREQ,.OMREQ		;REQUEUE THE CURRENT JOB
	XWD	OACSTP,.OMPAU		;STOP FOR A WHILE
	XWD	OACCON,.OMCON		;CONTINUE FROM STOP
	XWD	OACRSP,.OMRSP		;RESPONSE TO WTOR

	NMSGT==.-MSGTBL
SUBTTL	CHKOBJ	Routine to validate QUASAR/ORION/OPR MSG Object block

;CALL:	S1/ MESSAGE TYPE
;	M/ MESSAGE ADDRESS
;
;RET:	STREAM/STREAM NUMBER
;	J/DATA BASE ADDRESS
;	S/STATUS BITS


CHKOBJ:	$SAVE	<T1,T2,T3,T4>		;SAVE THE TEMPORARIES
	MOVSI	T1,-NMSGO		;GET REPEAT COUNT
CHKO.1:	HLRZ	S2,MSGOBJ(T1)		;GET A MESSAGE TYPE
	CAMN	S1,S2			;IS THIS IT?
	 JRST	CHKO.3			;YES..PROCESS IT
	AOBJN	T1,CHKO.1		;NO..TRY THE NEXT
	CAIGE	S1,.OMOFF		;OPR/ORION MESSAGE?
	$RETF				;NO..WE LOOSE

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

CHKO.3:	HRRZ	S1,MSGOBJ(T1)		;GET THE MESSAGE OFFSET
	JUMPE	S1,.RETT		;RETURN IF NOT MAPPABLE
	ADDI	S1,0(M)			;ADD MESSAGE ADDRESS
	JRST	CHKO.4			;MEET AT THE PASS.

CHKO.4:	PUSHJ	P,FNDOBJ		;GO FIND THE OBJECT BLOCK.
;**;[6002]At CHKO.4:+1L replace 2 lines with 24 lines  JCR  1/11/90
	JUMPF	CHKO.6			;[6002]Not there, that's an error
	SKIPN	G$NEBF			;[6002]Message originate remotely?
	$RET				;[6002]No, so finished
	LOAD	S1,.MSTYP(M),MS.TYP	;[6002]Pick up the message type
	CAIE	S1,.QOABO		;[6002]An ABORT message?
	JRST	CHKO.5			;[6002]No, go set up G$REMN
	MOVE	S1,ABO.ND(M)		;[6002]Pick up the remote node name
	MOVEM	S1,G$REMN		;[6002]Save where expected by $Qxxx
	$RET				;[6002]Return to the caller
CHKO.5:	$CALL	FNDREM			;[6002]Set up G$REMN
	$RETIT				;[6002]Return to the caller
	JRST	REMERR			;[6002]Shouldn't happen but tell ORION
CHKO.6:	SKIPN	G$NEBF			;[6002]Message originate remotely?
	$RET				;[6002]No, so return now
	LOAD	S1,.MSTYP(M),MS.TYP	;[6002]Pick up the message type
	CAIE	S1,.QOABO		;[6002]An ABORT message?
	JRST	CHKO.7			;[6002]No, go set up G$REMN
	MOVE	S1,ABO.ND(M)		;[6002]Pick up the remote node name
	MOVEM	S1,G$REMN		;[6002]Place where expected by $NUL
	JRST	CHKO.8			;[6002]Go send the Null ACK
CHKO.7:	$CALL	FNDREM			;[6002]Set up G$REMN
	JUMPF	REMERR			;[6002]Shouldn't happen but tell ORION
CHKO.8:	$NUL	(.MSCOD(M))		;[6002]Send a Null ACK to NEBULA
	$RETF				;[6002]Indicate error occurred to caller

;TABLE FORMAT FOR NON STANDARD MESSAGES
; Message type,,Message offset to object block (or 0 if none)

MSGOBJ:	.QOABO,,ABO.TY			;QUASAR ABORT MESSAGE
	.QORCK,,RCK.TY			;QUASAR REQUEST CHECKPOINT
	.QONEX,,.EQROB			;QUASAR NEXTJOB MESSAGE
	.QOSUP,,0			;QUASAR SETUP/SHUTDOWN MESSAGE
	.OMRSP,,0			;OPR/ORION RESPONSE?
	NMSGO==.-MSGOBJ			;NUMBER OF TYPES
SUBTTL	FNDOBJ	Routine to establish STREAM context

;ACCEPTS	S1/ Address of object block

;RETURNS TRUE	J/ Address of context data
;		S/ Context status bits
;	   STREAM/ Context stream

;	 FALSE	Object not found

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,NSTRMS		;THE END OF THE LINE?
	 $RETF				;LOOSE
	JRST	FNDO.1			;OK, LOOP

FNDO.3:	HRROM	T4,STREAM		;SAVE STREAM NUMBER
	MOVE	J,JOBPAG(T4)		;GET ADDRESS OF DATA
	MOVE	S,J$RACS+S(J)		;GET STREAMS 'S'
	CAME	J,ACTPAG		;SAME ACCOUNTING PAGE?
	$CALL	ACTRNT			;NO..DO RUNTIME ACCOUNTING
	MOVEM	J,ACTPAG		;SAVE ACCOUNTING PAGE
	$RETT				;AND RETURN
SUBTTL	GETBLK	Routine to return next argument from an OPR/ORION message

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

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


NXTJOB:	HRR	S1,J			;GET 0,,DEST
	HRR	S2,M			;GET ADDRESS OF MESSAGE
	HRL	S1,S2			;GET SOURCE,,DEST
	LOAD	S2,.MSTYP(S2),MS.CNT	;GET LENGTH OF MESSAGE
	ADDI	S2,-1(J)		;GET ADR OF END OF BLT
	BLT	S1,(S2)			;BLT THE DATA
	HRRZ	S1,STREAM		;GET STREAM NUMBER
	SETOM	JOBACT(S1)		;MAKE THE STREAM ACTIVE
	SETZM	JOBSTW(S1)		; AND NOT BLOCKED
	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

	MOVEI	S1,J$$BEG(J)		;PREPARE TO ZERO SELECTED WORDS JOB AREA
	MOVSI	S2,-^D15		;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

	LOAD	S1,.EQSPC(J),EQ.NUM	;GET NUMBER OF FILES
	MOVEM	S1,J$RFLN(J)		;STORE IT
	GETLIM	T1,.EQLIM(J),OLIM	;GET PAGE LIMIT
	MOVEM	T1,J$RLIM(J)		;SAVE IT
	$CALL	I%NOW			;GET TIME OF DAY
	MOVEM	S1,J$RTIM(J)		;SAVE IT AWAY
	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
	$WTOJ	(Begin,^R/.EQJBB(J)/,@JOBOBA(S1))
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET INVALID ACCOUNT BIT
	STORE	S1,S,ABORT		;ABORT IF SET
	$CALL	ACTBEG			;START ACCOUNTING
	$RETT				;AND RETURN
SUBTTL	User CANCEL Request

KILL:	TXOE	S,GOODBY!ABORT		;SET SOME BITS
;**;[6002]At KILL:+1L change 1 line  JCR  1/11/90
	JRST	KILL.1			;[6002]If leaving, check if remote
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPERATOR RESPONSE BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR OPR RESPONSE ???
;**;[6002]At KILL:+5L change 1 line  JCR  1/11/90
	$QKWTO	(JOBWAC(S1))		;[6002]Yes, kill it
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR THE WAIT BIT
	$CALL	INPFEF			;SET END OF FILE ALSO
	HRRZ	S1,STREAM		;POINT TO STREAM
;**;[6002]At KILL:+9L change 1 line  JCR  1/11/90
	$QWTOJ	(<Cancel request queued by user ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(.MSCOD(M))>);[6002]
	PUSHJ	P,SETEBF		;SET UP ERROR BUFFER
	$TEXT	(DEPBP,<? Canceled by user ^U/ABO.ID(M)/^0>)
	$RETT				;AND RETURN
;**;[6002]At KILL:+12L add 3 lines  JCR  1/11/90
KILL.1:	SKIPE	G$NEBF			;[6002]Request originated remotely?
	$NUL	(.MSCOD(M))		;[6002]Yes, send a Null ACK to NEBULA
	$RETT				;[6002]Return to the caller
	
SUBTTL	UPDATE Routine to send status update


; Generate status update messages
;
UPDATE:	$SAVE	<S1,S2,T1,T2>		;SAVE SOME ACS
	MOVX	S1,STU.SZ		;GET STATUS UPDATE SIZE
	MOVX	S2,.QOSTU		; AND TYPE
	$CALL	CLRMSG			;INIT THE MESSAGE AND T1
	MOVX	T2,%RESET		;DEFAULT TO RESET

	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVE	S1,JOBPAG(S1)		;GET ADDRESS OF JOB DATA PAGES
	MOVE	S2,J$RACS+S(S1)		;GET STREAM'S AC 'S'
	TXNE	S2,RQB			;REQUEUING JOB ?
	MOVX	T2,%REQUE		;YES
	TXNE	S2,ABORT		;ABORTING JOB ?
	MOVX	T2,%CNCLG		;YES

	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVE	S2,JOBSTW(S1)		;GET THE JOBS STATUS WORD
	TXNE	S2,PSF%OR		;ARE WE WAITING FOR OPR RESPONSE ???
	MOVX	T2,%OREWT		;YES,,SAY SO
	TXNE	S2,PSF%ST		;ARE WE STOPPED ???
	MOVX	T2,%STOPD		;YES,,SAY SO
	TXNE	S2,PSF%DO		;ARE WE OFFLINE ???
	MOVX	T2,%OFLNE		;YES,,SAY SO

	MOVEM	T2,STU.CD(T1)		;SAVE THE STATUS
	HRLZ	T2,JOBOBA(S1)		;GET THE OBJECT BLOCK ADDRESS
	HRRI	T2,STU.RB(T1)		;GET DESTINATION ADDRESS
	BLT	T2,STU.RB+OBJ.SZ-1(T1)	;COPY THE OBJ BLK OVER TO THE MSG
	$CALL	SNDQSR			;SEND IT OFF
	$RET
SUBTTL	CHKPNT Routine to send checkpoint message


; Send checkpoint job message to QUASAR. This routine calls the device
; dependant service routines to generate half of the ASCIZ text that gets
; displayed by QUASAR in queue listings.
;
CHKPNT:	MOVE	S1,STREAM		;GET THE STREAM NUMBER
	SKIPN	JOBACT(S1)		;NEED TO CHECKPOINT ?
	POPJ	P,			;NO - RETURN
	$CALL	I%NOW			;GET THE CURRENT TIME
	MOVE	TF,S1			;SAVE IT TEMPORARILY
	MOVE	S2,STREAM		;GET THE STREAM NUMBER
	SUB	S1,JOBCHK(S2)		;GET CHECKPOINT INTERVAL
	SKIPGE	S1			;TIME TO CHECKPOINT YET ?
	POPJ	P,			;NO - RETURN
	ADDI	TF,CKPTIM*3		;COMPUTE TIME OF NEXT CHECKPOINT
	MOVEM	TF,JOBCHK(S2)		;STORE FOR NEXT PASS THROUGH HERE

CHKP.0:	MOVX	S1,CHE.SZ		;GET SIZE OF CHECKPOINT MESSAGE
	MOVX	S2,.QOCHE		;AND CHECKPOINT TYPE
	PUSHJ	P,CLRMSG		;INIT MESSAGE AND T1
	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$APRT(J)		;GET NUMBER OF CARDS, ETC
	MOVEM	S1,CHE.IN+CKTPP(T1)	;AND STORE IT
	LOAD	S1,.EQITN(J)		;GET JOBS ITN
	MOVEM	S1,CHE.IT(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
	MOVEI	S1,STSSIZ*5-1		;MAXIMUMUM CHARACTER COUNT
	MOVEM	S1,TEXTBC		;FOR DEPBP
CHKP.1:	$TEXT	(DEPBP,<Started at ^C/J$RTIM(J)/, ^A>)
	MOVE	S1,J$LSER(J)		;GET ADDRESS OF DEVICE DISPATCH
	PUSHJ	P,DCHKP(S1)		;GENERATE DEVICE DEPENDANT TEXT
	HRRZ	S1,TEXTBP		;GET THE BYTE POINTER
	SUBI	S1,MSGBLK-1		;SUBTRACT START POINT
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE THE ACTUAL LENGTH
	PJRST	SNDQSR			;SEND IT AND RETURN
SUBTTL	SETUP/SHUTDOWN Message

SETUP:	LOAD	S2,SUP.FL(M)		;GET THE FLAGS
	TXNE	S2,SUFSHT		;IS IT A SHUTDOWN?
	JRST	[MOVEI S1,SUP.TY(M)	;GET OBJECT ADDRESS
		 $CALL	FNDOBJ		;FIND IT
		 JRST SHUTDN]		;AND SHUT IT DOWN

	SETZ	T2,			;CLEAR A LOOP REG

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

SETU.2:	HRRZM	T2,STREAM		;SAVE THE STREAM NUMBER
	$CALL	I%NOW			;USE SETUP TIME AS ACK STAMP
	MOVEM	S1,JOBWAC(T2)		;SAVE CODE FOR $WTOR
	MOVEI	S1,NJBPGS		;NUMBER OF PAGES NEEDED
	$CALL	M%AQNP			;GET THEM
	PG2ADR	S1			;CONVERT TO AN ADDRESS
	MOVEM	S1,JOBPAG(T2)		;AND SAVE IT
	MOVE	J,S1			;PUT IT IN J
	MOVEM	J,J$RACS+J(J)		;SAVE J AWAY
	MOVEI	S1,2000(J)		;DEV BUFFER ADDRESS
	MOVEM	S1,J$LBUF(J)		;STORE IT
	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
	$CALL	OUTGET			;GET THE OUTPUT DEVICE
	$CALL	RSETUP			;SEND RESPONSE TO SETUP
	HRRZ	S2,STREAM		;GET OUR STREAM NUMBER
	$WTO	(^T/@SETMSG(S1)/,,@JOBOBA(S2)) ;TELL THE OPERATOR
	CAIN	S1,%RSUOK		;ALL IS OK?
	$RETT				;YES, RETURN
	JRST	SHUTDN			;NO, SHUT IT DOWN

SETMSG:	[ASCIZ /Started/]
	[ASCIZ /Not available right now/]
	[ASCIZ /Does not exist/]
SUBTTL	Response to setup message

;CALL		S1/ Setup response code

;RETURNS	S1/ Setup response code

RSETUP:	$SAVE	<S1>			;PRESERVE S1 ACROSS CALL
	MOVE	T2,S1			;SAVE THE SETUP CONDITION CODE.
	MOVX	S1,RSU.SZ		;GET RESPONSE TO SETUP SIZE
	MOVX	S2,.QORSU		; AND TYPE
	$CALL	CLRMSG			;INIT MESSAGE AND T1
	STORE	T2,RSU.CO(T1)		;STORE THE RESPONSE CODE
	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
	PJRST	SNDQSR			;SEND IT OFF AND RETURN


;SHUTUP is called to shutdown the object and return to MAIN loop
;Here if something terrible happens to the device

SHUTUP:	MOVE	P,[IOWD PDSIZE,PDL]	;POINT TO MAIN PDL
	MOVEI	S1,%RSUDE		;GET DEVICE DOES NOT EXIST CODE
	$CALL	RSETUP			;TELL QUASAR
	$CALL	SHUTDN			;SHUT DOWN THE STREAM
	JRST	MAIN			;ONWARD AND UPWARD


;SHUTDN is called to shutdown the object running in the current STREAM

SHUTDN:	$CALL	OUTREL			;RELEASE THE OBJECT
	MOVE	S2,J			;GET THE JOBPAG ADDRESS
	ADR2PG	S2			;CONVERT TO A PAGE NUMBER
	MOVEI	S1,NJBPGS		;LOAD THE NUMBER OF PAGES
	$CALL	M%RLNP			;RETURN THEM
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBPAG(S1)		;CLEAR THE PAGE WORD
	SETZM	JOBACT(S1)		;AND THE ACTIVE WORD
	MOVX	S,NOSTRM		;MAKE NO STREAM CONTEXT
	$RETT				;AND RETURN
SUBTTL	Operator CANCEL command

OACCAN:	$SAVE	<P1,P2>			;PRESERVE SOME ACS
	PUSHJ	P,INPFEF		;FORCE EOF
	TXO	S,GOODBY!ABORT		;LIGHT THE ABORT FLAG
	PUSHJ	P,SETEBF		;SET UP ERROR TEXT BUFFER
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPERATOR RESPONSE BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR OPR RESPONSE ???
;**;[6002]At OACCAN:+7L change 3 lines  JCR  1/11/90
	$QKWTO	(JOBWAC(S1))		;[6002]Yes, kill it
	ANDCAM	S2,JOBSTW(S1)		;[6002]And clear the wait bit
	$QACK	(<Abort request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M));[6002]
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$TEXT	(DEPBP,<? Aborted by the operator^A>) ;INITIAL MESSAGE
	SETZ	P1,P2			;ASSUME NOT PURGED

OACC.1:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	OACC.2			;NO MORE,,FINISH UP
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	MOVEI	P1,0(T3)		;YES..SAVE ADDRESS OF REASON
	CAIE	T1,.CANTY		;IS THIS THE CANCEL TYPE BLOCK ???
	JRST	OACC.1			;NO,,SKIP IT AND GET NEXT BLOCK
	MOVE	S1,0(T3)		;YES - LOAD THE CANCEL TYPE
	CAIE	S1,.CNPRG		;IS IT /PURGE ???
	JRST	OACC.1			;NO,,PROCESS THE NEXT MSG BLK
	$TEXT	(DEPBP,< (purged)^A>)	;YES
	SETO	P2,			;FLAG PURGING JOB
	JRST	OACC.1			;GO BACK

OACC.2:	SKIPN	P1			;DID HE GIVE A REASON?
	$TEXT	(DEPBP,<. No reason given.^0>) ;NO
	SKIPE	P1			;NO?
	$TEXT	(DEPBP,<. Reason: ^T/0(P1)/.^0>) ;YES
;**;[6002]At OACC.2:+4L add 2 lines  JCR  1/11/90
	SKIPE	G$NEBF			;[6002]Request originate remotely?
	$CALL	TRSREM			;[6002]Yes, set up the remote parameters
	JUMPE	P2,.POPJ		;RETURN IF NOT PURGING
	MOVE	S1,J$DIFN(J)		;GET THE FILE IFN.
	TXZE	S,DSKOPN		;DONT CLOSE IF ITS NOT OPEN.
	PUSHJ	P,F%REL			;ELSE,,CLOSE IT OUT.
	$CALL	ACTEND			;DO FINAL ACCOUNTING
	$CALL	QRELEASE		;RELEASE THE STREAM
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBACT(S1)		;INDICATE NOT ACTIVE
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	CAIE	S1,%RSUOK		;DO WE STILL HAVE THE DEVICE?
	PJRST	SHUTUP			;NO..KILL THE STREAM
	POPJ	P,			;RETURN
SUBTTL	Operator STOP command

OACSTP:	MOVX	S2,PSF%ST		;LOAD THE STOP BIT
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	IORM	S2,JOBSTW(S1)		;SET IT
;**;[6002]At OACSTP:+3L change 1 line  JCR  1/11/90
	$QACK	(<Stopped>,,@JOBOBA(S1),.MSCOD(M)) ;[6002]Tell OPR
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$RETT				;AND RETURN

SUBTTL	Operator CONTINUE command

OACCON:	MOVX	S2,PSF%ST!PSF%DO	;LOAD STOP AND DEVICE OFF-LINE FLAGS
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
;**;[6002]At OACCON:+3L change 1 line  JCR  1/11/90
	$QACK	(<Continued>,,@JOBOBA(S1),.MSCOD(M)) ;[6002]]Tell OPR
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$RETT				;AND RETURN

SUBTTL	Operator RESPONSE command

;**;[6002]At OACRSP:+0L replace 6 lines with 9 lines  JCR  1/11/90
OACRSP:	$SAVE	<P1>			;[6002]Save this AC
	MOVE	S2,.MSCOD(M)		;[6002]Get WTOR ACK code
	MOVSI	S1,-NSTRMS		;[6002]Create AOBJN AC
RESP.1:	CAMN	S2,JOBWAC(S1)		;[6002]ACK codes the same?
	JRST	RESP.2			;[6002]Yes, this is the stream
	AOBJN	S1,RESP.1		;[6002]Check the next stream
	JRST	RESP.3			;[6002]Not there, check if remote
RESP.2:	MOVE	P1,S1			;[6002]Save the stream number
	MOVX	S2,PSF%OR		;[6002]Get "OPERATOR-RESPONSE" wait bit
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR IT
	MOVE	J,JOBPAG(S1)		;GET THE STREAM DB ADDRESS.
	$CALL	SETTBF			;POINT TO TEXT BUFFER
	MOVEI	S1,.OHDRS+ARG.DA(M)	;POINT TO THE OPERATOR RESPONSE.
	$TEXT	(DEPBP,<^T/0(S1)/^0>)	;MOVE RESPONSE TO TEXT BUFFER
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
;**;[6002]At RESP.2:+7L replace 1 line with 26 lines  JCR  1/11/90
	SKIPN	S1,G$NEBF		;[6002]Message originate remotely?
	$RETT				;[6002]No, return now
	MOVEM	S1,J$NEBF(J)		;[6002]Save in the job data stream
	MOVEI	S1,.ACKID		;[6002]Want to find the ACK block
	$CALL	FNDBLK			;[6002]Search for the ACK block
	JUMPF	REMERR			;[6002]Shouldn't happen, but tell ORION
	MOVE	S2,ARG.HD(S1)		;[6002]Pick up the PID of the operator
	MOVEM	S2,J$RPID(J)		;[6002]Save for any $Qxxx
	MOVE	S2,ARG.DA(S1)		;[6002]Pick up the node name
	MOVEM	S2,J$RNOD(J)		;[6002]Save for any $Qxxx
	SETOM	J$NULA(J)		;[6002]Indicate NEBULA needs a response
	MOVE	S1,JOBSTW(P1)		;[6002]Pick up the stream status
	TXNE	S1,PSF%ST		;[6002]Is the stream stopped?
	$CALL	SNDNUL			;[6002]Yes, send a Null ACK to NEBULA
	$RETT				;[6002]Now return

RESP.3:	SKIPN	G$NEBF			;[6002]Message originate remotely?
	$RET				;[6002]No, so return now
	MOVEI	S1,.ACKID		;[6002]Want to find the ACK block
	$CALL	FNDBLK			;[6002]Search for the ACK block
	JUMPF	REMERR			;[6002]Shouldn't happen but tell ORION
	MOVE	S2,ARG.DA(S1)		;[6002]Pick up the node name
	MOVEM	S2,G$REMN		;[6002]Place where $NUL expects it
	MOVE	S2,ARG.HD(S1)		;[6002]Pick up the PID of the operator
	$NUL	(S2)			;[6002]Send a Null ACK to NEBULA
	$RET				;[6002]Return to the caller
SUBTTL	Operator REQUEUE command

OACREQ:	TXNE	S,GOODBY		;IS IT TOO LATE FOR THIS ???
	$RETT				;YES..JUST RETURN
	PUSHJ	P,INPFEF		;FORCE AN INPUT EOF
	TXO	S,RQB!ABORT		;SET ABORT AND REQUEUED
	MOVE	S1,STREAM		;GET THE STREAM NUMBER
;**;[6002]At OACREQ:+5L change 1 line  JCR  1/11/90
	$QACK	(<Requeue request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M));[6002]
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$CALL	SETEBF			;POINT TO TEXT BUFFER

	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPERATOR RESPONSE BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR OPR RESPONSE ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL IT !!!
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR THE WAIT BIT
	$TEXT	(DEPBP,<?Requeued by operator ^A>)
	SETZ	P1,			;MESSAGE GIVEN

OACR.1:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	OACR.3			;NO MORE,,RETURN
	CAIN	T1,.REQTY		;IS THIS THE REQUEST TYPE BLOCK ???
	JRST	OACR.2			;YES,,GO PROGESS IT
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	MOVEI	P1,0(T3)		;GET THE MESSAGE
	JRST	OACR.1			;PROCESS THE NEXT MSG BLOCK

OACR.2:	MOVE	S1,0(T3)		;PICK UP THE REQUEUE CODE.
	SETZ	S2,			;ZERO AC 2
	CAXN	S1,.RQCUR		;/CURRENT?
	MOVEI	S2,[ASCIZ/ Job will restart at current position/]
	JUMPN	S2,OACR.1		;FINISH UP
	SETZM	J$RNPP(J)		;CLEAR CURRENT PAGE NUMBER
	CAXN	S1,.RQBCP		;BEGINNING OF COPY?
	MOVEI	S2,[ASCIZ /Job will restart at current copy/]
	JUMPN	S2,OACR.1		;AND CONTINUE ON
	SETZM	J$RNCP(J)		;CLEAR CURRENT COPY NUMBER
	CAXN	S1,.RQBFL		;FROM BEGINING OF FILE?
	MOVEI	S2,[ASCIZ /Job will restart at current file/]
	JUMPN	S2,OACR.1		;AND CONTINUE ON
	SETZM	J$RNFP(J)		;CLEAR FILE COUNT
	MOVEI	S2,[ASCIZ /Job will restart at beginning/]
	JRST	S2,OACR.1		;AND GO OUTPUT IT

OACR.3:	SKIPN	P1			;A REASON?
	$TEXT	(DEPBP,<. No reason given.>)
	SKIPE	P1			;LIST THEM ALL
	$TEXT	(DEPBP,<. Reason: ^T/0(P1)/.>)
	SKIPE	S2
	$TEXT	(DEPBP,<. ^T/0(S2)/.^A>)
	MOVEI	S1,.CHNUL		;END THE MESSAGE
	$CALL	DEPBP
;**;[6002]At OACR.3:+7L add 2 lines  JCR  1/11/90
	SKIPE	G$NEBF			;[6002]Message originate remotely?
	$CALL	TRSREM			;[6002]Yes, set up the remote parameters
	$RETT
SUBTTL	CLRMSG and SNDQSR routines

;CLRMSG can be called to setup the length and type of a message

;CALL		S1/ Length of Message
;		S2/ Message type

;RETURNS	T1/ Address of message

CLRMSG:	MOVEI	T1,MSGBLK		;GET ADDRESS FOR RETURN
	STORE	S1,.MSTYP(T1),MS.CNT	;STORE THE LENGTH
	STORE	S2,.MSTYP(T1),MS.TYP	;STORE THE TYPE
	CAILE	S2,MSBSIZ		;SIZE OK?
	 $STOP	(MSZ,Message size too large)
	SUBI	S1,.MSFLG		;DECREMENT COUNT TO CLEAR
	MOVEI	S2,.MSFLG(T1)		;FIRST WORD TO CLEAR
	PJRST	.ZCHNK			;CLEAR AND RETURN


;SNDQSR is called to send a message to QUASAR

;CALL		T1/ Message address

SNDQSR:	MOVX	S1,SP.QSR		;GET QUASAR CODE
	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 MESSAGE LENGTH
	TRNN	T1,777			;CHECK FOR PAGE MESSAGE
	MOVEI	S1,1000			;GET 1 PAGE MESSAGE SIZE
	STORE	S1,SAB+SAB.LN		;SAVE IT
	STORE	T1,SAB+SAB.MS		;SAVE THE MESSAGE ADDRESS
	MOVEI	S1,SAB.SZ		;LOAD THE SIZE
	MOVEI	S2,SAB			;AND THE ADDRESS
	$CALL	C%SEND			;SEND THE MESSAGE
	JUMPT	.RETT			;AND RETURN

	$STOP(QSF,Send to QUASAR FAILED)
FRMLEX:	GETLIM	S1,.EQLIM(J),FLEA	;GET FORMS-LIMIT-EXCEED ACTION
	CAIN	S1,.STCAN		;SEE IF CANCEL
	JRST	OUTCAN			;IT WAS, DO IT
	CAIN	S1,.STIGN		;SEE IF IGNORE
	JRST	OUTIGN			;YES, DOUBLE THE LIMIT

;DEFAULT TO ASK IF NOT CANCEL OR IGNORE

OUTASK:	HRRZ	S1,STREAM		;GET OUR STREAM
	SETZM	JOBCHK(S1)		;REQUEST A CHECKPOINT
	PUSHJ	P,CHKPNT		;GET IT
	HRRZ	S1,STREAM		;GET OUR STREAM
	MOVX	S2,PSF%OR		;GET 'OPR RESP WAIT' FLAG
	IORM	S2,JOBSTW(S1)		;STORE IT
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
;**;[6002]At OUTASK:+7L change 1 line  JCR  1/11/90
	$QWTOR	(Output limit exceeded,<^I/OLEMSG/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(J$RPID(J))>);[6002]
	$DSCHD	(PSF%OR)		;WAIT FOR RESPONSE
	TXNE	S,ABORT			;WERE WE CANCELLED ???
	PJRST	OUTIGN			;YES,,ASSUME IGNORE
	MOVEI	S1,OLEANS		;POINT TO ANSWER TABLE
	HRROI	S2,J$XTBF(J)		;POINT TO ANSWER
	$CALL	S%TBLK			;LOOKUP THE ANSWER
	TXNE	S2,TL%NOM+TL%AMB	;FIND IT OK?
	 JRST	OUTASK			;NOPE..TRY AGAIN
	HRRZ	S1,(S1)			;GET THE ADDRESS
	PJRST	0(S1)			; AND GO TO IT

OUTCAN:	MOVEI	S1,[ITEXT (<Output limit exceeded>)]
	$CALL	PUTERR			;Process IT
	$CALL	INPFEF			;FORCE EOF ON NEXT INPUT
	TXO	S,ABORT			;LIGHT ABORT
	HRRZ	S1,STREAM
;**;[6002]At OUTCAN:+5L replace 4 lines with 5 lines  JCR  1/11/90
	$QWTO	(Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]
	$RETT				;[6002]And return

OUTIGN:	$CALL	SNDNUL			;[6002]Send a Null ACK if necessary
	MOVX	S1,.INFIN		;[6002]Get maximum limit
	MOVEM	S1,J$RLIM(J)		;SAVE IT
	$RETT				;AND TRY SOME MORE


OLEANS:	$STAB
	 KEYTAB	(OUTCAN,ABORT)		;ABORT (CANCEL)
	 KEYTAB	(OUTIGN,PROCEED)	;PROCEED (IGNORE)
	$ETAB

OLEMSG:	ITEXT <^R/.EQJBB(J)/^T/@OLETXT/>
OLETXT:	[ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue outputing/]
SUBTTL	Accounting routines


; Routine to set up data for usage accounting
;
ACTINI:	MOVX	S1,-1			;-1 For us
	MOVX	S2,JI.JNO		;Function code
	$CALL	I%JINF			;Get our job number
	MOVEM	S2,L.JOB		;Store it
	MOVE	S1,[ASCII/D/]		;DEFAULT TO DETACHED
	MOVEM	S1,L.TTY		;SAVE THE DESIGNATOR

TOPS10	<				;TOPS-10 ONLY
	GETLIN	S1,			;GET OUR TTY NUMBER
	TLNN	S1,-1			;ARE WE DEATCHED ???
	$RETT				;YES,,SKIP THIS
	GTNTN.	S1,			;GET OUR LINE NUMBER
	  $RETT				;YES,,SKIP THIS
	SETOM	S2			;GET A -1
	TRMNO.	S2,			;GET OUR TTY NUMBER
	  $RETT				;YES,,SKIP THIS
	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,L.TTY		;SAVE THE TERMINAL DESIGNATOR
	HRRZM	S1,L.LIN		;SAVE THE LINE NUMBER
	$RETT				;RETURN
>					;END OF TOPS-10 CONDITIONAL

TOPS20	<				;TOPS-20 ONLY
	$RETT				;RETURN
>					;END OF TOPS-20 CONDITIONAL
ACTBEG:	SKIPN	ACTFLG			;ACCOUNTING?
	 $RETT				;NO..JUST RETURN
	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
	MOVE	S1,J$LSER(J)		;GET DISPATCH ADDRESS
	MOVE	S1,DNAME(S1)		;GET DEVICE (QUEUE) NAME
	MOVEM	S1,J$AQUE(J)		;SAVE FOR ACT END
	SETZM	J$PTIC(J)		;CLEAR PLOTTER ACCOUNTING
	$RETT				;RETURN

ACTEND:	SKIPN	ACTFLG			;ARE WE DOING ACCT?
	$RETT				;NO,,RETURN NOW.
	LOAD	S1,.EQSEQ(J),EQ.IAS	;GET THE INVALID ACCT STRING BIT
	JUMPN	S1,.RETT		;IF LIT,,THEN JUST RETURN
	MOVE	S1,J$LSER(J)		;GET DISPATCH ADDRESS
	PUSHJ	P,DACCT(S1)		;DO FINAL ACCOUNTING
	MOVX	S2,'NORMAL'		;ASSUME NORMAL DISPOSITION
	TXNE	S,RQB			;REQUED?
	MOVX	S2,'REQUED'		;YES
	TXNE	S,ABORT			;ABORTED?
	MOVX	S2,'CANCEL'
	MOVEM	S2,J$ADSP(J)		;STORE DISPOSITION
	$CALL	ACTRNT			;DO FINAL RUNTIME ACCOUTING
	SETZM	ACTPAG			;CLEAR THE PAGE ADDRESS

TOPS10<	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
	MOVX	S1,<ACTLEN,,ACTLST>	;SET UP AC
	QUEUE.	S1,			;MAKE A USAGE ENTRY
	 PUSHJ	P,ACTE.1		;FAILED,,TELL OPR

FACT<	MOVE	S1,L.LIN		;GET LINE NUMBER
	LDB	S2,[POINT 7,L.TTY,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,L.JOB		;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
	HLLZ	S2,J$AQUE(J)		;GET QUEUE NAME
	TLZ	S2,77			;CLEAR JUNK
	IOR	S1,S2			;INSERT QUEUE NAME
	IORM	S1,FACTBL+3		;NODE NUMBER ALREADY STORED FROM ABOVE
	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,[14,,FACTBL-1]	;DAEMON ARGUMENT
	DAEMON	S1,			;MAKE THE FACT ENTRY
	  JRST	ACTE.1			;REPORT THE FAILURE
> ;END FACT ACCOUNTING
> ;END TOPS10 ACCOUNTING

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

	$RETT				;RETURN WHEN DONE

ACTE.1:	MOVE	S1,STREAM		;GET THIS STREAM NUMBER
;**;[6002]At ACTE.1:+1L change 1 line  JCR  1/11/90
	$QWTO	(System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
	$RETT				;RETURN

ACTRNT:	SKIPN	ACTFLG			;Accounting turned on ?
	$RETT				;No - return
	SETO	S1,			;-1 Means us
	MOVX	S2,JI.RTM		;Function code
	$CALL	I%JINF			;Get our runtime
	ADDM	S2,ACTRNN		;Store accumulated time
	MOVNS	S2			;Negate actual runtime
	EXCH	S2,ACTRNN		;INIT FOR NEXT PASS
	SKIPE	S1,ACTPAG		;GET LAST PROCESSES PAGE ADDRESS
	ADDM	S2,J$ARTM(S1)		;ACCUMULATE TOTAL
	$RETT				;RETURN
	SEARCH	ACTSYM			;SEARCH THE ACCOUNTING UNV
ACTLST:	USENT.	(.UTOUT,1,1,0)
	USJNO.	(L.JOB)			;JOB NUMBER
	USTAD.	(-1)			;CURRENT DATE/TIME
	USTRM.	(L.TTY)			;TERMINAL DESIGNATOR
	USLNO.	(L.LIN)			;TTY LINE NUMBER
	USPNM.	(<SIXBIT/SPROUT/>,US%IMM) ;PROGRAM NAME
	USPVR.	(SPOVRS,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(.EQROB+.ROBND(J))	;NODE NAME
	USACT.	(<POINT 7,.EQACT(J)>)	;ACCOUTN STRING POINTER
	USSRT.	(J$ARTM(J))		;RUN TIME
	USSDR.	(J$ADRD(J))		;DISK READS
	USSDW.	(0,US%IMM)		;DISK WRITES
	USJNM.	(.EQJOB(J))		;JOB NAME
	USQNM.	(J$AQUE(J))		;QUEUE NAME
	USSDV.	(J$LDEV(J))		;DEVICE NAME
	USSSN.	(J$ASEQ(J))		;JOB SEQUENCE NUMBER
	USSUN.	(J$APRT(J))		;TOTAL PAGES processed
	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.	(J$ADSP(J))		;REQUEST DISPOSITION
	USTXT.	(<POINT 7,J$XERR(J)>)	;EXTRA TEXT
	USPRI.	(J$APRI(J))		;JOB PRIORITY
	USORI.	(.EQRID(J))		;USER REQUEST ID
	USOCN.	(L.CON)			;CONNECT TIME

TOPS10<					;TOPS-10 ONLY
	USPPN.	(.EQOID(J))		;USER PPN
	USNM1.	(.EQOWN(J))		;USER NAME 1 (TOPS10)
	USNM3.	(.EQOWN+1(J))		;USER NAME 1 (TOPS10)
ACTLEN==.-ACTLST			;LENGTH OF BLOCK
>					;END OF TOPS-10 CONDITIONAL

TOPS20<	USNM2.	(<POINT 7,.EQOWN(J)>)	;USER NAME (TOPS20)
	0				;END OF LIST
>					;END OF TOPS-20 CONDITIONAL

FACT<	EXP	.FACT			;DAEMON WRITE FACT FILE FUNCTION
FACTBL:	BLOCK	13  >			;FACT BLOCK FILLED IN
	SUBTTL	FORMS - Setup Forms for a job

FORMS:	GETLIM	S1,.EQLIM(J),FORM	;GET THE FORMS TYPE
	CAMN	S1,J$FORM(J)		;EXACTLY THE SAME?
	$RETT				;YES, JUST RETURN
	MOVE	S2,[POINT 7,J$XTBF(J)]	;GET POINTER TO WTOR BUFFER.
	MOVEM	S2,TEXTBP		;AND SAVE IT FOR DEPBP.
	MOVEI	S2,TXT$LN*5		;GET MAXIMUM BYTE COUNT
	MOVEM	S2,TEXTBC
	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)/'>)

FORM.1:	HRLZI	S1,J$FCUR(J)		;GET START OF SWITCH STORAGE
	HRRI	S1,J$FCUR+1(J)		;MAKE BLT POINTER
	SETZM	J$FCUR(J)		;CLEAR THE FIRST WORD
	BLT	S1,J$FCUR+F$NSW-1(J)	;CLEAR THE BLOCK

FORM.2:	$CALL	FRMINI			;READ THE SPFORM.INI FILE.
	MOVE	S1,TEXTBP		;GET THE WTOR BYTE POINTER.
	CAMN	S1,[POINT 7,J$XTBF(J)]	;IS THERE A MESSAGE FOR THE OPERATOR ??
	$RETT				;NO,,RETURN.
	$TEXT	(DEPBP,<Type 'RESPOND ^7/[.CHLAB]/number^7/[.CHRAB]/ PROCEED' when ready^0>)
	HRRZ	S1,STREAM		;GET STREAM NUMBER
;**;[6002]At FORM.2:+6L replace 2 lines with 3 lines  JCR  1/11/90
	$QWTOR  (,<^T/J$XTBF(J)/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(J$RPID(J))>) ;[6002]
	$DSCHD	(PSF%OR)		;[6002]Wait for operator response
	$CALL	SNDNUL			;[6002]Send a Null ACK to NEBULA
	$RETT				;RETURN...
FRMINI:	$SAVE	<T1,T2,T3,T4>		;PRESERVE TEMPORARIES
	MOVE	S1,J$LSER(J)		;GET DEVICE DISPATCH ADDRESS
	MOVE	T3,DNAME(S1)		;GET DEVICE NAME
	CAMN	T3,[SIXBIT/PLT/]	;IS DEVICE A PLOTTER?
	SETOM	J$FPLT(J)		;YES -- SET SWITCH FLAG
	DMOVE	S1,[EXP FOB.SZ,FRMFOB]	;POINT TO FILE OPEN BLOCK
	$CALL	F%IOPN			;AND OPEN FORM INI FILE
	JUMPF	.RETF			;RETURN IF FILE NOT FOUND
	MOVEM	S1,J$FIFN(J)		;SAVE IFN OF FORM INI FILE

FRMI.1:	$CALL	FH$SIX			;READ FIRST WORD OF LINE
	JUMPF	FRMIEX			;EXIT ON EOF
	CAME	T1,T3			;MATCH OBJECTS DEVICE TYPE
	CAMN	T1,J$LDEV(J)		;OR ACTUAL DEVICE NAME?
	JRST	FRMI.3			;YES -- CHECK FORMS TYPE
FRMI.2:	$CALL	FH$EOL			;NO -- LOOK FOR END OF LINE
	JUMPF	FRMIEX			;EXIT ON EOF
	JRST	FRMI.1			;DO NEXT LINE

FRMI.3:	$CALL	FH$SIX			;GET THE FORMS NAME
	JUMPF	FRMIEX			;EOF!!
	GETLIM	T2,.EQLIM(J),FORM	;GET FORMS
	CAMN	T1,T2			;MATCH??
	JRST	FRMI.4			;YES!!
	JRST	FRMI.2			;NO -- END LINE

FRMI.4:	CAIN	C,"/"			;BEGINNING OF SWITCH?
	JRST	FRMSWI			;YES, LOCATOR IS "ALL"
	CAIN	C,":"			;BEGINNING OF LOCATOR?
	JRST	FRMI.5			;YES, GO GET IT
	CAIN	C,.CHLFD		;EOL?
	JRST	FRMI.1			;YES, GO THE NEXT LINE
	$CALL	FH$CHR			;ELSE, GET A CHARACTER
	JUMPF	FRMIEX			;EOF
	JRST	FRMI.4			;AND LOOP

FRMI.5:	$CALL	FH$SIX			;GET A LOCATOR
	JUMPF	FRMIEX			;EOF!!
	JUMPE	T1,FRMI.6		;MAYBE PAREN??
	JRST	FRMI.7			;AND DO THE LIST

FRMI.6:	CAIN	C,"/"			;A SWITCH?
	JRST	FRMSWI			;YES!
	CAIN	C,"("			;A LIST?
	JRST	FRMI.7			;YES -- PROCESS IT

FRMERR:	HRRZ	S1,STREAM		;NO -- GET THE STREAM NUMBER.
;**;[6002]At FRMERR:+1L change 1 line  JCR  1/11/90
	$QWTOJ	(SPFORM.INI Error,<bad format>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]Tell OPR

FRMIEX:	MOVE	S1,J$FIFN(J)		;CLOSE FILE
	$CALL	F%REL
	$RETT
FRMI.7:	HLRZ	T2,T1			;GET THE FIRST THREE CHARS
	CAIN	T2,'ALL'		;IS IT "ALL"?
	JRST	FRMSWI			;YES, STOP CHECKING
	CAIN	T2,'LOC'		;IS IT LOCAL?
	SKIPGE	J$LREM(J)		;YES, ARE WE?
	  SKIPA				;NO, NO
	JRST	FRMSWI			;YES, YES!
	CAIN	T2,'REM'		;DOES IT SAY "REMOTE"?
	SKIPL	J$LREM(J)		;YES, ARE WE REMOTE
	  SKIPA				;NO!!!
	JRST	FRMSWI			;YES!!
	CAMN	T1,J$LDEV(J)		;COMPARE TO OUR DEVNAM
	JRST	FRMSWI			;MATCH!!

FRMI.8:	CAIN	C,.CHLFD		;BREAK ON EOL?
	JRST	FRMI.1			;YES, GET NEXT LINE
	CAIE	C,"/"			;IS IT A SLASH?
	CAIN	C,")"			;NO, CLOSE PAREN?
	JRST	FRMI.2			;YES, GET THE NEXT LINE
	$CALL	FH$SIX			;ELSE, GET THE NEXT LOCATOR
	JUMPF	FRMIEX			;EOF, RETURN
	JUMPE	T1,FRMERR		;BAD FORMAT
	JRST	FRMI.7			;AND LOOP AROUND
;GET HERE IF THIS LINE IS FOR US

FRMSWI:	CAIN	C,.CHLFD		;WAS THE LAST CHARACTER A LINEFEED?
	JRST	FRMS.5			;YES -- CHECK PLOTTER processing
	CAIN	C,"/"			;ARE WE AT THE BEGINNING OF A SWITCH?
	JRST	FRMS.1			;YES, DO IT!
	$CALL	FH$CHR			;NO, GET A CHARACTER
	JUMPF	FRMIEX			;EOF!!
	JRST	FRMSWI			;AND LOOP AROUND
FRMS.1:	$CALL	FH$SIX			;GET THE SWITCH
	JUMPF	FRMIEX			;EOF!!
	JUMPN	T1,FRMS.2		;JUMP IF WE'VE GOT SOMETHING
	CAIN	C,.CHLFD		;EOL?
	JRST	FRMIEX			;YES, RETURN
	JRST	FRMSWI			;ELSE, KEEP TRYING

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

FRMS.3:	HLLZ	T3,FFNAMS(T2)		;GET A SWITCH NAME
	CAMN	T3,T1			;MATCH??
	JRST	FRMS.4			;YES, DISPATCH
	AOBJN	T2,FRMS.3		;NO, LOOP
	MOVE	T1,T4			;GET SWITCH NAME
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER.
;**;[6002]At FRMS.3:+6L change 1 line  JCR  1/11/90
	$QWTOJ	(SPFORM.INI Error,<Unrecognized SWITCH ^W/T1/ found.>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
	JRST	FRMSWI			;AND LOOP

FRMS.4:	HRRZ	T3,FFNAMS(T2)		;GET DISPATCH ADDRESS
	PUSHJ	P,0(T3)			;GO!!
	JUMPF	FRMERR			;REPORT FAILURE AND GIVE UP
	JRST	FRMSWI			;AND LOOP

FRMS.5:	SKIPN	J$FPLT(J)		;SPECIAL PLOTTER SWITCHES
	JRST	FRMIEX			;NO - CLOSE FILE AND RETURN
	SKIPN	T1,J$FSPU(J)		;GET /SPU MULTIPLIER
	MOVEI	T1,1			;SOMEONE FORGOT TO PUT IT IN SPFORM.INI
	IMULM	T1,J$XORG(J)		;ADJUST X MINIMUM
	IMULM	T1,J$XMAX(J)		;ADJUST X MAXIMUM
	IMULM	T1,J$YMIN(J)		;ADJUST Y MINIMUM
	IMULM	T1,J$YMAX(J)		;ADJUST Y MAXIMUM
	MOVE	T1,J$FSPS(J)		;GET STEPS PER SECOND
	IMULI	T1,^D60			;COMPUTE STEPS PER MINUTE
	MOVEM	T1,J$PTPM(J)		;STORE IT
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,^D8			;ALLOW 8 LINES FOR TRAILER
	MOVNS	T1			;NEGATE IT
	ADDM	T1,J$XMAX(J)		;LEAVE ROOM FOR TRAILER
	JRST	FRMIEX			;CLOSE FILE AND RETURN
SUBTTL	Forms switch Subroutines


S$BANN:	SETOM	J$FBAN(J)		;SET A FLAG
	POPJ	P,			;AND RETURN

S$TRAI:	SETOM	J$FTRA(J)		;SET A FLAG
	POPJ	P,			;AND RETURN

S$HEAD:	SETOM	J$FHEA(J)		;SET A FLAG
	POPJ	P,			;AND RETURN

S$NOTE:	$TEXT(DEPBP,<Note: ^A>)		;PREFIX NOTE
S$NOT1:	$CALL	FH$CHR			;GET A CHARACTER
	JUMPF	S$NOT2			;EOF, FINISH UP!!
	CAIE	C,"/"			;STOP ON SLASH
	CAIGE	C,40			;OR CONTROL CHARACTERS
	  JRST	S$NOT2			;FINISH UP
	IDPB	C,TEXTBP		;DEPOSIT BYTE
	JRST	S$NOT1			;LOOP UNTIL DONE

S$NOT2:	$TEXT(DEPBP,<^M^J^A>)		;ADD A CRLF
	$RETT				;RETURN.
SUBTTL	Plotter only switches

S$SPS:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO
	PUSHJ	P,FH$DEC		;GET STEPS PER SECOND
	MOVEM	T1,J$FSPS(J)		;STORE IT
	$RETT				;RETURN

S$SPU:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- ERROR RETURN
	$CALL	FH$DEC			;GET STEPS PER UNIT
	MOVEM	T1,J$FSPU(J)		;AND SAVE IT
	$RETT

S$MINI:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- INVALID SWITCH
	SETZM	J$XORG(J)		;DEFAULT TO ZERO
	SETZM	J$YMIN(J)		;DITTO
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	MOVEM	T1,J$XORG(J)		;STORE X MINIMUM
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	MOVEM	T1,J$YMIN(J)		;STORE Y MINIMUM
	$RETT				;AND RETURN

S$MAXI:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- INVALID SWITCH
	MOVX	T1,.INFIN		;GET A LARGE NUMBER
	MOVEM	T1,J$XMAX(J)		;DEFAULT
	MOVEM	T1,J$YMAX(J)		;DITTO
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	MOVEM	T1,J$XMAX(J)		;STORE X MAXIMUM
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	MOVEM	T1,J$YMAX(J)		;STORE Y MAXIMUM
	$RETT				;AND RETURN
SUBTTL	I/O Subroutines for SPFORM.INI


;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. SKIPS NORMALLY, NON-SKIP ON EOF.
FH$SIX:	SETZ	T1,			;CLEAR FOR RESULT
	MOVE	T2,[POINT 6,T1]		;POINTER FOR RESULT
FH$SX1:	$CALL	FH$CHR			;GET A CHARACTER
	JUMPF	.RETF			;FAIL IF EOF
	CAIL	C,140			;LOWER CASE?
	SUBI	C,40			;YES -- CONVERT TO UPPER
	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


					;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C

FH$CHR:	MOVE	S1,J$FIFN(J)		;GET FORM FILE IFN
	$CALL	F%IBYT			;READ A BYTE
	JUMPF	.RETF			;FAIL -- ASSUME EOF
	CAIN	S2,"-"			;CONTINUED ON NEXT LINE?
	JRST	[$CALL	FH$EOL		;YES -- FIND END OF LINE
		 JRST  FH$CHR]		;AND GET NEXT CHARACTER
	MOVE	C,S2			;PUT BYTE IN CHARACTER AC
	CAIE	C,.CHTAB		;CONVERT TABS
	CAIN	C,.CHCRT		;AND CARRIAGE RETURNS
	MOVEI	C,40			;INTO SPACES
	CAIE	C,.CHFFD		;CONVERT FORM FEEDS
	CAIN	C,.CHVTB		;AND VERTICAL TABS
	MOVEI	C,.CHLFD		;INTO LINEFEED
	$RETT				;ITS NOT
;ROUTINE TO SEARCH FOR EOL IN SPFORM.INI

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


;ROUTINE TO PICK UP A DECIMAL NUMBER

FH$DEC:	SETZ	T1,			;PLACE TO ACCUMULATE RESULT
FH$DE1:	$CALL	FH$CHR			;GET A CHARACTER
	JUMPF	.RETF			;EOF, RETURN
	CAIL	C,"0"			;CHECK THE RANGE
	CAILE	C,"9"			;0-9
	  POPJ	P,			;RETURN
	IMULI	T1,12			;SHIFT A PLACE
	ADDI	T1,-"0"(C)		;ADD IN A DIGIT
	JRST	FH$DE1			;AND LOOP AROUND
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
	$CALL	.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,^D36			;USE FULL WORDS
	STORE	S1,J$XFOB+FOB.CW(J),FB.BSZ  ;AND SAVE THE BYTE SIZE
	MOVEM	S1,J$DBSZ(J)		;SAVE AS INPUT BYTESIZE
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET SENDERS PRIV BIT
	JUMPN	S1,INPO.1		;IF SET, AVOID ACCESS CHECK
	LOAD	S1,.FPINF(E),FP.SPL	;LIKEWISE IF SPOOLED
	JUMPN	S1,INPO.1		; ...

TOPS20 < HRROI	S1,.EQOWN(J)>		;GET THE OWNERS NAME ON TOPS-20
TOPS10 < LOAD	S1,.EQOID(J)>		;GET THE OWNERS NAME ON TOPS-10
	STORE	S1,J$XFOB+FOB.US(J)	;SAVE IT
TOPS20 <
	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
	$CALL	F%IOPN			;OPEN THE FILE
	JUMPF	INPO.3			;JUMP IF FAILED
	MOVEM	S1,J$DIFN(J)		;ELSE, SAVE THE IFN
	TXO	S,DSKOPN		;TURN ON FILE-OPEN FLAG
	MOVX	S2,FI.MOD		;CODE FOR MODE..
	$CALL	F%INFO			;GET MODE OF THE FILE
	MOVEM	S1,J$DMOD(J)		;STORE IT
	MOVE	S1,J$DIFN(J)		;GET THE IFN
	MOVX	S2,FI.SPL		;FOR SPOOLED NAME
	$CALL	F%INFO			;FIND IT OUT
	MOVEM	S1,J$DSPN(J)		;STORE IT
TOPS10	<
	SETZM	J$DSPX(J)		;Clear spooled file extension
	LOAD	S1,.FPINF(E),FP.REN	;GET RENAME BIT
	JUMPE	S1,.RETT		;DONE IF NOT /DISP:RENAME
	MOVE	S1,.FPONM(E)		;Get old file name
	MOVEM	S1,J$DSPN(J)		;Save as spooled file name
	MOVE	S1,.FPOXT(E)		;Get original file extension
	MOVEM	S1,J$DSPX(J)		;Save as spooled file extension
> ;End TOPS10 conditional
	$RETT				;AND RETURN

INPO.3:	MOVEI	S1,[ITEXT (<Cannot access file; ^E/[-1]/ File: ^F/@J$DFDA(J)/>)]
	$CALL	PUTERR			;AND TYPE ERROR MESSAGE
	HRRZ	S1,STREAM		;Get stream number
;**;[6002]At INPO.3:+3L change 1 line  JCR  1/11/90
	$QWTO	(Cannot access file,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]Notify operator
	$RETF
SUBTTL	INPBUF - Read a buffer from the input file

INPBUF:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	$CALL	F%IBUF			;GET A BUFFERFUL
	JUMPF	INPERR			;LOSE
	MOVEM	S1,J$DBCT(J)		;SAVE THE BYTE COUNT
	MOVEM	S2,J$DBPT(J)		;AND THE BYTE POINTER
	MOVEI	S1,^D36			;GET BITS/WORD
	IDIV	S1,J$DBSZ(J)		;GET BYTES/WORD
	IMULM	S1,J$DBCT(J)		;ADJUST BYTE COUNT ACCORDINGLY
	MOVE	S1,J$DBSZ(J)		;GET BYTE SIZE
	STORE	S1,J$DBPT(J),BP.SIZ	;AND ADJUST THE BYTE POINTER
	$RETT				;AND RETURN


SUBTTL	INPBYT - Read a byte from the input file

INPBYT:	SOSGE	J$DBCT(J)		;SKIP IF ANYTHING LEFT IN BUFFER
	JRST	INPB.1			;GET ANOTHER BUFFER
	ILDB	C,J$DBPT(J)		;GET A BYTE
	$RETT				;AND RETURN

INPB.1:	$CALL	INPBUF			;GET ANOTHER BUFFER
	JUMPF	.RETF			;LOSE (PROBABLY EOF)
	JRST	INPBYT			;AND LOOP

SUBTTL	INPERR - Handle an input failure
INPERR:	CAXN	S1,EREOF$		;WAS IT EOF?
	$RETF				;WAS JUST RETURN
	MOVEI	S1,[ITEXT (<File input error; ^E/[-1]/>)]
	$CALL	PUTERR			;AND PUT AN ERROR OUT
	TXO	S,SKPFIL		;SKIP FUTURE COPIES OF THIS FILE
	HRRZ	S1,STREAM		;Get stream number
;**;[6002]At INPERR:+6L change 1 line  JCR  1/11/90
	$QWTO	(File input error - file skipped,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]Notify operator
	$RETF				;AND RETURN


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

INPFEF:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	SETOB	S2,J$DBCT(J)		;CLEAR BYTE COUNT AND SET EOF POS
	TXNE	S,DSKOPN		;IS THE SPOOL FILE OPEN ???
	$CALL	F%POS			;YES,,POSITION IT
	$RETT				;AND RETURN

SUBTTL	INPREW - Rewind the input file

INPREW:	MOVE	S1,J$DIFN(J)		;GET THE IFN
	TXNE	S,DSKOPN		;IS THE SPOOL FILE OPEN ???
	$CALL	F%REW			;YES,,REWIND IT
	SETOM	J$DBCT(J)		;AND SET THE BYTE COUNT
	$RETT				;AND RETURN
SUBTTL	OUTGET - OPEN the output device

;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING

TOPS10 <
OUTGET:	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;GET OBJECT BLOCK ADDRESS
	MOVE	S1,OBJ.TY(S1)		;GET OBJECT TYPE
	SETZ	S2,			;AND CLEAR AN AC
	CAXN	S1,.OTPTP		;IS IT A PAPERTAPE PUNCH?
	MOVEI	S2,T$DISP		;YES!!
	CAXN	S1,.OTCDP		;NO, HOW ABOUT A CARD PUNCH?
	MOVEI	S2,C$DISP		;WIN!!
	CAXN	S1,.OTPLT		;TRY FOR A PLOTTER
	MOVEI	S2,P$DISP		;AND GET THE PLOTTER DISPATCH
	JUMPE	S2,OUTDDE		;DONT KNOW ABOUT IT
	MOVEM	S2,J$LSER(J)		;SAVE IT
	MOVEI	S1,J$LDEV(J)		;ADDRESS OF WHERE TO PUT DEVNAM
	HRLI	S1,(POINT 6,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,TEXTBP		;SAVE IT
	MOVEI	S1,6			;MAXIMUM CHARACTER COUNT
	MOVEM	S1,TEXTBC
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;GET OBJECT BLOCK ADDRESS
	$TEXT(DEP6BP,<^W3/DNAME(S2)/^O2R0/OBJ.ND(S1)/^O1/OBJ.UN(S1)/^A>)
	MOVE	T1,J$LDEV(J)		;GET THE DEVICE NAME
	DEVNAM	T1,			;GET ITS PHYSICAL NAME
	  JRST	OUTDDE			;LOSE?
	MOVEM	T1,J$LDEV(J)		;AND SAVE IT
	MOVX	T1,.IOIMG+UU.PHS+UU.AIO
					;IMAGE+PHONLY+NBIO
	MOVE	T2,J$LDEV(J)		;OUTPUT DEVICE NAME
	MOVSI	T3,J$LBRH(J)		;BUFFER HEADER
	MOVE	S1,STREAM		;GET OUR STREAM NUMBER
	MOVEM	S1,J$LJFN(J)		;SAVE AS THE STREAM NUMBER
	LSH	S1,^D23			;PUT IN THE RIGHT PLACE
	IOR	S1,[OPEN T1]		;MAKE IT AN INSTRUCTION
	XCT	S1			;AND EXECUTE IT
	   JRST	OUTDNA			;LOSE GIVE ERROR


	CONT.	(OUTGET)		;FORCE NEW LISTING PAGE
	MOVE	S1,J$LSER(J)		;GET DEVICE DISPATCH ADDRESS
	MOVE	S1,DBYTE(S1)		;GET OUTPUT BYTE SIZE
	STORE	S1,J$LBRH+1(J),BP.SIZ	;STORE IT
	MOVX	S1,PSF%OB!PSF%DO	;GET OUTPUT-BLOCKED AND DEVICE OFFLINE
	HRRZ	S2,STREAM		;AND STREAM NUMBER
	ANDCAM	S1,JOBSTW(S2)		;AND CLEAR THE CONDITIONS
	MOVE	T1,J$LJFN(J)		;LOAD CHANNEL NUMBER
	WHERE	T1,			;GET OUR STATION NUMBER
	  SETZ	T1,
	TLZ	T1,-1			;CLEAR STATION FLAGS
	CAME	T1,CNTSTA		;IS THIS CENTRAL STATION?
	SETOM	J$LREM(J)		;NO -- SET REMOTE
	MOVEI	S1,T1			;LOAD ADDRESS OF ARGBLOCK FOR DEVSIZ
	MOVX	T1,.IOIMG		;GET IMAGE MODE
	MOVE	T2,J$LJFN(J)		;GET THE CHANNEL
	DEVSIZ	S1,			;DO THE DEVSIZ
	  JRST	OUTDNA			;LOSE
	MOVEI	T1,PAGSIZ		;LOAD PAGE SIZE
	IDIVI	T1,(S1)			;GET NUMBER OF BUFFER TO CREATE
	MOVE	S1,J$LBUF(J)		;GET ADDRESS OF BUFFER PAGE
	EXCH	S1,.JBFF		;SWAP WITH JOBFF
	MOVE	S2,J$LJFN(J)		;GET CHANEL NUMBER
	LSH	S2,^D23			;POSITION IT
	IOR	S2,[OUTBUF 0(T1)]	;BUILD THE OUTBUF
	XCT	S2			;AND DO IT
	MOVEM	S1,.JBFF		;RESTORE JOBFF
	$CALL	INTCNL			;CONNECT TO INTERRUPTS
	MOVX	S1,%RSUOK		;LOAD OK CODE
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL
TOPS20 <
OUTGET:	$SAVE	<P1,P2>			;PRESERVE P1 AND P2
	HRRZ	S1,STREAM		;GET OUR STREAM
	MOVE	P1,JOBOBA(S1)		;P1 POINTS TO OUR OBJECT BLOCK
	MOVE	S1,OBJ.TY(P1)		;GET OBJECT TYPE
	SETZ	P2,			;P2 POINTS TO DISPATCH ADDRESS
	CAXN	S1,.OTCDP		;CARD PUNCH?
	MOVEI	P2,C$DISP		;YES -- LOAD DISPATCH ADDRESS
	CAXN	S1,.OTPLT		;PLOTTER ?
	MOVEI	P2,P$DISP		;YES -- LOAD DISPATCH ADDRESS
	CAXN	S1,.OTPTP		;PAPER TAPE PUNCH?
	MOVEI	P2,T$DISP		;YES -- LOAD DISPATCH ADDRESS
	JUMPE	P2,OUTDDE		;UNKNOWN OBJECT TYPE
	MOVEM	P2,J$LSER(J)		;SAVE DISPATCH ADDRESS
	MOVE	S1,[POINT 7,J$LDEV(J)]	;POINT TEXT TO DEVICE STRING
	MOVEM	S1,TEXTBP
	MOVEI	S1,^D10			;GET A STRING LENGTH
	MOVEM	S1,TEXTBC		;AND SAVE IT
	$TEXT	(DEPBP,<P^W3/DNAME(P2)/^O1/OBJ.UN(P1)/:^0>) ;FORM STRING
	MOVX	S1,GJ%FOU!GJ%SHT	;LOAD GTJFN FLAGS
	HRROI	S2,J$LDEV(J)		;POINT TO THE DEVICE STRING
	GTJFN				;AND GET A JFN
	  ERJMP	OUTDDE			;DEVICE DOESNT EXIST!!
	MOVEM	S1,J$LJFN(J)		;WIN, SAVE THE JFN
	MOVX	S2,OF%WR+OF%OFL		;GET OPENF BITS
	MOVE	T1,DBYTE(P2)		;GET DEVICE BYTE SIZE
	STORE	T1,S2,OF%BSZ		;AND STORE FOR OPENF
	OPENF				;OPEN IT
	  ERJMP	OUTDNA			;NOT AVAILBLE NOW
	HRROI	S1,J$LDEV(J)		;POINT TO ASCIZ DEVICE NAME
	$CALL	S%SIXB			;CONVERT IT TO SIXBIT
	MOVEM	S2,J$LDEV(J)		;REPLACE ASCIZ NAME
	MOVE	S1,J$LBUF(J)		;GET BUFFER PAGE ADDRESS
	HRLI	S1,440000		;MAKE POINTER WITH ZERO BYTE SIZE
	STORE	T1,S1,BP.SIZ		;STORE ACTUAL BYTE SIZE
	MOVEM	S1,J$LBPT(J)		;AND SAVE THE POINER
	MOVEM	S1,J$LIBP(J)		;AND AS INITIAL POINTER
	MOVEI	S1,^D36			;LOAD BITS/WORD
	IDIV	S1,T1			;COMPUTE BYTES/WORD
	IMULI	S1,PAGSIZ		;COMPUTE BYTES/PAGE
	MOVEM	S1,J$LBCT(J)		;AND SAVE IT
	MOVEM	S1,J$LIBC(J)		;AND AS INITIAL COUNT
	$CALL	OUTSTS			;GET DEVICE STATUS
	MOVX	S2,PSF%DO		;DEVICE OFFLINE FLAG
	HRRZ	T1,STREAM		;GET STREAM NUMBER
	ANDCAM	S2,JOBSTW(T1)		;CLEAR THE VALUE
	TXNN	S1,MO%OL		;IS IT OFF-LINE?
	JRST	OUTSOK			;NO..CONTINUE
	IORM	S2,JOBSTW(T1)		;YES, SET FLAG
	$CALL	OUTWON			;SEND THE OFFLINE MESSAGE
	JRST	OUTSOK			;CONTINUE ON OK
OUTSOK:	$CALL	INTCNL			;CONNECT UP THE DEV
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL

OUTDNA:	MOVX	S1,%RSUNA		;NOT AVAILABLE RIGHT NOW
	$RETF				;AND RETURN

OUTDDE:	MOVX	S1,%RSUDE		;NEVER AVAILABLE
	$RETF				;RETURN
SUBTTL	OUTBYT - Deposit a byte in the output buffer

;CALL WITH CHARACTER IN ACCUMULATOR 'C'.

OUTBYT:	SOSGE	J$LBCT(J)		;DECREMENT THE BYTE COUNT
	JRST	OUTB.1			;BUFFER FULL, ADVANCE IT
	IDPB	C,J$LBPT(J)		;DEPOSIT THE CHARACTER
	AOS	J$TBCT(J)		;ADVANCE TOTAL BYTE COUNT
	$RETT				;AND RETURN

OUTB.1:	$CALL	OUTOUT			;ADVANCE BUFFERS
	JRST	OUTBYT			;AND TRY AGAIN
SUBTTL	OUTOUT - Routine to output a buffer


TOPS10 <
OUTOUT:	$SAVE	<S1,S2>			;SAVE SOME ACS
OUTO.1:	MOVE	S1,STREAM		;Get our stream number
	MOVX	S2,PSF%OB		;Assume we are blocked
	IORM	S2,JOBSTW(S1)		; waiting for output done
	MOVE	S1,J$LJFN(J)		;GET THE CHANNEL NUMBER
	LSH	S1,^D23			;POSITION IT
	TLO	S1,(OUT 0,0)		;MAKE IT AN OUTPUT UUO
	XCT	S1			;AND DO IT
	 JRST	[MOVE	S1,STREAM	;We won!  Clear blocked bit
		 ANDCAM	S2,JOBSTW(S1)	; so we are runnable
		 $RETT]
OUTERR:	PUSHJ 	P,OUTSTS		;READ DEVICE STATUS
	JUMPT	[$DSCHD (0)		;ASSUME OUTPUT BLOCKED
		 JRST OUTO.1]		;RETRY OUTPUT
	$CALL	DEVERR			;PROCESS DEVICE ERROR
	JUMPT	OUTO.1			;RETRY OUTPUT IF CORRECTED
	JRST	MAIN			;STREAM IS SHUTDOWN


OUTWAT:	$CALL	OUTOUT			;OUTPUT THE BUFFER
OUTW.1:	$CALL	OUTSTS			;GET THE STATUS
	TXNN	S1,IO.ACT		;DONE?
	$RETT				;YES, RETURN
	$DSCHD	(0)			;FORCE A SCHEDULING RUN
	JRST	OUTW.1			;TRY AGAIN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTOUT:	$SAVE	<T1,T2,T3,T4>		;PRESERVE TEMPORARIES
	MOVE	S1,J$LJFN(J)		;GET DEV JFN
	MOVE	S2,J$LIBP(J)		;GET POINTER TO BUFFER
	SKIPGE	T1,J$LBCT(J)		;GET REMAINING BYTE COUNT
	SETZ	T1,			;MUST BE .GE. 0
	SUB	T1,J$LIBC(J)		;GET NEG. BYTE COUNT
	JUMPE	T1,OUTO.2		;DONE -- RESET BUFFER HEADER
OUTO.1:	HRRZ	T2,STREAM		;GET STREAM
	SETOM	J$LIOA(J)		;SET I/O ACT
	SKIPE	JOBSTW(T2)		;BLOCKED?
	 JRST	OUTINT			;YES -- POSTPONE SOUT
	SOUTR				;DUMP THE BUFFER
	  ERJMP	OUTERR			;PROCESS ERROR
OUTO.2:	SETZM	J$LIOA(J)		;CLEAR I/O ACT
	MOVE	S1,J$LIBC(J)		;GET INITIAL BYTE COUNT
	MOVEM	S1,J$LBCT(J)		;RESET BUFFER COUNT
	MOVE	S1,J$LIBP(J)		;GET INITIAL BYTE POINTER
	MOVEM	S1,J$LBPT(J)		;RESET BUFFER POINTER
	HRRZ	T1,J$LIBP(J)		;GET START ADDRESS OF BUFFER
	HRLZ	T2,T1			;COPY IT
	HRRI	T2,1(T1)		;MAKE A BLT POINTER
	SETZM	(T1)			;CLEAR THE FIRST WORD
	BLT	T2,PAGSIZ-1(T1)		;CLEAR THE BUFFER
	$DSCHD	(PSF%NP)		;PICK UP AGAIN AFTER SCHEDULE
	$RETT				;AND FINALLY RETURN

OUTERR:	SETOM	J$LIOE(J)		;SET ERROR FLAG
OUTINT:	SETZM	J$LIOA(J)		;CLEAR IO ACTIVE
	MOVEM	S2,J$LBPT(J)		;SAVE THE CURRENT POINTER
	MOVEM	T1,J$LBCT(J)		;SAVE NUMBER OF CHARACTERS LEFT
	SKIPE	JOBSTW(J)		;DEVICE OFF-LINE?
	$CALL	OUTWON			;POSSIBLY.  GO CHECK
	SKIPE	J$LIOE(J)		;ERROR?
	$CALL	OUTSTS			;READ DEVICE STATUS
	SKIPT				;ERROR?
	$CALL	DEVERR			;YES -- PROCESS IT
	JUMPF	MAIN			;STREAM HAS BEEN SHUTDOWN
	MOVE	S1,J$LJFN(J)		;RESTORE DEVICE JFN
	MOVE	S2,J$LBPT(J)		;RESTORE POINTER
	MOVE	T1,J$LBCT(J)		;RESTORE COUNT
	JRST	OUTO.1			;RESTART SOUT

>  ;END TOPS20 CONDITIONAL
SUBTTL	DEVERR - Handle Output Device Errors

DEVERR:	MOVE	S1,J$LIOS(J)		;GET IO STATUS
	MOVE	S2,J$LSER(J)		;GET ADDRESS OF SERVICE ROUTINES
	PUSHJ	P,DERR(S2)		;DO ERROR ROUTINE
	JUMPT	.POPJ			;ERROR CORRECTED -- RETURN
	
	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
;**;[6002]At DEVERR:+6L change 1 line  JCR  1/11/90
	$QWTO	(Device I/O Error,^R/.EQJBB(J)/,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
	JRST	SHUTUP			;SHUT IT DOWN AND GO TO MAIN

;OUTSTS reads the device status into location J$LIOS  and into
;	accumulator S1.

TOPS10 <
OUTSTS:	MOVE	S1,J$LJFN(J)		;GET DEVICE CHANNEL
	LSH	S1,^D23			;POSITION IT
	IOR	S1,[GETSTS J$LIOS(J)]	;FORM GETSTS
	XCT	S1			;AND DO IT
	MOVE	S1,J$LIOS(J)		;GET THE STATUS
	TXNE	S1,IO.ERR		;ACTUAL ERROR?
	  $RETF				;YES -- GIVE FALSE RETURN
	$RETT				;RETURN TO CALLER
> ;END TOPS10 CONDITIONAL

TOPS20 <
OUTSTS:	$SAVE	<T1,T2,T3,T4>		;SAVE T1-T4
	MOVE	S1,J$LJFN(J)		;GET DEV JFN
	MOVX	S2,.MORST		;READ STATUS FUNCTION
	MOVEI	T1,T2			;ADDRESS OF ARG BLOCK
	MOVEI	T2,3			;LENGTH OF ARG BLOCK
	SETZB	T3,T4			;CLEAR ANSWER
	MTOPR				;GET THE STATUS
	  ERJMP	.+1			;IGNORE THE ERROR
	DMOVEM	T3,J$LIOS(J)		;SAVE THE ERROR STATUS
	MOVE	S1,T3			;COPY THE STATUS TO S1
	TXNE	S1,MO%RLD+MO%FER+MO%SER+MO%HE ;ACTUAL ERROR?
	  $RETF				;YES -- GIVE FALSE RETURN
	$RETT				;NO -- GIVE TRUE RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL	OUTREL - Release output device

TOPS10 <
OUTREL:	MOVE	S1,J$LJFN(J)		;GET THE CHANNEL NUMBER
	LSH	S1,^D23			;SHIFT IT OVER
	TLO	S1,(RELEAS)		;MAKE A RELEASE UUO
	XCT	S1			;EXECUTE IT
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTREL:	MOVE	S1,J$LJFN(J)		;GET THE JFN
	CLOSF				;RELEASE THE DEVICE
	  $RETF				;ERROR..RETURN FALSE
	$RETT

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


TOPS10 <
OUTWON:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
	$WTO	(Device went off-line,,@JOBOBA(S1))
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$DSCHD(0)			;BLOCK FOR DEVICE ON-LINE
	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
	HRRZ	S1,STREAM		;AND THE STREAM NUMBER
	TDNN	S2,JOBSTW(S1)		;IS IT OFF-LINE?
	POPJ	P,			;NO, JUST RETURN
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
;**;[6002]At OUTWON:+5L change 1 line  JCR  1/11/90
	$QWTO	(Device went off-line,,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]
	$DSCHD(0)			;BLOCK FOR DEVICE ONLINE
	POPJ	P,			;NO, RETURN
>  ;END TOPS20 CONDITIONAL
SUBTTL	OUTFLS Routine to flush output buffers

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

TOPS10 <
OUTFLS:	PUSHJ	P,INTDCL		;DISCONNECT DEVICE INTERRUPTS
	MOVE	S1,J$LJFN(J)		;LOAD THE CHANNEL NUMBER
	RESDV.	S1,			;RESET THE CHANNEL
	  JFCL				;??
	PJRST	OUTGET			;AND REINIT THE LPT
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTFLS:	$SAVE	<T1>			;PRESERVE AN AC
	MOVE	S1,J$LJFN(J)		;GET OUTPUT JFN
	MOVX	S2,.MOFLO		;LOAD FLUSH FUNCTION
	MOVEI	T1,0			;AND ZERO ARGUMENTS
	MTOPR				;FLUSH THE BUFFERS
	 ERCAL	OUTF.1			;ON AN ERROR,,SHUT IT DOWN AND RESET IT
	MOVE	S1,J$LIBC(J)		;INITIAL WORDS IN BUFFER
	MOVEM	S1,J$LBCT(J)		;RESET BUFFER COUNT
	MOVE	S1,J$LIBP(J)		;GET INITIAL POINTER
	MOVEM	S1,J$LBPT(J)		;AND SAVE IT
	MOVEI	S1,%RSUOK		;LOAD GOOD RETURN CODE
	$RETT				;RETURN

OUTF.1:	MOVX	S1,CZ%ABT		;GET THE ABORT BITS.
	ADD	S1,J$LJFN(J)		;ADD THE JFN
	CLOSF				;CLOSE THE DEVICE
	ERJMP 	.+1			;IGNORE AN ERROR
	PJRST	OUTGET			;SET THE DEVICE UP AGAIN
>  ;END TOPS20 CONDITIONAL
SUBTTL	Card punch service -- Dispatch table


C$DISP:	JRST	C$HEAD			;(0) FILE HEADER
	JRST	C$EOF			;(1) FILE TRAILER
	SIXBIT	/CDP/			;(2) GENERIC DEVICE NAME
	EXP	^D12			;(3) OUTPUT BYTE SIZE
	JRST	C$PROC			;(4) PROCESS A FILE
	JRST	C$BANN			;(5) JOB BANNER
	JRST	C$TRAI			;(6) JOB TRAILER
	JRST	C$LETR			;(7) LETTER DEVICE
	JRST	.RETF			;(10) ERROR PROCESSOR
	JRST	.RETT			;(11) ACCOUNTING
	JRST	C$CHKP			;(12) CHECKPOINT TEXT GENERATION
SUBTTL	Card punch service -- Checkpoint text generation


C$CHKP:	$SAVE	<P1,P2>			;SAVE SOME ACS
	MOVE	P1,J$APRT(J)		;GET CARD COUNT
	MOVE	P2,J$RLIM(J)		;GET LIMIT
	CAMN	P2,[.INFIN]		;+INFINITY ?
	JRST	C$CHK1			;YES
	CAMG	P1,J$RLIM(J)		;OPERATOR ALLOW LIMIT TO EXCEED ?
	$TEXT	(DEPBP,<punched ^D/P1/ of ^D/J$RLIM(J)/ cards^0>)
	CAMLE	P1,J$RLIM(J)		;OPERATOR ALLOW LIMIT TO EXCEED ?
C$CHK1:	$TEXT	(DEPBP,<punched ^D/P1/ cards (limit exceeded)^0>)
	POPJ	P,			;RETURN
SUBTTL	Card punch service -- File processing


C$PROC:	LOAD	S1,.FPINF(E),FP.FPF	;GET PAPER FORMAT
	CAILE	S1,CDROUL		;WITHIN RANGE?
	JRST	BADMOD			;NO, LOSE
	JUMPN	S1,@C$ROUT-1(S1)	;YES, DISPATCH IF NON-ZERO
	MOVEI	S1,C$MTAB		;GET ADDRESS OF MODE TABLE
	MOVEI	S2,C$ROUT		;GET ADDRESS OF ROUTINE TABLE
	PJRST	DSPMOD			;AND DISPATCH BASED ON MODE



;TABLE OF processing ROUTINES
C$ROUT:	EXP	CDASC			;ASCII
	EXP	CD026			;026
	EXP	CDBIN			;CHECKSUMMED BINARY
	EXP	CDASC			;ASCII
	EXP	CDIMA			;IMAGE AND IMAGE BINARY

	CDROUL==.-C$ROUT		;LENGTH OF ROUTINE TABLE

;MODE TABLE
C$MTAB:	BYTE (3) 1,1,0,0,0,0,0,0,5,0,0,5,3,0,3,3
;	!              CARD-PUNCH MODE  --  IMAGE               !
;	!                                                       !
;	!    In IMAGE mode, each group of 27 (decimal) words    !
;	!    read from disk is divided into 81 12-bit bytes     !
;	!   the first 80 of which are punched one per column,   !
;	!               and the 81st is ignored.                !
;	!                                                       !
;	!=======================================================!
;	!    Column 1     !     Column 2     !     Column 3     !
;	!-------------------------------------------------------!
;	!    Column 4     !     Column 5     !     Column 6     !
;	!-------------------------------------------------------!
;	!                                                       !
;	\                           .                           \
;	\                           .                           \
;	\                           .                           \
;	!                                                       !
;	!-------------------------------------------------------!
;	!    Column 76    !    Column 77     !    Column 78     !
;	!-------------------------------------------------------!
;	!    Column 79    !    Column 80     !     Ignored      !
;	!=======================================================!


CDIMA:	MOVEI	T1,^D12			;GET 12 BIT BYTES FROM DISK
	MOVEM	T1,J$DBSZ(J)		;SAVE BYTE-SIZE
CDIM.1:	MOVEI	T2,CPC			;SET UP COL COUNTER
CDIM.2:	$CALL	INPBYT			;GET A CHARACTER
	JUMPF	CDIM.3			;FINISH CARD AT EOF
	PUSHJ	P,CDPBYT		;PUNCH IT
	SOJG	T2,CDIM.2		;JUMP IF CARD NOT FULL
	$CALL	OUTCDP			;IF FULL,OUTPUT CARD
	$CALL	INPBYT			;IGNORE BYTE 81
	JUMPF	.RETT			;THIS SHOULD NEVER REALLY HAPPEN!!
	JRST	CDIM.1			;AND THEN LOOP FOR MORE

CDIM.3:	CAIE	T2,CPC			;IS THERE ANYTHING ON THE CARD?
	$CALL	OUTCDP			;YES, FORCE OUT PARTIAL CARD
	$RETT				;RETURN
;	!              CARD-PUNCH MODE  --  BINARY              !
;	!                                                       !
;	! In BINARY mode, each group of 26 (decimal) words read !
;	!  from disk (fewer for last buffer) is split into 78   !
;	! 12-bit bytes and punched one byte per column starting !
;	!  in column 3 and continuing to column 80.  Column 1   !
;	!contains the actual word count in rows 12 through 3 and!
;	!   rows 7 and 9 punched.  Column 2 contains a 12-bit   !
;	!                   folded checksum.                    !
;	!                                                       !
;	!=======================================================!
;	!Byte 1 - Column 3!Byte 2 - Column 4 !Byte 3 - Column 5 !
;	!-------------------------------------------------------!
;	!Byte 4 - Column 6!Byte 5 - Column 7 !Byte 6 - Column 8 !
;	!-------------------------------------------------------!
;	!                                                       !
;	\                           .                           \
;	\                           .                           \
;	\                           .                           \
;	!                                                       !
;	!-------------------------------------------------------!
;	!Byte 76-Column 78!Byte 77-Column 79 !Byte 78-Column 80 !
;	!=======================================================!


CDBIN:	MOVEI	S1,^D26			;LOAD MAXIMUM BLOCK SIZE
	$CALL	CHKSUM			;GET A CHECKSUMMED BLOCK
	JUMPF	.RETT			;DONE ON EOF
	DMOVE	T1,S1			;SAVE THE RETURNED VALUES
	MOVE	C,S1			;GET THE BLOCKSIZE
	LSH	C,6			;PUT IN HIGH 6 OF 12 BITS
	IORI	C,5			;ADD ROWS 7 AND 9
	PUSHJ	P,CDPBYT		;AND PUNCH COLUMN 1
	MOVE	C,T2			;GET THE CHECKSUM
	PUSHJ	P,CDPBYT		;AND PUNCH COLUMN 2
	IMULI	T1,3			;CONVERT WORDS TO COLUMNS
	MOVE	T2,[POINT 12,J$XCHB(J)]	;LOAD A BYTE POINTER

CDBI.1:	ILDB	C,T2			;GET A BYTE
	PUSHJ	P,CDPBYT		;PUNCH IT
	SOJG	T1,CDBI.1		;LOOP FOR THE BLOCK
	$CALL	OUTCDP			;FORCE  OUT THE CARD
	JRST	CDBIN			;AND LOOP
;	!           CARD-PUNCH MODE  --  ASCII & 026            !
;	!                                                       !
;	!   In ASCII and 026 modes, each word read from disk    !
;	! is treated as 5 7-bit ASCII characters, each of which !
;	!  is converted to the appropriate Hollerith code and   !
;	!              punched in one card column.              !
;	!                                                       !
;	!=======================================================!
;	! Byte 1  ! Byte 2  ! Byte 3  ! Byte 4  ! Byte 5  !     !
;	!=======================================================!


CDASC:	SKIPA	T1,[MOVE C,TBLASC(T2)]	;GET CORRECT TABLE ENTRY
CD026:	MOVE	T1,[MOVE C,TBL026(T2)]	;GET 026 ENTRY
	MOVEM	T1,J$XCD1(J)		;AND SAVE FOR LATER EXECUTION
	MOVEI	T1,7			;READ 7 BIT BYTES FROM DISK
	MOVEM	T1,J$DBSZ(J)		;SAVE BYTE SIZE

CDAS.1:	MOVEI	T1,0			;START IN COLUMN 0
CDAS.2:	$CALL	INPBYT			;GET A BYTE
	JUMPF	CDAS.5			;EOF, FINISH UP
	JUMPE	C,CDAS.2		;IGNORE NULLS
	CAIN	C,.CHCRT		;IS IT A CARRIAGE RETURN?
	MOVEI	C," "			;YES, MAKE IT A SPACE
	CAIN	C,.CHLFD		;IS IT A LINEFEED?
	JRST	CDAS.6			;YES, ON TO NEXT CARD
	CAIN	C,.CHTAB		;IS IT A VERTICAL TAB?
	JRST	CDAS.3			;YES, GO HANDLE IT
	$CALL	CDAS.4			;ELSE, JUST PUNCH
	JRST	CDAS.2			;AND LOOP

CDAS.3:	MOVEI	C," "			;LOAD A SPACE
	$CALL	CDAS.4			;AND PUNCH IT
	TRNE	T1,7			;AT A TAB STOP?
	JRST	CDAS.3			;NO, LOOP
	JRST	CDAS.2			;YES, NEXT CHARACTER

CDAS.4:	CAIL	T1,CPC			;PUNCH 80 YET?
	AOJA	T1,.RETT		;YES, IGNORE THE CHARACTER
	MOVE	T2,C			;GET CHAR IN T2
	IDIVI	T2,3			;GET THE OFFSET INTO TABLE IN T2
	XCT	J$XCD1(J)		;GET THE CORRECT WORD
	IMULI	T3,^D12			;MULT REMAINDER BY 12 FOR SHIFT
	LSH	C,-^D24(T3)		;AND GET DESIRED BYTE
	PUSHJ	P,CDPBYT		;PUNCH IT
	AOJA	T1,.RETT		;INCREMENT AND RETURN

CDAS.5:	JUMPE	T1,.RETT		;EOF ON EMPTY CARD, JUST RETURN
CDAS.6:	MOVEI	C,0			;ELSE, LOAD A SPACE
	SKIPN	T1			;SKIP IF SOMETHING ON THE CARD ALREADY
	PUSHJ	P,CDPBYT		;ELSE, PUT SOMETHING IN THE BUFFER
	$CALL	OUTCDP			;FORCE OUT THE CARD
	JRST	CDAS.1			;AND ON TO THE NEXT CARD
;CAST OF CHARACTERS IN IMAGE FORMAT INDEXED BY ASCII VALUE

TBLASC:	BYTE (12)	5403,4401,4201	;NULL ^A ^B
	BYTE (12)	4101,0005,1023	;^C ^D ^E
	BYTE (12)	1013,1007,2011	;^F ^G ^H
	BYTE (12)	4021,1021,4103	;TAB LF VT
	BYTE (12)	4043,4023,4013	;FF CR ^N
	BYTE (12)	4007,6403,2401	;^O ^P ^Q
	BYTE (12)	2201,2101,0043	;^R ^S ^T
	BYTE (12)	0023,0201,1011	;^U ^V ^W
	BYTE (12)	2003,2403,0007	;^X ^Y ^Z
	BYTE (12)	1005,2043,2023	;^[ ^\ ^]
	BYTE (12)	2013,2007,0000	;^^ ^_ SPACE
	BYTE (12)	4006,0006,0102	;! " #
	BYTE (12)	2102,1042,4000	;$ % &
	BYTE (12)	0022,4022,2022	;' ( )
	BYTE (12)	2042,4012,1102	;* + ,
	BYTE (12)	2000,4102,1400	;- . /
	BYTE (12)	1000,0400,0200	;0 1 2
	BYTE (12)	0100,0040,0020	;3 4 5
	BYTE (12)	0010,0004,0002	;6 7 8
	BYTE (12)	0001,0202,2012	;9 : ;
	BYTE (12)	4042,0012,1012	;< = >
	BYTE (12)	1006,0042,4400	;? @ A
	BYTE (12)	4200,4100,4040	;B C D
	BYTE (12)	4020,4010,4004	;E F G
	BYTE (12)	4002,4001,2400	;H I J
	BYTE (12)	2200,2100,2040	;K L M
	BYTE (12)	2020,2010,2004	;N O P
	BYTE (12)	2002,2001,1200	;Q R S
	BYTE (12)	1100,1040,1020	;T U V
	BYTE (12)	1010,1004,1002	;W X Y
	BYTE (12)	1001,4202,1202	;Z [ \
	BYTE (12)	2202,2006,1022	;] ^ _
;FOLLOWING ALPHABETICS ARE SMALL LETTERS
	BYTE (12)	0402,5400,5200	;' A B
	BYTE (12)	5100,5040,5020	;C D E
	BYTE (12)	5010,5004,5002	;F G H
	BYTE (12)	5001,6400,6200	;I J K
	BYTE (12)	6100,6040,6020	;L M N
	BYTE (12)	6010,6004,6002	;O P Q
	BYTE (12)	6001,3200,3100	;R S T
	BYTE (12)	3040,3020,3010	;U V W
	BYTE (12)	3004,3002,3001	;X Y Z
	BYTE (12)	5000,6000,3000	;
	BYTE (12)	3400,0000,0000	;
;CAST OF CHARACTERS IN IMAGE FORMAT INDEXED BY ASCII VALUE

TBL026:	BYTE (12)	5403,4401,4201	;NULL ^A ^B
	BYTE (12)	4101,0003,1023	;^C ^D ^E
	BYTE (12)	1013,1007,2011	;^F ^G ^H
	BYTE (12)	4021,1021,4103	;TAB LF VT
	BYTE (12)	4043,4023,4013	;FF CR ^N
	BYTE (12)	4007,6403,2401	;^O ^P ^Q
	BYTE (12)	2201,2101,0013	;^R ^S ^T
	BYTE (12)	0023,0201,0011	;^U ^V ^W
	BYTE (12)	2003,2403,0007	;^X ^Y ^Z
	BYTE (12)	1005,2043,2023	;^[ ^\ ^]
	BYTE (12)	2013,2007,0000	;^^ ^_ SPACE
	BYTE (12)	4006,1022,1012	;! " #
	BYTE (12)	2102,1006,2006	;$ % &
	BYTE (12)	0012,1042,4042	;' ( )
	BYTE (12)	2042,4000,1102	;* + ,
	BYTE (12)	2000,4102,1400	;- . /
	BYTE (12)	1000,0400,0200	;0 1 2
	BYTE (12)	0100,0040,0020	;3 4 5
	BYTE (12)	0010,0004,0002	;6 7 8
	BYTE (12)	0001,2202,1202	;9 : ;
	BYTE (12)	4012,0102,2012	;< = >
	BYTE (12)	4202,0042,4400	;? @ A
	BYTE (12)	4200,4100,4040	;B C D
	BYTE (12)	4020,4010,4004	;E F G
	BYTE (12)	4002,4001,2400	;H I J
	BYTE (12)	2200,2100,2040	;K L M
	BYTE (12)	2020,2010,2004	;N O P
	BYTE (12)	2002,2001,1200	;Q R S
	BYTE (12)	1100,1040,1020	;T U V
	BYTE (12)	1010,1004,1002	;W X Y
	BYTE (12)	1001,2022,0006	;Z [ \
	BYTE (12)	4022,0022,0202	;] ^ _
					;FOLLOWING ALPHABETICS ARE SMALL LETTERS
	BYTE (12)	0402,5400,5200	;' A B
	BYTE (12)	5100,5040,5020	;C D E
	BYTE (12)	5010,5004,5002	;F G H
	BYTE (12)	5001,6400,6200	;I J K
	BYTE (12)	6100,6040,6020	;L M N
	BYTE (12)	6010,6004,6002	;O P Q
	BYTE (12)	6001,3200,3100	;R S T
	BYTE (12)	3040,3020,3010	;U V W
	BYTE (12)	3004,3002,3001	;X Y Z
	BYTE (12)	5000,6000,3000	;
	BYTE (12)	3400,0000,0000	;
SUBTTL	Card punch service -- File headers


C$HEAD:	SKIPN	J$FHEA(J)		;HEADER ALLOWED?
	$RETT				;NO -- RETURN
	LOAD	S1,.FPINF(E),FP.NFH	;GET NO FILE HEADER BIT
	JUMPN	S1,.RETT		;RETURN IF NOT WANTED
	MOVEI	C,4001			;SPECIAL MASK FOR FILE CARDS
	MOVEM	C,J$CMSK(J)		;SAVE FOR C$LETR
	MOVE	S1,J$DFDA(J)		;POINT TO FD
	SKIPN	S2,J$DSPN(J)		;SPOOL NAME?

TOPS10<	MOVE	S2,.FDNAM(S1) >		;NO -- USE FILE NAME

TOPS20<
	MOVX	S1,GJ%SHT!GJ%OFG	;PARSE ONLY, SHORT JFN
	MOVE	S2,J$DFDA(J)		;GET FD ADDRESS
	HRROI	S2,.FDSTG(S2)		;POINT TO START OF FILESPEC
	GTJFN				;GET A JFN
	  ERJMP	.POPJ			;ASSUME A SPOOLED FILE
	MOVE	S2,[POINT 7,FILNAM]	;POINT TO FILENAME STORAGE
	EXCH	S1,S2			;S1:= POINTER, S2:= JFN
	MOVE	T1,[FILNAM,,FILNAM+1]	;SET UP BLT
	SETZM	FILNAM			;CLEAR THE FIRST WORD
	BLT	FILNAM+7		;CLEAR THE ENTIRE BLOCK
	MOVX	T1,1B8			;WANT FILENAME ONLY
	JFNS				;GET IT
	HRROI	S1,FILNAM		;POINT TO THE FILENAME
	$CALL	S%SIXB			;CONVERT TO SIXBIT
>

	MOVEI	S1,[ITEXT<^W6/S2/>]	;POINT TO NAME
	PJRST	C$WORD			;PUNCH CARD AND RETURN
SUBTTL	Card punch service -- File trailers


C$EOF:	MOVEI	S1,^D80			;PUNCH EOF CARD
	MOVEI	C,7417			;TOP FOUR AND BOTTOM FOUR ROWS
	PUSHJ	P,CDPREP		;PUNCH EOF CARDS
	PJRST	OUTOUT			;FORCE OUTPUT
SUBTTL	Card punch service -- Banners


C$BANN:	SKIPN	J$FBAN(J)		;GET COUNT OF BANNER CARDS
	$RETT				;RETURN IF ZERO
	MOVEI	C,4003			;MASK FOR JOB CARDS
	MOVEM	C,J$CMSK(J)		;SAVE FOR C$LETR
	MOVEI	S1,[ITEXT<BEGIN:>]
	PJRST	CTRA.1			;FALL INTO COMMON CODE

C$TRAI:	SKIPN	J$FTRA(J)		;GET TRAILER COUNT
	$RETT				;RETURN IF ZERO
	MOVEI	C,4003			;MASK FOR JOB CARDS
	MOVEM	C,J$CMSK(J)		;SAVE FOR C$LETR
	MOVEI	S1,[ITEXT<END:  >]
CTRA.1:	$CALL	C$WORD
	MOVEI	S1,[ITEXT<^W6/.EQJOB(J)/>]
	$CALL	C$WORD
	MOVEI	S1,[ITEXT <REQ-ID >]
	PUSHJ	P,C$WORD
	MOVEI	S1,[ITEXT<#^D5R0/.EQJBB+JIB.ID(J)/>] ;REQUEST ID
	$CALL	C$WORD
	MOVEI	S1,[ITEXT<USER: >]
	$CALL	C$WORD
	$CALL	SETTBF			;POINT TO TEXT BUFFER

TOPS10	<				;TOPS-10 ONLY
	MOVEI	S1,[ITEXT <^W6/.EQJBB+JIB.NM(J)/>] ;USER NAME (WORD 1)
	PUSHJ	P,C$WORD		;PUNCH IT
	MOVEI	S1,[ITEXT <^W6/.EQJBB+JIB.NM+1(J)/>] ;USER NAME (WORD 2)
	PUSHJ	P,C$WORD		;PUNCH IT
	MOVEI	S1,[ITEXT <^O6R /.EQOID(J),LHMASK/>] ;PROJECT NUMBER
	PUSHJ	P,C$WORD		;PUNCH IT
	MOVEI	S1,[ITEXT <^O6L /.EQOID(J),RHMASK/>] ;PROGRAMMER NUMBER
	PUSHJ	P,C$WORD		;PUNCH IT
>					;END TOPS-10 CONDITIONAL

TOPS20	<
	MOVE	TF,[POINT 6,FILNAM]	;GET BYTE POINTER
	MOVEM	TF,TEXTBP		;STORE THE BYTE POINTER
	MOVEI	TF,TXT$LN*^D12		;GET BYTE COUNT
	MOVEM	TF,TEXTBC		;AND SAVE IT
	SETZM	FILNAM+0		;CLEAR A WORD
	SETZM	FILNAM+1		;CLEAR ANOTHER WORD
	$TEXT	(DEP6BP,<^T/.EQOWN(J)/^A>) ;ALLOW UP TO 12 CHARACTER NAMES
	MOVEI	S1,[ITEXT <^W6/FILNAM+0/>] ;WORD 1
	PUSHJ	P,C$WORD		;OUTPUT IT
	MOVEI	S1,[ITEXT <^W6/FILNAM+1/>] ;WORD 2
	SKIPE	FILNAM+1		;IS THERE A SECOND WORD?
	PUSHJ	P,C$WORD		;OUTPUT IT
	PUSHJ	P,SETTBF		;RESET BYTE POINTER AND COUNT
>

	GETLIM	T1,.EQLIM(J),NOT1	;GET /NOTE VALUE (WORD 1)
	GETLIM	T2,.EQLIM(J),NOT2	;GET /NOTE VALUE (WORD 2)
	SKIPN	T1			;RETURN IF BOTH
	JUMPE	T2,.RETT		; WORDS ARE ZERO
	MOVEI	S1,[ITEXT<NOTE: >]
	PUSHJ	P,C$WORD		;PUNCH IT
	GETLIM	T1,.EQLIM(J),NOT1	;GET /NOTE VALUE (WORD 1)
	MOVEI	S1,[ITEXT<^W6/T1/>]
	PUSHJ	P,C$WORD		;PUNCH IT
	GETLIM	T1,.EQLIM(J),NOT2	;GET /NOTE VALUE (WORD 2)
	JUMPE	T1,.RETT		;RETURN IF NO SECOND WORD
	MOVEI	S1,[ITEXT<^W6/T1/>]
	PJRST	C$WORD			;PUNCH LAST CARD AND RETURN
SUBTTL	Card punch service -- Word punching


;C$WORD
;Call	S1/ Address of Itext to punch as 6 Character word on card
;  Also J$CMSK Specifies Extra Rows to punch with Characters


C$WORD:	$CALL	SETTBF			;SET POINTERS TO TEXT BUFFER
	$TEXT(DEPBP,<^I/(S1)/^0>)	;STORE STRING IN BUFFER
	MOVEI	S1,0			;GET A NULL
	DPB	S1,[POINT 7,J$XTBF+1(J),13] ;TRUNCATE TO SIX CHARACTERS
	MOVEI	C,3776			;FIRST COLUMN WITH ROUNDED CORNERS
	PUSHJ	P,CDPBYT
	MOVEI	C,7777			;SECOND COLUMN FULLY LACED
	PUSHJ	P,CDPBYT
	MOVEI	S1,3			;NEXT 3 COLUMNS WITH SPECIAL MASK
	MOVE	C,J$CMSK(J)
	PUSHJ	P,CDPREP
	$CALL	STRING			;COLUMNS 6-77 FOR CHARACTERS
	MOVE	C,J$CMSK(J)		;COLUMN 78 SPECIAL MASK
	PUSHJ	P,CDPBYT
	MOVEI	C,7777			;COLUMN 79 FULLY LACED
	PUSHJ	P,CDPBYT
	MOVEI	C,3776			;COLUMN 80 ROUNDED CORNERS
	PUSHJ	P,CDPBYT
	PJRST	OUTOUT			;PUNCH CARD AND RETURN
SUBTTL	Card punch service -- Letters


;C$LETR
;Call with Ascii character to Punch in S1
;Punches Characters as 10 12 bit Frames followed by 2 blank frames
;Character is Punched in Rows 0 thru 6.  The Contents of J$CMSK is
;ORED with the Column Punch to identify the Card as a Job or File card.

C$LETR:	CAIL	S1,40			;CAN WE PUNCH THIS CHARACTER?
	CAILE	S1,177
	 POPJ	P,0			;NO -- RETURN
	CAILE	S1,"_"			;UPPER CASE ?
	SUBI	S1,40			;NO -- CONVERT TO UPPER
	MOVEI	S1,CHRTAB-40(S1)	;POINT TO CHARACTER BITS
	HRLI	S1,(POINT 7,0)		;MAKE BYTE POINTER
	MOVSI	S2,-5			;PUNCH AS 5 DUPLICATED FRAMES
CLET.1:	ILDB	C,S1			;GET SEGMENT BITS
	LSH	C,3			;CENTER ON CARD
	IOR	C,J$CMSK(J)		;INCLUDE MASK FOR SPECIAL ROWS
	PUSHJ	P,CDPBYT		;PUNCH FIRST FRAME
	PUSHJ	P,CDPBYT
	AOBJN	S2,CLET.1		;REPEAT 10 FRAMES
	MOVEI	S1,2
	MOVE	C,J$CMSK(J)		;PUNCH SPECIAL ROWS
	PJRST	CDPREP			;PUNCH CARDS AND RETURN
SUBTTL	Card punch service -- Byte output


; AC 'C' contains the byte to output
;
CDPBYT:	PJRST	OUTBYT			;OUTPUT THE BYTE


; Force card out
;
OUTCDP:	PUSHJ	P,OUTOUT		;FORCE CARD OUT
	AOS	S1,J$APRT(J)		;COUNT ANOTHER ONE
	CAMLE	S1,J$RLIM(J)		;OVER LIMIT?
	PUSHJ	P,FRMLEX		;HANDLE LIMIT EXCEEDED
	POPJ	P,			;RETURN


; Repeat the byte in AC 'C'
; Call:	MOVE	S1,repeat count
;	MOVE	C,byte to output
;	PUSHJ	P,CDPREP
;
CDPREP:	PUSH	P,P1			;SAVE P1
	MOVE	P1,S1			;GET COUNT
	PUSHJ	P,PTPBYT		;OUTPUT A BYTE
	SOJG	P1,.-1			;AND LOOP
	POP	P,P1			;RESTORE P1
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Dispatch table


P$DISP:	JRST	P$HEAD			;(0) FILE HEADER
	JRST	P$EOF			;(1) FILE TRAILER
	SIXBIT	/PLT/			;(2) GENERIC DEVICE NAME
	EXP	^D6			;(3) OUTPUT BYTE SIZE
	JRST	P$PROC			;(4) PROCESS A FILE
	JRST	P$BANN			;(5) JOB BANNER
	JRST	P$TRAI			;(6) JOB TRAILER
	JRST	P$LETR			;(7) LETTER PROCESSER
	JRST	P$DERR			;(10) DEVICE ERROR PROCESSOR
	JRST	.RETT			;(11) ACCOUNTING
	JRST	P$CHKP			;(12) CHECKPOINT TEXT GENERATION
SUBTTL	Plotter service -- Checkpoint text generation


P$CHKP:	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	MOVE	P1,J$PTIC(J)		;GET # TICS FOR JOB
	IDIV	P1,J$PTPM(J)		;T1:= MINUTES, T2:= FRACTION
	IMULI	P2,^D1000		;MAKE IT DECIMAL
	IDIV	P2,J$PTPM(J)		;T2:= DECIMAL FRACTION OF A MINUTE
	MOVE	P3,J$RLIM(J)		;GET LIMIT
	CAMN	P3,[.INFIN]		;+INFINITY ?
	JRST	P$CHK1			;YES
	CAMG	P1,J$RLIM(J)		;OPERATOR ALLOW LIMIT TO EXCEED ?
	$TEXT	(DEPBP,<plotted ^D/P1/.^D3L0/P2/ of ^D/J$RLIM(J)/ minutes^0>)
	CAMLE	P1,J$RLIM(J)		;OPERATOR ALLOW LIMIT TO EXCEED ?
P$CHK1:	$TEXT	(DEPBP,<plotted ^D/P1/.^D3L0/P2/ minutes (limit exceeded)^0>)
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- File processing


P$PROC:	LOAD	S1,.FPINF(E),FP.FPF	;GET PAPER FORMAT
	CAILE	S1,PLROUL		;WITHIN RANGE?
	JRST	BADMOD			;NO, LOSE
	JUMPN	S1,@P$ROUT-1(S1)	;YES, DISPATCH IF NON-ZERO
	MOVEI	S1,P$MTAB		;GET ADDRESS OF MODE TABLE
	MOVEI	S2,P$ROUT		;GET ADDRESS OF ROUTINE TABLE
	PJRST	DSPMOD			;AND DISPATCH BASED ON MODE


P$ROUT:	EXP	PLTSIX			;/PLOT:IMAGE	(6 BIT)
	EXP	PLTSVN			;/PLOT:ASCII	(7 BIT)
	EXP	PLTSIX			;/PLOT:BINARY	(6 BIT)
	PLROUL==.-P$ROUT		;LENGTH OF ROUTINE TABLE


;MODE TABLE
P$MTAB:	BYTE (3) 2,2,0,0,0,0,0,0,1,0,0,1,1,1,1,1
;	!=======================================================!
;	!                                                       !
;	!                PLOTTER MODE  --  6 BIT                !
;	!                                                       !
;	! In 6bit mode, each word read from disk is treated as  !
;	!  6 6-bit bytes each of which is sent to the plotter   !
;	!                                                       !
;	!=======================================================!
;	! Byte 1 ! Byte 2 ! Byte 3  ! Byte 4 ! Byte 5 ! Byte 6  !
;	!=======================================================!
;	
;	
;	
;	!=======================================================!
;	!                                                       !
;	!                PLOTTER MODE  --  7 BIT                !
;	!                                                       !
;	!In 7 bit mode, each word read from disk is treated as 5!
;	! 7-bit bytes each of which is truncated to 6 bits and  !
;	!                  sent to the plotter                  !
;	!                                                       !
;	!=======================================================!
;	! Byte 1  ! Byte 2  ! Byte 3  ! Byte 4  ! Byte 5  !     !
;	!=======================================================!


PLTSVN:	SKIPA	T1,[7]			;7 BIT BYTES FROM DISK
PLTSIX:	MOVEI	T1,6			;6 BIT BYTES FROM DISK
	MOVEM	T1,J$DBSZ(J)		;AND STORE THE BYTE SIZE

PLTLUP:	$CALL	INPBYT			;GET A BYTE
	JUMPF	PLTLP0			;EXIT LOOP IF AT EOF
	JUMPE	C,PLTLUP		;GET NEXT IF NULL
	PUSHJ	P,PLTBYT		;WRITE THE CHARACTER OUT
	MOVE	T1,J$PTIC(J)		;GET TICS PLOTTED
	IDIV	T1,J$PTPM(J)		;CONVERT TO MINUTES
	CAMLE	T1,J$RLIM(J)		;STILL IN RANGE?
	PUSHJ	P,FRMLEX		;NO - COMPLAIN
	JRST	PLTLUP			;AND LOOP
PLTLP0:	MOVE	T1,J$PTIC(J)		;GET TICS PLOTTED
	IDIV	T1,J$PTPM(J)		;CONVERT TO MINUTES
	MOVE	T3,J$PTPM(J)		;GET TICS PER MINUTE
	IDIVI	T3,2			;GET HALF
	CAMLE	T2,T3			;NEED TO ROUND UP?
	ADDI	T1,1			;YES
	MOVEM	T1,J$APRT(J)		;STORE THE ANSWER
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Devout output errors


; *** Note ***
; I/O bus XY10 plotters do not generate output errors. Unfortunately,
; TOPS-10 sometimes gets a little confused and the OUT UUO takes the
; error return. Just siz we're nice guys, we'll bitch at the operator
; just to he can count the number of times the -10 screws up, and we'll
; continue the plotter. If we ever have a supported plotter that can
; tell us about real I/O errors, the $RETT must be replaced by a POPJ P,
; so the job will be flushed down the old porclain facility.
;
P$DERR:	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
;**;[6002]At P$DERR:+1L change 1 line  JCR  1/11/90
	$QWTO	(<I/O error ^O6R0/J$LIOS(J),RHMASK/>,,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
	$RETT				;RETURN, IGNORING THE ERROR
SUBTTL	Plotter service -- Banners


P$BANN:	PUSHJ	P,P$CPEN		;RE-CALIBRATE THE PEN
	SKIPN	J$FBANN(J)		;BANNER WANTED?
	POPJ	P,			;NO - JUST RETURN
	PUSH	P,J$PTIC(J)		;DON'T CHARGE FOR PLOTTER OVERHEAD
	MOVEI	S1,[ASCIZ |Start|]	;GET LINE IDENTIFIER
	PUSHJ	P,PLTJOB		;PLOT JOB INFORMATION

BANN.1:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XPOS(J)		;POINT TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;MOVE THE PEN
	PUSHJ	P,SETTBF		;SET UP TEXT BUFFER
	$TEXT	(DEPBP,<  Limit: ^D/J$RLIM(J)/, Forms: ^W/J$FORM(J)/^A>)

BANN.2:	GETLIM	T1,.EQLIM(J),NOT1	;GET /NOTE VALUE (WORD 1)
	GETLIM	T2,.EQLIM(J),NOT2	;GET /NOTE VALUE (WORD 2)
	SKIPN	T1			;CHECK WORD 1
	SKIPE	T2			;CHECK WORD 2
	$TEXT	(DEPBP,<, Note: ^W6/T1/^W/T2/^A>) ;YES
	MOVEI	S1,.CHNUL		;GET A <NUL>
	PUSHJ	P,DEPBP			;STORE IT
	PUSHJ	P,STRING		;PLOT STRING
	POP	P,J$PTIC(J)		;RESTORE # PLOTTER TICS
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- File headers


P$HEAD:	PUSH	P,J$PTIC(J)		;DON'T CHARGE FOR PLOTTER OVERHEAD
	PUSHJ	P,P$DASH		;SEPARATE FROM BANNER OR LAST FILE
	SKIPN	J$FHEA(J)		;HEADER ALLOWED?
	PJRST	P$HEA1			;NO..POSITION TO ORIGIN
	LOAD	S1,.FPINF(E),FP.NFH	;GET NO FILE HEADER BIT
	JUMPN	S1,P$HEA1		;SKIP IF NOT WANTED
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	$CALL	SETTBF			;SETUP TO PRINT STIRNG
	MOVE	S1,J$DIFN(J)		;GET FILE IFN
	MOVEI	S2,FI.CRE		;GET CREATION DATE TIME
	$CALL	F%INFO
	MOVEI	S2,[ITEXT (<>)]		;ASSUME NOT /DISPOSE:RENAME
	SKIPE	J$DSPN(J)		;WAS IT /DISPOSE:RENAME ?
	MOVEI	S2,[ITEXT (< (^W/J$DSPN(J)/.^W/J$DSPX(J)/)>)] ;YES
	$TEXT	(DEPBP,<* File: ^F/@J$DFDA(J)/^I/(S2)/ created:^H/S1/ *^0>)
	PUSHJ	P,STRING		;PLOT TEXT

P$HEA1:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,4			;LEAVE THIS MUCH SPACE
	ADD	T1,J$XPOS(J)		;OFFSET BY CURRENT POSITION
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN GOES UP
	PUSHJ	P,PLOT			;POSITION PEN
	MOVE	T1,J$XPOS(J)		;GET CURRENT X POSITION
	MOVEM	T1,J$XMIN(J)		;UPDATE NEW MINIMUM
	POP	P,J$PTIC(J)		;RESTORE # PLOTTER TICS
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- File trailers


P$EOF:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XLIM(J)		;POSITION BEYOND THE HIGHEST X STEP
	MOVE	T2,J$YMIN(J)		;GO BACK TO THE MARGIN
	MOVEI	T3,3			;WITH PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	PJRST	OUTOUT			;DUMP WHAT WE HAVE
SUBTTL	Plotter service -- Job trailers


P$TRAI:	PUSHJ	P,P$DASH		;SEPARATE FROM LAST FILE
	PUSH	P,J$PTIC(J)		;DON'T CHARGE FOR PLOTTER OVERHEAD
	SKIPN	J$FTRA(J)		;TRAILER ALLOWED?
	  JRST	P$TRA3			;NO
	SKIPN	J$XERR(J)		;ANY ERROR TEXT ?
	JRST	P$TRA0			;NO - ONWARD
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XPOS(J)		;POINT TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	PUSHJ	P,SETTBF		;SET UP TEXT BUFFER
	$TEXT	(DEPBP,<^T/J$XERR(J)/^0>) ;INCLUDE ERROR TEXT
	PUSHJ	P,STRING		;PLOT ERROR TEXT

P$TRA0:	MOVEI	S1,[ASCIZ |End|]	;GET LINE IDENTIFIER
	PUSHJ	P,PLTJOB		;PLOT JOB LINE

P$TRA1:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XPOS(J)		;POINT TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	PUSHJ	P,SETTBF		;SET UP TEXT BUFFER
	LOAD	T1,.EQSPC(J),EQ.NUM	;GET NUMBER OF FILES
	MOVEI	T2,[ITEXT (<file>)]	;ASSUME 1 FILE
	CAIE	T1,1			;WAS IT
	MOVEI	T2,[ITEXT (<files>)]	;NO
	$TEXT	(DEPBP,<  Summary: ^D/T1/ ^I/(T2)/^A>)

P$TRA2:	MOVE	T1,(P)			;GET # TICS FOR JOB
	IDIV	T1,J$PTPM(J)		;T1:= MINUTES, T2:= FRACTION
	IMULI	T2,^D1000		;MAKE IT DECIMAL
	IDIV	T2,J$PTPM(J)		;T2:= DECIMAL FRACTION OF A MINUTE
	$TEXT	(DEPBP,< plotted in ^D/T1/.^D3L0/T2/ minutes^0>)
	PUSHJ	P,STRING		;PLOT TEXT

P$TRA3:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,2			;LEAVE THIS MUCH SPACE
	ADD	T1,J$XPOS(J)		;OFFSET BY CURRENT POSITION
	PUSHJ	P,P$LINE		;PLOT SEPARATOR
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,2			;POINT TO NEXT LINE
	ADD	T1,J$XPOS(J)		;OFFSET BY CURRENT POSITION
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	POP	P,J$PTIC(J)		;RESTORE # PLOTTER TICS
	MOVE	T1,J$PTIC(J)		;GET # TICS
	IDIV	T1,J$PTPM(J)		;GET MINUTES OF PLOTTER TIME
	MOVEM	T1,J$APRT(J)		;STORE IT
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Solid lines


; This routine does the following:
;	1. Position to the next line
;	2. Plot a solid line
;	3. Position to the next line
;
P$LINE:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XPOS(J)		;POINT TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	MOVE	T1,J$XPOS(J)		;DON'T TOUCH X POSITION
	MOVE	T2,J$YMAX(J)		;GET MAXIMUM Y VALUE
	MOVEI	T3,2			;PEN DOWN
	PUSHJ	P,PLOT			;PLOT A LINE

LINE.1:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,2			;LEAVE SOME SPACE
	ADD	T1,J$XPOS(J)		;POSITION TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y VALUE
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN AT START OF NEXT LINE
	PUSHJ	P,OUTOUT		;DUMP BUFFERS
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Dashed lines


; This routine works like P$LINE
;
P$DASH:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XPOS(J)		;POINT TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN

DASH.1:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$YPOS(J)		;ADD TO Y POSITION
	CAML	T1,J$YMAX(J)		;GONE TOO FAR ?
	JRST	LINE.1			;YES - FINISH UP
	MOVE	T2,T1			;PUT IN PROPER PLACE
	MOVE	T1,J$XPOS(J)		;GET X POSITION
	MOVEI	T3,2			;PEN DOWN
	PUSHJ	P,PLOT			;PLOT A LINE

DASH.2:	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$YPOS(J)		;ADD TO Y POSITION
	CAML	T1,J$YMAX(J)		;GONE TOO FAR ?
	JRST	LINE.1			;YES - FINISH UP
	MOVE	T2,T1			;PUT IN PROPER PLACE
	MOVE	T1,J$XPOS(J)		;GET X POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;PLOT A LINE
	JRST	DASH.1			;GO BACK AND DO IT AGAIN
SUBTTL	Plotter service -- Job information plotting


; Here to job information for banner and trailer lines
; Call:	MOVEI	S1,[ASCIZ |Start|]	;OR [ASCIZ |Stop|]
;	PUSHJ	P,PLTJOB
;
PLTJOB:	PUSH	P,S1			;SAVE TEXT POINTER
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,2			;MOVE OUT A BIT
	ADD	T1,J$XPOS(J)		;OFFSET BY CURRENT POSITION
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	PUSHJ	P,SETTBF		;SET UP TEXT BUFFER
	MOVE	T1,.EQJBB+JIB.JN(J)	;GET JOB NAME
	MOVE	T2,.EQJBB+JIB.ID(J)	;GET REQUEST ID
	POP	P,T3			;RESTORE TEXT POINTER
	$TEXT	(DEPBP,<* ^T/(T3)/ Job ^W/T1/ req #^D/T2/ ^H/[-1]/ ^T/(T3)/ *^0>)
	PUSHJ	P,STRING		;PLOT STRING
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,^D4			;GET STARTING POSITION
	ADD	T1,J$XPOS(J)		;OFFSET BY CURRENT POSITION
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;MOVE THE PEN
	PUSHJ	P,SETTBF		;SET UP POINTERS TO THE BUFFER
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,3			;COMPUTE NEW CHARACTER SIZE
	MOVEM	T1,J$CSIZ(J)		;STORE IT

	;PLOT THE USERS NAME

TOPS10<	DMOVE	T3,.EQOWN(J)		
	$TEXT	(DEPBP,< ^W6/T3/^W/T4/ ^P/.EQOID(J)/^0>)   > 

TOPS20<	$TEXT	(DEPBP,< ^T/.EQOWN(J)/^0>) 		   >

	PUSHJ	P,STRING		;PLOT THE STRING
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	ADD	T1,J$XPOS(J)		;POINT TO NEXT LINE
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Alignment and testing

REPEAT 0,<

; Routine to test character plots
;
P$TEST:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,SETTBF		;SET UP TEXT BUFFER
	PUSHJ	P,P$CPEN		;CALIBRATE THE PEN
	MOVEI	C,.CHNUL		;START WITH <NUL>

TEST.1:	PUSH	P,C			;SAVE CHARACTER
	PUSHJ	P,STRING		;OUTPUT TEXT
	PUSHJ	P,P$CHKS		;COMPUTE CHARACTER SIZE
	IMULI	T1,2			;WANT DOUBLE HEIGHT CHARACTERS
	MOVEM	T1,J$CSIZ(J)		;REMEMBER IT
	ADD	T1,J$XPOS(J)		;OFFSET BY CURRENT POSITION
	MOVE	T2,J$YMIN(J)		;GET MINIMUM Y POSITION
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	PUSHJ	P,SETTBF		;SET UP TEXT BUFFER
	POP	P,C			;RESTORE CHARACTER
	CAIN	C,200			;DONE ALL CHARACTERS ?
	PJRST	OUTOUT			;PLOT TEXT AND RETURN
	MOVEI	P1,40			;SET UP COUNTER

TEST.2:	SKIPN	S1,C			;GET CHARACTER
	MOVEI	S1," "			;STRING SUBROUTINE CAN'T HANDLE <NUL>
	PUSHJ	P,DEPBP			;PUT CARACTER
	ADDI	C,1			;ADVANCE TO NEXT CHARACTER
	SOJLE	P1,TEST.1		;DONE WITH THIS LINE ?
	JRST	TEST.2			;NO
>
SUBTTL	Plotter service -- Pen calibration


P$CPEN:	MOVE	T1,J$YMAX(J)		;GET THE MAXIMUM Y VALUE WE KNOW ABOUT
	MOVEM	T1,J$YPOS(J)		;FAKE OUT THE LOW LEVEL OUTPUT ROUTINE
	PUSH	P,J$YMIN(J)		;SAVE MINIMUM Y POSITION
	SETZM	J$YMIN(J)		;CLEAR SO WE CAN GO BELOW IT
	MOVE	T1,J$XPOS(J)		;DON'T TOUCH THE X POSITION
	MOVEI	T2,0			;RAM THE PEN INTO THE AXIS
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;POSITION PEN
	SETZM	J$XMIN(J)		;ZERO X MINIMUM
	SETZM	J$YMIN(J)		;ZERO Y MINIMUM
	SETZM	J$XPOS(J)		;ZERO X POSITION
	SETZM	J$YPOS(J)		;ZERO Y POSITION
	MOVE	T1,J$XORG(J)		;GET ORIGINAL X MINIMUM
	MOVE	T2,(P)			;GET MINIMUM Y VALUE
	MOVEI	T3,3			;PEN UP
	PUSHJ	P,PLOT			;PUT PEN THERE
	MOVE	T1,J$XORG(J)		;GET ORIGINAL X MINIMUM
	MOVEM	T1,J$XMIN(J)		;STORE IT
	POP	P,J$YMIN(J)		;RESTORE MINIMUM Y POSITION
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Compute chracter size


P$CHKS:	MOVE	T1,J$YMAX(J)		;CALCULATE SIZE
	SUB	T1,J$YMIN(J)		; OF PLOTTING AREA
	IDIVI	T1,CHRPLN		;MAXIMUM NUMBER OF CHARACTERS PER LINE
	MOVEM	T1,J$CSIZ(J)		;STORE CHARACTER SIZE
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Letters


P$LETR:	$SAVE	<T1,T2,T3,T4>		;PRESERVE TEMPORARIES
;	MOVEI	T1,0
;	MOVEM	T1,J$ROTA(J)
	PUSH	P,J$CSIZ(J)		;SAVE CHARACTER SIZE
	PUSH	P,J$XPOS(J)		;REMEMBER WHERE WE STARTED
	MOVE	T1,J$CSIZ(J)		;GET CHARACTER SPACING
	IDIVI	T1,CHRWID		;CALCULATE CHARACTER SIZE
	JUMPN	T1,SYM.1		;SIZE OK -- PROCEED
	ADDI	T1,1			;TOO SMALL -- CALCULATE FUDG
	SUBI	T2,CHRWID
SYM.1:	MOVEM	T1,J$CSIZ(J)		;SAVE CHARACTER SIZE
	MOVEM	T2,J$FUDG(J)		;AND FUDG (IF ANY)
	IMULI	T1,CHRBAS		;COMPUTE CHARACTER BASE
	ADD	T1,J$XPOS(J)		;GET CURRENT X POSITION
	MOVEM	T1,J$XBAS(J)		;SAVE AS CHARACTER X BASE
	MOVE	T2,J$YPOS(J)		;YPOSITION IS Y BASE
	MOVEM	T2,J$YBAS(J)

	HLRZ	T4,PLTTAB(S1)		;GET NUMBER OF STROKES
	HRRZ	T3,PLTTAB(S1)		;GET ADDR OF CHARACTER VECTORS
	HRLI	T3,(POINT 9)		;MAKE POINTER TO THEM
	MOVEM	T3,J$SPTR(J)		;AND SAVE IT
SYM.3:	ILDB	T2,J$SPTR(J)		;GET SEGMENT DISCRIPTOR
	LDB	T1,[POINT 4,T2,31]	;GET VERTICAL OFFSET
	IMUL	T1,J$CSIZ(J)
	MOVNS	T1			;SUBTRACT FROM BASE
	ADD	T1,J$XBAS(J)
	LDB	T3,[POINT 1,T2,27]	;LOAD PEN STATUS
	MOVE	T3,[EXP 3,2](T3)	;CONVERT TO PLOT PEN CODE
	ANDI	T2,17			;MASK ALL BUT HORIZONTAL OFFSET
	IMUL	T2,J$CSIZ(J)		;ADJUST PER CHARACTER SIZE
	ADD	T2,J$YBAS(J)		;ADD TO CHARACTER BASE
	PUSHJ	P,PLOT			;PLOT SEGMENT
	SOJG	T4,SYM.3		;DO ALL SEGMENTS
	SETZM	J$ROTA(J)		;CLEAR CHARACTER ROTATION
	POP	P,T1			;RESTORE X STARTING POSITION
	POP	P,J$CSIZ(J)		;RESTORE CHARACTER SIZE
	MOVE	T2,J$YBAS(J)		;GET STARTING Y POSITION
	ADD	T2,J$CSIZ(J)		;ADDJUST PER CHACTER SIZE
	MOVEI	T3,3			;PEN UP BEFOR PLOTTING
	PUSHJ	P,PLOT			;POSITION PEN
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Line segments


;Call	T1/ X Coordinate to move to
;	T2/ Y Coordinate to move to
;	T3/ Pen code as follows
;		1	No Change in Pen
;		2	Pen Down before Plotting
;		3	Pen Up before moving
;
PLOT:	$SAVE	<T1,T2,T3,T4>		;PRESERVE TEMPORARIES
	CAIG	T3,1			;CHANGE REQUESTED?
	JRST	PLT.1			;NO..PROCEED
	SUBI	T3,3			;YES..GET -1  OR 0
	CAMN	T3,J$PPOS(J)		;PEN IN POSITION?
	JRST	PLT.1			;YES -- PROCEED
	MOVEI	C,PNUP			;GET PEN UP CODE
	SKIPGE	T3			;WANT IT LOWERED?
	MOVEI	C,PNDN			;YES..GET THE CODE
	$CALL	PLTBYT			;MOVE THE PEN
PLT.1:	SUB	T1,J$XPOS(J)		;COMPUTE DELTA X
	MOVEI	T3,XYD			;ASSUME DOWN MOVEMENT
	SKIPG	T1			;IS THAT CORRECT?
	MOVEI	T3,XYU			;NO..ASSUME UP
	SUB	T2,J$YPOS(J)		;COMPUTE DELTA Y
	MOVEI	T4,XYL			;ASSUME LEFTWARD MOVEMENT
	SKIPG	T2			;IS THAT CORRECT?
	MOVEI	T4,XYR			;NO..THEN ASSUME RIGHT
	MOVMS	T1			;MAKE DELTA X POSITIVE
	MOVMS	T2			;MAKE DELTA Y POSITIVE
	CAML	T1,T2			;IS SMALLEST DELTA IN T2?
	JRST	PLT.2			;YES -- PROCEED
	EXCH	T1,T2			;NO -- MAKE IT SO
	EXCH	T3,T4			;EXCHANGE MOVEMENT CODES
PLT.2:	JUMPE	T1,PLT.8		;DONE IF NO MOVEMENT REQUESTED
	JUMPE	T2,PLT.6		;PLOT ONLY ONE DIRECTION
PLT.3:	PUSH	P,T3			;SAVE MOVEMENT CODES
	PUSH	P,T4
	MOVEI	T4,0			;CLEAR STEP COUNTER
PLT.4:	TLNE	T2,200000		;NORMALIZE MOVEMENT COUNTER
	JRST	PLT.5
	LSH	T2,1			;SHIFT LEFT
	TRO	T2,1			;AND ROUND UP
	AOJA	T4,PLT.4		;NORMALIZE TO BIT 1
PLT.5:	SUBI	T4,^D34			;ADJUST STEP COUNT
	MOVNS	T4			;GET REMAINING SHIFT COUNT
	IDIV	T2,T1			;COMBINED(NORMALIZED)/TOTAL
	LSH	T2,(T4)			;COMPUTE FINAL STEP FUNCTION
	POP	P,T4			;RESTORE MOVEMENT CODES
	POP	P,T3
PLT.6:	MOVEM	T2,J$STEP(J)		;SAVE STEP
	MOVEI	T2,0			;CLEAR STEP COUNTER

PLT.7:	ADD	T2,J$STEP(J)		;BUMP STEP COUNTER
	MOVE	C,T3			;ASSUME SINGULAR MOVEMENT
	TLZE	T2,200000		;TIME FOR COMBINED MOVE?
	IOR	C,T4			;YES..INCLUDE IT
	$CALL	PLTBYT
	SOJG	T1,PLT.7		;LOOP ON TOTAL COUNT
PLT.8:	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Rotation and XY20 translation



;Plotter Translation Table Entry Description
;	0                         17    20   23 24   27 28   31 32   35
;	================================================================
;	!       XY20 CODE           !  !ROT = 3!ROT = 2!ROT = 1!ROT = 0!
;	================================================================
;
ROTAB:	EXP 0						;NO MOVEMENT
	BYTE (18) 106 (2) 0 (4) XYU ,XYL ,XYD ,XYR 	;MOVE DOWN
	BYTE (18) 102 (2) 0 (4) XYD ,XYR ,XYU ,XYL 	;MOVE UP
	BYTE (18) 114 (2) 0 (4) PEN3,PEN3,PEN3,PEN3	;SELECT PEN3
	BYTE (18) 104 (2) 0 (4) XYR ,XYU ,XYL ,XYD 	;MOVE RIGHT
	BYTE (18) 105 (2) 0 (4) XYDL,XYUL,XYUR,XYDR	;MOVE DOWN+RIGHT
	BYTE (18) 103 (2) 0 (4) XYDR,XYDL,XYUL,XYUR	;MOVE UP+RIGHT
	EXP -1						;ILLEGAL
	BYTE (18) 100 (2) 0 (4) XYL ,XYD ,XYR ,XYU 	;MOVE LEFT
	BYTE (18) 107 (2) 0 (4) XYUL,XYUR,XYDR,XYDL	;MOVE DOWN+LEFT
	BYTE (18) 101 (2) 0 (4) XYUR,XYDR,XYDL,XYUL	;MOVE UP+LEFT
	EXP -1						;ILLEGAL
	BYTE (18) 113 (2) 0 (4) PEN2,PEN2,PEN2,PEN2	;SELECT PEN 2
	EXP -1						;ILLEGAL
	EXP -1						;ILLEGAL
	BYTE (18) 112 (2) 0 (4) CNGP,CNGP,CNGP,CNGP	;CHANGE PENS

ROPTR:	POINT	4,ROTAB(C),35		;POINTER TO ZERO ROTATION
	POINT	4,ROTAB(C),31		; ROTATION = 1
	POINT	4,ROTAB(C),27		; ROTATION = 2
	POINT	4,ROTAB(C),23		; ROTATION = 3
SUBTTL	Plotter service -- Pen movement generation


;Call	C/ Character to plot
;
;Will adjust values in J$XPOS and J$YPOS based on pen movement
;Also checks range on J$XMIN-J$XMAX and J$YMIN-J$YMAX
;Saves highest pen movement in J$XLIM and J$YLIM
;
PLTBYT:	TRZE	C,PNUP			;TEST AND CLEAR PEN UP CODE
	$CALL	PENUP			;RAISE PEN
	TRZE	C,PNDN			;TEST AND CLEAR PEN DOWN CODE
	$CALL	PENDN			;LOWER PEN

PLTXYD:	TRNN	C,XYD			;GOING DOWN ?
	JRST	PLTXYU			;NO
	AOS	S1,J$XPOS(J)		;+1
	CAMG	S1,J$XMAX(J)		;BEYOND X MAXIMUM ?
	CAMG	S1,J$XMIN(J)		;WITHIN X BOUNDS ?
	TRZ	C,XYD!XYU		;STOP MOVING

PLTXYU:	TRNN	C,XYU			;GOING UP ?
	JRST	PLTXYL			;NO
	SOS	S1,J$XPOS(J)		;-1
	CAMGE	S1,J$XMAX(J)		;BEYOND X MAXIMUM ?
	CAMGE	S1,J$XMIN(J)		;WITHIN X BOUNDS ?
	TRZ	C,XYD!XYU		;STOP MOVING

PLTXYL:	TRNN	C,XYL			;GOING LEFT ?
	JRST	PLTXYR			;NO
	AOS	S2,J$YPOS(J)		;+1
	CAMG	S2,J$YMAX(J)		;BEYOND Y MAXIMUM ?
	CAMG	S2,J$YMIN(J)		;WITHIN Y BOUNDS ?
	TRZ	C,XYR!XYL		;STOP MOVING

PLTXYR:	TRNN	C,XYR			;GOING RIGHT ?
	JRST	PLTB.6			;NO
	SOS	S2,J$YPOS(J)		;-1
	CAMGE	S2,J$YMAX(J)		;BEYOND Y MAXIMUM ?
	CAMGE	S2,J$YMIN(J)		;WITHIN Y BOUNDS ?
	TRZ	C,XYR!XYL		;STOP MOVING

PLTB.6:	SKIPN	J$PPOS(J)		;IS PEN DOWN?
	PJRST	PLTB.8			;NO..DON'T RECORD MAX POSITIONS
	CAMLE	S1,J$XMAX(J)		;CLIPPED?
	JRST	PLTB.7			;YES -- DON'T ADJUST LIMIT
	CAMLE	S1,J$XLIM(J)		;HIGHEST POINT SO FAR?
	MOVEM	S1,J$XLIM(J)		;YES -- SAVE IT

PLTB.7:	CAMLE	S2,J$YMAX(J)		;CLIPPED?
	JRST	PLTB.8			;YES -- DON'T ADJUST LIMIT
	CAMLE	S2,J$YLIM(J)		;HIGHEST POINT SO FAR?
	MOVEM	S2,J$YLIM(J)		;YES -- SAVE IT

PLTB.8:	JUMPE	C,.RETT			;RETURN IF NOTHING TO PLOT
	MOVEI	S1,PLTMOV		;LOAD # TICS FOR MOVEMENT
	ADDM	S1,J$PTIC(J)		;ADD TO TOTAL SO FAR
;	MOVE	S1,[LDB	C,ROPTR]	;GET ROTATE INSTRUCTION
;	ADD	S1,J$ROTA(J)		;OFFSET BY GRID ROTATION
;	XCT	S1			;ROTATE
	PJRST	OUTBYT			;OUTPUT THE BYTE
PENUP:	PUSH	P,C			;SAVE CHARCTER AC
	SETZM	J$PPOS(J)		;MARK PEN RAISED
	MOVEI	C,PNUP			;LOAD CODE FOR PEN UP
	PUSHJ	P,OUTBYT		;PLOT CHARACTER
	MOVEI	C,PLTPEN		;LOAD # TICS FOR UP/DOWN COMMAND
	ADDM	C,J$PTIC(J)		;ADD TO TOTAL SO FAR
	POP	P,C			;RESTORE CHARACTER AC
	POPJ	P,			;RETURN

PENDN:	PUSH	P,C			;SAVE CHARACTER AC
	SETOM	J$PPOS(J)		;MARK PEN DOWN
	MOVEI	C,PNDN			;LOAD PENDOWN CODE
	PUSHJ	P,OUTBYT		;PLOT CHARACTER
	MOVEI	C,PLTPEN		;LOAD # TICS FOR UP/DOWN MOVEMENT
	ADDM	C,J$PTIC(J)		;ADD TO TOTAL SO FAR
	POP	P,C			;RESTORE CHARACTER AC
	POPJ	P,			;RETURN
SUBTTL	Plotter service -- Character set


;DEFINE MACRO TO GENERATE CHARACTER TABLE ENTRY AS FOLLOWS

;PLTTAB
;	ONE ENTRY FOR EACH CHARACTER VALUE 0 THRU 177

;	LH OF EACH ENTRY
;		NUMBER OF SEGMENTS TO PLOT FOR THIS CHARACTER

;	RH OF EACH ENTRY
;		ADDRESS OF 9 BIT BYTES DESCRIBING SEGMENTS AS FOLLOWS

;	    0       1                   4     5                   8
;	=============================================================
;	!  PEN    !     VERTICAL OFFSET    !   HORIZONTAL OFFSET    !
;	=============================================================

;	PEN	1 FOR PEN DOWN
;		0 FOR PEN UP

;	VERTICAL OFFSET	  POINT IN CHARACTER GRID WHERE SEGMENT ENDS

;	HORIZONT OFFSET   POINT IN CHARACTER GRID WHERE SEGMENT ENDS

	DEFINE XX (ARGS) <
	ZZ=0
	IRP ARGS,<ZZ=ZZ+1>		;;COUNT NUMBER OF SEGMENTS
	XWD	ZZ,[BYTE (9) ARGS]	;;BUILD TABLE ENTRY AND STRING
	> ;END OF XX
	CHRBAS==6
	CHRWID==6

	FIN==<CHRBAS>B31!<CHRWID>B35
PLTTAB:

C%000:	Z				;NULL IS ILLEGAL
C%001:	XX <200,542,702,142,604,FIN>
C%002:	XX <144,563,603,622,621,600,560,541,542,563,603,624,FIN>
C%003:	XX <561,701,702,663,642,241,643,624,603,601,FIN>
C%004:	XX <602,544,FIN>
C%005:	XX <220,624,564,FIN>
C%006:	XX <243,641,620,560,541,543,200,602,FIN>
C%007:	XX <141,641,240,644,243,543,FIN>
C%010:	XX <602,240,544,FIN>
C%011:	XX <240,661,604,564,543,562,602,644,FIN>
C%012:	XX <242,641,620,560,541,543,564,624,643,642,702,704,FIN>
C%013:	XX <160,541,562,662,703,664,FIN>
C%014:	XX <240,644,302,562,160,564,FIN>
C%015:	XX <200,560,541,543,564,624,643,641,620,600,604,242,542,FIN>
C%016:	XX <202,561,600,620,641,622,602,563,604,624,643,622,FIN>
C%017:	XX <204,623,621,600,560,541,543,564,644,702,701,FIN>
C%020:	XX <244,641,620,560,541,544,FIN>
C%021:	XX <240,643,624,564,543,540,FIN>
C%022:	XX <160,640,661,663,644,564,FIN>
C%023:	XX <260,600,561,563,604,664,FIN>
C%024:	XX <300,600,542,604,704,240,644,FIN>
C%025:	XX <544,704,700,221,624,206>
C%026:	XX <100,640,600,561,562,603,643,603,564,FIN>
C%027:	XX <143,564,603,164,560,221,640,661,240,644,FIN>
C%030:	XX <541,561,600,620,641,643,624,604,563,543,544,FIN>
C%031:	XX <220,624,262,624,562,FIN>
C%032:	XX <160,601,543,564,FIN>
C%033:	XX <602,642,704,244,640,200,604,FIN>
C%034:	XX <160,563,303,620,623,FIN>
C%035:	XX <300,623,620,160,563,FIN>
C%036:	XX <160,564,224,620,260,664,FIN>
C%037:	XX <200,542,604,FIN>
C%040:	XX <FIN>
C%041:	XX <142,562,222,702,FIN>
C%042:	XX <241,701,303,643,FIN>
C%043:	XX <141,701,303,543,204,600,240,644,FIN>
C%044:	XX <160,563,604,623,621,640,661,664,302,542,FIN>
C%045:	XX <160,664,261,701,700,660,661,163,543,544,564,563,FIN>
C%046:	XX <144,640,660,701,662,642,600,560,541,542,604,FIN>
C%047:	XX <243,703,702,662,663,FIN>
C%050:	XX <142,600,640,702,FIN>
C%051:	XX <142,604,644,702,FIN>
C%052:	XX <160,664,262,562,164,660,220,624,FIN>
C%053:	XX <162,662,220,624,FIN>
C%054:	XX <123,603,602,562,563,FIN>
C%055:	XX <220,624,FIN>
C%056:	XX <142,543,563,562,542,FIN>
C%057:	XX <160,664,FIN>
C%060:	XX <160,660,701,703,664,564,543,541,560,664,FIN>
C%061:	XX <142,702,661,FIN>
C%062:	XX <260,701,703,664,644,623,621,600,540,544,FIN>
C%063:	XX <260,701,703,664,644,623,622,623,604,564,543,541,FIN>
C%064:	XX <300,620,624,623,663,543,FIN>
C%065:	XX <141,543,564,624,643,641,620,700,704,FIN>
C%066:	XX <220,623,604,564,543,541,560,660,701,703,FIN>
C%067:	XX <560,664,704,700,FIN>
C%070:	XX <221,623,644,664,703,701,660,640,621,600,560,541,543,564,604,623,FIN>
C%071:	XX <141,543,564,664,703,701,660,640,621,624,FIN>
C%072:	XX <161,562,602,601,561,241,642,662,661,641,FIN>
C%073:	XX <122,602,601,561,562,242,662,661,641,642,FIN>
C%074:	XX <143,620,703,FIN>
C%075:	XX <200,604,244,640,FIN>
C%076:	XX <141,624,701,FIN>
C%077:	XX <142,622,623,644,664,703,701,660,FIN>
C%100:	XX <143,541,560,660,701,703,664,604,602,642,644,FIN>
C%101:	XX <640,702,644,604,600,604,544,FIN>
C%102:	XX <700,703,664,644,623,620,623,604,564,543,540,FIN>
C%103:	XX <264,703,701,660,560,541,543,564,FIN>
C%104:	XX <700,702,644,604,542,540,FIN>
C%105:	XX <144,540,620,623,620,700,704,FIN>
C%106:	XX <620,623,620,700,704,FIN>
C%107:	XX <264,703,701,660,560,541,543,564,624,622,FIN>
C%110:	XX <700,620,624,704,544,FIN>
C%111:	XX <141,543,542,702,701,703,FIN>
C%112:	XX <160,541,543,564,704,FIN>
C%113:	XX <700,600,704,621,544,FIN>
C%114:	XX <300,540,544,FIN>
C%115:	XX <700,642,704,544,FIN>
C%116:	XX <700,660,564,544,704,FIN>
C%117:	XX <160,660,701,703,664,564,543,541,560,FIN>
C%120:	XX <700,703,664,644,623,620,FIN>
C%121:	XX <160,660,701,703,664,564,543,541,560,202,544,FIN>
C%122:	XX <700,703,664,644,623,620,621,544,FIN>
C%123:	XX <543,564,604,623,621,640,660,701,704,FIN>
C%124:	XX <142,702,700,704,FIN>
C%125:	XX <300,540,544,704,FIN>
C%126:	XX <300,660,542,664,704,FIN>
C%127:	XX <300,540,602,544,704,FIN>
C%130:	XX <560,664,704,664,622,660,700,660,564,544,FIN>
C%131:	XX <300,642,704,642,542,FIN>
C%132:	XX <300,704,664,622,620,624,622,560,540,544,FIN>
C%133:	XX <142,540,700,702,FIN>
C%134:	XX <260,564,FIN>
C%135:	XX <142,544,704,702,FIN>
C%136:	XX <240,702,644,302,542,FIN>
C%137:	XX <162,620,662,220,624,FIN>
C%140:	XX <341,703,FIN>
C%141:	XX <163,542,541,560,620,641,643,563,544,FIN>
C%142:	XX <300,540,543,564,624,643,640,FIN>
C%143:	XX <224,643,641,620,560,541,543,564,FIN>
C%144:	XX <304,544,541,560,620,641,644,FIN>
C%145:	XX <143,541,560,620,641,643,624,604,600,FIN>
C%146:	XX <141,661,702,703,664,220,622,FIN>
C%147:	XX <144,541,560,620,641,643,624,524,503,501,FIN>
C%150:	XX <700,220,641,643,624,544,FIN>
C%151:	XX <141,543,542,642,641,262,702,662,FIN>
C%152:	XX <121,502,503,524,644,643,FIN>
C%153:	XX <700,243,601,600,602,544,FIN>
C%154:	XX <141,543,542,702,701,FIN>
C%155:	XX <640,620,641,622,542,622,643,624,544,FIN>
C%156:	XX <640,200,642,643,624,544,FIN>
C%157:	XX <160,620,641,643,624,564,543,541,560,FIN>
C%160:	XX <100,640,643,624,564,543,540,FIN>
C%161:	XX <144,541,560,620,641,644,504,FIN>
C%162:	XX <640,200,642,643,624,FIN>
C%163:	XX <543,564,603,601,620,641,644,FIN>
C%164:	XX <301,561,542,543,564,240,642,FIN>
C%165:	XX <240,560,541,542,604,644,544,FIN>
C%166:	XX <240,600,542,604,644,FIN>
C%167:	XX <240,560,541,562,642,562,543,564,644,FIN>
C%170:	XX <644,240,544,FIN>
C%171:	XX <240,560,541,544,244,524,503,501,FIN>
C%172:	XX <240,644,540,544,201,603,FIN>
C%173:	XX <144,543,562,602,621,620,621,642,662,703,704,FIN>
C%174:	XX <102,702,FIN>
C%175:	XX <142,600,642,604,542,FIN>
C%176:	XX <541,562,602,623,624,623,642,662,701,700,FIN>
C%177:	XX <260,564,FIN>
SUBTTL	Paper tape punch service -- Dispatch table


T$DISP:	JRST	T$HEAD			;(0) FILE HEADER
	JRST	T$EOF			;(1) FILE TRAILER
	SIXBIT	/PTP/			;(2) GENERIC DEVICE NAME
	EXP	PTPBSZ			;(3) OUTPUT BYTE SIZE
	JRST	T$PROC			;(4) PROCESS A FILE
	JRST	T$BANN			;(5) JOB BANNER
	JRST	T$TRAI			;(6) JOB TRAILER
	JRST	T$LETR			;(7) LETTER ProcessER
	JRST	.RETF			;(10) ERROR PROCCESSOR
	JRST	.RETT			;(11) ACCOUNTING
	JRST	T$CHKP			;(12) CHECKPOINT TEXT GENERATION
SUBTTL	Paper tape punch service -- Checkpoint text generation


T$CHKP:	$SAVE	<P1,P2>			;SAVE SOME ACS
	MOVE	P1,J$TBCT(J)		;GET TOTAL BYTE COUNT
	IDIVI	P1,FRMPFT		;COMPUTE FEET OF TAPE USED
	MOVE	P2,J$RLIM(J)		;GET LIMIT
	CAMN	P2,[.INFIN]		;+INFINITY ?
	JRST	T$CHK1			;YES
	CAMG	P1,J$RLIM(J)		;OPERATOR ALLOW LIMIT TO EXCEED ?
	$TEXT	(DEPBP,<punched ^D/P1/ of ^D/J$RLIM(J)/ feet^0>)
	CAMLE	P1,J$RLIM(J)		;OPERATOR ALLOW LIMIT TO EXCEED ?
T$CHK1:	$TEXT	(DEPBP,<punched ^D/P1/ feet (limit exceeded)^0>)
	POPJ	P,			;RETURN
SUBTTL	Paper tape punch service -- File processing


T$PROC:	LOAD	S1,.FPINF(E),FP.FFF	;GET FILE FORMAT
	CAIN	S1,.FPF11		;/FILE:ELEVEN?
	JRST	PTELF			;YES, DO IT
	LOAD	S1,.FPINF(E),FP.FPF	;GET PAPER FORMAT
	CAILE	S1,PTROUL		;WITHIN RANGE?
	JRST	BADMOD			;NO, LOSE
	JUMPN	S1,@T$ROUT-1(S1)	;YES, DISPATCH IF NON-ZERO
	MOVEI	S1,T$MTAB		;GET ADDRESS OF MODE TABLE
	MOVEI	S2,T$ROUT		;GET ADDRESS OF ROUTINE TABLE
	PJRST	DSPMOD			;AND DISPATCH BASED ON MODE

T$ROUT:	EXP	PTASC			;ASCII
	EXP	PTIMA			;IMAGE
	EXP	PTIBI			;IBIN
	EXP	PTBIN			;BINARY

	PTROUL==.-T$ROUT		;LENGTH OF ROUTINE TABLE

;MODE TABLE
T$MTAB:	BYTE (3) 1,1,0,0,0,0,0,0,2,0,0,3,4,4,4,4
;	!              PAPER-TAPE MODE  --  ELEVEN              !
;	!                                                       !
;	!      In ELEVEN format, each word read from disk       !
;	!     is treated as 4 8 bit bytes each of which is      !
;	!              punched as 1 frame of tape               !
;	!                       - - - - -                       !
;	!                                                       !
;	!   0           1               2           2           !
;	!   2           0               0           8           !
;	!=======================================================!
;	!  !  Byte 2   !   Byte 1   !  !  Byte 4   !   Byte 3   !
;	!=======================================================!


PTELF:	$CALL	INPBYT			;GET A CHARACTER
	JUMPF	.RETF			;RETURN WHEN DONE
	MOVE	T2,C			;PUT THE CHARACTER INTO T2
	MOVEI	T1,3			;FOR SELECTION OF BYTE POINTER
PTEL.1:	LDB	C,ELFPTR(T1)		;SELECT A BYTE
	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	SOJGE	T1,PTEL.1		;COUNT DOWN
	JRST	PTELF			;LOOP



ELFPTR:	POINT	8,T2,^D27		;BYTE 4
	POINT	8,T2,^D35		;BYTE 3
	POINT	8,T2,^D9		;BYTE 2
	POINT	8,T2,^D17		;BYTE 1
;	!              PAPER-TAPE MODE  --  ASCII               !
;	!                                                       !
;	!In ASCII mode, each word read from disk is broken into !
;	! 5 seven bit bytes.  Each byte gets an even parity bit !
;	!      included and is punched as 1 frame of tape.      !
;	!                                                       !
;	!=======================================================!
;	! Byte 1  ! Byte 2  ! Byte 3  ! Byte 4  ! Byte 5  !     !
;	!=======================================================!
;	!                                                       !
;	!   If a vertical or horizontal TAB is punched, it is   !
;	!    followed by a RUBOUT character.  If a formfeed     !
;	!   is punched, it is followed by 16 (decimal) NULLs.   !


PTASC:	MOVEI	T1,7			;USE 7 BIT BYTES FROM DISK
	MOVEM	T1,J$DBSZ(J)		;SAVE THE BYTE SIZE
PTAS.1:	$CALL	INPBYT			;GET A CHARACTER
	JUMPF	.RETF			;RETURN WHEN DONE
	JUMPE	C,PTAS.1		;IGNORE NULLS
	MOVEI	T1,(C)			;COPY CHAR
	LSH	T1,-4			;SHIFT OVER
	XORI	T1,(C)			;FIND DIFFERENT BITS
	TRCE	T1,14			;LOOK AT 2 BITS
	TRNN	T1,14			;ARE THEY THE SAME?
	TRC	C,200			;YES--MAKE EVEN PARITY
	TRCE	T1,3			;LOOK AT THE OTHER 2 BITS
	TRNN	T1,3			;ARE THEY THE SAME?
	TRC	C,200			;YES--MAKE EVEN PARITY
PTAS.2:	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	CAIE	C,11			;HORIZ. TAB?
	CAIN	C,213			;VERT. TAB?
	JRST	PTAS.3			;YES--ADD A RUBOUT
	CAIE	C,14			;FORM FEED?
	JRST	PTAS.1			;NO-- MARCH ON.
	MOVEI	S1,20			;NEED 20 NULLS
	SETZ	C,			;NULL
	PUSHJ	P,PTPREP		;PUNCH THEM
	JRST	PTAS.1			;GET NEXT CHAR

PTAS.3:	MOVEI	C,377			;LOAD A RUBOUT
	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	JRST	PTAS.1			;AND LOOP
;	!              PAPER-TAPE MODE  --  BINARY              !
;	!                                                       !
;	!  In BINARY mode, the tape is broken up into logical   !
;	!  blocks consisting of 1 word of control information   !
;	!  and 40 (octal) words of data (the last block may be  !
;	!  smaller).  Each word (both data and control words)   !
;	!  is split into 6 6-bit bytes, each of which gets 200  !
;	!  (octal) added and is punched as one frame of tape.   !
;	!                                                       !
;	!=======================================================!
;	! Byte 1 ! Byte 2 ! Byte 3  ! Byte 4 ! Byte 5 ! Byte 6  !
;	!=======================================================!
;	!                                                       !
;	! The control word consists of a folded checksum in the !
;	! left half and the data word count in the right half.  !
;	!                                                       !
;	!=======================================================!
;	!      Folded checksum      !   Number of data words    !
;	!=======================================================!


PTBIN:	MOVEI	S1,40			;LOAD MAXIMUM BLOCKSIZE
	$CALL	CHKSUM			;GET A BLOCK CHECKSUMMED
	JUMPF	.RETT			;DONE!!
	MOVN	T4,S1			;PUT NEGATIVE BLOCKSIZE IN T4
	MOVE	T1,S1			;GET 0,,BLOCKSIZE
	HRL	T1,S2			;GET CHECKSUM,,BLOCKSIZE
	MOVEI	C,0			;LOAD A NULL
	MOVEI	S1,5			;AND A COUNT
	PUSHJ	P,PTPREP		;PUNCH SOME BLANK TAPE
	$CALL	PTBI.2			;PUNCH THE CONTROL WORD
	HRLZ	T4,T4			;GET -VE COUNT,,0
	HRRI	T4,J$XCHB(J)		;MAKE AN AOBJN POINTER

PTBI.1:	MOVE	T1,0(T4)		;GET A WORD
	$CALL	PTBI.2			;PUNCH IT
	AOBJN	T4,PTBI.1		;LOOP FOR ALL DATA WORDS
	JRST	PTBIN			;AND GO START ANOTHER BLOCK

PTBI.2:	MOVE	T2,[POINT 6,T1]		;LOAD A BYTE POINTER
PTBI.3:	ILDB	C,T2			;GET A BYTE
	TRO	C,200			;ADD HIGH ORDER BIT
	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	TLNE	T2,770000		;ARE WE DONE?
	JRST	PTBI.3			;NO, LOOP
	POPJ	P,			;YES, GET NEXT WORD
;	!           PAPER-TAPE MODE  --  IMAGE BINARY           !
;	!                                                       !
;	!   In Image Binary Mode, each word read from disk is   !
;	! split into 6 6-bit bytes.  Each byte gets 200 (octal) !
;	!      added to it and is sent as 1 frame of tape.      !
;	!                                                       !
;	!=======================================================!
;	! Byte 1 ! Byte 2 ! Byte 3  ! Byte 4 ! Byte 5 ! Byte 6  !
;	!=======================================================!


PTIBI:	MOVEI	T1,6			;USE 6 BIT BYTES FROM DISK
	MOVEM	T1,J$DBSZ(J)		;SAVE BYTE SIZE
PTIB.1:	$CALL	INPBYT			;GET A CHRACTER
	JUMPF	.RETF			;AND RETURN WHEN DONE
	TRO	C,200			;ADD A BIT
	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	JRST	PTIB.1			;LOOP FOR MORE





;	!              PAPER-TAPE MODE  --  IMAGE               !
;	!                                                       !
;	!   In IMAGE mode, the low-order 8 bits of each word    !
;	!   read from disk are punched as one frame of tape.    !
;	!                                                       !
;	!=======================================================!
;	!                                          !   Byte 1   !
;	!=======================================================!


PTIMA:	$CALL	INPBYT			;GET A CHARACTER (36 BITS)
	JUMPF	.RETF			;RETURN WHEN DONE
	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	JRST	PTIMA			;AND LOOP
SUBTTL	Paper tape punch service -- Banners


T$BANN:	MOVEI	T1,1			;1 FOLD
	SETZM	J$TBCT(J)		;CLEAR TOTAL BYTE COUNT
	SKIPN	J$FBAN(J)		;BANNER ALLOWED?
	PJRST	BLKFLD			;NO -- PUNCH BLANK FOLD
	$CALL	SETTBF			;SETUP TEXT BUFFER
	$TEXT(DEPBP,<Begin ^R/.EQJBB(J)/^A>)
	GETLIM	T1,.EQLIM(J),NOT1	;GET /NOTE VALUE (WORD 1)
	GETLIM	T2,.EQLIM(J),NOT2	;GET /NOTE VALUE (WORD 2)
	SKIPN	T1			;CHECK WORD 1
	SKIPE	T2			;CHECK WORD 2
	$TEXT	(DEPBP,<, Note: ^W6/T1/^W/T2/^A>) ;YES
	MOVEI	S1,.CHNUL		;GET A NUL
	PUSHJ	P,DEPBP			;STORE IT
	$CALL	STRING			;AND SEND TO THE PUNCH
	MOVEI	T1,1			;1 FOLD
	PJRST	BLKFLD			;PUNCH BLANK FOLDS
SUBTTL	Paper tape punch service -- File headers


T$HEAD:	MOVEI	T1,1			;1 FOLD
	SKIPN	J$FHEA(J)		;HEADER ALLOWED?
	JRST	BLKFLD			;NO -- JUST PUNCH A BLANK FOLD
	MOVEI	T1,1			;1 FOLD
	LOAD	S1,.FPINF(E),FP.NFH	;GET NO FILE HEADERS BIT
	JUMPN	S1,BLKFLD		;IF SET, JUST PUNCH A BLANK FOLD OF TAPE
	$CALL	SETTBF			;ELSE, SETUP TEXT BUFFER
	MOVEI	S1,[ITEXT <^F/@J$DFDA(J)/>] ;USE FILE NAME
	SKIPE	J$DSPN(J)		;UNLESS SPOOL NAME EXISTS
	MOVEI	S1,[ITEXT <^W/J$DSPN(J)/>] ;USE SPOOL NAME
	$TEXT	(DEPBP,<File: ^I/0(S1)/ started at ^H/[-1]/^0>)
	$CALL	STRING			;FORCE THE STRING OUT TO PUNCH
	MOVEI	T2,^D10			;LOAD LOOP COUNT

THEA.1:	MOVEI	S1,^D10			;GET A REPEAT COUNT
	MOVEI	C,0			;AND A NULL CHARACTER
	PUSHJ	P,PTPREP		;PUNCH SOME BLANK TAPE
	MOVEI	S1,^D10			;GET A REPEAT COUNT
	MOVEI	C,177			;AND A CHARACTER
	PUSHJ	P,PTPREP		;PUNCH SOME LACED FRAMES
	SOJG	T2,THEA.1		;AND LOOP
	MOVEI	T1,1			;1 FOLD
	PJRST	BLKFLD			;AND SEND A BLANK FOLD OF TAPE
SUBTTL	Paper tape punch service -- File trailers


T$EOF:	MOVEI	T1,1			;LOAD A REPEAT COUNT
	$CALL	BLKFLD			;SEND A BLANK FOLD
	MOVEI	S1,5			;GET A COUNT
	MOVEI	C,232			;AND AN EOF CHARACTER
	PUSHJ	P,PTPREP		;PUNCH SOME EOFS
	MOVEI	T1,1			;1 FOLD
	LOAD	S1,.FPINF(E),FP.NFH	;NO FILE HEADERS?
	JUMPN	S1,BLKFLD		;RIGHT -- PUNCH A BLANK FOLD
	MOVEI	S1,^D10			;LOAD A COUNT
	MOVEI	C,0			;AND A NULL
	PUSHJ	P,PTPREP		;PUNCH SOME BLANK TAPE
	MOVEI	S1,[ASCIZ /END/]	;PROBABLE TRAILER
	TXNE	S,ABORT!RQB		;IS FILE INCOMPLETE (ABORT OR REQUEUE)
	MOVEI	S1,[ASCIZ /ABORT/]	;YES!
	MOVEI	S2,[ITEXT <^F/@J$DFDA(J)/>] ;USE FILNAME
	SKIPE	J$DSPN(J)		;UNLESS SPOOL NAME EXISTS
	MOVEI	S2,[ITEXT <^W/J$DSPN(J)/>] ;USE SPOOL NAME
	$CALL	SETTBF			;SETUP TEXT BUFFER
	$TEXT(DEPBP,<^T/0(S1)/ file ^I/0(S2)/--^0>)
	$CALL	STRING			;AND SEND IT
	MOVEI	T1,1			;1 FOLD
	PJRST	BLKFLD			;SEND A BLANK FOLD OF TAPE
SUBTTL	Paper tape punch service -- Trailers


T$TRAI:	MOVEI	T1,1			;1 FOLD
	SKIPN	J$FTRA(J)		;GET TRAILER COUNT
	PJRST	BLKFLD			;PUNCH BLANK FOLDS
	$CALL	SETTBF			;SETUP THE TEXT BUFFER
	MOVEI	S1,[ASCIZ /END/]	;LOAD PROBABLE TRAILER
	TXNE	S,RQB			;REQUEUED?
	MOVEI	S1,[ASCIZ /REQUE/]	;YES!
	$TEXT(DEPBP,<^T/(S1)/ JOB ^W/.EQJOB(J)/**^0>)
	$CALL	STRING			;SEND IT
	MOVEI	T1,1			;1 FOLD
;	PJRST	BLKFLD			;SEND A BLANK FOLD OF TAPE
SUBTTL	Paper tape punch service -- Blank folds


;Call	T1/ Count of Blank folds to ppunch

;Returns after punching at least 10 blank frames and
;stopping tape at a fold

BLKFLD:	MOVE	S1,J$TBCT(J)		;GET TOTAL BYTE COUNT
	IDIVI	S1,CHPFLD		;EXTRACT REMAINDER
	MOVEI	S1,CHPFLD		;LOAD CHARACTERS PER FOLD
	IMUL	S1,T1			;MULTIPLY BY REQUESTED FOLDS
	ADD	S1,S2			;ADD REMAINDER FOR LAST FOLD
	CAIG	S1,^D10			;PUNCH AT LEASE 10 FRAMES
	ADDI	S1,CHPFLD
	SETZ	C,			;PUNCH BLANK FRAMES
	PJRST	PTPREP			;PUNCH SOME BLANK TAPE AND RETURN
SUBTTL	Paper tape punch service -- Letters


;SUBROUTINE TO PUNCH BLOCK CHARACTERS IN PAPER-TAPE

;CALL WITH ASCII CHARACTER TO PUNCH IN S1
;PUNCHES CHARACTER AS 5 7 BIT FRAMES FOLLOWED BY 2 BLANK FRAMES

T$LETR:	CAIL	S1,40			;IN RANGE?
	CAILE	S1,177
	 POPJ	P,0			;NO -- RETURN
	CAILE	S1,"_"			;UPPER CASE?
	SUBI	S1,40			;NO -- CONVERT TO UC
	MOVEI	S1,CHRTAB-40(S1)	;POINT TO BITS
	HRLI	S1,(POINT 7,0)		;MAKE BYTE POINTER
	MOVSI	S2,-5			;MAKE AOBJN POINTER
TLET.1:	ILDB	C,S1			;GT SEGMENT BITS
	PUSHJ	P,PTPBYT		;OUTPUT BYTE
	AOBJN	S2,TLET.1		;REPEAT FOR ALL SEGMENTS
	MOVEI	S1,2			;REPEAT COUNT
	MOVEI	C,0			;CHARACTER
	PJRST	PTPREP			;PUNCH SOME BLANK TAPE AND RETURN
SUBTTL	Paper tape punch service -- Byte output


; AC 'C' contains the byte to output
;
PTPBYT:	PUSH	P,S1			;SAVE FROM
	PUSH	P,S2			; DESTRUCTION
	PUSHJ	P,OUTBYT		;OUTPUT THE BYTE
	AOS	S1,J$TFRM(J)		;COUNT THE FRAME
	IDIVI	S1,FRMPFT		;COMPUTE FEET OF TAPE USED
	MOVEM	S1,J$APRT(J)		;STORE FOR ACCOUNTING PURPOSES
	CAMLE	S1,J$RLIM(J)		;EXCEEDED LIMIT ?
	PUSHJ	P,FRMLEX		;YES - ASK THE OPERATOR'S ADVICE
	POP	P,S2			;RESTORE
	POP	P,S1			; S1 & S2
	POPJ	P,			;RETURN


; Repeat the byte in AC 'C'
; Call:	MOVE	S1,repeat count
;	MOVE	C,byte to output
;	PUSHJ	P,PTPREP
;
PTPREP:	PUSH	P,P1			;SAVE P1
	MOVE	P1,S1			;GET COUNT
	PUSHJ	P,PTPBYT		;OUTPUT A BYTE
	SOJG	P1,.-1			;AND LOOP
	POP	P,P1			;RESTORE P1
	POPJ	P,			;RETURN
SUBTTL	Character Bit Array for 5 X 7 Character Matrix

CHRTAB:	BYTE (7) 000,000,000,000,000	;SPACE
	BYTE (7) 000,000,175,000,000	;!
	BYTE (7) 000,140,000,140,000	;"
	BYTE (7) 024,177,024,177,024	;#
	BYTE (7) 072,052,177,052,056	;$
	BYTE (7) 143,144,010,023,143	;%
	BYTE (7) 056,121,051,006,005	;&
	BYTE (7) 000,000,100,140,000	;'
	BYTE (7) 034,042,101,000,000	;(
	BYTE (7) 000,000,101,042,034	;)
	BYTE (7) 052,034,066,034,052	;*
	BYTE (7) 010,010,076,010,010	;+
	BYTE (7) 000,000,002,003,000	;,
	BYTE (7) 010,010,010,010,010	;-
	BYTE (7) 000,000,003,003,000	;.
	BYTE (7) 001,002,004,010,020	;/
	BYTE (7) 076,105,111,121,076	;0
	BYTE (7) 000,041,177,001,000	;1
	BYTE (7) 041,103,105,111,061	;2
	BYTE (7) 042,101,101,111,066	;3
	BYTE (7) 170,010,010,177,010	;4
	BYTE (7) 162,121,121,111,106	;5
	BYTE (7) 076,111,111,111,006	;6
	BYTE (7) 101,102,104,110,160	;7
	BYTE (7) 066,111,111,111,066	;8
	BYTE (7) 060,111,111,111,076	;9
	BYTE (7) 000,000,066,066,000	;:
	BYTE (7) 000,000,066,067,000	;;
	BYTE (7) 010,024,042,101,000	;<
	BYTE (7) 024,024,024,024,024	;=
	BYTE (7) 000,101,042,024,010	;>
	BYTE (7) 040,100,105,110,060	;?
	BYTE (7) 076,100,117,111,077	;@
	BYTE (7) 077,104,104,104,077	;A
	BYTE (7) 177,111,111,111,066	;B
	BYTE (7) 076,101,101,101,101	;C
	BYTE (7) 177,101,101,101,076	;D
	BYTE (7) 177,111,111,111,101	;E
	BYTE (7) 177,110,110,110,100	;F
	BYTE (7) 076,101,105,105,106	;G
	BYTE (7) 177,010,010,010,177	;H
	BYTE (7) 000,101,177,101,000	;I
	BYTE (7) 006,001,001,001,176	;J
	BYTE (7) 177,010,010,024,143	;K
	BYTE (7) 177,001,001,001,001	;L
	BYTE (7) 177,040,020,040,177	;M
	BYTE (7) 177,020,010,004,177	;N
	BYTE (7) 076,101,101,101,076	;O
	BYTE (7) 177,110,110,110,060	;P
	BYTE (7) 076,101,105,102,075	;Q
	BYTE (7) 177,110,114,112,061	;R
	BYTE (7) 061,111,111,111,106	;S
	BYTE (7) 100,100,177,100,100	;T
	BYTE (7) 177,001,001,001,177	;U
	BYTE (7) 174,002,001,002,174	;V
	BYTE (7) 177,002,004,002,177	;W
	BYTE (7) 143,024,010,024,143	;X
	BYTE (7) 140,020,017,020,140	;Y
	BYTE (7) 103,105,111,121,141	;Z
	BYTE (7) 000,177,101,000,000	;[
	BYTE (7) 020,010,004,002,001	;\
	BYTE (7) 000,000,101,177,000	;]
	BYTE (7) 010,020,076,020,010	;^
	BYTE (7) 010,034,052,010,010	;
SUBTTL	Common Utilities

;PUTERR	Routine to Move error Messages into J$XERR Buffer

; Call:	MOVE	S1,address if ITEXT block
;	PUSHJ	P,PUTERR
;
PUTERR:	$CALL	SETEBF			;POINT $TEXT TO ERROR BUFFER
	$TEXT	(DEPBP,<? ^I/0(S1)/^0>)	;YES -- MOVE TO BUFFER
	$RETT


;HERE TO PRINT THE STRING IN J$XTBF(J) ON THE DEVICE
STRING:	$SAVE	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,[POINT 7,J$XTBF(J)]	;LOAD A BYTE POINTER
	MOVE	P2,J$LSER(J)		;AND ADDRESS OF DISPATCH TABLE

STRI.1:	ILDB	S1,P1			;GET A BYTE
	JUMPE	S1,.RETT		;END OF STRING
	PUSHJ	P,DLETR(P2)		;PRINT THE LETTER
	JRST	STRI.1			;AND LOOP


;HERE TO SETUP A BYTE POINTER TO THE J$XTBF(J) BUFFER
SETTBF:	MOVEI	TF,J$XTBF(J)		;GET THE ADDRESS OF TEXT BUFFER
	HRLI	TF,(POINT 7,0)		;MAKE A POINTER
	MOVEM	TF,TEXTBP		;STORE THE BYTE POINTER
	MOVEI	TF,TXT$LN*5		;GET BYTE COUNT
	MOVEM	TF,TEXTBC		;AND SAVE IT
	SETZM	J$XTBF(J)		;ZAP FIRST WORD
	$RETT				;AND RETURN

SETEBF:	MOVEI	TF,J$XERR(J)		;GET THE ADDRESS OF ERROR BUFFER
	HRLI	TF,(POINT 7,0)		;MAKE A POINTER
	MOVEM	TF,TEXTBP		;STORE THE BYTE POINTER
	MOVEI	TF,ERR$LN*5		;GET BYTE COUNT
	MOVEM	TF,TEXTBC		;AND SAVE IT
	SETZM	J$XERR(J)		;ZAP FIRST WORD
	$RETT				;AND RETURN

;HERE TO DISPATCH TO A processing ROUTINE BASED ON FILE MODE.
;	S1 CONTAINS THE MODE-TABLE ADDRESS AND S2 CONTAINS THE ROUTINE-
;	TABLE ADDRESS.
DSPMOD:	$SAVE	<T1,T2,T3,T4>		;SAVE SOME ACS
	MOVE	T1,J$DMOD(J)		;GET THE MODE
	IMULI	T1,3			;3 BITS/MODE
	DMOVE	T2,0(S1)		;GET THE MODE TABLE
	LSHC	T2,(T1)			;GET THE CORRECT BYTE ON TOP
	LDB	T2,[POINT 3,T2,2]	;AND PICK IT UP
	JUMPE	T2,BADMOD		;LOSE BIG
	ADD	S2,T2			;ELSE ADD IT IN
	JRST	@-1(S2)			;AND DISPATCH

BADMOD:	MOVEI	S1,[ITEXT (<Illegal file mode ^O/T2/>)]
	PJRST	PUTERR			;AND FORCE IT OUT
;HERE TO COMPUTE A FOLDED 12 BIT CHECKSUM FOR CARDS AND PAPER-TAPE

;CALL:	S1/ MAXIMUM BLOCKSIZE
;
;T RET:	S1/ ACTUAL BLOCKSIZE
;	S2/ CHECKSUM
;	THE DATA READ (C[S1] WORDS) IS BUFFERED IN J$XCHB(J)
;
;F RET:	EOF ON FIRST TRY
;
;	* * * THIS ROUTINE DEPENDS ON AN INPUT BYTE-SIZE OF 36 BITS * * *

CHKSUM:	$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	MOVE	P1,S1			;SAVE MAXIMUM BLOCKSIZE
	MOVN	P2,S1			;GET NEGATIVE BLOCKSIZE
	HRLS	P2			;PUT IT IN LEFT HALF
	HRRI	P2,J$XCHB(J)		;AND POINT TO THE INTERMEDIATE BUFFER
	SETZ	P3,			;AND ZERO THE CHECKSUM

CHKS.1:	$CALL	INPBYT			;GET A WORD
	JUMPF	CHKS.2			;JUMP ON EOF
	ADD	P3,C			;ACCUMULATE A CHECKSUM
	MOVEM	C,0(P2)			;SAVE THE DATA WORD
	AOBJN	P2,CHKS.1		;AND LOOP
	JRST	CHKS.3			;GET A COMPLETE BLOCK!!

CHKS.2:	HLRES	P2			;GET WHAT'S LEFT OF NEGATIVE COUNT
	ADD	P1,P2			;AND GET ACTUAL BLOCKSIZE IN P1
	JUMPE	P1,.RETF		;IF NONE, RETURN FALSE

					;  /      P3      /      P4      /
					;  /--------------/--------------/
					;  /   1!   2!   3/   X!   X!   X/
CHKS.3:	LSHC	P3,-^D24		;  /   0!   0!   1/   2!   3!   X/
	LSH	P4,-^D12		;  /   0!   0!   1/   0!   2!   3/
	ADD	P3,P4			;  /   0! 2+C! 1+3/   0!   2!   3/
	LSHC	P3,-^D12		;  /   0!   0! 2+C/ 1+3!   0!   2/
	LSH	P4,-^D24		;  /   0!   0! 2+C/   0!   0! 1+3/
	ADD	P3,P4			;  /   0!C+C1!123 /   0!   0! 1+3/
					;  /--------------/--------------/

	TRZE	P3,770000		;TEST FOR CARRY (THIS IS A 1-COMP ADD)
	ADDI	P3,1			;YES, END-AROUND
	MOVE	S1,P1			;GET BLOCKSIZE IN S1
	MOVE	S2,P3			;GET CHECKSUM IN S2
	$RETT				;AND RETURN
SUBTTL	Interrupt Module

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

;DOSTRMS MACRO TO REPEAT CODE FOR MULTIPLE STREAM

DEFINE	DOSTRMS (CODE) <
	LSTOF.
	Z==0				;CLEAR STREAM INDEX
	ZZ==.				;SAVE TO COMPUTE TOTAL LENGTH
  REPEAT NSTRMS,<			;REPEAT FOR EACH STREAM
	CODE
	Z==Z+1				;INCREMENT STREAM INDEX
  > ;END REPEAT NSTRMS
	ZZ==.-ZZ			;COMPUTE TOTAL LENGTH
	LSTON.
> ;END DEFINE DOSTRMS
;INTERRUPT SYSTEM DATABASE


TOPS20 <
	.ICIPC==0			;INTERUPT CHANNEL FOR IPCF
	.ICODN==^D35			;INTERUPT CHANNEL FOR OUTPUT DONE

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 CHANNEL 0
  DOSTRMS <				;REPEAT FOR EACH STREAM
	XWD	1,INTDEV+<DVHDSZ*Z>	;LEVEL 1, DEVICE HEADER CODE
  > ;END DOSTRMS
	BLOCK	^D35-NSTRMS		;CLEAR REST OF TABLE

>  ;END TOPS20 CONDITIONAL
TOPS10 <
INTINI:	MOVEI	S1,INTIPC		;GET ADDRESS OF IPCF INT RTN
	MOVEM	S1,VECIPC+.PSVNP	;SAVE IN VECTOR

  DOSTRMS <				;REPEAT FOR EACH STREAM
	MOVEI	S1,INTDEV+<DVHDSZ*Z>	;GET DEVICE HEADER ADDRESS
	MOVEM	S1,VECDEV+<4*Z>+.PSVNP	;STORE HEADER ADDRESS IN VECTOR
  > ;END DOSTRMS

	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <

;BUILD ACTIVE CHANNEL MASK
	INTMSK==<1B<.ICIPC>+MASK.(NSTRMS,NSTRMS)+1B<.ICODN>> 

INTINI:	MOVX	S1,.FHSLF		;LOAD MY FORK HANDLE
	MOVX	S2,INTMSK		;CHANNEL MASK
	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
	MOVE	T1,J$LJFN(J)		;USE CHANNEL AS CONDTION
	HRRZ	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	;AND CONDITIONS
	SETZ	T3,			;ZERO T3
	PISYS.	S1,			;TO THE INTERRUPT SYSTEM
	  HALT
	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
INTCNL:	MOVE	S1,J$LJFN(J)		;GET THE DEV JFN
	MOVX	S2,.MOPSI		;GET MTOPR FUNCTION
	MOVEI	T1,T2			;AND ADDRESS OF ARGS
	MOVEI	T2,3			;1ST ARG IS # ARGS
	HRRZ	T3,STREAM		;2ND ARG IS INT CHANNEL NUMBER
	ADDI	T3,1			;INT CHANNEL IS STREAM PLUS 1
	MOVX	T4,MO%MSG		;DON'T TYPE THE MESSAGE
	MTOPR				;DO IT
	ERJMP	.+1			;IGNORE THE ERROR
	POPJ	P,			;AND RETURN
>  ;END TOPS20 CONDITIONAL
SUBTTL	IPCF and DEVICE Interrupt service for TOPS10

TOPS10 <

INTIPC:	$BGINT	1,			;SETUP FOR INTERRUPT
	$CALL	C%INTR			;FLAG THE INTERRUPT
	$DEBRK				;DISMISS INTERRUPT

;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, DVINTR.  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.

INTDEV:					;ADDRESS OF HEADER FOR STREAM 0
  DOSTRMS <				;REPEAT FOR EACH STREAM
	$BGINT	1,			;SETUP FOR INTERRUPT
	MOVEI	S1,Z			;LOAD STREAM NUMBER IN S1
	MOVEI	S2,VECDEV+<4*Z>		;LOAD DEVICE VECTOR ADDRESS
	JRST	DVINTR			;ENTER COMMON CODE
  > ;END DOSTRMS

	DVHDSZ==ZZ/NSTRMS		;COMPUTE SIZE OF HEADER CODE

DVINTR:	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
	SKIPN	JOBACT(S1)		;IS STREAM ACTIVE?
	JRST	INTDON			;NO -- IGNORE THE INTERRUPT
	MOVX	T2,PSF%OB		;GET OUTPUT BLOCKED FLAG
	TXNE	T1,PS.ROL		;IS IT ON-LINE?
	TXO	T2,PSF%DO		;YES, GET THE OFF-LINE FLAG
	ANDCAM	T2,JOBSTW(S1)		;CLEAR THE SCHEDULER FLAGS
	MOVE	T2,.PSVIS(S2)		;[QAR 10-4903] GET EXTRA STATUS
	DMOVEM	T1,J$LIOS(J)		;SAVE IT
	TXNN	T1,PS.RDO		;IS IT DEVICE OFF-LINE?
	JRST	INTDON			;NO, RETURN
	TXNE	T1,PS.ROL		;IF BOTH OFFLINE AND ONLINE,
	JRST	INTDON			;ASSUME ITS ONLINE
	MOVX	T1,PSF%DO		;GET SCHED OFFLINE FLAG
	IORM	T1,JOBSTW(S1)		;SET IT
	MOVEI	T1,OUTWON		;LOAD RESTART ADDRESS
	EXCH	T1,.PSVOP(S2)		;STORE FOR DEBRK AND GET OLD ADRESS
	MOVEM	T1,J$LIOA(J)		;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
INTDON:	$DEBRK				;DISMISS INTERRUPT

>  ;END TOPS10 CONDITIONAL
SUBTTL	IPCF and DEVICE interrupt service for TOPS20

TOPS20 <

INTIPC:	$BGINT	1,			;SET UP FOR INTERRUPT
	$CALL	C%INTR			;FLAG THE INTERRUPT
	SKIPL	T1,STREAM		;ARE WE IN STREAM CONTEXT?
	JRST	INTDON			;YES -- ENTER COMMON ENDING
	$DEBRK				;NO -- JUST DISMISS INTERRUPT

;Here on device interrupts on the -20.

INTDEV:					;ADDRESS OF CODE FOR STREAM 0
  DOSTRMS <				;REPEAT FOR EACH STREAM
	$BGINT	1,			;SETUP FOR INTERRUPT
	MOVEI	T1,Z			;LOAD STREAM NUMBER
	JRST	DVINTR			;ENTER COMMON CODE
  > ;END DOSTRMS

	DVHDSZ==ZZ/NSTRMS		;COMPUTE SIZE OF HEADER CODE

DVINTR:	SKIPN	J,JOBPAG(T1)		;DOES STREAM HAVE A JOB PAGE?
	JRST	INTBRK			;NO -- JUST DISMISS INTERUPT
	$CALL	OUTSTS			;YES -- GET DEVICE STATUS
	MOVX	S2,PSF%DO		;GET SCHEDULER OFF LINE FLAG
	ANDCAM	S2,JOBSTW(T1)		;ASSUME WE'RE ON LINE
	TXNE	S1,MO%OL		;IS IT OFF-LINE?
	IORM	S2,JOBSTW(T1)		;YES -- SET FLAG

INTDON:	SKIPN	J,JOBPAG(T1)		;MUST HAVE A JOB PAGE
	JRST	INTBRK			;NO -- JUST DISMISS INTERRUPT
	MOVEI	S1,OUTINT		;SET UP TO BREAK OUT OF SOUT
	SKIPE	J$LIOA(J)		;ARE WE IN SOUT?
	MOVEM	S1,LEV1PC		;YES -- BREAK OUT ON $DEBRK
INTBRK:	$DEBRK
;**;[6002]At INTBRK:+1L add routines  FNDBLK, SNDNUL, SETREM, FNDREM, TRSREM
	SUBTTL	FNDBLK - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE

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

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

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

FNDB.2:	MOVEI	S1,ARG.DA(S1)		;[6002]Point to the data field
	$RETT				;[6002]And return
	SUBTTL	SNDNUL - Routine to send a Null ACK to NEBULA

;[6002]SNDNUL determines if a Null ACK message must be sent to NEBULA as the
;[6002]result of a remote operator answering a response (.OMRSP) message. If
;[6002]such is the case, then a Null ACK message is sent.
;[6002]Call is:       J/Stream data base
;[6002]Returns true:  A Null ACK (.OMNAK) message has been sent to NEBULA
;[6002]Returns false: A Null ACK message does not need to be sent to NEBULA
;[6002]Side effects:  J$NULA(J) is zeroed

SNDNUL:	SKIPN	J$NULA(J)	;[6002]Need to send a Null ACK?
	$RETF			;[6002]No, indicate so
	SETOM	G$NEBF		;[6002]Indicate remote origin to $NUL
	MOVE	S1,J$RNOD(J)	;[6002]Pick up node where message originated
	MOVEM	S1,G$REMN	;[6002]Place where it is expected by $NUL
	$NUL	(J$RPID(J))	;[6002]Send a Null ACK to NEBULA
	SETZM	J$NULA(J)	;[6002]Don't send any more Null ACKs
	$RETT			;[6002]Indicate a Null ACK has been sent
	SUBTTL	SETREM - Set Up the Remote Origin Indicators From Stream

;[6002]SETREM determines if a remote operator has been involved in the
;[6002]processing of the current batch stream by means of answering a
;[6002]WTOR. If such is the case, then G$REMN and G$NEBF are set up
;[6002]appropriatly. This routine is called before sending a WTO so that
;[6002]ORION may forward the WTO to the node of the remote operator.
;[6002]
;[6002]Call is:       J/Stream data base
;[6002]Returns true:  A remote operator has been involved with this stream
;[6002]Returns false: A remote operator has not been involved with this stream

SETREM:	MOVE	S1,J$NEBF(J)		;[6002]Pick up the remote origin bit
	MOVEM	S1,G$NEBF		;[6002]Place where $Qxxxx expects it
	SKIPN	S1			;[6002]Remote operator been involved?
	$RETF				;[6002]No, indicate so
	MOVE	S1,J$RNOD(J)		;[6002]Pick up remote node name
	MOVEM	S1,G$REMN		;[6002]Place where $Qxxx expects it
	$RETT				;[6002]Return
	SUBTTL	FNDREM - Set Up the Remote Origin Indicators From IPCF

;[6002]FNDREM is called during the processing of an IPCF message after it
;[6002]has been determined that the message originated from a remote
;[6002]operator. FNDREM determines the node of the remote operator and
;[6002]saves the node name in G$REMN.
;[6002]
;[6002]Call is:       M/IPCF message address
;[6002]Returns true:  S1/Remote node name
;[6002]               G$REMN/Remote node name
;[6002]Returns false: Remote node name block not found

FNDREM:	MOVEI	S1,.NDENM		;[6002]Remote node name block
	$CALL	FNDBLK			;[6002]Check for remote node name block
	$RETIF				;[6002]Remote node name block not found
	MOVE	S1,0(S1)		;[6002]Pick up the node name
	MOVEM	S1,G$REMN		;[6002]Save for later
	$RETT				;[6002]Indicate success

	SUBTTL	TRSREM - Transfer Remote Data From IPCF to Stream Data Base

;[6002]TRSREM is called by those operator action commands (ABORT, CANCEL
;[6002]and REQUEUE) that, in addition to an ACK, will result in a WTO
;[6002]being sent to ORION at a later time. TRSREM preserves the remote
;[6002]origin information so that the WTO may be forwarded to the remote
;[6002]operator. 
;[6002]
;[6002]Call is: J/Stream data base address
;[6002]	        M/The IPCF message address
;[6002]Returns: The data stream's remote origin indicators have been updated
;[6002]
;[6002]Note: it is assumed that G$REMN contains the remote node name. 

TRSREM:	SETOM	J$NEBF(J)		;[6002]Indicate remote request
	MOVE	S1,G$REMN		;[6002]Pick up the remote node name
	MOVEM	S1,J$RNOD(J)		;[6002]Place in the stream data base
	MOVE	S1,.MSCOD(M)		;[6002]Pick up the remote PID
	MOVEM	S1,J$RPID(J)		;[6002]Place in the stream data base
	SETZM	J$NULA(J)		;[6002]Don't need to send a Null ACK
	$RET				;[6002]Return

REMERR:	$WTOJ	(<Illegally formatted message from NEBULA detected>,<SPROUT detected an illegally formatted mesage>,,<$WTFLG(WT.SJI)>);[6002]
	$RET				;[6002]Return

>  ;END TOPS20 CONDITIONAL
SPOEND::END	SPROUT