TITLE	CDRIVE - Multiple Card Reader Spooler

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



	SEARCH	GLXMAC,ORNMAC,QSRMAC
	PROLOG	(CDRIVE)

	.DIRECT	FLBLST

IF1,<
	TOPS10	<PRINTX Assembling Galaxy-10 Card Reader Spooler>
	TOPS20	<PRINTX Assembling Galaxy-20 Card Reader Spooler>
>

	SALL

	;VERSION INFORMATION

	RDRVER==1
	RDRMIN==0
	RDREDT==116
	RDRWHO==0

	%RDR==<BYTE (3)RDRWHO (9)RDRVER (6)RDRMIN (18)RDREDT>

	LOC	137

	EXP	%RDR

	RELOC	0


	SUBTTL	Table of Contents

;               TABLE OF CONTENTS FOR cdrive
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. SETUP REMOTE STATION PARAMETERS...........................   3
;    3. DN60 parameters...........................................   4
;    4. Revision History..........................................   5
;    5. CARD READER DATA BASE.....................................   6
;    6. Macros....................................................   7
;    7. LOCAL, DN200, & DN60 BYTE DEFINITIONS.....................   8
;    8. CARD READER DATA BASE.....................................   9
;    9. Random Impure Storage.....................................  11
;   10. Resident JOB Database.....................................  11
;   11. GLXLIB IB AND HELLO MESSAGE STRUCTURES....................  12
;   12. CDRIVE - Multiple card reader spooler.....................  13
;   13. Idle Loop.................................................  14
;   14. CHKTIM - ROUTINE TO SEE IF ITS TIME TO SCHEDULE A STREAM..  15
;   15. OACCAN - Operator CANCEL request..........................  16
;   16. OACPAU - Operator PAUSE Request...........................  16
;   17. OACCON - Operator CONTINUE Request........................  16
;   18. OACSHT - ROUTINE TO VALIDATE THE READER SHUTDOWN STATUS...  16
;   19. Operator Action Request/Response..........................  17
;   20. RDINIT - ROUTINE TO INITIALIZE SOME READER CONSTANTS......  18
;   21. DOJOB - ROUTINE TO PROCESS THE CARD READERS...............  19
;   22. DSCHD -- Deschedule process...............................  20
;   23. FIXPDL -- Fix PDL routine.................................  21
;   24. PRORDR--READER INPUT PROCESSING...........................  22
;   25. INCARD - ROUTINE TO READ CARDS FROM THE CARD READER.......  23
;   26. INPGET  --  OPEN the input device.........................  24
;   27. GENFIL - ROUTINE TO GENERATE THE SPOOL FILENAME...........  25
;   28. INPREL - ROUTINE TO RELEASE A CARD READER.................  26
;   29. Interrupt Module..........................................  27
;   30. INTIPC - IPCF INTERRUPT PROCESSING ROUTINE................  29
;   31. CHKQUE - ROUTINE TO CHECK FOR IMCOMMING MESSAGES..........  30
;   32. - CHKOBJ - ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.  31
;   33. SETUP/SHUTDOWN Message....................................  32
;   34. QSRNWA - ROUTINE TO PROCESS NODE-WENT-AWAY MESSAGES.......  34
;   35. SHUTDN - ROUTINE TO SHUT DOWN A LINE-PRINTER..............  35
;   36. RSETUP - ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR  35
;   37. FNDOBJ - ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE.....  36
;   38. UPDTST - ROUTINE TO SEND READER STATUS INFORMATION TO QUASAR  37
;   39. SNDQSR - ROUTINE TO SEND A MESSAGE TO QUASAR..............  38
;   40. IDLE LOOP.................................................  39
;   41. CHKFRK - ROUTINE TO PROCESS INFERIOR FORK TERMINATION.....  40
;   42. RDINIT - ROUTINE TO INITIALIZE READER CONSTANTS...........  41
;   43. INPGET - ROUTINE TO SETUP THE READER FORK.................  42
;   44. OACPAU - ROUTINE TO STOP A READER.........................  44
;   45. OACCON - ROUTINE TO CONTINUE A READER.....................  44
;   46. OACCAN - ROUTINE TO CANCEL THE CURRENT JOB ON THE READER..  44
;   47. OACSHT - ROUTINE TO SHUTDOWN THE CARD READER..............  44
;   48. INTERRUPT ROUTINES........................................  45
;   49. INPREL - ROUTINE TO RELEASE A CARD  READER................  46
;   50. SPOOLER - CARD READER SPOOLER FORK ROUTINE START ADDRESS..  47
;   51. MAINRT - ROUTINE TO INPUT AND PROCESS CARDS...............  48
;   52. GENFIL - ROUTINE TO GENERATE A SPOOL FILENAME.............  49
;   53. CHKOFL - ROUTINE TO CHECK LOCAL/REMOTE OFFLINE STATUS.....  49
;   54. CHKSTS - ROUTINE TO PROCESS THE DIFFERENT STATUS INTERRUPTS  50
;   55. GETDDT - ROUTINE TO LOAD DDT IF WE ARE DEBUGGING..........  50
;   56. SENDIT - ROUTINE TO SEND IPCF MESSAGES TO QUASAR..........  51
;   57. SNDSTS - ROUTINE TO SEND READER STATUS UPDATES TO QUASAR..  52
;   58. SETINT - ROUTINE TO SETUP PROCESS INTERRUPTS..............  53
;   59. INTERRUPT ROUTINES........................................  54
;   60. LOCAL/REMOTE I/O SUBROUTINES..............................  55
;   61. DN200 I/O SUPPORT ROUTINES................................  57
;   62. TOPS10 DN60 INTERFACE ROUTINES............................  58
;   63. DN60 I/O SUPPORT ROUTINES.................................  59
;   64. D60SU - DN60 success routine to fix counts................  60
;   65. D60ER - Process DN60 errors...............................  61
;   66. READER - ROUTINE TO PROCESS THE INPUT CARDS...............  64
;   67. PADJBP -- Positive ADJBP..................................  65
;   68. $CARD - ROUTINE TO PROCESS $ CARDS........................  66
;   69. JOBCRD - ROUTINE TO PROCESS A JOB CARD....................  67
;   70. EOJCRD - ROUTINE TO PROCESS $EOJ CARDS....................  68
;   71. SITCRD - ROUTINE TO PROCESS $SITGO CARDS..................  69
;   72. ENDCRD - ROUTINE TO PROCESS END-OF-FILE CARDS.............  70
;   73. COMMAND - ROUTINE TO PROCESS THE $$ COMMAND FOR OPR.......  70
;   74. I60OPR  Routine to get operator messages..................  71
;   75. OPRCMD - ROUTINE TO GENERATE AN OPR COMMAND MESSAGE.......  72
;   76. GETFIL - ROUTINE TO CREATE AN OUTPUT SPOOL FILE...........  73
;   77. OUTCRD - ROUTINE TO OUTPUT A CARD.........................  74
;   78. CREATE - ROUTINE TO GENERATE A CREATE MESSAGE FOR QUASAR..  75
	SUBTTL	SETUP REMOTE STATION PARAMETERS


TOPS20	<
	;IF WE HAVE RJE SUPPORT, GET JSYS SIMULATION PACKAGE

	FTRMTE==FTRJE!FTDN60		;SEE IF ANY REMOTES GEN'D

	IFN FTRJE,<.REQUIRE NURD.REL>	;GET DN200 I/O PACKAGE

> ;END TOPS20 CONDITIONAL


TOPS10<	FTRMTE==-1 >			;DEFAULT TO RJE ON THE -10


	SUBTTL	DN60 parameters

IFN FTDN60,<
	    SEARCH D60UNV		;GET DN60 UNIVERSAL

	.Z.==$ER1ST			;SET STARTING VALUE

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

D60TXT:	D60ERR	TEXT			;DEFINE THE ERROR TEXT

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

	X	(CFE,<Can't condition DN60 front-end>)
	X	(O6R,<Can't open remote DN60 reader>)
	X	(OHC,<Can't open HASP console>)
	X	(IDE,<DN60 Input Device Error>)
	X	(CRR,<Can't Release DN60 Reader>)
	X	(CRC,<Can't Release DN60 Console>)
	X	(CDL,<Can't Disable DN60 Line>)
	X	(CDE,<DN60 Console input error>)

> ;End FTDN60 conditional


	SUBTTL	Revision History

COMMENT \

1	Add Symbols CRDNBR, CRDSIZ. Change the processing routines
	to use them.

2	Add SNDSTS routine to send QUASAR current device status information

3	Change IB to new format and add PIB.

4	Delete routine DISPAT. Add DN200 support.

5	Add Status update messages capability

6	Major revision to support DN200 and DN60 readers

7	Fixup minor bugs caused by revision 6

10	Add routine OACSHT for defered reader shutdown.
	Make a lot of minor cosmetic modifications.

11	Fix major bugs caused by introduction of DN60 support

12	Add the operator command processor for DN60 remote stations

13	For DN60 card readers, after sleeping for 3 seconds following
	an offline condition, when we wake up clear the offline flag
	so that we perform another scheduling pass.

14	Change the IPCF send/recieve quotas from max to 20.

15	Change the DN60 open code to support the new port/line handles.

16	Fix a bug which would enable -20 CDRIVE to miss an IPCF interrupt

17	Fix a bug so that the correct error text is displayed on fork 
	termination

20	Delete the Send/Receive Quotas from the PIB.

21	Make a check for Non-Existant Readers in the Tops20 Open Routine.

22	Delete the call to F%FCHN and use the stream number as the channel
	number (TOPS10 Only)

23	Fix a Bug - Move the code to close the spool file to CREATE.

24	Add DN60 line conditioning support.

25	Don't interrupt the superior when re-initing the reader for device EOF.

26	At last, finish up DN60 changes. Delete DB entry .RDCND and replace
	it with .RDSUP in which we will now store the SETUP message.
	Change the calling parms for D60CND to use the SETUP message
	instead of .RDCND
	Change all references to .RDCND to .RDSUP

27	Add support for Node-Went-Away message.

30	Fix a bug affecting the -10 only. In SETUP, SETZM the FLAG word
	after setting up the card reader data base.

31	Change 'Cancelled' to 'Canceled'

32	Move search for DN60 symbols to FTDN60 conditional

33	Rewrite the INCARD routine so the the 'Input Done' status bit gets
	set before the IN UUO is done, and gets cleared if the UUO succeeds.

	RELEASE 4.1 LOADTEST STARTS HERE

34	Add support for 'data missed' errors

35	Add SITGO support

36	Add DN60 support for TOPS10

37	Fix interrupt code to handle node offline interrupt correctly.

40	Add prototype node handling for DN60.

41	Add variable to keep last DN60 error

42	Interchange the release of the reader with the QUASAR notification
	to prevent confusion on QUASAR's part

43	Misc:	$STOP if lousy error message from D60SIN
		DSCHD for 1 sec if too many device errors so stream
			will wake up to shutdown.
		Cause successful opening of DN60 to send status message
		Allow an infinite number of D6NBR returns if no job card

44	Add code to do the DN60 console input for HASP

45	Performance and nice stuff for the DN60
		Disable the line as part of the DN60 close.  Only allow
			a limited number of NBR errors to occur during
			the close cycle.
		Cause NBR errors during a job to only sleep for 2 seconds
			(SHSLPT)
		Increase all other sleep times to 10 octal secs. to limit
			overhead (LGSLPT)
		Make it so that 1 bad error from D60ER is a fatal error
			and cause for shutdown.

46	Initialize JOBSTW for a DN60 stream

47	Fix I60OPR to calculate next count for D60SIN correctly, expand
	size of CMDBUF.

50	Make the prototype node stuff really work.

51	Clear input blocked bit before calling OACREQ in INCARD.

52	Calculate the size of a stream's data base using the actual current
	size instead of guessing.

53	Make EOF work correctly by testing and clearing the IO.EOF bit
	in INCARD and by closing the input file.

54	Continue to make EOF work by incrementing card count in CRDEOF
	after creating fake EOF card.

55	Replace ADJBP with routine to fake it so it works
	on a KI in READER

56	Change $WTO to $WTOJ on "n cards spooled message"

57	1-22-81	In reading $ cards, if no match, do not reject the card.

60	Remove require for d60jsy and place in cdrive.cmd so we can get
	symbols for the d60jsy code

61	3/12/81  Implement image mode correctly for remote readers on TOPS10
	by treating remote readers and local readers the same in PRORDR.
	Force RDSCHD to be set on exit of an IPCF message processing routine.

62	4/14/81  Lots of changes to clean up and place on the 20
	Make STREAM an AC (AC12).
	Remove .RDUNT since it is not used (and was set incorrectly)
	Remove OUTDDE since it is not referenced.

63	5/12/81  Force the right connections to the DN60 stuff including
	fixing DSCHD, moving some code from $open to gtfj.6, removing
	GETHSP and the reference to it, and fixing up the returns from SIN.6.
	Remove TOPS20 references to SCHEDL, using only RDSHCD for scheduling.
	Make setting the stream's ACs done in a routine SETACS so T10 can
	do it after INPGET and T20 can do it before.
	At the end of CHKQUE loop until no more messages.
	Remove symbol GOODBY since it is not used.
	Don't sleep special for DN60 reader at main.1 (T20)

64	5/14/81  Add .RNSTW and change CDINTR and INPOFF so we can poll
	remote off-line card readers.

65	5/16/81  Set STREAM in SETACS.
	Use operator resp. wait as a status type.
	Only set for status update in CDINTR if we really need it.
	In routine CREATE (t10) do 2 things:
	1.	Move the release of the IFN until after the FD is copied
		into the QUASAR message.
	2.	Get the real FD from GLXLIB so physical structure is used.

66	5/26/81  Change REJECT + 1 to cause fake job decks to be created instead
	of quietly flushing cards.
	Fix the DSCHD code for TOPS-20.

67	6/15/81  Change the way we setup stream AC's incase an interrupt
	occurs with out P being set up.

70	8/20/81  Do some work to support DN60.  Add routine FIXPRO to
	set the prototype node name correctly (at different places for
	T10 and T20).  Return true from SIN.6 if got an OK error.
	Make use of .RDSTP consistant and use it also as a flag to
	avoid recursive or redundant error messages.

71	8/26/81  Fix missing instructions in CHKQUE.  Flush if not from OPR
	or QUASAR

72	9/4/81  Try not to get rid of inferior fork only if both
	debugging and an error has occured in the inferior.
	Shut down the process even if we are online.

73	9/9/81  Always do D60INI if it is possible to do IBMCOM, as
	part of initialization @CDRIVE.
	Make the reader always idle except when reading a job.
	Make OPRCMD delete trailing blanks from remote operator commands.

74	9/16/81  Finish up the previous edit.  Fix a typo in OPRCMD
	and also check for carriage return instead of line feed.

75	9/17/81  Need to split routine SETINT.  The problem is to
	activate interrupts before opening but not to activate the
	online/offline channel until after OPEN by adding COMINT.
	Add IBM statistics message (IBMSTM) and routine (IBMSTS).

76	9/18/81  Remove all references to .RDREJ and all of the reject
	code since it is not used any more.
	Add handling for abort from IBM stream.

77	9/21/81  In INTERR, only get and set error code if none has
	been generated previously and save only the error code.
	Make ERJMP INTERR into ERCAL INTERR.
	Handle ABORT in I60OPR.  Change $CALL D60ER to $D60ER ERCDE.
	Clear the error after the call (D60ER) if the error was ok.
	Set S2 that was clobbered by the call to IBMSTS.

100	11/1/81  On T10 do D60INI only at startup.  On T20 do it once per fork.
	Fix it so the data base has the proto name in the actual slot only
	for the response to setup message.  This makes all other starting
	messages from cdrive have the actual node name.  On T20, force a
	disable of the line with the routine KILL.

101	11/10/81  Try to make status more consistant.  Remove .RNSTW and use
	.RDOFL instead.  Add routine GSTS which gets the status.  This is
	because on the 20 the status can be send by either the superior or
	inferior fork and they use different memory for the send.  Now both
	status sends can use the same status determination.
	Try also to make shutdowns more consistant.  In CHKF.1, only
	clean up inferior if shutdown is set only if the fork has also halted.
	Everytime we change JOBCD bit in FLAG, save it also in .RDREG so
	superior fork will know it for job status messages.  (on the 10,
	it helps none but nor does it hurt)

102	11/24/81  Since whether we are in a job changes the state (from idle
	to reading and back) cause a status update everytime we change JOBCD.

103	12/2/81  Need to send message to ORION if D60SIN failed since the
	operator is not really there anymore.

104	12/4/81  Need to set .RDSHT in KILL but only for T10.  NOTE: .RDSHT
	means different things in the different versions.  See definition.
	Want to set NENBR large since we really don't want to stop but do
	want to maintain threshold counter to guarantee exit when in error.

105	1/4/82	Update copyrights, clarify $WTOR response.

106	3/22/82  Clear the card count after flushing a job.  GCO 4.2.1292

107	5/24/82  If we get a bad signon card, reset the line and try again
	@OPEN.6+10 or so.  GCO 4.2.1348

110	6/8/82  Set the flag AC in OACRSP so returning to CHKQUE will let
	the correct things happen.  GCO 4.2.1376

111	9/11/85  Do copyright statements.

112	21-Nov-86 /BAH  Change $STOP to STOPCD.  GCO 10467

113	Add code to make CDRIVE a %STCMD object processor.
	22-Jul-87 GCO 10542  /LWS

114	Fix a bug in edit 113 and change SOPTYP invocation to conform
	to new style. Also, don't logout if debugging.
	1-Aug-87  GCO 10548  /LWS

115	Fix problems in opening card reader when ANF is not supported
	in monitor. Requires TOPS-10 7.04 MCO 14267.
	DEC-10 89 GCO 10684  /LWS

116	Edit 115 deficient. Check both station (node) name and number
	against the node name/number in SETUP message when checking
	for local device.
	14-Jan-90 GCO 10685  /LWS

\ ;End of Revision History
	SUBTTL	CARD READER DATA BASE

	FILEMK==17777			;MASK FIELD FOR FILE NAME SPEC
	IBYT60==7			;INPUT DN60 BYTES ARE ASCII
	OBYT60==7			;OUTPT DN60 BYTES ARE ASCII
	IBYTSZ==^D18			;INPUT LOCAL/DN200 BYTES ARE 16 BITS
	OBYTSZ==^D18			;OUTPT LOCAL/DN200 BYTES ARE 18 BITS
	D60RCL==^D82			;DN60 RECORD LENGTH = 80 + <CRLF>
	LOCRCL==^D80			;LOCAL/DN200 RECORD LENGTH = 80


	PAGESZ==1000			;Page size
	MAXRDR==^D15			;MAXIMUM NUMBER OF READERS
	PDSIZE==^D200			;PDL SIZE
	MSBSIZ==30			;MESSAGE BUFFER SIZE

	;AC USAGE

	STREAM==12			;Identifies current stream data base
					;NOTE WELL!  This precludes the use
					;	     of P4
	M==13				;INCOMMING IPCF MESSAGE ADDRESS
	RDR==14				;RDR DATA BASE 
	AP==15				;POINTER TO BYTE TRANSLATION TABLE
	FLAG==16			;AC 16 HOLD FLAGS

	;STREAM STATUS BITS

	JOBCD==1B1			;JOB CARD READ AND JOB SETUP
	INTRPT==1B2			;READER IS CONNECTED TO INTRPT SYSTEM
	ABORT==1B3			;STREAM ABORT BIT.
	CD20==1B6			;READER LINE IS CD20
	EOF==1B8			;AN EOF CONDITION OCCURED

	SYSPRM	IOX4,20,IOX4		;EOF error #
	SYSPRM	IOX5,21,IOX5		;I/O device/data error
	SYSPRM	OPNX8,22,OPNX8		;Device not on line error
	SYSPRM	FDSIZE,FDMSIZ,10	;SPOOL FILE FD SIZE
	SYSPRM	CRDNBR,5,5		;NBR OF CARDS TO BE PROCESSED AT A TIME
	SYSPRM	BUFSIZ,<<CRDNBR*LOCRCL>/2>,<<<CRDNBR+1>*LOCRCL>/2> ;BUFFER SIZE
	SYSPRM	SERFLG,0,0		;SYSERR flag -- 0=no entries made
	SYSPRM	ERTCNT,4,4		;Error threshold count for DN60
	SYSPRM	NENBR,777777,777777	;# of errors allowed for NBR
					;Arbitrary large since we really don't
					;  want to stop.
	SYSPRM	NEDOL,100,100		;# of errors allowed for DOL
	SYSPRM	LGSLPT,10,10		;Long sleep time (no job or bad error)
	SYSPRM	SHSLPT,2,2		;Short sleep time (when in a job)
	SYSPRM	CMDLN,33,33		;Number of words in console command buf.

	SOPTYP	(CDRIVE,OPTYP%)		;SET OBJECT PROCESSOR TYPE

	DEFINE	GETBYT(AC,PTR),<ILDB AC,PTR
	XLIST
	ANDI	AC,7777
	LIST
	>  ;END GETBYT
	SUBTTL	Macros

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

; Macro to process DN60 errors
;
DEFINE $D60ER(ADD),<
	PUSHJ	P,D60ER
	XLIST
	JUMP	ADD
	LIST
	SALL
>  ;END DEFINE $D60ER

	SUBTTL	LOCAL, DN200, & DN60 BYTE DEFINITIONS

	LOC	0
JIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'J'
JIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'j'
OIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'O'
OIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'o'
BIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'B'
BIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'b'
DIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'D'
DIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'd'
EIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'E'
EIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'e'
SIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'S'
SIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 's'
IIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'I'
IIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'i'
TIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'T'
TIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 't'
GIMGUC:! BLOCK	1			;UPPER CASE CHARACTER 'G'
GIMGLC:! BLOCK	1			;LOWER CASE CHARACTER 'g'
$IMAGE:! BLOCK	1			;CHARACTER '$'
BLANK:!  BLOCK	1			;CHARACTER ' '
ENDIMG:! BLOCK	1			;END OF JOB CHARACTER
IMGLEN:!				;BLOCK LENGTH
	RELOC

	;DEFINE THE CHARACTER CODES FOR LOCAL AND DN200

LOC200:	$BUILD	IMGLEN
	 $SET(JIMGUC,,2400)		;IMAGE MODE 'J'
	 $SET(JIMGLC,,6400)		;IMAGE MODE 'j'
	 $SET(OIMGUC,,2010)		;IMAGE MODE 'O'
	 $SET(OIMGLC,,6010)		;IMAGE MODE 'o'
	 $SET(BIMGUC,,4200)		;IMAGE MODE 'B'
	 $SET(BIMGLC,,5200)		;IMAGE MODE 'b'
	 $SET(DIMGUC,,4040)		;IMAGE MODE 'D'
	 $SET(DIMGLC,,5040)		;IMAGE MODE 'd'
	 $SET(EIMGUC,,4020)		;IMAGE MODE 'E'
	 $SET(EIMGLC,,5020)		;IMAGE MODE 'e'
	 $SET(SIMGUC,,1200)		;ASCII MODE 'S'
	 $SET(SIMGLC,,3200)		;ASCII MODE 's'
	 $SET(IIMGUC,,4001)		;ASCII MODE 'I'
	 $SET(IIMGLC,,5001)		;ASCII MODE 'i'
	 $SET(TIMGUC,,1100)		;ASCII MODE 'T'
	 $SET(TIMGLC,,3100)		;ASCII MODE 't'
	 $SET(GIMGUC,,4004)		;ASCII MODE 'G'
	 $SET(GIMGLC,,5004)		;ASCII MODE 'g'
	 $SET($IMAGE,,2102)		;IMAGE MODE '$'
	 $SET(BLANK,,00000)		;IMAGE MODE ' '
	 $SET(ENDIMG,,7417)		;IMAGE MODE FOR END OF JOB
	$EOB

	;DEFINE THE CHARACTER CODES FOR THE DN60

CHAR60:	$BUILD	IMGLEN
	 $SET(JIMGUC,,112)		;ASCII MODE 'J'
	 $SET(JIMGLC,,152)		;ASCII MODE 'j'
	 $SET(OIMGUC,,117)		;ASCII MODE 'O'
	 $SET(OIMGLC,,157)		;ASCII MODE 'o'
	 $SET(BIMGUC,,102)		;ASCII MODE 'B'
	 $SET(BIMGLC,,142)		;ASCII MODE 'b'
	 $SET(DIMGUC,,104)		;ASCII MODE 'D'
	 $SET(DIMGLC,,144)		;ASCII MODE 'd'
	 $SET(EIMGUC,,105)		;ASCII MODE 'E'
	 $SET(EIMGLC,,145)		;ASCII MODE 'e'
	 $SET(SIMGUC,,123)		;ASCII MODE 'S'
	 $SET(SIMGLC,,163)		;ASCII MODE 's'
	 $SET(IIMGUC,,111)		;ASCII MODE 'I'
	 $SET(IIMGLC,,151)		;ASCII MODE 'i'
	 $SET(TIMGUC,,124)		;ASCII MODE 'T'
	 $SET(TIMGLC,,164)		;ASCII MODE 't'
	 $SET(GIMGUC,,107)		;ASCII MODE 'G'
	 $SET(GIMGLC,,147)		;ASCII MODE 'g'
	 $SET($IMAGE,,44)		;ASCII MODE '$'
	 $SET(BLANK,,40)		;ASCII MODE ' '
	 $SET(ENDIMG,,177)		;ASCII MODE FOR END OF JOB
	$EOB

	SUBTTL	CARD READER DATA BASE

	PHASE	0

.RDIPT:! BLOCK	1			;CARD BUFFER BYTE POINTER
.RDOPT:! BLOCK	1			;OUTPUT BUFFER POINTER
.RDCAD:! BLOCK	1			;CARD ADDRESS WITHIN INPUT BUFFER
.RDNBR:! BLOCK	1			;NUMBER OF CARDS IN THE BUFFER.
.RDSTR:! BLOCK	1			;READER STREAM NUMBER
.RDBFR:! BLOCK	1			;READER BUFFER ADDRESS.
.RDSTA:! BLOCK	1			;DEVICE STATUS WORD
.RDTIM:! BLOCK	1			;JOB START TIME
.RDINI:! BLOCK	1			;END RDR INITIALIZATION FLAG
.RDSUP:! BLOCK	SUP.SZ			;DEVICE SETUP MESSAGE

.RDREM:! BLOCK	1			;0=LOCAL,-1=DN200 REMOTE,+1=DN60 REMOTE

IFN FTDN60,<
.RDOPB:! BLOCK	OP$SIZ			;DN60 DEVICE OPEN BLOCK
.RTNBR:! BLOCK	1			;Threshold for NBR errors
.RTDOL:! BLOCK	1			;Threshold for DOL errors
.RDLER:! BLOCK	1			;Last DN60 error
.RDCPT:! BLOCK	1			;Console byte pointer to in mess.
					;  0 means there is no hasp console
.RDCCT:! BLOCK	1			;Console count for D60SIN
.RDCMD:! BLOCK	CMDLN			;Command input buffer for DN60
> ;End FTDN60 conditional

.RDPNN:! BLOCK	1			;Prototype node name
					;	(contains real node name until
					;	setup response is complete)
.RDFLG:! BLOCK	1			;FLAG WORD FOR DN60
.RDN60:! BLOCK	1			;HASP CONSOLE INPUT JFN

.RDECT:! BLOCK	1			;DEVICE ERROR COUNT
.RDIBZ:! BLOCK	1			;INPUT BYTE SIZE WE'RE PROCESSING
.RDOBZ:! BLOCK	1			;OUTPT BYTE SIZE WE'RE PROCESSING
.RDRCL:! BLOCK	1			;RECORD SIZE WE ARE PROCESSSING
.RDREG:! BLOCK	20			;STREAM AC SAVE AREA
.RDPDL:! BLOCK	PDSIZE			;STREAM CONTEXT PDL.
.RDIOA:! BLOCK	1			;INTERRUPT RETURN ADDRESS.
.CARDS:! BLOCK	BUFSIZ			;BUFFER AREA
.RDFD:!  BLOCK	FDSIZE			;FILE DESCRIPTOR FOR SPOOL FILE
.RDFOB:! BLOCK	4			;FILE OPEN BLOCK FOR GLXFIL
.RDIFN:! BLOCK	1			;GALAXY IFN FOR SPOOL FILE.

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

.RDJBT:! BLOCK	1			;COUNT OF CARDS IN DECK
.RDJBC:! BLOCK	1			;COUNT OF TOTAL JOB CARDS FOUND
.RDEOJ:! BLOCK	1			;COUNT OF TOTAL EOJ CARDS
.RDEND:! BLOCK	1			;COUNT OF TOTAL END CARDS
.RDIPC:! BLOCK	1			;IPCF MESSAGES SENT
.RDSHT:! BLOCK	1			;SHUTDOWN FLAG -1=SHUTDOWN THE READER
					;On the 20 this is only set if the
					;  shutdown is due to operator request.
					;On the 10 this is set to indicate
					;  shutdown in progress and must be set
					;  for cleanup of stream to complete.
.RDMSG:! BLOCK	MSBSIZ			;IPCF MESSAGE BUFFER
.RDRSP:! BLOCK	2			;OPERATOR RESPONSE
.RDOFL:! BLOCK	1			;ONLINE/OFFLINE FLAG (0=ON, -1=OFF)
					;On T10, does not cause blocking
					;  of stream
.RDWKT:! BLOCK	1			;STREAM WAKE UP TIME (UDT)
.RDCHN:! BLOCK	1			;CDR CHANNEL #
.RDSTS:! BLOCK	1			;FLAG -1=SEND STATUS UPDT MSG


TOPS10 <
.RDBLK:! BLOCK	3			;TOPS-10 OPEN BLOCK.
.RDIOB:! BLOCK	0			;CDR BUFFER CONTROL BLOCK.
.RDBUF:! BLOCK	1			;CDR BUFFER ADDRESS
.RDBPT:! BLOCK	1			;CDR BYTE POINTER.
.RDBCT:! BLOCK	1			;CDR BUFFER LENGTH
.RDUDX:! BLOCK	1			;CARD READER UDX
.RDDEV:! BLOCK	1			;CARD READER DEVICE NUMBER
.RDSTP:! BLOCK	1			;DN60 INPUT ERROR CODE
					;-1 = Generate no further msg.
					;  --already given
					; 0 = No error set
					;+n = 'n' is error code
>  ;END TOPS10 CONDITIONAL

TOPS20 <
.RDHND:! BLOCK	1			;INFERIOR PROCESS HANDLE
.RDRFD:! BLOCK	5			;READER FILE DESCRIPTOR
.RDSTP:! BLOCK	10			;ERROR MESSAGE BUFFER
					;The first word has the same
					;meaning as .RDSTP on T10
.RDSAB:! BLOCK	SAB.SZ			;IPCF SAB BLOCK
.RDCAN:! BLOCK	1			;CANCEL FLAG -1=CANCEL CURRENT JOB
>  ;END TOPS20 CONDITIONAL

DBEND:!				;End of defined reader data base

	DEPHASE

DBSIZE=<DBEND+PAGESZ>/PAGESZ+1		;Calculate number of pages
					;  needed for a stream database assuming
					;  cardreader buffer 1 page in size

BUFBEG=<DBEND/PAGESZ+1>*PAGESZ		;Calculate beginning of input buffer
					;  placing it at the beginning of a
					;  page

	SUBTTL	Random Impure Storage


PDL:	BLOCK	PDSIZE		;PUSHDOWN LIST
RDSCHD:	BLOCK	1		;SCHEDULING FLAG: NON-ZER0 = SCHEDULE, 0 = DON'T
SAB:	BLOCK	SAB.SZ		;A SEND ARGUMENT BLOCK
MSGBLK:	BLOCK	MSBSIZ		;A BLOCK TO BUILD MESSAGES IN.
BYTPTR:	BLOCK	1		;BYTE POINTER FOR $TEXT ROUTINE
SCHEDL:	BLOCK	1		;STREAM SCHEDULING DATA
CNTNAM:	BLOCK	1		;NODE NAME OF THE CENTRAL STATION
CNTSTA: BLOCK	1		;NUMBER OF THE CENTRAL STATION
RUTINE:	BLOCK	1		;MESSAGE PROCESSING ROUTINE ADDRESS.
NOSAVE:	BLOCK	1		;INDICATOR 0=SAVE FLAG BITS, -1=DONT.
FILENM:	BLOCK	1		;READER SPOOL FILE HASH CODE
FILEXT:	0,,1			;READER SPOOL FILE EXTENSION
SPOOL:	BLOCK	1		;SPOOL STRUCTURE PPN
PRGSTA:	BLOCK	1		;SPOOLER START ADDRESS (PAGE NUMBER)
RDRSIZ:	BLOCK	1		;SPOOLER LENGTH IN PAGES
TRMFRK:	BLOCK	1		;FORK TERMINATION FLAG
FRKINI:	BLOCK	1		;END FORK INITIALIZATION FLAG
SLEEPT:	BLOCK	1		;SECONDS TO SLEEP
IMESS:	BLOCK	1		;Flag to indicate if any IPCF messages held
				;-1 indicates IPCF message to be released
EMSG:	BLOCK	1		;Error message temp storage (D60ER)
OPTYPE:	BLOCK	1		;OBJECT PROCESSOR TYPE
SSETUP:	EXP 	0		;NUMBER OF SETUP STREAMS

	SUBTTL	Resident JOB Database

JOBPAG:	BLOCK	MAXRDR		;ADDRESS OF A TWO PAGE BLOCK

JOBOBA:	BLOCK	MAXRDR		;TABLE OF OBJECT BLOCK ADDRESSES

JOBSTW:	BLOCK	MAXRDR		;JOB STATUS WORD

JOBOBJ:	BLOCK	OBJ.SZ*MAXRDR	;LIST OF SETUP OBJECTS

JOBWAC:	BLOCK	MAXRDR		;WTOR ACK CODES

	SUBTTL	GLXLIB IB AND HELLO MESSAGE STRUCTURES


	TOPS10	<INTVEC==VECTOR>

	TOPS20	<INTVEC==:LEVTAB,,CHNTAB>


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


PIB:	$BUILD	PB.MNS				;
	  $SET	(PB.HDR,PB.LEN,PB.MNS)		;PIB LENGTH,,0
	  $SET	(PB.FLG,IP.PSI,1)		;PSI ON
	  $SET	(PB.INT,IP.CHN,0)		;INTERRUPT CHANNEL
	  $SET	(PB.SYS,IP.MNP,^D20)		;MAX NUMBER OF PIDS
	$EOB					;



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

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

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

;  This message is used to notify ORION that the link has failed.
;  ORION can then invalidate the operator for that node and the
;  system operators will get all following error messages.

NWAMSG:	$BUILD	.OHDRS+ARG.DA+OBJ.SZ
	 $SET(.MSTYP,MS.CNT,.OHDRS+ARG.DA+OBJ.SZ)
	 $SET(.MSTYP,MS.TYP,.QONWA)
	 $SET(.OARGC,,1)
	 $SET(.OHDRS+ARG.HD,AR.LEN,OBJ.SZ+1)
	 $SET(.OHDRS+ARG.HD,AR.TYP,.OROBJ)
	$EOB
> ;End of FTIBMS

;SCHEDULER FLAGS

	PSF%ID==1B1		;INPUT DONE WAIT
	PSF%DO==1B2		;DEVICE IS OFF-LINE
	PSF%ST==1B3		;STOPPED BY OPERATOR
	PSF%SH==1B4		;SHUT DOWN A CARD READER
	PSF%OR==1B5		;OPERATOR RESPONSE WAIT
	PSF%WT==1B6		;DESCHEDULE FOR 5 SECONDS

	SUBTTL	CDRIVE - Multiple card reader spooler.

CDRIVE:	RESET				;AS USUAL.
	MOVE	P,[IOWD PDSIZE,PDL]	;SET UP THE STACK.
	MOVEI	S1,IB.SZ		;GET THE IB SIZE.
	MOVEI	S2,IB			;ADDRESS OF THE IB.
	PUSHJ	P,I%INIT		;SET UP THE WORLD.
	PUSHJ	P,RDINIT		;GO SETUP READER CONSTANTS
	PUSHJ	P,INTINI		;SET UP THE INTERRUPT SYSTEM.
	PUSHJ	P,I%ION			;TURN ON INTERRUPTS.
	PUSHJ	P,I%NOW			;GET THE DATE/TIME
	MOVEM	S1,FILENM		;SAVE IT AS THE SPOOL FILE HASH CODE
TOPS10 <
IFN FTDN60,<
	MOVEI	S1,SERFLG		;Indicate need for SYSERR
	$CALL	D60INI##		;Initialize the DN60 database
> ; End of FTDN60 conditional
> ; End of TOPS10 conditional
	MOVX	S1,OPTYP%		;GET OBJECT PROCESSOR TYPE
	CAXN	S1,%DEMND		;CAN'T BE A "DEMAND SPOOLER"
	STOPCD	(CBD,HALT,,<CDRIVE can't be a %DEMND spooler>)
	SETOM	OPTYPE			;ASSUME %ONCE ONLY (REASONABLE)
	CAXN	S1,%STCMD		;START COMMAND TYPE (SHOULD BE)
	AOS	OPTYPE			;YES, MAKE ZERO
	MOVEI	S1,HELLO		;GET ADDRESS OF HELLO MESSAGE.
	MOVEI	S2,HEL.SZ		;GET LENGTH OF HELLO IN S2
	PUSHJ	P,SNDQSR		;SAY HI TO QUASAR.
	MOVSI	P1,-MAXRDR		;SET UP STREAM COUNTER.
	JRST	MAIN			;GO TO SCHEDULING LOOP
	SUBTTL	Idle Loop

TOPS10 <

MAIN:	SKIPN	JOBPAG(P1)		;IS THE STREAM ACTIVE ???
	JRST	MAIN.2			;NO,,GET THE NEXT STREAM.
	HRRZM	P1,STREAM		;RUNNABLE STREAM!!!
	MOVE	RDR,JOBPAG(P1)		;YES, GET JOB PAGE
	SKIPE	.RDSTS(RDR)		;WANT TO SEND STATUS INFO ???
	PUSHJ	P,UPDTST		;GO UPDATE AND SEND STATUS INFORMATION
	PUSHJ	P,CHKTIM		;CHECK FOR A WAKEUP TIME
	JUMPF	MAIN.2			;Go if need to wait some more
	SKIPE	JOBSTW(P1)		;IS THE STREAM WAITING ???
	JRST	MAIN.2			;YES,,GET THE NEXT STREAM.
	MOVEM	P1,SCHEDL		;SAVE THE SCHEDULING STREAM.
	MOVSI	0,.RDREG+1(RDR)		;Setup first source address
	HRRI	0,1			;Setup first destination for BLT
	BLT	0,17			;Get the AC's
	MOVE	S1,.RDNBR(RDR)		;GET # OF CARDS IN TEMP BUFFER
	CAIL	S1,CRDNBR		;HAVE WE READ ENOUGH ???
	PUSHJ	P,READER		;YES,,GO PROCESS THE CARDS
	SKIPE	.RDSHT(RDR)		;IS A SHUTDOWN SCHEDULED ???
	TXNE	FLAG,JOBCD		;YES,,ARE WE PROCESSING A JOB ???
	$RETT				;NEED MORE CARDS,, GO GET'EM !!!
	MOVX	S1,%RSUDE		;DEVICE HAS GONE AWAY
	PUSHJ	P,SHUTIT		;TIME TO SHUTDOWN,,SO DO IT !!!

MAIN.1:	MOVE	P1,SCHEDL		;GET THE LAST SCHEDULED STREAM.

MAIN.2:	AOBJN	P1,MAIN			;LOOP BACK FOR SOME MORE.
	PUSHJ	P,CHKQUE		;CHECK FOR INCOMMING MESSAGES.
	MOVE	S1,SLEEPT		;GET THE TIME TO SLEEP
	SKIPN	RDSCHD			;WANT ANOTHER SCHEDULING PASS ???
	PUSHJ	P,I%SLP			;ELSE,,GO WAIT

MAIN.3:	SETZM	SLEEPT			;ZAP THE SLEEP TIME
	SETZM	RDSCHD			;CLEAR SCHEDULING FLAG
	MOVE	P,[IOWD PDSIZE,PDL]	;RESET THE STACK POINTER.
	MOVSI	P1,-MAXRDR		;GET LOOP AC.
	JRST	MAIN			;KEEP ON PROCESSING.


SENDIT:	JRST	SNDQSR			;SLIGHT CROCK FOR -10/-20 COMPATABILITY
SNDOPR:	JRST	OPRMSG			;HERE ALSO

	SUBTTL	CHKTIM - ROUTINE TO SEE IF ITS TIME TO SCHEDULE A STREAM

	;CALL:	RDR/ The stream DB Address
	;
	;RET:	True if stream can be scheduled now (timewise)
	;	False if stream needs to wait

CHKTIM:	PUSHJ	P,I%NOW			;GET THE CURRENT TIME
	MOVE	S2,S1			;GET THE UDT IN S2
	MOVE	S1,.RDWKT(RDR)		;GET THE STREAM WAKEUP TIME
	SUB	S1,S2			;GET TIME LEFT IN JIFFIES
	IDIVI	S1,3			;GET NUMBER OF SECONDS
	SKIPG	S1			;Any seconds left?
	$RETT				;no time left -- return true
	SKIPE	SLEEPT			;IS A TIME SET ???
	CAMG	S1,SLEEPT		;CURRENT TIME LESS THE SET TIME ???
	MOVEM	S1,SLEEPT		;YES,,SAVE THE LOWER VALUE
	$RETF				;RETURN False
	SUBTTL OACCAN - Operator CANCEL request.

OACCAN:	TXZE	FLAG,JOBCD			;TELL READER WE ARE LEAVING.
	$ACK	(Current Job Aborted,,@JOBOBA(STREAM),.MSCOD(M))
	MOVE	S2,JOBPAG(STREAM)	;Get data base page address
	SETOM	.RDSTS(S2)		;Send status
	$RETT

	SUBTTL	OACPAU - Operator PAUSE Request

OACPAU:	MOVX	S2,PSF%ST		;GET THE STOPPED BITS
	IORM	S2,JOBSTW(STREAM)	;LITE THE STOPPED BITS.
	MOVE	S2,JOBPAG(STREAM)	;GET THE DATA BASE PAGE ADDRESS
	SETOM	.RDSTS(S2)		;SEND STATUS BACK TO QUASAR
	$ACK	(Stopped,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
	$RETT				;AND RETURN.


	SUBTTL	OACCON - Operator CONTINUE Request

OACCON:	MOVX	S2,PSF%ST		;GET THE STOPPED BITS.
	ANDCAM	S2,JOBSTW(STREAM)	;DE-LITE THE STOPPED BITS.
	MOVE	S2,JOBPAG(STREAM)	;GET THE DATA BASE PAGE ADDRESS
	SETOM	.RDSTS(S2)		;SEND STATUS BACK TO QUASAR
	$ACK	(Continued,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPR
	$RETT				;AND RETURN.


	SUBTTL	OACSHT - ROUTINE TO VALIDATE THE READER SHUTDOWN STATUS

OACSHT:	TXNN	FLAG,JOBCD		;ARE WE PROCESSING A JOB ???
	$RETT				;NO,,THEN SHUTDOWN IS OK.
	SETOM	.RDSHT(RDR)		;YES,,LITE DEFERED SHUTDOWN FLAG
	$RETF				;AND RETURN (NO SHUTDOWN)
SUBTTL	Operator Action Request/Response


; Operator Action Request
; Call:		S1/	address of table of legal responses
;		.RDMSG/	text to send to the operator
;
; TRUE return:	S1/	index into table
; FALSE return:	never, waits for a correct response
;
OACREQ:
	PUSHJ	P,.SAVE1		;Save P1
	MOVE	P1,S1			;Copy table address
	$CALL	I%NOW			;Get the date/time
	MOVEM	S1,JOBWAC(STREAM)	;Store as WTOR ACK code
	SETOM	.RDSTS(RDR)		;Say we want status update

OREQ.1:	$WTOR	(<Reader error>,<^T/.RDMSG(RDR)/>,@JOBOBA(STREAM),JOBWAC(STREAM))
	$DSCHD	(PSF%OR)		;Deschedule stream
	MOVE	S1,P1			;Point to response table
	HRROI	S2,.RDRSP(RDR)		;Point to operator response
	$CALL	S%TBLK			;Scan the table for a match
	TXNE	S2,TL%NOM		;Got one ?
	JRST	OREQ.1			;Nope - try again
	$RETT				;Return with table index in S1


; Operator Action Response
; Call:		M/	IPCF page address
;
; TRUE return:	.RDRSP(RDR) set up
; FALSE return:	never
;
OACRSP:	MOVE	S2,.MSCOD(M)		;Point to ACK code
	MOVSI	S1,-MAXRDR		;Make an AOBJN pointer
	CAME	S2,JOBWAC(S1)		;ACK codes match ?
	AOBJN	S1,.-1			;No - try another
	JUMPGE	S1,.RETT		;Flush junk messages
	MOVX	S2,PSF%OR		;Get operator response bit
	ANDCAM	S2,JOBSTW(S1)		;Clear it
	MOVE	RDR,JOBPAG(S1)		;Get stream relocation address
	MOVE	FLAG,.RDREG+FLAG(RDR)	;Set the flag AC so it can be used
	DMOVE	S1,.OHDRS+ARG.DA(M)	;Pick up operator response
	DMOVEM	S1,.RDRSP(RDR)		;Store in a safe place
	$RETT				;Return
	SUBTTL	RDINIT - ROUTINE TO INITIALIZE SOME READER CONSTANTS

RDINIT:	PUSHJ	P,I%HOST		;GET OUR SITE ID
	MOVEM	S1,CNTNAM		;SAVE NODE NAME
	MOVEM	S2,CNTSTA		;SAVE NODE NUMBER
	MOVX	S1,%LDQUE		;GET THE GETTAB PPN CODE
	GETTAB	S1,			;GET THE SPOOL PPN
	STOPCD	(CGS,HALT,,<Cannot get spool file PPN>)
	MOVEM	S1,SPOOL		;SAVE IT
	MOVSI	S1,.STSPL		;ISSUE 'SETUUO' TO
	SETUUO	S1,			;   CLEAR SPOOLING BITS
	  JFCL				;IGNORE THE ERROR
	$RETT				;RETURN
	SUBTTL 	DOJOB - ROUTINE TO PROCESS THE CARD READERS.

DOJOB:	HRLZ	S1,.RDOBZ(RDR)		;GET THE OUTPUT BYTE SIZE
	LSH	S1,6			;POSITION IT
	ADD	S1,[POINT 0,.CARDS(RDR)] ;MAKE THE BYTE POINTER
	MOVEM	S1,.RDOPT(RDR)		;AND SAVE IT.
	MOVE	S1,SPOOL		;GET THE SPOOL PPN
	MOVEM	S1,.RDFD+.FDPPN(RDR)	;SAVE IT
	MOVX	S1,FSSSTR		;GET THE SPOOL STRUCTURE NAME
	MOVEM	S1,.RDFD+.FDSTR(RDR)	;SAVE IT
	MOVEI	S1,FDSIZE		;GET THE FD SIZE
	STORE	S1,.RDFD+.FDLEN(RDR),FD.LEN ;SAVE IT
	MOVEI	S1,.RDFD(RDR)		;GET THE FD ADDRESS
	MOVEM	S1,.RDFOB+FOB.FD(RDR)	;SAVE IT
	MOVE	S1,.RDOBZ(RDR)		;GET THE BYTE SIZE
	STORE	S1,.RDFOB+FOB.CW(RDR),FB.BSZ ;SAVE IT
	MOVEI	S1,1			;GET A BIT
	STORE	S1,.RDFOB+FOB.CW(RDR),FB.NFO ;WANT 'NEW FILE ONLY'

CARDS:	PUSHJ	P,INCARD		;GET SOME CARDS
	JUMPF	CRDEOF			;NO MORE,,FINISH UP.
	PUSHJ	P,PRORDR		;GO PROCESS THE DATA CARDS.
	JRST	CARDS			;AND GET SOME MORE.

CRDEOF:	MOVE	S1,ENDIMG(AP)		;GET THE EOF CARD BITS
	IDPB	S1,.RDOPT(RDR)		;PUT IT IN THE BUFFER
	AOS	.RDNBR(RDR)		;Add the "EOF" card to the count
	TXO	FLAG,EOF		;TURN ON EOF INDICATOR
	PUSHJ	P,READER		;GO FINISH UP THIS FILE
	JRST	CARDS			;GO LOOK FOR MORE CARDS.
>;end of TOPS10
	SUBTTL DSCHD -- Deschedule process

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

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

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

; ASSUMPTIONS. . .

; 1.  STREAM is the correct stream number

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

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

; 4.  If not in stream context, push the routine FIXPDL on the stack
;     to restore the stream's stack to the overhead stack.

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

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

DSCHD:

TOPS10 <
;Save the AC's in any case

	MOVEM	0,.RDREG(RDR)		;Save AC0
	MOVEI	0,.RDREG+1(RDR)		;Place to put AC1
	HRLI	0,1			;Setup the BLT pointer
	BLT	0,.RDREG+17(RDR)	;Save the AC's

;Take care of the flags passed

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

	JUMPE	S2,DSCH.D		;No sleep time to worry about
	SKIPE	SLEEPT			;Is a time to sleep set?
	CAMG	S2,SLEEPT		;Current amount less than the set time?
	MOVEM	S2,SLEEPT		;Yes,, save the lower value
	$CALL	I%NOW			;Get the current time
	IMULI	S2,3			;Seconds to jiffies
	ADD	S1,S2			;Build wake-up time
	MOVEM	S1,.RDWKT(RDR)		;Save the wake-up time

;Check to see our current context

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

;Since we have to make a stream context, we must do the following:
;   1. Release any IPCF messages
;   2. Save PDL and AC17

	AOSN	IMESS			;Any IPCF messages?
	$CALL	C%REL			;Yes, release it

	PUSH	P,[EXP FIXPDL]		;Remember to restore overhead PDL
	MOVEI	S1,.RDPDL(RDR)		;Get stream's PDL location
	HRLI	S1,PDL			;Get beginning of PDL
	HRRZ	T1,P			;Get current PDL pointer
	SUBI	T1,PDL			;Find current length
	ADDI	T1,.RDPDL(RDR)		;Add stream's base
	HRR	P,T1			;Set new pointer
	BLT	S1,(T1)			;Save PDL
	MOVEM	P,.RDREG+P(RDR)		;Save new PDL pointer

	JRST	MAIN.3			;Return to restart main loop

DSCH.Z:	MOVE	P,[IOWD PDSIZE,PDL]	;Reset stack pointer
	JRST	MAIN.1			;Return to main loop
> ;End of TOPS10

TOPS20<
	PUSH	P,S1			;Save a reg.
	HRRZ	S1,-1(P)		;Get address of the flag word
	HRRZ	S1,@0(S1)		;Get the sleep time
	$CALL	I%SLP			;Sleep awhile
	POP	P,S1			;Restore the reg
	$RET
> ;End of TOPS20
	SUBTTL	FIXPDL -- Fix PDL routine

TOPS10<

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

FIXPDL:	MOVEI	S1,PDL			;Get overhead PDL
	HRLI	S1,.RDPDL(RDR)		;Get beginning of stream's PDL
	HRRZ	S2,P			;Get current pointer
	SUBI	S2,.RDPDL(RDR)		;Find the current length
	ADDI	S2,PDL			;Add the base of the PDL
	HRR	P,S2			;Set the new pointer
	BLT	S1,(S2)			;Restore PDL
	MOVE	S1,.RDREG+S1		;Restore S1
	MOVE	S2,.RDREG+S2		;Restore S2
	$RET				;Continue on
> ; End of TOPS10
	SUBTTL	PRORDR--READER INPUT PROCESSING
TOPS10 <
PRORDR:	SKIPLE	.RDREM(RDR)		;IS THIS A DN60 DEVICE ???
	$RETT				;YES,,NOTHING TO DO !!!!!!
	TXNE	FLAG,CD20		;IS THIS A CD20 LINE ???
	JRST	PROR.4			;YES,,DO IT DIFFERENTLY
	HLLZ	P1,.RDBPT(RDR)		;SAVE READERS BYTE SIZE.
	MOVEI	S1,1400			;GEN A 12 BIT BYTE SIZE.
	HRLM	S1,.RDBPT(RDR)		;CREATE A NEW BYTE POINTER.
	AOS	.RDBPT(RDR)		;POINT TO ACTUAL DATA.
PROR.1:	LDB	T1,.RDBPT(RDR)		;PICK UP A LOCAL BYTE.
	JUMPE	T1,PROR.2		;IF A BLANK,,SKIP THIS.
	LDB	S1,[POINT 7,T1,33]	;GET CDR COLS 1-7.
	LSH	S1,35			;LEFT JUSTIFY THOSE BITS.
	JFFO	S1,.+2			;GET # OF LEADING 0 BITS.
	JRST	PROR.2			;NOTHING THERE,,SO SKIP THIS
	ADDI	S2,1			;ADD 1 TO 0 BIT COUNT.
	LSH	S1,1(S2)		;SHIFT THEM OUT + 1.
	SKIPE	S1			;IF S1=0, THEN NO READER ERROR.
	ADDI	S2,10			;ELSE TURN ON ERROR BIT.
	LSH	S2,^D12			;SHIFT TO CORRECT BIT POSITION.
	ADD	T1,S2			;MERGE INTO CORRECTED WORD.
PROR.2:	IDPB	T1,.RDOPT(RDR)		;AND SAVE THE RESULTING 18 BIT BYTE.
	AOS	.RDBPT(RDR)		;    ADD 1 TO INPUT ADDRESS.
	SOSLE	.RDBCT(RDR)		;SUBTRACT 1 FROM BYTE COUNT
	JRST	PROR.1			;AND GO PROCESS THE NEXT BYTE.
	HLLM	P1,.RDBPT(RDR)		;RESTORE ORIGIONAL BYTE SIZE.
PROR.3:	AOS	S1,.RDNBR(RDR)		;BUMP THE NUMBER OF CARDS BY 1
	CAIL	S1,CRDNBR		;HAVE WE TRANSLATED ENOUGH YET ???
	PUSHJ	P,READER		;YES,,GO PROCESS THEM
	POPJ	P,			;RETURN TO MAIN PROGRAM

PROR.4:	MOVE	T1,.RDRCL(RDR)		;GET THE BYTE COUNT
	HRRZ	T2,.RDBPT(RDR)		;GET THE INPUT BUFFER ADDRESS
	ADD	T2,[POINT 16,1]		;CREATE THE BYTE POINTER
PROR.5:	ILDB	S1,T2			;GET AN INPUT BYTE
	IDPB	S1,.RDOPT(RDR)		;PUT IT OUT
	SOJG	T1,PROR.5		;MORE??,,KEEP PROCESSING
	JRST	PROR.3			;GO FINISH UP

	SUBTTL	INCARD - ROUTINE TO READ CARDS FROM THE CARD READER.

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

INCARD:	SKIPLE	.RDREM(RDR)		;IS THIS A DN60 DEVICE ???
	JRST	$IN60			;YES,,GO GET SOME CARDS

	MOVX	S2,PSF%ID		;GET THE 'INPUT BLOCKED' BIT
	IORM	S2,JOBSTW(STREAM)	;WAIT FOR INPUT DONE INTERRUPT
	MOVE	S1,.RDCHN(RDR)		;GET THE READERS CHANNEL.
	TLO	S1,(IN 0,0)		;CREATE AN INPUT UUO.
	XCT	S1			;READ SOME DATA CARDS.
	JRST	[ANDCAM S2,JOBSTW(STREAM) ;CLEAR THE INPUT BLOCKED BIT
		 $RETT  ]		;AND RETURN

INERR:	MOVE	S1,.RDCHN(RDR)		;GET THE CHANNEL NUMBER.
	IOR	S1,[GETSTS .RDSTA(RDR)]	;CREATE A GETSTS UUO.
	XCT	S1			;GET THE DEVICE STSTUS.
	MOVE	S1,.RDSTA(RDR)		;LOAD IT HERE ALSO.
	TXNE	S1,IO.ERR+IO.EOF	;WAS THERE AN ERROR OR EOF?
	JRST	INER.1			;YES,,GO PROCESS IT.
	$DSCHD(0)			;BLOCK FOR INPUT DONE. (See Above)
	JRST	INCARD			;AND GO TRY AGAIN

INER.1:	MOVE	S2,S1			;Copy the error bits to update status
	TRZ	S2,IO.ERR+IO.EOF	;Bits to clear
	HRLI	S2,(SETSTS 0,0)		;Create SETSTS UUO
	ADD	S2,.RDCHN(RDR)		;Add the channel number
	XCT	S2			;Clear the error bits in status word

	TXNE	S1,IO.EOF		;WAS THE ERROR EOF ???
	JRST	[HRLI	S2,(CLOSE 0,0)	;Need to close
		ADD	S2,.RDCHN(RDR)	;Add the channel number
		XCT	S2		;Close to clear the eof
		$RETF ]			;Return telling about EOF
	TXNN	S1,IO.DER		;DATA MISSED ERROR ?
	JRST	INCARD			;NOPE - Just go try again
	$TEXT	(<-1,,.RDMSG(RDR)>,<^T/DMETXT/^0>)
	MOVX	S2,PSF%ID		;Want to turn off the input blocked bit
	ANDCAM	S2,JOBSTW(STREAM)	;  so the job can be scheduled after
					;  the operator response.
	MOVEI	S1,DMETAB		;POINT TO OPERATOR RESPONSE TABLE
	PUSHJ	P,OACREQ		;REQUEST OPERATOR ACTION
	JRST	INCARD			;RETRY THE READ.


DMETXT:	ASCIZ	|Data missed error. Put last card in hopper and
Type 'RESPOND <number> PROCEED' to continue reading cards|

DMETAB:	$STAB
	 KEYTAB	(0,PROCEED)
	$ETAB
	SUBTTL	INPGET  --  OPEN the input device

INPGET:	SKIPLE	.RDREM(RDR)		;IS THIS A DN60 DEVICE ???
	JRST	[PUSHJ P,$OPEN		;YES,,GO OPEN IT UP
		 JUMPT OUTSOK 		;WIN,,RETURN
		 MOVX	S1,%RSUNA	;Not available right now
		 $RETF ]		;Already sent error message in OPEN.6
	SETOM	.RDCHN(RDR)		;INDICATE NO OUTPUT CHANNEL YET.
	PUSHJ	P,GENDEV		;CREATE THE PHYSICAL DEVICE NAME.
	MOVEM	S1,.RDDEV(RDR)		;AND SAVE IT
	MOVX	T1,UU.AIO+UU.SOE+IO.SIM+IO.SYN+.IOIMG	;GET OPEN FLAG BITS.
	MOVE	T2,.RDDEV(RDR)		;OUTPUT DEVICE NAME
	MOVEI	T3,.RDIOB(RDR)		;BUFFER HEADER
	MOVE	S1,STREAM		;USE OUR STREAM NUMBER AS THE CHANNEL #
	LSH	S1,^D23			;SHIFT IT TO ITS PROPER POSITION.
	IOR	S1,[OPEN T1]		;MAKE IT AN INSTRUCTION
	XCT	S1			;AND EXECUTE IT
	   JRST	OUTDNA			;LOSE GIVE ERROR

	MOVE	S2,STREAM		;AND STREAM NUMBER
	LSH	S2,^D23			;CONVERT TO A CHANNEL NUMBER
	MOVEM	S2,.RDCHN(RDR)		;SAVE IT FOR LATER
	SETZM	JOBSTW(STREAM)		;CLEAR THE STREAM STATUS BITS.
	MOVEI	T1,.DFHCW		;GET READER HARDWARD CHARACTERISTICS
	MOVE	T2,.RDDEV(RDR)		;FOR THIS READER
	MOVE	S1,[2,,T1]		;SET UP DEVOP. PARAMETER LIST
	DEVOP.	S1,			;GET CHARACTERISTICS...
	STOPCD	(CGC,HALT,,<Cannot get reader hardware characteristics>)
	LOAD	S2,S1,DF.CLS		;GET THE LINE TYPE 
	CAXN	S2,.DFS20		;IS IT A CD20 LINE ???
	TXO	FLAG,CD20		;YES,,SET IT.
	MOVE	S1,.RDBFR(RDR)		;GET THE READERS BUFFER ADDRESS.
	EXCH	S1,.JBFF		;MAKE IT OUT END ADDRESS.
	MOVE	S2,.RDCHN(RDR)		;GET THE CHANNEL NUMBER
	IOR	S2,[INBUF CRDNBR]	;MAKE AN INSTRUCTION
	XCT	S2			;AND CREATE 'CRDNBR' BUFFERS
	MOVEM	S1,.JBFF		;RESTORE JOBFF
	JRST	OUTSOK			;AND CONTINUE ON

GENDEV:	MOVE	T1,JOBOBA(STREAM)	;PICK UP OBJECT BLOCK ADDRESS.
	SKIPE	S1,CNTSTA		;ANF SUPPORTED?
	MOVE	S1,OBJ.ND(T1)		;PICK UP THE NODE NUMBER.
	IDIVI	S1,10			;SPLIT IT IN HALF.
	IMULI	S1,100			;SHIFT LEFT 2 DIGITS.
	ADD	S1,S2			;ADD SECOND NODE DIGIT.
	IMULI	S1,100			;SHIFT LEFT ANOTHER 2 DIGITS.
	ADD	S1,OBJ.UN(T1)		;ADD THE UNIT NUMBER.
	ADD	S1,[SIXBIT/CDR000/]	;CREATE THE PHYSICAL DEVICE NAME.
	POPJ	P,			;RETURN. . . . .
	SUBTTL	GENFIL - ROUTINE TO GENERATE THE SPOOL FILENAME

GENFIL:	PUSH	P,T1			;SAVE T1
	MOVE	S1,[POINT 6,.RDFD+.FDNAM(RDR)] ;BYTE PTR FOR FILENAME
	MOVEM	S1,BYTPTR		;SAVE IT.
	$TEXT	(CV26BT,<RD^D4L0/FILENM,FILEMK/>) ;CREATE THE SPOOL FILE NAME
	AOS	FILENM			;CREATE ANOTHER
	SETZM	.RDFD+.FDEXT(RDR)	;ZERO THE FILENAME EXT.
	MOVE	S1,FILEXT		;GET THE EXTENSION NUMBER
	IDIVI	S1,100			;GET THE THIRD DIGIT
	ADDI	S1,20			;MAKE IT SIXBIT.
	LSH	S1,6			;SHIFT IT OVER
	IDIVI	S2,10			;GET SECOND AND FIRST DIGITS
	ADDI	S2,20			;MAKE IT SIXBIT
	ADDI	T1,20			;HERE ALSO
	ADD	S1,S2			;PUT INTO S1
	LSH	S1,6			;SHIFT IT OVER
	ADD	S1,T1			;ADD FIRST DIGIT
	HRLZM	S1,.RDFD+.FDEXT(RDR)	;SAVE IT AS FILE EXT
	POP	P,T1			;RETSORE T1
	$RETT				;AND RETURN


CV26BT:	SUBI	S1,40			;CONVERT TO SIXBIT
	ANDI	S1,77			;JUST USE LAST 2 DIGITS
	IDPB	S1,BYTPTR		;SAVE THE BYTE
	$RETT				;AND RETURN


OUTSOK:	PUSHJ	P,INTCNL		;CONNECT UP THE READER
	TXO	FLAG,INTRPT		;TURN ON CONNECTED FLAG
	$WTO	(Started,,@JOBOBA(STREAM)) ;TELL OPERATOR WE'RE STARTED
	MOVX	S1,%RSUOK		;LOAD THE CODE
	$RETT				;AND RETURN

OUTDNA:	$WTO	(Not available right now,,@JOBOBA(STREAM)) ;TELL THE OPERATOR
	MOVX	S1,%RSUNA		;NOT AVAILABLE RIGHT NOW
	$RETF				;AND RETURN

	SUBTTL	INPREL - ROUTINE TO RELEASE A CARD READER

INPREL:	TXZE	FLAG,INTRPT		;ARE WE CONNECT TO THE INTRPT SYSTEM ??
	PUSHJ	P,INTDCL		;REMOVE THE READER FROM THE INTRPT SYS
	SKIPLE	.RDREM(RDR)		;IS THIS A DN60 DEVICE ???
	JRST	$CLOSE			;YES,,CLOSE IT DOWN
	SKIPGE	S1,.RDCHN(RDR)		;DID WE INIT A CHANNEL ???
	$RETT				;NO,,JUST RETURN
	LSH    S1,-^D23			;GET THE CHANNEL NUMBER
	RESDV. S1,			;RESET THE CHANNEL
	POPJ   P,			;IGNORE ERRORS
	POPJ   P,			;RETURN IF NORMAL
SUBTTL	Interrupt Module

;		INTINI		INITIALIZE INTERRUPT SYSTEM
;		INTCNL		CONNECT THE CARD READER
;		INTDCL		DISCONNECT THE CARD READER
;		INTIPC		INTERRUPT ROUTINE  --  IPCF


;INTERRUPT SYSTEM DATABASE


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

DEFINE CDINHD(Z),<
	XLIST
	$BGINT	1,
	MOVEI	S1,Z
	MOVEI	S2,VECDEV+<4*Z>
	JRST	CDINTR
	CDHDSZ==4
	LIST
>  ;END DEFINE CDINHD

INTINI:	MOVEI	S1,INTIPC		;GET ADDRESS OF IPCF INT RTN
	MOVEM	S1,VECIPC+.PSVNP	;SAVE IN VECTOR
	Z==0
REPEAT	MAXRDR,<XLIST
	MOVEI	S1,INTDEV+<CDHDSZ*Z>	;GET ADDRESS OF RDR HEADER
	MOVEM	S1,VECDEV+<4*Z>+.PSVNP	;STORE IN THE VECTOR
	Z==Z+1
	LIST
>  ;END REPEAT MAXRDR
	POPJ	P,			;AND RETURN


INTDCL:	SKIPA	S1,[PS.FRC+T1]		;REMOVE CONDITION USINGS ARGS IN T1
INTCNL:	MOVX	S1,PS.FAC+T1		;ADD CONDITION USING ARGS IN T1
	SKIPLE	.RDREM(RDR)		;IS THIS A DN60 DEVICE ???
	$RETT				;YES,,NO INTERRUPTS !!!
	MOVE	T1,.RDCHN(RDR)		;USE CHANNEL AS CONDTION
	LSH	T1,-^D23		;MAKE IT RIGHT !!!
	MOVE	T2,STREAM		;GET STREAM NUMBER
	IMULI	T2,4			;GET BLOCK OFFSET
	ADDI	T2,VECDEV-VECTOR	;GET OFFSET FROM BEGINNING
	HRLZS	T2			;GET OFFSET,,0
	HRRI	T2,PS.RID+PS.RDO+PS.ROL	;AND CONDITIONS
	SETZ	T3,			;ZERO T3
	PISYS.	S1,			;TO THE INTERRUPT SYSTEM
	STOPCD	(CAD,HALT,,<Cannot add/delete reader to/from interrupt system>)
	POPJ	P,			;AND RETURN

;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, CDINTR.  Note that on the -10, while
;	it is assumed that 'input 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.
;	The previous assumption is incorrect.  A node gone away message
;	can occur at any time but continue since CDRIVE will
;	get a shutdown message from QUASAR for that reader

INTDEV:	Z==0
	REPEAT MAXRDR,<
	CDINHD(Z)
	Z==Z+1 	      >

CDINTR:	MOVE	RDR,JOBPAG(S1)		;GET THE JOB PARAMETER PAGE
	HRRZ	T1,.PSVFL(S2)		;GET I/O REASON FLAGS
	ANDCAM	T1,.PSVFL(S2)		;AND CLEAR THEM
	TXNE	T1,PS.ROL		;Is it online?
	JRST	[SETOM	.RDSTS(RDR)	;Yes, want status update
		MOVX	T2,PSF%DO+PSF%ID ;Clear offline and input done
		SETZM	.RDOFL(RDR)	;Say we are online
		JRST	CDIN.0]		;Continue on
	SETZ	T2,			;CLEAR AN AC
	TXNE	T1,PS.RID		;IS IT INPUT DONE?
	TXO	T2,PSF%ID		;YES, GET SCHEDULER BIT
CDIN.0:	ANDCAM	T2,JOBSTW(S1)		;CLEAR THE SCHEDULER FLAGS
	TXNE	T1,PS.RDO		;IS IT DEVICE OFF-LINE?
	TXNE	T1,PS.ROL		;Yes, IF BOTH OFFLINE AND ONLINE,
	$DEBRK				;DISMISS THE INTERRUPT.
	MOVX	T2,PSF%DO		;GET OFF-LINE BIT.
	SKIPN	.RDREM(RDR)		;Is this a remote reader?
	JRST	CDIN.1			;No, skip this
	MOVE	T1,.PSVIS(S2)		;Get the file attributes
	TXC	T1,IO.ERR		;If all error bits are lit, we have
	TXNN	T1,IO.ERR		;node offline message -- DO WE?
	JRST	[IORM	T2,JOBSTW(S1)	;Yes, set the bit and not sched again
		SETOM	.RDSTS(RDR)	; might not be in stream context
		$DEBRK]			; and want to wait for shutdown
	SKIPA				;Don't set blocking offline...
					;Do it in INPOFF
CDIN.1:	IORM	T2,JOBSTW(S1)		;Set the offline bit for local
	MOVEI	T1,INPOFF		;LOAD RESTART ADDRESS
	EXCH	T1,.PSVOP(S2)		;STORE FOR DEBRK AND GET OLD ADRESS
	MOVEM	T1,.RDIOA(RDR)		;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
INTDON:	$DEBRK				;DISMISS THE INTERRUPT.

INPOFF:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	SKIPE	.RDOFL(RDR)		;Were we previously offline?
	JRST	INPO.2			;Yes, skip this and go to sleep
	SETOM	.RDSTS(RDR)		;Want status update
	SKIPE	.RDNBR(RDR)		;ANYTHING IN THE BUFFERS ???
	PUSHJ	P,READER		;GO PROCESS THE BUFFERS
	TXNE	FLAG,JOBCD		;ARE WE PROCESSING A JOB ???
	$WTO	(Offline,,@JOBOBA(STREAM)) ;TELL THE OPERATOR RDR IS OFFLINE.
	SKIPE	.RDREM(RDR)		;Is this a remote?
	JRST	[SETOM	.RDOFL(RDR)	;Yes, set it offline not to block
		JRST	INPO.2]		;Go sleep but not forever
	$DSCHD(0)			;WAIT FOR ONLINE INTERRUPT.
INPO.1:	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	JRST	@.RDIOA(RDR)		;CONTINUE PROCESSING.
INPO.2:	$DSCHD	(LGSLPT)		;Sleep for awhile
	JRST	INPO.1			;Go and try again
	SUBTTL	INTIPC - IPCF INTERRUPT PROCESSING ROUTINE


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

>  ;END OF TOPS-10 CONDITIONAL CODE


	SUBTTL	CHKQUE - ROUTINE TO CHECK FOR INCOMING MESSAGES.

CHKQUE:	PUSHJ	P,C%RECV		;RECEIVE A MESSAGE
	JUMPF	.POPJ			;RETURN,,NOTHING THERE.
	SETOM	IMESS			;Have a message
	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, flush it
	LOAD	S1,MDB.MS(S1),MD.ADR	;GET THE MESSAGE ADDRESS
	MOVEM	S1,RDSCHD		;SAVE IT AWAY
	MOVE	M,S1			;SAVE THE MESSAGE ADDRESS HERE TOO
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	MOVSI	S1,-NMSGT		;MAKE AOBJN POINTER FOR MSG TYPES

CHKQ.3:	HRRZ	T1,MSGTAB(S1)		;GET A MESSAGE TYPE
	CAMN	S2,T1			;MATCH?
	JRST	CHKQ.4			;YES, WIN
	AOBJN	S1,CHKQ.3		;NO, LOOP
	JRST	CHKQ.5			;NO,, go release the message

CHKQ.4:	HLRZ	T2,MSGTAB(S1)		;PICK UP THE PROCESSING ROUTINE ADDRESS.
	MOVEM	T2,RUTINE		;SAVE THE ROUTINE ADDRESS.
	SETZM	NOSAVE			;RESET THE FLAG SAVE FLAG WORD.
	PUSHJ	P,CHKOBJ		;GO FIND THE OBJECT BLOCK.
	JUMPF	CHKQ.5			;INVALID OBJECT,,FLUSH THE MESSAGE
	PUSHJ	P,@RUTINE		;DISPATCH THE MESSAGE PROCESSOR.
	SKIPN	NOSAVE			;DO WE WANT TO SAVE THE FLAGS ???
	MOVEM	FLAG,.RDREG+FLAG(RDR)	;YES,,SAVE THE STATUS BITS.
	SKIPN	RDSCHD			;Do we remember the message address?
	SETOM	RDSCHD			;No, force the scheduler anyway

CHKQ.5:	AOSN	IMESS			;Any IPCF messages?
	$CALL	C%REL			;Yes, release the message
	JRST	CHKQUE			;Go see if any more

MSGTAB:	XWD	.RETT,.QORCK		;REQUEST-FOR-CHECKPOINT
	XWD	SETUP,.QOSUP		;SETUP/SHUTDOWN
	XWD	OACCON,.OMCON		;OPERATOR CONTINUE REQUEST.
	XWD	OACCAN,.OMCAN		;OPERATOR CANCEL REQUEST.
	XWD	OACPAU,.OMPAU		;OPERATOR PAUSE/STOP REQUEST.
TOPS10< XWD	OACRSP,.OMRSP>		;OPERATOR WTOR RESPONSE.
	XWD	QSRNWA,.QONWA		;NODE-WENT-AWAY PROCESSOR

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


CHKOBJ:	CAIE	T1,.OMRSP		;IS THIS AN OPR RESPONSE MESSAGE ???
	CAIN	T1,.QOSUP		; OR IS THIS A SETUP/SHUTDOWN MESSAGE ??
	$RETT				;YES,,RETURN.
	CAXN	T1,.QORCK		;IS THIS A REQUEST FOR CHECKPOINT ???
	$RETF				;YES,,IGNORE IT

	LOAD	S2,.OHDRS+ARG.HD(M),AR.TYP  ;PICK UP THE MSG BLK TYPE.
	CAIE	S2,.OROBJ		;IS IT THE OBJ BLK ???
	STOPCD	(NFB,HALT,,<First block in message not the object block>)
	MOVEI	S1,.OHDRS+ARG.DA(M)	;POINT TO THE OBJECT BLOCK.
	PJRST	FNDOBJ			;RETURN THROUGH 'FNDOBJ'

	SUBTTL	SETUP/SHUTDOWN Message

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

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

SETU.2:	MOVEM	T2,STREAM		;SAVE THE STREAM NUMBER

;Get some pages for stream data base
	MOVEI	S1,DBSIZE		;NUMBER OF PAGES NEEDED
	PUSHJ	P,M%AQNP		;GET THEM
	PG2ADR	S1			;CONVERT TO AN ADDRESS
	MOVEM	S1,JOBPAG(T2)		;AND SAVE IT
	MOVE	RDR,S1			;PUT IT IN RDR

;Set some locations in the stream data base
	SETZM	FLAG			;CLEAR THE READER FLAG WORD
	MOVEM	T2,.RDSTR(RDR)		;SAVE THE STREAM NUMBER
	MOVEI	S1,BUFBEG(RDR)		;RDR BUFFER ADDRESS or END ADDRESS
	MOVEM	S1,.RDBFR(RDR)		;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
	HRL	S2,M			;GET THE SETUP MESSAGE ADDRESS
	HRRI	S2,.RDSUP(RDR)		;WHERE WE WANT IT PUT
	BLT	S2,.RDSUP+SUP.SZ-1(RDR)	;SAVE THE SETUP MESSAGE IN THE DATA BASE

	SETZM	.RDREM(RDR)		;ASSUME THAT IT IS LOCAL OR DN200
	MOVEI	AP,LOC200		;SINCE LOCAL,,GET LOCAL/DN200 BYTE TABLE
	MOVX	S1,IBYTSZ		;SINCE LOCAL,,GET INPUT BYTE SIZE
	MOVEM	S1,.RDIBZ(RDR)		;   AND SAVE IT FOR LATER
	MOVX	S1,OBYTSZ		;SINCE LOCAL,,GET OUTPT BYTE SIZE
	MOVEM	S1,.RDOBZ(RDR)		;   AND SAVE IT FOR LATER
	MOVX	S1,LOCRCL		;GET LOCAL/DN200 RECORD LENGTH
	MOVEM	S1,.RDRCL(RDR)		;   AND SAVE IT FOR LATER
	MOVE	S1,SUP.NO(M)		;GET THIS GUYS NODE NAME
	CAME	S1,CNTNAM		;IS IT REALLY LOCAL ???
	CAMN	S1,CNTSTA
	JRST	SETU.3			;YES,,SKIP THIS REMOTE STUFF

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

	SKIPN	SUP.CN(M)		;IS THIS A DN60 REMOTE ???
	JRST	[SETOM  .RDREM(RDR)	;NO,,MUST BE DN200 - SET DN200 FLAG
		 JRST	SETU.3    ]	;AND CONTINUE PROCESSING

	MOVEI	S1,1			;GET A 1 (DN60 FLAG)
	MOVEM	S1,.RDREM(RDR)		;MAKE THIS A DN60 REMOTE
	MOVE	S1,SUP.ST(M)		;GET THE DN60 FLAG WORD
	MOVEM	S1,.RDFLG(RDR)		;SAVE IT FOR LATER
	MOVEI	AP,CHAR60		;GET DN60 BYTE TRANSLATION TABLE
	MOVX	S1,IBYT60		;GET DN60 INPUT BYTE SIZE
	MOVEM	S1,.RDIBZ(RDR)		;AND SAVE IT
	MOVX	S1,OBYT60		;GET DN60 OUTPUT BYTE SIZE
	MOVEM	S1,.RDOBZ(RDR)		;AND SAVE IT
	MOVX	S1,D60RCL		;GET DN60 RECORD LENGTH
	MOVEM	S1,.RDRCL(RDR)		;AND SAVE IT

SETU.3:	MOVEM	AP,.RDREG+AP(RDR)	;SAVE AP FOR PROCESSING
TOPS20<	$CALL SETACS			;Now is the time for TOPS20 >
	PUSHJ	P,INPGET		;GET THE INPUT DEVICE.
	AOS	SSETUP			;ASSUME WE GOT IT
	CAIE	S1,%RSUOK		;ALL IS OK?
	JRST	[$CALL	SHUTUP		;Just do a quick shutdown
		JRST	SETU.5]		;go to end
TOPS10<
IFN FTDN60,<
	SKIPLE	.RDREM(RDR)		;DN60?
	$CALL	FIXPRO			;Yes, fix the data base
> ;End of FTDN60
	PUSHJ	P,RSETUP		;SEND THE RESPONSE TO SETUP MSG.

IFN FTDN60,<
	SKIPLE	.RDREM(RDR)		;DN60?
	$CALL	FIXPRO			;Yes, fix the data base back
> ;End of FTDN60

	$CALL	SETACS			;Now is the time for TOPS10
> ; End of TOPS10

SETU.5:	$RETT				;RETURN 

;Set up the stream's data base with the PDL and AC's
;  Must be done after INPGET for TOPS10 since a DSCHED can clobber the AC's
;  Must be done before INPGET for TOPS20 since the ACs are needed in inferior

SETACS:	MOVEI	S1,.RDPDL-1(RDR)	;SET UP THE STREAM CONTEXT
	HRLI	S1,-PDSIZE		;STACK POINTER.
	PUSH	S1,[EXP DOJOB]		;LETS START AT THE RIGHT SPOT.
	MOVEM	S1,.RDREG+P(RDR)	;SAVE THE STREAM STACK POINTER.
	MOVEM	RDR,.RDREG+RDR(RDR)	;SAVE RDR AWAY
	MOVEM	STREAM,.RDREG+STREAM(RDR) ;Save the stream  also
	$RET
	SUBTTL	QSRNWA - ROUTINE TO PROCESS NODE-WENT-AWAY MESSAGES


QSRNWA:	MOVX	S1,%RSUNA		;GET NOT AVAILABLE RIGHT NOW STATUS
	$CALL	SHUTUP			;Go shutdown the stream
	$RETT				;RETURN


IFN FTDN60,<
	SUBTTL	FIXPRO - Routine to fix proto node data base

;  The purpose of this routine is exchange the prototype name with the
;actual name in the reader data base for DN60 card readers.  This
;should happen twice, once before sending response to setup
;and once after sending the response to setup.  This is because QUASAR
;needs to know the prototype name since we are only now telling it the
;actual name with the message.  But we only want it changed at the
;response message because all other messages should have the correct name.
;It is a routine because T10 and T20 send the response to setup
;message at different times.

;Assumes that STREAM is correct.  Uses S1 and S2 and restores them

;Returns without setting TF

FIXPRO:	$SAVE	<S1,S2>
	MOVE	S1,JOBOBA(STREAM)	;Get object block address
	MOVE	S2,OBJ.ND(S1)		;Get prototype node name
	EXCH	S2,.RDPNN(RDR)		;Save it, Get node name
	MOVEM	S2,OBJ.ND(S1)		;Save it
	$RET				;Always return
> ; End of FTDN60
	SUBTTL	SHUTDN - ROUTINE TO SHUT DOWN A LINE-PRINTER


SHUTDN:	MOVEI	S1,SUP.TY(M)		;GET THE OBJECT BLOCK ADDRESS
	PUSHJ	P,FNDOBJ		;GO FIND IT
	JUMPF	.RETF			;NOT THERE,,RETURN
	PUSHJ	P,OACSHT		;GO SEE IF ITS OK TO SHUT IT DOWN
	JUMPF	.RETT			;NO,,RETURN NOW
	MOVX	S1,%RSUDE		;Get 'Does not exist'
SHUTUP:	TDZA	P1,P1			;SET CDRIVE CONTEXT INDICATOR
SHUTIT:	SETOM	P1			;SET STREAM CONTEXT INDICATOR
	PUSH	P,S1			;Save arg. for telling quasar
	$CALL	INPREL			;GO RELEASE THE READER
	POP	P,S1			;Restore arg. for telling quasar
	$CALL	RSETUP			;Tell QUASAR
	MOVE	S2,RDR			;GET THE JOBPAG ADDRESS
	ADR2PG	S2			;CONVERT TO A PAGE NUMBER
	MOVX	S1,DBSIZE		;LOAD THE NUMBER OF PAGES
TOPS10<	SKIPE	P1			;STREAM CONTEXT ???
	MOVE	P,[IOWD PDSIZE,PDL]	;YES,,RESET THE STACK POINTER.
> ; End of TOPS10
	PUSHJ	P,M%RLNP		;RETURN THEM
	PUSHJ	P,M%CLNC		;GET RID OF UNWANTED PAGES.
	SETZM	JOBPAG(STREAM)		;CLEAR THE PAGE WORD
	SETOM	NOSAVE			;WE DONT WANT STREAM FLAG BITS SAVED.
TOPS10	<
	SOS	S1,SSETUP		;YES, ANY STREAMS LEFT?
	SKIPL	OPTYPE			;%STCMD PROCESSOR?
	SKIPE	DEBUGW			;DEBUGGING?
	TRNA				;NOT %STCMD OR WE'RE DEBUGGING
	JUMPLE	S1,SHTBYE		;GO SAY GOODBYE IF NO MORE STREAMS
	JUMPN	P1,MAIN.3		;STREAM CONTEXT,,RETURN TO SCHEDULER
> ;End of TOPS10
	$RETT				;ELSE RETURN


	SUBTTL	RSETUP - ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR

RSETUP:	MOVE	T2,S1			;SAVE THE SETUP CONDITION CODE.
	MOVEI	S1,RSU.SZ		;GET MESSAGE LENGTH
	MOVEI	S2,MSGBLK		;AND THE ADDRESS OF THE BLOCK
	PUSHJ	P,.ZCHNK		;ZERO IT OUT
	MOVEI	T1,MSGBLK		;GET THE BLOCK ADDRESS
	MOVX	S1,RSU.SZ		;GET MESSAGE SIZE
	STORE	S1,.MSTYP(T1),MS.CNT	;STORE IT
	MOVX	S1,.QORSU		;GET FUNCTION CODE
	STORE	S1,.MSTYP(T1),MS.TYP	;STORE IT
	MOVS	S1,JOBOBA(STREAM)	;GET OBJADR,,0
	HRRI	S1,RSU.TY(T1)		;AND PLACE TO MOVE IT TO
	BLT	S1,RSU.TY+OBJ.SZ-1(T1)	;AND MOVE THE OBJECT BLOCK
	STORE	T2,RSU.CO(T1)		;STORE TH CODE
	MOVE	S1,JOBPAG(STREAM)	;Get the page
	MOVE	S1,.RDPNN(S1)		;Get the prototype node name (if one)
	MOVEM	S1,RSU.PN(T1)		;Save it in the response message
	MOVE	S1,T1			;GET THE MESSAGE ADDRESS.
	MOVEI	S2,RSU.SZ		;GET THE MESSAGE LENGTH.
	PUSHJ	P,SNDQSR		;AND SEND THE MESSAGE
	$RETT				;RETURN.

SUBTTL	SHTBYE - SAY GOODBYE AND LOGOUT WHEN ALL STREAMS SHUTDOWN

;Say GODDBYE to QUASAR and call I%KJOB to log us out

SHTBYE:	MOVEI	S1,HELLO		;GET ADDRESS OF HELLO MESSAGE.
	MOVX	TF,HEFBYE		;GET GOODBYE FLAG
	IORM	TF,HEL.FL(S1)		;LITE IN MSG
	MOVEI	S2,HEL.SZ		;GET LENGTH OF HELLO IN S2
	PUSHJ	P,SNDQSR		;SAY GOODBYE TO QUASAR.
	$WTO	(<CDRIVE logging out>,<All streams have been shutdown>,,<$WTFLG(WT.SJI)>)
	$CALL	I%KJOB			;LOG US OUT
	STOPCD	(CNL,HALT,,<Could not logout. Call to I%KJOB failed>)

	SUBTTL FNDOBJ - ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE.

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

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

FNDO.3:	MOVEM	T4,STREAM		;SAVE STREAM NUMBER
	SKIPN	RDR,JOBPAG(T4)		;GET ADDRESS OF DATA
	$RETF				;FOUND,,BUT NOT REALLY THERE,,TOO BAD
	MOVE	FLAG,.RDREG+FLAG(RDR)	;GET HIS 'FLAGS'
	$RETT				;AND RETURN

	SUBTTL	UPDTST - ROUTINE TO SEND READER STATUS INFORMATION TO QUASAR

	;CALL:	PUSHJ P,UPDTST
	;
	;RETURN: ALWAYS TRUE +1

UPDTST:	MOVEI	S1,MSGBLK		;GET THE SOON TO BE MSG BLOCK ADDRESS
	MOVE	S2,JOBPAG(STREAM)	;GET THE DATA BASE PAGE ADDRESS
	SETZM	.RDSTS(S2)		;CLEAR STATUS MSG FLAG WORD
	HRLZ	S2,JOBOBA(STREAM)	;GET THE STREAM'S OBJ BLOCK ADDRESS
	HRRI	S2,STU.RB(S1)		;GET THE DESTINATION ADDRESS
	BLT	S2,STU.RB+OBJ.SZ-1(S1)	;COPY THE OBJ BLK OVER
	SETZM	.MSCOD(S1)		;NO ACK CODE
	SETZM	.MSFLG(S1)		;NO FLAG BITS
	$CALL	GSTS			;Get the status
	MOVEI	S1,MSGBLK		;Get the message block address again
	STORE	S2,STU.CD(S1)		;SAVE THE STATUS CODE
	MOVX	S2,.QOSTU		;GET THE MESSAGE TYPE
	STORE	S2,.MSTYP(S1),MS.TYP	;SAVE IT IN THE MSG
	MOVX	S2,STU.SZ		;GET THE MSG LENGTH
	STORE	S2,.MSTYP(S1),MS.CNT	;SAVE IT IN THE MSG
	PJRST	SNDQSR			;SEND IT OFF TO QUASAR


	SUBTTL	GSTS - Routine to get the status of a stream

	;This is a routine since the status must be obtained either
	;by the superior fork (always for T10) or by the inferior fork
	;for sending the status message.
	;CALL:	RDR contains the address of stream

	;Returns: S2 / Status

GSTS:	MOVX	S2,%IDLE		;Default to idle
	MOVE	S1,FLAG+.RDREG(RDR)	;Get the flag word for the
					;stream
	TXNN	S1,JOBCD		;In a job?
	JRST	[MOVE	S1,JOBSTW	;No, offline doesn't matter
		JRST	GSTS.1]		;Skip offline checks
	MOVX	S2,%READN		;Yes in a job, we should be reading
	SKIPE	.RDOFL(RDR)		;Are we offline?
	MOVX	S2,%OFLNE		;Yes.
	MOVE	S1,JOBSTW(STREAM)	;GET THE JOB STATUS BITS
	TXNE	S1,PSF%DO		;ARE WE OFFLINE ???
	MOVX	S2,%OFLNE		;YES,,THEN WE ARE REALLY OFFLINE
GSTS.1:	TXNE	S1,PSF%ST		;ARE WE STOPPED BY THE OPERATOR
	MOVX	S2,%STOPD		;YES,,THEN SAY SO
	TXNE	S1,PSF%OR		;Are we waiting for OPR response?
	MOVX	S2,%OREWT		;Then say so.
	$RET				;And return


	SUBTTL SNDQSR - ROUTINE TO SEND A MESSAGE TO QUASAR.

	;CALL:	S1/ The message address
	;	S2/ The message length
	;
	;RET:	TRUE  if sent successfully
	;	Stopcode 'QSF' if the send fails
	;


OPRMSG:	TDZA	TF,TF			;FLAG SEND ORION ENTRY POINT
SNDQSR:	SETOM	TF			;FLAG SEND QUASAR ENTRY POINT
	MOVEM	S1,SAB+SAB.MS		;SAVE THE MESSAGE ADDRESS
	MOVEM	S2,SAB+SAB.LN		;SAVE THE MESSAGE LENGTH
	MOVX	S1,SP.QSR		;GET QUASAR FLAG
	SKIPN	TF			;UNLESS WE WANT TO THEN TO THE OPERATOR
	MOVX	S1,SP.OPR		;   THEN GET OPERATOR INDEX
	TXO	S1,SI.FLG		;SET SPECIAL INDEX FLAG
	STORE	S1,SAB+SAB.SI		;AND STORE IT
	SETZM	SAB+SAB.PD		;CLEAR THE PID WORD
	MOVEI	S1,SAB.SZ		;LOAD THE SIZE
	MOVEI	S2,SAB			;AND THE ADDRESS
	PUSHJ	P,C%SEND		;SEND THE MESSAGE
	JUMPT	.RETT			;AND RETURN

	STOPCD	(QSF,HALT,,<Send to QUASAR failed>)



TOPS20 <
	SUBTTL	IDLE LOOP

MAIN:	SETZM	RDSCHD			;SLEEP AFTER THIS PASS
	PUSHJ	P,CHKQUE		;GO CHECK THE MESSAGE QUEUE
	PUSHJ	P,CHKFRK		;GO CHECK FOR FORK TERMINATION
	SKIPE	RDSCHD			;DO WE WANT A SCHEDULING PASS ???
	JRST	MAIN			;YES,,GO CHECK AGAIN
	SETZM	S1			;SLEEP TILL WE'RE NEEDED
	PUSHJ	P,I%SLP			;NO,,GO TO SLEEEEEEEEEEEPPPPP
	JRST	MAIN			;GO CHECK TO MESSAGE QUEUE
	SUBTTL	CHKFRK - ROUTINE TO PROCESS INFERIOR FORK TERMINATION

CHKFRK:	SKIPN	TRMFRK			;DID ANY FORK GO AWAY ???
	JRST	CHKF.4			;NO,,GO CHECK FOR FORK INITIALIZATION
	SETOM	RDSCHD			;SCHEDULE ANOTHER PASS
	SETZM	TRMFRK			;ZERO FORK TERMINATION FLAG
	MOVSI	P1,-MAXRDR		;MAKE AN AOBJN AC

CHKF.1:	SKIPN	RDR,JOBPAG(P1)		;IS THIS STREAM ACTIVE ???
	JRST	CHKF.3			;NO,,TRY THE NEXT ONE
	MOVE	S1,.RDHND(RDR)		;GET THE PROCESS HANDLE
	RFSTS				;GET THE FORK STATUS
	 ERJMP	CHKF.A			;IGNORE ANY ERRORS
	TXZ	S1,RF%FRZ		;CLEAR THE FROZEN FORK BIT
	HLRZ	S1,S1			;MOVE LEFT TO RIGHT AND ZERO LEFT
	CAIE	S1,.RFHLT		;IS THIS FORK HALTED ???
	CAIN	S1,.RFFPT		;HERE TOO !
	SKIPA				;YES TO EITHER,,CONTINUE ON
	JRST	CHKF.3			;ELSE TRY NEXT FORK
	SKIPE	.RDSHT(RDR)		;DID THIS READER SHUTDOWN ???
	JRST	CHKF.2			;YES,,SHUT IT DOWN
	SKIPGE	.RDSTP(RDR)		;Do we need to find error?
	JRST	[$WTO (<^B/@JOBOBA(P1)/ Terminated>,,,<$WTFLG(WT.SJI)>)
		JRST	CHKF.A]
	HRROI	S1,.RDSTP(RDR)		;POINT TO ERROR BUFFER
	HRLOI	S2,@.RDHND(RDR)		;ELSE GET FORK HANDLE,,-1
	SKIPE	.RDSTP(RDR)		;IS THERE ANY ERROR CODE ???
	HRR	S2,.RDSTP(RDR)		;YES,,GET FORK HANDLE,,ERROR CODE
	MOVE	T1,[-^D49,,0]		;GET -LENGTH,,0
	ERSTR				;CONVERT ERROR TO A STRING
	 ERJMP	.+2			;IGNORE THIS ERROR
	 ERJMP	.+1			;AND THIS ONE
	$WTO	(<^B/@JOBOBA(P1)/ Terminated>,<Reason: ^T/.RDSTP(RDR)/>,,<$WTFLG(WT.SJI)>)

;  Here if in error

CHKF.A:	SKIPE	DEBUGW			;Are we debugging?
	JRST	CHKF.3			;Yes, both that and in error,
					;do not delete the fork.

CHKF.2:	SETZM	.RDSTP(RDR)		;Clear the error
	HRRZM	P1,STREAM		;SAVE THE STREAM NUMBER
	MOVX	S1,%RSUDE		;Device doesn't exist
	PUSHJ	P,SHUTUP		;Shut down the fork

CHKF.3:	AOBJN	P1,CHKF.1		;GO CHECK THE NEXT FORK

	;Here to Check to see if any fork is finished initialization.

CHKF.4:	SKIPN	FRKINI			;ANY FORK END ITS INITIALIZATION ???
	$RETT				;NO,,JUST RETURN
	SETOM	RDSCHD			;YES,,SCHEDULE ANOTHER PASS
	SETZM	FRKINI			;ZERO FORK TERMINATION FLAG
	MOVSI	P1,-MAXRDR		;MAKE AN AOBJN AC
CHKF.5:	SKIPE	RDR,JOBPAG(P1)		;IS THIS READER SETUP ???
	SKIPN	.RDINI(RDR)		;YES,,INITIALIZATION FLAG LIT ???
	JRST	CHKF.6			;NO,,TRY NEXT
	HRRZM	P1,STREAM		;SAVE OUR STREAM NUMBER
	SETZM	.RDINI(RDR)		;CLEAR THE INITIALIZATION FLAG
	MOVX	S1,%RSUOK		;GET RESPONSE TO SETUP CODE (OK)
IFN FTDN60,<
	SKIPLE	.RDREM(RDR)		;DN60?
	$CALL	FIXPRO			;Yes, fix the data base
> ;End of FTDN60
	PUSHJ	P,RSETUP		;SEND THE RESPONSE TO SETUP MESSAGE
IFN FTDN60,<
	SKIPLE	.RDREM(RDR)		;DN60?
	$CALL	FIXPRO			;Yes, fix the data base back
> ;End of FTDN60
CHKF.6:	AOBJN	P1,CHKF.5		;GO CHECK THE NEXT RDR
	$RETT				;RETURN WHEN DONE
	SUBTTL	RDINIT - ROUTINE TO INITIALIZE READER CONSTANTS

RDINIT:	PUSHJ	P,I%HOST		;GET OUR HOST NAME
	MOVEM	S1,CNTSTA		;SAVE THE SIXBIT NODE NAME
	SKIPE	135			;ARE WE DEBUGGING
	SKIPN	116			;AND ARE SYMBOLS DEFINED ???
	JRST	RDIN.1			;NO TO EITHER,,SKIP THIS
	HLRO	S1,116			;GET AOBJN LENGTH
	MOVMS	S1			;GET ABSOLUTE VALUE
	HRRZ	S2,116			;GET SYMBOL TABLE START ADDRESS
	ADDI	S1,-1(S2)		;CALC SYMBOL TABLE LENGTH
	SKIPA				;SKIP OVER NORMAL CALC
RDIN.1:	HLRZ	S1,.JBSA##		;GET THE PROGRAM END ADDRESS
	ADDI	S1,777			;ROUND IT OFF
	ADR2PG	S1			;MAKE IT A PAGE NUMBER
	MOVEM	S1,RDRSIZ		;SAVE IT
	$RETT				;RETURN
	SUBTTL	INPGET - ROUTINE TO SETUP THE READER FORK

INPGET:	MOVE	S1,JOBOBA(STREAM)	;GET THE OBJECT BLOCK ADDRESS
	SKIPN	.RDREM(RDR)		;IS THIS A LOCAL READER ???
	$TEXT	(<-1,,.RDRFD(RDR)>,<PCDR^O/OBJ.UN(S1)/:^0>) ;YES,,GEN DEV NAME
	SKIPGE	.RDREM(RDR)		;OR IS IT A REMOTE READER ???
	$TEXT	(<-1,,.RDRFD(RDR)>,<^W/OBJ.ND(S1)/::PCDR^O/OBJ.UN(S1)/:^0>)

	MOVX	S1,<CR%CAP+CR%ACS>	;SUPERIOR CAPS AND AC'S
	MOVEI	S2,.RDREG(RDR)		;AC LOAD BUFFER
	CFORK				;CREATE A SPOOLER
	 ERJMP	FRKERR			;ON ERROR,,GO PROCESS IT

	MOVEM	S1,.RDHND(RDR)		;SAVE THE INFERIOR HANDLE
	MOVSI	S1,.FHSLF		;GET MY HANDLE
	HRLZ	S2,.RDHND(RDR)		;GET THE SPOOLER HANDLE
	HRR	T1,RDRSIZ		;GET THE LENGTH IN PAGES
	HRLI	T1,(PM%RWX!PM%CNT)	;COUNT+READ+EXECUTE
	PMAP				;MAP THE PAGES
	 ERJMP	PMPERR			;ON ERROR,,GO PROCESS IT

	MOVE	S1,RDR			;GET THE DATA BASE ADDRESS
	ADR2PG	S1			;CONVERT IT TO A PAGE NUMBER
	MOVE	S2,S1			;SAVE IT IN S2
	HRLI	S1,.FHSLF		;GET MY HANDLE
	HRL	S2,.RDHND(RDR)		;GET THE SPOOLER HANDLE
	HRRI	T1,DBSIZE		;GET THE PAGE COUNT
	HRLI	T1,(PM%RWX!PM%CNT)	;R,W,E + COUNT
	PMAP				;MAP THE DATA BASE
	 ERJMP	PMPERR			;ON ERROR,,GO PROCESS IT

	MOVE	S1,.RDHND(RDR)		;GET THE SPOOLER HANDLE
	MOVEI	S2,DOJOB		;GET THE START ADDRESS
	SFORK				;START THE SPOOLER
	ERJMP	FRKERR			;ON ERROR,,PROCESS IT
	MOVX	S1,%RSUOK
	$RETT				;AND RETURN



FRKERR:	$WTO	(Cant create a Fork,,@JOBOBA(STREAM)) ;TELL THE OPERATOR
	MOVX	S1,%RSUDE		;GET THE ERROR CODE
	$RETT				;AND RETURN

PMPERR:	$WTO	(Cant PMAP Spooler Pages,,@JOBOBA(STREAM)) ;TELL THE OPERATOR
	MOVX	S1,%RSUDE		;GET THE ERROR CODE
	$RETT				;AND RETURN
	SUBTTL	OACPAU - ROUTINE TO STOP A READER

OACPAU:	MOVE	S1,.RDHND(RDR)		;GET THE SPOOLER HANDLE
	FFORK				;FREEZE THE FORK
	ERJMP	OACC.1			;IF AN ERROR,,PROCESS IT
	$ACK	(Stopped,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
	MOVX	S2,PSF%ST		;GET 'STOPPED' BIT
	IORM	S2,JOBSTW(STREAM)	;SET IT
	PUSHJ	P,UPDTST		;SEND A STATUS MESSAGE
	$RETT				;AND RETURN

OACC.1:	$ACK	(Cannot Be Stopped,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
	$RETT				;AND RETURN

	SUBTTL	OACCON - ROUTINE TO CONTINUE A READER

OACCON:	MOVE	S1,.RDHND(RDR)		;GET THE SPOOLER HANDLE
	RFORK				;RESTART THE SPOOLER
	ERJMP	OACC.2			;IF AN ERROR,,GO PROCESS
	$ACK	(Continued,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
	MOVX	S2,PSF%ST		;GET THE 'STOPPED' BIT
	ANDCAM	S2,JOBSTW(STREAM)	;CLEAR IT
	MOVE	S1,.RDHND(RDR)		;GET THE FORKS HANDLE
	MOVX	S2,<1B1>		;WANT CHANNEL 1
	IIC				;TELL FORK TO SEND STATUS
	$RETT				;AND RETURN

OACC.2:	$ACK	(Cannot Be Continued,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
	$RETT				;AND RETURN

	SUBTTL	OACCAN - ROUTINE TO CANCEL THE CURRENT JOB ON THE READER

OACCAN:	MOVE	S1,.RDHND(RDR)		;GET THE FORKS HANDLE
	MOVX	S2,<1B2>		;GET CHANNEL 2
	IIC				;TELL THE FORK TO CANCEL THE JOB
	$RETT				;AND RETURN

	SUBTTL	OACSHT - ROUTINE TO SHUTDOWN THE CARD READER

OACSHT:	MOVE	S1,.RDHND(RDR)		;GET THE FORKS HANDLE
	MOVX	S2,<1B3>		;GET CHANNEL 3
	IIC				;TELL THE FORK TO SHUTDOWN
	ERJMP	.RETT			;ON AN ERROR,,RETURN OK
	$RETF				;AND RETURN

	SUBTTL	INTERRUPT ROUTINES


LEVTAB:	EXP	LEV1PC			;INTRPT LEVEL 1 PC ADDRESS
	EXP	LEV2PC			;INTRPT LEVEL 2 PC ADDRESS
	EXP	LEV3PC			;INTRPT LEVEL 3 PC ADDRESS

CHNTAB:	XWD	1,INTIPC		;IPCF INTERRUPT ON CHANNEL 0
	XWD	1,INTFKI		;FORK INITIALIZATION END INTERRUPT
	BLOCK	^D34			;INFERIOR PROCESS TERM ON CHNL 19
					;ALL OTHER CHANNELS 0

LEV1PC:	BLOCK	1			;LEVEL 1 INTERRUPT PC
LEV2PC:	BLOCK	1			;LEVEL 2 INTERRUPT PC
LEV3PC:	BLOCK	1			;LEVEL 3 INTERRUPT PC


INTINI:	MOVE	S1,[1,,ENDFRK]		;SET UP INFERIOR FORK TERM PARMS
	MOVEM	S1,CHNTAB+.ICIFT	; IN THE CHANNEL TABLE
	MOVX	S1,.FHSLF		;GET MY HANDLE
	MOVX	S2,1B0+1B1+1B19		;GET CHNL 0 (IPCF)+CHNL 19 (FORK TERM)
	AIC				;ACTIVATE CHANNEL 0 AND 1 AND 19
	$RETT				;RETURN

INTIPC:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	PUSHJ	P,C%INTR		;FLAG THE IPCF INTERRUPT
	$DEBRK				;AND LEAVE INTERRUPT LEVEL

ENDFRK:	$BGINT	1,			;INTIALIZE INTERRUPT LEVEL
	SETOM	TRMFRK			;INDICATE WE DID THIS
	$DEBRK				;AND LEAVE INTERRUPT LEVEL

INTFKI:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	FRKINI			;FLAG THE INTERRUPT
	$DEBRK				;AND LEAVE INTERRUPT LEVEL

	SUBTTL	INPREL - ROUTINE TO RELEASE A CARD  READER

INPREL:	MOVE	S1,.RDHND(RDR)		;GET THE SPOOLER HANDLE
	KFORK				;KILL THE FORK
	ERJMP	.+1			;IGNORE ANY ERRORS
	$RETT				;AND RETURN

	SUBTTL	SPOOLER - CARD READER SPOOLER FORK ROUTINE START ADDRESS


RDRIB:	$BUILD	IB.SZ				;
	  $SET	(IB.PRG,,%%.MOD)		;PROGRAM 'CDRIVE'
	  $SET  (IB.FLG,IP.STP,1)		;STOPCODES TO ORION
	  $SET	(IB.PIB,,RDRPIB)		;SET UP PIB ADDRESS
	  $SET(IB.INT,,<LEVTBL,,CHNTBL>)	;SETUP INTERRUPT VECTOR
	$EOB					;

RDRPIB:	$BUILD	PB.MNS				;
	  $SET	(PB.HDR,PB.LEN,PB.MNS)		;
	$EOB					;


DOJOB:	MOVEI	S1,IB.SZ		;GET THE IB SIZE
	MOVEI	S2,RDRIB		;GET THE IB ADDRESS
	PUSHJ	P,I%INIT		;GO MAP THE LIBRARY
	SKIPE	135			;ARE WE DEBUGGING ???
	PUSHJ	P,GETDDT		;YES,,GO LOAD DDT AND WAIT
	MOVEI	S1,.RDFD(RDR)		;GET THE FD ADDRESS
	MOVEM	S1,.RDFOB+FOB.FD(RDR)	;SAVE IT IN THE FOB
	MOVE	S1,.RDOBZ(RDR)		;GET THE OUTPUT BYTE SIZE
	STORE	S1,.RDFOB+FOB.CW(RDR),FB.BSZ ;SAVE IT IN THE FOB
	MOVEI	S1,1			;GET A BIT
	STORE	S1,.RDFOB+FOB.CW(RDR),FB.NFO ;WANT 'NEW FILE ONLY' !!
	MOVX	S1,.FHSLF		;GET MY HANDLE
	RPCAP				;GET MY CAPABILITIES
	 ERCAL	INTERR			;STOP ON AN ERROR
	MOVE	T1,S2			;WANT ALL AVAILABLE CAPABILITIES
	MOVX	S1,.FHSLF		;GET MY HANDLE
	EPCAP				;ENABLE ALL CAPABILITIES
	 ERCAL	INTERR			;STOP ON AN ERROR

IFN FTDN60,<
	MOVEI	S1,SERFLG		;Indicate need for SYSERR
	SKIPLE	.RDREM(RDR)		;Is this one a DN60?
	$CALL	D60INI##		;Yes, initialize the DN60 database
> ; End of FTDN60 conditional

	PUSHJ	P,OPENIT		;GO OPEN THE READER

	MOVE	S1,.RDSTR(RDR)		;GET THE STREAM NUMBER
	$WTO	(Started,,@JOBOBA(S1)) ;TELL THE OPERATOR

	;SETUP THE UPDATE STATUS MESSAGE (ONCE ONLY)

	MOVE	S1,[STU.SZ,,.QOSTU]	;GET STATUS MSG LENGTH,,TYPE
	MOVEM	S1,.RDMSG+.MSTYP(RDR)	;SAVE IT
	MOVE	S1,.RDSTR(RDR)		;GET OUR STREAM NUMBER
	HRLZ	S1,JOBOBA(S1)		;GET OUR OBJECT BLOCK ADDRESS
	HRRI	S1,.RDMSG+STU.RB(RDR)	;GET THE DESTINATION ADDRESS
	BLT	S1,.RDMSG+STU.RB+OBJ.SZ-1(RDR) ;COPY THE OBJ BLK OVER
	SETOM	.RDSTS(RDR)		;LETS TRY IT FIRST CHANCE WE GET
	MOVEI	S1,ERTCNT		;GET A MAX ERROR COUNT
	MOVEM	S1,.RDECT(RDR)		;SAVE IT JUST IN CASE WE NEED IT

	JRST	MAINRT			;GO PROCESS

	SUBTTL	MAINRT - ROUTINE TO INPUT AND PROCESS CARDS

MAINRT:	MOVE	S1,.RDCHN(RDR)		;GET THE JFN
	HRLZ	S2,.RDIBZ(RDR)		;GET THE INPUT BYTE SIZE
	LSH	S2,6			;POSITION IT
	ADD	S2,[POINT 0,.CARDS(RDR)] ;CREATE THE BYTE POINTER
	MOVE	T1,[EXP -CRDNBR]	;GET THE NUMBER OF CARDS TO READ
	IMUL	T1,.RDRCL(RDR)		;MULTIPLY BY RECORD LENGTH
	PUSHJ	P,$SIN			;GET A BATCH OF CARDS
	JUMPT	MAIN.1			;WE WIN,,SO CONTINUE

	MOVE	P1,S2			;SAVE THE OUTPUT BYTE POINTER
	MOVE	P2,T1			;SAVE THE BYTE COUNT
	PUSHJ	P,$GTSTS		;GO SET THE READER STATUS
	PUSHJ	P,$GETER		;READ THE ERROR STATUS BITS
	MOVE	T1,P2			;RESTORE THE NUMBER OF BYTES READ
	CAXE	S1,OPNX8		;IS IT DEVICE OFFLINE ???
	CAXN	S1,IOX5			;   OR WAS IT AN I/O ERROR ???
	JRST	MAIN.1			;YES,,GO PROCESS IT
	CAXE	S1,IOX4			;WAS IT EOF ???
	PJRST	INTERR			;NO,,THEN A FATAL ERROR
	TXO	FLAG,EOF		;INDICATE AN EOF CONDITION OCCURED
	PUSHJ	P,RESDEV		;ON EOF,,GO CLOSE AND RE-OPEN THE RDR
	MOVE	S1,ENDIMG(AP)		;GET AN EOF BYTE
	IDPB	S1,P1			;MAKE AN EOF CARD
	MOVE	T1,P2			;GET THE NUMBER OF BYTES READ
	ADD	T1,.RDRCL(RDR)		;ADD 1 MORE CARD LENGTH

MAIN.1:	MOVE	S1,.RDRCL(RDR)		;GET THE RECORD LENGTH
	IMULI	S1,CRDNBR		;CALC # OF BYTES TO BE READ
	ADD	T1,S1			;CALC # OF BYTES READ
	IDIV	T1,.RDRCL(RDR)		;CALC # OF CARDS READ
	MOVEM	T1,.RDNBR(RDR)		;SAVE IT
	SKIPE	T1			;NO CARDS,,DONT PROCESS 
	PUSHJ	P,READER		;GO PROCESS THE CARDS
	SKIPG	.RDREM(RDR)		;IS THIS A DN60 READER ???
	PUSHJ	P,CHKOFL		;NO,,GO CHECK FOR OFFLINE'NESS

	PUSHJ	P,CHKSTS		;GO CHECK OUR STATUS
	SETZM	S1			;SLEEP TILL WE'RE  NEEDED
	SKIPE	.RDOFL(RDR)		;IS THE READER OFFLINE ???
	PUSHJ	P,I%SLP			;YES,,JUST SLEEEEEEP
	JRST	MAINRT			;ELSE,,GO PROCESS SOME MORE CARDS

	SUBTTL	GENFIL - ROUTINE TO GENERATE A SPOOL FILENAME

GENFIL:	MOVEI	S1,.RDFD(RDR)		;GET THE FD ADDRESS
	MOVEI	S2,10			;GET THE FD LENGTH
	STORE	S2,.FDLEN(S1),FD.LEN	;SAVE IT IN THE FD
	AOS	S2,FILENM		;BUMP HASH COUNT BY 1,,PUT IN S2
	$TEXT	(<-1,,.FDSTG(S1)>,<^T/SPL/RD^D4L0/S2,FILEMK/-^D3R0/FILEXT/>)
	$RETT				;AND RETURN


RESDEV:	SKIPLE	.RDREM(RDR)		;IS THIS A DN60 DEVICE ???
	$RETT				;YES,,RETURN
	MOVE	S1,.RDCHN(RDR)		;GET THE JFN
	TXO	S1,CZ%ABT		;ABORT ANY INPUT PROCESSING
	PUSHJ	P,$CLOSF		;CLOSE THE READER DOWN
	JUMPF	OPNERR			;NO,,STOP ON AN ERROR

	;FALL INTO READER OPEN CODE

OPENIT:	$CALL	SETINT			;Set up the interrupts
	MOVX	S1,GJ%SHT+GJ%PHY	;SHORT JFN+PHYSICAL UNIT
	HRROI	S2,.RDRFD(RDR)		;GET THE DEVICE ADDRESS
	PUSHJ	P,$GTJFN		;GET A JFN
	JUMPF	OPNERR			;STOP ON AN ERROR
	MOVEM	S1,.RDCHN(RDR)		;SAVE THE JFN
	MOVX	S2,^D16B5+10B9+OF%RD+OF%HER+OF%OFL ;16 BIT BYTES+IMAGE MODE+
	PUSHJ	P,$OPENF		;OPEN THE READER
	JUMPF	OPNERR			;STOP ON AN ERROR
	$CALL	COMINT			;Turn on reader interrupt
	PUSHJ	P,$GTSTS		;GO GET THE READER STATUS
	MOVE	S1,.RDSTA(RDR)		;GET THE DEVICE STATUS BITS
	TXNE	S1,MO%FNX		;DOES THE DEVICE REALLY EXIST ???
	JRST	[MOVX	S1,DIAGX8	;NO,,GET 'DEVICE DOESN'T EXIST' CODE
		 MOVEM	S1,.RDSTP(RDR)	;SAVE IT IN OUR DATA BASE
		 HALTF  ]		;WE'RE DONE FOR !!!
	TXNE	FLAG,EOF		;HERE BECAUSE OF DEVICE EOF ???
	$RETT				;YES,,JUST RETURN
	SETOM	.RDINI(RDR)		;FLAG END OF INITIALIZATION
	MOVX	S1,.FHSUP		;WANT SUPERIOR PROCESS
	MOVX	S2,<1B1>		;GET CHANNEL
	IIC				;TELL SUPERIOR TO SEND RSP MSG TO QUASAR
	ERCAL	OPNERR			;CAN'T,,OH WELL !!!
	$RETT				;OK,,RETURN

SPL:	ASCIZ/PS:<SPOOL>/




	SUBTTL	CHKOFL - ROUTINE TO CHECK LOCAL/REMOTE OFFLINE STATUS

CHKOFL:	SKIPN	.RDOFL(RDR)		;ARE WE OFFLINE ???
	$RETT				;NO,,JUST RETURN
	MOVE	S1,.RDSTR(RDR)		;GET OUR STREAM NUMBER
	TXNE	FLAG,JOBCD		;DO WE HAVE A JOB CARD ???
	$WTO	(Offline,,@JOBOBA(S1))	;TELL THE OPERATOR ITS OFFLINE
	$RETT				;AND RETURN

	SUBTTL	CHKSTS - ROUTINE TO PROCESS THE DIFFERENT STATUS INTERRUPTS

CHKSTS:
;	PUSHJ	P,GETHSP		;GO READ THE HASP CONSOLE (IF NEEDED)
;  Now done as part of SIN.6

	SKIPE	.RDSTS(RDR)		;DO WE WANT TO SEND A STATUS UPDATE ??
	PUSHJ	P,SNDSTS		;YES,,DO IT
	SKIPN	.RDCAN(RDR)		;DO WE WANT TO CANCEL THIS GUY ???
	JRST	CHKS.1			;NO,,CONTINUE ON
	SETZM	.RDCAN(RDR)		;CLEAR THE CANCEL FLAG
	TXZ	FLAG,JOBCD		;CLEAR THE JOBCARD FLAG
	MOVEM	FLAG,FLAG+.RDREG(RDR)	;Let the superior know
	SETOM	.RDSTS(RDR)		;Say we want status update
	MOVE	S1,.RDSTR(RDR)		;GET THE STREAM NUMBER
	$WTOJ	(Current Job Canceled,,@JOBOBA(S1)) ;TELL THE OPERATOR

CHKS.1:	SKIPE	.RDSHT(RDR)		;DO WE WANT TO SHUT DOWN?
	TXNE	FLAG,JOBCD		;ARE WE PROCESSING A JOB ???
	$RETT				;NO or YES,,RETURN
	MOVE	S1,.RDCHN(RDR)		;Get JFN
	$CALL	$CLOSF			;Close the reader
	HALTF				;KILL THE FORK



	SUBTTL	GETDDT - ROUTINE TO LOAD DDT IF WE ARE DEBUGGING

GETDDT:	MOVX	S1,GJ%OLD+GJ%SHT	;OLD FILE+SHORT JFN
	HRROI	S2,[ASCIZ/SYS:SDDT.EXE/] ;WANT DDT IN HERE TOO
	GTJFN				;GET DDT'S JFN
	 ERCAL	INTERR			;CANT,,TOO BAD !!
	HRLI	S1,.FHSLF		;GET MY HANDLE
	GET				;LOAD DDT
	 ERCAL	INTERR			;CANT LOAD IT,,TOO BAD !!
	MOVE	S1,116			;GET CONTENTS OF .JBSYM
	HRRZ	S2,770001		;GET ADDRESS OF WHERE TO PUT IT
	MOVEM	S1,0(S2)		;POINT DDT AT MY SYMBOL TABLE
	JRST	770000			;AND ENTER DDT
GO:	$RETT				;RETURN

	SUBTTL	SENDIT - ROUTINE TO SEND IPCF MESSAGES TO QUASAR

	;CALL:	S1/ THE MESSAGE ADDRESS
	;	S2/ THE MESSAGE LENGTH
	;
	;RET:	TRUE ALWAYS

SNDOPR:	TDZA	TF			;ZAP ENTRY FLAG WORD AND SKIP
SENDIT:	SETOM	TF			;SET ENTRY FLAG WORD AND CONTINUE
	MOVEM	S1,.RDSAB+SAB.MS(RDR)	;SAVE THE MESSAGE ADDRESS
	MOVEM	S2,.RDSAB+SAB.LN(RDR)	;SAVE THE MESSAGE LENGTH
	MOVX	S1,SP.QSR		;GET QUASAR'S SPECIAL INDEX
	SKIPN	TF			;CHECK ENTRY FLAG; IS IT OPR ENTRY POINT
	MOVX	S1,SP.OPR		;YES,,GET ORIONS SPECIAL INDEX
	TXO	S1,SI.FLG		;SET SPECIAL INDEX FLAG
	MOVEM	S1,.RDSAB+SAB.SI(RDR)	;SAVE THE RECIEVERS ID
	SETZM	.RDSAB+SAB.PD(RDR)	;CLEAR THE PID WORD
	MOVEI	S1,PIB			;GET SUPERIORS PIB ADDRESS
	MOVEM	S1,.RDSAB+SAB.PB(RDR)	;SAVE IT FOR 'IN BEHALF OF' SEND
	MOVEI	S1,SAB.SZ		;GET THE SAB LENGTH
	MOVEI	S2,.RDSAB(RDR)		;GET THE SAB ADDRESS
	PUSHJ	P,C%SEND		;SEND IT TO QUASAR
	JUMPT	.RETT			;RETURN IF OK
	$CALL	INTERR			;Else log the error and do not return

	SUBTTL	SNDSTS - ROUTINE TO SEND READER STATUS UPDATES TO QUASAR

SNDSTS:	SETZM	.RDSTS(RDR)		;CLEAR SEND STATUS FLAG
	$CALL	GSTS			;Get the status
	STORE	S2,.RDMSG+STU.CD(RDR)	;SAVE THE READER STATUS
	MOVEI	S1,.RDMSG(RDR)		;GET THE MESSAGE ADDRESS
	MOVEI	S2,STU.SZ		;GET THE MESSAGE LENGTH
	PUSHJ	P,SENDIT		;SEND IT TO QUASAR
	$RETT				;AND RETURN

	SUBTTL	SETINT - ROUTINE TO SETUP PROCESS INTERRUPTS

	;INTERRUPT DATA BASE

LEVTBL:	EXP	LVL1PC			;INTRPT LEVEL 1 PC ADDRESS
	EXP	LVL2PC			;INTRPT LEVEL 2 PC ADDRESS
	EXP	LVL3PC			;INTRPT LEVEL 3 PC ADDRESS

CHNTBL:	XWD	1,CDRINT		;ONLINE/OFFLINE ON CHANNEL 0
	XWD	1,STSINT		;UPDATE STATUS INTRPTS ON CHANL 1
	XWD	1,CANINT		;CANCEL JOB INTRPTS ON CHANL 2
	XWD	1,SHTINT		;SHUTDOWN READER INTRPTS ON CHANL 3
	BLOCK	^D35			;ALL OTHER CHANNELS 0

LVL1PC:	BLOCK	1			;LEVEL 1 INTRPT PC
LVL2PC:	BLOCK	1			;LEVEL 2 INTRPT PC
LVL3PC:	BLOCK	1			;LEVEL 3 INTRPT PC


SETINT:	MOVX	S1,.FHSLF		;GET THE PROCESS HANDLE
	SETOM	S2			;DISABLE ALL 36 CHANNELS
	DIC				;LETERRIP
	 ERCAL	INTERR			;ON ERROR,,HALT
	CIS				;CLEAR THE INTERRUPT SYSTEM
	MOVX	S1,.FHSLF		;GET MY PROCESS HANDLE
	MOVE	S2,[LEVTBL,,CHNTBL]	;GET PRTY LEVEL,,CHANNEL
	SIR				;SETUP THE MONITOR INTRPT TABLE ADDRS
	 ERCAL	INTERR			;ON ERROR,,HALT
	MOVX	S1,.FHSLF		;GET MY PROCESS HANDLE
	EIR				;ENABLE THE INTERRUPT SYSTEM
	 ERCAL	INTERR			;ON ERROR,,HALT
	MOVX	S1,.FHSLF		;Get my process handle
	MOVX	S2,1B1+1B2+1B3		;Activate all channels but
					;online/offline channel
	AIC				;Activate the channels
	 ERCAL	INTERR			;On error, HALT
	$RET				;Just return


COMINT:

;  This routine completes the interrupt system for the inferior fork.
;  It adds the ONLINE/OFFLINE channel.

IFN FTDN60,<
	SKIPLE	.RDREM(RDR)		;Is it DN60?
	$RET				;Yes, nothing further to do
> ; End of FTDN60

;  Place ONLINE/OFFLINE on channel 0

	MOVE	S1,.RDCHN(RDR)		;GET THE JFN
	MOVX	S2,.MOPSI		;FUNCTION: ADD TO INTRPT SYSTEM
	MOVEI	T1,T2			;ARGUMENT BLOCK ADDRESS
	MOVEI	T2,3			;    ""     ""  LENGTH
	MOVEI	T3,0			;INTERRUPTS ON CHANNEL 0
	MOVX	T4,MO%MSG		;NO MESSAGE
	PUSHJ	P,$MTOPR		;ADD TO THE INTERRUPT SYSTEM
	JUMPF	INTERR			;ON AN ERROR,,STOP

;  Now add the channel to the interrupt system

	MOVX	S1,.FHSLF		;GET MY PROCESS HANDLE
	MOVX	S2,1B0			;Only channel 0
	AIC				;Activate channel 0
	 ERCAL	INTERR			;ON ERROR,,HALT
	$RET				;RETURN

INTERR:
OPNERR:	SKIPE	.RDSTP(RDR)		;Previous error generated?
	JRST	INTE.1			;Yes, skip this
	MOVX	S1,.FHSLF		;GET MY HANDLE
	SETZM	S2			;CLEAR S2 (RESULT)
	GETER				;GET THE LAST ERROR CODE
	HRRZM	S2,.RDSTP(RDR)		;Save only the error code
INTE.1:	HALTF				;END IT ALL

	SUBTTL	INTERRUPT ROUTINES

	;READER ONLINE/OFFLINE INTERRUPT ROUTINE

CDRINT:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	.RDSTS(RDR)		;WANT A STATUS UPDATE MSG SENT
	MOVE	S1,.RDCHN(RDR)		;GET THE JFN
	MOVX	S2,.MORST		;READ DEVICE STATUS FUNCTION
	MOVEI	T1,T2			;ARGUMENT BLOCK ADDRESS
	MOVEI	T2,2			;ARGUMENT BLOCK LENGTH
	SETZ	T3,			;DEVICE STATUS
	PUSHJ	P,$MTOPR		;GET THE READER STATUS
	MOVEM	T3,.RDSTA(RDR)		;SAVE THE DEVICE STATUS BITS
	SETZM	.RDOFL(RDR)		;ASSUME WE ARE ON-LINE !!!
	TXNE	T3,MO%OL		;IS THE READER OFFLINE ???
	SETOM	.RDOFL(RDR)		;IF OFFLINE,,SAY SO.
	SKIPE	.RDREM(RDR)		;IF REMOTE,,
	JRST	CDRI.1			;   THEN SKIP THIS LOCAL STUFF
	MOVEI	S1,.RETT		;GET OFFLINE EXIT ADDRESS
	SKIPE	.RDIOA(RDR)		;WERE WE I/O ACTIVE ???
	MOVEM	S1,LVL1PC		;YES,,SAVE IT FOR DEBRK
CDRI.1:	SETZM	.RDIOA(RDR)		;CLEAR I/O ACTIVE
	$DEBRK				;DISMISS THE INTERRUPT.

	;UPDATE READER STATUS INTERRUPT ROUTINE

STSINT:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	.RDSTS(RDR)		;SAY WE WANT A STATUS UPDATE MSG SENT
	$DEBRK				;LEAVE INTERRUPT LEVEL

	;JOB CANCEL INTERRUPT ROUTINE

CANINT:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	.RDCAN(RDR)		;SAY WE WANT TO CANCEL THE CURRENT JOB
	$DEBRK				;LEAVE INTERRUPT LEVEL

	;CARD READER SHUTDOWN INTERRUPT ROUTINE

SHTINT:	$BGINT	1,			;INITIALIZE INTERRUPT LEVEL
	SETOM	.RDSHT(RDR)		;SAY WE WANT TO SHUT DOWN
	$DEBRK				;LEAVE INTERRUPT LEVEL

	SUBTTL	LOCAL/REMOTE I/O SUBROUTINES

$GTSTS:	SKIPLE	.RDREM(RDR)		;IS THIS A LOCAL OR DN200 CDR ???
	$RETT				;NO, SO DN60, SO RETURN
	MOVX	S1,.FHSLF		;YES,,GET MY HANDLE
	MOVX	S2,<1B0>		;WANT CHANNEL 0
	IIC				;FORCE INTERRUPT ON ONLINE/OFFLINE CHNL
	ERJMP	.+1			;IGNORE ANY ERROR
	$RETT				;AND RETURN

$GETER:	SKIPE	.RDREM(RDR)		;IS THIS A REMOTE READER ???
	JRST	[SKIPG	.RDREM(RDR)	;YES,,IS THIS A DN200 READER ???
		 JRST	GETE.2		;YES,,MUST BE DN200
		 JRST	GETE.6 ]	;NO,,MUST BE DN60
	MOVX	S1,.FHSLF		;GET MY HANDLE
	GETER				;GET THE LAST ERROR CODE
	HRRZ	S1,S2			;PUT IT INTO S1
	$RETT				;AND RETURN

$SIN:	SETOM	.RDIOA(RDR)		;MARK I/O ACTIVE
	SKIPE	.RDREM(RDR)		;IS THIS A REMOTE READER ???
	JRST	[SKIPG	.RDREM(RDR)	;YES,,IS IT THE DN200 READER ???
		 JRST	SIN.2		;YES,,GO PROCESS IT
		 JRST	SIN.6 ]		;NO,,MUST BE DN60 READER
	SKIPE	.RDOFL(RDR)		;IS THE READER OFFLINE ???
	JRST	SIN.T			;YES,,JUST RETURN
	SIN				;FINALLY READ THE DATA
	ERJMP	SIN.F			;RETURN FALSE ON AN ERROR
SIN.T:	SETZM	.RDIOA(RDR)		;CLEAR I/O ACTIVE
	$RETT				;AND RETURN
SIN.F:	SETZM	.RDIOA(RDR)		;CLEAR I/O ACTIVE
	$RETF				;AND RETURN

$OPENF:	SKIPE	.RDREM(RDR)		;IS THIS A REMOTE READER ???
	JRST	[SKIPG	.RDREM(RDR)	;YES,,IS IT THE DN200 READER ???
		 JRST	OPEN.2		;YES,,GO PROCESS IT
		 JRST	OPEN.6 ]		;NO,,MUST BE DN60 READER
	OPENF				;OPEN THE CARD READER
	ERJMP	.RETF			;ON AN ERROR,,RETURN WITH ERROR
	$RETT				;ELSE JUST RETURN

$MTOPR:	SKIPE	.RDREM(RDR)		;IS THIS A REMOTE READER ???
	JRST	[SKIPG	.RDREM(RDR)	;YES,,IS IT THE DN200 READER ???
		 JRST	MTOP.2		;YES,,GO PROCESS IT
		 JRST	.RETT ]		;NO,,MUST BE DN60 READER (NO MTOPR)
	MTOPR				;LOCAL,,ISSUE MTOPR NORMALLY
	ERJMP	.RETF			;ON AN ERROR,,RETURN NO GOOD
	$RETT				;RETURN OK

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

$GTJFN:	SKIPE	.RDREM(RDR)		;IS THIS A REMOTE READER ???
	JRST	[SKIPG	.RDREM(RDR)	;YES,,IS IT THE DN200 READER ???
		 JRST	GTJF.2		;YES,,GO PROCESS IT
		 JRST	GTJF.6 ]	;NO,,MUST BE DN60 READER (NO MTOPR)
	GTJFN				;LOCAL,,ISSUE GTJFN NORMALLY
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE RETURN OK

$CLOSF:	SKIPE	.RDREM(RDR)		;IS THIS A REMOTE READER ???
	JRST	[SKIPG	.RDREM(RDR)	;YES,,IS IT THE DN200 READER ???
		 JRST	CLOS.2		;YES,,GO PROCESS IT
		 JRST	CLOS.6 ]	;NO,,MUST BE DN60 READER (NO MTOPR)
	CLOSF				;LOCAL,,ISSUE CLOSF NORMALLY
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE RETURN OK

	SUBTTL	DN200 I/O SUPPORT ROUTINES

IFN FTRJE,<
GETE.2:	MOVE	S1,.RDCHN(RDR)		;GET THE JFN
	MOVX	S2,.MORST		;GET READ DEVICE STATUS FUNCTION
	MOVEI	T1,T2			;GET ARG BLOCK ADDRESS
	MOVEI	T2,2			;GET BLOCK LENGTH
	SETZM	T3			;CLEAR ANSWER WORD
	PUSHJ	P,UMTOPR##		;ISSUE THE MTOPR
	ERCAL	INTERR			;NO GOOD,,FORGET IT
	TXNE	T3,MO%OL+MO%HEM+MO%SCK+MO%PCK+MO%RCK+MO%SER
	MOVX	S1,IOX5			;ANY OF THE ABOVE,,SET I/O ERROR
	TXNE	T3,MO%EOF		;HARDWARE EOF ???
	MOVX	S1,IOX4			;YES,,MAKE IT EOF
	$RETT

SIN.2:	SKIPE	.RDOFL(RDR)		;IS THE READER OFFLINE ???
	JRST	SIN.T			;YES,,JUST RETURN
	PUSHJ	P,USIN##		;READ CARDS THROUGH NURD
	ERJMP	SIN.F			;RETURN FALSE ON AN ERROR
	JRST	SIN.T			;ELSE RETURN TRUE

OPEN.2:	PUSHJ	P,UOPENF##		;OPEN THE CARD READER THROUGH NURD
	ERJMP	.RETF			;CANT,,THATS AN ERROR
	$RETT				;OK,,JUST RETURN

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

GTJF.2:	PUSHJ	P,UGTJFN##		;GET A JFN VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE RETURN OK

CLOS.2:	PUSHJ	P,UCLOSF##		;CLOSE DOWN VIA NURD
	ERJMP	.RETF			;NO GOOD,,SAY SO
	$RETT				;ELSE RETURN OK
>
IFE FTRJE,<
GETE.2:
SIN.2:
OPEN.2:
MTOP.2:
GTJF.2:
CLOS.2:
	MOVX	S1,DIAGX8		;GET 'DEVICE DOES NOT EXIST'
	MOVEM	S1,.RDSTP(RDR)		;SAVE IT
	MOVE	S1,.RDSTR(RDR)		;GET OUR STREAM NUMBER
	$WTO	(DN200 Remote not Supported,,@JOBOBA(S1)) ;TELL OPERATOR
	HALTF				;END IT ALL
>
>  ;END OF TOPS-20 CONDITIONAL CODE
	SUBTTL	TOPS10 DN60 INTERFACE ROUTINES

TOPS10 <

$OPEN:	$CALL	GTJF.6			;do the initialization stuff
	$CALL	OPEN.6			;Open the card reader
	$RET				;Return keeping same condition

$CLOSE:	PJRST	CLOS.6			;SHUT US DOWN

$IN60:	MOVE	S1,.RDCHN(RDR)		;GET THE JFN
	HRLZ	S2,.RDIBZ(RDR)		;GET THE INPUT BYTE SIZE
	LSH	S2,6			;POSITION IT
	ADD	S2,[POINT 0,.CARDS(RDR)] ;CREATE THE BYTE POINTER
	MOVE	T1,[EXP -CRDNBR]	;GET THE NUMBER OF CARDS TO READ
	IMUL	T1,.RDRCL(RDR)		;MULTIPLY BY RECORD LENGTH
	PUSHJ	P,SIN.6			;GET SOME CARDS

	MOVE	S1,.RDRCL(RDR)		;GET THE RECORD LENGTH
	IMULI	S1,CRDNBR		;CALC # OF BYTES TO BE READ
	ADD	T1,S1			;CALC # OF BYTES READ
	IDIV	T1,.RDRCL(RDR)		;CALC # OF CARDS READ
	MOVEM	T1,.RDNBR(RDR)		;SAVE IT
	SKIPE	T1			;NO CARDS,,DONT PROCESS 
	PUSHJ	P,READER		;GO PROCESS THE CARDS
	SKIPE	S1,.RDSTP(RDR)		;GET THE LAST ERROR CODE
	CAXE	S1,IOX4			;WAS THE ERROR EOF ???
	SKIPA				;NO GOOD ERROR,,SKIP
	$RETF				;EOF,,RETURN
	JRST	$IN60			;TRY FOR SOME MORE CARDS

> ;END TOPS10

	SUBTTL	DN60 I/O SUPPORT ROUTINES

IFN FTDN60,<
SIN.6:	SETZM	.RDSTP(RDR)		;CLEAR LAST ERROR CODE
	SKIPE	.RDCPT(RDR)		;Hasp console?
	$CALL	I60OPR			;Yes - check for characters
	PUSHJ	P,D60SIN##		;TRY TO READ SOME CARDS
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes, do it
	JUMPT	[$CALL	D60SU		;Process success
		MOVEI	S1,ERTCNT	;Get error threshold count
		MOVEM	S1,.RDECT(RDR)	;Set it
		$RETT]			;and return true

	CAILE	S1,D6HEAD		;Check for legit error code
	CAIL	S1,D6TAIL		;because D60SIN isn't always friendly
	STOPCD (LEM,HALT,,<Lousy error message from D60SIN>) ;durn

	$D60ER(ERIDE)			;Process the error
	CAIN	S1,D6EOF		;Was it EOF error?
	$RETF				;Yes, return failure so higher level
					;  detects the EOF
	$RETIT				;If good error, just return

	$CALL	KILL			;Kill this, and don't return on T20
TOPS10<
	TXZ	FLAG,JOBCD		;Don't care if we have a job since
					;   we can't continue...
					;   This forces the shutdown!
	SETOM	.RDSTS(RDR)		;Say we want status update
	$DSCHD	(1)			;NOW and we shouldn't return
> ; End of TOPS10


TOPS20 <
GETE.6:	MOVE	S1,.RDSTP(RDR)		;GET THE LAST ERROR CODE
	$RETT				;AND RETURN
> ;End of TOPS20

GTJF.6:	$CALL D60SU			;Initialize the counts
	SETZM	JOBSTW(STREAM)		;Clear the status entry
	MOVEI	S1,ERTCNT		;GET ERROR THRESHHOLD COUNT
	MOVEM	S1,.RDECT(RDR)		;SET IT
	SETZM	S1			;NO JFN FOR DN60
	$RETT				;RETURN OK

CLOS.6:	MOVEI	S1,20			;Get a threshold for closing
					;  to force the end of this code
	MOVEM	S1,.RTNBR(RDR)		;  in our lifetime
	SKIPG	S1,.RDCHN(RDR)		;GET JUST THE JFN
	JRST	CLO6.1			;No handle to release
	$CALL	D60RLS##		;Try to release
	JUMPF	[$D60ER(ERCRR)		;Process the error
		JUMPT	CLOS.6		;If good error try again
		JRST	CLO6.1]		;Otherwise continue still bad
CLO6.1:	SKIPG	S1,.RDN60(RDR)		;Get the console handle
	JRST	CLO6.2			;No handle to release
	$CALL	D60RLS##		;Try to release
	JUMPF	[$D60ER(ERCRC)		;Process the error
		JUMPT	CLO6.1		;If good error try again
		JRST	CLO6.2]		;Otherwise continue still bad
CLO6.2:	MOVEI	S1,.RDSUP(RDR)		;Get address of setup message
	MOVE	S1,SUP.CN(S1)		;Get Port,,Line
	$CALL	D60DIS##		;Disable the line
	JUMPF	[$D60ER(ERCDL)		;Process the error
		JUMPT	CLO6.2		;Go try again
		JRST	CLO6.3]		;otherwise continue still bad
CLO6.3:	$RETT				;AND RETURN


KILL:	$CALL CLOS.6			;Close things down

TOPS10<	SETOM	.RDSHT(RDR)		;Tell main loop we are closing down
	$RETF
> ; End of TOPS10

TOPS20<	HALTF>
	SUBTTL	D60SU - DN60 success routine to fix counts

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

; Parameters:	RDR / Address of current jobpage

D60SU:	$SAVE	<S1>			;Save some registers
	MOVEI	S1,NENBR		;# of allowed NBR errors
	MOVEM	S1,.RTNBR(RDR)		;Initialize counter
	MOVEI	S1,NEDOL		;# of allowed DOL errors
	MOVEM	S1,.RTDOL(RDR)		;Initialize counter
	SKIPN	.RDOFL(RDR)		;Were we offline before this?
	$RETT				;No - just return
	SETZM	.RDOFL(RDR)		;Clear off-line flag
	SETOM	.RDSTS(RDR)		;say we want status update
	$RETT				;Return
	SUBTTL	D60ER - Process DN60 errors
; The purpose of this routine is to process DN60 errors that deal with
; LPT device (operator console are processed as part of the routine
; OPRCHK).  The following actions are taken:

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

; -- Bad error --

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

; Parameters:

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

;	Called by $D60ER macro

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

;Save the error code

D60ER:	MOVEM	S1,.RDLER(RDR)

;NBR error?

	CAIE	S1,D6NBR		;Non-blocking return?
	JRST	D60E.0			;no, go process other
	TXNN	FLAG,JOBCD		;Are we in a job?
	JRST	D60E.7			;No - quit, ignoring the error
	SOSG	.RTNBR(RDR)		;Out of errors?
	JRST	D60E.4			;Yes - process bad error
	$DSCHD	(SHSLPT)		;Do a short sleep
	JRST	D60E.8			;Return good with no further sleeping

;DOL error?

D60E.0:	CAIE	S1,D6DOL		;Device off-line error?
	JRST	D60E.1			;no - go try something else
	SOSLE	.RTDOL(RDR)		;Out of errors?
	JRST	D60E.7			;No - quit good

;EOF error?

D60E.1:	CAIE	S1,D6EOF		;EOF?
	JRST	D60E.3			;No, go try something else
D60E.2:	MOVX	TF,IOX4			;Get EOF error code
	MOVEM	TF,.RDSTP(RDR)		;Save it for later
	JRST	D60E.8			;Quit good without wait

;Abort error?

D60E.3:	CAIE	S1,D6IAB		;Abort error?
	JRST	D60E.4			;No, go process bad
	TXO	FLAG,ABORT		;Set the abort flag
	JRST	D60E.2			;Go set EOF and continue

;Bad error

D60E.4:	SETOM	.RDSTS(RDR)		;Say we want status update
	SETOM	.RDOFL(RDR)		;Say offline

	MOVEM	T1,EMSG			;Save T1 a second
	HRRZ	T1,@0(P)		;Get error message address
	SKIPN	T1			;Want error message output?
	JRST	[MOVE	T1,EMSG		;No - Restore T1
		JRST	D60E.6]		;and return
	EXCH	T1,EMSG			;Save error message
	$SAVE	<S2,T1>			;Get a couple free registers
	MOVE	T1,EMSG			;Get error message again
	CAIE	T1,ERIDE		;Is it an error during input?
	JRST	D60E.5			;No, skip the ORION message

;  Since we have fatal error, tell ORION so that further errors go to
;  all operators

	MOVE	S1,.RDSTR(RDR)		;Get our stream number
	MOVE	S1,JOBOBA(S1)		;Get the object block
	MOVE	S1,OBJ.ND(S1)		;Get the node name
	MOVEM	S1,NWAMSG+.OHDRS+ARG.DA+OBJ.ND ;Save the node name/number
	MOVEI	S1,NWAMSG		;Get the message address
	MOVEI	S2,.OHDRS+ARG.DA+OBJ.SZ	;Get the message length
	$CALL	SNDOPR			;Send it off
	MOVE	S1,.RDLER(RDR)		;Get back the error

D60E.5:	SUBI	S1,$ER1ST		;Set DN60 error message
	$WTO	(<^T/0(T1)/>,<^T/@D60TXT(S1)/>,@JOBOBA(STREAM)) ;Yes tell opr
	SETOM	.RDSTP(RDR)		;Generate no further error message
D60E.6:	$RETF

D60E.7:	$DSCHD (LGSLPT)			;Quit for awhile
D60E.8:	$RETT				;Return true
;DN60 LINE CONDITIONING AND DEVICE OPENING ROUTINE
;	T2 is set early and is used as index into JOBOBA

;Condition the line
OPEN.6:	SETOM	.RDCHN(RDR)		;NO CHANNEL YET
	SETOM	.RDN60(RDR)		;NO OPR CONSOLE YET
	MOVE	T2,.RDSTR(RDR)		;GET OUR STREAM NUMBER
	MOVEI	S1,.RDSUP(RDR)		;POINT TO OUR SETUP MESSAGE
	PUSHJ	P,D60CND##		;CONDITION THE FRONT END 
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes, do it
	JUMPT	[$CALL	D60SU		;process good
		JRST	OPN.6A]		;Go continue
	CAIN	S1,D6SON		;Is this just a bad signon card?
	JRST	[$CALL	CLO6.2		;Yes, disable the line
		JRST	OPEN.6]		;and go try again
	$D60ER	(ERCFE)			;Go process the error
	JUMPF	KILL			;Quit if bad error
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes -- quit
	JRST	OPEN.6			;Go try again

;Set up line data base info
OPN.6A:	MOVE	S2,JOBOBA(T2)		;GET OUT OBJECT BLOCK ADDRESS
	EXCH	S1,OBJ.ND(S2)		;Save the actual node name,
					;  (returned by D60CND)
					;  get the proto node name
	MOVEM	S1,.RDPNN(RDR)		;Save the proto node name
					;  in proto location till
					;  response to setup
	MOVE	S1,OBJ.UN(S2)		;GET OUR UNIT NUMBER
	STORE	S1,.RDOPB(RDR),OP$UNT	;SAVE THE UNIT NUMBER IN OPEN BLOCK
	$CALL	CHKNOD			;Check out the signing on node
					;name
	JUMPF	KILL			;Bad news
	MOVX	S1,.OPCDR		;WANT 'CDR' DEVICE
	STORE	S1,.RDOPB(RDR),OP$TYP	;SAVE THE DEVICE TYPE IN THE OPEN BLOCK
	LOAD	S1,.RDSUP+SUP.CN(RDR),CN$PRT	;GET THE PORT NUMBER
	STORE	S1,.RDOPB(RDR),OP$PRT	;SAVE IT IN THE OPEN BLOCK
	LOAD	S1,.RDSUP+SUP.CN(RDR),CN$LIN	;GET THE LINE NUMBER
	STORE	S1,.RDOPB(RDR),OP$LIN	;SAVE IT IN THE OPEN BLOCK
	LOAD	S1,.RDSUP+SUP.CN(RDR),CN$SIG	;GET THE LINE SIGNATURE
	STORE	S1,.RDOPB(RDR),OP$SIG	;SAVE IT IN THE OPEN BLOCK

;Open the remote "card reader"

OPN.6B:	HRROI	S1,-OP$SIZ		;GET THE NEGATIVE BLOCK LENGTH
	MOVEI	S2,.RDOPB(RDR)		;GET THE PARM BLOCK ADDRESS
	PUSHJ	P,D60OPN##		;OPEN THE READER
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes, do it
	JUMPT	[$CALL	D60SU		;process good
		JRST	OPN.6C]		;Go continue
	$D60ER	(ERO6R)			;Go process the error
	JUMPF	KILL			;Quit if bad error
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes -- quit
	JRST	OPN.6B			;Go try again

;Open succeeded, clean-up

OPN.6C:	MOVEM	S1,.RDCHN(RDR)		;SAVE THE CDR HANDLE
	SETZM	.RDCPT(RDR)		;Default is no hasp
	LOAD	S1,.RDFLG(RDR),NT.TYP	;GET THE REMOTE TYPE
	CAXE	S1,DF.HSP		;IS IT HASP ???
	JRST	OPN.6E			;Go clean up

;We have a HASP line, need to open the operator console
	HRLZI	S1,.OPCIN		;YES,,GET OPR CONSOLE ID
	STORE	S1,.RDOPB(RDR),OP$DEV	;SAVE IT IN THE OPEN BLOCK
OPN.6D:	HRROI	S1,-OP$SIZ		;GET THE NEGATIVE BLOCK LENGTH
	MOVEI	S2,.RDOPB(RDR)		;GET THE BLOCK ADDRESS
	PUSHJ	P,D60OPN##		;OPEN THE OPERATORS CONSOLE
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes, do it
	JUMPT	[$CALL	D60SU		;process good
		MOVEM	S1,.RDN60(RDR)	;Save OPR console handle
		MOVE	S1,[POINT 7,0]	;Pointer to begin. of in buff.
		HRRI	S1,.RDCMD(RDR)	;Make pointer absolute
		MOVEM	S1,.RDCPT(RDR)	;Save it
		MOVE	S1,[EXP -CMDLN*5];Get -length of buffer in bytes
		MOVEM	S1,.RDCCT(RDR)	;Save it
		JRST	OPN.6E]		;Go clean-up and return
	$D60ER	(EROHC)			;Go process the error
	JUMPF	KILL			;Quit if bad error
	SKIPE	.RDSHT(RDR)		;Shutdown?
	JRST	KILL			;Yes -- quit
	JRST	OPN.6D			;Go try again

OPN.6E:	SETOM	.RDSTS(RDR)		;Cause a status message to be sent
	$RETT				;Return true
	SUBTTL	CHKNOD - Routine to check for duplicate node names

;The purpose of this routine is to check for duplicate node names.
;This can happen particularly in IBMCOM if the same node tries to sign
;on twice to two different prototype nodes (different port,line #).
;The mechanism is to check the other objects in CDRIVE's data base to
;determine if this is a node that already exists and if so, disallow
;this one.  This code makes some assumptions.  If more than one CDRIVE
;process exists, this will not catch the problem because objects
;signed on the other node are unknown.  On the 20, due to
;multiforking, if both forks with the same node name try to signon
;simultaneously there is a possible race where this test will fail
;because of how the node names are stored in the data base (see
;FIXPRO).  In either of these cases, the error will at least be
;detected by QUASAR.

;Call:	S2 / Address of the object block being examined
;Returns:
;	FALSE if duplicate exists after notifying operator.

CHKNOD:	$SAVE	P1			;Get a work ac
	MOVE	S2,OBJ.ND(S2)		;Get the actual node name
					;signing on
	MOVSI	P1,-MAXRDR		;Prepare to loop through the
					;objects
CHKN.1:	HRRZ	S1,P1			;Get stream being examined
	CAMN	S1,STREAM		;Is it our current?
	JRST	CHKN.5			;Yes, skip this
	SKIPN	S1,JOBOBA(P1)		;Things set up?
	JRST	CHKN.5			;No, skip this one
	MOVE	S1,OBJ.ND(S1)		;Get this one's node name
	CAMN	S1,S2			;Is it equal to the new one?
	JRST	CHKN.6			;Yes, trouble in river city

CHKN.5:	AOBJN	P1,CHKN.1		;Go for another
	$RETT				;Made it this far, everything
					;must be O.K.

;Here if duplicate node names, send nasty message and return false.

CHKN.6:	$WTO	(<Refusing signon>,<Node ^N/S2/ tried to signon twice>)
	SETOM	.RDSTP(RDR)		;Generate no further error
					;messages
	$RETF				;Quit bad
	;ROUTINE TO READ THE HASP OPERATORS CONSOLE

TOPS20 <
REPEAT 0,<
GETHSP:	SKIPG	S1,.RDN60(RDR)		;IS THERE A OPR CONSOLE CHANNEL
	$RETT				;NO,,RETURN NOW
	MOVE	S2,[POINT 7,.CARDS(RDR)] ;GET THE INPUT BUFFER BYTE POINTER
	HRROI	T1,-^D140		 ;GET A LARGE BYTE COUNT
	PUSHJ	P,D60SIN##		 ;READ THE HASP OPERATORS CONSOLE
	SKIPF				 ;IF THE READ FAILED
	CAMN	S2,[POINT 7,.CARDS(RDR)] ;   OR NO DATA WAS READ
	$RETT				 ;       THEN JUST RETURN
	MOVE	S1,[POINT 7,.CARDS(RDR)] ;GET OUR INPUT BYTE POINTER BACK
	PUSHJ	P,OPRCMD		 ;GO PROCESS THE OPERATOR COMMAND
	$RETT				;AND RETURN
> ;End of REPEAT 0
> ;End of TOPS20
> ;End of IFN FTDN60

IFE FTDN60,<
GETE.6:
SIN.6:
OPEN.6:
GTJF.6:
CLOS.6:
GETHSP:
	MOVX	S1,DIAGX8		;GET 'DEVICE DOES NOT EXIST'
	MOVEM	S1,.RDSTP(RDR)		;SAVE IT
	MOVE	S1,.RDSTR(RDR)		;GET OUR STREAM NUMBER
	$WTO	(DN60 Type Remote not Supported,,@JOBOBA(S1)) ;TELL OPERATOR
TOPS20<	HALTF >				;AND END IT HERE !!!
TOPS10<	$RETF >				;RETURN FALSE
>

	SUBTTL	READER - ROUTINE TO PROCESS THE INPUT CARDS.

READER:	SKIPN	.RDNBR(RDR)		;ARE THERE ANY CARDS THERE ???
	JRST	READ.4			;NO,,JUST RETURN
	PUSHJ	P,.SAVE1		;YES,,SAVE P1
	HRLZ	P1,.RDOBZ(RDR)		;GET THE CORRECT BYTE SIZE
	LSH	P1,6			;POSITION SIZE FOR BYTE POINTER
	ADD	P1,[POINT 0,.CARDS(RDR)] ;COMBINE THE BYTE PTR & BYTE SIZE
	MOVEM	P1,.RDIPT(RDR)		;SAVE IT THE FIRST TIME THROUTH
READ.2:	GETBYT	S1,P1			;GET A BYTE
	HRRI	S2,@P1			;GET THE CARD STARTING ADDRESS
	MOVEM	S2,.RDCAD(RDR)		;SAVE IT FOR LATER
	CAMN	S1,$IMAGE(AP)		;IS IT A $ SIGN ???
	JRST	$CARD			;YES,,GO PROCESS IT
	CAMN	S1,ENDIMG(AP)		;IS IT AN EOF CARD ???
	JRST	ENDCRD			;YES,,GO PROCESS IT.
	TXNN	FLAG,JOBCD		;IS THERE A JOB SETUP ???
	JRST	REJECT			;NO,,REJECT THE CARD.
	PUSHJ	P,OUTCRD		;ELSE PUT OUT THE CARD.
READ.3:	MOVE	S1,.RDRCL(RDR)		;GET THE RECORD LENGTH IN BYTES

;	ADJBP	S1,.RDIPT(RDR)		;POINT TO THE NEXT CARD -- KL/KS only

;  The following two lines replace the previous line so CDRIVE is transportable.

	MOVE	S2,.RDIPT(RDR)		;Get the pointer
	$CALL	PADJBP			;Do the ADJBP

	MOVE	P1,S1			;Put result in the right place
	MOVEM	P1,.RDIPT(RDR)		;SAVE THE POINTER FOR LATER
	SOSLE	.RDNBR(RDR)		;SUB 1 FROM CARD COUNT
	JRST	READ.2			;MORE,,CONTINUE
READ.4:	SETZM	.RDNBR(RDR)		;ZERO THE NUMBER OF CARDS COUNTER
	HRLZ	S1,.RDOBZ(RDR)		;GET THE OUTPUT BYTE SIZE
	LSH	S1,6			;POSITION IT
	ADD	S1,[POINT 0,.CARDS(RDR)] ;MAKE IT A BYTE POINTER
	MOVEM	S1,.RDOPT(RDR)		;AND SAVE IT
	$RETT				;RETURN.
	SUBTTL	PADJBP -- Positive ADJBP

COMMENT \
	This routine fakes the ADJBP instruction for use in programs
  that must be run on a KI but only if the adjustment is positive.
  The other type could be added later.  S1 is to contain the adjustment
  and S2 is to contain the pointer to be adjusted.

		Returns false if the adjustment is invalid (negative)
	otherwise returns the adjusted pointer in S1 with S2 undefined.
\

	MSKSTR	(BYSIZE,,77B11)

PADJBP:	SKIPGE	S1			;Legit adjustment?
	$RETF				;No

	$SAVE	<P1,P2>		;Save work ac's
	LOAD	P2,S2,BYSIZE		;Get the bytesize
	MOVEI	P1,^D36			;Number of bits /word
	IDIV	P1,P2			;Get # of bytes /word
	MOVE	P2,S2			;save the pointer a sec.
	IDIV	S1,P1			;Calc the # of words to adjust
					;  Remainder in S2 (Bytes to adjust)
	ADD	S1,P2			;Add ptr to the # of words to adjust
	JUMPE	S2,PADJ.1			;jump if no bytes to adjust

PADJ.0:	IBP	S1			;Incremental adjustment
	SOJG	S2,PADJ.0		;Check to do again

PADJ.1:	$RETT

	SUBTTL	$CARD - ROUTINE TO PROCESS $ CARDS

$CARD:	GETBYT	S1,P1			;GET A BYTE
	CAME	S1,JIMGUC(AP)		;IS IT A 'J' ??
	CAMN	S1,JIMGLC(AP)		;IS IT 'j' ???
	JRST	JOBCRD			;YES TO EITHER,,PROCESS JOB CARD.
	CAME	S1,EIMGUC(AP)		;IS IT A 'E' ???
	CAMN	S1,EIMGLC(AP)		;IS IT A 'e' ???
	JRST	EOJCRD			;YES TO EITHER,,PROCESS EOJ CARD.
	CAME	S1,SIMGUC(AP)		;IS IT A 'S' ??
	CAMN	S1,SIMGLC(AP)		;IS IT 's' ???
	JRST	SITCRD			;YES TO EITHER,,PROCESS STIGO CARD.
	CAMN	S1,$IMAGE(AP)		;IS IT A COMMAND ??? ($$??)
	JRST	COMMAND			;YES,,GO PROCESS IT.
$CARD1:	TXNN	FLAG,JOBCD		;IS THERE A JOB SETUP ???
	JRST	REJECT			;NO,,REJECT IT.
$CARD2:	PUSHJ	P,OUTCRD		;ELSE WRITE IT OUT
	JRST	READ.3			;AND CONTINUE

REJECT:	TXZN	FLAG,EOF		;REJECTING AN EOF GENERATED CARD ???
	JRST	JOBC.2			;No, Go set up the fake job for rejects
	JRST	READ.3			;AND GO PROCESS IT.

	SUBTTL	JOBCRD - ROUTINE TO PROCESS A JOB CARD.

JOBCRD:	GETBYT	S1,P1			;GET A BYTE.
	CAME	S1,OIMGUC(AP)		;IS IT A 'O' ???
	CAMN	S1,OIMGLC(AP)		;IS IT A 'o' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD1			;Let SPRINT handle it
	GETBYT	S1,P1			;GET THE NEXT BYTE.
	CAME	S1,BIMGUC(AP)		;IS IT A 'B' ???
	CAMN	S1,BIMGLC(AP)		;IS IT A 'b' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD1			;Let SPRINT handle it
JOBC.1:	GETBYT	S1,P1			;GET THE NEXT BYTE.
	CAME	S1,BLANK(AP)		;IS IT A BLANK ???
	JRST	$CARD1			;No, let SPRINT handle it
	AOS	.RDJBC(RDR)		;BUMP JOB COUNT BY 1.
JOBC.2:	TXNE	FLAG,JOBCD		;IS THE JOBCARD BIT ON ???
	PUSHJ	P,CREATE		;GO SEND CREATE MSG FOR THE LAST JOB.
	TXO	FLAG,JOBCD		;TURN ON THE JOB CARD BIT.
	MOVEM	FLAG,FLAG+.RDREG(RDR)	;Make sure we let everyone know
	SETOM	.RDSTS(RDR)		;Say we want status update
	MOVEI	S1,ERTCNT		;GET AN ERROR COUNT OF 4
	MOVEM	S1,.RDECT(RDR)		;SAVE IT FOR LATER
	PUSHJ	P,I%NOW			;GET THE TIME.
	MOVEM	S1,.RDTIM(RDR)		;SAVE AS JOB START TIME
	MOVE	S1,.RDSTR(RDR)		;GET THE STREAM NUMBER
	PUSHJ	P,GETFIL		;GO SETUP THE OUTPUT SPOOL FILE
	JRST	$CARD2			;Go put it out

	SUBTTL	EOJCRD - ROUTINE TO PROCESS $EOJ CARDS.

EOJCRD:	TXNN	FLAG,JOBCD		;IS THERE A JOB SETUP ???
	JRST	REJECT			;NO,,REJECT THIS CARD.
	GETBYT	S1,P1			;GET THE NEXT BYTE
	CAME	S1,OIMGUC(AP)		;IS IT A 'O' ???
	CAMN	S1,OIMGLC(AP)		;IS IT A 'o' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD2			;Dump the card out and continue
	GETBYT	S1,P1			;GET THE NEXT BYTE.
	CAME	S1,JIMGUC(AP)		;IS IT A 'J' ???
	CAMN	S1,JIMGLC(AP)		;IS IT A 'j' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD2			;Dump the card out and continue
	GETBYT	S1,P1			;GET THE NEXT BYTE
	CAME	S1,BLANK(AP)		;IS IT A BLANK ???
	JRST	$CARD2			;No, dump the card out and continue
	AOS	.RDEOJ(RDR)		;BUMP END OF JOB COUNT BY 1
	PUSHJ	P,OUTCRD		;PUT IT OUT
	PUSHJ	P,CREATE		;SEND THE CREATE MSG OFF
	JRST	READ.3			;AND CONTINUE PROCESSING
	SUBTTL	SITCRD - ROUTINE TO PROCESS $SITGO CARDS.


SITCRD:	GETBYT	S1,P1			;GET A BYTE.
	CAME	S1,IIMGUC(AP)		;IS IT A 'I' ???
	CAMN	S1,IIMGLC(AP)		;IS IT A 'i' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD1			;Let SPRINT handle it
	GETBYT	S1,P1			;GET A BYTE.
	CAME	S1,TIMGUC(AP)		;IS IT A 'T' ???
	CAMN	S1,TIMGLC(AP)		;IS IT A 't' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD1			;Let SPRINT handle it
	GETBYT	S1,P1			;GET A BYTE.
	CAME	S1,GIMGUC(AP)		;IS IT A 'G' ???
	CAMN	S1,GIMGLC(AP)		;IS IT A 'g' ???
	SKIPA				;YES,,KEEP ON GOING
	JRST	$CARD1			;Let SPRINT handle it
	GETBYT	S1,P1			;GET A BYTE.
	CAME	S1,OIMGUC(AP)		;IS IT A 'O' ???
	CAMN	S1,OIMGLC(AP)		;IS IT A 'o' ???
	JRST	JOBC.1			;ALL'S WELL - ENTER $JOB CARD CODE
	JRST	$CARD1			;Let SPRINT handle it
	SUBTTL	ENDCRD - ROUTINE TO PROCESS END-OF-FILE CARDS

ENDCRD:	AOS	.RDEND(RDR)		;BUMP END CARD COUNT BY 1
	TXNN	FLAG,JOBCD		;IS THERE A JOB SETUP ???
	JRST	REJECT			;NO,,REJECT THIS CARD
	PUSHJ	P,CREATE		;GO SEND A CREATE MSG
	JRST	READ.3			;AND GO GET THE NEXT CARD






	SUBTTL	COMMAND - ROUTINE TO PROCESS THE $$ COMMAND FOR OPR

COMMAND: TXNE	FLAG,JOBCD		;ARE WE IN A JOB ???
	JRST	$CARD2			;Yes, just output the card
	SKIPG	.RDREM(RDR)		;IS THIS A DN60 REMOTE STATION ???
	JRST	$CARD1			;No, let SPRINT handle it
	MOVE	S1,P1			;GET THE CARD BYTE POINTER
	PUSHJ	P,OPRCMD		;GO PROCESS THE CARD
	JRST	READ.3			;AND CONTINUE ON
	SUBTTL	I60OPR	Routine to get operator messages

;  The purpose of this routine is to get any characters that are available
;  from the console device.  If during this process, a LF is found, then
;  the record is sent to OPRCMD to be processed.  At the end of the processing
;  the record is shifted so the next command is always at the beginning
;  of the buffer.

;	Note:  This routine saves all acs.

IFN FTDN60,<

I60OPR:	$SAVE	<S1,S2,T1,T2>		;Save everything
	MOVE	S1,.RDN60(RDR)		;Get handle of console
	MOVE	S2,.RDCPT(RDR)		;Get console pointer
	MOVE	T1,.RDCCT(RDR)		;Get console byte count
	$CALL	D60SIN			;Get some console stuff
	JUMPT	I60.1			;Go process characters
	CAIN	S1,D6NBR		;Is it a NBR return?
	JRST	I60.1			;Yes - Don't care about DN60 errors
	CAIN	S1,D6IAB		;Is it aborted?
	JRST	[MOVE	S1,[POINT 7,0]	;Yes, reset the buffers
					;Pointer to begin. of in buff.
		HRRI	S1,.RDCMD(RDR)	;Make pointer absolute
		MOVEM	S1,.RDCPT(RDR)	;Save it
		MOVE	S1,[EXP -CMDLN*5];Get -length of buffer in bytes
		MOVEM	S1,.RDCCT(RDR)	;Save it
		JRST 	I60.6]		;Go to return
	$D60ER	(ERCDE)			;Go process errors
	SKIPF				;Bad error?
	SETZM	.RDSTP(RDR)		;No, clear the error
I60.1:	CAMN	S2,.RDCPT(RDR)		;Checking pointers - Any chars?
	JRST	I60.4			;No - go to return
	ILDB	T2,.RDCPT(RDR)		;Get the next byte
	CAIE	T2,12			;Do we have a line feed?
	JRST	I60.1			;No - Go try to get another
	PUSH	P,S2			;Save S2 a sec.
	MOVE	S1,[POINT 7,0]		;Point to begin of buffer
	HRRI	S1,.RDCMD(RDR)		;Make pointer absolute
	$CALL	OPRCMD			;Process the operator message
	POP	P,S2			;Restore S2

;  Now need to move the remaining characters to the beginning of the
;  buffer, adjusting pointers and count along the way.

	MOVNI	T1,CMDLN*5		;assume we can fill entire buffer
	MOVE	S1,[POINT 7,0]		;Point to begin of buffer
	HRRI	S1,.RDCMD(RDR)		;Make pointer absolute
I60.2:	CAMN	S2,.RDCPT(RDR)		;Are the pointers alike (finished?)
	JRST	I60.3			;Yes, go to return
	ILDB	T2,.RDCPT(RDR)		;Get the next byte
	IDPB	T2,S1			;Save the next byte
	AOS	T1			;Adjust the count by decrementing
					; (negative count) for every character
					; still in buffer (i.e. moved down).
	JRST	I60.2			;Loop on more characters

;End of loop, clean up by updating the pointers.

I60.3:	MOVE	S2,S1			;Save the new local pointer
	MOVE	S1,[POINT 7,0]		;Get the new old pointer
	HRRI	S1,.RDCMD(RDR)		;Make pointer absolute
	MOVEM	S1,.RDCPT(RDR)		;Save it
	JRST	I60.1			;Go see if any more chars or commands.

I60.4:	JUMPL	T1,I60.5		;if we have a good count, exit
	MOVNI	T1,CMDLN*5		;else reset count
	MOVE	S1,[POINT 7,0]		; and byte
	HRRI	S1,.RDCMD(RDR)		;  counter
	MOVEM	S1,.RDCPT(RDR)		;this throws away crufty (too long) message
I60.5:	MOVEM	T1,.RDCCT(RDR)		;Save the new count
I60.6:	$RET
	SUBTTL	OPRCMD - ROUTINE TO GENERATE AN OPR COMMAND MESSAGE

	;CALL:	S1/ Byte Pointer to the Operator message terminated by a CRLF
	;
	;RET:	True Always

OPRCMD:	$SAVE	<T1,P1,P2>		;Need to save T1 also due to
					;fear of the unknown
	STKVAR	<BEGMSG>		;To save beginning of message
					;to calculate length later
	MOVE	P1,S1			;SAVE THE INPUT BYTE POINTER ALSO
	PUSHJ	P,M%GPAG		;GET A PAGE FOR THE MESSAGE
	MOVEM	S1,BEGMSG		;Save the beginning of msg.
	MOVE	P2,S1			;HERE ALSO

;  Build the header of the message

	MOVX	S1,.OMD60		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(P2),MS.TYP	;SAVE IT IN THE MESSAGE
	MOVEI	S1,3			;GET THE ARGUMENT BLOCK COUNT
	MOVEM	S1,.OARGC(P2)		;SAVE IT IN THE MESSAGE

;  Build the first argument block  (Node block for QUASAR validation)

	MOVEI	P2,.OHDRS(P2)		;GET THE FIRST BLOCK ADDRESS
	MOVE	S1,[2,,.ORNOD]		;GET THE FIRST BLOCK HEADER
	MOVEM	S1,ARG.HD(P2)		;SAVE IT IN THE MESSAGE
	MOVE	S1,.RDSTR(RDR)		;GET OUR STREAM NUMBER
	MOVE	S1,JOBOBA(S1)		;GET OUR OBJECT BLOCK ADDRESS
	MOVE	S1,OBJ.ND(S1)		;GET OUR NODE NAME IN SIXBIT
	MOVEM	S1,ARG.DA(P2)		;SAVE IT IN THE MESSAGE

;  Build the second argument block  (DN60 block of data)

	ADDI	P2,2			;POINT TO THE NEXT BLOCK
	MOVE	S1,[3,,.ORD60]		;GET THE NEXT BLOCK HEADER
	MOVEM	S1,ARG.HD(P2)		;SAVE IT IN THE MESSAGE
	LOAD	S1,.RDSUP+SUP.CN(RDR),CN$PRT	;GET THE PORT NUMBER
	HRLM	S1,ARG.DA(P2)		;SAVE IT IN THE MSG DATA BLOCK
	LOAD	S1,.RDSUP+SUP.CN(RDR),CN$LIN	;GET THE LINE NUMBER
	HRRM	S1,ARG.DA(P2)		;SAVE IT IN THE MSG DATA BLOCK
	LOAD	S1,.RDFLG(RDR)		;GET THE FLAG BITS
	MOVEM	S1,ARG.DA+1(RDR)	;SAVE IT IN THE MSG DATA BLOCK

;  Build the third argument block (text argument)

	ADDI	P2,3			;POINT TO THE NEXT BLOCK
	MOVX	S1,.CMTXT		;GET THE BLOCK TYPE
	MOVEM	S1,ARG.HD(P2)		;SAVE IT IN THE MESSAGE
	MOVE	S1,[POINT 7,ARG.DA(P2)]	;GET THE OUTPUT BYTE POINTER
	SETZM	T1			;Have found no trailing spaces
					;so far

OPRC.1:	ILDB	S2,P1			;GET A TEXT BYTE
	CAIN	S2,40			;Is is a space?
	JRST	[SKIPN	T1		;Yes, have trailing one set?
		MOVE	T1,S1		;No, set it here
		JRST	OPRC.2]		;Continue on
	CAIN	S2,15			;Is is a carriage return?
	JRST	OPRC.3			;Yes, get out of loop and
					;complete argument
	SETZM	T1			;Set have no trailing spaces
OPRC.2:	IDPB	S2,S1			;Save the byte in the message
	JRST	OPRC.1			;Go for the next one

OPRC.3:	SKIPE	T1			;Any set trailing space?
	MOVE	S1,T1			;Yes, set for it
	IDPB	S2,S1			;Save the carriage return
	ILDB	S2,P1			;Get the line feed that should
					;be there
	IDPB	S2,S1			;Save the line feed

;  Now calculate the lengths for both the total message and for the
;  text argument portion of the message.

	MOVEI	S1,@S1			;GET THE ENDING ADDRESS
	MOVE	S2,BEGMSG		;Get starting address of message
	SUBI	S1,-1(S2)		;CALC THE TOTAL MESSAGE LENGTH
	STORE	S1,.MSTYP(S2),MS.CNT	;SAVE THE MESSAGE LENGTH
	SUBI	S1,^D10			;CALC THE LENGTH OF THE TEXT BLOCK
	STORE	S1,ARG.HD+^D10(S2),AR.LEN ;SAVE IT IN THE MESSAGE

;  Send a IBMCOM stats message if needed

IFN FTIBMS,<
	MOVEI	S1,%TCNI		;Get the stats code for
					;console message
	$CALL	IBMSTS			;Tell QUASAR
	MOVE	S2,BEGMSG		;Restore S2
> ; End of FTIBMS

;  Send the message

	LOAD	S1,.MSTYP(S2),MS.CNT	;GET THE MESSAGE LENGTH IN S1
	EXCH	S1,S2			;GET ADDRESS IN S1 AND LENGTH IN S2
	PUSHJ	P,SNDOPR		;SEND THE MESSAGE OFF
	$RETT				;AND RETURN
> ;END DN60 CONDITIONAL

IFE FTDN60,<
OPRCMD:	$RETT >				;JUST RETURN

	SUBTTL	GETFIL - ROUTINE TO CREATE AN OUTPUT SPOOL FILE

GETFIL:	PUSHJ	P,GENFIL		;GO GENERATE THE SPOOL FILENAME
	MOVEI	S1,2			;GET FOB SIZE
	MOVEI	S2,.RDFOB(RDR)		;GET FOB ADDRESS
	PUSHJ	P,F%OOPN		;OPEN THE SPOOL FILE
	JUMPT	GETF.1			;IF OK,,CONTINUE ON
	CAIE	S1,ERFAE$		;IS THE ERROR 'FILE-ALREADY-EXISTS' ?
	STOPCD	(COS,HALT,,<Cannot open spool file>) ;NO,,THEN ITS A FATAL ERROR
	MOVE	S1,FILENM		;GET THE FILE NAME HASH CODE
	ANDI	S1,FILEMK		;GET THE GOOD PART
	CAIG	S1,17500		;IS IT LESS THEN 8000 (DECIMAL) ??
	JRST	GETFIL			;YES,,TRY THE NEXT FILE NAME
	SETZM	FILENM			;CREATE A NEW HASH CODE
	AOS	FILEXT			;AND A NEW EXTENSION
	JRST	GETF.1			;AND TRY AGAIN
GETF.1:	MOVEM	S1,.RDIFN(RDR)		;SAVE THE IFN
	$RETT				;AND RETURN

	SUBTTL	OUTCRD - ROUTINE TO OUTPUT A CARD.

OUTCRD:	AOS	.RDJBT(RDR)		;BUMP JOB CARD COUNT BY 1
	SKIPLE	.RDREM(RDR)		;IS IT LOCAL OR DN200 ???
	JRST	OUTD60			;NO,,MUST BE DN60 !!!
	MOVE	S1,.RDIFN(RDR)		;GET THE SPOOL FILE IFN
	HRL	S2,.RDRCL(RDR)		;GET THE RECORD LENGTH
	HRR	S2,.RDCAD(RDR)		;GET THE CARD ADDRESS.
	PUSHJ	P,F%OBUF		;WRITE OUT THE CARD
	JUMPT	.RETT			;IF OK,,RETURN
	STOPCD	(EWS,HALT,,<Error writing spool file>)

OUTD60:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A MINUTE
	MOVE	P1,.RDIPT(RDR)		;GET THE RECORD POINTER
	MOVE	P2,.RDRCL(RDR)		;GET THE RECORD LENGTH IN BYTES
OUTD.1:	MOVE	S1,.RDIFN(RDR)		;GET THE SPOOL FILE IFN
	ILDB	S2,P1			;GET A BYTE
	PUSHJ	P,F%OBYT		;PUT IT OUT
	JUMPF	S..EWS			;CANT,,FORGET IT !!!
	SOJG	P2,OUTD.1		;CONTINUE TILL DONE
	$RETT				;AND RETURN

	SUBTTL	CREATE - ROUTINE TO GENERATE A CREATE MESSAGE FOR QUASAR

CREATE:
IFN FTDN60,<
	TXNN	FLAG,ABORT		;Aborting?
	JRST	CREA.1			;No, continue on
	$CALL	IBMABO			;Yes, go process it
	$RETT
CREA.1:
> ; End of FTDN60
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	PUSHJ	P,M%ACQP		;ACQUIRE PAGE FOR MESSAGE TO QUASAR
	PG2ADR	S1			;CONVERT PAGE NUMBER TO ADDRESS
	MOVEM	S1,P1			;SAVE IN MES (AC FOR EQ ENTRY)

	MOVEI	S1,<EQHSIZ+FPMSIZ+FDSIZE> ;SIZE OF FULL MESSAGE
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IN HEADER FOR SIZE
	MOVEI	S1,.QOCRE		;CREATE INDICATOR TYPE
	STORE	S1,.MSTYP(P1),MS.TYP	;PLACE TYPE IN HEADER
	MOVEI	S1,%%.QSR		;QUASAR VERSION NUMBER
	STORE	S1,.EQLEN(P1),EQ.VRS	;SAVE VERSION NUMBER IN EQ
	MOVEI	S1,EQHSIZ		;EQ HEADER SIZE
	STORE	S1,.EQLEN(P1),EQ.LOH	;LENGTH OF HEADER FIELD
	MOVX	S1,<.OTBIN>		;BATCH INPUT QUEUE (SPRINT)
	STORE	S1,.EQROB+.ROBTY(P1)	;SAVE IN OBJECT TYPE
	MOVE	S1,CNTSTA		;GET THIS NODES ID
	MOVEM	S1,.EQROB+.ROBND(P1)	;SAVE NODE IN MESSAGE
	MOVEI	S1,1			;NUMBER OF FILES IN REQUEST
	STORE	S1,.EQSPC(P1),EQ.NUM	;STORE IN EQ
	
	MOVEI	S1,FPMSIZ		;SIZE OF THE FP
	STORE	S1,<EQHSIZ+.FPLEN>(P1),FP.LEN ;FP HEADER SIZE

	MOVE	S1,.RDIFN(RDR)		;Get the file IFN
	SETOM	S2			;We want the exact FD to tell QUASAR
	$CALL	F%FD			;Go get it
	HRLZS	S1			;Push address into left half
	HRRI	S1,<EQHSIZ+FPMSIZ>(P1)	;DESTINATION ADDRESS into right half
	BLT	S1,<EQHSIZ+FPMSIZ+FDSIZE-1>(P1) ;MOVE THE FD

;  Now we are through with the IFN, we can release the file

	MOVE	S1,.RDIFN(RDR)		;GET THE FILE IFN
	PUSHJ	P,F%REL			;RELEASE THE IFN AND CLOSE THE FILE.
	SKIPT				;IF OK,,CONTINUE
	STOPCD	(CCS,HALT,,<Cannot close spool file>) ;ELSE COMMIT SUICIDE

	MOVEI	S2,EQHSIZ(P1)		;GET THE FP ADDRESS IN S2
	MOVEI	S1,.RDRCL(RDR)		;GET CARD SIZE OF DATA
	STORE	S1,.FPINF(S2),FP.RCL	;SAVE THE RECORD LENGTH
	MOVEI	S1,.FPFAI		;GET THE AUGMENTED IMAGE MODE BITS
	SKIPLE	.RDREM(RDR)		;UNLESS THIS IS A DN60 READER
	MOVEI	S1,.FPFSA		;   THEN MAKE IT ASCII MODE
	STORE	S1,.FPINF(S2),FP.RCF	;SAVE THE RECORD FORMAT
	MOVE	S1,.RDJBT(RDR)		;CARD COUNT FOR JOB
	STORE	S1,.FPRCD(S2)		;SAVE THE NUMBER OF RECORDS
	MOVEI	S1,1			;GET A ONE..... 
	STORE	S1,.FPINF(S2),FP.SPL	;LITE THE SPOOLED FILE BIT
	STORE	S1,.FPINF(S2),FP.PCR	;SET PHYSICAL CARD READER BIT
	STOLIM	S1,.EQLIM(P1),CJOB	;ALSO 1 JOB PER FILE (FOR NOW)
	MOVE	S1,.RDTIM(RDR)		;GET START TIME OF JOB
	STOLIM	S1,.EQLIM(P1),CTIM	;SAVE START TIME OF JOB
	MOVE	S1,.RDSTR(RDR)		;GET THE STREAM NUMBER
	MOVE	S2,JOBOBA(S1)		;GET OUR OBJECT BLOCK ADDRESS
	MOVE	S2,OBJ.ND(S2)		;GET OUR NODE NAME
	STOLIM	S2,.EQLIM(P1),CNOD	;SAVE AS THE DESTINATION NODE

	$WTOJ	(<1 Job: ^D/.RDJBT(RDR)/ Cards Spooled>,,@JOBOBA(S1))
	AOS	.RDIPC(RDR)		;COUNT OF MESSAGES SENT
	TXZ	FLAG,JOBCD		;TURN OFF THE JOB CARD BIT
	MOVEM	FLAG,FLAG+.RDREG(RDR)	;Remember so everyone will know
	SETOM	.RDSTS(RDR)		;Say we want status update
	SETZM	.RDJBT(RDR)		;ZERO THE JOB CARD COUNT

;  Call the IBMCOM stats routine if needed.

IFN FTIBMS,<
	SKIPLE	.RDREM(RDR)		;Is it IBMCOM job?
	JRST	[MOVEI	S1,%TINP	;Yes, get the STAT code
		$CALL	IBMSTS		;Send it off
		JRST	.+1]		;Continue on
> ; End of FTIBMS

;  Continue on and send the CREATE message

	MOVE	S1,P1			;PUT THE MSG ADDRESS INTO S1.
	MOVEI	S2,1000			;PUT THE LENGTH IN S2.
	PJRST	SENDIT			;GO SEND IT OFF AND RETURN
	SUBTTL	IBMABO - Routine to handle IBMCOM abort

;  The purpose of this routine is to handle the abort of an IBM reader stream
;  abort.  There are three steps necessary:
;	Notify the operator of the abort
;	Clear the current output file
;	Finally clear the abort state

;  This routine is currently called only by CREATE routine.

;  Parameters:  none

;  Uses:
;	S1,

;  Returns without setting TF

IBMABO:
IFN FTDN60,<
;  Send the notification to the operator

	$WTO	(<Input aborted, ^D/.RDJBT(RDR)/ cards flushed>)

;  Clear the current output file

	MOVE	S1,.RDIFN(RDR)		;Get the IFN for the current file
	$CALL	F%RREL			;Release and close it
					;Ignore any errors
	SETZM	.RDJBT(RDR)		;Clear number of cards

;  Clear the abort state and the JOB state

	TXZ	FLAG,ABORT+JOBCD	;Do it
	MOVEM	FLAG,FLAG+.RDREG(RDR)	;Remember it
	SETOM	.RDSTS(RDR)		;Say we want status update
> ; End FTDN60
	$RET
	SUBTTL	IBMSTS - Routine to send IBMCOM statistics message

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

;  Parameters:

;	S1 / Code type

;  Uses:

;	S1, S2 and any ACs used by the send to QUASAR routine.

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

IBMSTS:
IFN FTIBMS,<
	MOVEM	S1,IBMSTM+MSHSIZ	;Save the statistics code in
					;the message
	MOVEI	S1,IBMSTM		;Get the address of message
	MOVEI	S2,MSHSIZ+1		;And the length
	$CALL	SENDIT			;Send it off to QUASAR
> ;End of FTIBMS
	$RET				;Pass any errors up
	END	CDRIVE