Google
 

Trailing-Edge - PDP-10 Archives - bb-v895a-bm_tops20_v41_2020_dist_2of2 - 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/DPM/NT 5-Nov-81

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


	SEARCH	GLXMAC			;SEARCH 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==2533			;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
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. UPDATE Routine to send status update......................  28
;   26. CHKPNT Routine to send checkpoint message.................  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.......................................  37
;   36. FORMS - Setup Forms for a job.............................  40
;   37. Forms switch Subroutines..................................  44
;   38. Plotter only switches.....................................  45
;   39. I/O Subroutines for SPFORM.INI............................  46
;   40. INPOPN - Routine to open the input file...................  48
;   41. INPBUF - Read a buffer from the input file................  49
;   42. INPBYT - Read a byte from the input file..................  49
;   43. INPERR - Handle an input failure..........................  49
;   44. INPFEF - Force end-of-file on next input..................  49
;   45. INPREW - Rewind the input file............................  49
;   46. OUTGET - OPEN the output device...........................  50
;   47. OUTBYT - Deposit a byte in the output buffer..............  53
;   48. OUTOUT - Routine to output a buffer.......................  54
;   49. DEVERR - Handle Output Device Errors......................  55
;   50. OUTREL - Release output device............................  56
;   51. OUTWON - Wait for on-line.................................  57
;   52. OUTFLS Routine to flush output buffers....................  58
;   53. Card punch service
;        53.1   Dispatch table....................................  59
;        53.2   Checkpoint text generation........................  60
;        53.3   File processing...................................  61
;        53.4   File headers......................................  67
;        53.5   File trailers.....................................  68
;        53.6   Banners...........................................  69
;        53.7   Word punching.....................................  70
;        53.8   Letters...........................................  71
;        53.9   Byte output.......................................  72
;   54. Plotter service
;        54.1   Dispatch table....................................  73
;        54.2   Checkpoint text generation........................  74
;        54.3   File processing...................................  75
;        54.4   Devout output errors..............................  77
;        54.5   Banners...........................................  78
;        54.6   File headers......................................  79
;        54.7   File trailers.....................................  80
;        54.8   Job trailers......................................  81
;        54.9   Solid lines.......................................  82
;        54.10  Dashed lines......................................  83
;        54.11  Job information plotting..........................  84
;        54.12  Alignment and testing.............................  85
;        54.13  Pen calibration...................................  86
;        54.14  Compute chracter size.............................  87
;        54.15  Letters...........................................  88
;        54.16  Line segments.....................................  89
;        54.17  Rotation and XY20 translation.....................  91
;        54.18  Pen movement generation...........................  92
;        54.19  Character set.....................................  94
;   55. Paper tape punch service
;        55.1   Dispatch table....................................  99
;        55.2   Checkpoint text generation........................ 100
;        55.3   File processing................................... 101
;        55.4   Banners........................................... 106
;        55.5   File headers...................................... 107
;        55.6   File trailers..................................... 108
;        55.7   Trailers.......................................... 109
;        55.8   Blank folds....................................... 110
;        55.9   Letters........................................... 111
;        55.10  Byte output....................................... 112
;   56. Character Bit Array for 5 X 7 Character Matrix............ 113
;   57. Common Utilities.......................................... 115
;   58. Interrupt Module.......................................... 118
;   59. IPCF and DEVICE Interrupt service for TOPS10.............. 122
;   60. IPCF and DEVICE interrupt service for TOPS20.............. 123
SUBTTL	Revision History

Comment\

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
2440	Add plotter limit check code

2441	MAKE 8 BIT PAPER TAPE OUTPUT BYTE SIZE
2442	Add usage accounting for TOPS-10 (DPM)
2443	Use new feature IB.DET to detach from FRCLIN (DPM)
2444	Delete IB.DET (GLXLIB defaults to detach)
2445	Change reference of symbol z to ZZ [QAR 10-04715]
2446	Add missing (S2) in DVINTR rouine [QAR 10-4903]

2447	Close SPFORM.INI before returning from FRMSWI [QAR 10-4855]
2450	Call OUTOUT after outputing trailers (SPR 20-14682)
	Make # chars per fanfold 85 not 90 (SPR 20-14680)
	Fix spelling error & FRMFD length error (SPR 20-14911)
2451	Get the correct owners name based on type of system.

2452	Fix OUTOUT so we don't loose output done interrupts

2453	Adjust J$XPOS and J$YPOS before clipping output per limits

2454	Always call file trailer routine during file processing

2455	Add support for /DISP:RENAME

2456	Account for X plotter usage

2457	Compute minimum character size (YMAX-YMIN)/90

2460	Have SPROUT generate own checkpoints

2461	Make cryptic error messages more explicit.

2462	Position pen at EOF before printing error message. General
	cleanup of job/file headers and trailers.

2463	Add missing entries in PLT dispatch table for /TAPE:BINARY.

2464	Add accounting support for the plotter.

2465	Don't do things like JRST .+3

2466	Remove edit 2456. Plotter usage is accounted for in minites, not
	amount of paper.

2467	Clear up /BANNER/HEADER/TRAILER problems with plotter. Edit 2457
	made the switch arguments nearly useless. Don't allow arguments
	for the plotter.

2470	SPFORM.INI switch arguments were sometimes stored in half-words,
	and later full-word multiplies were done. That produces strange
	results in banners, headers and trailers.

2471	Remove /GUIDE, /ORIGIN and /SIZE switches from SPFORM.INI since
	they didn't work and it was unclear how they should work. Replace
	the "+" guide marks with a line across the paper. Always ram the
	pen into the stops prior to starting a new job instead of setting
	the origin where ever the operator left the pen.

2472	Remove SPFORM.INI switch defaulting since it could never work
	correctly for all switches all the time (some switches take
	multiple arguments).

2473	Remove TOPS-20 fork code since it never worked & will never be made to.

2474	Fix limit clipping so plots don't overwrite banners and trailers.

2475	If we get an I/O error on the plotter, complain but continue the
	job, since plotters aren't supposed to get output errors.

2476	Always clear PSF%DO (device off-line bit) when the operator issues
	a continue command. This can't hurt anything and will be a win while
	driving a PTP. The PTP gives only off-line interrupts, but no on-line
	interrupts.

2477	Add PTP accounting and fix up checkpoint messages a bit.

2500	Insure plotter trailers won't clip.

2501	Fix PTP banners, header and trailers so characters don't get mangled.

2502	Process /BANNER, /HEADER and /TRAILER switches for all devices like
	it is done for PLTs. Also, add NOTE:foo to CDP and PTP banners since
	they tell me it's documented that way.

2503	Fix problem with J$XLIM growing with every plot done.

2504	Use symbol FTFACT from GALGEN dialogue and remove references to FTOACT.

2505	Fix up CDP headers and trailers.

2506	Do both a status update and a checkpoint prior to asking about
	limit exceeded action.

2507	Don't call EOF routines twice. Remove extra call at FILE.2+ a few.

2510	Clean up /NOTE switch processing a bit.

2511	Fix bug in PTPBYT that caused S1 and S2 to get trashed.

2512	Default /SPU value to 1 if not set in SPFORM.INI

2513	Make sure T1 is set up before calling BLKFLD to punch blank folds
	off paper tape.

2514	Correct the calculation of the number of minutes of plotting time.

2515	Fix compiler errors on TOPS20 by putting TOPS10 refs under conditional

2516	Store sixbit device name on TOPS-20 so accounting doesn't get
	screwed up. Also accumulate the number of feet plotted. Clean up
	other assorted accounting bugs.

2517	Clean up TOPS-20 card banners, headers and trailers.

2520	Zap output buffer after doing SOUT.

2521	Clarify $WTOR responses as 'ABORT' or 'PROCEED' only.

2522	Fix UP-DOWN RIGHT-LEFT confusion. QAR 10-06785

2523	Add file name info to Cannot Access File message QAR 10-06759

2524	Correct checking for a null /NOTE switch.
	Terminate job banner text properly.
	Terminate note text with a NUL when processing job banners.
	Requeue reason text may never gets to the error buffer. Fix it.

2525	Fix logic bug in SPFORM.INI parsing.

2526	Fix some bad error messages.
	GCO: 1298

2527	Remove two extraneous intructions at the end of routine P$CHKS.
	GCO: 1319

2530	Fix a bug that would not allow plots to be output if
	/HEADER was not specified.
	GCO: 1320

2531	Several very trivial fixes which don't really deserve seperate
	edit numbers.
	1) Put OUTSOK under TOPS-20 conditional since it's only needed for
		that system.
	2) Remove some extraneous symbols: J$FMSP, FOB. Put
		FILNAM under TOPS20 conditional.
	3) Fix OUTOUT on the -10 to not save S1/S2 if it is called from
		itself.
	GCO: 1341

2532	Fix a bug that keeps the last buffer from being output
	to the plotter. It may be an obscure monitor bug that has
	to be worked around.

2533	Fix copyright.  GCO 4.2.1528
End of revision history
\
SUBTTL	Constants  (Conditional and Unconditional)

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

;SYSTEM DEPENDENT PARAMETERS

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

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

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

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


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

	CONT.	(Constants)		;FORCE NEW LISTING PAGE

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


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


; Paper tape punch constants
;
	XP	CHPFLD,^D85		;CHARACTERS PER FOLD OF PTP
	XP	FRMPFT,^D120		;FRAMES PER FOOT OF TAPE
SUBTTL	MACROS

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

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


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

;FORMS SWITCHES:

;FOR ALL DEVICES

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


;FOR PLOTTER ONLY

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

;IN THE ABOVE AND BELOW EXPLANATIONS:
;	NN	IS A DECIMAL NUMBER
;	SS	IS A 1-6 CHARACTER STRING
;	AA	IS A STRING OF 1 TO 50 CHARACTERS
;	OO	IS AN OCTAL NUMBER
;	XX	INTEGER STEP NUMBER IN X AXIS
;	YY	INTEGER STEP NUMBER IN Y AXIS



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

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

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

;TYPICAL SPFORM.INI FORMS SPECIFICATION

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


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

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

	DSKOPN==1B2			;DISK DATA READ GOING ON
	RQB==1B3			;JOB HAS BEEN REQUED
	ABORT==1B5			;THE SHIP IS SINKING
	SKPFIL==1B8			;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
	GOODBY==1B9			;IN JOB TERMINATION SEQUENCE
	NOSTRM==1B10			;NOT IN STREAM CONTEXT
SUBTTL	Job Parameter Area

	LP	J$$BEG,0		;BEGINNING OF PARAMETER AREA

;REQUEST PARAMETERS
	LP	J$RFLN,1		;NUMBER OF FILES IN REQUEST
	LP	J$RLIM,1,Z		;JOB LIMIT IN PAGES
	LP	J$RTIM,1		;START TIME OF JOB
	LP	J$RNFP,1,Z		;NUMBER OF FILES processed
	LP	J$RNCP,1,Z		;NUMBER OF COPIES OF CURRENT FILE
	LP	J$RNPP,1,Z		;NUMBER OF PAGES IN CURRNET FILE
	LP	J$RACS,20		;CONTEXT ACS
	LP	J$RPDL,PDSIZE		;CONTEXT PUSHDOWN LIST

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


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

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

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

;STORAGE FOR CURRENT FORMS SWITCHS

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

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


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

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

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

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

;ACCOUNTING BLOCK

	LP	J$PTPM,1		;PLOTTER TICS PER MINUTE
	LP	J$PTIC,1,Z		;ACCOUNTING FOR PLOTTER
	LP	J$APRT,1,Z		;NUMBER OF PAGES processed
	LP	J$ADRD,1,Z		;DISK BLOCKS READ.
	LP	J$APRI,1,Z		;JOBS PRIORITY
	LP	J$ARTM,1,Z		;JOBS RUN TIME (CPU)
	LP	J$ASEQ,1,Z		;JOBS SEQUENCE NUMBER
	LP	J$AFXC,1,Z		;TOTAL FILES processed (FILES*COPIES)
	LP	J$ADSP,1,Z		;DISPOSITION (SIXBIT)
	LP	J$AQUE,1,Z		;QUEUE NAME (SIXBIT)
;DISK FILE PARAMETERS

	LP	J$DIFN,1		;THE IFN
	LP	J$DFDA,1		;THE FD ADDRESS
	LP	J$DBPT,1		;BUFFER BYTE POINTER
	LP	J$DBCT,1		;BUFFER BYTE COUNT
	LP	J$DBSZ,1		;INPUT BYTE SIZE
	LP	J$DMOD,1		;I/O MODE OF DISK FILE
	LP	J$DSPN,1		;SPOOLED FILE NAME IF ANY
	LP	J$DSPX,1		;SPOOLED FILE EXTENTION


	LP	J$$END,1		;END OF PARAMETER AREA
		J$$LEN==J$$END		;LENGTH OF PARAMETER AREA



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

ZTABLE:					;PUT TABLE HERE

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

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

PDL:	BLOCK	PDSIZE			;PUSHDOWN LIST

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

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

ACTFLG:	BLOCK	1			;-1 IF WE ARE DOING ACCOUNTING
ACTRNN:	BLOCK	1			;OLD SPOOLER RUNTIME
ACTPAG:	BLOCK	1			;OLD STREAM PAGE BLOCK ADDRESS
CNTSTA:	BLOCK	1			;CENTRAL STATION IDENTIFIER
TOPS20 <
FILNAM:	BLOCK	10			;ROOM FOR A TOPS-20 FILENAME
> ;END TOPS20 CONDITIONAL
SUBTTL	Resident JOB DaTABase

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

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

JOBOBA:	BLOCK	NSTRMS			;TABLE OF OBJECT BLOCK ADDRESSES

JOBSTW:	BLOCK	NSTRMS			;JOB STATUS WORD

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

JOBOBJ:	BLOCK	3*NSTRMS		;LIST OF SETUP OBJECTS

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

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

	LOWEND==.-1

TOPS10 <

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

>  ;END TOPS10 CONDITIONAL

TOPS20 <

LEV1PC:	BLOCK	1			;LVL 1 INTERRUPT PC STORED HERE
LEV2PC:	BLOCK	1			;LVL 2 INTERRUPT PC STORED HERE
LEV3PC:	BLOCK	1			;LVL 3 INTERRUPT PC STORED HERE

> ;END TOPS20 CONDITIONAL

;SCHEDULER FLAGS
	PSF%OB==1B1			;OUTPUT BLOCKED
	PSF%DO==1B2			;DEVICE IS OFF-LINE
	PSF%ST==1B3			;STOPPED BY OPERATOR
	PSF%OR==1B4			;OPERATOR RESPONSE WAIT
	PSF%NP==1B5			;GO TO NEXT PROCESS

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

	TOPS10	<INTVEC==VECTOR>

	TOPS20	<INTVEC==LEVTAB,,CHNTAB>

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

PIB:	$BUILD	(PB.MNS)
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;PIB LENGTH,,0
	  $SET	(PB.FLG,IP.PSI,1)	;PSI ON
	  $SET	(PB.INT,IP.CHN,0)	; CHANNEL 0
	  $SET	(PB.SYS,IP.BQT,-1)	;MAX IPCF QUOTAS
	$EOB

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

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

TOPS10 <

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

TOPS20 <

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


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

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

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

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

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

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


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

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

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

;HERE IF NO STREAM IS RUNNABLE

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

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

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

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

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

DOJOB:	$CALL	FORMS			;GET FORMS MOUNTED
	MOVE	S1,J$LSER(J)		;GET DEVICE DISPATCH TABLE
	PUSHJ	P,DBANN(S1)		;AND DO A BANNER IF NECESSARY
	LOAD	E,.EQLEN(J),EQ.LOH	;GET LENGTH OF HEADER
	ADD	E,J			;POINT TO FIRST FILE
	MOVE	T1,.EQCHK+CKFIL(J)	;YES, GET NUMBER OF FILES DONE
	MOVEM	T1,J$RNFP(J)		;STORE FOR NEXT CHECKPOINT
DOJO.1:	SOJL	T1,DOJO.2		;DECREMENT AND JUMP IF SKIPED ENUF
	PUSH	P,T1			;ELSE, SAVE T1
	$CALL	NXTFIL			;BUMP E TO NEXT SPEC
	POP	P,T1			;RESTORE T1
	JUMPF	ENDJOB			;FINISH OFF IF DONE
	JRST	DOJO.1			;LOOP SOME MORE

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

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

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

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

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


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

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

TOPS10 <
	$CALL	OUTWAT			;OUTPUT AND WAIT UNTIL DONE
> ;;END TOPS10

TOPS20 <
	$CALL	OUTOUT			;FORCE EVERYTHING OUT
> ;;END TOPS20

	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
TOPS20 <
	PUSHJ	P,OUTOUT		;FORCE OUTPUT
> ;;END TOPS20
	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	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	(<Cancel request queued by user ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1))
	PUSHJ	P,SETEBF		;SET UP ERROR BUFFER
	$TEXT	(DEPBP,<? Canceled by user ^U/ABO.ID(M)/^0>)
	$RETT				;AND RETURN
SUBTTL	UPDATE Routine to send status update


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

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

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

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


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

CHKP.0:	MOVX	S1,CHE.SZ		;GET SIZE OF CHECKPOINT MESSAGE
	MOVX	S2,.QOCHE		;AND CHECKPOINT TYPE
	PUSHJ	P,CLRMSG		;INIT MESSAGE AND T1
	MOVX	S1,CH.FCH!CH.FST	;GET CHECKPOINT AND STATUS FLAGS
	STORE	S1,CHE.FL(T1)		;AND STORE THEM
	MOVE	S1,J$RNFP(J)		;GET NUMBER OF FILES
	MOVEM	S1,CHE.IN+CKFIL(T1)	;STORE IT
	MOVE	S1,J$RNCP(J)		;GET NUMBER OF COPIES
	MOVEM	S1,CHE.IN+CKCOP(T1)	;AND STORE IT
	MOVE	S1,J$APRT(J)		;GET NUMBER OF CARDS, ETC
	MOVEM	S1,CHE.IN+CKTPP(T1)	;AND STORE IT
	LOAD	S1,.EQITN(J)		;GET JOBS ITN
	MOVEM	S1,CHE.IT(T1)		;STORE IT

	MOVEI	S1,CHE.ST(T1)		;GET ADDRESS OF STATUS AREA
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVEM	S1,TEXTBP		;SAVE BYTE POINTER
	MOVEI	S1,STSSIZ*5-1		;MAXIMUMUM CHARACTER COUNT
	MOVEM	S1,TEXTBC		;FOR DEPBP
CHKP.1:	$TEXT	(DEPBP,<Started at ^C/J$RTIM(J)/, ^A>)
	MOVE	S1,J$LSER(J)		;GET ADDRESS OF DEVICE DISPATCH
	PUSHJ	P,DCHKP(S1)		;GENERATE DEVICE DEPENDANT TEXT
	HRRZ	S1,TEXTBP		;GET THE BYTE POINTER
	SUBI	S1,MSGBLK-1		;SUBTRACT START POINT
	STORE	S1,.MSTYP(T1),MS.CNT	;SAVE THE ACTUAL LENGTH
	PJRST	SNDQSR			;SEND IT AND RETURN
SUBTTL	SETUP/SHUTDOWN Message

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

	SETZ	T2,			;CLEAR A LOOP REG

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

SETU.2:	HRRZM	T2,STREAM		;SAVE THE STREAM NUMBER
	$CALL	I%NOW			;USE SETUP TIME AS ACK STAMP
	MOVEM	S1,JOBWAC(T2)		;SAVE CODE FOR $WTOR
	MOVEI	S1,NJBPGS		;NUMBER OF PAGES NEEDED
	$CALL	M%AQNP			;GET THEM
	PG2ADR	S1			;CONVERT TO AN ADDRESS
	MOVEM	S1,JOBPAG(T2)		;AND SAVE IT
	MOVE	J,S1			;PUT IT IN J
	MOVEM	J,J$RACS+J(J)		;SAVE J AWAY
	MOVEI	S1,2000(J)		;DEV BUFFER ADDRESS
	MOVEM	S1,J$LBUF(J)		;STORE IT
	MOVE	S2,T2			;COPY OVER THE STREAM NUMBER
	IMULI	T2,OBJ.SZ		;GET OFFSET OF OBJECT BLOCK
	ADDI	T2,JOBOBJ		;ADD IN THE BASE
	MOVEM	T2,JOBOBA(S2)		;STORE OBJECT ADDRESS
	MOVE	S2,T2			;GET DESTINATION OF BLT INTO S2
	HRLI	S2,SUP.TY(M)		;MAKE A BLT POINTER
	BLT	S2,OBJ.SZ-1(T2)		;BLT THE OBJECT BLOCK
	$CALL	OUTGET			;GET THE OUTPUT DEVICE
	$CALL	RSETUP			;SEND RESPONSE TO SETUP
	HRRZ	S2,STREAM		;GET OUR STREAM NUMBER
	$WTO	(^T/@SETMSG(S1)/,,@JOBOBA(S2)) ;TELL THE OPERATOR
	CAIN	S1,%RSUOK		;ALL IS OK?
	$RETT				;YES, RETURN
	JRST	SHUTDN			;NO, SHUT IT DOWN

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

;CALL		S1/ Setup response code

;RETURNS	S1/ Setup response code

RSETUP:	$SAVE	<S1>			;PRESERVE S1 ACROSS CALL
	MOVE	T2,S1			;SAVE THE SETUP CONDITION CODE.
	MOVX	S1,RSU.SZ		;GET RESPONSE TO SETUP SIZE
	MOVX	S2,.QORSU		; AND TYPE
	$CALL	CLRMSG			;INIT MESSAGE AND T1
	STORE	T2,RSU.CO(T1)		;STORE THE RESPONSE CODE
	MOVE	S1,STREAM		;GET STREAM NUMBER
	MOVS	S1,JOBOBA(S1)		;GET OBJADR,,0
	HRRI	S1,RSU.TY(T1)		;AND PLACE TO MOVE IT TO
	BLT	S1,RSU.TY+OBJ.SZ-1(T1)	;AND MOVE THE OBJECT BLOCK
	PJRST	SNDQSR			;SEND IT OFF AND RETURN


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

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


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

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

OACCAN:	$SAVE	<P1,P2>			;PRESERVE SOME ACS
	PUSHJ	P,INPFEF		;FORCE EOF
	TXO	S,GOODBY!ABORT		;LIGHT THE ABORT FLAG
	PUSHJ	P,SETEBF		;SET UP ERROR TEXT BUFFER
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	MOVX	S2,PSF%OR		;GET OPERATOR RESPONSE BIT
	TDNE	S2,JOBSTW(S1)		;ARE WE WAITING FOR OPR RESPONSE ???
	$KWTOR	(JOBWAC(S1))		;YES,,KILL IT !!!
	ANDCAM	S2,JOBSTW(S1)		;AND CLEAR THE WAIT BIT
	$ACK	(<Abort request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$TEXT	(DEPBP,<? Aborted by the operator^A>) ;INITIAL MESSAGE
	SETZ	P1,P2			;ASSUME NOT PURGED

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

OACC.2:	SKIPN	P1			;DID HE GIVE A REASON?
	$TEXT	(DEPBP,<. No reason given.^0>) ;NO
	SKIPE	P1			;NO?
	$TEXT	(DEPBP,<. Reason: ^T/0(P1)/.^0>) ;YES
	JUMPE	P2,.POPJ		;RETURN IF NOT PURGING
	MOVE	S1,J$DIFN(J)		;GET THE FILE IFN.
	TXZE	S,DSKOPN		;DONT CLOSE IF ITS NOT OPEN.
	PUSHJ	P,F%REL			;ELSE,,CLOSE IT OUT.
	$CALL	ACTEND			;DO FINAL ACCOUNTING
	$CALL	QRELEASE		;RELEASE THE STREAM
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	SETZM	JOBACT(S1)		;INDICATE NOT ACTIVE
	PUSHJ	P,OUTFLS		;FLUSH THE OUTPUT BUFFERS
	CAIE	S1,%RSUOK		;DO WE STILL HAVE THE DEVICE?
	PJRST	SHUTUP			;NO..KILL THE STREAM
	POPJ	P,			;RETURN
SUBTTL	Operator STOP command

OACSTP:	MOVX	S2,PSF%ST		;LOAD THE STOP BIT
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	IORM	S2,JOBSTW(S1)		;SET IT
	$ACK	(<Stopped>,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$RETT				;AND RETURN

SUBTTL	Operator CONTINUE command

OACCON:	MOVX	S2,PSF%ST!PSF%DO	;LOAD STOP AND DEVICE OFF-LINE FLAGS
	HRRZ	S1,STREAM		;GET THE STREAM NUMBER
	ANDCAM	S2,JOBSTW(S1)		;CLEAR IT
	$ACK	(<Continued>,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$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
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$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	(<Requeue request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$CALL	SETEBF			;POINT TO TEXT BUFFER

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

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

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

OACR.3:	SKIPN	P1			;A REASON?
	$TEXT	(DEPBP,<. No reason given.>)
	SKIPE	P1			;LIST THEM ALL
	$TEXT	(DEPBP,<. Reason: ^T/0(P1)/.>)
	SKIPE	S2
	$TEXT	(DEPBP,<. ^T/0(S2)/.^A>)
	MOVEI	S1,.CHNUL		;END THE MESSAGE
	$CALL	DEPBP
	$RETT
SUBTTL	CLRMSG and SNDQSR routines

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

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

;RETURNS	T1/ Address of message

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


;SNDQSR is called to send a message to QUASAR

;CALL		T1/ Message address

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

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

;DEFAULT TO ASK IF NOT CANCEL OR IGNORE

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

OUTCAN:	MOVEI	S1,[ITEXT (<Output limit exceeded>)]
	$CALL	PUTERR			;Process IT
	$CALL	INPFEF			;FORCE EOF ON NEXT INPUT
	TXO	S,ABORT			;LIGHT ABORT
	HRRZ	S1,STREAM
	$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:	$STAB
	 KEYTAB	(OUTCAN,ABORT)		;ABORT (CANCEL)
	 KEYTAB	(OUTIGN,PROCEED)	;PROCEED (IGNORE)
	$ETAB

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


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

TOPS10	<				;TOPS-10 ONLY
	GETLIN	S1,			;GET OUR TTY NUMBER
	TLNN	S1,-1			;ARE WE DEATCHED ???
	$RETT				;YES,,SKIP THIS
	GTNTN.	S1,			;GET OUR LINE NUMBER
	  $RETT				;YES,,SKIP THIS
	SETOM	S2			;GET A -1
	TRMNO.	S2,			;GET OUR TTY NUMBER
	  $RETT				;YES,,SKIP THIS
	GETLCH	S2			;GET OUR LINE CHARACTERISTICS
	MOVE	TF,[ASCII/T/]		;DEFAULT TO A TTY
	TXNE	S2,GL.ITY		;ARE WE A PTY ???
	MOVE	TF,[ASCII/P/]		;YES,,MAKE US 'PTY'
	TXNE	S2,GL.CTY		;ARE WE THE CTY ???
	MOVE	TF,[ASCII/C/]		;YES,,MAKE US 'CTY'
	MOVEM	TF,L.TTY		;SAVE THE TERMINAL DESIGNATOR
	HRRZM	S1,L.LIN		;SAVE THE LINE NUMBER
	$RETT				;RETURN
>					;END OF TOPS-10 CONDITIONAL

TOPS20	<				;TOPS-20 ONLY
	$RETT				;RETURN
>					;END OF TOPS-20 CONDITIONAL
ACTBEG:	SKIPN	ACTFLG			;ACCOUNTING?
	 $RETT				;NO..JUST RETURN
	LOAD	S1,.EQSEQ(J),EQ.SEQ	;GET SEQUENCE NUMBER
	STORE	S1,J$ASEQ(J)		;STORE IT
	LOAD	S1,.EQSEQ(J),EQ.PRI	;GET EXTERNAL PRIORITY
	STORE	S1,J$APRI(J)		;STORE IT
	MOVE	S1,J$LSER(J)		;GET DISPATCH ADDRESS
	MOVE	S1,DNAME(S1)		;GET DEVICE (QUEUE) NAME
	MOVEM	S1,J$AQUE(J)		;SAVE FOR ACT END
	SETZM	J$PTIC(J)		;CLEAR PLOTTER ACCOUNTING
	$RETT				;RETURN

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

TOPS10<	MOVE	S1,[.NDRNN,,S2]		;GET CONVERT TO NAME FCT CODE
	MOVEI	S2,2			;A BLOCK LENGTH OF 2
	MOVE	T1,.EQROB+.ROBND(J)	;GET THE NODE NUMBER

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

	NODE.	S1,			;CONVERT IT
	 SKIPA				;SKIP ON AN ERROR
	MOVEM	S1,.EQROB+.ROBND(J)	;SAVE THE NODE NAME
	MOVX	S1,<ACTLEN,,ACTLST>	;SET UP AC
	QUEUE.	S1,			;MAKE A USAGE ENTRY
	 PUSHJ	P,ACTE.1		;FAILED,,TELL OPR

FACT<	MOVE	S1,L.LIN		;GET LINE NUMBER
	LDB	S2,[POINT 7,L.TTY,6]	;GET TERMINAL DESIGNATOR
	CAIN	S2,"C"			;ON THE CTY
	MOVEI	S1,7777			;YES, CTY DESIGNATOR
	CAIN	S2,"D"			;DETACHED
	MOVEI	S1,7776			;YES, FLAG THAT INSTEAD OF LINE NUMBER
	LSH	S1,6			;PUT IN BITS 18-29
	HRL	S1,L.JOB		;INSERT JOB NUMBER
	IOR	S1,[251000,,13]		;ADD FACT TYPE AND NUMBER OF WORDS
	MOVEM	S1,FACTBL+0		;STORE IN BLOCK
	MOVE	S1,.EQOID(J)		;GET PPN
	MOVEM	S1,FACTBL+1		;STORE
	SETZM	FACTBL+2		;DAEMON FILLS IN THE DATE/TIME
	MOVE	S1,[%CNSER]		;CPU SERIAL NUMBER
	GETTAB	S1,			;ASK FOR IT
	  SETZ	S1,			;USE 0 IF CAN'T FIND IT
	HLLZ	S2,J$AQUE(J)		;GET QUEUE NAME
	TLZ	S2,77			;CLEAR JUNK
	IOR	S1,S2			;INSERT QUEUE NAME
	IORM	S1,FACTBL+3		;NODE NUMBER ALREADY STORED FROM ABOVE
	MOVE	S1,J$ARTM(J)		;RUN TIME IN MILLISECONDS
	MOVEM	S1,FACTBL+4		;STORE
	SETZM	FACTBL+5		;*** CORE TIME INTERGRAL
	MOVE	S1,J$ADRD(J)		;DISK READS
	MOVEM	S1,FACTBL+6		;STORE
	SETZM	FACTBL+7		;NO DISK WRITES
	MOVE	S1,J$LDEV(J)		;DEVICE NAME
	MOVEM	S1,FACTBL+10		;STORE
	MOVE	S1,J$ASEQ(J)		;SEQUENCE NUMBER
	MOVEM	S1,FACTBL+11		;STORE
	MOVE	S1,J$APRT(J)		;NUMBER OF PAGES PRINTED
	MOVEM	S1,FACTBL+12		;STORE
	MOVE	S1,[14,,FACTBL-1]	;DAEMON ARGUMENT
	DAEMON	S1,			;MAKE THE FACT ENTRY
	  JRST	ACTE.1			;REPORT THE FAILURE
> ;END FACT ACCOUNTING
> ;END TOPS10 ACCOUNTING

TOPS20<	MOVX	S1,.USENT		;WRITE AN ENTRY
	MOVEI	S2,ACTLST		;POINT TO THE LIST
	USAGE				;DO THE JSYS
	  ERJMP	ACTE.1			;ON AN ERROR,,TELL THE OPERATOR
>					;END OF TOPS-20 CONDITIONAL

	$RETT				;RETURN WHEN DONE

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

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

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

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

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

FORMS:	GETLIM	S1,.EQLIM(J),FORM	;GET THE FORMS TYPE
	CAMN	S1,J$FORM(J)		;EXACTLY THE SAME?
	$RETT				;YES, JUST RETURN
	MOVE	S2,[POINT 7,J$XTBF(J)]	;GET POINTER TO WTOR BUFFER.
	MOVEM	S2,TEXTBP		;AND SAVE IT FOR DEPBP.
	MOVEI	S2,TXT$LN*5		;GET MAXIMUM BYTE COUNT
	MOVEM	S2,TEXTBC
	SKIPN	S2,J$FORM(J)		;GET FORMS TYPE
	MOVX	S2,FRMNOR		;USE NORMAL IF NULL
	XOR	S1,S2			;GET COMMON PART
	AND	S1,[EXP FRMSK1]		;AND IT WITH THE IMPORTANT PART
	GETLIM	S2,.EQLIM(J),FORM	;GET FORMS TYPE
	EXCH	S2,J$FORM(J)		;SAVE IT
	MOVEM	S2,J$FPFM(J)		;SAVE OLD ONES
	SKIPE	S1			;NO NEED TO CHANGE FORMS.
	$TEXT	(DEPBP,<Please load forms type '^W/J$FORM(J)/'>)

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

FORM.2:	$CALL	FRMINI			;READ THE SPFORM.INI FILE.
	MOVE	S1,TEXTBP		;GET THE WTOR BYTE POINTER.
	CAMN	S1,[POINT 7,J$XTBF(J)]	;IS THERE A MESSAGE FOR THE OPERATOR ??
	$RETT				;NO,,RETURN.
	$TEXT	(DEPBP,<Type 'RESPOND ^7/[.CHLAB]/number^7/[.CHRAB]/ PROCEED' when ready^0>)
	HRRZ	S1,STREAM		;GET STREAM NUMBER
	$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.2			;NO -- END LINE

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

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

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

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


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

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

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

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

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

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

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

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

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


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

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

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


					;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C

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

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


;ROUTINE TO PICK UP A DECIMAL NUMBER

FH$DEC:	SETZ	T1,			;PLACE TO ACCUMULATE RESULT
FH$DE1:	$CALL	FH$CHR			;GET A CHARACTER
	JUMPF	.RETF			;EOF, RETURN
	CAIL	C,"0"			;CHECK THE RANGE
	CAILE	C,"9"			;0-9
	  POPJ	P,			;RETURN
	IMULI	T1,12			;SHIFT A PLACE
	ADDI	T1,-"0"(C)		;ADD IN A DIGIT
	JRST	FH$DE1			;AND LOOP AROUND
SUBTTL	INPOPN - Routine to open the input file

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

INPOPN:	MOVEI	S1,FOB.SZ		;GET THE FOB SIZE
	MOVEI	S2,J$XFOB(J)		;AND THE FOR ADDRESS
	$CALL	.ZCHNK			;ZERO IT OUT
	LOAD	S1,.FPLEN(E),FP.LEN	;GET THE FP LENGTH
	ADD	S1,E			;GET THE FD ADDRESS
	MOVEM	S1,J$DFDA(J)		;SAVE THE ADDRESS
	STORE	S1,J$XFOB+FOB.FD(J)	;SAVE IN THE FOB
	MOVEI	S1,^D36			;USE FULL WORDS
	STORE	S1,J$XFOB+FOB.CW(J),FB.BSZ  ;AND SAVE THE BYTE SIZE
	MOVEM	S1,J$DBSZ(J)		;SAVE AS INPUT BYTESIZE
	LOAD	S1,.EQSEQ(J),EQ.PRV	;GET SENDERS PRIV BIT
	JUMPN	S1,INPO.1		;IF SET, AVOID ACCESS CHECK
	LOAD	S1,.FPINF(E),FP.SPL	;LIKEWISE IF SPOOLED
	JUMPN	S1,INPO.1		; ...

TOPS20 < HRROI	S1,.EQOWN(J)>		;GET THE OWNERS NAME ON TOPS-20
TOPS10 < LOAD	S1,.EQOID(J)>		;GET THE OWNERS NAME ON TOPS-10
	STORE	S1,J$XFOB+FOB.US(J)	;SAVE IT
TOPS20 <
	HRROI	S1,.EQCON(J)		;GET CONNECTED DIRECTORY
	STORE	S1,J$XFOB+FOB.CD(J)	;AND SAVE IT
>  ;END TOPS20 CONDITIONAL

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

INPO.3:	MOVEI	S1,[ITEXT (<Cannot access file; ^E/[-1]/ File: ^F/@J$DFDA(J)/>)]
	$CALL	PUTERR			;AND TYPE ERROR MESSAGE
	$RETF
SUBTTL	INPBUF - Read a buffer from the input file

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


SUBTTL	INPBYT - Read a byte from the input file

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

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

SUBTTL	INPERR - Handle an input failure

INPERR:	CAXN	S1,EREOF$		;WAS IT EOF?
	$RETF				;WAS JUST RETURN
	MOVEI	S1,[ITEXT (<File input error; ^E/[-1]/>)]
	$CALL	PUTERR			;AND PUT AN ERROR OUT
	TXO	S,SKPFIL		;SKIP 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
	HRROI	S1,J$LDEV(J)		;POINT TO ASCIZ DEVICE NAME
	$CALL	S%SIXB			;CONVERT IT TO SIXBIT
	MOVEM	S2,J$LDEV(J)		;REPLACE ASCIZ NAME
	MOVE	S1,J$LBUF(J)		;GET BUFFER PAGE ADDRESS
	HRLI	S1,440000		;MAKE POINTER WITH ZERO BYTE SIZE
	STORE	T1,S1,BP.SIZ		;STORE ACTUAL BYTE SIZE
	MOVEM	S1,J$LBPT(J)		;AND SAVE THE POINER
	MOVEM	S1,J$LIBP(J)		;AND AS INITIAL POINTER
	MOVEI	S1,^D36			;LOAD BITS/WORD
	IDIV	S1,T1			;COMPUTE BYTES/WORD
	IMULI	S1,PAGSIZ		;COMPUTE BYTES/PAGE
	MOVEM	S1,J$LBCT(J)		;AND SAVE IT
	MOVEM	S1,J$LIBC(J)		;AND AS INITIAL COUNT
	$CALL	OUTSTS			;GET DEVICE STATUS
	MOVX	S2,PSF%DO		;DEVICE OFFLINE FLAG
	HRRZ	T1,STREAM		;GET STREAM NUMBER
	ANDCAM	S2,JOBSTW(T1)		;CLEAR THE VALUE
	TXNN	S1,MO%OL		;IS IT OFF-LINE?
	JRST	OUTSOK			;NO..CONTINUE
	IORM	S2,JOBSTW(T1)		;YES, SET FLAG
	$CALL	OUTWON			;SEND THE OFFLINE MESSAGE
	JRST	OUTSOK			;CONTINUE ON OK
OUTSOK:	$CALL	INTCNL			;CONNECT UP THE DEV
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL

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

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

;CALL WITH CHARACTER IN ACCUMULATOR 'C'.

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

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


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


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

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

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

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

DEVERR:	MOVE	S1,J$LIOS(J)		;GET IO STATUS
	MOVE	S2,J$LSER(J)		;GET ADDRESS OF SERVICE ROUTINES
	PUSHJ	P,DERR(S2)		;DO ERROR ROUTINE
	JUMPT	.POPJ			;ERROR CORRECTED -- RETURN
	
	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
	$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	OUTREL - Release output device

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

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

> ;END TOPS20 CONDITIONAL
SUBTTL	OUTWON - Wait for on-line

;On the -10, this routine should only be gotten to by DEBRKing to it
;	on a device off-line interrupt.  On the -20, it can be called
;	from anywhere.


TOPS10 <
OUTWON:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	HRRZ	S1,STREAM		;POINT TO CURRENT STREAM
	$WTO	(Device went off-line,,@JOBOBA(S1))
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$DSCHD(0)			;BLOCK FOR DEVICE ON-LINE
	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	JRST	@J$LIOA(J)		;AND CONTINUE ON
>  ;END TOPS10 CONDITIONAL

TOPS20 <
OUTWON:	MOVX	S2,PSF%DO		;DEVICE OFFLINE FLAG
	HRRZ	S1,STREAM		;AND THE STREAM NUMBER
	TDNN	S2,JOBSTW(S1)		;IS IT OFF-LINE?
	POPJ	P,			;NO, JUST RETURN
	PUSHJ	P,UPDATE		;UPDATE STATUS TO QUASAR
	$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 -- Dispatch table


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


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


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



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

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

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


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

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


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

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


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

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

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

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

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

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

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


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

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

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

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


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


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

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

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

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

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


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


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


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

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


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


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


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


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


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


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


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


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


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

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


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


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

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

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


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

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


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


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

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

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

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

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


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

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


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

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

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


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

	;PLOT THE USERS NAME

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

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

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

REPEAT 0,<

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

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

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


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


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


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

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


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

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



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

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


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

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

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

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

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

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

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

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

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


;DEFINE MACRO TO GENERATE CHARACTER TABLE ENTRY AS FOLLOWS

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

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

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

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

;	PEN	1 FOR PEN DOWN
;		0 FOR PEN UP

;	VERTICAL OFFSET	  POINT IN CHARACTER GRID WHERE SEGMENT ENDS

;	HORIZONT OFFSET   POINT IN CHARACTER GRID WHERE SEGMENT ENDS

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

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

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


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


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


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

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

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

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


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



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


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

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


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

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

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


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





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


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


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


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

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


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


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


;Call	T1/ Count of Blank folds to ppunch

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

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


;SUBROUTINE TO PUNCH BLOCK CHARACTERS IN PAPER-TAPE

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

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


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


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

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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

;DOSTRMS MACRO TO REPEAT CODE FOR MULTIPLE STREAM

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


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

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

CHNTAB:	XWD	1,INTIPC		;IPCF CHANNEL 0
  DOSTRMS <				;REPEAT FOR EACH STREAM
	XWD	1,INTDEV+<DVHDSZ*Z>	;LEVEL 1, DEVICE HEADER CODE
  > ;END DOSTRMS
	BLOCK	^D35-NSTRMS		;CLEAR REST OF TABLE

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

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

	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <

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

INTINI:	MOVX	S1,.FHSLF		;LOAD MY FORK HANDLE
	MOVX	S2,INTMSK		;CHANNEL MASK
	AIC				;ACTIVATE THE CHANNELS
	POPJ	P,			;AND RETURN
>  ;END TOPS20 CONDITIONAL
TOPS10 <

INTDCL:	SKIPA	S1,[PS.FRC+T1]		;REMOVE CONDITION USINGS ARGS IN T1
INTCNL:	MOVX	S1,PS.FAC+T1		;ADD CONDITION USING ARGS IN T1
	MOVE	T1,J$LJFN(J)		;USE CHANNEL AS CONDTION
	HRRZ	T2,STREAM		;GET STREAM NUMBER
	IMULI	T2,4			;GET BLOCK OFFSET
	ADDI	T2,VECDEV-VECTOR	;GET OFFSET FROM BEGINNING
	HRLZS	T2			;GET OFFSET,,0
	HRRI	T2,PS.RDO+PS.ROD+PS.ROL	;AND CONDITIONS
	SETZ	T3,			;ZERO T3
	PISYS.	S1,			;TO THE INTERRUPT SYSTEM
	  HALT
	POPJ	P,			;AND RETURN
>  ;END TOPS10 CONDITIONAL

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

TOPS10 <

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

;Here on device interrupts on the -10.  This routine consists of multiple
;	interrupt headers (one for each stream) which load S1 and S2 and
;	call the main interrupt body, DVINTR.  Note that on the -10, while
;	it is assumed that 'output done' and 'on-line' interrupts can happen
;	anytime and anywhere, it is also assumed that 'device off-line'
;	interrupts ONLY HAPPEN IN THE STREAM CONTEXT.

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

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

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

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

TOPS20 <

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

;Here on device interrupts on the -20.

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

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

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

INTDON:	SKIPN	J,JOBPAG(T1)		;MUST HAVE A JOB PAGE
	JRST	INTBRK			;NO -- JUST DISMISS INTERRUPT
	MOVEI	S1,OUTINT		;SET UP TO BREAK OUT OF SOUT
	SKIPE	J$LIOA(J)		;ARE WE IN SOUT?
	MOVEM	S1,LEV1PC		;YES -- BREAK OUT ON $DEBRK
INTBRK:	$DEBRK

>  ;END TOPS20 CONDITIONAL
SPOEND::END	SPROUT