Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ihssrc/ibmspl.mac
There are 30 other files named ibmspl.mac in the archive. Click here to see a list.
;    IBMSPL - Emulation spooler for DN60 IBM communications
;
;
ASCIZ /
	     COPYRIGHT (C) 1977,1978,1979,1980,1981,1982,1983,1984,1985,1986,
			   1987
		
                    DIGITAL EQUIPMENT CORPORATION
/
;     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.
;
SUBTTL Table of contents

;               TABLE OF CONTENTS FOR IBMSPL
;
;
;                        SECTION                                   PAGE
;    1. Table of contents.........................................   2
;    2. Searches and version......................................   3
;    3. Edit history..............................................   4
;    4. Symbol definitions
;         4.1   AC Definitions....................................   5
;         4.2   Feature Test Switches.............................   6
;         4.3   Parameters........................................   7
;         4.4   External symbol definitions.......................   7
;         4.5   Device/task type codes............................   8
;         4.6   Message processor status bits (in S)..............   8
;         4.7   Task status bits (in S while task is running).....   8
;         4.8   Checkpoint request block offsets (from QUASAR)....   8
;         4.9   Create queue entry message offsets (from QUASAR)..   8
;         4.10  D60JSY interface..................................   8
;         4.11  DN60 Port status device active bits...............   8
;    5. Macro definitions
;         5.1   $DSCHD, de-schedule a task........................   9
;         5.2   $SIGNL, indicate wakeup condition.................  10
;         5.3   $WATCH, queue message for watchers macro..........  11
;         5.4   SKPTSK, skip if in task context...................  11
;         5.5   D60, call D60JSY and analyze error return.........  11
;    6. Database definitions
;         6.1   Random static storage.............................  12
;         6.2   Constant static storage...........................  13
;         6.3   IB, Initialization block for GLXLIB...............  13
;         6.4   HELLO, message for QUASAR at startup..............  13
;         6.5   ITEXT strings.....................................  13
;         6.6   Miscellaneous cells...............................  13
;         6.7   Interrupt system database.........................  14
;    7. Dynamic storage definitions
;         7.1   Active task list (ATL) entry "A.xxx"..............  15
;         7.2   Port list entry "P.xxx"...........................  16
;         7.3   Line block list entry "L.xxx".....................  17
;         7.4   Task block list entry "T.xxx".....................  18
;    8. Interrupt code
;         8.1   INTINI, Interrupt system initialization...........  19
;         8.2   INTIPC, IPCF Interrupt routine....................  19
;    9. Initialization code.......................................  20
;   10. Scheduler
;        10.1   MAIN loop.........................................  21
;        10.2   SCHED, Schedule a task............................  22
;        10.3   DESCHD, Deschedule a task.........................  23
;        10.4   ACTTSK, activate a task...........................  24
;        10.5   DEATSK, Deactivate a task.........................  25
;        10.6   WAKTSK, wake a task unconditionally...............  26
;        10.7   SGNTSK, signal a task.............................  27
;        10.8   SGNLIN, signal all tasks on a line................  28
;        10.9   POLL, active device signalling....................  29
;   11. Scheduler IPCF handling
;        11.1   MSGCHK, message checker...........................  30
;        11.2   MSGPRC, IPCF message processor....................  31
;   12. Message processors
;        12.1   TEXTMS, Text message response.....................  32
;        12.2   SETUP, Setup/shutdown message.....................  33
;        12.3   SETALL, setup a new station.......................  34
;        12.4   SHTALL, shutdown station (signoff)................  35
;        12.5   USRCN, User cancel message........................  36
;        12.6   OPRCN, Operator cancel message....................  37
;        12.7   NXTJB, Nextjob message............................  38
;        12.8   SHWSTS, Show status message.......................  39
;        12.9   RQCHK, Request checkpoint message.................  40
;        12.10  CHKPNT, CHKPNB, send checkpoint...................  41
;        12.11  SNDCI, send console input to IBM..................  42
;   13. Tasks
;        13.1   Description.......................................  43
;        13.2   TKSND, console output distribution................  44
;        13.3   TKCTL, control for 2780/3780......................  45
;        13.4   .  CTSGON, wait for signon........................  46
;        13.5   .  CTSGOF, do signoff.............................  47
;        13.6   .  CTLNGN, line gone while active processing......  48
;        13.7   TKCDR, 2780/3780 card reader......................  49
;        13.8   .  CDCNI, send console input to IBM...............  50
;        13.9   .  CDJOB, send job to IBM.........................  51
;        13.10  .   DOJOB, process "batch" job....................  52
;        13.11  .   FILE, copy a disk file to IBM.................  53
;        13.12  .   NXTFIL, advance to next file in job...........  54
;        13.13  TKLPT, 2780/3780 line printer.....................  55
;        13.14  .  LPTJOB, process printer job....................  56
;        13.15  TKHCDR, HASP card reader..........................  57
;        13.16  TKHCDP, HASP card punch...........................  58
;        13.17  TKHLPT, HASP line printer.........................  58
;        13.18  TKHCNI, HASP console input to IBM.................  59
;        13.19  TKHCNO, HASP console output from IBM..............  60
;   14. Subroutines
;        14.1   Initialization and Main Loop subroutines..........  61
;        14.2   .  OPDINI, Get operating system information.......  61
;        14.3   .  QUIESC, wait for tasks to settle...............  62
;        14.4   IPCF message subroutines..........................  63
;        14.5   .  SNDQSR, send a message to QUASAR...............  63
;        14.6   .  SNDBAK, IPCF reply to last sender..............  64
;        14.7   .  RSETUP, response to setup (to QUASAR)..........  65
;        14.8   .  QRLSE, requeue/release (to QUASAR).............  66
;        14.9   . INIXBA, set up single page buffer...............  67
;        14.10  .  INIPAG, set up job pages.......................  67
;        14.11  Queue create message handling.....................  68
;        14.12  .   INIQRQ, Initialize queue request to default...  68
;        14.13  .   INSENT, Insert entry..........................  69
;        14.14  .   FNDENT, Find entry............................  70
;        14.15  Task control subroutines..........................  72
;        14.16  .  MAKLB, create line block.......................  72
;        14.17  .  BLDTSK, create task............................  73
;        14.18  .  RELTKB, release task block.....................  74
;        14.19  .  BUFSZ, calculate task's buffer size............  75
;        14.20  .  RELLB, delete a line block.....................  76
;        14.21  Search subroutines................................  77
;        14.22  .  FNDPOR, Find port block........................  77
;        14.23  .  FNDLB, Find line block.........................  78
;        14.24  .  FNDNOD, Find line block for a node.............  79
;        14.25  .  FNDTSK, Find task from port,line,dev,unit......  80
;        14.26  .  TSKCUR, Make TK value current entry............  81
;        14.27  .  FNDOBJ, Find task from QUASAR object block.....  82
;        14.28  I/O subroutines...................................  83
;        14.29  .  LOGCHR, put character in log...................  83
;        14.30  .  LOGBUF, get another log buffer.................  84
;        14.31  .  COPY, copy a file..............................  85
;        14.32  .  GETDSK, read a record from disk................  86
;        14.33  .  GETIBM, read a record from DN60................  87
;        14.34  .  PUTDSK, write a record to disk.................  88
;        14.35  .  PUTIBM, write a record to DN60.................  89
;        14.36  .  PUTCNI, send console input to IBM..............  90
;        14.37  .  PUTCNO, put a record into CNO queue............  91
;        14.38  .  DEVOPN, open a D60JSY device...................  92
;        14.39  .  CHKDSK, Checkpoint a disk file.................  93
;        14.40  DN60 Control subroutines..........................  94
;        14.41  .  LINSTS, get current line status................  94
;        14.42  .  GETLNO, ensure output is possible..............  95
;        14.43  .  DISABL, routine to disable a line..............  96
;        14.44  .  SGNFIL, SGFFIL, signon/signoff file setup......  97
;        14.45  .  IBMLFR, scan incoming records..................  98
;        14.46  .  CLLUSR, pass record to user exit...............  99
;        14.47  .  BLDFDB, build FD for holding files............. 100
;        14.48  Debugging subroutines............................. 101
;        14.49  .  LBVER, verify LB address....................... 101
;        14.50  Disposition subroutines........................... 102
;        14.51  . DISPOS, dispose of files read from IBM host..... 102
;        14.52  .  SETACT, set print file account string.......... 103
;        14.53  .  SETLMT, Set print file page limit.............. 104
;        14.54  .  QUEFDB, build q-create variant of hold file.... 105
;        14.55  .  WRTQUE, write out the queue info page.......... 106
;        14.56  .  QECLS, close the queue info file............... 107
;        14.57  .  RDQUE, read the queue info file................ 108
;        14.58  .  DELQUE, flush the queue info file.............. 109
;        14.59  .  SNDQUE, send queue info to QUASAR.............. 110
;        14.60  .  PRCQRQ, modify queue info...................... 111
;        14.61  Miscellaneous subroutines......................... 113
;        14.62  .  TBFINI, initialize task IO buffer.............. 113
;        14.63  .  INIJOB, initialize a job....................... 114
;        14.64  .  IBMOOP, IBMIOP - special opens for hold file... 115
;        14.65  .  OPNHLD, open the hold file..................... 116
;        14.66  .  INPOPN, open a file for input.................. 117
;        14.67  . CHKSNZ, check if task should deschedule......... 118
;        14.68  . SNZ, task or non-task time wait................. 119
;        14.69  . D60ANL, D60JSY call interface................... 120
;        14.70  . D60FAL, check for non-fatal errors.............. 120
;        14.71  .  CHGNAM,CHGUSR,CHGSTR, modify hold file from swi 121
;        14.72  . MISLP, sleep for specified time................. 122
;   15. Literals.................................................. 123
;	TITLE	IBMSPL - Emulation spooler for DN60 IBM communications
	SUBTTL	Searches and version

	SALL				; Make nice clean listings

	.DIRECTIVE FLBLST		; List only 1st binary word in multi
					;  word text strings

	SEARCH	IBMMAC			; IBMSPL specific definitions
	SEARCH	GLXMAC			; Use GALAXY group's macros/symbols
	SEARCH	QSRMAC			; Symbols for setup message
	SEARCH	ORNMAC			; ORION communications symbols
	SEARCH	D60UNV			; Search for linkage symbols
	SEARCH	ACTSYM			; Search Accounting Symbols
	PROLOGUE (IBMSPL)		; Initialize Galaxy symbol definitions

; Version

	XP	IBMVER,	4		; Major version number
	XP	IBMMIN,	2		; Minor version number
	XP	IBMEDT,	406		; Edit level
	XP	IBMWHO,	0		; Who did last edit (0=DEC)

; Conditional assembly flags.

	ND	FTDEBUG, 0		; If on .. then generate debuging code

; Version

	%%.IBM=:<VRSN. (IBM)>		; Set value of edit level/version

; Print title/version information to log during compilation

Define VOUTX ($S1,$S2,$S3,$S4)
 <TITLE $S1 $S2'$S3'('$S4')
  PRINTX $S1 $S2'$S3'('$S4')>

IF1,<
 IFN <IBMMIN>,<VOUTX (IBMSPL - GALAXY IBM emulation spooler,\IBMVER,\"<"@"+IBMMIN>,\IBMEDT)>
 IFE <IBMMIN>,<VOUTX (IBMSPL - GALAXY IBM emulation spooler,\IBMVER,,\IBMEDT)>
IFN FTDEBUG,<PRINTX .       with DEBUG features>
    > ;End If PASS1

IF2,<PRINTX Pass 2.>

	LOC	137		; Jobver
VERWRD:	EXP	%%.IBM

	RELOC
IBMNAM:	ASCIZ	/IBMSPL/	; Name of program
	EXP	0
SUBTTL Edit history
COMMENT	&

Edit	Date		Who	Why

0(103)	9-May-79	K Reti	Development of new product
1(104)	9-May-79	KR	Added TOC, and made it version 1 for loadtest
1(105)	15-May-79	KR	Fixed wrong object type for RSETUP, better
				messages
1(106)	15-May-79	KR	Make D60 skippable
1(107)	16-May-79	KR	Made IBMLFR use its own (larger) stack for
				pattern match calls; cut down register saving
				overhead
1(110)	17-May-79	KR	Took out IBMSPL from $MSG calls to WTOR, added
				error codes to SNDCIE
1(111)	17-May-79	KR	Add version printing
1(112)	18-May-79	KR	Fix LPCONO bugs and change version printing to
				use version cell when available
1(113)	23-May-79	KR	Fix wrong D60JSY error message at BLDERR
1(114)	23-May-79	KR	Add line signature code
1(115)	23-May-79	KR	Fix console copy code in TKHCNO
1(116)	29-May-79	KR	Change response to setup to be sent only after
				successful signon
1(117)	30-May-79	KR	Various bug fixes
1(120)	30-May-79	KR	Release ATL entries also at RELTKB
1(121)	31-May-79	KR	Make COPY call put routine to do EOF on error
1(122)	1-Jun-79	KR	Fix console input to HASP
1(123)	1-Jun-79	KR	Fix recognition of console output for 2780/3780
1(124)	4-Jun-79	KR	Add code so that negative POLTIM means no polling,
				fix WAKTIM calculations, and cause RELLB to delete
				port also if line was last on port;
				also change begin and end messages for CDR to
				use ^R
1(125)	4-Jun-79	KR	Fix FNDOBJ calls to take false return
1(126)	6-Jun-79	KR	Add support for IOWAIT argument on SNOOZE to
				improve performance
1(127)	6-Jun-79	KR	Add code to detect new D6LGA return code
1(130)	7-Jun-79	KR	Fix line gone detection code
1(131)	8-Jun-79	KR	Fix single setup to send response, HASP signon
				wait loop to notice line going away, task quiesce
				code, FNDPOR and RELTKB
1(132)	10-Jun-79	KR	Fix various bugs in line gone away code
2(133)	10-Jun-79	KR	Make line status bits change to conform to
				version 3 11-code and version 2 D60JSY
2(134)	10-Jun-79	KR	Make LPTJOB set active earlier so OPNHLD error
				messages can get in log file.
2(135)	14-Jun-79	KR	Change bit definitions for line status to use D60JSY bits,
				add code to disable line on shutdown, change format
				or console input reception to conform to new
				string format
2(136)	15-Jun-79	KR	Get the rest of the bits edit 135 didn't catch
2(137)	15-Jun-79	KR	Fix minor bugs in POLDWN and TKCDR
2(140)	18-Jun-79	KR	Add code to OPDINI for TOPS20 to allow structure
				access without prior structure mount.
2(141)	19-Jun-79	KR	Bug fixes
2(142)	20-Jun-79	KR	Strip blank lines from 2780/3780 console output
				also fix restartup of card-reader bug
2(143)	20-Jun-79	KR	collect console messages destined for OPR
2(144)	21-Jun-79	KR	don't send CHKPNT to QUASAR if there is no job
				(it complains!); also timeout CTSGOX loop
2(145)	27-Jun-79	KR	Move SALL earlier, add debugging code to look
				for one line taking another down bug
2(146)	29-Jun-79	KR	Add code at DISPER to try requeuing hold
				files as printer files, and to delete printer
				files, also add TOPS10 CHGNAM, CHGUSR, CHGSTR.
2(147)	10-July-79	SMJ	Remove JXO instruction so GLXEXT can be heaved.
2(150)	11-July-79	SMJ	Increase the signon interval to 5 minutes.
2(151)  20-July-79	SMJ	Output the correct message on a 700000 type
				 IPCF message.
2(152)	15-Aug-79	SMJ	Put line conditioning code in SETALL.
2(153)	15-Aug-79	SMJ	Fix INPOPN so that it doesn't try line sequence
				 number stripping.
2(154)	29-Aug-79	SMJ	Add support for ORION show status message.
2(155)	4-Sep-79	SMJ	Change call to D60CND to now pass SETUP msg.
2(156)	4-Sep-79	SMJ	Some changes to try to reduce assembly time.
2(157)	5-Sep-79	SMJ	Remove status info from checkpoint message.
2(160)	18-Sep-79	SMJ	Cosmetic fixes to the code at end that was
				never commented properly.
2(161)	25-Sep-79	SMJ	Add account string code for printing
				disposition.
2(162)	28-Sep-79	SMJ	Fix task descheduling (CHKSNZ and SNZ) so that
				if D60SIN/D60SOU never desched a task it can't
				lock out the others until it's done.
2(163)	3-Oct-79	SMJ	Fix GETIBM to properly handle carriage returns
				that are not followed by LF, FF or DC3.
2(164)	17-Oct-79	SMJ	Change name of D60JSY.UNV to D60UNV.UNV.
2(165)	29-Oct-79	SMJ	Change LOOP/SCHED/DSCHED so that IPCF messages
				can't get locked out for extended periods.
2(166)	31-Oct-79	SMJ	Clean up status message format a bit.
2(167)	1-Nov-79	SMJ	Change routine in INIQRQ to create a more
				readable job name from the internal time.
2(170)	10-Nov-79	SMJ	More code cleanup.  Desupport multiple devices
				on a HASP line, since FE can't handle them. Fix
				startup/shutdown code.
2(171)	19-Nov-79	SMJ	Put in fix in MSGPRC so that specified message
				types can be ignored w/o processing and w/o
				giving an error.
2(172)	25-Nov-79	SMJ	Add code to COPY, LPTJOB and DISPOS to handle
				printer page calculations.
2(173)	28-Nov-79	SMJ	Fix TKLPT (2780/3780) so that the device status
				goes idle after turning line back over to CDR.
				Also fix TKHCNI so it really checks the line
				status flags (not random garbage in S1).
2(174)	19-Jan-80	SMJ	Update copyright date
2(175)	20-Jan-80	SMJ	Fix MOVEM (should be MOVE) in POLL that
				destroyed real value in NOW.
2(176)	20-Jan-80	SMJ	Add bytes transfered to status message
2(177)	20-Jan-80	SMJ	Fix edit 167 which destroyed T.RNM, thus giving
				very funny dates for holding file names.
2(200)	21-Jan-80	SMJ	When adding new port check if POLTIM already
				set.
2(201)	21-Jan-80	SMJ	Make minimum of 9 page LIMIT in SETLMT.

******** Version 3

3(202)	22-Jan-80	SMJ	Rewrite routines LOOP (now called MAIN), SCHED,
				DESCHD, MSGCHK, ACTTSK, DEATSK, SGNTSK, SGNLIN,
				WAKTSK.  This major fix cleans up the garbage
				happening during task scheduling, improves code
				readability and increase performance.  Also the
				routine POLL was changed to a subroutine,
				instead of the crazy JRST/JRST stuff that was
				going on.
				Because of massive change, increment version.
2(203)	22-Jan-80	SMJ	Rewrite $DSCHD macro to use new scheduling
				format.
3(204)	23-Jan-80	SMJ	Remove $MSG macro.  Change to $STOP and $WTOJ
				macros.  This improves source to .EXE mapping
				for debugging (besides not generating the
				correct code in the first place).  Not also
				that the assembly time dropped by 1 CPU minute.
3(205)	24-Jan-80	SMJ	Remove superfluous unreferenced cells and
				symbols.
3(206)	24-Jan-80	SMJ	Remove code checking for a M%GPAG failure at
				TSCRP0+1 (this routine always stopcodes on
				failure).
3(207)	25-Jan-80	SMJ	Remove isolated code at TKHERR and RBUF.
3(210)	26-Jan-80	SMJ	Fix PUTIBM to update transfered byte count
				properly.
3(211)	28-Jan-80	SMJ	Performance improvements.  Eliminate routine
				CHKLNI; let POLL do the work designed for it.
				CHKLNI was only checking activity flags anyhow.
				Also if task desched on TW.IOD (I/O wait),
				force an immediate device polling.
3(212)	20-FEB-80	RLS	Changed C%SEND failure in SNDQSR to return the
				failure value instead of STOPCODE.  Users of
				SNDQSR fixed to decide what to do. In particular
				IBMSPL startup changed to wait awhile for QUASAR
				to come to life.  Routine MISLP created to
				provide sleep impervious to interrupts.
3(213)	25-FEB-80	RLS	SNDCI fixed to send multiline msgs to IBM.
				2780/3780 console input(to IBM) routine(CDCNI)
				fixed to actually send msgs instead of halting.
				New subr PUTCNI created from TKHCNI subr to do
				the work. TKHCNI uses the same subr now.
				PUTDSK modified to recognize null files and
				set T.TBC to zero at closing. DISPOS modified
				to complexly delete null files.
3(214)	27-FEB-80	RLS	Fixed register and logic inconsistencies in
				GETDSK and GETIBM for DC3 replacement.
				Made OPNHLD check error return from INIQRQ
				and log errors(made INSENT return a null error
				code - others possible are defined GLXERRs).
				DISPOS stopcodes if request to QUASAR fails.
3(215)	10-MAR-80	RLS	Added cruft to implement logical name for hold
				file device - affects primarily TOPS20. The string
				IBMDEV holds the logical name used by BLDFDB. ALL
				calls to F%OOP and F%IOP replaced by calls to
				local routines IBMOOP and IBMIOP respectively.
3(216)	12-MAR-80	RLS	IBMLFR changed to quit checking for switches
				in IBM input after 8000. characters have been
				processed.
3(217)	19-MAR-80	RLS	modifications to dispos to take care of
				crash/restart problems.RDQUE fixed to init
				queue info if the queue info file doesn't exist.
3(220)	26-MAR-80	RLS	added L.SGN flag to line block status.  Means
				SIGNON is required for station.  SETALL fixed to
				get this from setup msg and use it.
				Fixed RQCHK to load LB(line block ptr)
				Caused crash when QUASAR asked for a checkpoint.
3(221)	5-MAY-80	RLS	Fixed calls to D60SIN and D60SOU
				to reflect non-blocking return.
3(222)	8-MAY-80	RLS	fix tops10 things dealing with hold
				file names,queue create msg file name entry.
4(223)	30-JUN-80	RLS	Modify to use D60JSY version 4 : non-blocking
				IO.  D60 macro changed to include retry return
				for innocuous errors.  D60ANL expanded to cope
				with this change.  SNZ function called when
				"wait" condition is returned by D60JSY.

4(224)	1-JUL-80	RLS	Modify BUFSZ to return 2*MXLPBF for lpt
				buffer size to better accomodate line accumulation.
				Fix TKHCNO to dump buffer when less than MXLPBF
				space left in buffer.
4(225)	23-JUL-80	RLS	Add SYSERR logging enable(D60INI arg)

4(226)	5-AUG-80	RLS	Undo edit 220(SIGNON parts). SIGNON is required
				for emulation mode by FE in order for flow
				control to work properly...FE couldn't resume
				transfers after halt due to not being signed on
4(227)	11-AUG-80	RLS	FIX $DSCHD macro so DEACTIVATE arg clears TF
				well as CURATE(TF/args deliverd to DESCHD).
4(230)	2-SEP-80	RLS	fix FNDOBJ to set up LB on success exit.
				relates to patch 220 - RQCHK.
4(231)	15-SEP-80	RLS	remove patch 216. Fix LINSTS to set L.SND.
4(232)	18-SEP-80	RLS	removed infinite retry in OPNHLD. will try
				five times then give error return if fails. LPTJOB
				modified to handle  OPNHLD error return - log
				and opr msgs then returns error. TKLPT AND TKHLPT
				modified to handle the LPTJOB error - lpt input
				cannot proceed at this point.
4(233)	22-SEP-80	RLS	add more info on all DISPOS error msgs. more
				analysis and directed action on DISPOS errors.
				retry count for disposal implemented.
				fixes bug on rename error(due to P1 being munged)
				which caused lpt io to cease after rename error.
4(234)	23-SEP-80	RLS	add file copy to DISPOS for use when
				strucutres are different for rename. tops10
				conditional used to check actual structure
				before renaming. tops20 renames and will get
				erfds$ error(hopefully).
4(235)	24-SEP-80	RLS	add rbs(record buffer size) to task block.
				change TKHCNO to use copy command.
4(236)	26-SEP-80	RLS	add extension incrementing to dispos/rename.
4(237)	23-Oct-80	KR	Fix bug in GETIBM that caused TRPILM stopcodes.
4(240)	4-Nov-80	KR	Add delayed signoff code to fix multiple
				hold files open problem; also fix signal line
				bug.
4(241)	5-Nov-80	KR	Fix bugs introduced by 4(240).
4(242)	7-Nov-80	KR	Make immediate shutdown hang up line too.
4(243)	18-Nov-80	KR	Fix TKCDR's losing track of job.
4(244)	22-Nov-80	KR	Make signoff process more informative
				Also fix CTSGOF register problem

	8-JAN-81		TOPS-10 FTT #1

4(245)	12-JAN-81	RLS	swap  a pop and store instruction in
				SGNTSK - effect was to forget all pending signals
				whenever any new signal to a task was done.
				This fixes(hopefully) 2780/3780 problem where
				a card job waiting for lpt io done is forgotten.
				Similar problem with console messages.
				Removed temporary patch in CDEXT which
				went out on FTT #1.

4(246)	26-FEB-81	KR	Fix IBMLFR to pass record count and not mung T1
				for USRLPT.
4(247)	03-MAR-81	RLS	Add NDLESS flag to S to warn downstream processors
				 of input records that the record has no LF.
				Add lots of abort messages and abort checking- sned
				IO abort command to FE (D60OPR - .MOABT).
				Make IPCF message error messages more explicit.
				Requeue/HOLD  NEXTJOB request when it cannot be
				processed for a variety of reasons.
				Ignore possible line error states when doing cleanup
				in signon/signoff tasks.
				COPY now will make sure input function sees ABORT
				flag when output function sees fatal error conditions
				 - prevents open files from hanging around.
				GETDSK now checks his buffer limits while looking
				for LF - sets NDLESS if buffer filled before LF
				seen.
				Add new function ABTDEV - aborts IO on a device.
				Make copy/rename function in DISPOS insist on new
				file generation - use extension modification if
				necessary to get unique file name.
				remove error message when receiving tex type IPCF
				message - QUASAR now sends them to see who is alive.
4(250) 23-Mar-81	RLS	Polling now done every time main scheduler wakess
				from its idle sleep, but not oftener than once per
				second.  Polling interval(POLINT) lengthened to
				5 seconds. PUTIBM,GETIBM set their own retry timers
				so polling is for new device activity only.
				If next wakeup time in scheduler is less than 1
				second in the future, the clock is advanced to
				avoid the overhead of sleeping and waking.
				PUTIBM fixed to update byte xferred count only
				after successfully outputting a string.

4(251) 25-Mar-81	RLS	Add timeout and associated error message to line
				conditioning(SETALL).  Add error message for D60
				error failure of line condition. Change signon
				timeout to 15 minutes. Now will only be applied to
				lines with signon required, others will still
				sign on but will not be timed.
				Replace all references to ERRIBM with use of
				itext D60ERM.
				Replace all refereences to GLXERR with use of
				itext DGLXER.

4(252) 17-APR-81	RLS	Fix FILE to not requeue jobs whose input open
				failed. Error msg removed from INPOPN.

4(253)	6-May-81	CLB	Add CHGSTR routine for TOPS20's use.
				Increase size of per task PDL = TKPDLN

4(254)	6-May-81	WEM	Fix problem of rename to existing file not
				causing an error return.  Symptom is older
				file gets superceded.
				This edit will be obsolete when F%REN on
				TOPS20 is patched to detect this case.

4(255)	6-May-81	WEM	INIQRQ fails to append NUL to filename it is
				working on.  Fix it.

4(256)	7-MAY-81	RLS	Fix problem of CHGNAM assuming that the
				filename it is working with has a directory
				field.  Now it will assume that the logical
				name field is present.

4(257)	8-MAY-81	WEM	Fix same problem fixed by edit 256 to
				CHGNAM in CHGUSR and CHGSTR.

4(261)	12-May-81	WEM	Modify code to handle input and output
				aborts more reliably.  If an incoming file
				is aborted, dispose of the file normally
				but with a distinct filename.
4(262)	20-MAY-81	RLS	Move opening of hold file to PUTDSK from
				LPTJOB - avoids opening file for IBM null
				file case.
4(263)	19-Jun-81	WEM	Bug fixes in PUTDSK and IBMLF0
				Add code to handle DISPOS failure in OPNOLD
4(264)	23-Jul-81	WEM	Improve inport abort handling.
4(265)	27-Jul-81	WEM	Fix handling of ERFNF$ error in DISPOS.
				Specifically, check for case of ERFNF$ being
				returned for destination filename problems.
4(266) 20-AUG-81	RLS	Set L.SND in L.STS at CTSGO3.  Fixes problem
				of abrupt shutdown of line(2780/3780) when only
				lpt job is active(ie, no card jobs pending).
4(267) 22-OCT-81	TJW	Added accounting routines and database
				(first pass)
4(270) 02-NOV-81	RLS	Added poll estimate usage...various bug fixes.
4(271) 04-NOV-81	RLS	Changed status display to use .ORDSP form of
				message.
4(272) 17-NOV-81	RLS	Remove 264 - makes it complain bitterly about
				every null file sent by IBM.
4(273) 19-NOV-81	RLS	Add xfer rate to status messages.
4(274) 23-NOV-81	TJW	Fix IBMSPL to not try to talk to a terminal
				when it can't find QUASAR
4(275) 23-NOV-81	TJW	Add REQUE message processor
4(276) 25-NOV-81	RLS	fix various obscure bugs. detect input abort
				more reliably in GETIBM. Add output abort
				processing to PUTIBM. Check for it in FILE.
4(277) 01-DEC-81	RLS	Change console pattern matching conventions to
				match 1st line of file only. New S switch
				created(CONPAT). New parameter(CONLMT) created
				to turn off CONPAT if file too big.
4(300) 01-DEC-81	RLS	Add T.TFS and T.TFD variables to task data base
				to receive actual io start time and done time.
				Flag IOBEG in S added to gate checking for
				start time.
4(301) 02-DEC-81	RLS	Change $DSCHD macro to accomodate use of
				variable sleep time.
4(302) 07-DEC-81	TJW	Fix accounting to work for both input and output
4(303) 09-DEC-81	TJW	Fix requeue logic to handle jobs which are
				waiting on line turnaround
4(304) 28-DEC-81	RLS	Remove crock put in to append portions of hold
				file name to /LNAM request(TOPS-20).
4(305) 29-DEC-81	TJW	Fix several bugs in accounting stuff having to
				do with register allocation. Fix the handling
				deleted control files. etc.
4(306) 25-FEB-81	RLS	Make DISABL more aggressive.
4(307) 04-MAR-82	RLS	Restructure "MAIN" scheduler loop SCHED/DESCHD
				to get more responsiveness to front end line
				conditions. Might also improve response to OPR
				requests.
4(310) 07-MAR-82	RLS	GCO 4.2.1249 - Add CHKSNZ's to GETIBM,PUTIBM.
				Make use of conditional FTCLOG since we don't
				use the feature.
4(311) 07-MAR-82	RLS	GCO 4.2.1251 - set FR.NFO in FRB for DISPOS
				rename.
4(312) 08-MAR-82	RLS	GCO 4.2.1254 - delete PNAME entry when mapping
				LSTR to D60:.
4(313) 08-MAR-82	RLS	GCO 4.1.1255 - send response to shutdown after
				all shutdown processing is complete.
4(314) 10-MAR-82	RLS	GCO 4.2.1261 - check for input abort and input
				eof at CDTURR.
4(315) 23-MAR-82	RLS	GCO 4.2.1293 - at DCPF2C, delete LSTR entry and
				call INIQRF to recreate default file name.
4(316) 29-MAR-82	RLS	GCO 4.2.1308 - in FILE, set requeue flag(RQB) w
				with ABORT at FILE2D so line errors cause job to
				be requeued. Don't set hold flag(RQ.HBO in
				 REQ.FL) in QRLSE.
4(317) 21-APR-82	RLS	GCO 4.2.1328 - use F%RREL to close output file
				at DCPFCL in DISPOS copy routine.
4(320) 21-APR-82	RLS	GCO 4.2.1330 - use T.TYP as index into set of
				device names for "file queued to device" message
				in DISPOS.
4(321) 04-MAY-82	RLS	GCO 4.2.1338 - fix field alignment in status
				msg. add cdr performance statistics. change
				wording of lpt status mesgs.
4(322) 27-MAY-82	RLS	GCO 4.2.1349 - make GETLNO not wait forever on
				D6NBR returns.
4(323) 09-JUN-82	RLS	GCO 4.2.1379 - close file in PUTDSK if output
				error occurs.
4(324) 18-JUN-82	RLS	GCO 4.2.1392 - in GETIBM account for input done
				on input aborts.
4(325) 23-JUN-82	TJW	GCO 4.2.1395 - answer to QAR 20-01022 - clear
				input and output record counts when starting
				a new job.
4(326) 24-JUN-82	RLS	GCO 4.2.1397 - in GETLNO, don't save S1.

4(327) 30-JUN-82	TJW	GCO 4.2.1413 answer to QAR 20-01011. fix
				SETACT to build .QCACT correctly
4(330) 08-JUL-82	RLS	GCO 4.2.1428 - use default sleep time in DISABL
4(331) 12-JUL-82	RLS	GCO 4.2.1444 - use T.ICT instead of T%ICT at
				IBMLFE to get record for user exit.
4(332) 15-JUL-82	RLS	GCO 4.2.1448 - at PUTIB2, don't sleep if last
				sout transferred nonzero number of bytes.
4(333) 19-JUL-82	RLS	GCO 4.2.1453 - in DISPOS, interlock use disposal
				to avoid interference in FDBARE usage.
4(334) 21-JUL-82	RLS	GCO 4.2.1459 - in FILE, if input file fails to
				open just send a message and do not abort line.
4(335) 29-JUL-82	RLS	GCO 4.2.1471 - in PRCQRQ, if there is a PNAME
				entry but not an LSTR entry, insert real name
				of structure of D60:.
4(336) 01-AUG-82	RLS	GCO 4.2.1475 - don't return ptr in P3 from
				 INIQRQ/INIQRF.
4(337) 09-UAG-82	RLS	GCO 4.2.1486 - POLEST can be 0
				GCO 4.2.1487 - Add fcn LINCHK which rules on
				line viability and use it in appropriate places
				GCO 4.2.1488 -  add timer in CTSGOFF after sending
				signoff card so JESx systems can send one last
				message.
4(340) 16-AUG-82	RLS	GCO 4.2.1490 - in ABTDEV, also do an eof for
				hasp output devices.
4(341) 18-AUG-82	RLS	GCO 4.2.1493 - in INSENT, specifically clear
				word after end of list after all inserts and
				deletes.
4(342) 23-AUG-82	RLS	GCO 4.2.1500 - in SNDCI, fill out last word of
				copied OPR message with nulls.
4(343) 24-AUG-82	RLS	GCO 4.2.1502 - in CTSGOF, protect control task
				pointer better while sending signoff file.
4(344) 08-AUG-82	RLS	GCO 4.2.1509 - at GETIRT check if buffer still
				has characters left and take normal exit if so,
				not checking for eof.
4(345) 20-SEP-82	RLS	GCO 4.2.1512 - put tops20 conditional around
				call to RELSTR.
4(346) 01-OCT-82	TJW	GCO 4.2.1518 fixup output spooler accounting
				record
4(347) 04-nov-82	TJW	GCO 4.2.1527 Fix bad WTO for accounting
				failure.
4(350) 13-NOV-82	DEK	GCO 4.2.1528 Fix Copyright.
4(351) 22-FEB-83	TJW	GCO 4.2.1542 Fix signoff problem, not waiting
				for disconnect message, reverse two tests.
4(352) 08-Nov-83	GKN	SPR 20-19594 NDLESS flag is useless.
4(353) 10-Nov-83	GKN	SPR 10-34279 Don't make FACT file entries if
				FTDEBUG is turned on.
4(354) 11-Nov-83	GKN	SPR 10-34280 Fix possible ILMs with incorrect
				LOAD S1,T.QNM (should be LOAD S1,,T.QNM).
4(355) 16-Dec-83	GKN	Fix part of the problem with ?Illegal address
				in UUO executing QUEUE. UUOs.  IBMSPL feeds
				the monitor a bogus string pointer in the
				system text field.
4(356)	16-Jan-84	GKN	SPR 10-34449. Security problem. IBMSPL doesn't
				bother to use "in your behalf" and users are
				thus able to submit files to which they have no
				access.  Both TOPS-10 and TOPS-20.
4(357)	23-Jan-84	GKN	SPR 10-34425. Fix off-by-1 problem in the VOUTX
				macro (caused the wrong minor version to be
				printed at compile time).
4(360)	16-Mar-84	TPW	remove edit 351.  Put test for line up back
				before test for line gone away.
4(361)	18-Mar-84	TPW	Supplements edit 353.  Don't allow accounting
				to be done if DEBUGW is non-zero.
4(362)	18-May-84	DRB	At LPTJOB: change call to INIPAG so that AC S
				does not get lost
4(363)	18-May-84	DRB	Prevent restarting a node if a previous
				shutdown has not yet completed.
4(364)	24-Sep-84	TPW	Fix edit 356 to prevent access violation
				using /DELETE switch with control files.
4(365)	22-Oct-84	VLG	Fix file not printing if LSTR switch is used
				accidently.
4(366)	1-Nov-84	TPW	Remove indirection from instructions using
				.RETT,.RETF,.POPJ memory operands
				(i.e. @.POPJ -> .POPJ).
4(367)	13-Jun-85	DRB	In LPT Tasks, always clear OUTEOF after
				processing a file in case of abnormal
				termination.
4(370)	14-Feb-86	TPW	Make SETLMT calculate the lineprinter page 
				limit the same way the EXEC and QUEUE does.
4(371)	4-Apr-86	TPW	Include GLXLIB's PCO 030 FB.SUP bit in DELQUE
				so D60: doesn't fill up with deleted files.
4(372)	19-Nov-86	TPW	In LPTJOB, if input abort occurs don't use
				normal file completion messages for WTOJ etc
4(373)	17-Jan-86	TPW	Fix for Tops10 703 so that IBMSPL will report
				correctly formatted port numbers.
4(374)	30-Jul-87	LWS	Tops10: Change $STOPs to STOPCDs.
				Fix up edit 373.
4(375)	17-Aug-87	LWS	Change object type to .OTBAT in hello block
				and add %IBMBT as attribute supported.
				Must have QUASAR edit 1466!!
				GCO 10554	SPR 10-35999
4(376)	24-Sep-87	TPW	Initialize Queue Create Page with a structure 
				so that the /LSTR switch will work
4(377)	29-Sep-87	TPW	Copyright					
4(400)  01-Dec-87	TPW	Place a limit on the number of times GETIBM
				will transfer in 0 bytes so as not
				to loop in this sort of effort indefinitely.
4(401)  10-Dec-87	TPW	Fix register referencing error in BUFSZ
4(402)  01-Feb-88	TPW	Conditionalize edit 376
4(403)  02-Feb-88	TPW	Conditionalize edit 373
4(404)  04-Feb-88	TPW	Edit 365 has side (or no) effects.
4(405)	04-Feb-88	TPW	Fix code in DISPOS so that file 
				disposition with(without) /LSTR 
				switch will happen as documented.
4(406)	25-Jan-89	JYCW	Edit 400 initialized ZBICNT in the wrong
				routine.
&
SUBTTL	Symbol definitions -- AC Definitions

; Preserved AC's

	J=:13			; Job context pointer (address of 3-page area:
				; request page, buffer page, log buffer page)
	LB=:14			; Line block pointer
	TK=:15			; Task block pointer
	S=:16			; Status flags

; Symbolic register definitions for when absolute register numbers
; must be used (so we can see them in the cross reference)

	REGS			; Generate mnemonic names for physical
				; registers, i.e. R0, R1, etc.
SUBTTL Symbol definitions -- Feature Test Switches

COMMENT	&

  The following symbols enable or disable certain features in IBMSPL; the
only supported settings of these switches are the default settings given
below (although it is expected that this may change in the future).

  All the symbol enable the feature with a non-zero value, and disable the
feature with a zero value WITH ONE EXCEPTION, namely FTDEBUG which (for
ease of assembly) enables the debug code if defined (with any value) and
disables the debug code if undefined.  Its default is undefined, and it
is not included in the list below.

  These feature test symbols are then converted to macros, to make testing
for the feature easier (and more readable) in the code.  Each macro has the
same name as the feature test switch.

	&

	ND FTLOG,  0		; Log files for users
	ND FTACCT, -1		; Accounting
	ND FTCLOG, 0		; IBMSPL central log file
	ND FTIBMS,  0		; Support for the IBM program

	DEFINE FTLOG <IFN FTLOG>
	DEFINE FTACCT <IFN FTACCT>
	DEFINE FTCLOG <IFN FTCLOG>
	DEFINE FTIBM <IFN FTIBMS>
	DEFINE FACT <IFN FTFACT,>
SUBTTL Symbol definitions -- Parameters

; Parameters which may be changed at assembly time

	ND	PDSIZE,120	; Size of pushdown list
IFN FTDEBUG,<
	ND	TKPDLN,250	; Bigger stack if debugging
    >;End if FTDEBUG
	ND	TKPDLN,150	; Size of per task PDL
	ND	LGNUM,10	; Number of log pages to keep
	ND	MAXDEV,^D50	; Maximum number of devices we will service
	ND	INSIGN,^D15	; Time delay between receipt and
				;  start of job considered insignificant
	ND	CHKCNT,^D200	; Number of records between checkpoints
				;  of the "hold" files for input from IBM
	ND	CHKRTV,^D10	; Number of records between checkpoint
				;  attempts if an error occurred on the
				;  last checkpoint
	ND	SNZINT,^D1	; Number of desched checks before a
				;  task will for forced to deschedule
	ND	PATPLN,^D250	; Length of stack for pattern matching
	ND	ZBITRY,^D10	;[400] Number of retries for zero byte input
; System dependent parameters

	SYSPRM	SYSNML,5,10	; Number of word in system name

; Constant parameters

	XP MSBSIZ,30		; Size of message block
	XP MXLNBT,^D40		; Maximum bytes on a line of status info
	XP MXCDBF,<^D80/4>+2	; Maximum record buffer size for card reader
	XP MXLPBF,<^D144/5>+2	; Maximum record buffer size for printer
	XP POLINT,^D10*3		;[261] Polling interval, in UDT units - when all is quiet
	XP SPLINT,^D5*3		; sampling interval for 2780/3780 to check for input
	XP CONLMT,^D5000	; maximum allowable size for console message in
				; 2780/3780...larger is DISPOS'd of.

SUBTTL Symbol definitions -- External symbol definitions

	EXTERNAL D60INI,D60OPN,D60SIN	; D60JSY routines
	EXTERNAL D60SOU,D60EOF,D60STS
	EXTERNAL D60RLS,D60OPR,D60CND
	EXTERNAL D60DIS
	EXTERNAL POLEST			; D60JSY's estimate of next optimal poll time
	EXTERNAL STSBUF			; D60JSY  full status buffer - referenced
					; by D60UNV field definition macroes
	EXTERNAL USRCDR,USRLPT,USRCDP	; User exits to validate records
	EXTERNAL PATLOG,PATSWT,DOSWT	; Pattern matching entries to IBMPAT
SUBTTL Symbol definitions -- Device/task type codes

	.TCTL==0		; Control task type
	.TLPT==1		; LPT device type
	.TCDP==2		; CDP device type
	.TCDR==3		; CDR device type
	.TCNI==4		; Console in device type
	.TCNO==5		; Console out device type
	.TSND==6		; "Send console messages to "watchers"
				;  (programs OPR and IBM) task type

; NOTE: the routine BLDTSK uses the fact that all the device
; (as opposed to task) codes are contiguous and begin with .TLPT
; and end with .TCNO.


SUBTTL Symbol definitions -- Message processor status bits (in S)

	F.IPCSY==1B0		; Message was from a GALAXY component
	F.HASP==1B1		; Request was for a HASP line


SUBTTL Symbol definitions -- Task status bits (in S while task is running)

	DSKOPN==1B0		; Disk file is open
	ABORT==1B1		; We should abort
	GOODBY==1B2		; We are cleaning up
	QSRREQ==1B3		; Request page has data in it
	ACTIVE==1B4		; Active (i.e. console msgs should be logged)
	JVALID==1B5		; Pointer to job pages is set up
	RQB==1B6		; Job must be requeued
	INPEOF==1B7		; Input EOF seen
	OUTEOF==1B8		; Flag to write output EOF
	CHECK==1B9		; Checking of records should be done (in COPY)
	HASP==1B10		; We are doing hasp
	FLSH==1B11		; We are flushing input before signalling EOF
	CHKLOG==1B12		; Check for console output in IBM output
	CONPAT==1B13		; input file is console output
	CHKSWT==1B14		; Check for user switches in IBM output
	DOCHKP==1B15		; Do checkpoints on output file
	NOCTLS==1B16		; Convert ^S (23 octal) to LF (12 octal)
				;  (self-resetting on input EOF)
	LGA==1B17		; Line has gone away
	TCR==1B18		; CR seen in input IBM stream
	PEOF==1B19		; pretend end-of-file when no input
				;  (GETIBM for console)
;[352]	NDLESS==1B20		; this input record has no line feed
	IOABT==1B21		;[261] soft abort has been seen on line
	NODEL==1B22		; INSENT should not replace an already
				;  existing entry of the same type
	IOBEG==1B23		; set until 1st nonblank record transferred
				; to/from front end

SUBTTL Symbol definitions -- Checkpoint request block offsets (from QUASAR)

	XP	CKFIL,0		; Number of files processed
	XP	CKTRS,3		; Total records processed
	XP	CKFLG,4		; Flags
	  XP	  CKFREQ,1B0	;  Requeued by operator
	  XP	  CKFCHK,1B1	;  Job was checkpointed


SUBTTL Symbol definitions -- Create queue entry message offsets (from QUASAR)

	XP	CQBEG,MSHSIZ+2	; Beginning of entries
	XP	CQARGN,MSHSIZ+1	; Number of entries (arguments)



SUBTTL Symbol definitions -- DN60 Port status device active bits

	XP	LP0BIT,1B23	; LPT0 active
	XP	CP0BIT,1B31	; CDP0 active
	XP	CR0BIT,1B15	; CDR0 active
	XP	CNIBIT,1B1	; Input console active
	XP	CNOBIT,1B0	; Output console active
	XP	BUNUSD,1B2+1B3+1B4+1B5+1B6+1B7 ; Unused bits (line abort)
SUBTTL Macro definitions -- $DSCHD, de-schedule a task

; Macro - $DSCHD
;
; Function - Set wake conditions and return to scheduler (de-schedule).
;
;	This macro generates code that sets the bits for wakup conditions and
;	the wakeup delay time and calls the scheduler.  If an argument is
;	omitted the corresponding function is not done.
;
; Parameters -
;
;	BITS	Bits defining wakeup event flags
;		 or keywords:
;		  DELETE	Indicates task no longer exists
;		  DEACTIVATE	Indicates task is removed from ATL
;	TIME	Time delay (in 1/3 secs) for unconditional wakeup

DEFINE $DSCHD (BITS,TIME) <
  %%.DS==0				;; Flag keyword not found yet
  IFIDN <BITS>,<DELETE>,<		;; If task has been deleted
	SETZ	TK,			;;  Clear task block pointer
	PJRST	DESCHD			;;  Jump back to MAIN context
  %%.DS==-1
    > ;;End if DELETE
  IFIDN <BITS>,<DEACTIVATE>,<		;; If task has been deactivated
	SETZB	TF,CURATE		;;  Clear Active Task List pointer
	$CALL	DESCHD			;;  Call descheduler
  %%.DS==-1
    > ;;End if DEACTIVATE
  IFE %%.DS,<				;; If normal task descheduling
	MOVX	TF,<BITS,,TIME>		;;  Set wakeup conditions
	$CALL	DESCHD			;;  Call descheduler
    > ;;End if normal deschedule
   >;End DEFINE $DSCHD

DEFINE	VDSCHD (BITS,TIME) <
	MOVE	TF,TIME			;;  Set wakeup conditions
	HRLI	TF,<BITS>
	$CALL	DESCHD			;;  Call descheduler
>;END VDSCHD
SUBTTL Macro definitions -- $SIGNL, indicate wakeup condition

; Macro - $SIGNL
;
; Function - To signal either a task or all the tasks on a line of a
;	schedulable event.  Any task that matches it's wakeup flags
;	against the event signaled to it on the next scheduler pass
;	is run.
;
; Parameters -
;
;	BITS	Wakeup event flags
;	TYPE	"LINE" or "TASK", the default is "TASK"

DEFINE $SIGNL (BITS,TYPE<TASK>) <
	XLIST
	..TM==0
  IFIDN <TYPE>,<TASK>,<
	MOVEI	S1,BITS
	$CALL	SGNTSK
	..TM==1
   >;END IFIDN <TYPE>,<TASK>
  IFIDN <TYPE>,<LINE>,<
	MOVEI	S1,BITS
	$CALL	SGNLIN
	..TM==1
   >;END IFIDN <TYPE>,<LINE>
  IFE ..TM,<
    PRINTX ?Illegal argument "type" in $SIGNL call -- using TASK
	MOVEI	S1,BITS
	$CALL	SGNTSK
   >;END IFE ..TM
	PURGE	..TM
	LIST
  >;End DEFINE $SIGNL
SUBTTL Macro definitions -- $WATCH, queue message for watchers macro

DEFINE $WATCH (STRING) <
	$CALL	WATCH
	CAI	[ASCIZ %'STRING'%]
    >;End DEFINE $WATCH



SUBTTL Macro definitions -- SKPTSK, skip if in task context

DEFINE SKPTSK <
	SKIPN	CURATE
   >;End DEFINE SKPTSK



SUBTTL Macro definitions -- D60, call D60JSY and analyze error return

DEFINE D60 (FNC,RTRY,WTIM) <
	XLIST
$$WTIM==3
IFNB	<WTIM>,<$$WTIM==WTIM>
	CAIA
	JRST	.+3
	MOVE	TF,[@[FNC
		    $$WTIM
		    RTRY]]
	$CALL	D60ANL
	LIST
  >;End DEFINE D60
SUBTTL Database definitions -- Random static storage

LOWBEG==.			; Start of area to zero

; Scheduler cells

NOW:	BLOCK	1		; Current date/time (in UDT format)
WAKTIM:	BLOCK	1		; Time when to do next task scheduling loop
POLTIM:	BLOCK	1		; Time when to poll active devices on all ports
LSTPOL:	BLOCK	1		; last time poll happened
CURATE:	BLOCK	1		; Address of current Active Task List entry
SCHDGO:	BLOCK	1		; If non-zero, do another scheduling pass
ZBICNT: BLOCK	1		;[400] 0 byte-transfer retry counter

; Handles for data structure linked lists

LBNAM:	BLOCK	1		; Handle for line block list
TSKNAM:	BLOCK	1		; Handle for task block list
ATLNAM:	BLOCK	1		; Handle of list of (potentially) active tasks
WATNAM:	BLOCK	1		; Handle for watcher list
PTLNAM:	BLOCK	1		; Handle for port list

; Environmental information

CNF:	BLOCK	SYSNML		; Monitor name string
CNTSTA:	BLOCK	1		; Node number of central station

TOPS20 <
SPLDIR:	BLOCK	1		; Directory number for PS:<SPOOL>
    >;End if TOPS20

; IPCF Message handling cells

MDBADR:	BLOCK	1		; Message data block address for IPCF
SAB:	BLOCK	SAB.SZ		; Send argument block for sending messages
MSGBLK:	BLOCK	MSBSIZ		; Block to build messages in
MSGLIM:	BLOCK	<<MXLNBT+4>/5>+1 ; Buffer area for status line overflow

; Multiple device status return block

DEVBTS:	BLOCK	^D12		; Twelve lines maximum
	BLOCK	1		;  (overrun protection)


; Block in which to build FDB's

DSPLOK:	BLOCK	1		; DISPOS interlock

FDBARE:	BLOCK	FDXSIZ		; Maximum area for file name

; File rename block

FRB:	BLOCK	FRB.SZ		; Maximum size

REALST:	BLOCK	2		; holds real structure name


; Data areas for Tops-10 File info

TOPS10	<
OBLOCK: BLOCK 3		;[370]

LKBLK:	BLOCK	1	;[370]EXTENDED LOOKUP BLOCK
LKPPN:	BLOCK	1	;[370]DIRECTORY
LKNAM:	BLOCK	1	;[370]FILE NAME
LKEXT:	BLOCK	1	;[370]FILE EXTENSION
LKPRV:	BLOCK	1	;[370]PROTECTION WORD
LKSIZ:	BLOCK	1	;[370]FILE SIZE
	BLOCK	1	;[370]JUNK
LKSPL:	BLOCK	1	;[370]SPOOLING NAME
	BLOCK	6	;[370]JUNK
LKDEV:	BLOCK	1	;[370]LOCATION OF FILE (LOGICAL UNIT)
LKBLKL==.-LKBLK
    >;[370]End TOPS10

; File open block (long form)

FOB:	BLOCK	FOB.SZ		;[356] Reserve space for a long-form FOB

LOWEND==.			; End of zeroed area plus 1

IBMDEV:				; logical device name for hold file

TOPS10	<SIXBIT	/D60/>		; use ersatz device

TOPS20	<ASCIZ	/D60/		; use system logical name
	HLDDVW==.-IBMDEV
	>

; Pattern matching and scanning stack/AC preservation area

PATPDL:	BLOCK	PATPLN		; Reserve space for it
.LACS::	BLOCK	20		; AC save area for record examine rtns


; Signon/Signoff file cells

SGNFOB:	EXP	SGNFDB		; Address of FDB
	EXP	7		; Byte size

TOPS10	<
SGNFDB:	XWD	5,0		; Length of FDB
	SIXBIT	/D60/		; Device name
SGNNAM:	EXP	0		; Filename (station name)
SGNTYP:	EXP	0		; Extension (.SON or .SOF)
	EXP	0		; PPN
    >;End if TOPS10

TOPS20	<
SGNTYP:	EXP	0		; Temporary pointer to extension
SGNFDB:	XWD	1+^D8,0		; Length of FDB
SGNFSP:	BLOCK	^D8		; Reserve at most 39 characters
    >;End if TOPS20

PDLSAV:	BLOCK	1		; Temporary storage for stack pointer
PDL:	BLOCK	PDSIZE		; Stack for MAIN context

;Random accounting locations

;DAEMON block for FACT accounting

TOPS10<
FACT<	EXP	.FACT		;DAEMON WRITE FACT FILE FUNCTION
FACTBL:	BLOCK	13  >		;FACT BLOCK FILLED IN
>

L.JOB:	BLOCK 1			;job number
L.TTY:	BLOCK 1			;tty designator
L.LINE:	BLOCK 1			;tty line number
L.NODE:	BLOCK 1			;node name
NODNUM:	BLOCK 1			;node number
TOPS10<
ACTPNM:	BLOCK 1			;holds PPN
>;End of TOPS10 Conditional
TOPS20<
ACTPNM:	BLOCK 10		;holds user name
>;End of TOPS20 Conditional
ACTACT:	BLOCK 10		;holds account string
SUBTTL Database definitions -- Constant static storage

TOPS10 <
	INTVEC==VECTOR		; Define interrupt vector address
    >;End if TOPS10

TOPS20 <
	INTVEC==:LEVTAB,,CHNTAB	; Define interrupt vector address
    >;End if TOPS20


SUBTTL Database definitions -- IB, Initialization block for GLXLIB

IB:	$BUILD	IB.SZ			; Initialization block
	  $SET	(IB.PRG,,%%.MOD)	;  Sixbit program name (from PROLOG)
	  $SET	(IB.INT,,INTVEC)	;  Interrupt system base
	  $SET	(IB.OUT,,T%TTY)		;  Global TTY handling routine
	  $SET	(IB.PIB,,PIB)		;  Address of PSI block
	  $SET	(IB.FLG,IP.STP,1)	;  Send stopcodes to ORION
	$EOB

PIB:	$BUILD	PB.MXS			; PSI information block
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;  Length of block is standard
	  $SET	(PB.FLG,IP.PSI,1)	;  PSI notification of IPCF message
	  $SET	(PB.INT,IP.CHN,0) 	;  Use PSI channel 0
	  $SET	(PB.FLG,IP.RSE,1) 	;  Return send errors immediately
	  $SET	(PB.SYS,IP.SQT,511) 	;  Its send quota is large
	  $SET	(PB.SYS,IP.RQT,511) 	;  Likewise its receive quota
	  $SET	(PB.NAM,FWMASK,IBMNAM)	;  Set name to be
	$EOB


SUBTTL Database definitions -- HELLO, message for QUASAR at startup

HELLO:	$BUILD	HEL.SZ			; "HELLO" message block
	  $SET	(.MSTYP,MS.TYP,.QOHEL)	;  Message type is "hello" message (1)
	  $SET	(.MSTYP,MS.CNT,HEL.SZ)	;  Its size
	  $SET	(HEL.NM,,<'IBMSPL'>)	;  Name of the spooler in SIXBIT
	  $SET	(HEL.FL,HEFVER,%%.QSR)	;  QUASAR version
	  $SET	(HEL.NO,HENNOT,1)	;  Max objects spooler handles
	  $SET	(HEL.NO,HENMAX,MAXDEV)	;  Max number of jobs it will handle
TOPS20	 <$SET	(HEL.OB,,.OTIBM)>	;[375] Object
TOPS10	 <$SET	(HEL.OB,HELOBJ,.OTBAT)	;[375] Object
	  $SET	(HEL.OB,HELATR,%IBMBT)>	;[375] Attribute (TOPS-10)
	$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
> ;End of FTIBMS

SUBTTL Database definitions -- ITEXT strings

; USRSPC is user'S name and PPN (TOPS10) or directory (TOPS20)

TOPS10 <
USRSPC:	ITEXT	(<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/ ^U/.EQOID(J)/>)
    >;End if TOPS10

TOPS20 <
USRSPC:	ITEXT	(<^T/.EQOWN(J)/>)
    >;End if TOPS20

;miscellaneous msgs

OLPTER:	ITEXT	(<failed to open hold file ^F/FDBARE/ - cannot receive lpt input.>)
DGLXER:	ITEXT	(<error "^E/S1/">)
DCPERM:	ITEXT	(<copying hold file ^F/@FRB/ to user file ^F/@FRB+1/>)
IBMOAB:	ITEXT	(<aborting output to IBM>)
IBMIAB:	ITEXT	(<aborting input from IBM>)
WRTFLM:	ITEXT	(<while writing file ^F/(P3)/>)
D60ERM:	ITEXT	(<error "^T/@ERRD60-D6HEAD(S1)/">)

; Log file stamps

IBMSG:	ITEXT	(<^C/[-1]/ IBMSG	>)
IBDAT:	ITEXT	(<^C/[-1]/ IBDAT	>)
IBCON:	ITEXT	(<^C/[-1]/ IBCON	>)
IBLPT:	ITEXT	(<^C/[-1]/ IBLPT	>)
JOBID:	ITEXT	(<^I/JOBREQ/ for: ^I/USRSPC/>)
JOBREQ:	ITEXT	(<Job ^W/.EQJOB(J)/ Req # ^D/.EQRID(J)/>)

SUBTTL Symbol definitions -- D60JSY interface

; Error codes & messages

ERRD60:	D60ERR	ASSTXT			; Invoke error definitions


SUBTTL Database definitions -- Miscellaneous cells

WTORNM:	EXP	5000		; ACK code to usr for WTOR (incremented)
MSNDR:	Z			; last IPCF msg sender name

; Dummy Object block

OBJBLK:	EXP	.OTIBM		; We are an IBM object
	EXP	0		; No unit number
	EXP	0		; No station

; Text processing utility

TEXTBP:	Z			; Byte pointer used by DEPBP

DEPBP:	IDPB	S1,TEXTBP	; Store byte at byte pointer
	$RETT			; and return true
; Miscellaneous storage

PRTFAL:	Z			;poll flag for port status failure
SUBTTL Database definitions -- Interrupt system database

TOPS10 <
VECTOR:	BLOCK	0		; Start of interrupt vectors
VECIPC:	BLOCK	4		; IPCF vectors
	ENDVEC==.-1		; Symbol marking last vector
    >;End if TOPS10

TOPS20 <
LEVTAB:	EXP	LEV1PC		; Where to store level 1 PC
	EXP	LEV2PC		; Where to store level 2 PC
	EXP	LEV3PC		; Where to store level 3 PC

CHNTAB:	XWD	1,INTIPC	; IPCF interrupt on level 1
	BLOCK	^D35		; Rest of table

LEV1PC:	EXP	0		; Level 1 PC
LEV2PC:	EXP	0		; Level 2 PC
LEV3PC:	EXP	0		; Level 3 PC
    >;End if TOPS20
SUBTTL Dynamic storage definitions -- Active task list (ATL) entry "A.xxx"

;	!=======================================================!
;	!             Time to wake up in UDT format             !
;	!-------------------------------------------------------!
;	!     Wakeup event bits     !   Address of task block   !
;	!=======================================================!

	DATAST	A,S2			; Data structure prefixed by "A"
					; offset by register S2

$	WKT				; Time to wakeup (UDT) or 0
$	WKB,^D18			; Wakeup conditions that occurred
$	TKB,^D18			; Address of task block
$					; Force new word
$	SIZ,0				; Size of block
SUBTTL Dynamic storage definitions -- Port list entry "P.xxx"

;	!=======================================================!
;	!                      Port number                      !
;	!-------------------------------------------------------!
;	!     First list block      !      Last line block      !
;	!=======================================================!

	DATAST	P,P1			; Data structure prefixed by "P"
					; offset by register P1

$	PRT				; Port number
$	CHN,,,1				; Chain of line blocks on this port
  $.	  FLB,^D18			;  First line block
  $.	  LLB,^D18			;  Last line block
$
$	SIZ,0				; Size of port list entry
SUBTTL Dynamic storage definitions -- Line block list entry "L.xxx"

;	!=======================================================!
;	!                      Line status                      !
;	!-------------------------------------------------------!
;	!     First task block      !      Last task block      !
;	!-------------------------------------------------------!
;	!        Port number        !        Line number        !
;	!-------------------------------------------------------!
;	!                    Line signature                     !
;	!-------------------------------------------------------!
;	!            Station name (SIXBIT node name)            !
;	!-------------------------------------------------------!
;	!      Next line block      !    Previous line block    !
;	!-------------------------------------------------------!
;	!   Console output queue    !    Console input queue    !
;	!=======================================================!

	DATAST	L,LB			; Data structure prefixed by "L"
					; offset by register LB

$	STS,,,1				; Status bits
	  L.SND==1b0			;  Signed on
	  L.SFR==1b1			;  Signoff requested
	  L.SFS==1b2			;  Signoff sent
	  L.UP==1b3			;  Line up
	  L.HSP==1b4			;  Line is HASP
$	TKB,,,1				; Task block chain head
  $.	  FTK,^D18			;  First task in chain
  $.	  LTK,^D18			;  Last task in chain
$	LNI,,,1				; Line information
  $.	  PRT,^D18			;  Port
  $.	  LIN,^D18			;  Line on port
$	SIG				; Line signature
$	NAM				; Station name (for SIGNON/OFF)
$	CHN,,,1				; Chain of LB's on port
  $.	  PFW,^D18			;  Forward pointer
  $.	  PBK,^D18			;  Backward pointer
$	CNO				; Console output queue (from IBM)
$	CNI				; Console input queue (to IBM)
$
$	SIZ,0				; Size of line block
SUBTTL Dynamic storage definitions -- Task block list entry "T.xxx"

;	!=======================================================!
;	!    Wakeup event flags     ! Wake time delay (1/3 sec) !
;	!-------------------------------------------------------!
;	!   Events causing wakeup   !  Active task list entry   !
;	!-------------------------------------------------------!
;	!                                                       !
;	\                   Task's registers                    \
;	!                                                       !
;	!-------------------------------------------------------!
;	!                                                       !
;	\                     Task's stack                      \
;	!                                                       !
;	!-------------------------------------------------------!
;	!     Task/device type      !        Unit number        !
;	!-------------------------------------------------------!
;	!     Next task on line     !   Previous task on line   !
;	!-------------------------------------------------------!
;	!               queue for device requests               !
;	!-------------------------------------------------------!
;	!                Address of object block                !
;	!-------------------------------------------------------!
;	!                      Object type                      !
;	!-------------------------------------------------------!
;	!                      Object unit                      !
;	!-------------------------------------------------------!
;	!                      Object node                      !
;	!-------------------------------------------------------!
;	!               Device handle for D60JSY                !
;	!-------------------------------------------------------!
;	!        Bit for this device in activity status         !
;	!-------------------------------------------------------!
;	!                    $WTOR ACK code                     !
;	!-------------------------------------------------------!
;	!     Initial byte pointer for transmission buffer      !
;	!-------------------------------------------------------!
;	!                                                       !
;	\                Addresses of log pages                 \
;	!                                                       !
;	!-------------------------------------------------------!
;	!               Count of log pages in use               !
;	!-------------------------------------------------------!
;	!                  Count of log lines                   !
;	!-------------------------------------------------------!
;	!                   Input byte count                    !
;	!-------------------------------------------------------!
;	!                  Input byte pointer                   !
;	!-------------------------------------------------------!
;	!   State string address    !  Other task (2780/3780)   !
;	!-------------------------------------------------------!
;	!                   Time job received                   !
;	!-------------------------------------------------------!
;	!                   Time job started                    !
;	!-------------------------------------------------------!
;	!                   Time file started                   !
;	!-------------------------------------------------------!
;	!                   Time file done                      !
;	!-------------------------------------------------------!
;	!              Number of files in request               !
;	!-------------------------------------------------------!
;	!               Number of files processed               !
;	!-------------------------------------------------------!
;	!             Number of records transferred             !
;	!-------------------------------------------------------!
;	!                 Log file spec address                 !
;	!-------------------------------------------------------!
;	!            Address of "get" record routine            !
;	!-------------------------------------------------------!
;	!            Address of "put" record routine            !
;	!-------------------------------------------------------!
;	!     Last "get" error      !     Last "put" error      !
;	!-------------------------------------------------------!
;	!           Address of "check" record routine           !
;	!-------------------------------------------------------!
;	!              Checkpoint routine address               !
;	!-------------------------------------------------------!
;	!                 Record buffer address                 !
;	!-------------------------------------------------------!
;	!		Record buffer size(bytes)		!
;	!-------------------------------------------------------!
;	!               Record buffer byte count                !
;	!-------------------------------------------------------!
;	!              Record buffer byte pointer               !
;	!-------------------------------------------------------!
;	!                Disk buffer byte count                 !
;	!-------------------------------------------------------!
;	!               Disk buffer byte pointer                !
;	!-------------------------------------------------------!
;	!            Transmission buffer byte count             !
;	!-------------------------------------------------------!
;	!           Transmission buffer byte pointer            !
;	!-------------------------------------------------------!
;	! LH of ptr for Xmt buffer  !  Max bytes in Xmt buffer  !
;	!-------------------------------------------------------!
;	!                Unique transaction name                !
;	!-------------------------------------------------------!
;	!                  Input record count                   !
;	!-------------------------------------------------------!
;	!                  Output record count                  !
;	!-------------------------------------------------------!
;	!      Output records left before next checkpoint       !
;	!-------------------------------------------------------!
;	!      Transfer count for forced task descheduling      !
;	!-------------------------------------------------------!
;	!      Cumulative bytes transferred for current job     !
;	!-------------------------------------------------------!
;	!	Job's priority					!
;	!-------------------------------------------------------!
;	!	Queue name					!
;	!-------------------------------------------------------!
;	!	Sequence number					!
;	!-------------------------------------------------------!
;	!	Physical device name				!
;	!-------------------------------------------------------!
;	!	Disposition					!
;	!-------------------------------------------------------!
;	!	Scheduled time					!
;	!-------------------------------------------------------!
;	!	Destination node name				!
;	!-------------------------------------------------------!
;	!	Job name					!
;	!=======================================================!


	DATAST	T,TK			; Data structure prefixed by "T"
					; offset by register TK

$	STS,,,1				; Task wakeup status
  $.	  WKB,^D18			; Desired wakeup bits
		TW.WAK==1B18		;  Wake by another task
		TW.QRQ==1B19		;  QUASAR request received
		TW.LGN==1B20		;  Line gone
		TW.SFR==1B21		;  Signoff requested
		TW.CIR==1B22		;  Console input received
		TW.COR==1B23		;  Console output received
		TW.WMR==1B24		;  Watch/unwatch message received
		TW.SMR==1B25		;  Send message received
		TW.SNR==1B26		;  Signon requested
		TW.SND==1B27		;  Signon done
		TW.ICP==1B28		;  Input complete
		TW.CNI==1B29		;  Console input queued to CNI queue
		TW.IAV==1B30		;  Input available
		TW.CNO==1B31		;  Console output queued to CNO queue
		TW.IOD==1B32		;  Input/output done
		TW.GEN==1B35		;** special wakeup bit for generous tasks **
					; causes a scheduling pass to let
					; other tasks run, then wakes up
					; original task. The task merely
					; turns on TW.GEN in its $DSCHD call;
					; it is self-signalling and results
					; in a time wakeup (i.e. TW.GEN is
					; not set).
  $.	  WKD,^D18			; Wake time delay (in UDT units)
$	WCN,^D18			; Wakeup conditions causing SCHED
$	ATE,^D18			; Entry in active task list

$	ACS,,20				; Task's AC's
$	PDL,,TKPDLN			; Task's stack

$	DEV,,,1				; Device information
  $.	  TYP,^D18			;  Device (or task) type
  $.	  UNI,^D18			;  Unit number

$	CHN,,,1				; Chain of tasks on a line block
  $.	  PFW,^D18			;  Forward link
  $.	  PBK,^D18			;  Backward link

$	QOB				; queue object type for queue request
					; to QUASAR

$	OBA				; Address of object block
$	OBJ,,3,1			; Object block
  $.	  OTY				;  Type
  $.	  OUN				;  Unit
  $.	  ONO				;  Node
$	DHA				; Device handle from D60JSY
$	BIT				; Bit representation for this device
$	WAC				; $WTOR ack code
$	XBA				; Initial byte pointer for xmt buffer
$	GBA,,LGNUM			; Addresses of log pages
$	GCT				; Count of log pages in use
$	GLN				; Count of log lines
$	GIC				; Input byte count
$	GIP				; Input byte pointer
$	DST,^D18			; State description address (ASCIZ)
$	OTK,^D18			; Other task address (used by 2780/3780
					;  CDR to save LPT and LPT to save CDR
$	TMR				; Time job received
$	TMS				; Time job started
$	TFS				; Time of 1st io to/from front end
$	TFD				; Time of last io to/from front end
$	NFL				; Number of files in request
$	NFP				; Number of files processed
$	NRS				; Number of records transferred
$	LFS				; Address of log file spec
$	GTR				; Address of routine for gets
$	PTR				; Address of routine for puts
$	GTE,^D18			; Last error on get
$	PTE,^D18			; Last error on put
$	CKR				; Check record routine
$	CKP				; Address of checkpoint routine
$	RIA				; Record buffer address
$	RBS				; record buffer size
$	RIC				; Record buffer byte count
$	RIP				; Record buffer byte pointer
$	DIC				; Disk buffer byte count
$	DIP				; Disk buffer byte pointer
$	XRC				; Transmission buffer byte count
$	XRP				; Transmission buffer byte pointer
$	XBT,^D18			; Left half of byte ptr for xmt buffer
$	XBN,^D18			; Max bytes fitting into xmt buffer
$	RNM				; Unique name for transaction
$	ICT				; Input record count
$	OCT				; Output record count
$	OCK				; Minus records before checkpoint
$	SNZ				; Forced task descheduling counter
$	TBC				; Transferred byte count
$	PRI				; job's priority
$	QNM				; Queue name
$	SEQ				; Sequence number
$	PDV				; Physical device name
$	DSP				; Disposition
$	STM				; Scheduled time
$	NOD				; destination node name
$	LNM				; hold file name
$	FRM				; forms
$	STR				; structure
$
$	SIZ,0				; Size of block
SUBTTL Interrupt code -- INTINI, Interrupt system initialization

; Here to initialize interrupt system

TOPS10 <
INTINI:	MOVEI	S1,INTIPC		; Address of IPCF interrupt routine
	MOVEM	S1,VECIPC+.PSVNP	; Save it in the vector
	$RETT				; Return true always
    >;End if TOPS10

TOPS20 <
INTINI:	MOVX	R1,.FHSLF		; Get fork handle
	MOVX	R2,1B0!1B1		; Set channels 1 and 0
	AIC				; Activate interrupt channels
	$RETT				; Return
    >;End if TOPS20


SUBTTL Interrupt code -- INTIPC, IPCF Interrupt routine

INTIPC:	$BGINT	1,			; Set up interrupt context
	$CALL	C%INTR			; Call GLXLIB routine to post interrupt
	$DEBRK				; Exit interrupt
SUBTTL Initialization code

IBMSPL:	RESET				; Clear out I/O system in case of start
	MOVE	P,[IOWD PDSIZE,PDL]	; Load stack pointer with initial value
	MOVEI	S1,IB.SZ		; Put size of initialization
	MOVEI	S2,IB			; block and address in argument regs
	$CALL	I%INIT			; and initialize GLXLIB
	MOVEI	S1,<LOWEND-LOWBEG>	; Get size of area to be zeroed
	MOVEI	S2,LOWBEG		; and start address
	$CALL	.ZCHNK			; and call GLXLIB routine to do it
IBMSP0:	SETO	S1,			; turn on SYSERR logging
	D60	D60INI,IBMSP0		; Initialize interface to DN60
	$CALL	INTINI			; Initialize interrupt system
	$CALL	OPDINI			; Get operating system information
	$CALL	I%ION			; Turn on interrupts
	PUSH	P,P1			; send hello to QUASAR when it comes up
	MOVEI	P1,^D300/^D30		; 30 second retries for 5 minutes
IBMSP1:	MOVEI	T1,HELLO		; Point to "hello" message
	$CALL	SNDQSR			; and send it to QUASAR
	JUMPT	IBMSP2			; did it!
	SOJL	P1,	[POP	P,P1
			 JRST	QSRDTH]	; die ignomineously
	HRROI	S1,[ASCIZ	\IBMSPL sleep - waiting for QUASAR to start
\]
	$CALL	K%SOUT			; tell the user
	MOVEI	S1,^D30			; still hoping for the best
	$CALL	MISLP			; retire a while
	JRST	IBMSP1			; and try again
IBMSP2:	POP	P,P1			; QUASAR is alive & well
	$CALL	L%CLST			; Create a linked list
	MOVEM	S1,TSKNAM		; Save handle for task list
	$CALL	L%CLST			; Create another
	MOVEM	S1,LBNAM		; Save handle for line list
	$CALL	L%CLST			; Create another
	MOVEM	S1,WATNAM		; Save handle for line list
	$CALL	L%CLST			; Create list for the active task list
	MOVEM	S1,ATLNAM		; Save name for future use
FTACCT<	$CALL	ACTINI>			; Set up accounting
	JRST	MAIN			; Start main loop
SUBTTL Scheduler -- MAIN loop

; Routine - MAIN
;
; Function - This is the main scheduling loop.  Whenever there is a task
;	to be scheduled this loop is executed.  Also there are two special
;	tasks that get scheduled after a pass through the active task list.
;	These are the IPCF message processor and the active device POLLer.
;
;	After all tasks have been conditionally run, a check is made against
;	the flag SCHDGO.  If this is non-zero, another scheduling pass will
;	be made of the active task list immediately.  Otherwise the job will
;	go to sleep.  This flag is set non-zero by ACTTSK (activate task)
;	and SGNTSK (signal task).
;
;	The sleep time is the minimum of three values: WAKTIM (least time
;	set by any task to wakeup), POLTIM (time to poll for activity flags),
;	and 60 seconds.
;
;	After sleeping a check against WAKTIM is done to see if it is time
;	to schedule active tasks.  If not, the IPCF message queue is checked
;	and POLLing is conditionally done.
;
;	The flow of the scheduler is such that each routine that uses a
;	substantial amount of time is responsible for updating the cell NOW
;	which contains the current time.  The routines that currently update
;	NOW are SCHED, MSGCHK and POLL.

MAIN:	$CALL	I%NOW			; Get current time
	MOVEM	S1,NOW			; Save it
	MOVEM	S1,POLTIM		; Save as next time to poll
	SETOM	SCHDGO			; make sure we schedule 1st time around
	JRST	MAIN.3			; enter the primary schedule loop

MAIN.1:	SETZM	SCHDGO			; Clear scheduling pass flag
	MOVE	S1,POLTIM		; poll time is the outer bound time
	MOVEM	S1,WAKTIM		; Save as next time to wakeup scheduler
	MOVE	S1,ATLNAM		; Get name of Active Task List
	$CALL	L%FIRST			; Point to first entry on list
	JUMPF	MAIN.3			;  If none .. go check IPCF queue

MAIN.2:	$CALL	SCHED			; Go conditionally schedule task
	$CALL	I%NOW			; update the local clock
	MOVEM	S1,NOW
	$CALL	MSGCHK			; Check for IPCF messages
	MOVE	S1,ATLNAM		; Get name of list again
	$CALL	L%NEXT			; Point to next entry on active list
	JUMPT	MAIN.2			;  If there is one, try to sched it

MAIN.3:	$CALL	MSGCHK			; Check for IPCF messages
	MOVE	S1,POLTIM		; Get polling time
	CAMG	S1,NOW			; Check if it's time yet
	$CALL	POLL			;  Yes .. poll for new activity
	SKIPE	SCHDGO			; Check for another pass to be done
	JRST	MAIN.1			;  Yes .. some task has been signaled
	MOVE	S1,WAKTIM		; Get minimum time to make next pass
	CAMG	S1,NOW			; Check if it's time already
	JRST	MAIN.1			;  Yes .. go do another pass
	SUB	S1,NOW			; Calculate time to sleep
	ADDI	S1,2			; in seconds, insuring
	IDIVI	S1,3			; at least one second sleep
	CAIL	S1,^d30			; Check for greater than 1/2 minute
	MOVEI	S1,^d30			;  Yes .. limit to 1/2 minute max
	$CALL	I%SLP			; Go to sleep
	$CALL	I%NOW			; Get current time

MAIN.5:	MOVEM	S1,NOW			; Save it
	JRST	MAIN.3			; check messages and new device activity
SUBTTL Scheduler -- SCHED, Schedule a task

; Routine - SCHED
;
; Function - To conditionally schedule tasks.  This routine is called
;	with the address of an Active Task List entry.  This entry
;	is checked against NOW and the flags in the associated TasK Block
;	to see if the task should be run.  If it is to be run the
;	wakeup conditions are set, MAIN context PDL saved, and the task
;	context restored.  If it is not to be run, WAKTIM is updated
;	to the the minimum of this task's wake time and the previous
;	value.
;
;	See also the co-routine DESCHD, which is called when a task
;	wishes to switch back to MAIN context.
;
; Parameters -
;
;	S2/	Address of Active Task List entry
;
; Note - This routine destroys all registers except the stack pointer.


SCHED:	LOAD	TK,,A.TKB		; Get address of TasK Block
	LOAD	T1,,A.WKB		; Get events to wake up task with
	LOAD	T2,,T.WKB		; Get events task is waiting for
	LOAD	T3,,A.WKT		; Get time to wakeup task at
	AND	T2,T1			; Mask events
	JUMPN	T2,OKSCHD		; If event hit, schedule task
	JUMPE	T3,.POPJ		; If no wakeup time, return to MAIN
	CAMG	T3,NOW			; Check against current time
	 JRST	OKSCHD			; Yes .. schedule task
	CAMG	T3,WAKTIM		; No, check against minimum sleep time
	 MOVEM	T3,WAKTIM		; Minimum seen so far .. save it
	$RET				; Return to MAIN

OKSCHD:	HRRZM	S2,CURATE		; Save address of current active task
	ANDCM	T1,T2			; Clear events causing wakeup
	STORE	T1,,A.WKB		; Save events yet to be woken on
	TXZ	T2,TW.IOD		; don't record TW.IOD as wakeup condition
	STORE	T2,,T.WCN		; Save event flags causing wakeup
	ZERO	,A.WKT			; Clear wakeup time
	MOVEM	P,PDLSAV		; Save MAIN stack context
	MOVSI	R17,T%ACS		; Swap registers for the
	BLT	R17,R17			; current task's registers
	POPJ	P,			; Return to task
SUBTTL Scheduler -- DESCHD, Deschedule a task

; Routine - DESCHD
;
; Function - To deschedule a task and return to MAIN context.  This routine
;	saves the current task context (if it still exists), updates the
;	current time.
;	If the task descheduling itself is deactivated the cell CURATE
;	(Current Active Task list Entry) should be cleared.  If the task
;	has deleted itself (task no longer exists) the task block pointer
;	(register TK) should be cleared.
;
;	The normal manner for calling is this routine is through the
;	$DSCHD macro.
;
; Parameters -
;
;	TF/	Wakeup-events,,Wakeup-time-delay
;	TK/	Address of this task's task block
;		 (If zero, then this task has deleted itself)
;	CURATE/	Address of pointer into Active Task List
;		 (If zero, then this task has deactivated itself)

DESCHD:	SETOM	SCHDGO			; ensure a second scheduling loop
	JUMPE	TK,[MOVE P,PDLSAV	; If task deleted itself
		    SETZM CURATE	;  Yes .. reset from task context
		    $RET]		;  Return to main context
	MOVEM	TF,T%STS		; Save wakeup status flags
	MOVEM	R0,R0+T%ACS		; Save a scratch register
	MOVEI	R0,R1+T%ACS		; Save the task's register
	HRLI	R0,1			; context
	BLT	R0,R17+T%ACS		; in the task block
	MOVE	P,PDLSAV		; Get MAIN stack context back

	SKIPN	CURATE			; Is task still active
	$RET				;  No .. just retun to MAIN context
	SETZM	CURATE			; Clear task context flag
	ZERO	,T.WCN			; Clear events woken on
	LOAD	S2,,T.ATE		; Point to Active Task List entry
	JUMPE	S2,.POPJ		; If deactivated, return to MAIN
	$CALL	I%NOW			; Get current time
	MOVEM	S1,NOW			; Save what time it is
	LOAD	T1,,T.WKB		; get conditions on which to be awakened
	TXNN	T1,TW.GEN		; is task being generous (i.e. giving up
					; CPU to other tasks)?
	JRST	DESCH1			; no, just continue
	MOVE	T1,NOW			; get current time
	STORE	T1,,A.WKT		; store it as time to wake him up
	$RET				; return to scheduling loop

DESCH1:	ZERO	,A.WKT			; Clear time to wake up at
	LOAD	T1,,T.WKD		; Get wakeup time delay
	JUMPE	T1,.POPJ		; If none, go try to SCHED on events
	ADD	T1,NOW			; Get time when to wake task
	STORE	T1,,A.WKT		; Save for SCHED
	$RET
SUBTTL Scheduler -- ACTTSK, activate a task

; Routine - ACTTSK
;
; Function - Trys to activate a task, puts new entry on active task list for
;	the newly activated task.  If task already active it just returns.
;
; Parameters - TK/ Address of task to be activated.
;
; Returns - True it task activated, false if cannot make ATL entry
;
; Note - Destroys S2
;	 Changes current entry for active task list


ACTTSK:	SKPE	S1,,T.ATE		; Get active task list pointer
	 $RETT				;  Already active, so return
	MOVE	S1,ATLNAM		; Get name of Active Task List
	MOVEI	S2,A$SIZ		; Get size of entry
	$CALL	L%CENT			; Create an entry
	 JUMPF	.POPJ			;  If cannot, propagate failure
	STORE	TK,,A.TKB		; Save task address in ATL entry
	STORE	S2,,T.ATE		; Save ATL entry address in task block
	LOAD	S1,,T.WCN		; Get saved wakeup conditions
	STORE	S1,,A.WKB		; Save in wakeup bits
	ZERO	,T.WCN			; Clear wakeup conditions
	LOAD	S1,NOW			; Get current time
	STORE	S1,,A.WKT		; store as wakeup time so task will run
	SETOM	SCHDGO			; Force another scheduling pass
	$RETT				; Return true
SUBTTL Scheduler -- DEATSK, Deactivate a task

; Routine - DEATSK
;
; Function - Removes a task from the Active Task List (ATL) and goes back
;	to the scheduler.  This routine assumes normal operation of the
;	scheduler.  Also it assumes that only the task that is running
;	can deactivate itself.  Therefore the Active Task List should
;	be pointing directly at the task.
;
; Parameters - TK/ Address of task to deactivate
;
; Returns - Doesn't return until task is reactivated
;
; Note - Changes "current" entry of active task list


DEATSK:	$SAVE	<S1,S2,T1>

	MOVE	S1,ATLNAM		; Get handle for list
	LOAD	T1,,T.ATE		; Get pointer to current entry
	$CALL	L%CURR			; Position to current entry
	 JUMPF	DEATS1			;  If none, start at beginning
	CAMN	T1,S2			; Is this the proper entry?
	 JRST	DEAFND

DEATS1:	$CALL	L%FIRST			; Start from top of list
	 JUMPF	DEAERR			; If no entries at all .. stop

DEATS2:	CAMN	T1,S2			; Is this our entry?
	 JRST	DEAFND			;  Yes, go delete it
	$CALL	L%NEXT			; No, point to next entry
	 JUMPF	DEAERR			;  No more entries .. error
	JRST	DEATS2			; Go try this entry

DEAFND:	LOAD	S1,,A.WKB		; Get events that have already happened
	STORE	S1,,T.WCN		; Save in convenient place
	LOAD	S1,ATLNAM		; Get handle for active task list again
	$CALL	L%DENT			; Delete it
	 JUMPF	DEAERR			;  If we cannot, stop
	ZERO	,T.ATE			; Clear active task entry
	$DSCHD	DEACTIVATE		; Return to MAIN
	$RET				; Task has been re-activated

DEAERR:
TOPS20	<$STOP	TNE,<Task not active>>
TOPS10	<STOPCD	(TNE,HALT,,<Task not active>)>
SUBTTL Scheduler --  WAKTSK, wake a task unconditionally

; Routine - WAKTSK
;
; Function -  If task is not active it is activated; then it set wakeup time
;	to "NOW" so scheduler will pick it up on next pass.
;
; Parameters - TK/ Address of task block to be awakened
;
; Returns - True always
;
; Note - Destroys S1 and S2
;	 May move current entry for active task list (ATL)
;	 Stopcodes if active task entry cannot be created.

WAKTSK:	SKPE	S2,,T.ATE		; Is task active?
	 JRST	WAKTS1			;  Yes, just set time
	$CALL	ACTTSK			; No, activate it
	 JUMPF	WAKERR			;  If failed .. fatal error
WAKTS1:	MOVE	S1,NOW			; Get current time
	STORE	S1,,A.WKT		; Store it as wake time
	SETOM	SCHDGO			; Force another scheduler pass
	$RETT				; Return true

WAKERR:
TOPS20	<$STOP	CAT,<Cannot activate task>>
TOPS10	<STOPCD	(CAT,HALT,,<Cannot activate task>)>
SUBTTL Scheduler -- SGNTSK, signal a task

; Routine - SGNTSK
;
; Function -  Sets argument bits in active list entry to flag a condition
;	for a task.
;
; Parameters - TK/ Task to be signalled
;	       S1/ Bits to signal task with in RH
;
; Returns - True if task is active, false if task is not already active
;
; Note - Destroys S2


SGNTSK:	LOAD	S2,,T.ATE		; Get active list entry
	JUMPE	S2,.RETF		; If not active return error
	PUSH	P,S1			; save original bits [4(240)]
	PUSH	P,S2			; Save it for a bit
	LOAD	S2,,A.WKB		; Get existing bits
	IOR	S1,S2			; OR into desired bits
	POP	P,S2			; Get ATL entry address back
	STORE	S1,,A.WKB		; Store the new wakeup bits
	POP	P,S1			; get back original bits [4(240)]
	SETOM	SCHDGO			; Force another scheduler pass
	$RETT				; Return true
SUBTTL Scheduler -- SGNLIN, signal all tasks on a line

; Routine - SGNLIN
;
; Function - Sets argument bits for all tasks on a particular line.
;
; Parameters - LB/ Line whose tasks are to be signalled
;	       S1/ Bits in RH to signal tasks with
;
; Returns - True always
;
; Note - Destroys S2


SGNLIN:	$SAVE	<TK>			; Save task pointer
	LOAD	TK,,L.FTK		; Get first in line block chain
	JUMPE	TK,.RETT		; If none, done

SGNLI1:	$CALL	SGNTSK			; Set bits
	LOAD	TK,,T.PFW		; Get pointer to next task
	JUMPN	TK,SGNLI1		; If there is one, go back to loop
	$RETT				; Return true
SUBTTL Scheduler -- POLL, active device signalling

; Routine - POLL
;
; Function - This routine loops through the port list (tags POLL0-POLL0E)
;	reading the port status.  For each port it loops through the line
;	blocks chain to the port block (POLL1-POLL1E); for each line block
;	it loops through all the TKB's associated with it.  If the active
;	bit is on for that device in the port status and the task is waiting
;	for I/O done (TW.IOD) to set, it wakes the task.  After looking at
;	all the tasks on a line, if there are still active bits unaccounted
;	for it creates new tasks to handle them.  Finally, it sets up a new
;	value for POLTIM (when to do next poll).


POLL:	SKIPN	S1,PTLNAM		; Is there a port list yet?
	JRST	POLLEX			;  No, so don't bother checking
	$CALL	L%FIRST			; Yes, point to first entry

; Loop to look at each port

POLL0:	JUMPF	POLLEX			; Exit loop if no entry
	MOVE	P1,S2			; Get pointer to port entry
POLL0R:	LOAD	S1,,P.PRT		; Get port number
	HRLI	S1,.STPRT		; and flag that it is multiple status
	MOVEI	S2,DEVBTS		; Where to put device bits
	D60	D60STS,POLL0R,0		; Get status
	SETCAM	TF,PRTFAL		; save success/failure for later checking
	LOAD	LB,,P.FLB		; Point to first line block

; Loop to look at each line on the current port

POLL1:	LOAD	S1,,L.LIN		; Get line number
	SKIPN	P2,PRTFAL		; dummy all active bits set if port status failed
	MOVE	P2,DEVBTS(S1)		; Get the active bits for that line
	JUMPE	P2,POLL1E		; If none are active, try next line
	LOAD	TK,,L.FTK 		; Get control task TKB pointer
	TXC	P2,BUNUSD		; Complement bits for line abort check
	TXCN	P2,BUNUSD		; Is it the abort bits?
	 JRST	[$CALL	ACTTSK		;  Activate it (in case its 2780/3780)
		 $SIGNL	TW.LGN		;  Signal control task, line has gone
		 JRST	POLL1E]		;  and go on to next line

; Loop to look at each task on a line

POLL2:	LOAD	P3,,T.BIT		; Get bit for this device
	JUMPE	P3,POLL2E		; If none, go select next device
	TDZN	P2,P3			; Is active bit is on for this device?
	 JRST	POLL2E			;  No, continue scanning TKB's
	LOAD	S1,,T.WKB		; Get bits task wants to wake on
	TXNN	S1,TW.IOD		; Is it waiting for I/O done?
	 JRST	POLL2E			;  No, go look at next device
	$SIGNL	TW.IOD			; Yes, signal that I/O done occurred

; Advance to next device in task chain on current line

POLL2E:	LOAD	TK,,T.PFW		; Get next TKB entry
	JUMPN	TK,POLL2		; If we got one, go back to check it

; Advance to next line on port

POLL1E:	LOAD	LB,,L.PFW		; Get forward chain pointer
	JUMPN	LB,POLL1		; If there was one, go back to check it

; Get next port

POLL0E:	MOVE	S1,PTLNAM		; Get handle name
	$CALL	L%NEXT			; Advance to next entry
	JRST	POLL0			; and go back


; Done polling

POLLEX:	$CALL	I%NOW			; Get current time
	MOVEM	S1,LSTPOL		; track time polled
	ADDI	S1,POLINT		; Add polling interval
	MOVEM	S1,POLTIM		; to make new poll time
	$RET				; Return to MAIN context
SUBTTL Scheduler IPCF handling -- MSGCHK, message checker

; Routine - MSGCHK
;
; Function - This is a special purpose task executed by the MAIN routine.
;	For each IPCF message that exists the routine MSGPRC is called.
;	If any message processing routine causes the change in state
;	of a task the flag SCHDGO is set.  After each message is processed
;	the current time NOW is updated.
;
; Returns - always
;
;	NOW/	Most current time
;	SCHDGO/	Turned on if any task state is changed

MSGCHK:	$CALL	C%RECV			; Get the next IPCF message
	 JUMPF	.POPJ			;  If none .. just return
	$CALL	MSGPRC			; Process this message
	 $CALL	C%REL			;  Now, .. release it
	$CALL	I%NOW			; Get current time
	MOVEM	S1,NOW			; Save it
	JRST	MSGCHK			; Go onto next message
SUBTTL Scheduler IPCF handling -- MSGPRC, IPCF message processor

; Routine - MSGPRC
;
; Function - This subroutine processes IPCF messages received from QUASAR
;	and ORION.  MSGPRC determines if message is from someone it knows,
;	and then dispatches to the proper message processing routine.
;
;	Upon entry, S1 has the address of the Message Data Block (MDB) for the
;	message. When this routine dispatches to the message processors, P1
;	will have the address of the message and S will have flags indicating
;	what type of program sent the message, whether or not it is for
;	HASP line, etc.


MSGPRC:	MOVEM	S1,MDBADR		; Store message data block address
	MOVE	S2,MDB.SI(S1)		; Get special index word
	SETZ	S,			; Clear flags
	TXZN	S2,SI.FLG		; Are we using special system index?
	$RET				;  No, don't process it
	TXO	S,F.IPCSY		; Indicate we have a system message
	CAIE	S2,SP.OPR		; It better be ORION
	CAIN	S2,SP.QSR		; or QUASAR
	 JRST	MSGPR1			;  Yes, go process it
	$WTOJ	<Bad IPCF message>,<Message received from unknown system component (^O/S2/)>,OBJBLK
	$RET				; Return to main loop after error

; Here after checking system message source


MSGPR1:	MOVE	P1,MDB.MS(S1)		; Get address of message
	CAIE	S2,SP.OPR		; save name of sender
	SKIPA	S1,[[ASCIZ /QUASAR/]]
	MOVEI	S1,[ASCIZ /ORION/]
	MOVEM	S1,MSNDR
	LOAD	S1,.MSTYP(P1),MS.TYP	; Get message type
	MOVSI	S2,-NMSGT		; Make AOBJN pointer for table

; Loop to scan MSGTAB for processing routine for this message

MSGPR2:	HRRZ	T1,MSGTAB(S2)		; Get message type from current entry
	CAMN	T1,S1			; Is it the same as our message?
	 JRST	MSGPR3			;  Yes, go process it
	AOBJN	S2,MSGPR2		; No keep looking
	$WTOJ	<Bad IPCF message>,<Message received from ^T/@MSNDR/ with unknown type code (^O/S1/)>,OBJBLK
	$RET				; Return to main loop

; Here when we have found MSGTAB entry for this message type

MSGPR3:	HLRZ	T2,MSGTAB(S2)		; Get entry vector address for msg type
	JUMPE	T2,.POPJ		; If no vector, ignore message
	MOVE	T2,@T2			; Get contents of vector
	TXNE	S,F.IPCSY		; Are we processing system request?
	 MOVS	T2,T2			;  Yes, swap vector
	HRRZ	T2,T2			; Clear out inappropriate half
	JUMPN	T2,@T2			; If we still have an address, go to it
	$WTOJ	<Invalid IPCF message type>,<"^T/MSGTNM(S2)/" message received from ^T/@MSNDR/ not valid for this component type>,OBJBLK
	$RET				; Return to main loop after error


; Table of type,,entry vector for message process dispatch
; Entry vector points to a word that contains dispatch addresses:
;	system-message-routine,,non-system-message-routine

MSGTAB:	XWD	VSETUP,.QOSUP		; Setup/shutdown message
	XWD	VUSRCN,.QOABO		; User cancel
	XWD	VNXTJB,.QONEX		; Nextjob
	XWD	VOPRCN,.OMCAN		; Operator cancel
	XWD	VSNDCI,.OMSND		; Send console message to IBM
	XWD	VSTATS,.OMSHS		; ORION show status command
	XWD	VRQCHK,.QORCK		; Request for a checkpoint
	XWD	TEXTMS,MT.TXT		; Text message
	XWD	0,.OMPAU		; Stop message
	XWD	0,.OMCON		; Continue message
	XWD	VRQMSG,.OMREQ		; Requeue message
NMSGT==.-MSGTAB				; Size of table

MSGTNM:	ASCIZ	\Setup/shutdown\
	ASCIZ	/User cancel/
	ASCIZ	/Nextjob/
	ASCIZ	/Operator cancel/
	ASCIZ	/Send console message to IBM/
	ASCIZ	/ORION show status command/
	ASCIZ	/Request for a checkpoint/
	ASCIZ	/Text/
	ASCIZ	/Stop/
	ASCIZ	/Continue/
	ASCIZ	/Requeue/
SUBTTL Message processors -- TEXTMS, Text message response

; Routine - TEXTMS
;
; Function - To send a text IPCF message that IBMSPL has received to
;	OPR.

;	P1/QUASAR message ptr

TEXTMS:	XWD	TEXTM1,TEXTM1

TEXTM1:					;QUASAR sends these(null) to see who
					; is still around
	$RET				; Return to main loop
SUBTTL Message processors -- SETUP, Setup/shutdown message

; Routine - SETUP
;
; Function - This routine loads some important information (such as line,,port
;	and device type,,unit into P3 and P4) then decides what to do;
;	whether to setup or shutdown a whole station.  Throughout this
;	processing, P1 has the address of the message, P3 has port,,line
;	and P4 has type,,unit-number.

;	P1/QUASAR message ptr

VSETUP:	XWD	SETUP,0			; Only system msgs may setup/shutdown

SETUP:	MOVE	P3,SUP.CN(P1)		; Get port,,line number
	MOVE	P4,SUP.UN(P1)		; Get unit number from message
	HRLI	P4,.TCDR		;  and make into dev,,uni
	MOVE	T4,SUP.NO(P1)		; Get station name from message
	LOAD	T3,SUP.CN(P1),CN$SIG	; Get line signature from message
	LOAD	S2,SUP.ST(P1),NT.TYP	; Get station type field
	CAIN	S2,DF.HSP		; Is it HASP?
	 TXO	S,F.HASP		;  Yes, light our HASP bit

	MOVE	S2,SUP.FL(P1)		; Get flags word from message
	TXNN	S2,SUFSHT		; Is it really shutdown?
	 JRST	SETALL			;  No .. go setup station
	MOVE	S1,T4			; Node name for FNDNOD routine
	SETZ	LB,			; Clear LB to say LB not found yet
	$CALL	FNDNOD			; Go find line block for this node
	LOAD	P3,,L.LNI		; Get port,,line from line block
	JRST	SHTALL			; Shut down all
SUBTTL Message processors --  SETALL, setup a new station

; Routine - SETALL
;
; Function - To build the line block and associated tasks for a new
;	station.
;
;	The tasks created are chained to the line block and have
;	forward/reverse links between all of them.  For a 2780/3780
;	station there is a control task (to do signon/signoff), a card
;	reader task (to send jobs to the IBM host), a line printer task
;	(to read jobs from the IBM host), a console input task (to accept
;	data, from the operator, to be sent to the IBM host as console
;	input), and a send task (which sends the console output back to
;	the operators).  A HASP station gets all the tasks given to a
;	2780/3780 station plus a punch task (to read punch jobs from
;	the IBM host) and a console output task (to read console output
;	from the IBM host and give it to the send task for distribution).
;
;	After all the tasks are built the card reader task is started.
;	When this line initialization has been done and the line to the
;	stations is signed on, a setup response message is sent back to
;	QUASAR indicating either success or failure.  If a failure occured
;	control is passed to the shutdown routines and the all the setup
;	that just executed is undone.
;
; Parameters -
;
;	P1/	Address of setup message
;	P3/	Port,,line
;	P4/	Dev,,unit
;
; Returns -
;
;	P2/	Response code for setup response

SETALL:	MOVX	P2,%RSUDE		; Pre-load pessimistic setup response
	MOVE	S1,P3			; Get port,,line
	$CALL	MAKLB			; Create a line block for port,,line
	JUMPF	SETCHK			; [363] Can't
	$CALL	I%NOW			; get the time
	MOVE	T2,S1			; save it for the duration of line condition
	JRST	SETAL0

SETALA:	$CALL	I%NOW			; check on time
	SUB	S1,T2			; delta t from start
	JUMPL	S1,SETER1		; just in case this gets screwed up
	CAILE	S1,^D30*3		; allow 30 seconds to enable line
	JRST	SETER1			; something is wrong

SETAL0:	MOVEI	S1,0(P1)		; Get address of setup message
	D60	D60CND,SETALA		; Condition the line to what is needed
	JUMPF	SETER2			;  Couldn't condition line .. fail

	$CALL	LINSTS			; get line status

	STORE	T4,,L.NAM		; Save name of station in line block
	LOAD	T4,,L.STS		; Get line status flags
	LOAD	T1,S,F.HASP		; Get HASP bit from status in S
	SKIPE	T1			; Check for HASP flag on
	 IORX	T4,L.HSP		;  Yes .. turn on HASP flag
	STORE	T4,,L.STS		; Set new line status

	TXNE	S,F.HASP		; See if HASP line
	SKIPA	T1,[XWD -SETHSN,SETHSP]	;  Yes, get HASP task table instead
	MOVE	T1,[XWD -SETTKN,SETTSK]	; Default to 2780/3780 task table

; Loop to add all tasks in appropriate task table

SETAL1:	MOVE	S1,0(T1)		; Get current task table entry
	SETZ	S2,			; Make a default device 0
	$CALL	BLDTSK			; Build task for it and acquire device
	JUMPF	SETSN1			; If either no core or couldn't get
					;  device, send error to QUASAR
	AOBJN	T1,SETAL1		; Loop through whole table

	DMOVE	S1,P3			; Get parameters to identify device
	$CALL	FNDTSK			; Search existing tasks for this device
	 JUMPT	SETOK			; If there go initialize it
	HRRZ	S1,P4			; Get unit number
	JUMPE	S1,SETADD		; If 0, then no need for more checking
	TXNN	S,F.HASP		; If non-zero, is this a HASP line?
	 JRST	SETSN1			;  No, don't allow it

; Here to add main card reader task to chain

SETADD:	MOVEI	S1,.TCDR		; Get task type
	HRRZ	S2,P4			; Get unit number
	$CALL	BLDTSK			; Build the task
	JUMPF	SETSN1			; If error, inform QUASAR no device

; Here when main task is built

SETOK:	$CALL	INIPAG			; Set up job pages
	JUMPF	SETSN1			; Cannot; tell QUASAR to give up
	STORE	LB,LB+T%ACS		; Save line block address in
					; task's LB register

	MOVE	T1,SUP.TY(P1)		; Get batch stream object type
	STORE	T1,,T.OTY		; Store in task block
	MOVE	T1,SUP.UN(P1)		; Get object unit from message
	STORE	T1,,T.OUN		; Store in task block
	MOVE	T1,SUP.NO(P1)		; Get object node from message
	STORE	T1,,T.ONO		; Store in task block
	MOVEI	T1,T%OBJ		; Get address of object block
	STORE	T1,,T.OBA		; and store it away
	$CALL	ACTTSK			; Activate the main task
	MOVX	P2,%RSUOK		; Indicate we have device

; Send setup response to QUASAR (P2 has code)

	LOAD	S1,,L.STS		; Get line status bits
	TXC	S1,L.UP!L.SND		; is line up and signed on ?
	TXCE	S1,L.UP!L.SND
	JRST	SETSN0			; no - setttle back and rest til SIGNON

; Here to send response to QUASAR

SETSN1:	MOVE	S1,P2			; Get response code
	$CALL	RSETUP			; Send the response to setup message
	MOVE	S1,SUP.UN(P1)		; Get unit from request
	STORE	S1,OBJBLK+1		; Store in unit
	MOVE	S1,SUP.NO(P1)		; Get node
	STORE	S1,OBJBLK+2		; Store it in object block
	$WTOJ	<Setup response>,<^1/SUP.TY(P1)/ ^O/SUP.UN(P1)/ on ^N/SUP.NO(P1)/ ^T/@SETMSG(P2)/>,OBJBLK

	JUMPE	LB,SETSN0		; no need to shut down if no line block
	CAIN	P2,%RSUOK		; Was it all right?
	JRST	SETSN0			; yes - exit
	$CALL	DISABL			; no - disable the line
	JRST	SHTAL0			; go shutdown the whole shmear

; Here to exit setup message processing

SETSN0:	AOS	S1,WTORNM		; Make a unique number
	STORE	S1,,T.WAC		; and save it as $WTOR ack code
	$RET				; Yes, return to message processor

SETCHK:					; [363] Here on failure to set up
					;       line block
	JUMPE	LB,SETSN1		; [363] If no LB, fail now.
	LOAD	S1,,L.STS		; [363] Get line status
	TXNN	S1,L.SFR		; [363] Is signoff pending
	 JRST	SETSN1			; [363]  No
	SETZ	LB,0			; [363]  Yes, don't force shutdown now
	$WTOJ	<failed to restart node>,<previous SHUTDOWN still in progress for node ^N/SUP.NO(P1)/>,SUP.TY(P1)	; [363]
	JRST	SETSN1			; [363]

SETER1:	$WTOJ	<failed to condition line>,<timed out attempting to condition  line for node ^N/SUP.NO(P1)/>,SUP.TY(P1)
	JRST	SETSN1

SETER2:	$WTOJ	<failed to condition line>,<^I/D60ERM/ while trying to condition line for node ^N/SUP.NO(P1)/>,SUP.TY(P1)
	JRST	SETSN1


SETMSG:	[ASCIZ /started/]		; This message if started
	EXP	0			; Temporarily unavailable
	[ASCIZ /not available/]		; This message if failed


; Task tables
;	Entry format is type code (.Txxx where xxx is device)
;	in LH, and first entry point of task in RH.

SETTSK:	EXP	.TCTL			; Control task MUST be first
	EXP	.TLPT			; LPT task
	EXP	.TCDR			; CDR task
	EXP	.TSND			; Console output distributor task
SETTKN==.-SETTSK			; Length of table

SETHSP:	EXP	.TCTL			; HASP control task (must be first)
	EXP	.TLPT			; HASP line printer task
	EXP	.TCDP			; HASP card punch task
	EXP	.TCDR			; HASP card reader task
	EXP	.TCNO			; HASP console output receiver task
	EXP	.TSND			; Console output distributor (not HASP specific)
	EXP	.TCNI			; HASP console input sender task
SETHSN==.-SETHSP			; Length of HASP table
SUBTTL Message processors --  SHTALL, shutdown station (signoff)

; Routine - SHTALL
;
; Function - To shutdown a line (all devices).  If this line is signed on
;	the control task for the line is awakened and it will wait for all
;	activity to cease before shutting down the devices.  The control task
;	will then call this routine again at task level to destroy the tasks.
;	If the line is not signed on, the tasks will be released immediately.
;
;	Exit is made via SHTEXT code which either returns by $RET or goes to
;	the scheduler depending on whether it deleted its entry TKB (task)
;	if it came from task context.
;
; Parameters -
;

;	P1/QUASAR message ptr
;	P3/	Port,,line
;	P4/	Dev,,unit

; Here to shutdown all (signoff)

SHTALL:	JUMPE	LB,SHTERR		; If no line block, stop
	LOAD	S2,,L.STS		; get last line status
	TXNE	S2,L.SND		; If line was ever signed on
	 JRST	SHTALD			; Do delayed signoff
	$CALL	LINSTS			; no, see if line not up
	JUMPF	SHTAL0			; if down, assume disabled
	TXNN	S1,L.UP			; is line up
	JRST	SHTAL0			; no, don't have to take it down
	$CALL	DISABL			; yes, hang up

; Here to do shutdown right away

SHTTSK:
SHTAL0:	SETZ	T1,			; Zero task pointer
	PUSH	P,T1			; Push zero on stack to flag end
	MOVE	T1,TK			; save incoming TK
	LOAD	TK,,L.FTK		; Get control task's TKB
	JUMPE	TK,SHTAL2		; If none, just release line block

; Loop to release tasks

SHTAL1:	$CALL	RELTKB			; Release this one
	LOAD	TK,,T.PFW		; Get address of next TKB in chain
	JUMPE	TK,SHTAL2		; and if there was next one, release it
	CAMN	TK,T1			; About to free entry task block?
	 MOVEM	TK,0(P)			;  Yes, flag it
	JRST	SHTAL1

; Here to release line block

SHTAL2:	$CALL	RELLB			; Release line block too
	POP	P,T1			; Get "freed myself" task or 0
	JRST	SHTEXT			; Exit


; Here to do delayed shutdown

SHTALD:	TXO	S1,L.SFR		; Set line block bit shutdown requested
	STORE	S1,,L.STS		; and save line status bits
	LOAD	TK,,L.FTK		; Get control task TKB
	$CALL	ACTTSK			; activate control task
	$SIGNL	TW.SFR,TASK		; Wake him to do signoff
	$RET				;return to message processor


; Here to exit from shutdown

SHTEXT:	SKPTSK				; Skip if from task context
	 $RET				;  Exit via return to msgprc
	CAME	T1,TK			; Did we delete ourselves?
	 $RET				;  No, exit via return to task
	$DSCHD	DELETE			; Deschedule this task forever

; Here if device does not exist that QUASAR is shutting down.

SHTERR:	$WTOJ	<QUASAR Shutting down inactive device>,,<SUP.TY(P1)>
	$RET
SUBTTL Message processors -- USRCN, User cancel message

; Routine - USRCN
;
; Function - This routine tests if the job is already aborting or exiting,
;	and if so exits.  Then it tests if the disk file is open, and
;	if so sets it to return end of file on the next read.  Finally
;	it sets the GOODBY and ABORT bits in the task's S, wakes the task,
;	makes an entry into the log file and sends a message to operators.

;	P1/QUASAR message ptr

VUSRCN:	XWD	USRCN,0			; Only system components can do cancels

USRCN:	MOVEI	S1,ABO.TY(P1)		; Point to object block in message
	$CALL	FNDOBJ			; Set up TK, LB and J
	JUMPF	.POPJ			; Return if we cannot find it
					; TK,LB,J setup
	LOAD	S,S+T%ACS		; Get S
	TXOE	S,GOODBY!ABORT		; Set abort and end processing bits
	 $RET				;  If already on, ignore request
	STORE	S,S+T%ACS		; Put back updated status bits
	$CALL	WAKTSK			; Wake up task unconditionally
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/Job cancelled by user ^U/ABO.ID(P1)/>)>
	$WTOJ	<Cancelling>,<^R/.EQJBB(J)/>,@T%OBA
	$RET				; Exit
SUBTTL Message processors -- OPRCN, Operator cancel message

; Routine - VOPRCN
;
; Function - This routine does effectly the same thing as USRCN except
;	the cancel request has come from the operator instead of a user.

;	P1/QUASAR message ptr

VOPRCN:	XWD	OPRCN,0			; Operator cancel legal only from
					; system component

OPRCN:	MOVEI	S1,.OHDRS+1(P1)		; Point to object block
	LOAD	S2,-1(S1),AR.TYP	; Get type of block
	CAIE	S2,.OROBJ		; Is it ORION object block?
	 $RET				;  No, ignore bad message
	$CALL	FNDOBJ			; Find the task for the object type
	 JUMPF	.POPJ			;  Return if we cannot find it
					; TK,LB,J setup
	LOAD	S,S+T%ACS		; Get status
	TXOE	S,GOODBY!ABORT		; Tell low level to get out
	 $RET				;  If it was already doing it, exit
	STORE	S,S+T%ACS		; Stash status again
	$CALL	WAKTSK			; Make task wake up
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/Job cancelled by operator>)>
	$WTOJ	<Cancelling>,<^R/.EQJBB(J)/>,@T%OBA
	$RET
SUBTTL Message processors -- OPRRQ, Operator requeue message

; Routine - VOPRRQ
;
; Function - this routine checks to see if the job is already aborting
; or exiting and if so, returns. If not, we set the RQB bit and
; the GOODBY and ABORT bits in the task status and calls WAKTSK to
; cause a scheduler cycle, make a log entry and send a message to the
; operator.

VRQMSG:	XWD	OPRRQ,0			; operator cancel is legal only
					; from system components.

OPRRQ:	MOVEI	S1,.OHDRS+1(P1)		; Point to object block
	LOAD	S2,-1(S1),AR.TYP	; Get type of block
	CAIE	S2,.OROBJ		; Is it ORION object block?
	 $RET				;  No, ignore bad message
	$CALL	FNDOBJ			; Find the task for the object type
	 JUMPF	.POPJ			;  Return if we cannot find it
					; TK,LB,J setup
	LOAD	S2,,T.TYP		; find out which flavor task
	CAIE	S2,.TCDR		; is it a CDR?
	 JRST	RQDER			; no, can't requeue it
	LOAD	S,S+T%ACS		; yes, get status
	TXNE	S,GOODBY!ABORT!RQB	; Are we already stopping?
	 $RET				; yes, no more can be done
	TXO	S,GOODBY!ABORT!RQB	; no, we are now though!
	STORE	S,S+T%ACS		; store the status ac away in context
	$CALL	WAKTSK			; wake up the task
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/ Job Requeued By Operator>)>
	$WTOJ	<Requeuing>,<^R/.EQJBB(J)/>,@T%OBA
	$RET				; and wait for the scheduler

RQDER:	$WTOJ	<Can't requeue a job being received, use the ABORT command.>
	$RET
SUBTTL Message processors -- NXTJB, Nextjob message

; Routine - NXTJB
;
; Function - This routine save the current time as that when the request
;	was received, copies the request into the first job page for
;	the task (also sets the bit indicating that it is present)
;	and finally signals a "request from QUASAR" wake condition
;	for the task.

;	P1/QUASAR message ptr

VNXTJB:	XWD	NXTJB,0			; Only system programs can give a job

NXTJB:	MOVEI	S1,.EQROB(P1)		; Point to object block
	$CALL	FNDOBJ			; Set up world
	 JUMPF	NXTJER			;  Issue message if we cannot find it
					; TK,LB,J setup
	LOAD	S,S+T%ACS		; Get task status bits
	TXOE	S,QSRREQ		; Indicate we have a request
TOPS20	<$STOP	MRR,<Request received while another active>>
TOPS10	<STOPCD	(MRR,HALT,,<Request received while another active>)>

	STORE	S,S+T%ACS		; Save S for task
	$CALL	I%NOW			; Get current time
	STORE	S1,,T.TMR		; Save it as receive time of request
	HRR	S1,J			; Get destination for request in RH
	HRL	S1,P1			; and source in LH
	LOAD	S2,.MSTYP(P1),MS.CNT	; Get length of message
	ADDI	S2,-1(J)		; Compute last word address
	BLT	S1,0(S2)		; Copy message
	$SIGNL	TW.QRQ,TASK		; Tell task request is there
	$RET				; And exit

NXTJER:	$WTOJ	<Nextjob error>,<either invalid object type or line gone away - job requeued>,@T%OBA
	TXO	S,RQB			; set requeue flag
	MOVE	J,P1			; set job page ptr to msg block
	$CALL	QRLSE			; release the job
	$RET
SUBTTL Message processors -- SHWSTS, Show status message

; Routine - SHWSTS
;
; Function - This routine sets up the ack message to send to the
;	operator (OPR) telling him what the status of the emulation
;	devices on a particular node are doing.

;	P1/QUASAR message ptr

VSTATS:	XWD	SHWSTS,0		; Only system programs for now.

SHWSTS:	$SAVE	<S,J,P2,P3,P4,T2,T3,T4,LB,TK>	; Save some registers

	SETZB	P2,P4			; init msg counter

SHWST0:					; P2 will hold the work page for the duration
					; P3 will hold node name requested
					; P4 will hold count of nodes reported on
					; T3 will hold ptr to current message block
					; T4 will hold correct node name
	MOVE	P3,.OHDRS+ARG.DA+OBJ.ND(P1) ; Get node name (SIXBIT)
	MOVE	S1,LBNAM		; Get name of line block list
	$CALL	L%FIRST			; Point to first entry on list

SHWLP1:	JUMPF	SHWER1			; If no more .. didn't find node
	PUSH	P,S1			; save list handle
	MOVE	LB,S2			; Put line block addr in correct place
	LOAD	S2,,L.NAM		; Get name of node for this line
	CAME	P3,[-1]			; check for "all"
	CAMN	S2,P3			; Check if one we are looking for
	$CALL	SHWFND			;  Yes .. found line block for node
	POP	P,S1			; restore list handle
	JUMPF	.POPJ			; exit if error happened
	CAME	P3,[-1]			; check for "all"
	JUMPN	P4,SHWER1		; done if only requested one
	$CALL	L%NEXT			; No .. continue looking
	JRST	SHWLP1			; Go check next list entry

SHWFND:	MOVE	T4,S2			; copy current node name
	JUMPN	P2,SHWFN1		; check if message started yet

SHWFN0:	$CALL	SHWMSI			; init msg
	JUMPF	.POPJ

SHWFN1:	$CALL	SHWNXT			; make sure there is room for more
	JUMPE	P2,SHWFN0		; check if the partial message went
	$CALL	SHWTIT			; insert node title and set up body
	$TEXT	(DEPBP,<^T/STSHDR/>^A)	; Output the status header string

	AOS	P4			; count this node status
	LOAD	TK,,L.FTK		; Get address of first task block

SHWLP2:	MOVE	S,S+T%ACS		; Get status registers
	LOAD	S2,,T.TYP		; Get task type
	CAIL	S2,.TLPT		; Check for within range of
	CAILE	S2,.TCDR		;  device type tasks
	 JRST	SHWTST			;   No .. ignore control tasks
	LOAD	S1,,T.DST		; Get address of task state string
	$TEXT	(DEPBP,<^T14/@STSNAM-1(S2)/^T30/0(S1)/  ^A>)
	MOVE	J,J+T%ACS		; Get pointer to JOB pages
	LOAD	S2,,T.TYP		; Get device type again
	CAIE	S2,.TCDR		; Check for a card reader (batch strm)
	 JRST	SHWLPT			;  No .. go show LPT or CDP
	TXNN	S,QSRREQ		; Check for request page setup
	 JRST	SHWLF			;  No .. just end the line
	MOVE	S2,.EQRID(J)		; Get request ID number of job
TOPS20<	$TEXT	(DEPBP,<^D6/S2/  ^W9/.EQJOB(J)/^T/.EQOWN(J)/>)>
TOPS10<	$TEXT	(DEPBP,<^D6/S2/  ^W9/.EQJOB(J)/^W6/.EQOWN(J)/^W6/.EQOWN+1(J)/>)>

	JRST	SHWRUN			; Go output transfer start time

SHWLPT:	TXNE	S,ACTIVE		; Check for device really active
	TXNN	S,JVALID		; Check for job pages existant
	JRST	SHWLF			;  No .. end the status line
	LOAD	S1,,T.TBC		; check if any io has been done
	JUMPE	S1,SHWLF		; no - don't report 0 bytes xfer'd
	MOVX	T2,.QCJBN		; Find the job name entry
	$CALL	FNDENT			; in the queue request create page
	 JUMPF	 SHWNJB			;  No job name .. just output blanks
	$TEXT	(DEPBP,<        ^W9/1(S1)/^A>)
	CAIA
SHWNJB:	 $TEXT	(DEPBP,<                 ^A>)
	MOVX	T2,.QCNAM		; Find the user name entry
	$CALL	FNDENT			; in the queue request create page
	 JUMPF	SHWLF			;  None .. just close off the line
TOPS20<	$TEXT	(DEPBP,<^T/1(S1)/^A>)>	; Output name from queue entry
TOPS10<	$TEXT	(DEPBP,<^W6/1(S1)/^W6/2(S1)/^A>)>

SHWLF:	$TEXT	(DEPBP,<>)		; Put CRLF at end of line if needed
SHWRUN:	TXNN	S,ACTIVE		; Check for an active task
	JRST	SHWTST
	$CALL	XFRAT			;calc xfer rate
	 $TEXT	(DEPBP,<  Started at: ^H/T%TMS/ transferred ^D/T%TBC/ bytes at ^D/S1/ Bps>)
SHWTST:	LOAD	TK,,T.PFW		; Get next task on this line
	JUMPN	TK,SHWLP2		; If there is one .. continue output

	$CALL	SHWTRM			; terminate current message block
	$RETT

SHWNXT:	MOVE	S1,T3			; find out how much room left
	SUBI	S1,(P2)
	CAIGE	S1,PAGSIZ*5-^D80*6	; need six lines worth
	$RET
	MOVX	S1,WT.MOR		; send what we have
	IORM	S1,.OFLAG(P2)

SHWLST:	MOVE	S1,T3			; do final formatting of message
	SUBI	S1,(P2)
	HRLM	S1,.MSTYP(P2)		; total length

	MOVE	T1,P2
	$CALL	SNDOPR			; ship it
	SETZ	P2,			; this message no longer exists
	$RETT

SHWER1:	JUMPN	P4,SHWLST		; check if we reported something
	CAMN	P3,[-1]			; check for "all"
	JRST	SHWEND			; not an error if "all" request

	$ACK	(<IBM emulation node ^N/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,<	Unknown node status requested>,,<.MSCOD(P1)>)
	$RET

SHWEND:	$ACK	(<no IBM emulation nodes started>,,,<.MSCOD(p1)>)
	$RET

SHWMSI:	$CALL	M%GPAG			; get a work page
	JUMPT	SHWMS0
	$ACK	(<IBM emulation node ^N/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,<	failed to get workspace to build response>,,<.MSCOD(P1)>)
	$RETF				; ignore request
SHWMS0:	MOVE	P2,S1			; put message ptr in its permanent home
	MOVEI	S1,.OMACS		; do some formatting
	MOVEM	S1,.MSTYP(P2)
	SETZM	.MSFLG(P2)
	MOVE	S1,.MSCOD(P1)
	MOVEM	S1,.MSCOD(P2)
	MOVX	S1,WT.SJI!WT.NFO
	MOVEM	S1,.OFLAG(P2)
	SETZM	.OARGC(P2)
	MOVEI	T3,.OHDRS(P2)		; T3/ptr to current message block
	$RETT

SHWTIT:	$CALL	SHWARG			; set up new message block
	$CALL	I%NOW			; get time stamp
	MOVEM	S1,ARG.DA(T3)
	AOS	TEXTBP			; push text ptr to next word
					; insert title for this node status
	$TEXT	(DEPBP,< IBM emulation node ^N/T4/ device status ^A>)

	$CALL	SHWTRM			; terminate this message

SHWART:	SKIPA	S1,[.CMTXT]		; set up body of node status message

SHWARG:	MOVEI	S1,.ORDSP		; set up title of node status message
	MOVEM	S1,ARG.HD(T3)
	MOVEI	S1,ARG.DA(T3)		; now init byte ptr for msg text
	HRLI	S1,(POINT 7)
	MOVEM	S1,TEXTBP
	AOS	.OARGC(P2)		; count this message block in whole
	$RET

SHWTRM:	SETZ	S1,			; terminate message
	IDPB	S1,TEXTBP
	AOS	S1,TEXTBP		; count size of it
	SUB	S1,T3
	HRLM	S1,ARG.HD(T3)		; stuff it in msg block hdr
	HRRZ	T3,TEXTBP		; ptr to next msg block
	$RET

STSHDR:	ASCIZ	\
  Device         Status                        Req#   Jobname  Username
-----------   ------------------------------  ------  -------  --------
\

STSNAM:	[ASCIZ	\Line printer\]
	[ASCIZ	\Card punch\]
	[ASCIZ	\Card reader\]
SUBTTL Message processors -- RQCHK, Request checkpoint message

; Routine - RQCHK
;
; Function  - This routine merely sets up the task context and calls
;	the CHKPNT to build and send the message; if the request
;	was from a non-system program it calls the subroutine at the
;	CHKPNB entry point.

;	P1/QUASAR message ptr

VRQCHK:	XWD	RQCHK,RQCHK		; Both types can request checkpoints

RQCHK:	MOVEI	S1,RCK.TY(P1)		; Point object block sent by QUASAR
	$CALL	FNDOBJ			; Set up TK and LB and J
	 JUMPF	.POPJ			;  Ignore it if we cannot find it
					; TK,LB,J setup
	LOAD	S1,S+T%ACS		; Set task's status bits
	TXNN	S1,QSRREQ		; See if we are processing a request
	 $RET				;  No, QUASAR doesn't expect chkpnt
	MOVEI	T1,CHKPNT		; Assume only to QUASAR
	TXNN	S,F.IPCSY		; See if request came from system
	MOVEI	T1,CHKPNB		; No, use other entry point
	PJRST	@T1			; Go there and then return to main loop
SUBTTL Message processors --  CHKPNT, CHKPNB, send checkpoint

; Routine - CHKPNT, CHKPNB
;
; Function - CHKPNT is the subroutine to build a checkpoint message in
;	the message block and then send it to QUASAR; CHKPNB is an entry
;	point that can be used only from the message processing level to
;	send a checkpoint message both to QUASAR and to the NON-SYSTEM PROGRAM
;	that sent the request.
;
; Parameters - LB must be set up
;	P1/QUASAR message ptr
;
; Returns - True if SNDQSR does
;
; Note - Destroys S1 and S2

CHKPNB:	TDZA	S2,S2			; Entry to send checkpoint to both
CHKPNT:	 SETOM	S2			; Set QUASAR-only flag true

	$SAVE	<S,TK,J,T1,T2,T3,T4>	; Save registers
	LOAD	S1,,T.TYP		; Get caller's context type
	SETZ	T4,			; Provisionally clear register to hold
					; device selected for checkpoint information
	CAIN	S1,.TCDR		; Is it a card reader device?
	 HRRZ	T4,TK			;  Yes, use it
	MOVEI	T1,MSGBLK		; Point to block in which to build
					;  message (can do this since we are
					;  not interruptible until WE do
					;  a $DSCHD
	MOVX	S1,CH.FCH		; Indicate that we have checkpoint info
	STORE	S1,CHE.FL(T1)		; Store flags in message
	LOAD	TK,,L.FTK		; Point to first device on line
	JUMPE	TK,CHKLO4		; If none, we are done

CHKLOP:	LOAD	T2,,T.TYP		; Get task/device type
	SKIPE	T4			; Selected device for checkpoint info?
	 JRST	CHKLO1			;  Yes, go see if they match
	CAIE	T2,.TCDR		; No, see if this is a candidate
	 JRST	CHKLO2			;  No, just do continue
	HRRZ	T4,TK			; Yes, select him

CHKLO1:	CAME	TK,T4			; Device we wish to checkpoint?
	 JRST	CHKLO2			;  No, just continue to next task
	LOAD	S1,,T.NFP		; Get number of files processed
	STORE	S1,CHE.IN+CKFIL(T1)	; Save it in checkpoint block
	LOAD	S1,,T.NRS		; Get number of records processed
	STORE	S1,CHE.IN+CKTRS(T1)	; Save it too
	LOAD	J,J+T%ACS		; Get address of request
	LOAD	S1,.EQITN(J)		; Get internal number from request
	STORE	S1,CHE.IT(T1)		; and save it also
	MOVX	S1,CKFCHK		; Flag that job has been checkpointed
	STORE	S1,CHE.IN+CKFLG(T1)	; Set it in block

CHKLO2:	LOAD	TK,,T.PFW		; Get next task in chain
	JUMPN	TK,CHKLOP		; If there was one, go back to loop
CHKLO4:	MOVX	S1,CHE.ST		; Get length of message
	STORE	S1,.MSTYP(T1),MS.CNT	; Save as length of message
	MOVX	S1,.QOCHE		; Get function (checkpoint)
	STORE	S1,.MSTYP(T1),MS.TYP	; And save it in header too
	SKIPE	S2			; See it we are to send to caller
	 JRST	CHKLO5			;  No, just to QUASAR
	SKPTSK				; Only message processors can send back to caller
	$CALL	SNDBAK			; Send it back
CHKLO5:	$CALL	SNDQSR			; Send it to QUASAR
	JUMPF	QSRDTH			; die if can't do it
	$RET
SUBTTL Message processors -- SNDCI, send console input to IBM

; Routine - SNDCI
;
; Function -   This routine receives a message from either OPR (send to
;	batch stream) or a non-system component (with the same codes for
;	simplicity) which is a console line intended to be sent to IBM.
;	After some validity checking, it merely copies it into a console
;	input queue (CNI) entry and signals TW.CNI to the appropriate task.

;	P1/QUASAR message ptr

VSNDCI:	XWD	SNDCI,SNDCI		; Both types can do this

SNDCI:	MOVEI	S1,.OHDRS(P1)		; Point past message header
	LOAD	S2,ARG.HD(S1),AR.TYP	; Get type of first block
	LOAD	T1,ARG.HD(S1),AR.LEN	; and length
	ADD	T1,S1			; Compute address of next block
	SETZM	SNDCEC			; Initialize error code
	CAIE	S2,.OROBJ		; Is first block object block?
	 JRST	SNDCIE			;  No, inform world of error
	AOS	SNDCEC			; Increment error code
	AOS	S1			; Point to start of object type
	$CALL	FNDOBJ			; Yes, set up TK properly
	JUMPF	SNDCIE			; If cannot, something is very wrong
					; TK,LB,J setup
	LOAD	S2,ARG.HD(T1),AR.TYP	; Get type of second block
	AOS	SNDCEC			; Increment error code to 2
	CAIE	S2,.CMTXT		; It better be text type
	 JRST	SNDCIE			;  It isn't, so complain
	AOS	SNDCEC			; next possible error
	HRRI	S1,1(T1)		; Point to start of data part
	HRLI	S1,440700		; and make it into a byte pointer
	LOAD	T2,ARG.HD(T1),AR.LEN	; get the text length
	SOS	T2			; flush word count
	IMULI	T2,5			; make bytes
					; now scan line for =>

SNDCI0:	SOJL	T2,SNDCIE		; msg too short
	ILDB	S2,S1			; Get next character
SNDCI1:	CAIE	S2,"="			; Is it = ?
	 JRST	SNDCI0			;  No, keep looking
					; =
	SOJL	T2,SNDCIE		; msg too short
	ILDB	S2,S1			; Get next character
	CAIE	S2,76			; Is it right angle bracket?
	 JRST	SNDCI1			; no, keep scanning
					; => ...the IBM console msg  follows
	MOVE	T3,S1			; save the ptr, T2/no. bytes in msg
	LOAD	S1,,L.CNI		; Get CNI queue list handle
	MOVE	S2,T2			; Copy length in bytes
	ADDI	S2,4+5			; Compute length
	IDIVI	S2,5			; in words (accounting for length word)
	AOS	SNDCEC			; Increment error code to 3
	$CALL	L%CENT			; and get a new entry
	 JUMPF	SNDCIE			;  If no room, go complain
	MOVEM	T2,0(S2)		; Store length in first word
	ADD	S2,[XWD 440700,1]	; Make entry address into byte pointer

	CAIA
SNDCI4:	JUMPE	S1,SNDCI5		; when the null char is found, stop source
	ILDB	S1,T3			; Get next character
SNDCI5:	IDPB	S1,S2			; Store it in entry
	SOJG	T2,SNDCI4		; Loop till no more characters left

	TDZA	S1,S1			; make sure there is a null char to stuff
SNDCI6:	IDPB	S1,S2
	TLNE	S2,760000		; only done when last dest word is filled
	JRST	SNDCI6

	$SIGNL	TW.CNI,LINE		; and inform world its there

IFN FTIBMS,<
	MOVEI	S1,%ECNI		; inform QUASAR
	$CALL	IBMSTS
> ;End of FTIBMS

	$RET				; Return to MSGPRC

SNDCIE:	MOVE	S2,SNDCEC		; Get error code
	$WTOJ	<Console error>,<Error "^T/@SNDERR(S2)/" processing send message.>,@T%OBA
	$RET

SNDCEC:	EXP	-1
	EXP	[ASCIZ /illegal error code/]
SNDERR:	EXP	[ASCIZ /first block in msg not object/]
	EXP	[ASCIZ /can't find task for object block/]
	EXP	[ASCIZ /second block in msg not text/]
	EXP	[ASCIZ /illformed IBM console msg/]
EXP	[ASCIZ /cannot create CNI queue entry/]
SUBTTL Multiple CPU port identifier -- DN60ID, get a port identifier string

; Routine - DN60ID
;
; Function -    For Tops-10 Multiple CPU support this gets the correctly
;		correctly formatted port number.
;
; Returns	S2/port identifier
;
TOPS10<					;[403]Conditionalize
DN60ID:	PUSHJ	P,.SAVET		;[373]SAVE SOME ACS
	LOAD	T4,,L.PRT		;[373]GET THE PORT DATA
	HRLZS	T4			;[373]CAL11. STYLE
	LOAD	T1,T4,C1.1CN		;[373]CPU NUMBER
	LOAD	T2,T4,C1.1TY		;[373]PORT TYPE
	MOVE	T2,PORTAB(T2)		;[373]CONVERT TO TEXT
	LOAD	T3,T4,C1.1PN		;[373]PORT NUMBER
	LOAD	T4,,L.LIN		;[373]LINE NUMBER
	LOAD	S2,,L.NAM		;[373]STATION NAME
	$TEXT	(<-1,,DN60TX>,<^I/DN60IT/^0>)
	MOVEI	S2,DN60TX		;[373]POINT TO TEXT
	POPJ	P,			;[373]RETURN


DN60IT:	ITEXT	(<Station ^N/S2/ CPU^D/T1/ ^T/(T2)/ port ^O/T3/ line ^O/T4/>)

DN60TX:	BLOCK	25

PORTAB:	[ASCIZ	/DL10/]
	[ASCIZ	/DTE/]
	[ASCIZ	/KMC/]
	[ASCIZ	/DMR/]

>;[403]end TOPS10
SUBTTL Tasks -- Description

COMMENT	&

  The tasks IBMSPL uses can be divided into common tasks (TKCTL, TKSND)
and line-type dependent tasks (TKCDR-TKHCDR, TKLPT-TKHLPT,
TKHCNI, TKHCNO and TKHPUN).

  TKSND takes console output from the CNO queue (it was placed there
either by TKLPT for 2780/3780 or by TKHCNO for HASP) and distributes it
to all "watchers" of the console line.  These include OPRs (for a short
time after the operator issues a "send" command), IBMs (the program
specifically designed for watching the console) and the log files for
jobs coming in from IBM (so that the eventual user can see what was
done to his job by operators or other users).

  The control task (TKCTL) is responsible for signon and signoff.

  The card reader tasks (TKCDR for 2780/3780 and TKHCDR for HASP) copy
jobs to IBM.

  The lineprinter and punch (TKLPT, TKHLPT and TKHPUN) tasks copy jobs
from the IBM host to disk files, and then either rename them to
the user's area or queue them to the appropriate device on the 10/20. They
obtain the information on what to do by scanning the received data for
specific switches (a process called log-file recognition, or recognition
for short).

  The console input (TKHCNI) task copies messages from the CNI queue
to the IBM host; entries are placed in the queue by the send message
processor.

  The console output task (TKHCNO) copies output messages from the
IBM host to the CNO queue and wakes up the send task to
distribute them to whomever is interested.

	&
SUBTTL Tasks -- TKSND, console output distribution

; Task - TKSND
;
; Function - This task distributes console output arriving from the IBM
;	host to 1) all log files of active devices for that port,,line and
;	2) all programs that have declared themselves "watchers" of the
;	console line.  There are two programs intended to be watchers,
;	OPR (which becomes a watcher for a small period of time after
;	issuing a "send to batch-stream" command; and non-system programs
;	which allow a user of the DN6x to send messages and receive replies
;	over the console pipe to IBM.
;
;	This tasks wakes upon an TW.CNO signal, which is set by TKLPT
;	(2780/3780) or by TKHCNO (HASP) after after they have queued console
;	output to the CNO list for the line.
;
;	This task dequeues messages from this list, loops over all devices
;	on the line and inserts the message into the log file for all active
;	devices; then it loops over the list of watchers, sending the message
;	to all.

TKSND:	LOAD	S1,,L.STS		; Get status
	TXNN	S1,L.SFS		; If signoff sent
	TXNE	S,LGA			; or line gone away
	 JRST	CDERR			;  Exit and wait to die
	$DSCHD	TW.CNO,0		; Wait only on CNO queued signal
	LOAD	S1,,L.CNO		; Get handle for CNO list
	$CALL	L%FIRST			; Position to the beginning of the list

TSLOOP:	JUMPF	TKSDON			; If none, send to OPR then wait again
	MOVE	T1,S2			; Copy address of message entry
	LOAD	T2,,L.FTK		; Get first task in line block chain
	JUMPE	T2,TSWAT		; If none, go send it to watchers
	EXCH	TK,T2			; Save our task context and use his

TSLOG:	LOAD	S,S+T%ACS		; Get task's status

FTCLOG<	TXNE	S,ACTIVE		; Is it active?
	$TEXT	(LOGCHR,<^I/IBCON/^T/0(T1)/>)
      >
	LOAD	TK,,T.PFW		; Get next task in chain
	JUMPN	TK,TSLOG		; If there is one, go back
	EXCH	T2,TK			; Otherwise restore our context again

TSWAT:	MOVE	S1,WATNAM		; Get handle for watcher list
	$CALL	L%FIRST			; Get first entry in watcher list
	JUMPF	TSNEXT			; If none, try getting another message

TSWAT0:	$CALL	WATSND			; Send the message
	$CALL	L%NEXT			; Advance to next watcher
	JUMPT	TSWAT0			; If there is one, go back

TSNEXT:	$CALL	TSSTSH			; Store in collected messages
	LOAD	S1,,L.CNO		; Get list handle back
	$CALL	L%DENT			; Delete current entry, just sent it
	$CALL	L%NEXT			; And get next entry
	JRST	TSLOOP			; Go back to check if we won or lost

LOGOBJ:	EXP	.OTIBM			; Object block used for console msgs
	EXP	0			; Line
	EXP	0			; Node


TSOPR:	JUMPE	P3,.POPJ		;exit if no current byte pointer
	SETZ	S1,			;get a null
	IDPB	S1,P2			;wipe out last CRLF (OPR adds it)
	LOAD	S1,,L.LIN		;get line number
	STORE	S1,LOGOBJ+1		;store in object block
	LOAD	S1,,L.NAM		;get node name
	STORE	S1,LOGOBJ+2		;store in object block
	$WTOJ	<Console output>,<^T/0(P1)/^A>,LOGOBJ
	MOVE	S1,P1			;point to start of page
	$CALL	M%RPAG			;releases it
	$CALL	M%CLNC			;and clean up working set
	SETZB	P1,P3			;zero out pointers
	$RET
TKSDON:					;here to send collected message to OPR
	$CALL	TSOPR			;send it
	JRST	TKSND			;go wait for more work
TSSTSH:					;subroutine to stash messages in page
					;P1=start of page or 0, P2=pointer to last CRLF
					;P3=current byte pointer, P4=count to go
	$SAVE	<S1,S2,T1,T2,T3,T4,J>	;save registers
	MOVE	J,T1			;save start of message
TSSTR:					;restart point if page got full
	MOVE	S2,J			;get address of message
	HRLI	S2,440700		;make into byte pointer
	DMOVE	T1,P1			;save current page parameters
	DMOVE	T3,P3			; in T1-4
	SKIPN	P3			;page already there?
	$CALL	TSCRPG			;no, create one -- will set up P's
	SETZ	P2,			;current attempt has no CRLF yet
TSST0:					;loop to look at message characters
	ILDB	S1,S2			;get source character
	JUMPE	S1,TSST1		;if null, we are done
	CAIE	S1,12			;if LF
	CAIN	S1,15			; or CR
	$CALL	TSUPL			;update P2
	CAIN	S1,14			;also FF (for safety)
	$CALL	TSUPL			;update P2
	IDPB	S1,P3			;store it page
	SOJG	P4,TSST0		;continue till no room in page
	DMOVE	P1,T1			;restore old pointers
	DMOVE	P3,T3			; ...
	$CALL	TSOPR			;send this page to OPR
	JRST	TSSTR			;and restart us
TSST1:					;here when null seen
	$RET				;exit
TSUPL:					;update CRLF pointer
	SKIPN	P2			;don't update if we already have value
	MOVE	P2,P3			;save current as CRLF pointer
	$RET				;exit
TSCRPG:					;subroutine to create the page
	$SAVE <S1,S2>
TSCRP0:	$CALL	M%GPAG
	MOVE	P1,S1			;copy start address
	SETZ	P2,
	MOVE	P3,S1			;copy address again
	HRLI	P3,440700		;and make into a byte pointer
	MOVEI	P4,^D512*3		;get number of characters that will fit
					;we don't use whole page because WTOJ croaks
	$RET
SUBTTL Tasks -- TKCTL, control for 2780/3780

COMMENT	&

  This task wakes on TW.SNR (a signon request from
a main [i.e. CDR] task), on TW.SFR (a signoff request
by a special shutdown message from QUASAR) and TW.LGN
(a line gone signal because of front end crash or line abort
set by any task getting such an error).

  On a signon request, it gets the signon string from SYS:nodename.SON;
then if the line is not up it waits for it to come up (DTR and
DSR on).  Once the line is up, it requests output permission
and waits till it gets it.  Then it sends the signon message
to the IBM host and alternately tries to get either input or
output permission. Once it succeeds, it considers the
station signed on, sets the bit in the line block, signals
TW.SND (signon done) and goes to sleep again.

  On a signoff request, this task gets the signoff string
from SYS:nodename.SOF, queues it to the CNI queue,
signals TW.CNI to get card reader task to send it, and
then waits for the line to go away (IBM hangs up).
When this happens, the task sends a message to all watchers.
It then deletes all the tasks and the line block by calling
SHTTSK.

  On a line-gone condition it sends messages to the world,
waits for everything to complete (all watcher messages out,
log files written, etc.) and then calls SHTTSK to
delete station.

	&

TKCTL:					;2780/3780 control task
	MOVE	T1,TK			;save task block pointer
	LOAD	S1,,L.LNI		;get line information
	HRLZI	S2,.TCDR		;get card-type,,0 as dev,,unit
	$CALL	FNDTSK			;get card reader task address
	LOAD	S1,,T.OBA		;address of object block
	EXCH	T1,TK			;get our task block back
	STORE	S1,,T.OBA		;save address of object block
TKCTL0:	$DSCHD	<TW.SNR!TW.SFR!TW.LGN>	;wait for signon request, signoff request
					; or line gone
	SKPN	S1,,T.WCN		;get conditions which caused us to wake
TOPS20	<$STOP	ILW,<Illegal wakeup>>
TOPS10	<STOPCD	(ILW,HALT,,<Illegal wakeup>)>
	TXZE	S1,TW.SNR		;if signon request
	JRST	CTSGON			;go process it
	TXZE	S1,TW.LGN		;if line gone (which thus has priority
					; over signoff)
	JRST	CTLNGN			;go process it
	TXZE	S1,TW.SFR		;if signoff request
	JRST	CTSGOF			;go do it
CTEXT:					;here to exit control task
	$CALL	DEATSK			;deactivate
	JRST	TKCTL0			;and go back to beginning
SUBTTL Tasks -- .  CTSGON, wait for signon

CTSGON:					;here to do signon

CTSLIN:					;loop to wait for line to come up
	$CALL	LINSTS			;get most recent line status
	LOAD	S1,,L.STS		;get line status from list entry
	TXNE	S1,L.UP			;is line up?
	JRST	CTSGO1			; yes, go on
	MOVEI	S1,[ASCIZ /waiting for line to become active(DSR on)/]
	STORE	S1,,T.DST

	$DSCHD	0,^D2*3			;no, wait a little
	JRST	CTSLIN			;and try again

CTSGO1:					;here to prepare for signon
	MOVE	T1,TK			;save task block pointer
	MOVSI	S2,.TCDR		;get type,,unit 0
	LOAD	S1,,L.LNI		;and port,,line
	$CALL	FNDTSK			;find its task
	TXNE	S,HASP			;are we HASP Multileaving?
	JRST	CTSGOA			;yes, don't get things we don't need
	LOAD	P1,P1+T%ACS		;get device handle
	PUSHJ	P,CTSXBT		;exchange bit fields
	EXCH	TK,T1			;put back our TK

CTSGOW:	$CALL	GETLNO			;request output permission
	JUMPF	[CAIE S1,D6NBR		;analyze failure
		 CAIN S1,D6DOL
		 JRST CTSGOW		;just hang in here
		 JRST CTSFAI]		;if it fails, abort
	EXCH	TK,T1			;put back card reader TK
CTSGOA:					;here to store card parameters as ours
	LOAD	S1,,T.RIA		;get address of his record buffer
	LOAD	S2,,T.XBA		;get his big buffer
	LOAD	T2,,T.XBN		; and its size
	EXCH	TK,T1			;swap task block addresses (restoring ours)
	STORE	S1,,T.RIA		;save record address
	STORE	S2,,T.XBA		;save big buffer address
	STORE	T2,,T.XBN		; and size
	STORE	T1,,T.OTK		;and pointer to CDR0 task (for later)
	$CALL	TBFINI			;initialize counts and pointers
	$CALL	SGNFIL			;setup to read signon file
	JUMPF	CTSGO4			;if error, complain
	TXZ	S,CHECK			;ensure we don't call checking routines
	$CALL	COPY			;write signon message
	JUMPF	CTSFAI			;complain if it didn't work
	ZERO	,T.RIA			;clear our record pointer,
	ZERO	,T.XBA			; buffer pointer
	ZERO	,T.XBN			; and size
	TXNE	S,HASP			;this a HASP line?
	JRST	CTSGO7			;yes, don't do unnecessary wind-down
	SETZ	P1,			;clear out handle register
	LOAD	T1,,T.OTK		;get card reader TKB address
	PUSHJ	P,CTSXBT		;exchange T.BIT between TK and T1
CTSGO7:					;here to test result of copy
	JUMPF	CTSFAI			;if we cannot, abort
	TXNN	S,HASP			;is this HASP line?
	JRST	CTSGO3			;no, assume it came up

CTSGOX:	$CALL	LINSTS			;yes, get line status
	TXNE	S1,L.UP			;has "up" bit been zeroed
	TXNE	S,LGA!ABORT		; or did D60JSY flag serious error?
	JRST	CTSFAI			;yes, indicate failure
	TXNE	S1,L.SND		;check signon bit
	JRST	CTSGOR			;it's up
	$DSCHD	0,3			;wait a second
	JRST	CTSGOX			;not yet, loop
CTSGOR:	MOVE	S1,P1			;get handle
	D60	D60RLS,CTSGOR		;release signon device

CTSGO3:					;here when OK to continue
	MOVX	S1,L.SND		;make sure local signon flag is set
	IORM	S1,L$STS(LB)

	$WTOJ	<Signed on>,,@T%OBA	;tell world we are signed on
	MOVE	T4,TK			;save task block pointer
	LOAD	TK,,L.FTK		;get first task on LB
CTSGO8:					;loop to activate tasks
	JUMPE	TK,CTSGO9		;exit if no more TKB's
	$CALL	ACTTSK			;activate this one
	JUMPF	CTSGO5			;die if we cannot
	LOAD	TK,,T.PFW		;get next one
	JRST	CTSGO8			;and try again
CTSGO9:					;here when all tasks active
	MOVE	TK,T4			;restore our task
	MOVEI	S1,%RSUOK		;code for unit is OK
	LOAD	P1,,T.OBA		;address of object block
	SUBI	P1,SUP.TY		;dummy up for RSETUP
	$CALL	RSETUP			;send response to setup
	$SIGNL	TW.SND,LINE		;let everyone know that signon has happened
	MOVE	TK,T4			;restore our task
	JRST	CTEXT			;and exit task

CTSXBT:					;here to swap TK and T1 T.BIT fields
	$SAVE	S1			;preserve register we will use
	LOAD	S1,,T.BIT		;get TK's bit field
	EXCH	S1,T$BIT(T1)		;swap them
	STORE	S1,,T.BIT		;save other version
	$RET

CTSGO5:
TOPS20	<$STOP	CAS,<Cannot accomplish SIGNON>>
TOPS10	<STOPCD	(CAS,HALT,,<Cannot accomplish SIGNON>)>

CTSGO4:	$WTOJ	<Signon error>,<^I/DGLXER/ opening signon file>,@T%OBA
	JRST	CTSFA0

; Here when line goes away

CTSFAI:
TOPS20	<
	LOAD	S2,,L.LIN		;get line number
	LOAD	P1,,L.PRT		; and port
	$WTOJ	<Line ^O/S2/ on port ^O/P1/ went away>,,@T%OBA
>
TOPS10	<
	PUSHJ	P,DN60ID		;[373]Get multiple CPU port number
	$WTOJ	(<Status information>,<^T/(S2)/ went away>,@T%OBA)
>
CTSFA0:					;ignore possible error states on line
	MOVEI	S1,[ASCIZ /disabling line/]
	STORE	S1,,T.DST
TOPS20	<
	LOAD	S1,,L.PRT		;get port number
	LOAD	S2,,L.LIN		;get line number
	$WTOJ	<Hanging up line ^O/S2/ on port ^O/S1/>,,@T%OBA
>
TOPS10	<
	PUSHJ	P,DN60ID		;[373]Get multiple CPU port number
	$WTOJ	(<Status information>,<Hanging up ^T/(S2)/>,@T%OBA)
>
	$CALL	DISABL			;turn off the line

	MOVEI	S1,%RSUDE		;code for device doesn't exist
	LOAD	P1,,T.OBA		;get address of object block
	SUBI	P1,SUP.TY		;dummy up for RSETUP
	$CALL	RSETUP			;send response to setup

	SETZ	S1,
	STORE	S1,,L.STS		;make sure status has L.UP bit off
CTSGF0:	PJRST	SHTTSK			;kill all the tasks
SUBTTL Tasks -- .  CTSGOF, do signoff

CTSGOF:					;here to do SIGNOFF processing
	LOAD	S1,,L.STS		;get last line status
	TXO	S1,L.SFS		;indicate signoff send
	STORE	S1,,L.STS		;save it where all tasks can see
	LOAD	S2,,L.LIN		;get line number
	LOAD	P1,,L.PRT		; and port
	MOVEI	S1,[ASCIZ \waiting for active tasks to finish\]
	STORE	S1,,T.DST		;set dying state
	$SIGNL	TW.IOD,LINE		;wake any tasks waiting to do I/O
	$CALL	QUIESC			;wait for all tasks to settle down
	PUSH	P,TK			;save out task address
	MOVSI	S2,.TCDR		;get task id for card reader
	LOAD	S1,,L.LNI		;get port,,line
	$CALL	FNDTSK			;become card reader
	JUMPF	[POP P,TK		;restore task ptr
		 JRST CTSGF0]		;if we cannot, skip sending SIGNOFF file
	MOVEI	S1,[ASCIZ /Signing off/]
	STORE	S1,,T.DST
TOPS20	<
	LOAD	S2,,L.LIN		;get line number
	LOAD	P1,,L.PRT		; and port
	$WTOJ	<Line ^O/S2/ on port ^O/P1/ signing off>,,@T%OBA
>
TOPS10	<
	PUSHJ	P,DN60ID		;[373]Get multiple CPU port number
	$WTOJ	(<Status information>,<^T/(S2)/ signing off>,@T%OBA)
>
	LOAD	P1,P1+T%ACS		;get card reader handle
	$CALL	TBFINI			;initialize buffer
	$CALL	SGFFIL			;find SIGNOFF file, initialize COPY parameters and switches
	SKIPF				;don't copy it if not there
	$CALL	COPY			;send it out

	$CALL	LINSTS			; check if line is already dead
	POP	P,TK			; restore control task ptr now
	JUMPF	CTSFA0			; make everything go away
	TXNE	S1,L.UP			; [360] line still up?
	TXNE	S1,LGA			; [360] yes,hard error?
	JRST	CTSFA0			; [360] it's dead clean up after it
	$DSCHD	,^D4*3			; wait for the host to kill it(maybe)
	JRST	CTSFA0			; we've waited long enough, go kill it
SUBTTL Tasks -- .  CTLNGN, line gone while active processing
CTLNGN:					;here if D60PRD activates control
					; task and signals line has gone away
	LOAD	TK,,L.FTK		;get first task pointer (ctl task)
	LOAD	TK,,T.PFW		;get first real task
	JUMPE	TK,QUIDON		;if none, we don't have to wait
CTLNG0:					;loop setting ABORT and LGA for tasks
	MOVE	S1,S+T%ACS		;get task's S
	TXO	S1,ABORT+LGA		;set abort and line gone
	MOVEM	S1,S+T%ACS		;and put status back
	$CALL	WAKTSK			;activate and wake it
	LOAD	TK,,T.PFW		;point to next task
	JUMPN	TK,CTLNG0		;and process it too, if there
	$CALL	QUIESC			;wait for tasks to go away [4(240)]
	LOAD	TK,,L.FTK		;point to our task block again
	JRST	CTSFAI			;and finally shut down
SUBTTL Tasks -- TKCDR, 2780/3780 card reader

COMMENT	&

  This task is given control by the setup routine; it first
checks if the station is up and signed on; if not, it activates
the control task, signals signon request, and waits for signon done.

  Once the station is signed on, it waits on TW.QRQ
(a request arrived from QUASAR) and TW.CNI (there is
data in the CNI queue to be sent to IBM as console input
messages).

  On console input, it gets output permission (sleeping and
retrying if necessary), initializes the data buffer and then
loops gathering messages from the queue, sending each to
all watchers and then outputing them to IBM.  When it
reaches the queue, it forces an output end of file to IBM
and exits.

  On receipt of a QUASAR request it gets output permission
and then calls the DOJOB subroutine to copy the files of
the request to IBM.

	&

TKCDR:					;start of 2780/3780 card reader task
	MOVE	T1,TK			;save TKB pointer
	LOAD	S1,,L.LNI		;get port,,line
	HRLZI	S2,.TLPT		;and lpt,,0
	$CALL	FNDTSK			;find its TKB
	EXCH	TK,T1			;restore our task pointer
	STORE	T1,,T.OTK		;save address for future reference
	LOAD	S1,,L.STS		;get line status
	TXC	S1,L.UP!L.SND		; is line up and signed on ?
	TXCN	S1,L.UP!L.SND
	JRST	CDMAIN			;go immediately to idle wait
	LOAD	T1,,L.FTK		;get address of control task
	EXCH	T1,TK			;save our task pointer
	$CALL	ACTTSK			;activate control task
	$SIGNL	<TW.SNR>,TASK		;tell him to do signon
	MOVE	TK,T1			;get our pointer back
	MOVEI	S1,[ASCIZ /Waiting for SIGNON/];display our current state
	STORE	S1,,T.DST		; in status message
	$DSCHD	TW.SND,0		;wait only for signon done
	ZERO	,T.WCN			;clear wakeup conditions
CDMAIN:					;main idle loop
	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

	MOVEI	S1,[ASCIZ /Idle/]	;display idle
	STORE	S1,,T.DST		; state
	$DSCHD	TW.QRQ!TW.CNI,SPLINT	;wait for job or console input or both
	LOAD	T3,,T.WCN		;get condition(s) which woke us
CDEXT:	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

	JUMPE	T3,CDTURD		;if timeout, go try to turn line around
	TXZE	T3,TW.CNI		;if console input (which thus has priority)
	JRST	CDCNI			; go do it
	TXZE	T3,TW.QRQ		;if a job
	JRST	CDJOB			; go do that
	$WTOJ	<Logic error>,<Illegal wakeup condition ^O/S1/>,@T%OBA
	ANDCAM	S1,T%WCN		;clear offending bits
	JRST	CDMAIN			;and go to main loop

CDTURN:	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

CDTURD:	MOVE	T1,TK			; Save task pointer
	LOAD	TK,,T.OTK		; Get line printer task pointer
CDTURR:	HRRZ	S1,P1+T%ACS		; Get device handle
	D60	D60STS,CDTURR,0		; Get LPT status
	JUMPF	CDTRN1			;  If failed .. go check on CDR
	TXNN	S2,SDIRN!SDIPR!SDIPW!SDIPG!SDIAS!SDIAC!SDIEC ; Check for input events
	 JRST	CDTRN1			;  If none .. back to CDR service
	$CALL	ACTTSK			; Activate it
	$SIGNL	TW.IAV			; Tell him he has input available
	MOVE	TK,T1			; Restore our task pointer
	MOVEI	S1,[ASCIZ /Input EOF wait/]
	STORE	S1,,T.DST		; State for status messages
	$DSCHD	TW.ICP,0		; Wait for input complete
	LOAD	S1,,T.WCN		; get wakeup conditions
	TXZ	S1,TW.ICP		; clear this one
	IOR	T3,S1			;  but save rest
	JRST	CDEXT			; Go back to check on CDR

CDTRN1:	MOVE TK,T1			; Reset to CDR task pointer
	JRST CDMAIN			; and go check on card reader


; This is where tasks jump when settling down to be killed off.  The
;  control task waits for all others to be descheduled forever.

CDERR:	MOVEI	S1,[ASCIZ /Waiting to SIGNOFF/]
	STORE	S1,,T.DST
	$DSCHD	0,0			; Sleep till control task kills us
	JRST	CDERR			; Just in case
SUBTTL Tasks -- .  CDCNI, send console input to IBM

COMMENT	&

  This routine sends all the console input msgs queued, then
goes back to CDEXT to see if card reader task has to handle
more conditions before idling.

	&

CDCNI:					;HERE to send console input to IBM
	MOVEI	S1,[ASCIZ /Waiting to send console input/];get state
	STORE	S1,,T.DST		;and make it visible
	$CALL	GETLNO			;try to get line for output
	JUMPF	CDCNIZ			;if we cannot, signal ourselves to try again
	MOVEI	S1,[ASCIZ /Sending console input/];our new state
	STORE	S1,,T.DST		; in the usual place
	TXZ	S,CHECK			;do not check records now
	$WATCH	<Console input>		;tell watchers what follows is input
CDCNI1:					;loop to get card images to send
	$CALL	PUTCNI			; use the worker to do it
	JUMPT	CDCNI2			; worker suc'd, so we are done

CDCNER:	$WATCH	<Console input aborted by error>;tell watchers
	JRST	CDEXT			;and try to continue

CDCNI2:					;here at end of messages
	$WATCH	<Console input sent>	;tell watchers we are done
	JRST	CDEXT			;and go see if we have more to do
CDCNIZ:	$SIGNL	TW.CNI
	JRST	CDTURN
SUBTTL Tasks -- .  CDJOB, send job to IBM

COMMENT	&

  This routine simply waits for permission and calls DOJOB
(which it shares with the HASP card reader task) to process
the request from QUASAR.

	&

CDJOB:					;here to send a job to IBM
	TXNE	S,RQB			;are we requeuing?
	JRST	CDJRQ			;yes, go do it
	MOVEI	S1,[ASCIZ /Grant wait/];describe new state
	STORE	S1,,T.DST		;and make it visible
	$CALL	GETLNO			;get output permission
	JUMPF	CDJOB0			;if cannot get permission, try input
FTACCT<	PUSHJ	P,IACTBG>		;Start acounting on new job.
	$CALL	DOJOB			;use subroutine to copy all the files
					;of request, do checkpoints, etc.
	TXNE	S,LGA			;see if line has gone away
	JRST	CDERR			;die on line gone
FTACCT<	PUSHJ	P,IACTND>		;finish accounting.
	JRST	CDEXT			;if job succeeded or failed, try more

CDJOB0:	$SIGNL	TW.QRQ			;wake ourselves up
	JRST	CDTURN			;and try to get input


CDJRQ:	TXO	S,GOODBY		;no more logging
	TXZ	S,QSRREQ!ACTIVE		;indicate we no longer have a request
	MOVEI	S1,[ASCIZ /Finished Job/]
	STORE	S1,,T.DST		;change our state
	$CALL	CHKPNT			;make sure everyone knows
	$CALL	QRLSE			;do the requeue
	JRST	CDEXT			;go try another
SUBTTL Tasks -- .   DOJOB, process "batch" job

; Routine - DOJOB
;
; Function - Loops through files of request, copying them to IBM if
;	necessary (also making log file entries and at end writing it).
;
; Parameters - TK, LB and J must be set up, P1 must have device handle
;
; Returns - False when line goes away.
;
; Note - MUNGS S1,S2,T1,T2,P2,P3

COMMENT	&

  This subroutine initializes the task-block data structure
for the job, writes log file entries and messages to operator
to show we are starting job, then loops over each file in request,
skipping it if we were requeued and had completed it before,
and sending it (via subroutine FILE) to IBM else.
When it is finished, it writes the log file out to disk, and
possibly queues it to a line printer queue.

	&

DOJOB:					;here to fulfill a request from QUASAR
	$CALL	INIJOB			;clean up job-related task block entries
	TXZ	S,ABORT!INPEOF!OUTEOF!FLSH!GOODBY!RQB!NODEL;clear possible abort from last time
	TXO	S,ACTIVE!CHECK		;indicate we are active and checking records
	TXZ	S,IOABT			;[261] forget any soft aborts 'til now
	MOVEI	S1,[ASCIZ /Sending job/];our current state
	STORE	S1,,T.DST		; is now visible
	$CALL	CHKPNT			;make sure QUASAR knows it
					;put first line in log file
FTCLOG<
	$TEXT	(LOGCHR,<^M^J^I/IBDAT/IBMSPL version ^V/[%%.IBM]/	^T/CNF/>)
	LOAD	S1,T%UNI
	LOAD	S2,L%PRT
	LOAD	T1,L%LIN
	$TEXT	(LOGCHR,<^I/IBDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on IBM CDR^D/S1/ on P^O/S2/L^O/T1/>) ;and next
	SKIPN	T2,.EQCHK+CKFLG(J)	;was this job requeued?
	JRST	DOJOB0			;no, just process it
	MOVEI	T1,[ASCIZ /system failure/];assume it was because of system failure
	TXNE	T2,CKFREQ		;was it really operator requeue?
	MOVEI	T1,[ASCIZ /requeue by operator/];yes, use proper string
	$TEXT	(LOGCHR,<^I/IBMSG/Job being restarted after ^T/0(T1)/>) ;write it into log
DOJOB0:					;here after writing initial log file lines
      >	;end FTCLOG

	$CALL	I%NOW			;get time
	STORE	S1,,T.TMS		;save as time we started job
	LOAD	S2,,T.TMR		;see when we received it
	SUB	S1,S2			;get time difference
FTCLOG<
	CAILE	S1,INSIGN		;if it is insignificant, skip message
	$TEXT	(LOGCHR,<^I/IBMSG/Job received at ^C/S2/ and delayed ^C/S1/>) ;put entry into log file
      >	;end FTCLOG

	$WTOJ	<Begin>,<^R/.EQJBB(J)/>,@T%OBA
	$CALL	TBFINI			;initialize the buffer
	LOAD	P2,.EQLEN(J),EQ.LOH	;get length of header of request
	ADD	P2,J			;add to start to get beginning
					;of file blocks (P2 is pointer
					;to next file block within DOJOB)
	LOAD	S1,.FPLEN(P2),FP.LEN	;get length of parameters
	MOVE	P3,P2			;copy base address
	ADD	P3,S1			;point to FDB
	LOAD	T2,.EQSPC(J),EQ.NUM	;get number of files in request
	STORE	T2,,T.NFL		;save as number of files
	SKIPN	.EQCHK+CKFLG(J)		;is this a restarted job?
	JRST	DOJOB4			;no, just start at beginning
	LOAD	T1,.EQCHK+CKFIL(J)	;yes, get how many files already done
	STORE	T1,,T.NFP		;save as number of files processed
DOJOB1:					;loop to skip already send files
	SOJL	T1,DOJOB2		;jump if we have skipped enough
	$CALL	NXTFIL			;advance to next file block
	JUMPF	DOJOB7			;finish up processing if we skipped them all
	JRST	DOJOB1			;go try to skip another
DOJOB2:					;here after skipping already done files
	LOAD	T1,.EQCHK+CKTRS(J)	;get checkpointed count of
					;total number of records sent
	STORE	T1,,T.NRS		;save as our num records sent
DOJOB4:					;here to loop sending files
	$CALL	FILE			;do a file
	JUMPF	.POPJ			;return failure to caller if CGO error
	TXNE	S,RQB			;did job get requeued while we were doing it?
	JRST	DOJEND			;yes, go end job
	INCR	,T.NFP			;increment number of files processed
	$CALL	CHKPNT			;and make sure the world knows it
					; by sending checkpoint to QUASAR

	TXNE	GOODBY!ABORT		;[364] Aborting job?
	JRST	DOJB4A			;[364] Then don't process switches
	LOAD	S1,.FPINF(P2),FP.DEL	;check switches
	JUMPE	S1,DOJB4A		;no delete request anyhow

	MOVEM	P3,FOB			;[364] Save the FD ptr
	MOVE	S1,FOB.CW		;[364] Get the control info
	MOVEM	S1,FOB+FOB.CW		;[364] Put it in our FOB area
TOPS20<	HRROI	S1,.EQOWN(J)		;[364] User name from request header
	HRROI	S2,.EQCON(J)		;[364] Connected directory
>;End TOPS-20
TOPS10< MOVE	S1,.EQOID(J)		;[364] PPN from request header
	SETZM	S2			;[364] FOB.CD not used in Tops-10
>;End TOPS-10
	MOVEM	S1,FOB+FOB.US		;[364] Put user info in our FOB
	MOVEM	S2,FOB+FOB.CD		;[364]   and connected directory
	

	MOVEI	S1,FOB.SZ		;[364] Size of the block
	MOVE	S2,.EQJBB+JIB.SQ(J)	;[364] Get word with possible priv bit
	TXNE	S2,EQ.PRV		;[364] Is priv bit set?
	MOVEI	S1,FOB.MZ		;[364] Yes..pass the short FOB 
	MOVEI	S2,FOB			;[364] Address of block

	$CALL	F%DEL			;delete the sucker
	JUMPT	DOJB4A			;it suc'd!
	$WTOJ	<couldn't delete batch file>,<failure to delete user batch file ^F/(P3)/, ^I/DGLXER/>,@T%OBA

DOJB4A:

IFN FTIBMS,<
	MOVEI	S1,%EINP		; inform QUASAR
	$CALL	IBMSTS
> ;End of FTIBMS

	$CALL	NXTFIL			;advance to next file
	JUMPT	DOJOB4			;if there was one, go process it
DOJOB7:					;here when all files have been processed
	SKPN	P2,,T.LFS		;get address of log file spec	(set
					; by NXTFIL)
	JRST	DOJEND			;if none, end job
	TXZ	S,ABORT			;clear abort flag
FTLOG <	MOVEI	S1,LOGGET 		;address of get routine
	STORE	S1,,T.GTR 		;save if for FILED routine
	$CALL	FILED			;write log file to disk
	$CALL	QUELPT			;queue it to DEC LPT queue
>;end FTLOG
DOJEND:					;here when all done with job
	TXO	S,GOODBY		;let everyone know they cannot
					; abort anything any more
	TXZ	S,QSRREQ!ACTIVE		;indicate that we no longer have a request
	MOVEI	S1,[ASCIZ /Finished job/]
	STORE	S1,,T.DST		;save state
	$CALL	CHKPNT			;and make sure world knows
	$CALL	QRLSE			;send release/requeue message
	$RETT				;return to caller
SUBTTL Tasks -- .   FILE, copy a disk file to IBM

; Routine - FILE
;
; Function - Writes message into log file, opens disk input file, copies
;	from disk to IBM till either EOF or error, writes appropriate
;	message into log file, and exits
;
; Parameters - TK, LB and J must be set up
;		P2/ptr to file block
;		P3/ptr to file FD
;
; Returns - Propogates true or false from COPY
;
; Note - Destroys S1

COMMENT	&

  This routine exits if the ABORT flag has been set; if not
it opens the input file, writes a message to the log file,
sets up the put and get routine addresses for the COPY subroutine,
and then calls it to copy from source to destination.  If there
is an error upon return from COPY, it notes that in the log
file; otherwise it notes that it finished the file and exits.

	&

FILE:					;copy a file from DSK to IBM
	TXNN	S,ABORT			;if abort flag set, exit immediately
	JRST	FILE0
	TXO	S,RQB			;aborting - make sure requeue is set
	$RETT				;pretend we copied file

FILE0:

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/Starting file ^F/0(P3)/>)>;put line into log file
	MOVEI	S1,GETDSK		;get address of routine to read from disk
	STORE	S1,,T.GTR		;save it where COPY will find it
	MOVEI	S1,PUTIBM		;likewise with
	STORE	S1,,T.PTR		; output routine address
	MOVEI	S1,IBMLFR		;get address of checker external routine
	STORE	S1,,T.CKR		;save it for dispatch
	TXZ	S,CHKLOG!CONPAT!CHKSWT	;don't do input checking
	ZERO	,T.GTE			;zero get error code
	ZERO	,T.ICT			;zero the input record count
	ZERO	,T.OCT			;and the output record count
	ZERO	,T.PTE			;as well as put error code
	ZERO	,T.TBC			;clear transfered byte count
	$CALL	INPOPN			;open input file and set DSKOPN flag
	JUMPF	[TXO	S,GOODBYE	; treat as a cancel
		 JRST	FILE2E]		;if open failed, set abort
	$CALL	COPY			;copy the file
	TXNE	S,LGA			;has line gone away?
	JRST	FILE2A			;yes, cause job to be requeued
	JUMPT	FILE1			;if success, exit normally
FILE2:					;here on error during file transfer
	LOAD	S1,,T.PTE		;see if put error code
	JUMPE	S1,FILE2B		;jump if no error
	CAIN	S1,D6CGO		;if can't get output, do special processing
	JRST	FILCGO			;handle it
	$WTOJ	<^I/IBMOAB/>,<output ^I/D60ERM/ ^I/WRTFLM/>,@T%OBA

	JRST 	FILE2C

FILE2B:					;here to print error message
	LOAD	S1,,T.GTE		;get input device error
	JUMPE	S1,FILABO		; something different

	$WTOJ	<^I/IBMOAB/>,<input error "^I/DGLXER/" ^I/WRTFLM/>,@T%OBA

FILE2C:

FTCLOG<	$TEXT 	(LOGCHR,<^I/IBMSG/Error "^I/DGLXER/" ^I/WRTFLM/>)>

	TXNE	S,GOODBYE		;check for job being cancelled
	JRST	FILABO			;yes - do the aborting cruft
	TXNN	S,IOABT			;check on output abort
	$CALL	ABTDEV			;abort the stream so IBM will know
	JRST	FILE2D

FILE2A:	$WTOJ	<^I/IBMOAB/>,<line went away ^I/WRTFLM/>,@T%OBA

FILE2D:	TXO	S,ABORT!RQB		;requeue request and set abort to
					; prevent I/O to IBM
FILE1:					; here when finished with file
	$CALL	XFRAT			; calculate transfer rate
	$WTOJ	<finished output>,<finished output from file ^F/(P3)/, ^D/T%TBC/ bytes at ^D/S1/ Bps>,@T%OBA
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/Finished file ^F/0(P3)/>)>
	TXZ	S,DSKOPN		;clear flag
	$RETT				;passs COPY return code on
FILCGO:					;here if direction is wrong

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/File transfer aborted because of input ^F/0(P3)/>)>
	TXZ	S,DSKOPN		;indicate file is closed
	$RETF				;return false

FILABO:	$CALL	ABTDEV			;no io errors - just aborting
	TXNN	S,GOODBYE		;check if CANCEL happened
	JRST	FILAB1

	$WTOJ	<^I/IBMOAB/>,<job cancelled ^I/WRTFLM/>,@T%OBA
	JRST	FILE1			;don't requeue this one

FILAB1:	$WTOJ	<^I/IBMOAB/>,<software bug ^I/WRTFLM/>,@T%OBA
	JRST	FILE2D			; requeue this one

FILE2E:	$WTOJ	<job cancelled>,<job cancelled due to ^I/DGLXER/ while opening file ^F/(P3)/>,@T%OBA

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/job cancelled due to ^I/DGLXER/ while opening file ^F/(P3)/>)>
	TXZ	S,DSKOPN		;clear flag
	$RETT				;end normally
SUBTTL Tasks -- .   NXTFIL, advance to next file in job

; Routine - NXTFIL
;
; Function - Advances P2 and P3 to the next file-spec in the QUASAR request
;
; Parameters - P2 must point to current parameter area of FDB within request.
;
; Returns - P2 on true points to next parameter area, P3 to next FDB
;	    true if another file to process, false otherwise
;
; Note - destroys S1, decrements file count (T.FLN), sets T.LFS if
;	 log-file spec encountered.

COMMENT	&

  This routine advances the pointer to the current file
(kept in P2 and P3) to point to the next file-spec in the request sent
by QUASAR; if the next specification is for a log-file, it
saves its address (at T.LFS) and goes to the next one.
If there are no more, it returns false.

	&


NXTFIL:					;subroutine to advance P2 to next file spec
	SOSG	T%NFL			;decrement count of files
	$RETF				;if no more, return false
	AOS	T%NFP			;If more, count one more done.
	LOAD	S1,.FPLEN(P2),FP.LEN	;get length of the file parameter area
	ADD	P2,S1			;advance to next FDB
	LOAD	S1,.FDLEN(P2),FD.LEN	;get length of FDB
	ADD	P2,S1			;advance to next parameter area
	LOAD	S1,.FPLEN(P2),FP.LEN	;get length of parameter area
	MOVE	P3,P2			;copy address of parameter area
	ADD	P3,S1			;set up P3 to point to FDB
;	LOAD	S1,.FPINF(P2),FP.FLG	;get log-file flag
	LOAD	S1,,T.NFL		;?? get number of files left
	SUBI	S1,1			;?? if just 1, we have real file
	JUMPN	S1,.RETT		;return if not log file
	STORE	P2,,T.LFS		;save log-file address for later
	JRST	NXTFIL			;and go get next real spec (if any)
SUBTTL Tasks -- TKLPT, 2780/3780 line printer

; Routine - TKLPT
;
; Function - To control the 2780/3780 line printer input stream.
;
;	 This task wakes only on TW.IAV (input available) which is set by the
;	main task (TKCDR) whenever it succeeds in turning the line around.  It
;	then opens a temporary holding file for the data; if one already exists
;	(because of a system crash for example) it retrieves its disposition
;	information and disposes of iT.  Once the holding file is ready, it
;	sets up the parameters for the subroutine LPTJOB and calls it to do
;	the actual copying of line printer data from IBM to the disk.
;
;	 After the file is finished, the task gets its disposition information
;	and queues it to the LPT queue or renames it into the user's directory.
;	The task then disposes of the log file in the same way; this log file
;	contains not only such job-related information as times started and
;	finished, number of records read, etc. but also all console traffic to
;	and from the IBM host while the file was being transferred (so that the
;	user will have a record of what, if anything, was done to his job [e.g.
;	restarting, making more copies, cancelling]).
;
;	 When the task is all finished with the file it signals TW.ICP to the
;	card reader task and deactivates itself.

TKLPT:	MOVE	T1,TK			; Save task block address
	LOAD	S1,,L.LNI		; Get line information
	HRLZI	S2,.TCDR		; Get card-type,,0 as dev,,unit
	$CALL	FNDTSK			; Get card reader task address
	LOAD	S1,,T.OBA		; Address of object block
	EXCH	T1,TK			; Get our task block back
	STORE	S1,,T.OBA		; Save address of object block
	STORE	T1,,T.OTK		; and save other task address for later
	MOVEI	S1,[ASCIZ /Idle/]	; Get state
	STORE	S1,,T.DST		; and save it for status

; Here to wait for input ready signal from card reader task

LPMAIN:	$DSCHD	TW.IAV,0		; Wait only on TW.IAV
	TXZ	S,IOABT			;[261] clear leftover abort flag
	LOAD	S1,,L.STS		; Get line status
	TXNN	S1,L.SFS		; If signoff sent
	TXNE	S,LGA			; or line gone away
	 JRST	CDERR			;  Exit gracefully
	TXO	S,CHKLOG		; Checking for console output file
	TXZ	S,CONPAT		; but it isn't yet
	$CALL	LPTJOB			; Call common routine to process file
	JUMPF	LPMAI0			; could not process lpt input try to ignore
	TXNE	S,CONPAT		; Was it a log file?
	JRST	[LOAD S1,,T.TBC		; yes - check size limit
		 CAIG S1,CONLMT
		 JRST LPCONO		;  ok to display on operator console
		 JRST .+1]
	$CALL	DISPOS			; No, take care of disposition

IFN FTIBMS,<
	MOVEI	S1,%EOUT		; inform QUASAR
	$CALL	IBMSTS
> ;End of FTIBMS


LPMAI0:	TXZ	S,ACTIVE!ABORT!CHECK!OUTEOF ; [367] Clear flags

FTLOG <
	MOVEI	S1,LOGGET		;address of get routine
	STORE	S1,,T.GTR		;save it
	$CALL	FILED			;write it to disk
	$CALL	DISPOS			;dispose of it too
   >;end FTLOG

; Here when done with LPT file

LPDONE:	MOVEI	S1,[ASCIZ /Idle/]	; Get state
	STORE	S1,,T.DST		; and save it for status
	LOAD	T1,,T.OTK		; Get card reader task
	EXCH	T1,TK			; Switch to its task block
	$SIGNL	TW.ICP			; Set input complete
	EXCH	TK,T1			; Switch back to ours
	TXNE	S,LGA			; See if line has gone away
	 JRST	CDERR			;  Yes, just wait for coup de grace
	$CALL	DEATSK			; No, deactivate task
	LOAD	S1,,L.STS		; Get line status
	TXNN	S1,L.SFS		; If signoff sent
	TXNE	S,LGA			; or line gone away
	 JRST	CDERR			;  Exit gracefully
	JRST	LPMAIN			; When re-activated, go back to loop

; Here when line printer file was really console output

LPCONO:	$CALL	ROPNHL			; Open hold file for input
	JUMPF	LPCONE			; Complain if cannot
	MOVEI	S1,GETDSK		; Address of get routine
	STORE	S1,,T.GTR		; to vector
	MOVEI	S1,PUTCNO		; Address of put routine
	STORE	S1,,T.PTR		; to vector too
	MOVEI	S1,STRPBL		; Address of rtn to strip blank lines
	STORE	S1,,T.CKR		; to check routine vector
	TXZ	S,ACTIVE!ABORT		; Logging no longer allowed
	TXO	S,NOCTLS!CHECK		; Make sure we convert ctl-s
	$CALL	TBFINI			; Initialize buffer pointers
	$CALL	COPY			; and copy entire file to CNO queue
	$CALL	ROPNHL			; Re-open hold file
	JUMPF	LPCONE			; If cannot, complain
	$CALL	F%DREL			; and release it
	JUMPT	LPDONE			; Go finish up if no error

; Here if error handling hold file of console output

LPCONE:	$WTOJ	<Spool file error>,<^I/DGLXER/ opening or closing hold file of console output>,@T%OBA
	JRST	LPDONE			; Ignore rest of it


; Local subroutine to re-open hold file

ROPNHL:	MOVEI	S1,FDBARE		; Point to FDB build area
	MOVEI	S2,NMNTAB		; and table of names
	$CALL	BLDFDB			; Get filename of hold file
	MOVEI	S1,2			; Size of open block
	MOVEI	S2,FIB			; and address of open block
	$CALL	IBMIOP			; Open hold file for input
	$RET				; Propagate true or false

FIB:	EXP	FDBARE			; File open block for input
	EXP	7			; Byte size

; Subroutine to strip blanks out of 2780/3780 console output

;	T1/adr of record
;	T2/byte count

STRPBL:	JUMPLE	T2,.POPJ		; do nothing if no data
	$SAVE	<T1,T3>
	MOVE	T3,T2
	HRLI	T1,440700		; Make byte pointer
STRPB0:	ILDB	S1,T1			; Get next character
	CAILE	S1,40			; If control or blank, continue
	 $RET				;  else return (i.e. leave line as is)
	SOJN	T3,STRPB0		; Continue until all accounted for
	SETZ	T2,			; Line blank or cntl, clear count
	$RET				; Return
SUBTTL Tasks -- .  LPTJOB, process printer job

; Routine - LPTJOB
;
; Function - Opens hold file, initializes buffers and counters, puts
;	messages into log file (FTLOG), copies the input file from IBM
;	to disk until error or EOF occurs.
;
; Parameters - S must have CHKLOG on if log file checking desired.
;
; Returns -	Always true
;		CHKLOG turned off if no record matched log file pattern.
;		P3/ptr to fdb in queue create msg/random name for hold file
;		P4/ifn for hold file(PnnLnn form) used to receive lpt input
;
; Note - Destroys S1, S2, T1, T2



LPTJOB:	STORE	S,S+T%ACS		; [362] store S in AC block because
					;   INIPAG updates it there
	$CALL	INIPAG			; [362] make sure pages are set up
	LOAD	S,S+T%ACS		; [362] restore updated S
	JUMPF	.POPJ			; [362] propagate error if we cannot
	LOAD	J,J+T%ACS		; [362] get pointer to pages
;**;[406]At LPTJOB:+5L delete 2 lines	JYCW 1/25/89
	$CALL	TBFINI			; Initialize bufffer pointers
	MOVEI	S1,GETIBM		; Address of routine to get from IBM
	STORE	S1,,T.GTR		; Store as "get" routine
	MOVEI	S1,IBMLFR		; Point to checking routine
	STORE	S1,,T.CKR		; And save its address
	MOVEI	S1,PUTDSK		; Address of routine to write to disk
	STORE	S1,,T.PTR		; Store as "put" routine
	ZERO	,T.ICT			; Clear input count
	ZERO	,T.OCT			; and output count
	ZERO	,T.TBC			; Clear cumulative byte count
	ZERO	,T.GTE			; init errors
	ZERO	,T.PTE
	TXO	S,ACTIVE!CHECK!CHKSWT!DOCHKP ; init switches
	SETZB	P3,P4			; no file open yet
	MOVEI	S1,[ASCIZ /permission to input job granted/]
	STORE	S1,,T.DST		; Save status for display messages
	$CALL	I%NOW			; Get starting time
	STORE	S1,,T.TMS		; Save it in task starting time
	HRREI	S1,-CHKCNT		; Get record count between checkpoints
	STORE	S1,,T.OCK		; and save it
	MOVEI	S1,CHKDSK		; Address of checkpoint routine
	STORE	S1,,T.CKP		; Store in vector
FTACCT<	PUSHJ	P,OACTBG>		; Begin accounting.
	$CALL	COPY			; Copy the file
	JUMPT	OPNZX1			; If no error .. skip error message
	LOAD	S1,,T.GTE		; track down the error
	JUMPE	S1,OPNZX2		; not IBM

	JUMPE	P3,OPNZX1		;[4(264)] output file setup?
	$WTOJ	<^I/IBMIAB/>,<input ^I/D60ERM/ ^I/WRTFLM/>,@T%OBA ;Yes.
FTCLOG<	$TEXT	(LOGCHR,<^I/IBLPT/^I/D60ERM/ ^I/WRTFLM/>)>
	JRST	OPNZX1			;[4(264)] finish up

OPNZX2:	LOAD	S1,,T.PTE		; no input error - check output(file)
	JUMPE	S1,LPTABO		;just aborting apparently

	$WTOJ	<^I/IBMIAB/>,<output error "^I/DGLXER/" ^I/WRTFLM/>,@T%OBA
FTCLOG<	$TEXT	(LOGCHR,<^I/IBLPT/Error ^I/DGLXER/ ^I/WRTFLM/>)>

OPNZAB:	$CALL	ABTDEV			; abort the stream from IBM

OPNZX1:	JUMPE	P4,.RETF		;fail if no file was created
	LOAD	T1,,T.TBC		;[261] retrieve size of file just input
	SKIPN	T1			;[261] is it 0 bytes long ?
	TXZ	S,CHKLOG!CONPAT		;[261] yes, say it wasn't console input
	$CALL	XFRAT			;calc xfer rate
;at OPNZX1:+6
	TXNN	S,IOABT			;[372] transfer complete and ok?
	JRST	LPTFIN			;[372] yes, give normal finish message
FTCLOG<	$TEXT	(LOGCHR,<^I/IBLPT/terminated file ^F/0(P3)/, ^D/T1/ bytes at ^D/S1/ Bps>)>				;[372] no, log that we had a problem
	$WTOJ	<Aborted finish>,<finished input to .ABT file, ^D/T1/ bytes at ^D/S1/ Bps>,@T%OBA			;[372] tell everyone file got mangled
	$RETT				;[372]	 Return
LPTFIN:	FTCLOG<	$TEXT	(LOGCHR,<^I/IBLPT/finished file ^F/0(P3)/, ^D/T1/ bytes at ^D/S1/ Bps>)>
	$WTOJ	<finished input>,<finished input to file ^F/0(P3)/, ^D/T1/ bytes at ^D/S1/ Bps>,@T%OBA
	$RETT				; Return

OPNDTH:

FTCLOG<	$TEXT	(LOGCHR,<^I/IBLPT/ ^I/OLPTER/>)>
	$WTOJ	<^I/IBMIAB/>,<could not open hold file - "^I/OLPTER/">,@T%OBA
	$CALL	ABTDEV			; make sure IBM knows
	$RETF				; die

LPTABO:	JUMPE	P4,OPNDTH		; error was in opening hold file
	TXNN	S,GOODBYE		; no io error - just aborting
	JRST	LPTAB1

	$WTOJ	<^I/IBMIAB/>,<COMMANDED ABORT ^I/WRTFLM/>,@T%OBA
	JRST	OPNZAB

LPTAB1:	$WTOJ	<^I/IBMIAB/>,<software bug ^I/WRTFLM/>,@T%OBA
	JRST	OPNZAB

XFRAT:					; calc xfer rate
	LOAD	S1,,T.TFD		; get done time for io
	SKIPN	S1
	$CALL	I%NOW			; not set - get present
	LOAD	S2,,T.TFS		; get io start time
	SKIPN	S2
	LOAD	S2,,T.TMS		; not set - get job start time
	SUB	S1,S2
	IDIVI	S1,3
	SKIPN	S2,S1
	MOVEI	S2,1			; min 1 sec
	LOAD	S1,,T.TBC		; get amt xferred
	IDIV	S1,S2			; bytes per sec
	$RET
SUBTTL Tasks -- TKHCDR, HASP card reader

; Task - TKHCDR
;
; Function -   This task is given control by the setup routine; it first
;	checks if the station is up and signed on; if not, it activates
;	the control task, signals signon request, and waits for signon done.
;
;	Once the station is signed on, it waits on TW.QRQ
;	(a request arrived from QUASAR).
;
;	On receipt of a QUASAR request it calls the DOJOB subroutine
;	to copy the files of the request to IBM.

TKHCDR:	LOAD	S1,,L.STS		; Get line status
	TXC	S1,L.UP!L.SND		;  check both line up and signed on
	TXCN	S1,L.UP!L.SND		; Put em back and skip if not both on
	 JRST	TKHCR0			;  Go immediately to idle wait
	LOAD	T1,,L.FTK		; Get address of control task
	EXCH	T1,TK			; Save our task pointer
	$CALL	ACTTSK			; Activate control task
	$SIGNL	<TW.SNR>,TASK		; Tell him to do signon
	MOVE	TK,T1			; Get our pointer back
	MOVEI	S1,[ASCIZ /Waiting for SIGNON/]
	STORE	S1,,T.DST		; State for status message
	$DSCHD	TW.SND,0		; Wait only for signon done
	LOAD	S1,,T.DEV		; Get device code
	LOAD	S2,,L.LNI		; and port,,line
	$CALL	DEVOPN			; Open it because signon needed it
	TXNE	S,LGA			; See if line has gone away
	 JRST	CDERR			;  If line down, exit
	MOVE	P1,S1			; Copy dev handle into proper register
	LOAD	S1,,T.WCN		; Get wakeup conditions
	TXNE	S1,TW.QRQ		; Has QUASAR been fast?
	JRST	TKHCR1			;  Yes, don't do delay
	JRST	TKHCRA

TKHCR0:	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

TKHCRA:	MOVEI	S1,[ASCIZ /Idle/]	; Display idle
	STORE	S1,,T.DST		; State for message
	$DSCHD	TW.QRQ,0		; Wait for job
	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

TKHCR1:	MOVEI	S1,[asciz /Sending job/]
	STORE	S1,,T.DST		; State for status message
FTACCT<	PUSHJ	P,IACTBG>		; start accounting
	$CALL	DOJOB			; Get next job and do it

FTACCT<	PUSHJ	P,IACTND>		; and write the accounting entry
	JRST	TKHCR0			; Go back for more
SUBTTL Tasks -- TKHCDP, HASP card punch
SUBTTL Tasks -- TKHLPT, HASP line printer

; Task - TKHCDP, TKHLPT
;
; Function - To service HASP line-printer and card-punch streams.


TKHCDP:
TKHLPT:	MOVE	T1,TK			; Save task block address
	LOAD	S1,,L.LNI		; Get line information
	HRLZI	S2,.TCDR		; Get card-type,,0 as dev,,unit
	$CALL	FNDTSK			; Get card reader task address
	LOAD	S1,,T.OBA		; Address of object block
	EXCH	T1,TK			; Get our task block back
	STORE	S1,,T.OBA		; Save address of object block
	JRST	LPHMA0

LPHMAI:	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

LPHMA0:	MOVEI	S1,[ASCIZ /Idle/]	; Get state
	STORE	S1,,T.DST		; and save it for status
	$DSCHD	TW.IOD			; Wait for activity
	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

LPHMAR:	TXZ	S,IOABT			;[372] clear leftover abort flag
	HRRZ	S1,P1			; Get device handle
	D60	D60STS,LPHMAR,0		; Get device status
	JUMPF	LPHMAI			;  If failed .. wait for I/O
	TXNN	S2,SDIRN!SDIPW!SDIPR	; Check for input request
	 JRST	LPHMAI			;  If none .. go back to sleep

LPHJOB:	$CALL	LPTJOB			; Call common routine to process file
	JUMPF	LPHJOE			; skip if lpt input not processed
	$CALL	DISPOS			; Take care of disposition

IFN FTIBMS,<
	MOVEI	S1,%EOUT		; inform QUASAR
	$CALL	IBMSTS
> ;End of FTIBMS

LPHJOE:	TXZ	S,ACTIVE!ABORT!CHECK!OUTEOF ; [367] Clear flags

FTLOG <
	TXZ	S,IOABT			;[261] clear soft abort condition
; Set up log file parameters from recognized stuff
	MOVEI	S1,LOGGET		; Address of get routine
	STORE	S1,,T.GTR		; Save it
	$CALL	FILED			; Write it to disk
	$CALL	DISPOS			; Dispose of it too
    >;end FTLOG

	JRST	LPHMAI			; No, go back and look for more work
SUBTTL Tasks -- TKHCNI, HASP console input to IBM

; Task - TKHCNI
;
; Function - To take entries from the console input queue and send them
;	down the HASP console input pipe.

TKHCNI:	$DSCHD	TW.CNI,0		; Wait for some
	$CALL	PUTCNI			; use  the worker fcn
	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

	JRST	TKHCNI			; and try to continue
SUBTTL Tasks -- TKHCNO, HASP console output from IBM

; Task - TKHCNO
;
; Function - To read console output coming from the IBM host and queue
;	it to the SND task to be distributed.

TKHCNO:	MOVE	T1,TK			; Save task block address
	LOAD	S1,,L.LNI		; Get line information
	HRLZI	S2,.TCDR		; Get card-type,,0 as dev,,unit
	$CALL	FNDTSK			; Get card reader task address
	LOAD	S1,,T.OBA		; Address of object block
	EXCH	T1,TK			; Get our task block back
	STORE	S1,,T.OBA		; Save address of object block
TKHCN1:	$CALL	INIXBA			; initialize SIN buffer page
	JUMPT	TKHCN0			; continue with task if successful
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/couldn't allocate transmission buffer for console>)>
	$WTOJ	<console error>,<couldn't allocate transmission buffer>,@T%OBA
	$DSCHD	0,^D60*3		; wait a minute
	JRST	TKHCN1			; try again

TKHCN0:	$DSCHD	TW.IOD			; Wait for input available
	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully

	MOVEI	S1,GETIBM		; Address of get routine
	STORE	S1,,T.GTR		; to vector
	MOVEI	S1,PUTCNO		; Address of put routine
	STORE	S1,,T.PTR		; to vector too
	TXZ	S,ACTIVE!ABORT!DOCHKP!CHECK	; Logging no longer allowed
	TXO	S,NOCTLS!PEOF		; Make sure we convert ctl-s and hallucinate EOF
;[372] Remove one line at TKHCNO+9
	$CALL	TBFINI			; Initialize buffer pointers
	SETZ	S1,

	STORE	S1,,T.GTE		; clear COPY error report entries
	STORE	S1,,T.PTE
	$CALL	COPY			; and copy entire file to CNO queue
	JUMPT	TKHCN0			; did it go ok?
					; no - report error
	LOAD	S1,,T.GTE		; only expect "get" errors
	JUMPE	S1,TKHCN0		; however, it's best to be paranoid

TKHCN2:	$WTOJ	<D60JSY error>,<^I/D60ERM/ while reading console output>,@T%OBA
	$CALL	LINCHK			; check if line is viable
	JUMPF	CDERR			; no - expire gracefully
	JRST	TKHCN0			; wait for more
SUBTTL Subroutines -- Initialization and Main Loop subroutines
SUBTTL Subroutines -- .  OPDINI, Get operating system information

; Routine - OPDINI
;
; Function - Gets central site node number, monitor name and (if 20) the
;	directory number for PS:<SPOOL>.
;
; Parameters - None
;
; Returns - True always
;	    CNTSTR is set to node number
;	    CNF is set to monitor name
;	    SPLDIR is set to PS:<SPOOL> directory number if TOPS20
;
; Note - Destroys T1-T3

COMMENT	&

  This routine is operating system dependent. For TOPS-10 it gets the
name of the monitor, and then the station number of the central site.
For TOPS-20 it zeros the station number, gets the monitor name, gets
the directory number for PS:<SPOOL> and finally issues MSTR to allow
structure access without prior mount.

	&

OPDINI:					;operating system dependent
					; initialization
TOPS10 <
	CNFDSP==(%CNFG0)		;get displacement
	CNFDSP==CNFDSP&RHMASK		; of first word in table
	MOVE	T3,[XWD -SYSNML,CNFDSP]	;LH=number of words to get,
					; RH=first index for GETTAB
OPDIN1:	MOVEI	T2,.GTCNF		;get table number in RH
	HRL	T2,T3			;get current index in LH
	GETTAB	T2,			;get that word into T2
	  SETZ	T2,			;no GETTAB, no monitor name
	MOVEM	T2,CNF-CNFDSP(T3)	;put the word into the proper place in CNFG
					; (the -CNFDSP is only necessary in
					; case its value (now 0) changes
	AOBJN	T3,OPDIN1		;loop control, index register advancement
					; and index advancement for GETTAB
					; in one instruction

	MOVEI	T1,.GTLOC		;table name for location
	GETTAB	T1,			;get central site number
	  SETZ	T1,			;set to 0 if we don't have UUO
	HRRZM	T1,CNTSTA		;save it
    >;End if TOPS10

TOPS20 <
	SETZM	CNTSTA			;set central site number to 0
	MOVX	R1,'SYSVER'		;get name of table
	SYSGT				;convert into table number
	HRLZ	T1,R2			;get table#,,0
	MOVEI	T2,SYSNML		;get number of words
OPDNI1:	MOVS	R1,T1			;get n,,table#
	GETAB				;get the entry
	  SETZ	S1,			;use 0 if error
	MOVEM	S1,CNF(T1)		;store the result
	CAILE	T2,(T1)			;done enough?
	AOJA	T1,OPDNI1		;no, go back for more


	MOVX	R1,RC%EMO		;we want exact match
	HRROI	R2,[ASCIZ /PS:<SPOOL>/]	; of this directory
	RCDIR				;get its number
	MOVEM	R3,SPLDIR		;save it
	MOVEI	S1,.MSIIC		;function to disable structure checking
	MSTR				;issue it, will be illegal instruction
					; if we are not privileged enough
    >;End if TOPS20
	$RETT				;always return true
SUBTTL Subroutines -- .  QUIESC, wait for tasks to settle

; Routine - QUIESC
;
; Function - Waits for all tasks to be idle
;
; Parameters - none (TK and LB must be set up)
;
; Returns - always .POPJ when all tasks are idle
;
; Note - Destroys S1, S2
;

QUIESC:					;here to wait for all tasks to
					; exit gracefully (i.e. DSCHD for
					; neither time nor bits)
	$SAVE	<P1,P2>			;get a couple of registers
	MOVE	P1,TK			;save original TK
QUILOP:	SETZ	P2,			;clear non-waiting count
	LOAD	TK,,L.FTK		;point to control task
	LOAD	TK,,T.PFW		;get first real task
	JUMPE	TK,QUIDON		;if no tasks, we are done
QUIES0:					;loop to check tasks
	LOAD	S2,,T.ATE		;point to active task list
	JUMPE	S2,QUIKIL		;illegal to be zero, kill task
	LOAD	S1,,A.WKT		;get wakeup time
	JUMPN	S1,QUIES2		;if there, can't kill him yet
	LOAD	S1,,T.WKB		;get his wakeup bits
	JUMPE	S1,QUIES1		;if none, task is waiting patiently to die
	$CALL	SGNTSK			;if some, dummy up what he is waiting for
QUIES2:	AOS	P2			;indicate another task not ready
QUIES1:					;here if we cannot kill this
	LOAD	TK,,T.PFW		;get next task
	JUMPN	TK,QUIES0		;if we got one, try to kill it
	JUMPE	P2,QUIDON		;if none not-waiting, we are finished
	LOAD	TK,,L.FTK		;point to control task (us)
	$DSCHD	0,^D6			;wait a couple of seconds
	JRST	QUILOP			;and try again
QUIDON:	MOVEM	P1,TK			;restore original TK
	$RET
QUIKIL:	$CALL	RELTKB			;delete task
	JRST	QUILOP			; and start over
SUBTTL Subroutines -- IPCF message subroutines
SUBTTL Subroutines -- .  SNDQSR, send a message to QUASAR

; Routine - SNDQSR
;
; Function - Gets system index flag, puts QUASAR's index in, puts length
;	and address of message in, and calls C%SEND to send message
;
; Parameters - T1/ Address of message
;
; Returns - true if send succeeds
;	    false if not, S1/C%SEND error code
;
; Note - Destroys S1, S2
;	 Changes SAB (send argument block for C%SEND)


COMMENT	&

  This subroutine fills in the send argument block with the
appropriate information for sending a message to QUASAR
and calls the GLXLIB routine C%SEND to send iT.

  We can have a single send argument block only one task (or
the scheduler) can run at a time and whatever is running cannot
be interrupted until it does a $DSCHD.

	&
SNDOPR:	SKIPA	S1,[SP.OPR]		;here to send message to ORION
SNDQSR:					;here to send message to QUASAR
	MOVX	S1,SP.QSR		;get QUASAR's system PID index
	TXO	S1,SI.FLG		; and turn on flag to indicate we
					; are using system PIDs
	STORE	S1,SAB+SAB.SI		;store in system index word of send
					; argument block
	SETZM	SAB+SAB.PD		;clear the destination PID word
	LOAD	S1,.MSTYP(T1),MS.CNT	;get length of message from the header
	STORE	S1,SAB+SAB.LN		;and store in length word
	STORE	T1,SAB+SAB.MS		;store message address also
	MOVEI	S1,SAB.SZ		;put length of send argument block into
					; parameter register
	MOVEI	S2,SAB			;and its address
	$CALL	C%SEND			;call GLXLIB routine to send message
	$RET				; return results of C%SEND


QSRDTH:
TOPS20	<$STOP	SQF,<Send to QUASAR failed>> ; SNDQSR users can come here to die
TOPS10	<STOPCD	(SQF,HALT,,<Send to QUASAR failed>)> ; SNDQSR users can come here to die
					; when they cannot tolerate failure
SUBTTL Subroutines -- .  SNDBAK, IPCF reply to last sender

; Routine - SNDBAK
;
; Function - Gets PID from current message, puts it in header, puts length
;	and address of message in and calls C%SEND to send message.
;
; Parameters - none
;
; Returns - True always
;
; Note - Destroys S1, S2
;	 Changes SAB (send argument block for C%SEND)

COMMENT	&

  This subroutine fills in the send argument block with the
appropriate information for sending a message back to the
user who sent the last message we received and calls the
GLXLIB routine C%SEND to send iT.

  We can have a single send argument block only one task (or
the scheduler) can run at a time and whatever is running cannot
be interrupted until it does a $DSCHD.

	&

SNDBAK:					;here to send message back
	SETZ	S1,			;clear system PID indicator
	STORE	S1,SAB+SAB.SI		;store in system index word of send
					; argument block
	LOAD	S2,MDBADR		;get MDB address
	LOAD	S1,MDB.SP(S2)		;get sender's PID
	STORE	S1,SAB+SAB.PD		;store it in the SAB
	LOAD	T1,MDB.MS(S2),MD.ADR	;get message address
	LOAD	S1,.MSTYP(T1),MS.CNT	;get length of message from the header
	STORE	S1,SAB+SAB.LN		;and store in length word
	STORE	T1,SAB+SAB.MS		;store message address also
	MOVEI	S1,SAB.SZ		;put length of send argument block into
					; parameter register
	MOVEI	S2,SAB			;and its address
	$CALL	C%SEND			;call GLXLIB routine to send message
	$RETT				;ignore errors
SUBTTL Subroutines -- .  RSETUP, response to setup (to QUASAR)

; Routine - RSETUP
;
; Function - Builds a response to setup message in MSGBLK and sends it
;	to QUASAR; if the response was not ok (%RSUOK set) it also
;	disables the line (so that dial-up phone hangs up).
;
; Parameters - S1/ Condition code to return to QUASAR
;
; Returns - True if succeeds, dies otherwise
;
; Note - Destroys S1, S2, T1 and T2
;	 Changes contents of MSGBLK


RSETUP:					;subroutine to send response to setup
	MOVE	T2,S1			;save condition code
	MOVEI	S1,RSU.SZ		;get length of this message
	MOVEI	S2,MSGBLK		;and start of where we want to build it
	$CALL	.ZCHNK			;zero out the message
	STORE	S1,.MSTYP(S2),MS.CNT	;store size
	MOVX	S1,.QORSU		;get message function code
	STORE	S1,.MSTYP(S2),MS.TYP	;save it in message also
	MOVEI	S1,SUP.TY(P1)		;get address of object block
	MOVS	S1,S1			;get it into LH for BLT pointer
	HRRI	S1,RSU.TY(S2)		;get destination address in RH
	BLT	S1,RSU.TY+OBJ.SZ-1(S2)	;copy object block into message
	STORE	T2,RSU.CO(S2)		;store response code
TOPS10	<
	MOVX	S1,%IBMBT		;[375] Get attribute
	CAXN	T2,%RSUOK		;[375] Success?
	STORE	S1,RSU.DA(S2),RO.ATR	;[375] Yep, set attribute
> ;End TOPS10
	MOVE	T1,S2			;get address of message for SNDQSR
	$CALL	SNDQSR			;go send message to QUASAR and return to caller
	JUMPF	QSRDTH			; die if can't do it
	$RET				; return true
SUBTTL Subroutines -- .  QRLSE, requeue/release (to QUASAR)

; Routine - QRLSE
;
; Function - Sends message to operator and then builds a release/requeue
;	message for QUASAR.
;
; Parameters - none
;
; Returns - True always
;
; Note - Destroys S1, S2 and MSGBLK contents


QRLSE:					;send a  requeue/release message to QUASAR
	$WTOJ	<End>,<^R/.EQJBB(J)/>,@T%OBA
	MOVEI	S1,MSBSIZ		;get size of message block
	MOVEI	S2,MSGBLK		; and its address
	$CALL	.ZCHNK			;zero it out
	MOVEI	T1,MSGBLK		;point to start of block
	TXZE	S,RQB			;are we requeuing the job?
	JRST	QRLSE0			;yes, go set up for it
	LOAD	S1,.EQITN(J)		;get internal identification number (ITN)
	STORE	S1,REL.IT(T1)		;and put it into message
	MOVX	S1,REL.SZ		;load size of release message
	MOVX	S2,.QOREL		; and function for
	JRST	QRLSE1			; common code

QRLSE0:					;here on job requeue
	LOAD	S1,.EQITN(J)		;get internal identification
	STORE	S1,REQ.IT(T1)		;save in message
	LOAD	S1,,T.NFP		;get number of files processed
	STORE	S1,REQ.IN+CKFIL(T1)	;store in message
	MOVX	S1,CKFREQ		;get requeue bit
	STORE	S1,REQ.IN+CKFLG(T1)	;store it in message
					;don't set RQ.HBO in REQ.FL
	MOVX	S1,REQ.SZ		;get size of requeue message
	MOVX	S2,.QOREQ		; and function

QRLSE1:					;common code for requeue and release
	STORE	S1,.MSTYP(T1),MS.CNT	;save size
	STORE	S2,.MSTYP(T1),MS.TYP	; and function in header
	MOVEI	T1,MSGBLK		;get address of message
	$CALL	SNDQSR			;send it to QUASAR
	JUMPF	QSRDTH			; die if can't do it
	$RET				;return true
SUBTTL Subroutines -- . INIXBA, set up single page buffer


INIXBA:					;get and setup T.XBA buffer
	$CALL	M%GPAG			;get a page from QUASAR
	JUMPF	.POPJ			;propagate error if we cannot
	STORE	S1,,T.XBA		;store as transmission buffer
	PJRST	INIXBF			; and initialize rest

SUBTTL Subroutines -- .  INIPAG, set up job pages

INIPAG:					;set up job pages if necessary
	LOAD	S1,S+T%ACS		;get task's status bits
	TXNE	S1,JVALID		;already set up?
	$RETT				;yes, return
	MOVEI	S1,3			;number of pages to acquire
	$CALL	M%AQNP			;get them
	JUMPF	.POPJ			;if we have error, return it
	PG2ADR	S1			;convert page addr to real address
	STORE	S1,J+T%ACS		;save it as task's J register
	LOAD	S2,S+T%ACS		;get task's S register (flags)
	TXO	S2,JVALID		;set the J register valid bit
	STORE	S2,S+T%ACS		;and put it back
	ADDI	S1,1000			;calculate address of 2nd page
	STORE	S1,,T.XBA		;store as device buffer address
	ADDI	S1,1000			;get address of third page
	STORE	S1,,T.GBA		;store as log file page number 1
INIXBF:	MOVEI	S1,440700		;default byte pointer is ASCII
	HRLM	S1,T%XBA		;save in LF of buffer address
	MOVEI	S1,1000*5		;default number of bytes
	STORE	S1,,T.XBN		;save for later
	$RETT
SUBTTL Subroutines --  Queue create message handling
SUBTTL Subroutines -- .   INIQRQ, Initialize queue request to default

; Routine - INIQRQ
;
; Function - Puts default entries into queue request page (short create msg);
;	can only be called from task level.
;
; Parameters - none
;
; Returns -	False if INIPAG or INSENT fails, True otherwise
;		S1/ ptr to fdb in queue create msg for random file namme
;
; Note - Destroys S2
;	 Changes queue request page for task


INIQRQ:					;here to initialize queue request page
	$SAVE	<T1,T2,T3>
	MOVEM	S,S+T%ACS		;store S in AC block because INIPAG
					; updates it there
	$CALL	INIPAG			;make sure pages are set up
	MOVE	S,S+T%ACS		;restore updated S
	JUMPF	.POPJ			;propagate error if we cannot
	LOAD	J,J+T%ACS		;get pointer to pages
	SETZM	0(J)			;zero first word of page
	MOVEI	S1,1(J)			;get destination for BLT pointer
	HRL	S1,J			;and source
	BLT	S1,777(J)		;zero whole page
	MOVE	T1,[XWD 2,.QCQUE]	;get beginning of queue type entry
	LOAD	T2,,T.QOB		;get queue object type
	MOVEI	S1,T1			;point to it
	$CALL	INSENT			;store it
	JUMPF	.POPJ			;propagate error if there is one
TOPS10<					;[402]Conditionalize this
INIQRS:	MOVE	T1,[XWD 2,.IBMST]	;[376]Make a structure entry
	MOVE	T2,IBMDEV		;[376]use the default structure
	MOVEI	S1,T1			;[376]pass address of entry
	$CALL	INSENT			;[376]add to Queue create page	
	JUMPF	.POPJ			;[376]couldn't do it, return error
	MOVE	T1,[XWD 2,.QCOID]	;[376]Make a "dummy" ppn entry
	MOVE	T2,[XWD 5,32]		;[376]Use D60's ppn
	MOVEI	S1,T1			;[376]pass address of entry
	$CALL	INSENT			;[376]add to Queue create page	
	JUMPF	.POPJ			;[376]couldn't do it, return error
>					;[402]conditional
	$CALL	I%NOW			;Get internal date/time in UDT format
	STORE	S1,,T.RNM		;store it as our random name
	$CALL	LGFD.0			;Convert to a reasonable sixbit value
	MOVE	T2,S1			; and set as jobname argument
	MOVE	T1,[XWD 2,.QCJBN]	;get first part of jobname entry
	MOVEI	S1,T1			;point to it
	$CALL	INSENT			;insert it
	JUMPF	.POPJ			;propagate error if we cannot
	JRST	INIQRA			; go create the file name

INIQRF:	$SAVE	<T1,T2,T3>		;create default file spec

INIQRA:	MOVEI	S1,FDBARE		;point to FDB area
	MOVEI	S2,NMNTAB		;point to names for main file
	$CALL	BLDFDB			;build an FDB
TOPS10 <LOAD	S1,,T.RNM		;get random name
	MOVE	T1,[POINT 5,S1,5]	;pointer to characters of random name
	MOVEI	T2,6			;count of characters in random name
	TLZ	S2,7700			;mask out length
	TLO	S2,0600			;and put in 6 bit bytes
INIQR0:					;loop to replace P00L00 with random name
	ILDB	T3,T1			;get next random character
	CAILE	T3,^D9			;map 5 bit bytes into digits and letters
	ADDI	T3,'A'-^D10-'0'		;offset to sixbit A
	ADDI	T3,'0'			;offset to sixbit 0
	IDPB	T3,S2			;store at pointer
	SOJG	T2,INIQR0		;keep looping till all done
					;file name part is replaced
>;end TOPS10
TOPS20 <PUSH	P,S2			;save byte pointer to end of FDB
	LOAD	S2,,T.RNM		;get UDT random name
	HRROI	S1,INIQDT		;point to work area for date/time
	MOVX	T1,OT%NSC!OT%NCO	;no seconds and no colons in time
	ODTIM				;convert to string
	MOVE	S1,[POINT 7,INIQDT]	;point to converted string
	POP	P,S2			;get pointer after FDB
	SETZ	T2,			;zero character count register
INIQR0:					;loop to pretty up date/time
	ILDB	T1,S1			;get next character
	JUMPE	T1,INIQS1		;if null, go calculate new length for
					; FDB
	CAIN	T1,"-"			;is it a dash?
	JRST	INIQR0			;yes, just get next character
	CAIN	T1," "			;is it a blank?
	MOVEI	T1,"-"			;yes, convert to dash
	IDPB	T1,S2			;no, store it at end of file spec
	AOJA	T2,INIQR0		;increment character count and continue
					; looping
INIQS1:					;here to calculate new FDB length
	IDPB	T1,S2			;[4(255)]  Append NUL to new filename.
	MOVEI	S2,1(S2)		;point to next word
	SUBI	S2,FDBARE		;subtract from start to get length
	HRLM	S2,FDBARE		; and store as length
>;end TOPS20
	MOVEI	S2,.QCFIL		;get entry code
	HRRM	S2,FDBARE		;store in FDB
	MOVEI	S1,FDBARE		;point to FDB
	$CALL	INSENT			;insert it as an entry
	JUMPF	.POPJ			;propagate error if we cannot
					;retrun address of eventual FDB for messages
	$RET				;pass on either failure or success
TOPS20 <
INIQDT:	BLOCK	4			;work area for appending date to spec
>;end TOPS20
SUBTTL Subroutines -- .   INSENT, Insert entry

; Routine - INSENT
;
; Function - Inserts entry into queue create message, deleting a previous
;	one if there (unless NODEL set in S).
;
; Parameters - S1/ address of queue create message entry
;
; Returns - False if no room in page, S1/0
;	    true otherwise, S1/ Address of inserted entry
;
; Note - Destroy S2
;	 Changes task's queue create message page


INSENT::				;insert entry into queue create message
	$SAVE	<P1,P2,P3,P4,S>		;save registers
	LOAD	S2,0(S1),RHMASK		;get type code of new entry
	MOVEI	P1,CQBEG(J)		;get address of first entry
	MOVE	P2,CQARGN(J)		; and number of entries
	JUMPE	P2,INSADD		;if there are none, just add this one
	SETZ	P4,			;zero eventual pointer to matching entry
INSEN0:					;loop looking for a matching entry
	LOAD	P3,0(P1),RHMASK		;get type of current entry
	CAMN	P3,S2			;is it the same as the one we are looking for?
	MOVE	P4,P1			;yes, save its address
	LOAD	P3,0(P1),LHMASK		;get length of this entry
	ADD	P1,P3			;point to next entry
	SOJG	P2,INSEN0		;loop through all entries
	JUMPE	P4,INSADD		;if no match, add to end
	TXNE	S,NODEL			;is no-delete bit set?
	JRST	INSADD			;yes, go add to end
	MOVE	S2,0(P4)		;get length,,type of old entry
	CAME	S2,0(S1)		;compare with new entry
	JRST	INSDEL			;if not same length, must go delete it
	HLRZ	S2,S2			;get length by itself
	ADDI	S2,-1(P4)		;get address of last word in RH of S2
	HRL	P4,S1			;make BLT pointer (source,,dest)
	HRRZ	S1,P4			;save destination for return to caller
	BLT	P4,0(S2)		;copy into existing slot
	$RETT
INSDEL:					;here to delete an existing entry
	HLRZS	P3,S2			;get length of old entry and save a copy
	ADD	S2,P4			;point to next entry
	HRL	P4,S2			;make BLT pointer next,,this
	MOVE	S2,P1			;get pointer to end of block
	SUBI	S2,1(P3)		;make into last word to be transferred
	BLT	P4,0(S2)		;move other entries down
	MOVEI	P1,1(S2)		;point to next slot free
	SETZM	(P1)			; make sure the end is zero
	SOS	CQARGN(J)		;decrement argument count because we just
					; deleted it
INSADD:					;here to add this entry to the end of the list
	MOVE	P3,P1			;copy end of block address
	LOAD	P2,0(S1),LHMASK		;get length
	JUMPE	P2,.RETT		;if zero length, just exit
	ADD	P1,P2			;new end point
	CAIL	P1,777(J)		;off the end of the page?
	JRST	[SETZ	S1,		;yes, return error
		 $RETF]
	AOS	CQARGN(J)		;no, we now have one more argument
	HRL	P3,S1			;make BLT pointer
	HRRZ	S1,P3			;save destination for return to caller
	BLT	P3,-1(P1)		;copy new entry
	SETZM	(P1)			; make sure end is zero
	$RETT				;give success return
SUBTTL Subroutines -- .   FNDENT, Find entry

; Routine - FNDENT
;
; Function - Scans queue create message page for a particular entry type.
;
; Parameters - T2/ Entry code for which to search.
;
; Returns - True if found, false if not.
;	    S1/ Address of block containing entry
;


FNDENT::$SAVE	<S2,T1>			;subroutine to find queue create entry
	MOVEI	S1,CQBEG(J)		;point to first entry address
FNDEN0:					;loop to look at an entry
	HLRZ	S2,0(S1)		;get length of this entry
	JUMPE	S2,.RETF		;if zero, we didn't find it
	HRRZ	T1,0(S1)		;get type code of entry
	CAMN	T1,T2			;is it the one we want
	$RETT				;yes, return with address in S1
	ADD	S1,S2			;no, point to next entry
	JRST	FNDEN0			;and try again
; Routine - LGFD.0
;
; Function - To create a sixbit job name from the internal date/time.
;
; Parameters - S1/ Time to be converted
;
; Returns - Always S1/ Sixbit name
;
; Note - destroys S2, T1

LGFD.0:	$SAVE	<P1>
	MOVE	T1,[POINT 6,S1]		; Get the output byte pointer
	MOVEI	P1,6			; Only 6 characters !!!

LGFD.1:	IDIVI	S1,^D36			; Get radix 36
	PUSH	P,S2			; Save the remainder
	SOSE	P1			; Count down the characters
	 $CALL	LGFD.1			;  More .. go back.
	POP	P,S2			; Get an answer.
	ADDI	S2,'0'			; Make it sixbit
	CAILE	S2,'9'			; Is it a number ???
	 ADDI	S2,'A'-'9'-1		;  No .. make it a letter
	IDPB	S2,T1			; Save the byte
	$RET				; then process the next one
SUBTTL Subroutines -- Task control subroutines
SUBTTL Subroutines -- .  MAKLB, create line block

; Routine - MAKLB
;
; Function - Tries to find a line block for port,,line (if one already there)
;	then creates an entry in the lin block list, initialises it and loads
;	LB with the address.
;
; Parameters - S1/ Port,,line
;
; Returns - False if entry already exists or L%CENT fails to create one
;	    LB/ Address of line block
;
; Note - All registers preserved (except LB)
;	 Changes line block and port block lists and their "current" entries.

MAKLB:					;subroutine to create a line block
	$CALL	FNDLB			;see if one already exists
	JUMPT	.RETF			;return false if it does
	$SAVE	<T1,S1,S2,P1>		;save some registers
	MOVE	T1,S1			;copy port,,line
	$CALL	FNDPOR			;find the port block (address in P1)
	JUMPT	MAKLB0			;continue if successful
	SKIPN	S1,PTLNAM		;get port name
	$CALL	L%CLST			;if none, create it
	MOVEM	S1,PTLNAM		;save port name
	MOVX	S2,P$SIZ		;get size of an entry
	$CALL	L%CENT			;create a new entry
	JUMPF	.POPJ			;exit if we cannot
	MOVE	P1,S2			;get entry address into proper register
	LOAD	S1,T1,LHMASK		;get the port number passed as argument
	STORE	S1,,P.PRT		;save it
MAKLB0:					;here when we have a port block in P1
	MOVE	S1,LBNAM		;get name of line block list
	$CALL	L%LAST			;position to end of list
	MOVE	S1,LBNAM		;get name again
	MOVX	S2,L$SIZ		;get size of entry
	$CALL	L%CENT			;create entry
	JUMPF	.POPJ			;if it failed, propagate false return
	MOVE	LB,S2			;get address of new line block
	STORE	T1,,L.LNI		;save port,,line
	STORE	T3,,L.SIG		;save line signature
	$CALL	L%CLST			;get a list handle
	JUMPF	MAKLB4			;if we cannot, better undo this
	STORE	S1,,L.CNO		;save as console output queue
	$CALL	L%CLST			;get another list handle
	JUMPF	MAKLB4			;if cannot, abort this
	STORE	S1,,L.CNI		;save as console input queue

	LOAD	S1,,P.LLB		;get last LB in chain
	JUMPN	S1,MAKLB2		;if there is one, go handle that
	STORE	LB,,P.LLB		;if none, its easy; store us as last
	STORE	LB,,P.FLB		;and first
	JRST	MAKLB3			;and we are done (our link word is already 0)
MAKLB2:					;here to add us when chain already exits
	STORE	LB,,P.LLB		;we are new last entry
Q==L.PFW				;mask ??
	STORE	LB,L$PFW(S1),Q		;store us in previous last's forward pointer
	STORE	S1,,L.PBK		;and point our backward pointer to previous last
MAKLB3:					;here when done attaching LB to port blck chain
	$CALL	I%NOW			;get current time
	ADDI	S1,POLINT		;add polling interval
	CAMG	S1,POLTIM		; Check for a previously given poll time
	 MOVEM	S1,POLTIM		;save for later
	$RETT				; and return true
MAKLB4:					;here to delete LB entry and return false
	SETZ	LB,0			; [363] Line block is not valid
	MOVE	S1,LBNAM		;point to LB list
	$CALL	L%DENT			;delete current entry (we just created it)
	$RETF				;tell caller of error
SUBTTL Subroutines -- .  BLDTSK, create task

; Routine - BLDTSK
;
; Function - Acquires a TKB (task block), links it into LB chain (chain of
;	tasks for a particular port/line), initializes task registers
;	and if request if for a device serving task it opens the device.
;
; Parameters - LB/ Address of line block
;	       S1/ Type code for task
;	       S2/ Unit number for device (if applicable)
;
; Returns - If true: TK/ Address of task block
;
; Note - Destroys S1 and S2
;	 Changes LB chain
;	 Makes the new TKB current entry of list
;	 Sets HASP bit in TKB if same bit turned on in LB

COMMENT	&

  This subroutine saves some registers; creates an entry in the
task list (a TKB) after the "current" one  (returning false if it can't); points TK to it;
initializes the task's stack and ACs; stores line and unit
information in TKB; opens the device (if it is a device task)
and saves the handle in task's P1 and finally
adds TKB to the LB chain.

	&
BLDTSK:					;subroutine to build a task
	$CALL	.SAVET			;save the T's
	DMOVE	T1,S1			;copy the parameters to them

IFN FTDEBUG,<
	CAIL	S1,.TCTL		;make sure task/device type is
	CAILE	S1,.TSND		; within range
TOPS20	<$STOP	IDC,<Illegal task/device type code>>
TOPS10	<STOPCD	(IDC,HALT,,<Illegal task/device type code>)>
    >;end IFN FTDEBUG
	LOAD	S1,TSKNAM		;get handle for task list
	MOVEI	S2,T$SIZ		;and get size of TKB
	$CALL	L%CENT			;create an entry
	JUMPF	.POPJ			;if we cannot, return the failure to our caller
	MOVE	TK,S2			;let everyone know we have a new TKB!
	MOVEI	S1,-1+T%PDL		;get address of stack-1
	HRLI	S1,-TKPDLN		;put -length into LH
	HRRZ	T3,TSKTAB(T1)		;get 0,,entry address of task if 2780/3780
	LOAD	T4,,L.STS		;Get line status flags
	TXNE	T4,L.HSP		;see if we are really HASP mode
	HLRZ	T3,TSKTAB(T1)		;yes, use HASP entry instead
	PUSH	S1,T3			;and store it on top of stack
	HRL	T2,T1			;get device/task type,,unit
	MOVEM	S1,P+T%ACS		;save stack pointer in task's ACs
	MOVEM	TK,TK+T%ACS		;as well as TK register
	SETZ	S1,			;zero task status bits
	TXNE	T4,L.HSP			;see if hasp
	TXO	S1,HASP			;yes, set the bit
	MOVEM	S1,S+T%ACS		;store it
IFN FTDEBUG,<
	LOAD	S1,LBNAM		;get name of line block list
	$CALL	L%RENT			;remember our current entry
	$CALL	LBVER			;verify that LB contains a valid line block address
	JUMPF	[MOVE S1,LBNAM		;and if not, clean up and return false:
					; get handle for line block list
		$CALL L%PREM		;position to remember entry
		JRST BLDER0]		;go release task block and exit false
	MOVE	T3,TK			;save TKB address
	LOAD	S1,TSKNAM		;get list handle
	$CALL	L%RENT			;remember current entry
	LOAD	S1,,L.LNI		;get line information
	LOAD	S2,T2			;and device information
	$CALL	FNDTSK			;see if task already exists
	JUMPT	[LOAD S1,TSKNAM		;get handle for list again
		$CALL L%PREM		;go back to remembered entry
		JRST BLDER1]		;go to clean up and return false
	MOVE	TK,T3			;get back our TKB
    >;end IFN FTDEBUG

	LOAD	S1,,L.LNI		;get port,,line
	STORE	T2,,T.DEV		;and also save type,,unit
	STORE	LB,LB+T%ACS		;save line block address for task
	HLRZ	T1,T2			;get 0,,type
	MOVSI	S1,6			;preload device code
	TXNN	T4,L.HSP		;see if HASP
	JRST	BLDTS5			;if not, go on with normal functions
	JUMPE	T1,BLDTS0		;if HASP and control, open signon device
	CAIN	T1,.TCDR		;if HASP and CDR
	JRST	BLDTS6			;don't do open now
BLDTS5:	CAIL	T1,.TLPT		;if less than first device
	CAILE	T1,.TCNO		;or greater than last device
	JRST	BLDTS1			;skip trying to acquire device
	LOAD	S1,,T.DEV		;get type,,unit
BLDTS0:					;entry for HASP control task
	LOAD	S2,,L.LNI		;and port,,line
	$CALL	DEVOPN			;open the device
	JUMPF	BLDER2			;if not successful, return error
	STORE	S1,P1+T%ACS		;save in task AC dedicated to it
	STORE	S1,T%DHA		;save device handle in task block also
BLDTS6:	MOVEI	S1,[ASCIZ /Initializing/];get initial device state
	STORE	S1,,T.DST		;and save it for checkpointers
	JUMPE	T1,BLDTS1		;if control task type, don't get record buffer
	$CALL	BUFSZ			;get size of record buffer into S1
	$CALL	M%GMEM			;get memory for record buffer
	JUMPF	BLDER3			;if none, abort
	IMULI	S1,5			;convert words to bytes
	STORE	S1,,T.RBS		;save buffer size
	STORE	S2,,T.RIA		;save its address
	LOAD	S1,BITTAB-.TLPT(T1)	;get starting bit for this device type
	LOAD	S2,,T.UNI		;get unit number (i.e. bits to shift)
	LSH	S1,0(S2)		;shift it
	STORE	S1,,T.BIT		;and save bit for later in TKB
	LOAD	S1,QOBTAB-.TLPT(T1)	;get object type for queue create
	STORE	S1,,T.QOB		;store it for INIQRQ
BLDTS1:					;here to link this task in the LB's chain
	LOAD	S1,,L.LTK		;get last TKB in chain
	JUMPN	S1,BLDTS2		;if there is one, go handle that
	STORE	TK,,L.LTK		;if none, its easy; store us as last
	STORE	TK,,L.FTK		;and first
	JRST	BLDTS3			;and we are done (our link word is already 0)
BLDTS2:					;here to add us when chain already exits
	STORE	TK,,L.LTK		;we are new last entry
Q==T.PFW				;mask ??
	STORE	TK,T$PFW(S1),Q		;store us in previous last's forward pointer
	STORE	S1,,T.PBK		;and point our backward pointer to previous last
BLDTS3:					;here when done attaching TKB to LB chain
	$RETT				;take success return

IFN FTDEBUG,<
BLDER0:	$WTOJ	<Internal error>,<LB doesn't point to valid line block>,OBJBLK
	JRST	BLDERR

BLDER1:	$WTOJ	<Internal error>,<Task we are trying to create already exists>,OBJBLK
	JRST	BLDERR
    >;end IFN FTDEBUG

BLDER2:	$WTOJ	<D60JSY error>,<^I/D60ERM/ opening device ^D/T1/>,OBJBLK
	JRST	BLDERR

BLDER3:	$WTOJ	<Internal error>,<No memory for record buffer for device ^D/T1/>,OBJBLK
	JRST	BLDERR

BLDERR:					;here if error building task after TKB acquired
	LOAD	S1,TSKNAM		;point to task list
	$CALL	L%DENT			;delete the entry we created
	SETZ	TK,			;and wipe out pointer to him
	$RETF				;take error return

TSKTAB:					;table of entry points for task types
					;LH=HASP entry, RH=2780/3780 entry
	XWD	TKCTL,TKCTL		;control type
	XWD	TKHLPT,TKLPT		;line printer
	XWD	TKHCDP,TKERR		;card punch (HASP only)
	XWD	TKHCDR,TKCDR		;card reader
	XWD	TKHCNI,TKERR		;console input task (HASP only)
	XWD	TKHCNO,TKERR		;console output task (HASP only)
	XWD	TKSND,TKSND		;console message distributor task

TKERR:					;dummy entry for illegal tasks
TOPS20	<$STOP	IT2,<Illegal task type for 2780/3780>>
TOPS10	<STOPCD	(IT2,HALT,,<Illegal task type for 2780/3780>)>

BITTAB:					;table of starting active bits in port
					; status word
	EXP	LP0BIT			;first bit for LPTs
	EXP	CP0BIT			;first bit for CDPs
	EXP	CR0BIT			;first bit for CDRs
	EXP	CNIBIT			;only bit for console input
	EXP	CNOBIT			;only bit for console output

QOBTAB:					;table of queue request object types
	EXP	.OTLPT			;lpt
	EXP	.OTCDP			;card punch
	EXP	0			;not used for card reader
	EXP	0			;not used for console input
	EXP	0			;not used for console output
SUBTTL Subroutines -- .  RELTKB, release task block

; Routine - RELTKB
;
; Function - Releases all storage associated with a task block, then deletes
;	the task list entry for the block.
;
; Parameters - TK/ Task block address to be released
;
; Returns - True always
;
; Note - Destroys S1 and S2
;	 Stopcodes if any of the called routines fail


RELTKB:					;subroutine to release a task block
	$SAVE	<T1,T2>			;save some registers
	$CALL	TSKCUR			;make TK value current tast table entry
	SKIPT				;skip error message if we succeed
TOPS20	<$STOP	RTT,<Couldn't find task to be released>>
TOPS10	<STOPCD	(RTT,HALT,,<Couldn't find task to be released>)>
	LOAD	T1,,T.TYP		;get device/task type
	CAIL	T1,.TCTL		;see if really a
	CAILE	T1,.TCNO		; device
	JRST	RELTK0			;no, skip releasing it
RELTKR:	LOAD	S1,P1+T%ACS		;get handle from TKB
	JUMPE	S1,RELTK4		;if none, skip it
	D60	D60RLS,RELTKR		;release the device
;	JUMPF	RELTKE			;if we cannot, die
RELTK4:					;here to get rid of record buffer
	LOAD	S2,,T.RIA		;get record address
	JUMPE	S2,RELTK0		;if none, don't release it
	$CALL	BUFSZ			;figure out buffer size
	$CALL	M%RMEM			;release record buffer
	JUMPF	RELTKE			;if we cannot, issue stopcode
RELTK0:					;here to check for storage to release
	LOAD	S1,S+T%ACS		;get task's S
	TXNN	S1,JVALID		;is J set up to 3-page block?
	JRST	RELTK1			;no, continue
	LOAD	S2,J+T%ACS		;yes, get address of 3-page block
	ADR2PG	S2			;convert to page number
	MOVEI	S1,3			;number of pages
	$CALL	M%RLNP			;release them all
	JUMPF	RELTKE			;stopcode if we get error
	$CALL	M%CLNC			;and delete them (why not?)
	JUMPF	RELTKE			;if we cannot, something must be VERY wrong
RELTK1:					;here to check for log pages
	LOAD	T2,,T.GCT		;get count of log pages in use
	CAIG	T2,1			;is it only the first?
	JRST	RELTK3			;yes, try next test
	SOS	T2			;make into index
	MOVEI	T1,T%GBA		;get address of first entry
	ADD	T1,T2			;make address of last entry
RELTK2:					;loop to delete log pages
	LOAD	S1,0(T1)		;get current entry
	$CALL	M%RPAG			;release the page
	JUMPF	RELTKE			;if we cannot, die
	$CALL	M%CLNC			;clean up working set
	JUMPF	RELTKE			;we couldn't?? ugh
	SOS	T1			;decrement slot pointer
	SOJG	T2,RELTK2		;loop till no more
RELTK3:					;here to check for active task list entry
	LOAD	T1,,T.ATE		;get pointer to ATL entry
	JUMPE	T1,RELTK6		;if none, skip this business
	LOAD	S1,ATLNAM		;get name of list
	$CALL	L%FIRST			;get address of first entry
	JUMPF	RELTKE			;if none, we also blew it
RELTK5:					;loop looking for our entry
	CAMN	S2,T1			;compare this entry with one from TKB
	JRST	RELTK7			;if the same, delete it
	$CALL	L%NEXT			;find next one
	JUMPF	RELTKE			;blew it if none
	JRST	RELTK5			; and try again
RELTK7:					;here to delete ATL entry
	$CALL	L%DENT			;delete the entry
	JUMPF	RELTKE			;if we cannot, die
RELTK6:					;here to de-link from LB chain
	LOAD	S1,,T.PFW		;get our forward pointer
	LOAD	S2,,T.PBK		; and backward pointer
	MOVEI	T1,T$PFW(S2)		;get normal destination of forward pointer
	SKIPN	S2			;see if there really is a next TKB
	MOVEI	T1,L%FTK		;no, change destination to be list head
	STORE	S1,0(T1),LHMASK		;and store pointer to next TKB
	MOVEI	T1,T$PBK(S1)		;get normal dest (back pointer cell of next TKB)
	SKIPN	S1			;see if there is a next TKB
	MOVEI	T1,L%LTK		;no, store it in line block instead
	STORE	S2,0(T1),RHMASK		;store pointer to previous LB
	MOVE	S1,TSKNAM		;get handle for task block list
	$CALL	L%DENT			;delete this entry
	JUMPF	RELTKE			;if cannot, die
	$RETT				;and return

RELTKE:					;here on unexpected error
	MOVE	T1,1(P)			;get return PC from last call
TOPS20	<$STOP	ERT,<Unexpected error in RELTKB>>
TOPS10	<STOPCD	(ERT,HALT,,<Unexpected error in RELTKB>)>
SUBTTL Subroutines -- .  BUFSZ, calculate task's buffer size

; Routine - BUFSZ
;
; Function - Assigns large buffers (MXLPBF) to consoles and line printers,
;	small buffers (MXCDBF) to everything else
;
; Parameters - T1/ Task type code
;
; Returns - TF/ Preserved
;	    S1/ Buffer size in words

BUFSZ:					;here to calculate buffer size
	MOVEI	S1,MXCDBF		;maximum buffer size for cards
	CAIN	T1,.TCNO		;[401]console cruft ?
	JRST	BUFSZ0
	CAIE	T1,.TCNI		;is it console output or
	CAIN	T1,.TLPT		; line printer?
BUFSZ0:	MOVEI	S1,MXLPBF		;yes, use line printer size instead
	$RET
SUBTTL Subroutines -- .  RELLB, delete a line block

; Routine - RELLB
;
; Function - Deletes the line block pointed to by LB (and the port block if it
;	was the last line on the port).  Stopcodes if LB not in port chain or
;	still has TKBS attached.
;
; Parameters - LB/ Address of line block
;
; Returns - False if L%DENT fails
;
; Note - Destroys S1
;	 Changes current entry of line block list and port list

RELLB:					;subroutine to release a line block
	$SAVE	<T1,S2,P1>		;save some registers
	LOAD	S1,,L.LNI		;get port,,line
	MOVE	T1,S1			;copy port,,line
	$CALL	FNDPOR			;find the port block (address in P1)
	JUMPT	RELLB0			;continue if successful
TOPS20	<$STOP	NPB,<No port block on releasing line block>>
TOPS10	<STOPCD	(NPB,HALT,,<No port block on releasing line block>)>

RELLB0:					;here when we have a port block in P1
	LOAD	S1,,L.TKB		;get task chain
	JUMPE	S1,RELLB1		;if zero, OK
TOPS20	<$STOP	TSQ,<Tasks still queued to line block on release>>
TOPS10	<STOPCD	(TSQ,HALT,,<Tasks still queued to line block on release>)>
RELLB1:					;now un-link this LB from the port chain
	LOAD	S1,,L.PFW		;get our forward pointer
	LOAD	S2,,L.PBK		; and backward pointer
	MOVEI	T1,L$PFW(S2)		;get normal destination of forward pointer
	SKIPN	S2			;see if there really is a next LB
	MOVEI	T1,P%FLB		;no, change destination to be list head
	STORE	S1,0(T1),LHMASK		;and store pointer to next LB
	MOVEI	T1,L$PBK(S1)		;get normal dest (back pointer cell of next LB)
	SKIPN	S1			;see if there is a next LB
	MOVEI	T1,P%LLB		;no, store it in port block instead
	STORE	S2,0(T1),RHMASK		;store pointer to previous LB
	LOAD	S1,,P.CHN		;get chain word from port block
	JUMPN	S1,RELLB2		;if there are still lines, skip deleting
					; port block
	LOAD	S1,PTLNAM		;get handle for port list
	$CALL	L%DENT			;delete this entry
RELLB2:					;here after de-linking LB from port
	LOAD	S1,,L.LNI		;get port,,line
	MOVE	T1,LB			;save LB address
	$CALL	FNDLB			;make sure that it is the current entry
	SKIPF
	CAME	T1,LB			;check that he found ours
TOPS20	<$STOP	NLB,<Error finding line block>>
TOPS10	<STOPCD	(NLB,HALT,,<Error finding line block>)>
	MOVE	S1,LBNAM		;get handle for line block list
	$CALL	L%DENT			;delete this entry
	$RET				;and return
SUBTTL Subroutines -- Search subroutines
SUBTTL Subroutines -- .  FNDPOR, Find port block

; Routine - FNDPOR
;
; Function - Scans port list for an entry with specified port number.
;
; Parameters - S1/ Port,,line
;
; Returns - True: P1/ Port list entry address
;	    False: no port number match
;
; Note - All registers preserved except P1

FNDPOR:					;subroutine to find a port list entry
	$SAVE	<S1,S2,T1>		;save registers
	HLRZ	T1,S1			;get port
	LOAD	S1,PTLNAM		;get port list name
	JUMPE	S1,.RETF		;false if none
	$CALL	L%FIRST			;position to first port
FNDPO0:					;loop looking at port entries
	JUMPF	.RETF			;failure if no more entries
Q==P.PRT				;mask ??
	LOAD	S1,P$PRT(S2),Q		;get port number in this entry
	CAMN	S1,T1			;compare with argument
	JRST	[MOVE P1,S2
		$RETT]			;success
	LOAD	S1,PTLNAM		;get list handle
	$CALL	L%NEXT			;point to next entry
	JRST	FNDPO0			;and try again
SUBTTL Subroutines -- .  FNDLB, Find line block

; Routine - FNDLB
;
; Function - Scan line block list to find one with specified port/line.
;
; Parameters - S1/ Port,,line
;
; Returns - True: LB/ Line block address
;	    False:LB/0, other registers preserved .. didn't find entry
;
; Note - "Current" entry for line block list is changed.


FNDLB:	$SAVE	<S1,S2,T1>		; Save parameter regs and a work reg
	MOVE	T1,S1			; Copy port,,line
	LOAD	S1,LBNAM		; Get handle for LB list
	SETZ	LB,0			; preset false exit value
	$CALL	L%FIRST			; Position it to the first entry
	JUMPF	.POPJ			; If none, propagate false return

; Loop to compare LB's against port,,line

FNDLB1:	CAMN	T1,L$LNI(S2)		; Is this the right line block?
	 JRST	FNDLOK			;  Yes, go return it in LB
	$CALL	L%NEXT			; Advance to next LB
	JUMPF	.POPJ			; If none, propagate failure
	JRST	FNDLB1			; else continue looking

; Here when we have found the LB we want

FNDLOK:	LOAD	LB,S2			; Copy into line block register
	$RETT				; and return true
SUBTTL Subroutines -- .  FNDNOD, Find line block for a node

; Routine - FNDNOD
;
; Function - Scan line block list to find one with specified node name.
;
; Parameters - S1/ Sixbit node name
;
; Returns - True: LB/ Line block address
;	    False: all registers preserved .. didn't find entry
;
; Note - "Current" entry for line block list is changed.



FNDNOD:	$SAVE	<S1,S2,T1>		; Save parameter regs and a work reg
	MOVE	T1,S1			; Copy node name
	LOAD	S1,LBNAM		; Get handle for LB list
	$CALL	L%FIRST			; Position it to the first entry
	JUMPF	.POPJ			; If none, propagate false return

; Loop to compare LB's against given node name

FNDND1:	CAMN	T1,L$NAM(S2)		; Is this the right line block?
	 JRST	FNDND2			;  Yes, go return it in LB
	$CALL	L%NEXT			; Advance to next LB
	JUMPF	.POPJ			; If none, propagate failure
	JRST	FNDND1			; else continue looking

; Here when we have found the LB we want

FNDND2:	LOAD	LB,S2			; Copy into line block register
	$RETT				; and return true
SUBTTL Subroutines -- .  FNDTSK, Find task from port,line,dev,unit

; Routine - FNDTSK
;
; Function - Find line block for port/line and then search for task associated
;	with device/unit on the task chain given in the line block.
;
; Parameters - S1/ Port,,line
;	       S2/ Device,,unit
;
; Returns - False: if didn't find either line block or task block
;	    True: LB/ Line block address
;		  TK/ Task block address
;
; Note - Changes "current" entry for line and task lists


FNDTSK:					;subroutine to find a set up TK
	$CALL	FNDLB			;find line block
	JUMPF	.POPJ			;if none, propagate failure
	LOAD	TK,,L.FTK		;get first task in line block chain
FNDTS1:					;loop to see if this is correct task
	JUMPE	TK,.RETF		;if none, exit false
	CAMN	S2,T%DEV		;compare with type,,unit
	$RETT				;return true if the same
	LOAD	TK,,T.PFW		;get next entry in forward chain
	JRST	FNDTS1			;else go looking some more
SUBTTL Subroutines -- .  TSKCUR, Make TK value current entry

; Routine - TSKCUR
;
; Function - Scans task (TSK) list for entry whose address is in TK.
;
; Parameters - TK/ Task block (TKB) address that is to be made "current".
;
; Returns - False: no entry on task list matches address in TK
;
; Note - Destroys S1, S2
;	 Sets TSK (task list) "current" pointer to specified task.

TSKCUR:					;subroutine to make TK current task
	LOAD	S1,TSKNAM		;get list handle
	$CALL	L%FIRST			;point to first entry
TSKCU0:					;loop looking at TSK list entries
	JUMPF	.POPJ			;propagate error if none there
	CAMN	S2,TK			;compare this entry with requested
	$RETT				;return true if they are identical
	$CALL	L%NEXT			;point to next (if any)
	JRST	TSKCU0			;and try again
SUBTTL Subroutines -- .  FNDOBJ, Find task from QUASAR object block

; Routine - FNDOBJ
;
; Function - Scan TSK (task) list for one with the specified object type.
;
; Parameters - S1/ Object block address (GALAXY format)
;
; Returns - False: cannot find task with specified object type
;	    True: TK/ Task block address
;		  LB/ Line block address
;		   J/ Job page address
;
; Note - Destroys S1, S2


FNDOBJ:					;subroutine to set up TK and J from object type
	$CALL	.SAVET			;save the temporary registers
					; we will use them for the parts of the object type
	LOAD	T1,.ROBTY(S1)		;get type from object block
	LOAD	T2,.ROBAT(S1)		; and unit
	LOAD	T3,.ROBND(S1)		; and node
	LOAD	S1,TSKNAM		;get task list handle
	$CALL	L%FIRST			;position list to first entry
	JUMPF	FNDOB4			;error return if none
FNDOB1:					;loop to compare object block in TKB with desired
					; object block (T1-T3)
	CAMN	T1,T$OTY(S2)		;if type doesn't match
	CAME	T2,T$OUN(S2)		;or unit
	JRST	FNDOB2			;go on to next entry
	CAMN	T3,T$ONO(S2)		;is node the same?
	JRST	FNDOB3			;yes, go set up regs and exit
FNDOB2:					;here on mismatch to bump to next TKB
	$CALL	L%NEXT			;get next entry
	JUMPT	FNDOB1			;if there is one, do compare again
FNDOB4:	$RETF				;propagate failure to caller
FNDOB3:					;here when match found
	MOVE	TK,S2			;load pointer to task block
	MOVE	LB,LB+T%ACS		;get line block ptr
	MOVE	J,J+T%ACS		;and load address of job page
IFN FTDEBUG,<
	JUMPE	J,FNDOB4		;if there is none, stop
    >;end IFN FTDEBUG
	$RETT				;return true
SUBTTL Subroutines -- I/O subroutines
SUBTTL Subroutines -- .  LOGCHR, put character in log

; Routine - LOGCHR
;
; Function - Stores character in log buffer.  If no room, get another page
;	until limit of LGNUM is reached, then starts throwing away characters.
;
; Parameters - S1/ Character to store
;
; Returns - True always
;
; Note - May change log file pointer, count, count of log pages
;	 and addresses of log pages.

FTCLOG	<

LOGCHR:					;here to log a character
IFN FTDEBUG,<
	TXC	S,ACTIVE!JVALID		;zero active and valid
	TXCE	S,ACTIVE!JVALID		;restore and skip if both were on
TOPS20	<$STOP	LNA,<Logging illegally>>
TOPS10	<STOPCD	(LNA,HALT,,<Logging illegally>)>
    >;end IFN FTDEBUG

	CAIE	S1,.CHLFD		;is it LF?
	CAIN	S1,23			; or DC3?
	INCR	,T.GLN			;yes, count another line
LOGCH1:					;here to put char in buffer
	SOSGE	T%GIC			;any room in buffer?
	JRST	LOGCH2			;no, get a new buffer
	IDPB	S1,T%GIP		;yes, store character
	$RETT				;and exit

LOGCH2:					;here to get another buffer and retry
					; storing character
	PUSH	P,S1			;save character
	$CALL	LOGBUF			;get another buffer
	POP	P,S1			;get character back
	JUMPT	LOGCH1			;if we succeeded, go store character
	$RETT				;else throw it away
	>; end FTCLOG
SUBTTL Subroutines -- .  LOGBUF, get another log buffer

; Routine - LOGBUF
;
; Function - Gets another page and adds it to the log file buffer list.
;
; Parameters - none
;
; Returns - True if another buffer available
;
; Note - Changes buffer count, log character pointer and count.

FTCLOG	<

LOGBUF:					;get another log buffer
	$CALL	.SAVE1			;save P1
	AOS	P1,T%GCT		;increment count of buffers in use
	CAIN	P1,1			;see if first time
	JRST	LOGBU0			;yes, just initialize
	CAIL	P1,LGNUM		;if too many
	JRST	LOGBU2			;signal error
	PUSHJ	P,M%GPAG		;get a page of memory
	JUMPF	LOGBU2			;if cannot, set erroor
	ADDI	P1,-1(TK)		;calculate address
	MOVEM	S1,T$GBA(P1)		;and store in appropriate slot
	CAIA				;skip next instruction
LOGBU0:	LOAD	S1,T$GBA(TK)		;load with address of first buffer
LOGBU1:					;here to initialize pointer and count and return
	HRLI	S1,(POINT 7,0)		;make a byte pointer
	MOVEM	S1,T%GIP		;save it
	MOVEI	S1,<5*1000-1>		;get count
	MOVEM	S1,T%GIC		;store it too
	$RETT
LOGBU2:					;here if we cannot do it
	SOS T%GCT			;decrement count again
	SETZM T%GIC			;and zero count
	$RETF				;before returning false
	>; end FTCLOG
SUBTTL Subroutines -- .  COPY, copy a file

; Routine - COPY
;
; Function - Copies a file from a source (routine to do fetches must be pointed
;	to by T.GTR in task block) to a destination (in T.PTR) until EOF or
;	an error occurs.
;
; Parameters - TK, LB and J must be set up, P1 contains device handle
;
; Returns - True: file copied successfully
;	    False: otherwise
;
; Note - Error code returned by store (put) routine in T.PTE
;	 Error cdoe returned by fetch (get) routine in T.GTE


COPY:	ZERO	,T.TFS			; init io xfer parameters
	ZERO	,T.TFD
	TXO	S,IOBEG			; no io done yet

COPY0:	PUSHJ	P,@T%GTR		; Fill up buffer, returns T1=address,
					; T2=length, and on false S1=0 for EOF
	TXNE	S,CHECK			; If bit is on, call checking routine
	PUSHJ	P,@T%CKR		; Which changes only T2 (length) if it
					; wants to delete record
	JUMPT	COPY1			; If successful get, go empty buffer
	TXO	S,INPEOF+OUTEOF		; Set EOF flag bits
	JUMPE	S1,COPY2		; If EOF, go write out last
	TXO	S,ABORT			; fatal - abort all
	STORE	S1,,T.GTE		; Save it
	TXNE	S,IOABT			;[4(264)] If input abort
	JRST	COPY2			;[4(264)] then treat as EOF
	SETZB	T1,T2			; and no records
	PUSHJ	P,@T%PTR		; Go close output file
	JUMPF	COPY3			; Store error if we cannot
	LOAD	S1,,T.GTE		; get error code
	JRST	COPYXF			; else just return false

; Here on successful record read (get)

COPY1:	SKIPE	T2			; If no data, don't count record
	AOS	T%ICT			; One more input record
	PUSHJ	P,@T%PTR		; Write out buffer
	JUMPF	COPY4			; If not successful, go save error code
	AOS	T%OCT			; Count one more output record
	TXNE	S,DOCHKP		; Does caller want output checkpoint?
	AOSGE	S1,T%OCK		; and if so, has count expired?
	JRST	COPY0			;  No, just copy another record
	PUSHJ	P,@T%CKP		; Yes, call checkpoint routine
	JRST	COPY0			; and continue with loop

COPY3:	STORE	S1,,T.PTE		; Save error

COPYXF:	$CALL	XFRDUN			; set end time for copy
	$RETF				; Return failure

COPY2:	PUSHJ	P,@T%PTR		; Output buffer, write EOF
	JUMPF	COPY3			; If an error, save it
	TXNE	S,IOABT			;[4(264)] If input abort occurred
	JRST	COPYXF			;[4(264)] then return false.
	$CALL	XFRDUN			; set end time for copy
	$RETT				; ok return

COPY4:	STORE	S1,,T.PTE		; save the error code
	TXO	S,ABORT			; fatal - abort all
	$CALL	@T%GTR			; let input device know about abort so
	JRST	COPYXF			; it can clean up.

XFRBEG:	PUSH	P,TF			; set the start time
	PUSH	P,S1
	$CALL	I%NOW			; get the current time
	STORE	S1,,T.TFS		; time file started
	JRST	XFRDNX

XFRDUN:	PUSH	P,TF			; set end of copy time
	PUSH	P,S1
	$CALL	I%NOW
	STORE	S1,,T.TFD		; time file done

XFRDNX:	POP P,S1
	POP P,TF
	$RET
SUBTTL Subroutines -- .  GETDSK, read a record from disk

; Routine - GETDSK
;
; Function - Reads disk blocks in to a record buffer.
;
; Parameters - TK/ Task block address
;		P3/ptr to file FD
;
; Returns - True: T1/ Address of start of record
;		  T2/ Number of bytes in record
;	    False: S1/ 0 for EOF, nonzero for error
;
; Note - Changes T.RIP, T.RIC (keeping track of record) and
;	 T.DIP, T.DIC (keeping track of disk buffer).

GETDSK:	LOAD	T1,,T.RIA		; Get address of record
	LOAD	T2,,T.RIC		;  and current count now in
					;  case we get EOF

GETDS0:	TXNE	S,ABORT			; Check for aborted task
	 JRST	GETDE1			;  Yes .. pretend EOF occured
	MOVE	S1,P4			; Get disk I/O handle
	$CALL	F%IBYT			; Get next byte from file
	 JUMPF	GETDER			;  If error .. go process it
	AOS	T2,T%RIC		; Increment real count and user copy
	CAIN	S2,23			; DC3?
	JRST	GETRT3			; go check mapping and terminate record
	IDPB	S2,T%RIP		; Store it in record
	CAIN	S2,12			; Was it LF?
	 JRST	GETDRT			;  Yes, return to caller
	LOAD	S1,,T.RBS		; check buffer limit
	SOS	S1			; leave room for null
	CAML	T2,S1
	JRST	GETDRT			; full
	JRST	GETDS0			; No, continue looping

GETDER:	CAIE	S1,EREOF$		; Was it EOF?
	 JRST	GETDE0			;  No, report error
GETDE1:	MOVE	S1,P4			; Get handle again to close the file
	$CALL	F%REL			; Release file
	TXZ	S,DSKOPN!NOCTLS		; We no longer have input file open and
					; We no longer want to convert CTL-S
	TXO	S,INPEOF+OUTEOF		; Mark EOF was seen and should be sent
	SETZ	S1,			; Return code
	$RETF				; Return false

GETDE0:					; Here if error other than EOF

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/^I/DGLXER/ reading file ^F/0(P3)/>)>
	$RETF				; and give false return

GETRT3:	TXNE	S,NOCTLS		; DC3 - check for mapping
	MOVEI	S2,12			; make it a line feed
	IDPB	S2,T%RIP		; Store it in record

;[352] Deleted 3 lines, NDLESS flag unused. SPR 20-19594.   GKN

GETDRT:	SETZ	S2,			; Get a null byte to store
	IDPB	S2,T%RIP		; at end of record to make ASCIZ
	SETZM	T%RIC			; For next time, byte count is 0
	LOAD	S1,,T.RIA		; Get address of record buffer
	HRLI	S1,440700		; Make into ILDB-type byte pointer
	STORE	S1,,T.RIP		; Save it for next time
	$RETT				; True return
SUBTTL Subroutines -- .  GETIBM, read a record from DN60

; Routine - GETIBM
;
; Function - Reads IBM data from the emulation node into a record buffer.
;
; Parameters -	TK/ Task block address
;		P1/device handle
;
; Returns - True: T1/ Address of start of record
;		  T2/ Number of bytes in record
;	    False: S1/ 0 for EOF or nonzero for error
;
; Note - Changes T.RIP, T.RIC (keeping track of record) and
;	 T.DIP, T.DIC (keeping track of IBM buffer)

GETIBM:	TXZ	S,TCR			;Clear CR seen flag
;**;[406]At GETIBM:+1L add two lines	JYCW 1/25/89
	MOVEI	S1,ZBITRY		;[406]Initialize the retry counter
	MOVEM	S1,ZBICNT		;[406]Save it for 0 bits read.
	LOAD	T1,,T.RIA		;get address of record
	LOAD	T2,,T.RIC		; and current count now in
					; case we get EOF
GETIB0:	TXNE	S,ABORT			; check for abort while we wern't looking
	JRST	GETIB2
					;character loop
	SOSGE	T%DIC			;a character left from last IBM buffer?
	JRST	GETIBF			;no, go get more
	ILDB	S2,T%DIP		;yes, get it
	AOS	T2,T%RIC		; Increment real count and user copy
	CAIN	S2,23			; DC3?
	JRST	GETIR3			; go check mapping and terminate record
	IDPB	S2,T%RIP		; Store it in record
	TXNE	S,TCR			;Check if last character was CR
	JRST	GETIRT			; Yes .. end rec'd on current character
	CAIN	S2,15			;Check if this character is CR
	JRST	[TXO S,TCR		; Yes .. set CR seen flag
		 JRST GETIB0]		; Go get next character in stream
	CAIE	S2,12			; LF ?
	CAIN	S2,14			;is it FF?
	JRST	GETIRT			;yes, return to caller
	CAML	T2,T%RBS		;reached end of record buffer?
	JRST	GETIRT			;this means a missing crlf
	JRST	GETIB0			;no, continue looping

GETIBF:					;here to read another buffer of IBM data
	TXNE	S,IOABT!FLSH!ABORT	;have we gotten all we are going to get or want?
	JRST	GETIB2			;yes, return data plus EOF indicators
GETIBR:	MOVE	S1,P1			;get IBM I/O handle
	LOAD	S2,,T.XBA		;get initial transmission buffer byte pointer
	STORE	S2,,T.DIP		;save for us to use later
	MOVNI	T1,1000*5		;number of bytes to read
	D60	D60SIN,GETIB1,0		;do input
	JUMPF	GETIER			;if false return, go analyze error
GETIB1:					;here to see if we have data to use
	MOVEI	S1,1000*5		;maximum number of bytes we could have gotten
	ADD	S1,T1			;subtract ones we didn't get
	LOAD	T1,,T.RIA		;restore record address
	MOVEM	S1,T%DIC		;store byte count transferred
	JUMPE	S1,GETIBB
	TXZE	S,IOBEG
	$CALL	XFRBEG			; set copy start time
GETIBB:	TXNE	S,IOABT!FLSH		;check for input abort
	JRST	GETIB0			;nothing more coming - process what we have
	JUMPE	S1,GETINO		;if nothing, try waiting awhile
	$CALL	CHKSNZ			;attempt fairness
	JRST	GETIB0			;try putting a char in the record again

GETIER:					;here on error or EOF
	CAIE	S1,D6EOF		;was it EOF?
	JRST	GETIE0			;no, go report it
	SKIPA				;[261] Yes.
GETIE1:	TXO	S,IOABT			;[261] mark that soft abort was seen
	TXO	S,FLSH			;mark that EOF was seen
	JRST	GETIB1			;and continue merrily passing records
GETIE0:					;here on error other than EOF

FTCLOG<	TXNN	S,ACTIVE		;see if we can log things
	JRST	GETIEX			;no, just store code
	JUMPE	P3,GETIE2		;[4(264)] don't do message if no file
	$TEXT	(LOGCHR,<^I/IBMSG/^I/D60ERM/ reading into file ^F/0(P3)/>)
	JRST	GETIEX

GETIE2:

	$TEXT	(LOGCHR,<^I/IBMSG/^I/D60ERM/>)
	>

GETIEX:	CAIE	S1,D6IAB		;[372] did input abort occur ?
	CAIN	S1,D6LGA		;[372] or line went down?
	JRST	GETIE1			;[261] yes, treat as EOF
	SETZB	T1,T2			;zero return registers
	$RETF				;give error return
GETIB2:					;here to return EOF to caller
	$CALL	GETIR5			;set up byte pointers
	TXO	S,INPEOF!OUTEOF		;set visible bits
	TXZ	S,FLSH!NOCTLS		;and clear our bit and control-s convert
	TXNN	S,IOABT			;[4(264)] If input abort, leave error
					;[4(264)] code intact
	TDZA	S1,S1			;return code
	MOVEI	S1,D6IAB		;restore original error code
	$RETF				;return false

GETIR3:	TXNE	S,NOCTLS		; DC3 - check for mapping
	MOVEI	S2,12			; make it a line feed
	IDPB	S2,T%RIP		; Store it in record

;[352] Deleted 3 lines, NDLESS flag not used. SPR 20-19594.   GKN

GETIRT:	SKIPLE	T%DIC			; check if buffer is empty
	JRST	GETIR5			; no - don't check error conditions
	TXNE	S,IOABT!FLSH		;check for aborting
	JRST	GETIB2			;go there to die

GETIR5:	SETZ	S1,			;get null byte
	IDPB	S1,T%RIP		;store at end of record for ASCIZ
	SETZM	T%RIC			;for next time, byte count is 0
	LOAD	S1,,T.RIA		;get address of record buffer
	HLL	S1,T%XBA		;make into ILDB-type byte pointer
	STORE	S1,,T.RIP		;save it for next time
	$RETT				;true return

GETINO:					;here when SIN resulted in no data
	TXNE	S,PEOF!FLSH		;if we have to dummy up EOF on no more data
	JRST	GETIB2			; go do it
	SKIPN	POLEST			; if poll time is zero
	JRST	GETINX			;[400] Retry input
	VDSCHD	TW.IOD,POLEST		;wait a little - but don't be complacent

GETINX: SOSG	ZBICNT			;[400]Reached the retry limit yet?
	TXO	S,IOABT			;[400]Yes, consider it a problem.
	JRST	GETIBF			;[400]Try to get one more buffer.
SUBTTL SUBROUTINES -- .  PUTDSK, write a record to disk

; ROUTINE - PUTDSK
;
; function - copies data in record to disk, if outeof set an eof is sent.
;	     if t%tbc = 0,1 it is set to zero to flag a null file. this
;	     accounts for file sent by ibm consisting only of a form feed
;	     as an existence query.
;	     opens hold file if previously unopened.
;
; parameters -	T1/ address of record
;	 	T2/ byte count
;		P4/ifn for open file
;
; returns - true, unless an output error occurs
;
; note - destroys s1, s2

PUTDSK:					;subroutine to write a record to disk
	$SAVE	<T1,T2>
	JUMPLE	T2,PUTDET		;if no bytes, go check for eof
	ADDM	T2,T%TBC		;[4(263)] update transferred byte count
	TXNE	S,OUTEOF!ABORT		;check for terminal conditions
	JUMPE	P4,PUTD2		;null file
PUTD0:	SKIPE	S1,P4			;not terminal - get the ifn
	JRST	PUTD1			;file is open
	MOVEI	S1,[ASCIZ /opening input hold file/] ;need to open the hold file
	STORE	S1,,T.DST		; save status for display messages
	$CALL	OPNHLD			; open holding file, dispose of old one
	JUMPF	.POPJ			; could't open hold file - can't continue
					; P3 ->hold file fd
					; P4/ifn for pnnlnn form of hold file
	MOVEI	S1,[ASCIZ /receiving job/]
	STORE	S1,,T.DST		; save status for display messages
	$WTOJ	<receiving input>,<starting input to file ^F/0(P3)/>,@T%OBA
FTCLOG<	$TEXT	(LOGCHR,<^I/IBLPT/reading file into ^F/0(P3)/>)>
	MOVE	S1,P4			;[4(263)] retrieve ifn

PUTD1:	MOVE	S2,T1			;get address in rh
	HRL	S2,T2			; and count in lh
	$CALL	F%OBUF			;output this buffer
	JUMPT	PUTDET
	PUSH	P,S1			; if output error
	MOVE	S1,P4			; get the ifn
	$CALL	F%REL			; close file
	POP	P,S1			; and return the error
	$RETF

PUTDET:					;here after buffer written
	TXZN	S,OUTEOF!ABORT		;see if we need to write eof
	$RET				;no - just return
	SKIPN	S1,P4			;yes - get the ifn
	$RETT				;file not open - null file
	MOVE	T2,T%TBC		;file is open - check size
	CAIG	T2,2			;if only a line feed or crlf
	JRST	PUTDT1			;flush it
	$CALL	F%REL			;close the file
	$RET				;and return

PUTDT1:	$CALL	F%DREL			;wasted effort
	SETZB	P3,P4			;pretend file was never opened
	$CALL	DELQUE			;flush the queue info file also
	$RETT

PUTD2:	CAILE	T2,2			;eof or abort and hold file not open
	JRST	PUTD0			;got something - not the null file
	TXZ	S,OUTEOF!ABORT		;flush the conditions
	$RETT
SUBTTL SUBROUTINES -- .  PUTIBM, write a record to DN60

; ROUTINE - PUTIBM
;
; function - copies data in transmission buffer (record), outputting as
;	necessary, and if outeof set, sends eof.
;
; parameters -	T1/ address of record
;		T2/ byte count
;		P1/device handle
;
; returns - true unless output error
;
; NOTE - destroys S1, S2, T1
;	 changes T.XRC and T.XRP

PUTIBM:	HLL	T1,T%XBA		;make address into byte pointer

PUTIB0:	TXNE	S,OUTEOF		;check for eof required
	JRST	PUTIBF			;yes - go clean up(note: ABORT might also be set)
	TXNE	S,ABORT			;check for sneaky abort
	JRST	PUTIAB
	JUMPLE	T2,PUTIET		;if no more bytes, check for eof
	SOSG	T%XRC			;any space in this buffer?
	JRST	[$CALL PUTIBF		; no, must output buffer first
		JUMPF .POPJ		;if it failed, give up
		JRST PUTIB0]		;and go finish record
	ILDB	S1,T1			;get byte
	IDPB	S1,T%XRP		;store it in buffer
	SOJA	T2,PUTIB0		;and go back for more

PUTIET:					;here when all proferred characters are in buffer
	TXNN	S,OUTEOF		;are we requested to close file?
	$RETT				;no, just return true

PUTIBF:					;here to write a buffer out
	$SAVE	<T1,T2,T3>		;save record pointers
	LOAD	T1,,T.XBN		;get max bytes in buffer
	SUB	T1,T%XRC		;calculate count to output
	JUMPE	T1,PUTIRT		;if znro, we don't have to
	MOVN	T1,T1			;make it negative for d60sou
	LOAD	S2,,T.XBA		;get byte pointer to data
PUTIB3:	MOVE	S1,P1			;get DN60 i/o handle
PUTIB1:					;loop to get buffer all out
	MOVN	T3,T1			;save for count update
	D60	D60SOU,PUTIB4,0		;do simulated sout
	JUMPF	PUTIER			;if we don't succeed, return error code

PUTIB4:	ADD	T3,T1			;calc amount actually xferred
	ADDM	T3,T%TBC		;update transfered byte count
	JUMPE	T3,PUTIBB
	TXZE	S,IOBEG
	$CALL	XFRBEG			; set copy start time
PUTIBB:	JUMPE	T1,PUTIRT		;if no bytes remaining, we are done
	JUMPT	PUTIB5			;keep going if successful

PUTIB2:	JUMPN	T3,PUTIB5		;don't sleep if there were any bytes
					; transferred last time
	SKIPN	POLEST			; if poll time is zero
	JRST	PUTIB5			; try again immediately
	VDSCHD	TW.IOD,POLEST		;wait a little - 2 seconds

	CAIA				;no need to be fair if we just woke up
PUTIB5:	$CALL	CHKSNZ			;attempt fairness
	TXNN	S,ABORT			;check for abort while we weren't looking
	JRST	PUTIB3			;and continue

PUTIAB:	SETZ	S1,			;abort exit
	$RETF

PUTIRT:	TXNN	S,OUTEOF		;were we supposed to close it?
	JRST	PUTIR1			;no

PUTIR0:	MOVE	S1,P1			;yes - get the device handle
	D60	D60EOF,PUTIR0		;do it
	TXZ	S,OUTEOF		;only once
	JUMPF	.POPJ			;hard error ?

PUTIR1:	LOAD	S1,,T.XBA		;get initial byte pointer
	STORE	S1,,T.XRP		;store for putting next bit into buffer
	LOAD	S1,,T.XBN		;get how much will fit
	STORE	S1,,T.XRC		;store as byte count
	$RETT				;and return true

PUTIER:					;here on error on D60SOU
	CAIN	S1,D6OAB		;output abort?
	TXO	S,IOABT			;set soft abort flag
	$RET				;propagate failure
SUBTTL Subroutines -- .  PUTCNI, send console input to IBM

; Routine - PUTCNI
;
; Function - sends all console msg queued up to IBM,then does an EOF to
;	     clear the output state.
;
; Parameters - task context, gets msgs from L.CNI queue
;		P1/device handle
;
; Returns - TRUE unless a D60JSY error occurs
;
; Note: mungs S1,S2,T1,T2


PUTCNI:	LOAD	S1,,L.CNI		; Get handle for CNI queue
	$CALL	L%FIRST			; Point to first entry
	SKIPT				; make sure there is something to do
	$RETT

; loop to process console messages to IBM

PUTCI0:	MOVE	T2,S2			; Save msg address for any error
	MOVN	T1,0(S2)		; Get length (as negative for D60SOU)
	HRROI	S2,1(S2)		; Point to start of data

PUTCI1:	MOVE	S1,P1			; Get device handle
	D60	D60SOU,PUTCIW,0		; Output data
	JUMPF	PUTCIE			; errs?
	JUMPE	T1,PUTCID		; no - check for all sent

PUTCIW:	$DSCHD	TW.IOD,3		; more - sleep and try again later
	JRST	PUTCI1

PUTCIE:					;  err'd
	TXNE	S,LGA			; Has line gone away?
	$RETF				; yes - give false return
	$WTOJ	<Console send error>,<^I/D60ERM/^M^JMessage was--^T/1(T2)/^A>,@T%OBA

PUTCID:	LOAD	S1,,L.CNI		; Get list handle
	$CALL	L%DENT			; Delete this entry
	$CALL	L%NEXT			; and on to next
	JUMPT	PUTCI0			; if any
					; done...do an EOF

PUTCI2:	MOVE	S1,P1			;get the device handle
	D60	D60EOF,PUTCI2		; signal end of this  cruft
	$RET				; return whatever
SUBTTL Subroutines -- .  PUTCNO, put a record into CNO queue

; Routine - PUTCNO
;
; Function - Copies record into entry in CNO (console output) queue for
;	SND (console sending) task.  Signals SND task that it has something
;	to process.
;
; Parameters - T1/ Address of record
;	       T2/ Length in bytes
;
; Returns - True always
;
; Note - Destroys S1, S2

PUTCNO:					;subroutine to put records into console
					; output queue
	$SAVE	<T1,T2,T3>		;preserve these registers
	JUMPLE	T2,PUTCNE		;if no data, just do EOF processing
	ADDI	T2,5			;fudge to byte count
	IDIVI	T2,5			; and calculate number of words
PUTCN1:					;here to create CNO entry
	MOVE	S2,T2			;get length
	LOAD	S1,,L.CNO		; and list handle
	$CALL	L%CENT			;create an entry
	JUMPF	PUTCND			;if we fail, go wait and try later
	HRL	S2,T1			;make BLT word
	HRRI	S1,-1(S2)		;get address before destination
	ADD	S1,T2			; and add length for end of BLT
	BLT	S2,(S1)			;send all of it

IFN FTIBMS,<
	MOVEI	S1,%ECNO		; inform QUASAR
	$CALL	IBMSTS
> ;End of FTIBMS


PUTCNE:					;here when done copying data into entry
	TXZN	S,OUTEOF		;see if we should output eof
	JRST	PUTCN2			;no, just exit
	MOVE	T3,TK			;save TK
	LOAD	S1,,L.LNI		;get port,,line
	HRLZI	S2,.TSND		;    type,,number
	$CALL	FNDTSK			;find it
	$SIGNL	TW.CNO,TASK		;wake task
	MOVE	TK,T3			;restore task pointer
PUTCN2:					;here when all done
	TXZ	S,NOCTLS		;clear ctrl-s conversion
	$RETT				;and return
PUTCND:					;here to delay and try again
	$DSCHD	0,^D10			;wait three seconds
	JRST	PUTCN1			; and try again
SUBTTL Subroutines -- .  DEVOPN, open a D60JSY device

; Routine - DEVOPN
;
; Function - Copies parameters into OPNBLK (of device), adds line signature
;	and then calls D60OPN to do the device open.
;
; Parameters - S1/ Device,,unit
;	       S2/ Port,,line
;	       LB must be setup
;
; Returns - False: S1/ error code
;	    True: Handle to use when referencing device

DEVOPN:					;do open of device
	PUSH	P,S2			; ...
	DMOVEM	S1,OPNBLK		;save  device,,unit and port,,line

DEVOPR:	MOVNI	S1,3			;get minus length
	MOVEI	S2,OPNBLK		;point to block
	D60	D60OPN,DEVOPR		;call D60JSY routine to do open
	POP	P,S2			;restore S2
	$RET				;return to caller
OPNBLK:	BLOCK	3			;open block
SUBTTL Subroutines -- .  CHKDSK, Checkpoint a disk file

; Routine - CHKDSK
;
; Function - Ensures that no data already processed can be lost in the
;	event of a crash.
;
; Parameters - P4/ IFN of file to be checkpointed
;
; Returns - True: if checkpoint succeeded
;
; Note - Destroys S1, S2

CHKDSK:					;checkpoint disk file routine
	MOVE	S1,P4			;get IFN
	$CALL	F%CHKP			;let GLXLIB do all the work
	JUMPF	CHKDER			;if it fails report error
	HRREI	S1,-CHKCNT		;get count to next checkpoint
	STORE	S1,,T.OCK		;save it
	$RET				;return to caller
CHKDER:					;here if checkpoint attempts wins
					; an error
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/^I/DGLXER/ trying to checkpoint hold file>)>
	$WTOJ	<Checkpoint error>,<^I/DGLXER/ trying to checkpoint hold file>,@T%OBA
	HRREI	S1,CHKRTV		;shorter attempt to checkpoint periods
	STORE	S1,,T.OCK		;in the checkpoint counter
	$RET
SUBTTL	Subroutines -- DN60 Control subroutines
SUBTTL Subroutines -- .  LINSTS,LINCHK, get current line status

; Routine - LINSTS
;
; Function - Checks if line is usable (DSR up and no hardware aborts) and
;	returns line status bits.
;
; Parameters - none
;
; Returns - True: unless line goes away
;		S1/ LB.STS status word
;		S2/ D60JSY style status word
;
; Note - Sets or clears L.UP bit in L.STS for current line


LINSTS:					;here to determine if line is usable
	LOAD	S1,,L.PRT		;get port into RH
	HRLI	S1,.STLIN		;get code for line status into LH
	LOAD	S2,,L.LIN		;get line number
	D60	D60STS,LINSTS,0		;get the line status
	JUMPF	.POPJ			;if error, handle it
					;S1/SLFLG, S2/SLFLG&177400+SLINF
	LOAD	S1,,L.STS		;get status bits
	TXC	S2,SLDTR!SLDSR!SLLEN	;check if DTR,DSR,line enable are set
	TXCE	S2,SLDTR!SLDSR!SLLEN	;skip if all are set
	TXZA	S1,L.UP			;clear "up" bit
	TXO	S1,L.UP			;mark line up
	TXNE	S2,SLSON		;set signon state
	TXO	S1,L.SND
LINST2:	STORE	S1,,L.STS		;store new status
	$RETT

LINCHK:	$CALL	LINSTS			; check line viability
	TXNN	S1,L.SFS		; if signoff sent
	TXNN	S1,L.UP			; or line is no longer up
	$RETF				; then line is not viable
	TXNE	S,LGA			; also if hard error has occurred
	$RETF
	$RETT				; things seem to be ok
SUBTTL Subroutines -- .  GETLNO, ensure output is possible

; Routine - GETLNO
;
; Function - Waits until output is running
;
; Parameters - none
;
; Returns - False: if cannot get output permission
;
; Note - Changes DN60 front end status bits


GETLNO:					;here to ensure output
	$SAVE	<S2,T1>			;save all our registers
	MOVEI	T1,5			;number of times to try
	JRST	GETLN1			;skip $DSCHD the first time
GETLN0:					;loop trying to get permission
	$DSCHD	0,3			;short sleep

GETLN1:	MOVE	S1,P1			;get handle
	MOVEI	S2,.MORQI		;get D60OPR function code
	D60	D60OPR,GETLN2		;do request for output
	JUMPT	.POPJ			;if successful, just return
	CAIE	S1,D6CGO		;if "can't get output" don't retry
GETLN2:	SOJG	T1,GETLN0		;else loop for count
	$RET				;fe not ready yet
SUBTTL Subroutines -- .  DISABL, routine to disable a line

; Routine - DISABL
;
; Function - Calls D60DIS to disable line and hang up phone.
;
; Parameters - LB must point to line block for line to be disabled.
;
; Returns - True always
;
; Note - Destroys S1, S2
;	 Does an implicit D60RLS of all devices open on the line.

DISABL:					;routine to hang up the line
	LOAD	S1,,L.LNI		;get port,,line
	LOAD	S2,,L.NAM		;get node name
	D60	D60DIS,DISAB0		;do condition call to disable line
	$RETT				;ignore any errors

DISAB0:	$CALL	LINSTS			;update the line status
	JUMPF	.RETT			;things are going downhill fast
	TXNN	S1,L.UP			;make sure it went down
	$RETT
	JRST	DISABL			;no - must not have gotten through to fe
SUBTTL Subroutines -- .  ABTDEV, abort IO stream on a device

; Routine - ABTDEV
;
; Function - sends appropriate stream abort to IBM
;
; Parameters - P1/device handle
;
; Returns - nothing of particular interest

ABTDEV:	TXNE	S,LGA			;if line already gone, nuthin to do
	$RETT
ABTDV1:	MOVE	S1,P1			;get the device handle
	MOVEI	S2,.MOABT		; the function to perform
	D60	D60OPR,ABTDV1
	LOAD	S1,,T.TYP		; check for hasp output device
	CAIE	S1,.TCDR		; card reader
	CAIN	S1,.TCNI		; console input(to host)
	TXNN	S,HASP			; if hasp
	$RET

ABTHSP:	MOVE	S1,P1			; get device handle
	D60	D60EOF,ABTHSP		; Do an end of file to terminate stream
	$RET
SUBTTL Subroutines -- .  SGNFIL, SGFFIL, signon/signoff file setup

; Routine - SGNFIL, SGFFIL
;
; Function - Opens a signon/signoff file and sets it up to be copied.
;
; Parameters - none
;
; Returns - False: if file cannot be opened
;
; Note - Destroys S1, S2, T1, and T2
;	 Clears CHECK bit in S


; Here to open signon file

SGNFIL:
TOPS10 <MOVSI	S1,(SIXBIT/SON/)>	;get extension
TOPS20 <HRROI	S1,[ASCIZ/.SON/]>	;get extention
	MOVEM	S1,SGNTYP		;save for later
	JRST	SGNFI

; Here to setup SIGNOFF file

SGFFIL:
TOPS10 <MOVSI	S1,(SIXBIT/SOF/)>	;get extension
TOPS20 <HRROI	S1,[ASCIZ/.SOF/]>	;get pointer to extension
	MOVEM	S1,SGNTYP		;store type of file
	JRST	SGNFI

; Common code for signon/signoff

SGNFI:
TOPS10	<LOAD	S1,,L.NAM		;get station name
	STORE	S1,SGNNAM		;save it as filename
    >;end TOPS10
TOPS20	<SETZ	R3,			;no byte count for SOUT
	HRROI	R1,SGNFSP		;point to FDB as destination
	HRROI	R2,IBMDEV		;point to beginning of name
	SOUT				;copy to FDB
	MOVEI	R2,":"			; add the trailing  colon
	IDPB	R2,R1
	MOVE	R3,[POINT 6,L%NAM]	;point to SIXBIT station name
	MOVEI	R4,6			;maximum number of character

; Loop to copy characters of station name

SGNFI0:	ILDB	R2,R3			;get next SIXBIT character
	JUMPE	R2,SGNFI1		;if blank, exit loop
	ADDI	R2,40			;convert to ASCII
	IDPB	R2,R1			;store in FDB
	SOJG	R4,SGNFI0		;loop till count exhausted

; Here to finish off string

SGNFI1:	SETZ	R3,			;no count
	MOVE	R2,SGNTYP		;get pointer to extension
	SOUT
    >;end TOPS20

	MOVEI	S1,2			;length of open block
	MOVEI	S2,SGNFOB		;and address
	$CALL	IBMIOP			;open it
	JUMPF	.POPJ			;propagate false return if cannot
	MOVE	P4,S1			;save IFN
	MOVEI	S1,GETDSK		;"get" routine address
	STORE	S1,,T.GTR		;save for COPY subroutine
	MOVEI	S1,PUTIBM		;"put" routine address
	STORE	S1,,T.PTR		;save for COPY
	ZERO	,T.GTE			;zero get error code
	ZERO	,T.PTE			; as well as put error code
	ZERO	,T.TBC			;clear transferred byte count
	TXZ	S,CHECK!ABORT!GOODBY!INPEOF!OUTEOF!FLSH!IOABT ;init switches
	$RETT
SUBTTL Subroutines -- .  IBMLFR, scan incoming records

; Routine - IBMLFR
;
; Function - Calls pattern matcher to determine if records are console output
;	and/or contain user switches; also calls user exit routines to
;	examine the records.
;
; Parameters - T1/ Address of record
;	       T2/ Length of record in bytes
;
; Returns - Preserves TF


IBMLFR:	JUMPE	T2,.POPJ			;if 0 length, return to caller
	MOVEM	R0,.LACS		;save AC0
	MOVE	R0,[XWD R1,.LACS+1]	;make BLT pointer
	BLT	R0,.LACS+17		;save all ACs
	MOVE	P,[IOWD PATPLN,PATPDL]	;point to new (and larger stack)
	PUSH	P,[EXP .LRST]		; and address of restore routine
	MOVE	P4,T1			;copy start of record
	SETZB	T1,T3			;indicate 0th byte and no minimum
	PUSH	P,T2			;save original length
	SUBI	T2,2			;subtract CRLF ?? to get real length
	JUMPLE	T2,IBMLFE		;if null record, just pass to user
	TXZN	S,CHKLOG		;are we checking for a log file?
	JRST	IBMLF0			;no, just continue
	$CALL	PATLOG			;see if match on console output pattern
	JUMPF	IBMLF0			;no - will never check further
	TXO	S,CONPAT		;yes - claim it is

IBMLF0:	MOVEM	S,.LACS+S		;put flags in commonly accessible place

; Here to check for user switches

	TXNN	S,CHKSWT		;checking for switches?
	 JRST	IBMLFE			;no, exit, passing record to user exit
	$CALL	PATSWT			;see if record matches switch pattern
	JUMPF	IBMLFF			;[4(263)] if not, exit
	TXZ	S,CONPAT		;if switches present, it isn't console cruft
	MOVEM	S,.LACS+S		;put flags in commonly accessible place
	$CALL	DOSWT			;if it does, process the switch
	MOVE	TK,.LACS+TK		;[4(263)] restore TKB pointer
	JUMPF	IBMLFE			;[4(263)] if failed, don't write queue info file
	$CALL	WRTQUE			;update queue info file to current info

; Here to exit by passing record to user exit

IBMLFF:	MOVE	TK,.LACS+TK		;[4(263)] restore TKB pointer
IBMLFE:	POP	P,T2			;get back original length
	MOVE	T1,.LACS+T1		;get back original start address
	LOAD	R0,,T.ICT		;get input record count
	PJRST	CLLUSR			;and go to user calling routine


; Clear CHKSWT bit

CLRSWT::PUSH	P,S1			;save a register
	MOVE	S1,.LACS+S		;get S value
	TXZ	S1,CHKSWT		;clear bit
	MOVEM	S1,.LACS+S		;put S value back
	POP	P,S1			;restore register
	$RETF				;exit false, flag for no WRTQUE call


; Routine to restore all ACs except T2
;  (user can change length in user exit)

.LRST:	EXCH	T2,.LACS+T2		;use real T2
	HRLZI	R17,.LACS		;make BLT pointer
	BLT	R17,R17			;restore all AC's including stack
	$RET				;return to caller of IBMLFR
SUBTTL Subroutines -- .  CLLUSR, pass record to user exit

; Routine - CLLUSR
;
; Function - Decides device type and passes record to which of the
;	three processing routines that is appropriate.
;
; Parameters - T1/ Address of record
;	       T2/ Length of record in bytes
;
; Returns - True always
;
; Note - Destroys P1, P2
;	 User may change data in record and/or modify T2


CLLUSR:					;here to pass record to user exit
	LOAD	P1,,T.TYP		;get device type
	SUBI	P1,.TLPT		;normalize
	JUMPL	P1,.RETT		;skip it if type too low
	CAILE	P1,.TCDR-.TLPT		;see if it is too high
	$RETT				;skip it then also
	LOAD	P1,CLLTAB(P1)		;get proper user exit address
	JUMPE	P1,.RETT		;exit if none supplied
	PJRST	0(P1)			;call the user exit and return

CLLTAB:					;table of user exits
	EXP	USRLPT			;line printer record exit
	EXP	USRCDP			;card punch record exit
	EXP	USRCDR			;card reader record exit
SUBTTL Subroutines -- .  BLDFDB, build FD for holding files

; Routine - BLDFDB
;
; Function - Builds and FDB for the specified file type.
;
; Parameters - S1/ Address of FD (at least HLDFDB words long)
;	       S2/ Address of device/name table
;
; Returns - S2/ Byte pointer to name string
;
; Note - Changes 5 word block pointed to by S1

TOPS10 <DEFINE STSH <	IDPB P1,S1>>
TOPS20 <DEFINE STSH <	HRROI S2,P1
	SOUT>;end DEFINE STSH
>;end TOPS20

TOPS10 <HLDWD==1+1+1+1>			;str+name+ext+ppn
TOPS20 <HLDCH==1+3+5+7+7+^D13+1
		;"IBMDEV":+dev+"-IBM-"+"PnnLnn."+dev+"-ddmmmyy-hhmm"+null
	HLDWD==<HLDCH+4>/5+HLDDVW>		;number of words needed
	HLDFDB=1+HLDWD			;size of FDB = length word plus file
					; description

BLDFDB:					;subroutine to build device FD
	$SAVE	<T1,P1,P2,P3,P4>	;save some registers
	PUSH	P,S1			;save address of destination where we
					; can easily get at it
	MOVE	P3,S2			;save table address
	SETZM	0(S1)			;zero first word
	MOVS	T1,S1			;copy address to LH
	HRRI	T1,1(S1)		;make BLT pointer
	MOVEI	S2,HLDFDB-1(S1)		;address of last word to copy
	BLT	T1,0(S2)		;zero out block
TOPS10 <HRLI	S1,(POINT 36)>		;make into fullword byte pointer
TOPS20 <HRRO	S1,S1			;make into a byte pointer
	SETZ	T1,>			;no length for SOUT
	AOS	S1			;point to word after length
TOPS10 <MOVE	P1,IBMDEV		;get device name: LPT,CDP,CDR
	STSH>
TOPS20 <HRROI	S2,IBMDEV		;and point to directory
	SOUT
	MOVEI	S2,":"			; add the trailing colon
	IDPB	S2,S1
	MOVEM	S1,FDB.DV		; save ptr to next part of file spec
	>
	LOAD	P4,,T.TYP		;get device type
	ADDI	P4,-1(P3)		;get address of table entry
	MOVE	P4,0(P4)		;get contents
	TXNN	S,HASP			;are we doing it for HASP?
	JRST	BLDFD0			;no, this is sufficient
					;map dev name extension to one of the following
					; LPn
					; CPn
					; CRn
TOPS10 <MOVE	P1,[POINT 6,P4,11]>	;point to middle ch
TOPS20 <MOVE	P1,[POINT 7,P4,13]>	;point to middle ch
	LDB	P3,P1			;get middle char
TOPS10	<CAIN	P3,'D'>			;check for D
TOPS20	<CAIN	P3,"D">
	JRST	[PUSH	P,P1
		 ILDB	P3,P1		;get 3rd ch to replace 2nd ch
		 POP	P,P1
		 JRST	.+1]
	DPB	P3,P1			;store proper middle ch
TOPS10	<MOVEI	P3,'0'>			; and get a zero
TOPS20	<MOVEI	P3,"0">			; and get a zero digit
	LOAD	P2,,T.UNI		;get device number
	ADD	P2,P3			;convert to octal digit
	IDPB	P2,P1			;and store in name
BLDFD0:					;here when done making device name
	PUSH	P,P4			;save device name string
TOPS20 <MOVE	P1,P4			;copy it to parameter register
	STSH				;put into descriptor
	MOVEM	S1,FDB.IB		; save ptr to next part of file spec
	DMOVE	P1,[ASCIZ /-IBM-/]	;get next part of name
	STSH				;put into FD
	MOVEM	S1,FDB.PL		; save ptr to next part of file spec
	>
TOPS10 <MOVE	P1,[SIXBIT /P00L00/]	;get prototype port-line
	MOVE	P3,[POINT 6,P1,5]>	; and DPB-style pointer
TOPS20 <DMOVE	P1,[ASCIZ /P00L00./]	;get pattern for port-line
	MOVE	P3,[POINT 7,P1,6]>	; and pointer to first character
TOPS10 <MOVEM	S1,BLDFD2>		;copy byte pointer to name for later
	LOAD	S2,,L.PRT		;get port number
	$CALL	BLDFD1			;stuff it in
	LOAD	S2,,L.LIN		;get line number
	$CALL	BLDFD1			;put it in also
	STSH				;store result in FDB
TOPS20	<MOVEM	S1,FDB.EX>		; save ptr to ext
	POP	P,P1			;get device string again
	STSH				;put it as extension
TOPS20 <MOVEM	S1,BLDFD2>		;save pointer after file spec for TOPS20
	MOVSI	S2,HLDFDB		;get length of FDB
	POP	P,S1			;get destination address again
	MOVEM	S2,0(S1)		;store length word
	MOVE	S2,BLDFD2		;get pointer to name
	$RETT				;return
BLDFD1:					;subroutine add in two octal digits
	PUSH	P,S2			;save argument
	IBP	P3			;skip over character
	ANDI	S2,70			;get high order digit
	LSH	S2,-3			; all by itself
	LDB	P4,P3			;get a "0"
	ADD	P4,S2			;add our value in
	DPB	P4,P3			;and put it back
	POP	P,S2			;get original value
	ANDI	S2,7			;only low digit this time
	ILDB	P4,P3			;get next "0"
	ADD	P4,R2			;make into real digit
	DPB	P4,P3			;put it back
	IBP	P3			;point to next character
	$RET				;and return
TOPS20	<				; ptrs specific parts of file spec
FDB.DV:	0				; ptr to "dev" part
FDB.IB:	0				; ptr to "-IBM-" part
FDB.PL:	0				; ptr to "PnnLnn." part
FDB.EX:	0				; ptr to extention
	>
BLDFD2:	EXP	0			;word to hold byte pointer to name
SUBTTL Subroutines -- Debugging subroutines
IFN FTDEBUG,<

SUBTTL Subroutines -- .  LBVER, verify LB address


; Routine - LBVER
;
; Function - Scans line block list, comparing all entries against LB until
;	either a match is found or the end of list is reached.
;
; Parameters - LB/ Line block address
;
; Returns - True: if line block on line block list matches LB contents
;	    False: if no line block address match
;
; Note - Destroys S1, S2
;	 Changes "current" entry of LB

LBVER:					;verify that LB contains a line block address
	LOAD	S1,LBNAM		;get handle for list
	$CALL	L%FIRST			;position to first entry
	JUMPF	.POPJ			;if false, propagate it
LBVER1:					;compare loop
	CAMN	S2,LB			;is this the line block we are looking for?
	$RETT				;yes, return true
	$CALL	L%NEXT			;no, get next entry
	JUMPF	.POPJ			;if none, propagate false return
	JRST	LBVER1			;otherwise keep comparing

LSTD60:	EXP	0			;cell to store last D60JSY call address
LSTTF:	EXP	0
LSTS1:	EXP	0
LSTS2:	EXP	0
LSTT1:	EXP	0
    >;end IFN FTDEBUG
SUBTTL	Subroutines -- Disposition subroutines
SUBTTL Subroutines -- . DISPOS, dispose of files read from IBM host

; Routine - DISPOS
;
; Function - Renames the holding file according to the current queue create
;	 page info (pointed to by J) and queues the file to the line
;	printer (unless DISP:HOLD was specified, in which case it goes to
;	disk) except for null files, which are deleted.
;
; Parameters - J/ Queue request page
;
; Returns - False: if no filename or rename fails
;
; Note - Destroys S1, S2 and T2


DISPOS:	$SAVE	<T4,P1,P2,P3>
	MOVEI	S1,[ASCIZ /renaming hold file/]
	STORE	S1,,T.DST		; let world know why we are stuck
	SETZ	P3,			;init rename extension
	MOVEI	T4,5			;set retry count

DSPLK0:	SKIPN	DSPLOK			;check DISPOS interlock
	JRST	DSPLK1
	$DSCHD	0,^D2*3			;busy - try later
	JRST	DSPLK0

DSPLK1:	SETOM	DSPLOK			;ok to proceed - set lock
	$CALL	DISPOT			;do the disposal
	SETZM	DSPLOK			;clear the lock
	$RET

DISPOT:	$CALL	PRCQRQ			;pre-process QRQ block
	MOVEI	S1,FDBARE		;point to FDB build area
	MOVEI	S2,NMNTAB		;and to name table
	$CALL	BLDFDB			;build hold file name
TOPS10<	MOVEI	S1,2			;check on the file size
	MOVEI	S2,DOBLK
	$CALL	IBMIOP			;open the file
	JUMPF	DELQUE			;don't have anything to do anyhow
	MOVE	T2,S1			;save the IFN
	SETO	S2,			;find actual structure
	$CALL	F%FD			;gets actual FD
	MOVS	S2,(S1)			;get length of actual fd
	HRLI	S1,FDBARE		;make blt ptr
	MOVSS	S1
	BLT	S1,FDBARE-1(S2)		;copy actual into local area
	MOVE	S1,T2			;get the ifn back
	$CALL	F%REL			;close the file again
	>
	MOVEI	S1,FDBARE		;point to FDB
	MOVEM	S1,FRB			;store address in FRB
	MOVEI	T2,.QCFIL		;get file entry code
	$CALL	FNDENT			;find that entry
	JUMPT	DISPO1			;if we found it, continue
TOPS20	<$STOP	CFF,<Couldn't find file entry>>
TOPS10	<STOPCD	(CFF,HALT,,<Couldn't find file entry>)>
DISPO1:	MOVEM	S1,FRB+1		;store address in second half of
	TXZE	S,IOABT			;[261] did abort occur during input ?
	$CALL	RENABO			;[261] yes, modify filename appropriately

DISPOR:					; rename block
TOPS10<	MOVE	S2,.FDSTR(S1)		;check structures
	CAME	S2,IBMDEV		;is it same structure as default?
	JRST	DISPOB			;no, may have to copy
	MOVE	S2,FDBARE+.FDPPN	;yes, get PPN equivalent
	MOVEM	S2,.FDPPN(S1)		;store in destination FD
	MOVE	S2,FDBARE+.FDSTR	;also physical structure name
	MOVEM	S2,.FDSTR(S1)
DISPOB:	CAME	S2,FDBARE+.FDSTR	;same structure?
	>
TOPS20<	HRROI	S1,IBMDEV		;point at D60: string
	STDEV				;get device designator
	JFCL				;D60: must be there!!
	MOVE	T2,S2			;save it for a minute
	MOVE	S1,FRB+1		;get destination pointer
	HRROI	S1,1(S1)		;get by the first word
	STDEV				;get it's device designator
	ERJMP	DCPF2C			;device doesn't exist! try D60:.
	CAME	T2,S2			;are they the same?
>
	JRST	DISCPY			;no, we can't rename we have to copy
	MOVEI	S2,FRB			;get pointer to rename block
					;init FRB args
	SETZM	FRB.US(S2)		;user id for "in behalf of"
	SETZM	FRB.CD(S2)		;connected directory
	MOVX	S1,FR.NFO
	MOVEM	S1,FRB.FL(S2)		;flags: unique destination name
	SETZM	FRB.AB(S2)		;attribute block address
	MOVX	S1,FRB.SZ		;size of FRB
	$CALL	F%REN			;rename file
	JUMPF	DISPER			;if error, report it

DSPOSF:					; here when hold file is renamed
	MOVEI	T2,[ASCIZ /disposing of hold file/]
	STORE	T2,,T.DST
	MOVEI	T2,.QCODP		;get disposition block code
	$CALL	FNDENT			;get its block (if any)
	JUMPT	DSPOSD			;[405]has one, see what it is
	MOVEI	T2,.IBMST		;[405]none, check for /LSTR 
	$CALL	FNDENT			;[405]see if structure present
	JUMPT	DISPSN			;[405]yes, print it anyway
DSPOSD:	SKIPE	1(S1)			;[405]if disposition is delete, then
	JRST	DISDEL			; go delete user job
DSPHLD:	MOVE	S1,FRB+1		;get address of file specification
	$WTOJ	<File held for user>,<^F/@FRB+1/>,@T%OBA
FTACCT<	PUSHJ	P,OACTND>		;go do accounting
	JRST	DELQUE			;go delete hold file queue info
DOBLK:	FDBARE
	7

DISPSN:	MOVEI	S1,[XWD 2,.QCODP	;output disposition
		    EXP 1]		; of delete
	$CALL	INSENT			;insert it
	LOAD	S1,,T.TYP		; get the device type
	$WTOJ	<File queued to ^T/@QTYPE(S1)/>,<^F/@FRB+1/>,@T%OBA
	$CALL	SETACT			; Setup the account string if needed
	$CALL	SETLMT			; Set the printer page limit
FTACCT<	PUSHJ	P,OACTND>		; go do accounting
	$CALL	SNDQUE			; Send request to QUASAR
	 JUMPF	QSRDTH			; die ignomineously. file will hang around
	JRST	DELQUE			; All done here - flush the queue info file

QTYPE:	[ASCIZ	/control/]		; control task
	[ASCIZ	/printer/]		; lpt
	[ASCIZ	/punch/]		; cdp
	[ASCIZ	/reader/]		; cdr
	[ASCIZ	/console input/]	; cni
	[ASCIZ	/console output/]	; cno

; Here on error while renaming hold file

DISPER:	CAIE	S1,ERFNF$		;analize rename failure
	JRST	DISPR1
	PUSH	P,S1			;file wasn't there!
	MOVEI	S1,2
	MOVEI	S2,DOBLK		; see if Hold File is missing
	$CALL	IBMIOP			; by trying to open it
	JUMPF	[POP	P,S1
		 JRST	DISPR7]		; failure means no hold file
	$CALL	F%REL			; Hold file exists, so close it
	POP	P,S1
	JRST	DISPR2			; ERFNF$ was due to destination FD

DISPR7:					;[4(265)] Here if hold file is lost

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/could not find hold file ^F/FDBARE/>)>
	$WTOJ	<hold file evaporated!>,<couldn't dispose of hold file ^F/FDBARE/ 'cause it wasn't there>,@T%OBA
	$RETT				;nothing to do(except ponder the mystery)

DISPR1:	CAIN	S1,ERFDS$
	JRST	DISCPY			;have to copy if files on different structures
DISPR2:					;error may not be permanent
	CAIN	S1,ERFAE$		;check if already there
	JRST 	DISPR4			;if so, try new extension
	CAIA
DISPR5:	$WTOJ	<Rename failure>,<Rename extensions exhausted ^F/@FRB+1/>,@T%OBA

	SOJLE	T4,DISPR3		;try patience
	$CALL	DISRNE			;print rename error message
	$DSCHD	0,^D60*3		;wait a minute
	JRST	DISPOT			;try once more

DISPR3:					; cannot rename hold file
	MOVEI	T2,.QCODP		;code for output disposition
	$CALL	FNDENT			;find it
	JUMPF	DISPSN			;pretty hopeless - try to print it
	SKIPE	1(S1)			;check value
	JRST	DISPE1			;if disp=delete, complain and delete file

DISPE0:	$WTOJ	<cannot rename hold file>,<^F/FDBARE/ queued to LPT>,@T%OBA

	$CALL	INIQRQ			;re-initialize queue info
	JRST	DISPOT			;and try again

DISPR4:	CAIL	P3,^D100		;here to try modifying extension
	JRST	DISPR5			;but there's a limit!
	$LOG	<Rename failure>,<Attempting to rename file with modified extensions>,@T%OBA
DISPR6:	MOVE	S1,FRB+1		;get fd ptr
	MOVE	S2,P3			;get the modifier
	$CALL	MODEXT			;mung the extension
	$DSCHD	TW.GEN			;give other lines/tasks time
	MOVEI	T4,4			;reinit the retry count
	AOJA	P3,DISPOR		;and try once more

DISRNE:	$WTOJ	<Rename failure>,<cannot rename ^F/@FRB/ to ^F/@FRB+1/, ^I/DGLXER/. Will retry ^D/T4/ more times before taking default action.>,@T%OBA
	$RET

DISPE1:					;here on error for delete file

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/could not dispose of file ^F/FDBARE/>)>
	$WTOJ	<Couldn't queue file>,<will attempt to delete ^F/FDBARE/ >,@T%OBA

DISDEL:	MOVEI	T4,3

DISDL0:	MOVEI	S1,1			;size of FOB
	MOVEI	S2,FRB			;address of FOB
	$CALL	F%DEL			;delete the file
	JUMPT	DISDL1			; and the queue info file
	CAIN	S1,ERFNF$
	JRST	DISDL1			;it wasn't there anyhow

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/could not delete file ^F/FDBARE/>)>
	$WTOJ	<couldn't delete hold file>,<failure to delete hold file ^F/FDBARE/, ^I/DCPERM/>,@T%OBA

	SOJLE	T4,DISCRF
	$DSCHD	0,^D60*3*2		;wait two and hope opr will cure
	JRST	DISDL0			;otherwise we can't continue

DISDL1:

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/hold file ^F/FDBARE/ deleted>)>
	$WTOJ	<^F/FDBARE/ deleted>,<hold file ^F/FDBARE/ deleted>,@T%OBA
FTACCT<	PUSHJ	P,OACTND>		;go do accounting
	JRST	DELQUE			;now flush the q info file

DSPOSL:	MOVE	S1,T2			;come here to flush a null file
	$CALL	F%DREL
	JRST	DELQUE			;also the queue info file

DISCPY:					;rename to different structure must be
					;done via copy operation
	JUMPN	P3,DCP0			;[4(260)] message on first pass only
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/^I/DCPERM/>)>
	$WTOJ	< copying hold file to user area>,<^I/DCPERM/>,@T%OBA

DCP0:	PUSH	P,FRB+1			;make an open block
	PUSH	P,[FB.NFO!7]		;require new file
	MOVEI	S1,2
	MOVEI	S2,-1(P)
	$CALL	F%OOPN			;open destination file
	JUMPF	DCPFL2			; screw
	MOVE	P2,S1			;save dest ifn
	MOVE	S1,FRB
	MOVEM	S1,-1(P)
	MOVEI	S1,2
	MOVEI	S2,-1(P)
	$CALL	F%IOPN			;open the source file(hold file)
	JUMPF	DCPFL1			;not going to get far this way
	MOVE	P1,S1			;save source ifn
	POP	P,S1			;RESTORE STACK
	POP	P,S1

DCP1:	MOVE	S1,P1			;read some
	$CALL	F%IBUF
	JUMPF	DCPFL3
					;S1/number of bytes
					;S2/byte ptr to 1st byte(ILDB form)
					; assume 1st byte is 1st in word
	IBP	S2			; make sure byte ptr address -> 1st word
	HRL	S2,S1			; make args to write
	MOVE	S1,P2
	$CALL	F%OBUF			; write some
	JUMPT	DCP1			; keep going

DCPFL4:

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/write error ... ^I/DCPERM/, ^I/DGLXER/>)>
	$WTOJ	<write error>,< ^I/DCPERM/, ^I/DGLXER/>,@T%OBA
DCPFCL:	EXCH	S1,P1			;close the files
	$CALL	F%REL
	MOVE	S1,P2
	$CALL	F%RREL			; obliterate any trace of this attempt
DCPFC1:	MOVE	S1,P1			;get the error code back

DCPFL:	JRST	DISPER			;go analyze error

DCPFL3:	CAIN	S1,EREOF$		;eof?
	JRST	DCPSUC			;ok
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/input error ... ^I/DCPERM/, ^I/DGLXER/>)>
	$WTOJ	<input error>,< ^I/DCPERM/, ^I/DGLXER/>,@T%OBA
	JRST	DCPFCL

DCPFL1:					;output file opened, input open failed

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/input open error ... ^I/DCPERM/, ^I/DGLXER/>)>
	$WTOJ	<input open error>,< ^I/DCPERM/, ^I/DGLXER/>,@T%OBA
	POP	P,S2			;RESTORE STACK
	POP	P,S2
	EXCH	S1,P2
	$CALL	F%REL			;close the hold file
	MOVE	S1,P2			;[4(260)] get the error code back
	JRST	DCPFL			;[4(260)]

DCPFL2:					;output open failed
	CAIN	S1,ERFAE$		;[4(260)] file already exists ?
	JRST	DCPF2A			;go play the rename game
	CAIN	S1,ERNSD$		;check if structure is mounted
	JRST	DCPF2B			;no - punt
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/output open error ... ^I/DCPERM/, ^I/DGLXER/>)>
	$WTOJ	<output open error>,< ^I/DCPERM/, ^I/DGLXER/>,@T%OBA
DCPF2A:	POP	P,S2			;RESTORE STACK
	POP	P,S2
	JRST	DCPFL

DCPF2B:	POP	P,S2
	POP	P,S2

DCPF2C:	MOVEI	S1,[.IBMST]		;delete the LSTR entry
	$CALL	INSENT

TOPS10<	MOVEI	S1,[.QCOID]>
TOPS20<	MOVEI	S1,[.QCNAM]>
	$CALL	INSENT			;delete any PNAME entry - it might not
					; exist on same structure as D60:
	$CALL	INIQRF			;reestablish default file spec
	JRST	DISPOT			;and try the whole rename process again

DCPSUC:	MOVE	S1,P2			;done - close files
	$CALL	F%REL
	MOVE	S1,P1
	$CALL	F%DREL			;release and delete hold file
FTACCT<	PUSHJ	P,OACTND>		;go do accounting
	JRST	DELQUE			;flush the q info file

DISCRF:					;can't get rid of hold file no way!

TOPS20	<$STOP	CDF,<can't delete hold file>>
TOPS10	<STOPCD	(CDF,HALT,,<can't delete hold file>)>

MODEXT:					;S1/ptr to FD
					;S2/numeric modifier
	$SAVE	<T1>
	IDIVI	S2,^D10			;T1/low order digit
	PUSH	P,T1
	IDIVI	S2,^D10			;T1/high order digit
TOPS10<	ADDI	T1,'0'			;cram the digits in
	DPB	T1,[POINT 6,.FDEXT(S1),11]
	POP	P,T1
	ADDI	T1,'0'
	DPB	T1,[POINT 6,.FDEXT(S1),17]
	>
TOPS20<	PUSH	P,T1			;save this one
	$CALL	SCAN.			;[261] scan off directory name
	IBP	S2			;skip 1st letter of extension
	POP	P,T1			;get the high order digit
	PUSHJ	P,MODEX2		;crammit
	POP	P,T1			;and likewise for the low order digit
MODEX2:	ADDI	T1,"0"
	IDPB	T1,S2
	>
	$RETT


;Routine - RENABO
;
;Function - if an input abort occurred during the receipt
;	of the current file, then modify the first 3 characters
;	of the extension to be ABT.  Otherwise, DISPOS of
;	the file normally.

RENABO:	PUSH P,S2
TOPS10<	MOVSI	S2,(SIXBIT /ABT/)	;new extension
	MOVEM 	S2,.FDEXT(S1) >		;into the filename
TOPS20<	PUSH	P,S1
	PUSH	P,T1
	$CALL	SCAN.			;find extension field
	MOVE	S1,[POINT 7,ABTSTR]	;replace dev with ABT
	ILDB	T1,S1			;same no. of instructions as other methods
	IDPB	T1,S2
	ILDB	T1,S1
	IDPB	T1,S2
	ILDB	T1,S1
	IDPB	T1,S2
	POP	P,T1
	POP	P,S1 >
	POP	P,S2
	$RET				;done

ABTSTR:	ASCIZ	/ABT/


SCAN.:	MOVEI	S2,1(S1)		;scan the file name for "."
	HRLI	S2,(POINT 7)

SCAN.1:	ILDB	T1,S2
	CAIN	T1,74			;[4(260)] left angle bracket
					; - scan off directory first
	JRST	[ILDB T1,S2
		 CAIE T1,76		;look for right angle bracket
		 JRST .
		 JRST SCAN.1]		;[4(260)]
	CAIE	T1,"."
	JRST	SCAN.1			;we naturally assume it is there!
	$RET
SUBTTL Subroutines -- .  SETACT, set print file account string

; Routine - SETACT
;
; Function - To setup the account string on TOPS20 in a queue create message.
;	This is needed for printing, otherwise the account string of the
;	job that is running this program will be used.
;
; Parameters - none
;
; Returns - True always
;
; Note - If this routine can find an account string, a .QCACT entry is
;	made in the queue create message.

TOPS10 <
SETACT:	$RETT >				; Nothing to do for TOPS10

TOPS20 <
SETACT:	$SAVE	<P1,P2>			; Save some registers
	STKVAR	<<ACTBUF,^d40>>		; Temporary buffer for GTDIR and
					;  Q create message entry
	MOVX	T2,.QCACT		; Account string entry
	$CALL	FNDENT			; Check if one already exists
	 JUMPT	.POPJ			;  Yes .. so don't fool with it
	MOVX	T2,.QCNAM		; User name entry
	$CALL	FNDENT			; Check if that exists
	 JUMPF	.POPJ			;  None .. can't find an account then
	MOVE	P1,S1			; Save address of name entry

	HRROI	S2,ACTBUF		; Point to buffer with a byte pointer
	HRROI	S1,[ASCIZ \PS:<\]	; Start of directory name
	SETZ	T1,			; Stop transfer on zero byte
	SIN				; Transfer to directory name buffer
	HRROI	S1,1(P1)		; Point to user name
	SIN				; Put that into directory name also
	HRROI	S1,[ASCIZ \>\]		; Close of the directory name
	SIN
	HRROI	S2,ACTBUF		; Get start of directory name back
	MOVX	S1,RC%EMO		; Exact match flag
	RCDIR				; Get directory number
	TXNE	S1,RC%DIR+RC%NOM	; Check for files-only or no match
	 $RETF				;  Can't have either
	MOVEI	P2,ACTBUF		; Get address of buffer
	MOVX	S1,20			; Size of the GTDIR block
	MOVEM	S1,.CDLEN(P2)		; Put into length word
	SETZM	S1,.CDLEN+1(P2)		; Clear next word
	HRRI	S1,.CDLEN+2(P2)		; Next word to clear
	HRLI	S1,.CDLEN+1(P2)		; Standard way to BLT
	BLT	S1,.CDDAC-1(P2)		;  a block clean
	HRRI	S1,.CDDAC+2(P2)		; A couple of words past arg block
	HRLI	S1,(POINT 7,)		;  so that queue create block fits
	MOVE	P1,S1			; Save pointer to start of string
	MOVEM	S1,.CDDAC(P2)		; Store in arg block for account string
	MOVE	S1,T1			; Get directory number
	MOVE	S2,P2			; Get location of argument block
	SETZ	T1,			; Clear pointer to password string
	GTDIR				; Get account string
	MOVE	S1,P1			; Get start of string pointer again
	ILDB	S1,S1			; Get first byte
	JUMPE	S1,.POPJ		; If null, no account string
	HRRZ	S1,.CDDAC(P2)		; Get address of end of account
	MOVEI	P1,1(P1)		; get the beginning address and
	SUBI	P1,.CDDAC(P2)		; Calculate length of string in words
	HRRI	S1,.QCACT		; Account string entry
	HRL	S1,P1			; Of the specified length
	MOVEM	S1,.CDDAC+1(P2)		; Put into arg block
	MOVEI	S1,.CDDAC+1(P2)		; Get address of create message entry
	$CALL	INSENT			; Insert it into message
	$RETT				; Return successfully.

    >;End if TOPS20
SUBTTL Subroutines -- .  SETLMT, Set print file page limit

; Routine - SETLMT
;
; Function - To calculate the printer page limit of a job to be printed.  The
;	page limit is then inserted in to the queue create message for
;	processing by QUASAR.
;
; Parameters - none

SETLMT:	STKVAR	<<LMTBUF,^d2>>		;[370] Buffer for Q msg create entry

TOPS20 <
PAGLMT:	MOVX	S1,GJ%SHT+GJ%OLD	;[370] File exists
	MOVE	T1,FRB+1		;[370] Get the new name per
	HRROI	S2,1(T1)		;[370]  File Rename Block 
	GTJFN				;[370] Get its handle
	 JRST LKPERR			;[370] Pretend this didn't happen 
	HRRZ	S1,S1			;[370] JFN
	MOVE	S2,[1,,.FBBYV]		;[370] Want page size
	MOVEI	T1,S2			;[370] Get address of limit buffer
	GTFDB				;[370] Get the monitor's file info
	 ERJMP LKPERR			;[370] Can't do, use monitor's kluge
    >;[370]End if TOPS20

TOPS10 <
BLKLMT:	MOVE	S2,[SIXBIT/DSK/]	;[370] Get a channel for opening
	MOVEM	S2,OBLOCK+1		;[370] Set up the open block
	MOVEM   S2,LKDEV		;[370] And the lookup block for later
	OPEN	S1,OBLOCK		;[370] Open the channel
	 JRST LKPERR			;[370] This has got to work
 	MOVEI	T1,LKBLKL-1		;[370] Set up the lookup table
	HRRZM	T1,LKBLK		;[370] Length of Arguments
	MOVE	T1,FRB+1		;[370] Find the File Rename Block
	MOVE	S2,.FDNAM+(T1)		;[370] Get new file name 
	MOVEM	S2,LKNAM		;[370] Pass to lookup block
	MOVE	S2,.FDEXT+(T1)		;[370] Get file extension
	MOVEM	S2,LKEXT		;[370] Need that too
	MOVE	S2,.FDPPN+(T1)		;[370] Get user PPN
	MOVEM	S2,LKPPN		;[370] And we're ready
	LOOKUP	S1,LKBLK		;[370]  to do the Lookup
	 JRST LKPERR			;[370] Lookup failed, use kluge method
	MOVE	S2,LKSIZ		;[370] Get file word size 
	ADDI	S2,177			;[370] Round up a block's worth
	ASH	S2,-7			;[370] convert to blocks 
    >;[370]End if TOPS10

LPTLMT:	IMULI	S2,LPTMUL		;[370] Per disk page/block multiplier
	IDIVI	S2,LPTDIV		;[370] and divisor to come up with
	SKIPE	T1			;[370] number of lineprinter pages
	ADDI	S2,1			;[370] Round up if necessary.
	
SETLM1:	MOVEI	S1,LMTBUF		;[370] Get address of buffer
	MOVE	T1,[2,,.QCLIM]		;[370] /LIMIT entry
	MOVEM	T1,(S1)			;[370] First word in entry
	MOVEM	S2,1(S1)		;[370] Lineprinter page limit is next

	PJRST	INSENT			;[370] Insert entry and return

LKPERR:	$WTOJ	<Can't size file, using default for>,<^F/@FRB+1/>,@T%OBA
	SETZ	S2,			;[370] Problems, then let QUASAR
	JRST SETLM1			;[370] handle it
SUBTTL Subroutines -- .  QUEFDB, build q-create variant of hold file

; Routine - QUEFDB
;
; Function - build q-create variant of hold file
;
; Parameters - none
;
; Returns - leaves name in FDBARE


QUEFDB:					;subroutine to build the queue create
					; file variant of the hold file FDB
	MOVEI	S1,FDBARE		;point to area to build FDB
	MOVEI	S2,NMNTAB		; and to table of names
	$CALL	BLDFDB			;build the standard name
TOPS20 <MOVE	S1,FDB.IB		;get ptr to "-IBM-"
	IBP	S1
	MOVEI	S2,"Q"			;get a "Q"
	IDPB	S2,S1			;make filename "IBMDEV"dev-QBM-P...
>;end TOPS20
TOPS10	<MOVEI	S1,'Q'			;get "Q"
	DPB	S1,[POINT 6,FDBARE+2,5]	;make filename QnnLnn
>;end TOPS10
	$RETT
SUBTTL Subroutines -- .  WRTQUE, write out the queue info page

; Routine - WRTQUE
;
; Function - write the queue info page to the queue info file
;
; Parameters - none
;
; Returns - TRUE

WRTQUE:					;write out the queue info file
	$CALL	QUEFDB			;make the queue file name
	MOVEI	S1,2			;get length
	MOVEI	S2,QOBLK		; and address of FOB (file open block)
	$CALL	IBMOOP			;open it for output
	JUMPT	WRTQU0			;continue if successful
QUEERR:					;here on queue info file manipulation error

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/^I/DGLXER/ on queue info hold file ^F/FDBARE/>)>
	$WTOJ	<File error>,<^I/DGLXER/ on queue info hold file ^F/FDBARE/>,@T%OBA
	$RETT				;ignore error
WRTQU0:					;here if open succeeded
	PUSH	P,S1			;save IFN
	PUSH	P,[EXP QUECLS]		; and address of routine to close it
	HRR	S2,J			;get address to write from
	HRLI	S2,1000			; and length (1 page)
	$CALL	F%OBUF			;write it out
	JUMPF	QUEERR			;complain if we could not
	$RET
SUBTTL Subroutines -- .  QECLS, close the queue info file

; Routine - QUECLS
;
; Function - close the queue info file
;
; Parameters - P/IFN for the file
;
; Returns - TRUE

QUECLS:					;routine to close queue info file
	POP	P,S1
	$CALL	F%REL
	$RETT				;ignore errors
SUBTTL Subroutines -- .  RDQUE, read the queue info file

; Routine - RDQUE
;
; Function - read the queue info file into the queue info page
;
; Parameters - assumes the job pages are set up
;
; Returns - TRUE

RDQUE:					;routine to read queue info file
	$CALL	QUEFDB			;make name
	MOVEI	S1,2			;get length
	MOVEI	S2,QOBLK		; and address of open block (FOB)
	$CALL	IBMIOP			;open for input
	JUMPF	RDQUER			;complain if we cannot
	PUSH	P,S1			;save IFN
	PUSH	P,[EXP QUECLS]		; and address of routine to close it
	$SAVE	<T1,T2,T3,T4>		;preserve a few registers
	MOVE	T4,S1			;copy IFN
	MOVE	T2,J			;get address to read into
	HRLI	T2,444400		;make into byte pointer
	MOVEI	T1,1000			;and get count of bytes to read
RDQUE0:					;loop to read whole page
	MOVE	S1,T4			;get IFN again
	$CALL	F%IBUF			;get a bufferful
	JUMPT	RDQUE1			;if we succeeded, continue
	CAIN	S1,EREOF$		;check for EOF error
	$RETT				;if so, return true
RDQUER:	$CALL	QUEERR			; report error
	$CALL	INIQRQ			;re-initialize queue page if we
					; got a real error (who knows what
					; it might have!)
					; ......the shadow knows!
	$RETT				; a valid random file has been created
RDQUE1:					;here on good buffer of queue info data
	ILDB	T3,S2			;get next word (byte)
	JUMPE	T1,RDQUE2		;if we have copied whole page, exit
	IDPB	T3,T2			;store it in page
	SOS	T1			;we have one less word to copy
RDQUE2:					;here to decrement buffer count
	SOJG	S1,RDQUE1		;loop till this buffer exhausted
	JUMPN	T1,RDQUE0		;if more to copy, try another read
	$RETT				;else consider it done
SUBTTL Subroutines -- .  DELQUE, flush the queue info file

; Routine - DELQUE
;
; Function - flush the queue info file
;
; Parameters - none
;
; Returns - TRUE

DELQUE:					;subroutine to delete queue info file
	$CALL	QUEFDB			;make queue info file name
	MOVEI	S1,2			;get length
	MOVEI	S2,QOBLK		; and address of open block (FOB)
	$CALL	F%DEL			;delete the file
	$RETT				;ignore errors

;@QOBLK+1 - Edit 371
QOBLK:	EXP	FDBARE			;address of FDB
TOPS20 <EXP	FB.SUP!^D36>		;[371]supersede bit!byte size
SUBTTL Subroutines -- .  SNDQUE, send queue info to QUASAR

; Routine - SNDQUE
;
; Function - send queue info to QUASAR
;
; Parameters - J -> queue request page
;
; Returns - results of SNDQSR - caller must decide what to  do about failure

SNDQUE:					;subroutine to send queue create
					; to QUASAR
	MOVEI	S1,.QOCQE
	STORE	S1,0(J)
	MOVEI	S1,CQBEG(J)
SNDQU0:	HLRZ	S2,0(S1)
	JUMPE	S2,SNDQU1
	ADD	S1,S2
	JRST	SNDQU0
SNDQU1:	SUBI	S1,0(J)
	HRLM	S1,0(J)
	MOVE	T1,J
	$CALL	SNDQSR
	$RET
SUBTTL Subroutines -- .  PRCQRQ, modify queue info

; Routine - PRCQRQ
;
; Function - modify queue info to reflect switches read
;
; Parameters - queue info page set up
;
; Returns - TRUE

PRCQRQ:					;routine to re-arrange queue info
	MOVEI	T2,.QCODP		;find
	$CALL	FNDENT			; disposition block
	JUMPF	PRCQR1			;if none, check other switch values
	SKIPE	1(S1)			;see if disp=delete
	JRST	PRCALL			;yes, just do always processing

PRCQR1:	MOVEI	T2,.QCJBN		;identifier for LNAME info
	$CALL	FNDENT			;search for it
	JUMPF	PRCQR0			;not there, so skip replacement
	$CALL	CHGNAM			;change PnnLmm to name
	JUMPF	PRCERR			;illformed queue info file
PRCQR0:					;here to check for PNAME (user)
TOPS10 <MOVEI	T2,.QCOID>		;code for TOPS-10 PPN
TOPS20 <MOVEI	T2,.QCNAM>		;code for TOPS-20 user name
	$CALL	FNDENT			;see if one was supplied
	JUMPF	PRCALL			;[404] no, skip this
	$CALL	CHGUSR			;change user in file spec
	JUMPF	PRCERR			;illformed queue info file
	MOVEI	T2,.IBMST		;code for structure entry
	$CALL	FNDENT			;see if structure present
TOPS10	<JUMPF	PRCALL>			;no - so don't do anything
TOPS20	<JUMPF	[$CALL RELSTR		;no - insert real D60 structure
		 JRST	PRCALL]>	;...it's aesthetic
	$CALL	CHGSTR			;replace structure in file spec
	JUMPF	PRCERR			;illformed queue info file
PRCALL:					;here to do processing which always
					; has to be done
	$RETT

	
PRCERR:	$CALL	QUEFDB			;reconstruct queue info file name

FTCLOG<	$TEXT	(LOGCHR,<illformed queue info file - F/FDBARE/>)>
	$WTOJ	<illformed queue info file>,<switch entries in queue info file ^F/FDBARE/ were illformed - using defaults>,@T%OBA
	$CALL	INIQRQ			;experience might indicate desirability
					; of ignoring crufty entries and using the
					; the good ones(if any) - but I don't
					; trust any of it at this point
	$RETT
notyet:	HALT

WATCH:	$RETT
WATSND:	JRST NOTYET
GETCNI:	JRST NOTYET
SUBTTL	Subroutines -- Miscellaneous subroutines
SUBTTL Subroutines -- .  TBFINI, initialize task IO buffer

; Routine - TBFINI
;
; Function -	initialize task IO buffer
;
; Parameters -	TK/task block ptr
;
; Returns -	TRUE always

TBFINI:	SETZM	T$DIC(TK)
	SETZM	T$RIC(TK)
	MOVE	S1,T$RIA(TK)
	HLL	S1,T%XBA
	MOVEM	S1,T$RIP(TK)
	LOAD	S1,,T.XBA
	STORE	S1,,T.XRP
	LOAD	S1,,T.XBN
	STORE	S1,,T.XRC
	$RETT
SUBTTL Subroutines -- .  INIJOB, initialize a job

; Routine - INIJOB
;
; Function -	initialize a job
;
; Parameters -	TK/task block ptr
;
; Returns -

INIJOB:	SETZM	T$GIC(TK)
	SETZM	T$NFP(TK)		;set no files processed
	POPJ	P,
SUBTTL Subroutines -- .  IBMOOP, IBMIOP - special opens for hold file

; Routine - IBMOOP
;
; Function - open file for output. if fails due to device name, create
;	     default for IBMDEV and try again.
;
; Parameters - S1/open block size
;	       S2/ptr to open block
;
; Returns - true if suceeds
;	    false if fails for any reason - S1/code

IBMOOP:					; open file for output
TOPS10	<$CALL	F%OOPN			; nothing special for TOPS10
	$RET>

TOPS20	<PUSH	P,T2			; use special open
	MOVE	T2,[$CALL	F%OOPN]	; tell opener what glx fcn to use

IBMOPN:	PUSH	P,T1			; special opener, T2/glx fcn
	PUSH	P,S1
	PUSH	P,S2			; save args in case of initial fail
	XCT	T2			; try it
	JUMPT	OOPX			; exit immediately if suc'd
	CAIN	S1,ERNSD$		; failed - check for logical name
	$CALL	IBLCRR			; ok or hopeless return
OOPX:	SUB	P,[2,,2]		; success or hopeless exit

IBMOPX:	POP	P,T1
	POP	P,T2
	$RET

IBLCRR:	$WTOJ	<IBMSPL fatal error>,<required system logical name "^T/IBMDEV/" not defined>,@T%OBA
	MOVEI	S1,ERUSE$		; return glxerr code
	$RETF
	>
; Routine - IBMIOP
;
; Function - open file for input - similar to IBMOOP

IBMIOP:
TOPS10	<$CALL	F%IOPN			; nothing special for TOPS10
	$RET>
TOPS20	<PUSH	P,T2			; open file for input
	MOVE	T2,[$CALL	F%IOPN]	; glx fcn to use
	JRST	IBMOPN			; use special opener
	>
SUBTTL Subroutines -- .  OPNHLD, open the hold file

; Routine - OPNHLD
;
; Function - open the hold file. If there is an old one lying around - DISPOS
;	     it. Waits until it succeeds.
;
; Parameters - none
;
; Returns -	TRUE always
;		P3/ptr to hold file FD
;		P4/IFN for holding file

OPNHLD:	$SAVE	<T1,T2,T4>		;subroutine to open hold file
	SETZB	P3,P4			;preset failure exit

OPNHQ0:	MOVEI	T4,^D10			;init retry count
OPNHLQ:	$CALL	INIQRQ			;initialize queue create message page
	JUMPF	OPNQFL			; some form of fatality

	MOVE	P3,S1			;save  the fd ptr
	MOVEI	S1,FDBARE		;point to area to build file spec
	MOVEI	S2,NMNTAB		; and to name table
	$CALL	BLDFDB			;build hold file name
	MOVEI	S1,2			;get size
	MOVEI	S2,OBLK			; and address of open block
	$CALL	IBMOOP			;open hold file for output
	JUMPF	OPNHER			;report error if that failed
OPNHL0:					;here on successful open of hold file
	MOVE	P4,S1			;copy IFN for permanent storage
	$CALL	GETCFD			;get the hold  file fd adr in P3
	$RETT
OPNHER:					;here on error opening hold file
	CAIN	S1,ERFAE$		;is the error that the file already exists?
	JRST	OPNOLD			;yes, we have to go process file left
					; over from a crash
					; log some errors
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/^I/DGLXER/ opening hold file ^F/FDBARE/>)>
	$WTOJ	<File error>,<^I/DGLXER/ opening hold file ^F/FDBARE/>,@T%OBA

	SOJLE	T4,.RETF		;must be permanent
	$DSCHD	0,^D60*3		;wait a fairly long time
	JRST	OPNHLQ			;and try again

OPNOLD:					;here when we have an old hold file
					; lying around
FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/disposing of old hold file ^F/FDBARE/>)>
	$WTOJ	<disposing of old hold file>,<^F/FDBARE/>,@T%OBA

	$CALL	RDQUE			;read whatever queue info file exists
					; ...if none, a valid copy is created
	$CALL	DISPOS			;and dispose of file accordingly
	JUMPF	OPNOLE

IFN FTIBMS,<
	MOVEI	S1,%EOUT		; inform QUASAR
	$CALL	IBMSTS
> ;End of FTIBMS

	JRST	OPNHQ0			;[4(263)] and try opening hold file again
OPNOLE:	TXO	S,GOODBYE!ABORT		;[4(263)] abort and hangup
	$RETF				;[4(263)]

OPNQFL:					;can't correctly generate queue create msg

FTCLOG<	$TEXT	(LOGCHR,<^I/IBMSG/^I/DGLXER/ initializing queue create message>)>
	SOJLE	T4,.RETF		;looks grim
	$DSCHD	0,^D30*3		;wait half a minute and try again
	JRST	OPNHLQ			;try again

GETCFD:	$SAVE	<S1,S2>			;P4/IFN for file
	MOVE	S1,P4			;get ptr to its FD
	SETO	S2,			;get exact version
	$CALL	F%FD
	MOVE	P3,S1			;return in P#
	$RET

OBLK:	EXP	FDBARE
	EXP	7+FB.NFO		;byte size of 7 and require new file
NMNTAB:
TOPS10<	SIXBIT	/LPT/
	SIXBIT	/CDP/
	SIXBIT	/CDR/
	>
TOPS20<	ASCIZ	/LPT/
	ASCIZ	/CDP/
	ASCIZ	/CDR/
	>
SUBTTL Subroutines -- .  INPOPN, open a file for input

; Routine - INPOPN
;
; Function -	open a file for input
;
; Parameters -	P3/ptr to file FD
;
; Returns -	TRUE if open succeeds
;		P4/IFN for open file


INPOPN:	MOVEI	P4,FB.LSN+7		; 7 bit bytes with line number stripping
	MOVEI	S1,FOB.SZ		;[356] Zero
	MOVEI	S2,FOB			;[356]  the
	$CALL	.ZCHNK			;[356]   FOB
	DMOVEM	P3,FOB+FOB.FD		;[356] Store FD address & byte size, etc.
	LOAD	P4,.EQSEQ(J),EQ.PRV	;[356] Grab user's privs
	JUMPN	P4,INPO.1		;[356] Is user a wheel or [1,2] ?
	LOAD	P4,.FPINF(P2),FP.SPL	;[356] Also check to see if
	JUMPN	P4,INPO.1		;[356]  this is spooled
TOPS20	<
	HRROI	P4,.EQCON(J)		;[356] Get connected directory
	MOVEM	P4,FOB+FOB.CD		;[356] And stash it
	HRROI	P4,.EQOWN(J)		;[356] Create a pointer to the user name
>
TOPS10	<
	MOVE	P4,.EQOID(J)		;[356] Get PPN
>
	MOVEM	P4,FOB+FOB.US		;[356] Stash PPN or user name

INPO.1:	$CALL	F%IOPN			;Open the file
	JUMPF	.POPJ			;Failed

INPOP0:	MOVEM	S1,P4			;Save IFN
	SETZM	T$DIC(TK)		;Zero disk file byte count
	$RET				;Done
SUBTTL	Subroutines -- . CHKSNZ, check if task should deschedule

; Routine - CHKSNZ
;
; Function - This routine checks if a task that has been doing I/O to
;	an IBM device has been descheduled recently.  If not it is forced
;	into an I/O wait and a scheduling pass is made.
;
; Parameters - none except normal registers setup in task context.
;
; Returns - Always

CHKSNZ:	TXNE	S,OUTEOF!INPEOF!FLSH!LGA!IOABT!ABORT ; Check if task is done anyhow
	$RET				;  Yes .. no need to block him
	$SAVE	<S1>			; Save a work register
	AOSGE	T%SNZ			; Increment desched counter
	$RET				;  Ok so far .. let him continue
	HRLZI	S1,TW.GEN		; do a gentlemanly desched
	JRST	SNZTSK
SUBTTL	Subroutines -- . SNZ, task or non-task time wait

; Routine - SNZ
;
; Function - To provide descheduling capabilities for routines external
;	to IBMSPL.  Specifically D60JSY routines.  Note also the companion
;	routine CHKSNZ that stops COPY/GETIBM/PUTIBM from blocking all
;	other task from running.
;
; Parameters - S1/ Wakeup-conditions,,Sleep-time
;
; Returns - Always.
;
; Note - See also DSCHD routine.  If the sleep time is zero, the desched
;	will return only on the conditions flagged.

SNZ:	SKIPE	CURATE			; Called from task context?
	 JRST	SNZTSK			;  Yes, go off to sleep that way
	TXZ	S1,TW.IOD		; Clear I/O done bit
	PJRST	MISLP			; and just sleep and return

SNZTSK:	MOVE	TF,S1			; Move scheduling parameters
	MOVNI	S1,SNZINT		; Get number of times that snooze
	MOVEM	S1,T%SNZ		;  chk can happen before deschd forced
	PJRST	DESCHD			; Sleep and return
SUBTTL	Subroutines -- . D60ANL, D60JSY call interface

; Routine - D60ANL
;
; Function -	Call indicated D60JSY function and check error returned and take
;		appropriate action depending on the fatality level of the error.
;		Non-fatal errors will cause a deschedule(from task level) or
;		sleep for 3 seconds,  then retry return is taken.
;
; Parameters -	TF/ptr to arg block:
;			@function
;			wait time for D6NBR returns
;			retry address for D6NBR returns
;		S1/device handle (if relevant)
;		S2/byte ptr (if SIN/SOUT)
;		T1/-<byte cnt> if(SIN/SOUT)
;
; Returns -

D60ANL:
IFN FTDEBUG,<
	MOVEM	TF,LSTD60
	MOVEM	TF,LSTTF
	MOVEM	S1,LSTS1
	MOVEM	S2,LSTS2
	MOVEM	T1,LSTT1
    >;end IFN FTDEBUG

	PUSH	P,TF			;save the arg block ptr
	PUSHJ	P,@TF			;...and call fcn
	JUMPT	D60RET
	$CALL	D60FAL			; If failed .. check error code
	JUMPT	D60RTR			; if innocuous, take the retry return

	CAIL	S1,D6HEAD		;if it is a JSYS error, give up too
	CAIN	S1,D6COF		;if we cannot open FE
	JRST	D60PRD			; its hopeless
	CAIE	S1,D6LGA		;if line has gone away
	CAIN	S1,D6CTF		; or front end
	JRST	D60PRD			;go signal appropriate aborts
	CAIN	S1,D6DNR		;dead FE's are unfriendly
	JRST	D60PRD			;go signal appropriate aborts

D60RET:	EXCH	TF,(P)			;return inline,preserving the error status
	POP	P,TF
	$RET
D60PRD:					;here on serious error
	POP	P,TF			;flush the retry adr
	$SAVE	<P1,P2,P3,LB,TK,S1,S2,T1>;save some registers
	MOVE	P3,LB			;remember line we were on
	SKIPE	CURATE			;if not a task, skip
	TXO	S,ABORT!LGA		;set abort and line gone away
	SETOM	P2			;assume entire port has gone
	CAIN	S1,D6LGA		;is it really only the line?
	SETZM	P2			;yes, revise assumption
	LOAD	S1,,L.LNI		;get port,,line
	$CALL	FNDPOR			;get port block in P1
	LOAD	LB,,P.FLB		;get first line block
D60PR0:					;loop over line blocks
	SKIPL	P2			;skip if multiple lines
	CAMN	LB,P3			; or see if same line we were on
	$CALL	D60PR1			;yes, signal this line
	LOAD	LB,,L.PFW		;get next line block
	JUMPN	LB,D60PR0		;loop till no more
	$RETF
D60PR1:					;subroutine to flag line as down
	LOAD	S1,,L.STS		;get status bits
	TXZ	S1,L.UP			;clear up bit
	LOAD	TK,,L.FTK		;point to first task
	JUMPE	TK,.POPJ		;if none, we must already be winding down
	$CALL	ACTTSK			;make sure it is active
	$SIGNL	TW.LGN,LINE		;set bits for everyone
	$RET				;return to caller

D60RTR:	POP	P,TF			;take the retry return
	ADDI	TF,2			;2(TF)!
	MOVEI	TF,@TF
	MOVEM	TF,(P)			;whew!
	$RETF

SUBTTL	Subroutines -- . D60FAL, check for non-fatal errors

D60FAL:	CAIE	S1,D6NBR		;check non-fatal errors
	CAIN	S1,D6DOL
	CAIA
	$RETF				;fatal - just return
	PUSH	P,S1			;save the error code for kicks
	MOVE	S1,-2(P)		;get arg block ptr
	SKIPE	S1,1(S1)		;get the wait time
	$CALL	SNZ			;deschedule or sleep as appropriate
	POP	P,S1
	$RETT
SUBTTL Subroutines -- .  CHGNAM,CHGUSR,CHGSTR, modify hold file from switches


; Routine -	CHGNAM,CHGUSR,CHGSTR
;
; Function -	modify hold file from switches /LNAME,/PNAME,/LSTR

;
; Parameters -	J setup
;		S1/ptr to switch entry block
;
; Returns -	TRUE if all kosher
;		FALSE if	(a) file block not found
;				(b) switch entry is illformed
;
; Note -	 uses FDBARE as staging area for strings(TOPS-20)

TOPS10	<
CHGNAM:					;subroutine to change file name
	MOVEI	S2,.FDNAM		;where to put result
CHGCOM:					;common change code
	$SAVE	<T1,T2,T3>		;get some registers
	MOVE	T1,1(S1)		;get argument
CHGCM0:	MOVE	T3,S2			;save displacement
	MOVEI	T2,.QCFIL		;code for file block
	$CALL	FNDENT			;find it
	JUMPF	SWILL			;illformed switch entry block
	ADD	T3,S1			;make address of word
	MOVEM	T1,0(T3)		;store word
	$RETT

CHGUSR:					;here to change PPN
	MOVEI	S2,.FDPPN
	JRST	CHGCOM

CHGSTR:					;here to change structure
	MOVEI	S2,.FDSTR		;where to store word
	JRST	CHGCOM

RCHSTR:	$SAVE	<T1,T2,T3>		;map structure back to D60:
	MOVE	T1,IBMDEV
	JRST	CHGCM0
    >;End if TOPS10

TOPS20	<
CHGUSR:					;subroutine to change user
	$SAVE	<S1,S2,T1,T2,T3,P1>	;save some registers
	MOVEI	P1,1(S1)		;point to start of replacement string
	HRLI	P1,440700		;make into byte pointer
	MOVEI	T2,.QCFIL		;code for file block
	$CALL	FNDENT			;find it
	JUMPF	SWILL			;illformed switch entry block
	MOVEI	S2,1(S1)		;point to start of source string
	HRLI	S2,440700		;make into byte pointer
	MOVE	T2,[POINT 7,FDBARE+1]	;make destination pointer
	MOVEI	T3,<FDXSIZ-1>*5		;limit of staging area
	MOVE	T1,0(S1)		;get first word of entry
	MOVEM	T1,FDBARE		;and save it
CHGUS0:					;loop to copy till user start
	SOJL	T3,SWILL		;limit test
	ILDB	S1,S2			;get a character
	JUMPE	S1,SWILL		;illform test
	IDPB	S1,T2			;no, copy character
	CAIE	S1,":"			;[4(257)] is it colon ?
	JRST	CHGUS0			;no, go back for another
	SOJL	T3,SWILL		;limit test
	MOVEI	S1,74			;[4(257)] left angle bracket
	IDPB	S1,T2			;[4(257)] start user field in dest.
	MOVE	S1,S2			;[4(257)] look ahead one byte
	ILDB	S1,S1			;[4(257)] in source string.
	CAIE	S1,74			;[4(257)] is directory field present ?
	JRST	CHGUS2			;[4(257)] no, so skip skipping over it
	MOVEI	T1,^D39			;field scan limit
CHGUS1:					;loop to skip over user
	SOJL	T1,SWILL		;field limit test
	ILDB	S1,S2			;get next character
	JUMPE	S1,SWILL		;illform test
	CAIE	S1,76			;is it right angle bracket?
	JRST	CHGUS1			;no, continue
CHGUS2:					;here to copy in replacement name
	ILDB	S1,P1			;get replacement byte
	JUMPE	S1,CHGUS3		;continue with source when null seen
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;save in new file spec
	JRST	CHGUS2			;and look for more
CHGUS3:					;here to put right angle bracket in
	SOJL	T3,SWILL		;limit test
	MOVEI	S1,76			;get right angle bracket
	IDPB	S1,T2			;store in destination
CHGUS4:					;loop to copy rest of source
	ILDB	S1,S2			;get another source byte
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;stash it
	JUMPN	S1,CHGUS4		;if not done, go do another
CHGCOM:					;common exit for change routines
	HRRZI	T2,1(T2)		;point to word after last byte
	SUBI	T2,FDBARE		;length of entry
	HRLM	T2,FDBARE		;and store as FDB length
	MOVEI	S1,FDBARE		;point to new entry
	$CALL	INSENT			;stash it
	JUMPT	.POPJ			;if it succeeds, exit
	$CALL	RDQUE			;replace with old queue entry
	$RETT				;and exit

CHGNAM:					;subroutine to put request name in file
	$SAVE	<S1,S2,T1,T2,T3,P1>	;save some registers
	MOVEI	P1,1(S1)		;get address of request name
	HRLI	P1,440600		;make into SIXBIT byte pointer
	MOVEI	T2,.QCFIL		;code for file block
	$CALL	FNDENT			;get its address
	JUMPF	SWILL			;illformed switch entry block
	MOVE	S2,0(S1)		;get first word of entry
	MOVEM	S2,FDBARE		;save it
	MOVEI	S2,1(S1)		;point to source string
	HRLI	S2,440700		; as ASCII byte pointer
	MOVE	T2,[POINT 7,FDBARE+1]	;point to destination string as ASCII byte pointer
	MOVEI	T3,<FDXSIZ-1>*5		;limit of staging area
CHGNA6:					;[4(256)] loop to copy thru LOGNAM:
	SOJL	T3,SWILL		;limit test
	ILDB	S1,S2
	JUMPE	S1,SWILL		;illform test
	IDPB	S1,T2			;copy byte
	CAIE	S1,":"
	JRST	CHGNA6			;loop 'til we've found the colon
	MOVE	S1,S2
	ILDB	S1,S1			;got colon, look at next byte.
	CAIE	S1,74			;directory ?
	JRST	CHGNA7			;no, go on to file name

CHGNA0:					;loop to copy through user
	ILDB	S1,S2			;get byte
	JUMPE	S1,SWILL		;illform test
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;put byte
	CAIE	S1,76			;if right angle bracket, skip
	JRST	CHGNA0			;else just get another character
CHGNA7:	MOVEI	T1,6			;max characters to get
CHGNA1:					;loop copying name characters in
	ILDB	S1,P1			;get SIXBIT character
	JUMPE	S1,CHGNA5		;stop on blank
	ADDI	S1,40			;make into ASCII
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;store in destination
	SOJG	T1,CHGNA1		; and continue
CHGNA5:	ILDB	S1,S2			;scan for extension
	JUMPE	S1,SWILL
	CAIE	S1,"."
	JRST	CHGNA5
	SKIPA	T1,[4]			;copy . + 3 character extension
CHGNA3:	ILDB	S1,S2			;copy rest of file-spec
	JUMPE	S1,CHGNAX		;check for end
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2
	SOJG	T1,CHGNA3
CHGNAX:	SETZ	S1,			;stuff a null byte
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2
	JRST	CHGCOM

CHGSTR:					;change structure part of TOPS20 name
					;subroutine to put LSTR in file
	$SAVE	<S1,S2,T1,T2,T3,P1>	;save some registers
	MOVEI	P1,1(S1)		;get address of LSTR
	$CALL	CHGSTI			;mumble
	JUMPF	SWILL			;illformed switch entry block
	MOVEI	T1,6			;max characters to get

CHGST0:					;loop copying name characters in
	ILDB	S1,P1			;get SIXBIT character
	JUMPE	S1,CHGST1		;stop on blank
	ADDI	S1,40			;convert to ASCII
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;store into destination
	SOJG	T1,CHGST0		;and continue
CHGST1:	MOVEI	S1,":"			;add in colon for structure
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;stuff it
	MOVEI	T1,^D39			;field scan limit
CHGST4:	ILDB	S1,S2			;[4(257)] skip over structure of source
	SOJL	T1,SWILL		;field limit test
	CAIE	S1,":"			;[4(257)] looking for colon
	JRST	CHGST4			;[4(257)] keep looking until found
CHGST2:	ILDB	S1,S2			;copy rest of file-spec
	SOJL	T3,SWILL		;limit test
	IDPB	S1,T2			;stuff it
	JUMPN	S1,CHGST2		;loop 'til done
	JRST	CHGCOM			;branch to common routine

RCHSTR:	$SAVE	<S1,S2,T1,T2,P1>	;map structure back to D60:
	$CALL	CHGSTI			;mumble
	JUMPF	SWILL			;illformed switch entry block
	MOVE	P1,[POINT 7,IBMDEV]
RCHST1:	ILDB	S1,P1			;copy system logical name to fd
	JUMPE	S1,CHGST1
	SOJL	T3,SWILL
	IDPB	S1,T2
	JRST	RCHST1

RELSTR:	$SAVE	<S1,S2,T1,T2,P1>	;map structure to real structure of D60:
	HRROI	S1,IBMDEV		;first get D60 device designator
	STDEV
	ERJMP	SWILL
	MOVE	S1,[POINT 7,REALST]	;now get the inverse which will be the
	DEVST				; real structure
	ERJMP	SWILL
	SETZ	P1,			;stash a null byte
	IDPB	P1,S1
	$CALL	CHGSTI			;now work into main stream
	JUMPF	SWILL
	MOVE	P1,[POINT 7,REALST]
	JRST	RCHST1

CHGSTI:	HRLI	P1,440600		;make into SIXBIT byte pointer
	MOVEI	T2,.QCFIL		;code for file block
	$CALL	FNDENT			;get its address
	JUMPF	.POPJ			;illformed switch entry block
	MOVE	S2,0(S1)		;get first word of entry
	MOVEM	S2,FDBARE		;save it
	MOVEI	S2,1(S1)		;point to source string
	HRLI	S2,440700		; as ASCII byte pointer
	MOVE	T2,[POINT 7,FDBARE+1]	;point to destination string
	MOVEI	T3,<FDXSIZ-1>*5		;limit of staging area
	$RETT
    >;End if TOPS20


SWILL:					;here if switch entry is crufty
	$RETF
SUBTTL Subroutines -- . MISLP, sleep for specified time

; Routine - MISLP
;
; Function - sleep for a specified amount of time
;
; Parameters - S1/no. of seconds
;
; RETURNS - TRUE always

MISLP:	IMULI	S1,3			;sleep for a while in spite of interrupts
	PUSH	P,S1
	$CALL	I%NOW			; get now
	ADDM	S1,(P)			; keep wake time on pdl
MISLP1:	$CALL	I%NOW			; get new now
	SUB	S1,(P)			; find out how long to go
	MOVNS	S1			; forwards
	JUMPLE	S1,MISLPX		; done
	IDIVI	S1,3			; make seconds
	SKIPE	S2
	AOS	S1			; at least 1
	$CALL	I%SLP			; try to sleep the whole time
	JRST	MISLP1
MISLPX:	POP	P,S1			; time to awake
	$RETT
	SUBTTL Subrouines  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	T1,IBMSTM		;Get the address of message
	MOVEI	S2,MSHSIZ+1		;And the length
	$CALL	SNDQSR			;Send it off to QUASAR
> ;End of FTIBMS
	$RET				;Pass any errors up
	SUBTTL Subroutines ACTINI, IACTBG, OACTBG, IACTND, OACTND

; Routine to set up data for usage accounting
; This routine gathers all the accounting entry header info
; and stores it in the static data base area.
FTACCT<
ACTINI:	MOVX	S1,-1			;yes, -1 For us
	MOVX	S2,JI.JNO		;Function code
	$CALL	I%JINF			;Get our job number
	MOVEM	S2,L.JOB		;Store it
	$CALL	I%HOST			;get the host name
	MOVEM	S1,L.NODE		;put it away
	MOVEM	S2,NODNUM		;and the node number
	MOVX	S1,-1			;set up to
	MOVX	S2,JI.TNO		;get the tty number
	$CALL	I%JINF			;go get it
	MOVEM	S2,L.LINE		;save the line number
TOPS10	<				;TOPS-10 only
	MOVE	S1,[ASCII/D/]		;default to detached
	MOVEM	S1,L.TTY		;save the designator
	GETLCH	S2			;get our line characteristics
	SKIPN	S2			;are we detached?
	 POPJ	P,			;yes, all done, return to caller
	MOVE	TF,[ASCII/T/]		;default to a TTY
	TXNE	S2,GL.ITY		;are we a PTY ???
	MOVE	TF,[ASCII/P/]		;yes,,make us 'PTY'
	TXNE	S2,GL.CTY		;are we the CTY ???
	MOVE	TF,[ASCII/C/]		;yes,,make us 'CTY'
	MOVEM	TF,L.TTY		;save the terminal designator
	POPJ	P,			;return
>					;end of TOPS-10 conditional
TOPS20	<				;TOPS-20 only
	MOVE	S1,[ASCII/D/]		;default to detached
	MOVEM	S1,L.TTY		;save the designator
	GJINF				;go get the job info
	CAMN	T2,[-1]			;are we detached?
	 POPJ	P,			;yes, all done, return to caller
	MOVEI	S1,.PRIOU		;no,  point at our primary output jfn
	DVCHR				;ask the monitor
	MOVE	TF,[ASCII/T/]		;default to a TTY
	LDB	S1,[POINT 9,S2,17]	;get device type field
	CAIE	S1,.DVTTY		;is it a TTY?
	MOVE	TF,[ASCII/P/]		;no, make us 'PTY'
	CAIE	S1,.DVPTY		;is it a PTY?
	MOVE	TF,[ASCII/U/]		;no, make us 'UNKNOWN'
	MOVEM	TF,L.TTY		;save the terminal designator
	POPJ	P,			;return
>					;end of TOPS-20 conditional
; IACTBG and OACTBG are the routines called when we are
; beginning a new job. These routines remember all the values
; needed to write the accounting entry. They store the values in
; the TASK BLOCK which is pointed to by TK

IACTBG:	LOAD	S1,.EQSEQ(J),EQ.SEQ	;get sequence number
	STORE	S1,,T.SEQ		;store it
	LOAD	S1,.EQSEQ(J),EQ.PRI	;get external priority
	STORE	S1,,T.PRI		;store it
	$CALL	I%NOW			;get the time
	STORE	S1,,T.STM		;and put it away
	MOVE	S1,.EQOID(J)		;get the PPN
	MOVEM	S1,ACTPNM		;save it for DOFACT
	POPJ	P,			;return

OACTBG:	$CALL	I%NOW			;get the time
	STORE	S1,,T.STM		;and put it away
	LOAD	S1,,T.TYP		;get device number
	MOVE	S1,TSKDEV(S1)		;get device name
	STORE	S1,,T.QNM		;save for ACTEND
	LOAD	S1,,L.NAM		;get the SIXBIT staion name
	STORE	S1,,T.PDV		;store it as device name
	POPJ	P,			;nothing else to do
; These routines gather all the information which is
; needed to make the USAGE entry.
;
;	Arguments: S1 contains the ACTLST pointer
;
;	Returns nothing
;

IACTND:	SKIPN	S2,DEBUGW		;[361] Check if debug switch on.
	LOAD	S2,.EQSEQ(J),EQ.IAS	;GET THE INVALID ACCT STRING BIT
	JUMPN	S2,.RETT		;IF LIT,,THEN JUST RETURN
	MOVX	S2,'NORMAL'		;ASSUME NORMAL DISPOSITION
	TXNE	S,RQB			;REQUED?
	MOVX	S2,'REQUED'		;YES
	TXNE	S,ABORT			;ABORTED?
	MOVX	S2,'CANCEL'
	STORE	S2,T$DSP		;STORE DISPOSITION
	MOVE	S2,[XWD IACTLN,IACTLS]	;point at the list
	JRST	WRTUSG			;now, go write the entry
OACTND:				;here to check for PNAME (user)
	SETZM	ACTPNM			;clear the first
TOPS20 <MOVE	T1,[ACTPNM,,ACTPNM+1]	;set up for the rest
	BLT	T1,ACTPNM+10-1>		;clear the rest
TOPS10 <MOVEI	T2,.QCOID>		;code for TOPS-10 PPN
TOPS20 <MOVEI	T2,.QCNAM>		;code for TOPS-20 user name
	$CALL	FNDENT			;see if one was supplied
	SKIPF				;no, skip this
	PUSHJ	P,STONAM		;yes, store it away
	SETZM	ACTACT			;clear the first word of the
	MOVE	T1,[ACTACT,,ACTACT+1]	;account string, set up for the rest
	BLT	T1,ACTACT+10-1		;clear the rest
	MOVEI	T2,.QCACT		;here to check for an account string
	$CALL	FNDENT			;see if one was supplied
	SKIPF				;no, go on
	PUSHJ	P,STOACT		;yes, store that away too
	MOVEI	T2,.QCNOD		;find the destination node
	$CALL	FNDENT			;if one was supplied
	SKIPF				;none, go on
	PUSHJ	P,STONOD		;yes, store it
	MOVEI	T2,.QCJBN		;identifier for LNAME info
	$CALL	FNDENT			;search for it
	SKIPF				;not there, so skip replacement
	PUSHJ	P,STOFNM		;store away too
	MOVEI	T2,.QCODP		;find LDISP
	$CALL	FNDENT			;disposition block
	SKIPF				;if none, check other switch values
	PUSHJ	P,STODSP		;store it
	MOVEI	T2,.QCFRM		;find LFORM
	$CALL	FNDENT			;block, if supplied
	SKIPF				;none
	PUSHJ	P,STOFRM		;store it
	MOVEI	T2,.IBMST		;code for /LSTR
	$CALL	FNDENT			;see if structure present
	SKIPF				;no, skip processing
	PUSHJ	P,STOSTR		;store it
	MOVE	S2,[XWD OACTLN,OACTLS]	;point at the list
	JRST	WRTUSG			;now go write the entry
STONAM:
TOPS10<	MOVE	T2,1(S1)		;get PPN
	MOVEM	T2,ACTPNM		;save it
	POPJ	P,			;return
>; End of TOPS10 conditional
TOPS20<	MOVE	T1,0(S1)		;get the header word
	HLRZS	T1			;get length alone
	AOS	S1			;get by pointer word
	HRLZ	T2,S1			;get the source address
	HRRI	T2,ACTPNM		;get the destination address
	BLT	T2,ACTPNM(T1)		;move it!
	POPJ	P,			;return
>; End of TOPS20 conditional

STOACT:	MOVE	T1,0(S1)		;get the header word
	HLRZS	T1			;get length alone
	AOS	S1			;get by pointer word
	HRLZ	T2,S1			;get the source address
	HRRI	T2,ACTACT		;get the destination address
	BLT	T2,ACTACT(T1)		;move it!
	POPJ	P,			;return

STONOD:	MOVE	T2,1(S1)		;get node name
	STORE	T2,,T.NOD		;store it
	POPJ	P,			;return

STOFNM:	MOVE	T2,1(S1)		;get file name
	STORE	T2,,T.LNM		;store it
	POPJ	P,			;return

STODSP:	MOVE	T2,1(S1)		;get disposition
	MOVE	T1,[SIXBIT/HOLD/]	;make one up
	CAIE	T2,0			;is it?
	MOVE	T1,[SIXBIT/DELETE/]	;no, it must be this
	STORE	T1,,T.DSP		;store it
	POPJ	P,			;return

STOFRM:	MOVE	T2,1(S1)		;get forms type
	STORE	T2,,T.FRM		;save it
	POPJ	P,			;return

STOSTR:	MOVE	T2,1(S1)		;get structure name
	STORE	T2,,T.STR		;save it
	POPJ	P,			;return


TOPS10 <
WRTUSG:	SKIPE DEBUGW			;[361] If debug switch set
	POPJ P,				;[361] forget the accounting.
IFE FTDEBUG,<				;[353] Same goes if feature test debug
	QUEUE.	S2,			;MAKE A USAGE ENTRY
	 PUSHJ	P,ACTE.1		;FAILED,,TELL OPR

;This routine is called to make FACT entrys on a TOPS10 system

FACT<
DOFACT:	MOVE	T1,NODNUM		;get octal node number
	HRLZM	T1,FACTBL+3		;STORE NODE NUMBER NOW
	MOVE	S1,L.LINE		;GET LINE NUMBER
	LDB	S2,[POINT 7,L.TTY,6]	;GET TERMINAL DESIGNATOR
	CAIN	S2,"C"			;ON THE CTY
	MOVEI	S1,7777			;YES, CTY DESIGNATOR
	CAIN	S2,"D"			;DETACHED
	MOVEI	S1,7776			;YES, FLAG THAT INSTEAD OF LINE NUMBER
	LSH	S1,6			;PUT IN BITS 18-29
	HRL	S1,L.JOB		;INSERT JOB NUMBER
	IOR	S1,[251000,,13]		;ADD FACT TYPE AND NUMBER OF WORDS
	MOVEM	S1,FACTBL+0		;STORE IN BLOCK
	MOVE	S1,ACTPNM		;GET PPN
	MOVEM	S1,FACTBL+1		;STORE
	SETZM	FACTBL+2		;DAEMON FILLS IN THE DATE/TIME
	MOVE	S1,[%CNSER]		;CPU SERIAL NUMBER
	GETTAB	S1,			;ASK FOR IT
	  SETZ	S1,			;USE 0 IF CAN'T FIND IT
	LOAD	S1,,T.QNM		;[354] Get the queue name
	TLZ	S2,77			;CLEAR JUNK
	IOR	S1,S2			;INSERT QUEUE NAME
	IORM	S1,FACTBL+3		;NODE NUMBER ALREADY STORED FROM ABOVE
	SETZM	FACTBL+4		;no runtime
	SETZM	FACTBL+5		;no core time intergral
	SETZM	FACTBL+6		;no disk reads
	SETZM	FACTBL+7		;no disk writes
	MOVE	S1,[SIXBIT /IBM   /]	;Make up a device name
	MOVEM	S1,FACTBL+10		;store it
	LOAD	S1,,T.SEQ		;[354] Sequence number
	MOVEM	S1,FACTBL+11		;STORE
	LOAD	S1,,T.NRS		;[354] Number of units processed
	MOVEM	S1,FACTBL+12		;STORE
	MOVE	S1,[14,,FACTBL-1]	;DAEMON ARGUMENT
	DAEMON	S1,			;MAKE THE FACT ENTRY
	  JRST	ACTE.1			;REPORT THE FAILURE
> ;END FACT ACCOUNTING

; At DOFACT+38. lines.  SPR 10-34279.  GKN

> ;[353] End IFE FTDEBUG

	POPJ	P,			;did it!

> ;End of TOPS10 conditional

TOPS20<
WRTUSG:	MOVX	S1,.USENT		;WRITE AN ENTRY
	HRRZS	S2			;Clear the left half
	USAGE				;DO THE JSYS
	  ERJMP	ACTE.2			;ON AN ERROR,,TELL THE OPERATOR
	POPJ	P,			;did it!

ACTE.2:	HRLZI	S1,.FHSLF		;get the process handle
	GETER				;get the last error code
	HRRZI	S2,S2			;get the code alone
> ;end TOPS20 conditional
ACTE.1:	$WTO	 (System Accounting Failure -- Error Code: ^O/S2/)
	POPJ	P,     			;RETURN

;Table of device names we can handle

TSKDEV:	SIXBIT /CTL   /
	SIXBIT /LPT   /
	SIXBIT /CDP   /
	SIXBIT /CDR   /
	SIXBIT /CON   /
	SIXBIT /CON   /
	SIXBIT /SND   /
SUBTTL	--  ACTLST - Usage Accounting Data

;INPUT accounting data

IACTLS:	USENT.	(.UTINP,1,1,0)
	USJNO.	(L.JOB)			;JOB NUMBER
	USTAD.	(-1)			;CURRENT DATE/TIME
	USTRM.	(L.TTY)			;TERMINAL DESIGNATOR
	USLNO.	(L.LINE)		;TTY LINE NUMBER
	USPNM.	(<'IBMSPL'>,US%IMM)	;PROGRAM NAME
	USPVR.	(%%.IBM,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(L.NODE)		;NODE NAME

TOPS10<	USIAC.	(<POINT 7,.EQACT(J)>)	;ACCOUNT STRING POINTER
	USIRN.	(0,US%IMM)		;RUN TIME
	USICT.	(0,US%IMM)		;CORE-TIME INTERGRAL
	USIDR.	(0,US%IMM)		;DISK READS
	USIDW.	(0,US%IMM)		;DISK WRITES
	USIJN.	(.EQJOB(J))		;JOB NAME
	USIQN.	(<'INP   '>,US%IMM)	;QUEUE NAME
	USIPD.	(<SIXBIT/IBM/>,US%IMM)	;DEVICE NAME
	USISN.	(T$SEQ(TK))		;JOB SEQUENCE NUMBER
	USICR.	(T$ICT(TK))		;TOTAL CARDS READ
	USSNF.	(T$NFP(TK))		;NUMBER OF FILES PROCESSED
	USICD.	(.EQAFT(J))		;CREATION DATE/TIME OF REQUEST
	USIDS.	(<'BATCH '>,US%IMM)	;DISPOSITION
	USIPR.	(T$PRI(TK))		;JOB PRIORITY
	USIRI.	(.EQRID(J))		;USER REQUEST ID
	USTXT.	(<[ASCIZ / /]>)		;[355] System text
	USICN.	(0,US%IMM)		;CONNECT TIME
	USPPN.	(.EQOID(J))		;USER PPN
	USNM1.	(.EQOWN(J))		;USER NAME WORD 1 (TOPS10)
	USNM3.	(.EQOWN+1(J))		;USER NAME WORD 2 (TOPS10)
IACTLN==.-IACTLS			;ACCOUNTING BLOCK LENGTH
> ;END OF TOPS-10 CONDITIONAL

TOPS20<	USACT.	(<POINT 7,.EQACT(J)>)	;ACCOUNT STRING POINTER
	USSRT.	(0,US%IMM)		;RUN TIME
	USSDR.	(0,US%IMM)		;DISK READS
	USSDW.	(0,US%IMM)		;DISK WRITES
	USJNM.	(.EQJOB(J))		;JOB NAME
	USQNM.	(<'INP   '>,US%IMM)	;QUEUE NAME
	USSDV.	(<SIXBIT/IBM/>,US%IMM)	;DEVICE NAME
	USSSN.	(T$SEQ(TK))		;JOB SEQUENCE NUMBER
	USSUN.	(T$ICT(TK))		;TOTAL CARDS READ
	USSNF.	(T$NFP(TK))		;NUMBER OF FILES PROCESSED
	USCRT.	(.EQAFT(J))		;CREATION DATE/TIME OF REQUEST
	USDSP.	(<'BATCH '>,US%IMM)	;DISPOSITION
	USPRI.	(T$PRI(TK))		;JOB PRIORITY
	USCCT.	(0,US%IMM)		;CONNECT TIME
	USTXT.	(<[ASCIZ / /]>)		;[355] System text
	USNM2.	(<POINT 7,.EQOWN(J)>)	;USER NAME (TOPS20)
	0				;END OF LIST
IACTLN==.-IACTLS			;ACCOUNTING BLOCK LENGTH
> ;END OT TOPS-20 CONDITIONAL
;OUTPUT accounting data

OACTLS:	USENT.	(.UTOUT,1,1,0)
	USJNO.	(L.JOB)			;JOB NUMBER
	USTAD.	(-1)			;CURRENT DATE/TIME
	USTRM.	(L.TTY)			;TERMINAL DESIGNATOR
	USLNO.	(L.LINE)		;TTY LINE NUMBER
	USPNM.	(<SIXBIT/IBMSPL/>,US%IMM) ;PROGRAM NAME
	USPVR.	(%%.IBM,US%IMM)		;PROGRAM VERSION
	USAMV.	(-1)			;ACCOUNTING MODULE VERSION
	USNOD.	(L.NODE)		;NODE NAME
	USACT.	(<POINT 7,ACTACT>)	;ACCOUNT STRING POINTER
	USSRT.	(0,US%IMM)		;RUN TIME
	USSDR.	(0,US%IMM)		;DISK READS
	USSDW.	(0,US%IMM)		;DISK WRITES
	USJNM.	(T$LNM(TK))		;JOB NAME
	USQNM.	(T$QNM(TK))		;QUEUE NAME
	USSDV.	(T$PDV(TK))		;DEVICE NAME
	USSSN.	(0,US%IMM)		;JOB SEQUENCE NUMBER
	USSUN.	(T$OCT(TK))		;total units processed
	USSNF.	(T$NFP(TK))		;TOTAL FILES processed
	USCRT.	(T$STM(TK))		;CREATION DATE/TIME OF REQUEST
	USSCD.	(T$STM(TK))		;SCHEDULED DATE/TIME
	USFRM.	(T$FRM(TK))		;FORMS TYPE
	USDSP.	(T$DSP(TK))		;REQUEST DISPOSITION
	USPRI.	(0,US%IMM)		;JOB PRIORITY
	USORI.	(0,US%IMM)		;USER REQUEST ID
	USOCN.	(0,US%IMM)		;CONNECT TIME
	USTXT.	(<[ASCIZ / /]>)		;[355] System text

TOPS10<					;TOPS-10 ONLY
	USPPN.	(ACTPNM)		;USER PPN
	USNM1.	(0,US%IMM)		;USER NAME 1 (TOPS10)
	USNM3.	(0,US%IMM)		;USER NAME 1 (TOPS10)
OACTLN==.-OACTLS			;LENGTH OF BLOCK
>					;END OF TOPS-10 CONDITIONAL

TOPS20<	USNM2.	(<POINT 7,ACTPNM>)	;USER NAME (TOPS20)
	0				;END OF LIST
OACTLN==.-OACTLS			;LENGTH OF BLOCK
>;END OF TOPS-20 CONDITIONAL
>;END OF FTACCT
	SUBTTL	Literals

IBMLIT:	XLIST
	LIT
	LIST
IBMEND:
	END	IBMSPL

; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Start:;
; Comment Begin:;
; Word Abbrev Mode:1
; End: