Google
 

Trailing-Edge - PDP-10 Archives - BB-D868D-BM - language-sources/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 - Version 4
SUBTTL	D.A. Lewine - L.S. Samberg/PJT 28-Mar-79

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


	SEARCH	GLXMAC			;SEARCH GLXLIB SYMBOLS
	PROLOGUE(SPROUT)		;DO STANDARD PROLOG
	SEARCH	QSRMAC			;GET QUASAR SYMBOLS
	SEARCH	ORNMAC			;GET OPERATOR SYMBOLS


;VERSION INFORMATION
	SPOVER==4			;MAJOR VERSION NUMBER
	SPOMIN==0			;MINOR VERSION NUMBER
	SPOEDT==2437			;EDIT LEVEL
	SPOWHO==0			;WHO LAST PATCHED

	%SPO==<BYTE (3)SPOWHO(9)SPOVER(6)SPOMIN(18)SPOEDT>

;STORE VERSION NUMBER IN JOBVER
	LOC	137
.JBVER:: EXP	%SPO			;SPROUT VERSION

	RELOC	0
SUBTTL TABLE OF CONTENTS

;               TABLE OF CONTENTS FOR SPROUT
;
;
;                        SECTION                                   PAGE
;    1. TABLE OF CONTENTS.........................................   2
;    2. Revision History..........................................   3
;    3. Constants  (Conditional and Unconditional)................   4
;    4. MACROS....................................................   5
;    5. Special Forms Handling Parameters.........................   6
;    6. Flag Definitions..........................................   8
;    7. Job Parameter Area........................................   9
;    8. Random Impure Storage.....................................  12
;    9. Resident JOB DaTABase.....................................  13
;   10. Non-zero daTABase.........................................  14
;   11. $TEXT Utilities and common Messages.......................  15
;   12. Program Initialization....................................  16
;   13. Idle Loop.................................................  17
;   14. Deschedule Process........................................  18
;   15. Do the Job................................................  19
;   16. Process a File............................................  20
;   17. End of Job................................................  21
;   18. FILDIS  Routine to KEEP/DELETE requested files............  21
;   19. CHKQUE  Routine to process IPCF messages..................  22
;   20. CHKOBJ  Routine to validate QUASAR/ORION/OPR MSG Object block  23
;   21. FNDOBJ  Routine to establish STREAM context...............  24
;   22. GETBLK  Routine to return next argument from an OPR/ORION message  25
;   23. NEXTJOB Message from QUASAR...............................  26
;   24. User CANCEL Request.......................................  27
;   25. CHKSTS Routine to send status update and checkpoint to Quasar  28
;   26. Request for Checkpoint....................................  29
;   27. SETUP/SHUTDOWN Message....................................  30
;   28. Response to setup message.................................  31
;   29. Operator CANCEL command...................................  32
;   30. Operator STOP command.....................................  33
;   31. Operator CONTINUE command.................................  33
;   32. Operator RESPONSE command.................................  33
;   33. Operator REQUEUE command..................................  34
;   34. CLRMSG and SNDQSR routines................................  35
;   35. Accounting routines.......................................  36
;   36. FORMS   --  Setup Forms for a job.........................  38
;   37. Forms switch Subroutines..................................  42
;   38. Plotter only switches.....................................  43
;   39. I/O Subroutines for SPFORM.INI............................  44
;   40. INPOPN  --  Routine to open the input file................  46
;   41. INPBUF  --  Read a buffer from the input file.............  47
;   42. INPBYT  --  Read a byte from the input file...............  47
;   43. INPERR  --  Handle an input failure.......................  47
;   44. INPFEF  --  Force end-of-file on next input...............  47
;   45. INPREW  --  Rewind the input file.........................  47
;   46. OUTGET  --  OPEN the output device........................  48
;   47. OUTBYT  --  Deposit a byte in the output buffer...........  51
;   48. OUTOUT  --  Routine to output a buffer....................  52
;   49. DEVERR  --  Handle Output Device Errors...................  53
;   50. Buffer routines and discriptions for TOPS20...............  54
;   51. Routine to Setup Inferior Process to do OUTPUT to device..  55
;   52. Fork IO Code for TOPS20...................................  56
;   53. TOPS20 Output Code to Drive Inferrior Fork................  57
;   54. OUTREL  --  Release output device.........................  58
;   55. OUTWON  --  Wait for on-line..............................  59
;   56. OUTFLS Routine to flush output buffers....................  60
;   57. Card-punch Service Routines...............................  61
;   58. Card File Header and Trailer Routines.....................  67
;   59. Card Job Banner and Trailer Routines......................  68
;   60. Card Block Word and Letter Routines.......................  69
;   61. Plotter Service Routines..................................  71
;   62. PLOTTER BANNER HEADER AND TRAILER ROUTINES................  73
;   63. Routine to Plot line Segment..............................  76
;   64. Plotter Rotation and XY20 Translation table...............  78
;   65. PLTBYT  Routine to plot a single character................  79
;   66. Plotter Character Table and Segement Codes................  82
;   67. Paper-tape punch Service Routines.........................  86
;   68. Tape Trailer and Blank Fold Routines......................  92
;   69. Character Bit Array for 5 X 7 Character Matrix............  94
;   70. Common Utilities..........................................  96
;   71. Interrupt Module..........................................  98
;   72. IPCF and DEVICE Interrupt service for TOPS10.............. 102
;   73. IPCF and DEVICE interrupt service for TOPS20.............. 103
SUBTTL	Revision History

;2000	First GALAXY-10 Field-Test release, June, 1975.
;2100	Make this version 2, August, 1976.

;;First field-test release of GALAXY release 2, Jan 1977

;2400	MAKE THIS VERSION 4, APRIL 1977.
;	(NOTE: RELEASE 3 OF GALAXY WAS TOPS20 ONLY AND DID NOT INCLUDE SPROUT)
;	INSERT CHANGES FOR NEW FP/FD.
;2401	START CONVERTING TO USE GLXLIB INSTEAD OF CSP??? AND SBS???.
;2402	FIX UP AC CONVENTIONS TO BE COMPATIBLE WITH GLXLIB.
;2403	MAKE SPROUT INTO A SINGLE SEGMENT AND DO A CODE CLEANUP.
;2404	START MERGING IN GLXFIL USAGE FOR THE INPUT FILE.
;2405	MORE OF 2404 AND START REPLACING LUUOS WITH $TEXTS.
;2406	MAKE MORE USE OF $TEXT.
;2407	MANY MINOR BUG FIXES AND CHANGES.
;2410	SOME MAJOR CODE CLEANUP.
;2411	START MAJOR RE-WORK OF SPROUT TO MAKE MORE USE OF GLXLIB AND TO
;	TALK WITH THE NEW OPERATOR INTERFACE.
;2412	CHANGE IMAGE MODE ON THE CDP TO IGNORE EACH 81ST BYTE READ
;	FROM DISK SO THAT IT IS COMPATIBLE WITH SPRINT AND PIP.
;2413	DONT ENFORCE LIMITS ON PTP AND PLT SINCE THE LIMITS ARE DIRECTLY
;	DERIVABLE FROM THE FILE-SIZE.
;2414	DO SOME CODE CLEANUP.
;2415	Code Cleanup and add plotter and card letter routines
;2416	Added Forms processing for SPFORM.INI File
;2417	Added MSGFLG and Changed interrupt and Scheduling code
;	to set/check msgflg for IPCF messages
;2420	Added code to check length of message for DEP6BP and DEPBP
;2421	Removed msgflg (twas a bad idea)
;2422	Fixed OUTOUT and DEVERR for TOPS10
;2423	Fixed ACTION operator message processing
;2424	Fixed Offline device interrupt code
;2425	Updated to new library and message formats
;2426	Added preliminary accounting parameters
;	Added two pass scheduling algorithm to allow mulitple
;	devices to operate in parallel on TOPS20
;2427	Fixed bug in INPOPN regarding access checks
;	Moved impure interrupt stuff to impure storage
;	Added call to I%HOST to get local node name
;2430	Changed all message processing to use ac M
;	Changed scheduling loop to WAIT instead of SLEEP
;	when no jobs are scheduable
;2431	Added correct mulitple stream runtime accounting code
;2432	Put IB.PRG back into IB
;2433	add Mount Bypass
;2434	Add WTOR kill code  (AWC)
;2435	Fix a $TEXT bug - IQN Stopcode (AWC)
;2436	Put in Null routines for TOPS10 accounting
;2437	Fix Plotter Banner Header and Trailer code
SUBTTL	Constants  (Conditional and Unconditional)
;2431	Moved FILDIS to QRELEAS
;	Added Invalid account check to NXTJOB

;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

;RANDOM CONSTANTS
	ND	PDSIZE,100		;SIZE OF PUSHDOWN LIST
	ND	CPC,^D80		;CHARACTERS PER CARD
	ND	CHPFLD,^D90		;CHARACTERS PER FOLD OF PTP
	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,^D10		;LENGTH OF JOB ERROR TEXT BUFFER
	ND	NBFRS,2			;NUMBER OF BUFFERS TO CREATE
	ND	NJBPGS,3		;NUMBER OF JOB PAGES TO CREATE

					;*** FORK CODE CANNOT BE ON ***
	ND	FTFKIO,0		;-1 TO INCLUDE INFERIOR IO FORK
	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

	CONT.	(Constants)		;FORCE NEW LISTING PAGE

;PLOTTER MOTION CHARACTERS
	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	XYL,10			;-X   MOVE LEFT
	XP	XYR,4			;+X   MOVE RIGHT
	XP	XYU,2			;+Y   MOVE UP
	XP	XYD,1			;-Y   MOVE DOWN
	XP	XYUL,12			;-X+Y MOVE UP+LEFT
	XP	XYDL,11			;-X-Y MOVE DOWN+LEFT
	XP	XYUR,06			;+X+Y MOVE UP+RIGHT
	XP	XYDR,05			;+X-Y MOVE DOWN+RIGHT

	XP	MARSTP,^D20		;STEPS IN MARGIN
	XP	CHRSIZ,^D20		;MAXIUM CHARACTER SIZE
SUBTTL	MACROS


;MACRO TO GENERATE TBLUK TABLES

DEFINE	TB (RESPONSE,CODE) <
	[ASCIZ/RESPONSE/],,CODE>


DEFINE IOFORK <IFN FTFKIO,>		;END DEFINE IOFORK
DEFINE NOFORK <IFE FTFKIO,>

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
;	ORIGIN:XX:YY	POINT TO LOCATE PEN IN FORM

;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,2
	FF	TRAILER,2
	FF	HEADER,2
	FF	NOTE,0
	FF	SPU,1
	FF	SIZE,0
	FF	MINIMUM,0
	FF	MAXIMUM,0
	FF	ORIGIN,0
	FF	GUIDE,0
>


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

FFNAMS:	SWITCHES

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

FFDEFS:	SWITCHES
	F$NSW==.-FFDEFS
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

TOPS20 <
  IOFORK <
	LP	J$STRM,1		;STREAM NUMBER
	LP	J$IFRK,1		;FORK HANDLE
	LP	J$IHDR,2		;CURRENT BUFFER HEADER
	LP	J$IBHB,<4*NBFRS>	;4 WORDS PER BUFFER HEADER
	LP	J$ICOD,200		;FORK IO CODE LIVES HERE
  > ;END IOFORK CONDITIONAL
> ;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$FMSP,1,Z		;FORMS WTO/WTOR PAGE ADDRESS
	LP	J$FPLT,1		;FORMS TYPE FOR PLOTTER

;STORAGE FOR CURRENT FORMS SWITCHS

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

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

;STORAGE FOR PREVIOUS FORMS SWITCHES

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

	LP	J$FPRM,0		;ORIGIN OF PREVIOUS SWITCHES
	SWITCHES			;ONE LOCATION 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$XPOS,1		;CURRENT PLOTTER X COORDINATE
	LP	J$XLIM,1		;HIGHEST XSTEP SEEN THIS PLOT
	LP	J$XMIN,1		;X MINIMUM POINT IN FORM
	LP	J$XORG,1		;X ORIGIN IN FORM
	LP	J$XMAX,1		;X MAXIMUM POINT IN FORM
	LP	J$XSIZ,1		;NUMBER OF X STEPS 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$YORG,1		;Y ORIGIN IN FORM
	LP	J$YMAX,1		;MAXIMUM ALLOWABLE Y COORDINATE
	LP	J$YSIZ,1		;NUMBER OF Y STEPS IN FORM
	LP	J$ORGF,1		;-1 IF ORIGIN NEED TO BE RESET
	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$GSIZ,1		;GUIDE 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
;ACCOUNTING BLOCK

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

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

PDL:	BLOCK	PDSIZE			;PUSHDOWN LIST

LOWBEG:					;BEGINNING OF AREA TO CLEAR ON STARTUP

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
FOB:	BLOCK	FOB.SZ			;FILE OPEN BLOCK

JIFSEC:	BLOCK	1			;JIFFIES/SEC
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
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			;-1 IF CHECKPOINT 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:	EXP	FFD$LN			;FILE DISCRIPTOR LENGTH
	ASCIZ	/SYS:SPFORM.INI/
	FFD$LN==.-FRMFD			;COMPUTE FD LENGTH
> ;END TOPS20 CONDITIONAL
SUBTTL	$TEXT Utilities and common Messages

JOBBAN:	ITEXT <Start ^R/.EQJBB(J)/ ^H/[-1]/>
JOBTRA:	ITEXT <^T/J$XERR(J)/End ^R/.EQJBB(J)/ ^C/[-1]/>

USRNAM:	ITEXT <^T/.EQOWN(J)/>

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

SPROUT:	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
>  ;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

	$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
	SKIPE	JOBCHK(P1)		;CHECKPOINT REQUESTED?
	$CALL	CHKSTS			;YES -- DO IT
	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
	MOVSI	17,J$RACS(J)		;SETUP STREAM CONTEXT
	BLT	17,17			;RESTORE STREAM 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:	$CALL	CHKPNT			;TAKE A CHECKPOINT
	$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
	TXNE	S,ABORT!SKPFIL!RQB	;ABORTED OR SKIPPED OR REQUEUED?
	JRST	FILE.2			;YES, CONTINUE ON
	MOVE	S1,J$LSER(J)		;GET ADDRESS OF DEVICE DISPATCH
	PUSHJ	P,DTAIL(S1)		;AND DO A  FILE TRAILER
	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
	$RET				;AND RETURN
SUBTTL	End of Job

ENDJOB:	TXO	S,GOODBY		;FLAG EOJ SEQUENCE
	MOVE	S1,J$LSER(J)		;GET DEVICE DISPATCH TABLE
	PUSHJ	P,DEOJ(S1)		;DO A TRAILER IF NECESSARY
	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
	$WTOJ	(End,^R/.EQJBB(J)/,@JOBOBA(S1))
	$CALL	QRELEASE		;RELEASE THE JOB
	$CALL	ACTEND			;DO FINAL ACCOUNTING
	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.
	TXNE	T2,FP.SPL+FP.DEL	;SPOOL FILE or /DELETE ???
	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
	$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	REQCHK,.QORCK		;REQUEST-FOR-CHECKPOINT
	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.
	JUMPF	.RETF			;NOT THERE,,THATS AN ERROR.
	$RETT				;RETURN.


;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
	$RETT				;IF WE LEAVING, IGNORE IT ANYWAY
	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
	$CALL	INPFEF			;SET END OF FILE ALSO
	HRRZ	S1,STREAM		;POINT TO STREAM
	$WTOJ	(Canceled by user,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	MOVEI	S1,[ASCIZ /CBU/]	;GET THE ERROR CODE
	MOVEI	S2,[ITEXT(^U/ABO.ID(M)/)] ;USER'S ID
	$CALL	PUTERR			;AND DO THE MESSAGE
	$RETT				;AND RETURN
SUBTTL CHKSTS Routine to send status update and checkpoint to Quasar

;SENDS QUASAR STATUS UPDATE MESSAGE FOLLOWED BY A CHECKPOINT

CHKSTS:	MOVX	S1,STU.SZ		;GET STATUS UPDATE SIZE
	MOVX	S2,.QOSTU		; AND TYPE
	$CALL	CLRMSG			;INIT THE MESSAGE AND T1
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVE	S2,JOBSTW(S1)		;GET THE JOBS STATUS WORD
	MOVX	T2,%RESET		;DEFAULT TO RESET
	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
	PJRST	CHKPNT			;ALSO SEND A CHECK POINT
SUBTTL	Request for Checkpoint


REQCHK:	TXNE	S,GOODBY		;ARE WE ON THE WAY OUT?
	$RETT				;YES, IGNORE THE MESSAGE

CHKPNT:	MOVX	S1,CHE.SZ		;GET SIZE OF CHECKPOINT MESSAGE
	MOVX	S2,.QOCHE		;AND CHECKPOINT TYPE
	$CALL	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
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBCHK(S1)		;CLEAR THE REQUEST
CHKP.1:	$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/^0>)
	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			;AND SEND IT
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>			;PRESERVE AN AC
	$CALL	INPFEF			;FORCE EOF
	TXO	S,ABORT			;LIGHT THE ABORT FLAG
	MOVEI	P1,[ASCIZ/No reason given/] ;ASSUME NO REASON
	$CALL	SETTBF			;POINT AT 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

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
					;YES...
	MOVE	S1,0(T3)		;LOAD THE CANCEL TYPE.
	CAIE	S1,.CNPRG		;IS IT /PURGE ???
	JRST	OACC.1			;NO,,PROCESS THE NEXT MSG BLK
	HRRZ	S1,STREAM		;YES..GET THE STREAM NUMBER
	$ACK	(Purged,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	MOVEI	P1,[ASCIZ/Purged by operator/]
	$TEXT	(DEPBP,^T/0(P1)/)	;STORE THE REASON
	$CALL	ACTEND			;DO FINAL ACCOUNTING
	$CALL	QRELEASE		;RELEASE THE STREAM
	SETZM	JOBACT(S1)		;INDICATE NOT ACTIVE
	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.
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	CAIE	S1,%RSUOK		;DO WE STILL HAVE THE DEVICE?
	PJRST	SHUTUP			;NO..KILL THE STREAM
	$RETT				;RETURN

OACC.2:	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	$ACK	(Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TEl OPR
	$TEXT	(DEPBP,<^T/0(P1)/>)	;STORE THE REASON
	$RETT
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
	$ACK	(Stopped,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
	SETOM	JOBCHK(S1)		;REQUEST CHECKPOINT
	$RETT				;AND RETURN

SUBTTL	Operator CONTINUE command

OACCON:	MOVX	S2,PSF%ST		;LOAD THE STOP FLAG
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
	$ACK	(Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
	SETOM	JOBCHK(S1)		;REQUEST CHECKPOINT
	$RETT				;AND RETURN

SUBTTL	Operator RESPONSE command

OACRSP:	MOVE	S2,.MSCOD(M)		;GET WTOR ACK CODE.
	MOVSI	S1,-NSTRMS		;CREATE AOBJN AC.
RESP.1:	CAME	S2,JOBWAC(S1)		;COMPARE ACK CODES..
	JRST	[AOBJN S1,RESP.1	;NOT EQUAL,,CHECK NEXT STREAM.
		 $RETT	]		;NOT THERE,,FLUSH THE MSG.
	MOVX	S2,PSF%OR		;GET "OPERATOR-RESPONSE" WAIT BIT
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR IT
	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
	$RETT				;AND RETURN
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
	$ACK	(Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
	$CALL	SETTBF			;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

OACR.1:	PUSHJ	P,GETBLK		;GET A MESSAGE BLOCK
	JUMPF	.RETT			;NO MORE,,RETURN
	CAIN	T1,.REQTY		;IS THIS THE REQUEST TYPE BLOCK ???
	JRST	OACR.2			;YES,,GO PROGESS IT
	CAIN	T1,.ORREA		;IS THIS THE REASON BLOCK ???
	$TEXT(DEPBP,<Reason:^T/0(T3)/>)
	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.3		;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.3		;AND CONTINUE ON
	SETZM	J$RNCP(J)		;CLEAR CURRENT COPY NUMBER
	CAXN	S1,.RQBFL		;FROM BEGINING OF FILE?
	MOVEI	S2,[ASCIZ /Job will retart at current file/]
	JUMPN	S2,OACR.3		;AND CONTINUE ON
	SETZM	J$RNFP(J)		;CLEAR FILE COUNT
	MOVEI	S2,[ASCIZ /Job will restart at beginning/]
OACR.3:	$TEXT(DEPBP,<^T/0(S2)/>)	;STORE REQUE
	JRST	OACR.1			;GO PROCESS THE NEXT MSG BLOCK.
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)
SUBTTL	Accounting routines

TOPS10 <
ACTBEG:	$RETT				;JUST RETURN

ACTEND:	$RETT				;HERE ALSO

ACTRNT:	$RETT
>  ;END TOPS10 CONDITIONAL


TOPS20 <
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
	$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
	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
	$RETT				;ELSE RETURN
ACTE.1:	MOVE	S1,STREAM		;GET THIS STREAM NUMBER
	$WTO	(System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	$RETT				;RETURN
					;ACCOUNT PARAMETER BLOCK DEFINED ON THE NEXT PAGE
ACTRNT:	SKIPN	ACTFLG			;DOING ACCOUNTING?
	 $RETT				;NO..JUST RETURN
	MOVX	S1,.FHSLF		;GET MY FORK
	RUNTM				; RUNTIME
	ADDM	S1,ACTRNN		;STORE ACCUMULATED TIME
	MOVNS	S1			;NEGATE ACTUAL RUNTIME
	EXCH	S1,ACTRNN		;INIT FOR NEXT PASS
	SKIPE	S2,ACTPAG		;GET LAST PROCESSES PAGE ADDRESS
	ADDM	S1,J$ARTM(S2)		;ACCUMULATE TOTAL
	$RETT				;RETURN
	SEARCH	ACTSYM			;SEARCH THE ACCOUNTING UNV
ACTLST:	USENT.	(.UTOUT,1,1)
	USJNO.	(-1)			;JOB NUMBER
	USTAD.	(-1)			;CURRENT DATE/TIME
	USTRM.	(-1)			;TERMINAL DESIGNATOR
	USLNO.	(-1)			;TTY LINE NUMBER
	USPNM.	(<SIXBIT/SPROUT/>,US%IMM) ;PROGRAM NAME
	USPVR.	(%SPO,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(-1)			;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$XTBF(J)>)	;EXTRA TEXT
	USPRI.	(J$APRI(J))		;JOB PRIORITY
	USNM2.	(<POINT 7,.EQOWN(J)>)	;USER NAME
	0				;END OF LIST
>  ;END TOPS20 CONDITIONAL
	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,<SPROUT: Please load forms type '^W/J$FORM(J)/'>)

FORM.1:	HRLI	S1,J$FCUR(J)		;MOVE CURRENT SWITCH VALUES
	HRRI	S1,J$FPRM(J)		;TO PREVIOUS SWITCH VALUES
	BLT	S1,J$FPRM+F$NSW-1(J)	;DO ALL SWITCHES

	HRLI	S1,FFDEFS		;MOVE DEFAULT SWITCH VALUES
	HRRI	S1,J$FCUR(J)		;TO CURRENT SWITCH VALUES
	BLT	S1,J$FCUR+F$NSW-1(J)	;DO ALL SWITCHES

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,<Respond 'CONTINUE' when ready.^0>)
	HRRZ	S1,STREAM		;GET STREAM NUMBER
	$WTOR  (,<^T/J$XTBF(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
	$DSCHD	(PSF%OR)		;WAIT FOR OPERATOR RESPONSE.
	$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.1			;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.
	$WTOJ	(SPFORM.INI Error,<bad format>,@JOBOBA(S1)) ;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.
	$WTOJ	(SPFORM.INI Error,<Unrecognized SWITCH ^W/T1/ found.>,@JOBOBA(S1))
	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 -- FINISH UP
	MOVE	T1,J$FSPU(J)		;GET MULTIPLYING FACTOR
	IMULM	T1,J$FBANN(J)		;MULTIPLY ALL BY FACTOR
	IMULM	T1,J$FHEAD(J)
	IMULM	T1,J$FTRAI(J)
	IMULM	T1,J$FSIZE(J)
	IMULM	T1,J$FMINI(J)
	IMULM	T1,J$FMAXI(J)
	IMULM	T1,J$FORIG(J)
	IMULM	T1,J$FGUID(J)
	MOVE	T1,J$FMINI(J)		;GET MINIMUM X Y POINTS
	HLRZ	T2,J$XMIN(J)		;SAVE MINUMUM X POINT
	HRRZ	T3,J$YMIN(J)		;SAVE MINIMUM Y POINT
	ADD	T2,J$FBANN(J)		;XMIN IS RELATIVE TO BANNER
	ADD	T2,J$FHEAD(J)		; AND HEADER
	MOVEM	T2,J$XMIN(J)		;SAVE MINIMUM X POINT
	MOVEM	T3,J$YMIN(J)		;SAVE MAXIMUM Y POINT
	MOVE	T1,J$FMAXI(J)		;GET MAXIMUM X Y POINTS
	HLRZM	T1,J$XMAX(J)
	ADDM	T2,J$XMAX(J)		;XMAX IS RELATIVE TO XMIN
	HRRZM	T1,J$YMAX(J)
	ADDM	T3,J$YMAX(J)		;YMAX IS RELATIVE TO YMIN
	ADDM	T3,J$YMAX(J)
	MOVE	T1,J$FORIG(J)
	HLRZM	T1,J$XORG(J)
	ADDM	T2,J$XORG(J)		;XORG IS RELATIVE TO XMIN
	HRRZM	T1,J$YORG(J)
	ADDM	T3,J$YORG(J)		;YORG IS RELATIVE TO YMIN
	MOVE	T1,J$FSIZE(J)		;GET ABSOLUTE FORMS SIZE
	HLRZM	T1,J$XSIZ(J)		;SAVE MAXIMUM X SIZE
	HRRZM	T1,J$YSIZ(J)		;SAVE MAXIMUM Y SIZE
	JRST	FRMIEX			;FINISH UP
SUBTTL	Forms switch Subroutines


S$BANN:	$CALL	FH$DEC			;GET DECIMAL ARGUMENT
	MOVEM	T1,J$FBAN(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$TRAI:	$CALL	FH$DEC			;GET DECIMAL ARGUMENT
	MOVEM	T1,J$FTRA(J)		;STORE IT
	POPJ	P,			;AND RETURN

S$HEAD:	$CALL	FH$DEC			;GET A DECIMAL ARGUMENT
	MOVEM	T1,J$FHEA(J)		;STORE IT
	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,<>)			;ADD A CRLF
	$RETT				;RETURN.
SUBTTL	Plotter only switches

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$SIZE:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- INVALID SWITCH
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRLZM	T1,J$FSIZE(J)		;STORE X SIZE
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRRM	T1,J$FSIZE(J)		;STORE Y SIZE
	$RETT				;AND RETURN

S$MINI:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- INVALID SWITCH
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRLZM	T1,J$FMINI(J)		;STORE X MINI
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRRM	T1,J$FMINI(J)		;STORE Y MINI
	$RETT				;AND RETURN

S$MAXI:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- INVALID SWITCH
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRLZM	T1,J$FMAXI(J)		;STORE X MAXI
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRRM	T1,J$FMAXI(J)		;STORE Y MAXI
	$RETT				;AND RETURN

S$ORIG:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO -- INVALID SWITCH
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRLZM	T1,J$FORIG(J)		;STORE X ORIG
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL INTEGER
	HRRM	T1,J$FORIG(J)		;STORE Y ORIG
	$RETT				;AND RETURN

S$GUID:	SKIPN	J$FPLT(J)		;IS DEVICE A PLOTTER?
	$RETF				;NO..INVALID SWITCH
	SETZM	J$GSIZ(J)		;CLEAR GUIDE SIZE
	$CALL	FH$DEC			;GET DECIMAL INTERGER
	HRLZM	T1,J$FGUID(J)		;SAVE X OFFSET
	CAIE	C,":"			;IS Y ARGUMENT SPECIFIED?
	$RETT				;NO -- RETURN
	$CALL	FH$DEC			;GET DECIMAL NUMBER
	HRRM	T1,J$FGUID(J)		;SAVE THE Y OFFSET
	CAIE	C,":"		;GUIDE SIZE SPECIFIED
	$RETT
	$CALL	FH$DEC			;YES..GET A NUMBER
	MOVEM	T1,J$GSIZ(J)		;SAVE SIZE OF THE "+"
	$RETT
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:	CLEAR	T1,			;CLEAR FOR RESULT
	MOVE	T2,[POINT 6,T1]		;POINTER FOR RESULT
FH$SX1:	$CALL	FH$CHR			;GET A CHARACTER
	JUMPF	.RETF			;FAIL IF EOF
	CAIL	C,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:	CLEAR	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		; ...

	HRROI	S1,.EQOWN(J)		;GET THE OWNERS NAME
	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.2			;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
	$RETT				;AND RETURN

INPO.2:	MOVEI	S1,[ASCIZ /CAF/]	;CANT ACCESS FILE
	MOVEI	S2,[ITEXT(^E/[-1]/)]	;EXPAND LAST ERROR
	$CALL	PUTERR			;AND TYPE ERROR MESSAGE
	$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,[ASCIZ /ERI/]	;ERROR READING INPUT
	MOVEI	S2,[ITEXT(^E/[-1]/)]	;EXPAND LAST ERROR
	$CALL	PUTERR			;AND PUT AN ERROR OUT
	TXO	S,SKPFIL		;SKIP THE REST OF THE FILE
	$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
	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
  IOFORK <
	$CALL	GETFRK			;GET IO FORK
	  JUMPF	OUTDNA			;FORK NOT AVAILABLE
  >  ;END IOFORK CONDITINAL
	$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
>  ;END TOPS20 CONDITIONAL
OUTSOK:	$CALL	INTCNL			;CONNECT UP THE DEV
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN

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:	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
	  $RETT				;WIN!!
OUTERR:	PUSHJ 	P,OUTSTS		;READ DEVICE STATUS
	JUMPT	[$DSCHD (PSF%OB)	;ASSUME OUTPUT BLOCKED
		 JRST OUTOUT]		;RETRY OUTPUT
	$CALL	DEVERR			;PROCESS DEVICE ERROR
	JUMPT	OUTOUT			;RETRY OUTPUT IF CORRECTED
	JRST	MAIN			;STREAM IS SHUTDOWN

>  ;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
	$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
	$WTO	(Device I/O Error,^R/.EQJBB(J)/,@JOBOBA(S1))
	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	Buffer routines and discriptions for TOPS20

TOPS20 <
  IOFORK <

;DEFINE BUFFER CONTROL BLOCK  (FOR INFERIOR IO FORK)

	MSKSTR	CURBFR,J$IHDR(J),RHMASK	;POINTS TO CURRENT BUFFER
	MSKSTR	INICNT,J$LIBC(J),FWMASK	;INITIAL BYTE COUNT

;DEFINE BUFFER HEADER BLOCK   (CURRENT HEADER ADDRESS MUST BE IN P1)

	MSKSTR	USEFLG,0(P1),.MIFIN	;BUFFER USE FLAG
	MSKSTR	NXTBFR,0(P1),RHMASK	;NEXT BUFFER HEADER
	MSKSTR	CURPTR,1(P1),FWMASK	;CURRENT BUFFER BYTE POINTER
	MSKSTR	CURCNT,2(P1),FWMASK	;CURRENT BUFFER BYTE COUNT
	MSKSTR	INIPTR,3(P1),FWMASK	;INITIAL BUFFER BYTE POINTER

  > ;END IOFORK CONDITIONAL
> ;END TOPS20 CONDITIONAL
SUBTTL	Routine to Setup Inferior Process to do OUTPUT to device

TOPS20	<
  IOFORK <

GETFRK:	$SAVE	<P1,P2>			;PRESERVE P2
	HRRZ	P2,STREAM		;LOAD OUR STREAM NUMBER
;MOVE OUTFRK CODE
	HRLI	S1,FKCODE		;GET OUR ADDRESS OF OUTFRK
	HRRI	S1,OUTFRK(J)		;GET DESTINATION IN JOBPAG
	BLT	S1,COD$LN(J)		;AND MOVE IT
	MOVX	S1,CR%ACS		;LOAD FORKS ACS
	SETZ	S2,			;FROM OUR ACS
	CFORK				;BUILD THE FORK
	  ERJMP	.RETF			;OOPS
	MOVEM	S1,J$IFRK(J)		;REMEMBER FORK HANDLE
	MOVEI	S1,(J)			;GET JOBPAG ADDRESS
	ADR2PG	S1,			;CONVERT TO PAGE NUMBER
	MOVE	S2,S1			;SETUP FOR PMAP
	HRLI	S1,.FHSLF		;FROM THIS FORK
	HRL	S2,J$IFRK(J)		;TO INFERIOR
	MOVX	T1,PM%RD+PM%WR+PM%EX+PM%CNT+<NJBPGS>B35
	PMAP
	HRRI	S1,<JOBSTW/1000>	;ALSO MAP JOB STATUS PAGE
	HRRI	S2,<JOBSTW/1000>	;THE SAME
	MOVX	T1,PM%RD+PM%WR		;WITH READ AND WRITE
	PMAP
	MOVE	S1,J$IFRK(J)		;GET FORK HANDLE
	RPCAP				;GET CURRENT CAPABILITIES
	TXO	T1,SC%SUP		;ALLOW INTERRUPTS
	EPCAP
	$RETT


KILFRK:	MOVE	S1,J$IFRK(J)		;GET FORK HANDLE
	KFORK
	  ERJMP	.RETF			;OOPS
	$RETT

  > ;END IOFORK CONDTIONAL
> ;END TOPS20 CONDITIONAL
SUBTTL	Fork IO Code for TOPS20

TOPS20 <
  IOFORK <

;NOTE:	This code will be moved into inferior Job Pages
;	All Instruction Addresses Must be indexed by (J)

	FKCODE==.			;TOP LEVEL ADDRESS OF CODE

	PHASE	J$ICOD			;TO BE MOVED TO THIS LOCATION

OUTFRK:	LOAD	P1,CURBFR		;POINT TO CURRENT BUFFER
	MOVE	P2,J$STRM(J)		;AND MY STREAM
OUTF.1:	LOAD	S1,USEFLG		;GET USE BIT
	JUMPE	S1,OUTF.5(J)		;TERMINATE IF BUFFER UNUSED
OUTF.2:	MOVE	S1,J$LJFN(J)		;GET DEVICE JFN
	LOAD	S2,CURPTR		;GET BUFFER POINTER
	LOAD	T1,CURCNT		;GET NEGITIVE BYTE COUNT
	JUMPE	T1,OUTF.3(J)		;NOTHING TO DO -- RESET BUFFER
	SOUT				;DUMP THE BUFFER
	  ERJMP	OUTF.4(J)		;FLAG ERROR AND TERMINATE
OUTF.3:	LOAD	S1,INIPTR		;GET INITIAL POINTER
	STORE	S1,CURPTR		;RESET BUFFER POINTER
	LOAD	S1,INICNT		;GET INITIAL BYTE COUNT
	STORE	S1,CURCNT		;RESET BUFFER COUNT
	SETZ	S1,			;LOAD A ZERO
	STORE	S1,USEFLG		;CLEAR USEFLG (SAYS OK TO FILL)
	MOVX	S1,PSF%OB		;GET SCHED OUTPUT BLOCKED BIT
	ANDCAM	S1,JOBSTW(P2)		;AND CLEAR IT FOR OUR STREAM
	LOAD	P1,NXTBFR		;ADVANCE TO OUR NEXT BUFFER
	STORE	P1,CURBFR		;AND MAKE IT CURRENT
	SKIPGE	STREAM			;IS SUPERIOR IDLE?
	 JRST	OUTF.1(J)		;NO -- DON'T BOTHER HIM
	LOAD	S1,USEFLG		;IS THIS BUFFER USED?
	JUMPE	S1,OUTF.5(J)		;NO -- TERMINATE.
	MOVX	S1,.FHSUP		;WAKE SUPERIOR WITH INTERRUPT
	MOVX	S2,1B<.ICODN>		;ON OUTPUT DONE CHANNEL
	IIC
	  ERJMP	OUTF.5(J)		;TERMINATE ON ERROR
	JRST	OUTF.2(J)		;THEN DO NEXT BUFFER

OUTF.4:	SETOM	J$LIOE(J)		;FLAG ERROR
	STORE	S2,CURPTR		;SAVE FINAL POINTER
	STORE	T1,CURCNT		;SAVE FINAL COUNT
	MOVX	S1,PSF%OB		;GET SCHED OUTPUT BLOCKED BIT
	ANDCAM	JOBSTW(P2)		;AND CLEAR IT FOR OUR STREAM
OUTF.5:	SETZM	J$LIOA(J)		;CLEAR IO ACTIVE
	HALTF				;DIE AND WAKE SUPERIOR
	JRST	OUTFRK(J)		;NEXT BUFFER IF CONTINUED

	DEPHASE

	COD$LN==.-FKCODE		;COMPUTE LENGTH FOR BLT

  > ;END IOFORK CONDITIONAL
> ;END TOPS20 CONDITIONAL
SUBTTL	TOPS20 Output Code to Drive Inferrior Fork

TOPS20 <
  IOFORK <

OUTPUT:	SKIPE	J$LIOE(J)		;ERROR FLAG LIT?
	  $RETF				;YES -- GIVE BAD RETURN
	$SAVE	<P1>			;PRESERVE AN AC
	LOAD	P1,J$LBRH(J)		;GET OUR BUFFER HEADER
	SKIPGE	S1,J$LBCT(J)		;GET COUNT OF REMAINING BYTES
	  SETZ	S1,			;MUST BE .GE. 0
	SUB	S1,J$LIBC(J)		;SUBTRACT INITIAL COUNT
	STORE	S1,CURCNT		;SAVE NEGITIVE BYTE COUNT
	SETZ	S1,			;CLEAR S1
	STORE	S1,USEFLG		;AND CLEAR USEFLG (OK TO EMPTY)
	SKIPL	J$LIOA(J)		;IS IO FORK ACTIVE?
	$CALL	IOGO			;NO -- GO START IT
	LOAD	P1,NXTBFR		;GET NEXT BUFFER ADDRESS
	STORE	P1,J$LBRH(J)		;MAKE IT OUR OWN
OUTP.1:	LOAD	S1,USEFLG		;GET USE FLAG
	JUMPE	S1,OUTP.2		;HURRAY! IT'S UNUSED
	$DSCHD	(PSF%OB)		;WAIT FOR OUTPUT DONE
	SKIPE	J$LIOE(J)		;ANY ERRORS?
	  $RETF				;YES -- GIVE FALSE RETURN
	JRST	OUTP.1			;RECHECK USE FLAG

OUTP.2:	LOAD	S1,CURPTR		;GET BUFFER POINTER
	STORE	S1,J$LBPT(J)		;MAKE IT OUR OWN
	LOAD	S1,CURCNT		;GET CURRENT COUNT
	STORE	S1,J$LBCT(J)		;MAKE IT OUR OWN
	$RETT				;AND FINALLY, RETURN


IOGO:	MOVE	S1,J$IFRK(J)		;GET FORK HANDLE
	MOVEI	S2,TF			;SCRATCH AC
	MOVEI	TF,OUTFRK(J)		;LOAD START ADDRESS
	SFORK				;AND GET IT SPINNING
	  ERJMP	$RETF
	SETOM	J$LIOA(J)		;SET IO ACTIVE
	$RETT				;AND RETURN
  > ;END IOFORK CONDITIONAL
> ;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

  IOFORK <
	$CALL	KILFRK			;DESTROY OUR FORK
  > ;END IOFORK CONDITIONAL

	SKIPT
	  $RETF
	$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))
	SETOM	JOBCHK(S1)		;REQUEST CHECKPOINT
	$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
	SETOM	JOBCHK(S1)		;REQUEST CHECKPOINT
	$WTO	(Device went off-line,,@JOBOBA(S1))
	$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 Routines

;DISPATCH TABLE FOR CARD-PUNCH

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


;HERE TO PROCESS A FILE
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
	$CALL	OUTBYT			;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
	$CALL	OUTBYT			;AND PUNCH COLUMN 1
	MOVE	C,T2			;GET THE CHECKSUM
	$CALL	OUTBYT			;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
	$CALL	OUTBYT			;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
	$CALL	OUTBYT			;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
	$CALL	OUTBYT			;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 File Header and Trailer Routines

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
> ;END TOPS10 CONDITIONAL
	MOVEI	S1,[ITEXT<^W6/S2/>]	;POINT TO NAME
	PJRST	C$WORD			;PUNCH CARD AND RETURN

C$EOF:	MOVEI	S1,^D80			;PUNCH EOF CARD
	MOVEI	C,7417			;TOP FOUR AND BOTTOM FOUR ROWS
	$CALL	REPBYT
	PJRST	OUTOUT			;FORCE OUTPUT
SUBTTL	Card Job Banner and Trailer Routines

C$BANN:	SKIPN	T1,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	T1,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
	SOJE	T1,.RETT		;RETURN IF FINISHED
	MOVEI	S1,[ITEXT<^W6/.EQJOB(J)/>]
	$CALL	C$WORD
	SOJE	T1,.RETT		;RETURN IF FINISHED
	MOVEI	S1,[ITEXT<#^D5R0/.EQSEQ(J),EQ.SEQ/>] ;SEQUENCE NUMBER
	$CALL	C$WORD
	SOJE	T1,.RETT		;RETURN IF FINISHED
	MOVEI	S1,[ITEXT<USER: >]
	$CALL	C$WORD
	SOJE	T1,.RETT		;RETURN IF FINISHED
	$CALL	SETTBF			;POINT TO TEXT BUFFER
	$TEXT	(DEPBP,<^I/USRNAM/>)	;GET USER NAME
	MOVEI	S1,[ITEXT <^T6/J$XTBF(J)/>] ;SIX CHARACTER USER NAME
	PJRST	C$WORD			;PUNCH LAST CARD AND RETURN
SUBTTL	Card Block Word and Letter Routines

;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
	$CALL	OUTBYT
	MOVEI	C,7777			;SECOND COLUMN FULLY LACED
	$CALL	OUTBYT
	MOVEI	S1,3			;NEXT 3 COLUMNS WITH SPECIAL MASK
	MOVE	C,J$CMSK(J)
	$CALL	REPBYT
	$CALL	STRING			;COLUMNS 6-77 FOR CHARACTERS
	MOVE	C,J$CMSK(J)		;COLUMN 78 SPECIAL MASK
	$CALL	OUTBYT
	MOVEI	C,7777			;COLUMN 79 FULLY LACED
	$CALL	OUTBYT
	MOVEI	C,3776			;COLUMN 80 ROUNDED CORNERS
	$CALL	OUTBYT
	PJRST	OUTOUT			;PUNCH CARD AND RETURN

;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
	$CALL	OUTBYT			;PUNCH FIRST FRAME
	$CALL	OUTBYT
	AOBJN	S2,CLET.1		;REPEAT 10 FRAMES
	MOVEI	S1,2
	MOVE	C,J$CMSK(J)		;PUNCH SPECIAL ROWS
	PJRST	REPBYT			;PUNCH 2 BLANK FRAMES
OUTCDP:	$CALL	OUTOUT			;FORCE CARD OUT
	AOS	S1,J$APRT(J)		;COUNT ANOTHER ONE
	CAMG	S1,J$RLIM(J)		;OVER LIMIT?
	$RETT				;NO, CONTINUE ON

	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
	$WTOR	(Output limit exceeded,<^I/OLEMSG/>,@JOBOBA(S1),JOBWAC(S1))
	SETOM	JOBCHK(S1)		;REQUEST A CHECKPOINT
	$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,[ASCIZ /OLE/]	;OUTPUT LIMIT EXCEEDED
	SETZ	S2,
	$CALL	PUTERR			;Process IT
	$CALL	INPFEF			;FORCE EOF ON NEXT INPUT
	TXO	S,ABORT			;LIGHT ABORT
	HRRZ	S1,STREAM
	$WTO	(Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;NOTIFY
	$RETT				;AND RETURN

OUTIGN:	MOVX	S1,.INFIN		;GET MAXIMUM LIMIT
	MOVEM	S1,J$RLIM(J)		;SAVE IT
	$RETT				;AND TRY SOME MORE


OLEANS:	OLESIZ,,OLESIZ			;BUILD RESPONSE TABLE
	TB (CANCEL,OUTCAN)		;CANCEL
	TB (IGNORE,OUTIGN)		;IGNORE
	OLESIZ==.-OLEANS-1		;GET NUMBER OF ENTRIES

OLEMSG:	ITEXT <^R/.EQJBB(J)/^T/@OLETXT/>
OLETXT:	[ASCIZ/
Type 'Respond <Number> CANCEL' to Cancel the Job
Type 'Respond <Number> IGNORE' to Ignore the Error/]
SUBTTL	Plotter Service Routines

;PLOTTER 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	.RETF			;(10) ERROR PROCESSOR
	JRST	.RETT			;(11) ACCOUNTING


;HERE TO PROCESS A FILE
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			;STANDARD 6BIT INPUT
	EXP	PLTSVN			;SEVEN-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	.RETT			;RETURN WHEN DONE
	$CALL	PLTBYT			;WRITE THE CHARACTER OUT
	JRST	PLTLUP			;AND LOOP
SUBTTL	PLOTTER BANNER HEADER AND TRAILER ROUTINES

P$BANN:	SKIPN	T1,J$FGUID(J)		;GUIDE POSITIONING WANTED?
	JRST	P$BAN1			;NO..GO RESET THE ORIGIN
	SETZM	J$XPOS(J)		;YES..RESET TEMPORARILY
	SETZM	J$YPOS(J)
	$CALL	P$GUID			;DO THE POSITIONING
P$BAN1:	$CALL	P$ORG			;RESET OUR ORIGIN
	SKIPN	T1,J$FBANN(J)		;BANNER WANTED?
	$RETT				;NO..JUST RETURN
	$CALL	P$CHKS			;CHECK CHARACTER SIZE
	IMULI	T1,2			;GET STARTING POSITION
	MOVEI	T2,MARSTP		;GET STEPS IN MARGIN
	MOVEI	T3,3			;PEN UP
	$CALL	PLOT			;POSITION TO PRINT BANNER
	$CALL	SETTBF
	$TEXT	(DEPBP,^I/JOBBAN/^0)	;Display job banner
	$CALL	STRING			;CALL P$LETR TO PLOT IT
	$RETT

P$ORG:	SETZM	J$XPOS(J)		;RESET THE ORIGIN
	SETZM	J$YPOS(J)
	SETZM	J$XLIM(J)		;RESET REMEMBERED LIMITS
	SETZM	J$YLIM(J)
	SETZM	J$ORGF(J)		;RESET ORIGIN NEEDED FLAG
	SKIPN	S1,J$GSIZ(J)		;GUIDE WANTED?
	 PJRST	OUTOUT			;NO..DUMP BUFFERS AND RETURN
	$CALL	PENDN			;LOWER THE PEN
	MOVE	T1,J$GSIZ(J)
	MOVEI	C,XYD			;PRINT A +
	$CALL	REPBYT			;PRINT A +
	MOVE	T1,J$GSIZ(J)
	IMULI	S1,2
	MOVEI	C,XYU
	$CALL	REPBYT
	MOVE	S1,J$GSIZ(J)
	MOVEI	C,XYD
	$CALL	REPBYT
	MOVE	S1,J$GSIZ(J)
	MOVEI	C,XYL
	$CALL	REPBYT
	MOVE	S1,J$GSIZ(J)
	IMULI	S1,2
	MOVEI	C,XYR
	$CALL	REPBYT
	MOVE	S1,J$GSIZ(J)
	MOVEI	C,XYL
	$CALL	REPBYT
	$CALL	PENUP
	PJRST	OUTOUT			;DUMP WHAT WE HAVE

P$HEAD:	SKIPE	J$ORGF(J)		;ORIGIN NEEDED?
	$CALL	P$ORG			;YES..DO IT
	SKIPN	T1,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
	$CALL	P$CHKS			;CHECK CHARCTER SIZE
	IMULI	T1,2			;GET OFFSET TO START AT
	ADD	T1,J$FBANN(J)		;RELATIVE TO BANNER
	MOVEI	T2,MARSTP		;GET STEPS IN MARGIN
	MOVEI	T3,3			;PEN GOES UP
	$CALL	PLOT			;POSITION TO PRINT STRING
	$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
	$TEXT	(DEPBP,<File ^F/@J$DFDA(J)/ created:^H/S1/^0>)
	$CALL	STRING
P$HEA1:	MOVE	T1,J$XORG(J)		;POSITION TO ORIGIN
	MOVE	T2,J$YORG(J)
	MOVEI	T3,3			;PEN GOES UP
	$CALL	PLOT
	$RETT

P$CHKS:	IDIVI	T1,3			;Get size of characters
	CAILE	T1,CHRSIZ		;Exceed maximum size?
	MOVEI	T1,CHRSIZ		;No..don't let it be
	MOVEM	T1,J$CSIZ(J)		;Save size for P$LETR
	$RETT
P$EOF:	SKIPN	T1,J$XSIZ(J)		;X FORM SIZE GIVEN?
	 JRST	[MOVE	T1,J$XLIM(J)	;NO..USE OUR HIGHEST X STEP
		 ADD	T1,J$FTRA(J)	;PLUS TRAILER SIZE
		 IDIV	T1,J$FSPU(J)	;ROUND TO NEAREST UNIT
		 IMUL	T1,J$FSPU(J)
		 SKIPE T2
		 ADD	T1,J$FSPU(J)
		 JRST	.+1]
	MOVEI	T2,0			;GO BACK TO THE MARGIN
	MOVEI	T3,3			;WITH PEN UP
	$CALL	PLOT
	SETOM	J$ORGF(J)		;SET ORIGIN NEEDED
	PJRST	OUTOUT			;DUMP WHAT WE HAVE

P$TRAI:	SKIPN	T1,J$FTRA(J)		;TRAILER ALLOWED?
	 PJRST	P$TRA1			;NO..RESET THE ORIGIN
	PUSH	P,J$XPOS(J)		;YES..REMEMBER WHERE WE START
	$CALL	P$CHKS			;CHECK CHARACTER SIZE
	MOVNS	T1			;SUBTRACT FROM CURRENT POSITION
	ADD	T1,J$XPOS(J)
	MOVEI	T2,MARSTP		;GET THE MARGIN TO START AT
	MOVEI	T3,3			;PEN GOES UP
	$CALL	PLOT
	$CALL	SETTBF			;Point to text buffer
	$TEXT	(DEPBP,^I/JOBTRA/^0)	;Display job trailer
	$CALL	STRING
	POP	P,T1			;GET STARTING POSITION
	MOVEI	T2,0
	MOVEI	T3,3			;PEN GOES UP
	$CALL	PLOT
P$TRA1:	$CALL	P$ORG			;RESET THE ORIGIN
	SKIPN	T1,J$FGUID(J)		;GUIDE POSITIONING WANTED?
	$RETT
	MOVNS	T1			;YES..DO REVERSE POSITIONING
P$GUID:	HRRE	T2,T1			;GET Y GUID POSITION
	HLRE	T1,T1			;GET Y GUIDE POSITION
	MOVEI	T3,3			;PEN GOES UP
	$CALL	PLOT
	PJRST	OUTOUT			;DUMP WHAT WE HAVE
P$LETR:	$SAVE	<T1,T2,T3,T4>		;PRESERVE TEMPORARIES
	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
	$CALL	PLOT			;PLOT SEGMENT
	SOJG	T4,SYM.3		;DO ALL SEGMENTS
	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
	$CALL	PLOT
	$RETT
SUBTTL	Routine to Plot line Segment

;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,XYR			;ASSUME RIGHT MOVEMENT
	SKIPG	T1			;IS THAT CORRECT?
	MOVEI	T3,XYL			;NO..ASSUME LEFT
	SUB	T2,J$YPOS(J)		;COMPUTE DELTA Y
	MOVEI	T4,XYU			;ASSUME UPWARD MOVEMENT
	SKIPG	T2			;IS THAT CORRECT?
	MOVEI	T4,XYD			;NO..THEN ASSUME DOWN
	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:	$RETT				;RETURN
SUBTTL	Plotter Rotation and XY20 Translation table



;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) XYL ,XYU ,XYR ,XYD 	;MOVE DOWN
	BYTE (18) 102 (2) 0 (4) XYR ,XYD ,XYL ,XYU 	;MOVE UP
	BYTE (18) 114 (2) 0 (4) PEN3,PEN3,PEN3,PEN3	;SELECT PEN3
	BYTE (18) 104 (2) 0 (4) XYD ,XYL ,XYU ,XYR 	;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) XYU ,XYR ,XYD ,XYL 	;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	PLTBYT	Routine to plot a single character

;Call	C/ Character to plot

;Will ROTA Plot per variable J$ROTA(J) and Adjust Values in J$XPOS(J) and J$YPOS(J)
;per movement code.

;Also makes range check on XMIN-J$XMAX(J) and J$YMIN(J)-J$YMAX(J)

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
	MOVE	S1,J$XPOS(J)
	TRNE	C,XYR			;ADD 1 FOR RIGHT MOVE
	 AOS	S1,J$XPOS(J)		;ADD 1 FOR RIGHT MOVE
	TRNE	C,XYL
	 SOS	S1,J$XPOS(J)		;SUB 1 FOR LEFT MOVE
	CAMLE	S1,J$XLIM(J)		;HIGHEST POINT SO FAR?
	MOVEM	S1,J$XLIM(J)		;YES -- SAVE IT
	MOVE	S2,J$YPOS(J)		;GET CURRENT Y POSITION
	TRNE	C,XYU			;ADJUST PER MOVEMENT
	 AOS	S2,J$YPOS(J)		;ADD 1 FOR UPWARD MOVE
	TRNE	C,XYD
	 SOS	S2,J$YPOS(J)		;SUB 1 FOR DOWN MOVE
	CAMLE	S2,J$YLIM(J)		;HIGHEST POINT SO FAR?
	MOVEM	S2,J$YLIM(J)		;YES -- SAVE IT
	PJRST	OUTBYT			;PUT CHARACTER IN BUFFER AND RETURN
PENUP:	PUSH	P,C			;SAVE CHARCTER AC
	SETZM	J$PPOS(J)		;MARK PEN RAISED
	MOVEI	C,PNUP			;LOAD CODE FOR PEN UP
	$CALL	OUTBYT			;PLOT CHARACTER
	POP	P,C			;RESTORE CHARACTER AC
	$RETT

PENDN:	PUSH	P,C			;SAVE CHARACTER AC
	SETOM	J$PPOS(J)		;MARK PEN DOWN
	MOVEI	C,PNDN			;LOAD PENDOWN CODE
	$CALL	OUTBYT
	POP	P,C			;RESTORE CHARACTER AC
	$RETT
;DEC 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
SUBTTL	Plotter Character Table and Segement Codes

	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 Routines

;PAPER TAPE DISPATCH TABLE

T$DISP:	JRST	T$HEAD			;(0) FILE HEADER
	JRST	T$EOF			;(1) FILE TRAILER
	SIXBIT	/PTP/			;(2) GENERIC DEVICE NAME
	EXP	^D36			;(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

;HERE TO PROCESS A FILE
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
	EXP	PTIMA			;IMAGE
	EXP	PTELF			;ELEVEN

	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
	$CALL	OUTBYT			;PUT IT IN THE TAPE
	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:	$CALL	OUTBYT			;PUNCH THE CHAR
	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
	$CALL	REPBYT			;PUNCH THEM
	JRST	PTAS.1			;GET NEXT CHAR

PTAS.3:	MOVEI	C,377			;LOAD A RUBOUT
	$CALL	OUTBYT			;PUNCH IT
	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
	$CALL	REPBYT			;OUTPUT 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
	$CALL	OUTBYT			;PUNCH IT
	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
	$CALL	OUTBYT			;PUNCH
	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
	$CALL	OUTBYT			;PUNCH IT
	JRST	PTIMA			;AND LOOP
;PAPER-TAPE HEADERS, TRAILERS, ETC.

T$BANN:	SETZM	J$TBCT(J)		;CLEAR TOTAL BYTE COUNT
	SKIPN	T1,J$FBAN(J)		;BANNER ALLOWED?
	PJRST	BLKFLD			;NO -- PUNCH BLANK FOLD
	$CALL	SETTBF			;SETUP TEXT BUFFER
	$TEXT(DEPBP,<Begin ^R/.EQJBB(J)/>)
	$CALL	STRING			;AND SEND TO THE PUNCH
	PJRST	BLKFLD			;PUNCH BLANK FOLDS

T$HEAD:	SKIPN	T1,J$FHEA(J)		;HEADER ALLOWED?
	JRST	BLKFLD			;NO -- JUST PUNCH A BLANK 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,<Start ^I/0(S1)/ 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
	$CALL	REPBYT			;SEND SOME BLANK FRAMES
	MOVEI	S1,^D10			;GET A REPEAT COUNT
	MOVEI	C,177			;AND A CHARACTER
	$CALL	REPBYT			;SEND SOME LACED FRAMES
	SOJG	T2,THEA.1		;AND LOOP
	PJRST	BLKFLD			;AND SEND A BLANK FOLD OF TAPE

	CONT.	(HEADERS)		;FORCE NEW LIST PAGE
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
	$CALL	REPBYT			;SEND SOME EOFS
	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
	$CALL	REPBYT			;LEAVE SOME SPACE
	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
	PJRST	BLKFLD			;SEND A BLANK FOLD OF TAPE
SUBTTL	Tape Trailer and Blank Fold Routines

T$TRAI:	SKIPN	T1,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

;Routine to Punch a number of 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	REPBYT
;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
	$CALL	OUTBYT			;PUNC IT
	AOBJN	S2,TLET.1		;REPEAT FOR ALL SEGMENTS
	MOVEI	S1,2			;REPEAT COUNT
	MOVEI	C,0			;CHARACTER
	PJRST	REPBYT			;PUNCH 2 BLANKS AND 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	S1/ Address of Asciz "short error" message or 0 if none
;	S2/ Address of ITEXT for "Extended Error" Message or 0 if none

PUTERR:	$CALL	SETEBF			;POINT $TEXT TO ERROR BUFFER
	SKIPE	S1
	$TEXT	(DEPBP,^T/(S1)/--^A)	;YES -- MOVE TO BUFFER
	SKIPE	S2			;LONG MESSAGE?
	$TEXT(DEPBP,^I/0(S2)/^A)	;YES -- MOVE TO BUFFER
	$TEXT	(DEPBP,^0)		;STORE NULL
	$RETT


;HERE TO REPEAT THE BYTE IN ACCUMULATOR C ACCORDING TO THE COUNT IN AC S1.
REPBYT:	$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;PUT COUNT IN P1
REPB.1:	$CALL	OUTBYT			;PUT OUT A BYTE
	SOJG	P1,REPB.1		;AND LOOP
	$RETT				;RETURN WHEN DONE


;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,[ASCIZ /UPM/]	;LOAD AN ERROR
	SETZ	S2,			;NO ADDITIONAL MESSAGE
	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		;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

>  ;END TOPS20 CONDITIONAL
SPOEND::END	SPROUT