Trailing-Edge
-
PDP-10 Archives
-
BB-D351B-SM
-
sources/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
;
;
; COPYRIGHT (c) 1978, 1979, 1980
; 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......................................... 3
; 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
; 5. Symbol definitions
; 5.1 Device/task type codes............................ 8
; 5.2 Message processor status bits (in S).............. 8
; 5.3 Task status bits (in S while task is running)..... 8
; 5.4 Checkpoint request block offsets (from QUASAR).... 8
; 5.5 Create queue entry message offsets (from QUASAR).. 8
; 5.6 D60JSY interface.................................. 8
; 5.7 DN60 Port status device active bits............... 8
; 6. Macro definitions
; 6.1 $DSCHD, de-schedule a task........................ 9
; 6.2 $SIGNL, indicate wakeup condition................. 10
; 6.3 $WATCH, queue message for watchers macro.......... 11
; 6.4 SKPTSK, skip if in task context................... 11
; 6.5 D60, call D60JSY and analyze error return......... 11
; 7. Database Definitions
; 7.1 Random static storage............................. 12
; 7.2 Constant static storage........................... 13
; 7.3 IB, Initialization block for GLXLIB............... 13
; 7.4 HELLO, message for QUASAR at startup.............. 13
; 7.5 ITEXT strings..................................... 13
; 7.6 Miscellaneous cells............................... 13
; 7.7 Interrupt system database......................... 14
; 8. Dynamic storage definitions
; 8.1 Active task list (ATL) entry "A.xxx".............. 15
; 8.2 Port list entry "P.xxx"........................... 16
; 8.3 Line block list entry "L.xxx"..................... 17
; 8.4 Task block list entry "T.xxx"..................... 18
; 9. Interrupt code
; 9.1 INTINI, Interrupt system initialization........... 19
; 9.2 INTIPC, IPCF Interrupt routine.................... 19
; 10. Initialization code....................................... 20
; 11. SCHEDULER
; 11.1 MAIN loop......................................... 21
; 11.2 SCHED, Schedule a task............................ 22
; 11.3 DESCHD, Deschedule a task......................... 23
; 11.4 ACTTSK, activate a task........................... 24
; 11.5 DEATSK, Deactivate a task......................... 25
; 12. Subroutines
; 12.1 - WAKTSK, wake a task unconditionally............ 26
; 12.2 - SGNTSK, signal a task.......................... 27
; 12.3 - SGNLIN, signal all tasks on a line............. 28
; 13. TASK
; 13.1 POLL, active device signalling.................... 29
; 13.2 IPCF, message checker............................. 30
; 13.3 IPCF, message processor........................... 31
; 14. Message processors
; 14.1 Text message response............................. 32
; 14.2 SETUP, Setup/shutdown message..................... 33
; 14.3 - SETALL, setup a new station.................... 34
; 14.4 - SETTSK and SETHSP, task tables................. 35
; 14.5 - SHTALL, shutdown station (signoff)............. 36
; 14.6 USRCN, User cancel message........................ 37
; 14.7 OPRCN, Operator cancel message.................... 38
; 14.8 NXTJB, Nextjob message............................ 39
; 14.9 SHWSTS, Show status message....................... 40
; 14.10 RQCHK, Request checkpoint message................. 41
; 14.11 - CHKPNT, CHKPNB, send checkpoint................ 42
; 14.12 SNDCI, send console input to IBM.................. 43
; 15. Tasks
; 15.1 description....................................... 44
; 15.2 TKSND, console output distribution................ 45
; 15.3 TKCTL, control for 2780/3780...................... 46
; 15.4 - CTSGON, wait for signon........................ 47
; 15.5 - CTLNGN, line gone while active processing...... 48
; 15.6 TKCDR, 2780/3780 card reader...................... 49
; 15.7 - CDCNI, send console input to IBM............... 50
; 15.8 - CDJOB, send job to IBM......................... 51
; 15.9 - DOJOB, process "batch" job.................... 52
; 15.10 - FILE, copy a disk file to IBM................. 53
; 15.11 - NXTFIL, advance to next file in job........... 54
; 15.12 TKLPT, 2780/3780 line printer..................... 55
; 15.13 - LPTJOB, process printer job.................... 56
; 15.14 TKHCDR, HASP card reader.......................... 57
; 15.15 TKHCDP, HASP card punch........................... 58
; 15.16 TKHLPT, HASP line printer......................... 58
; 15.17 TKHCNI, HASP console input to IBM................. 59
; 15.18 TKHCNO, HASP console output from IBM.............. 60
; 16. Subroutines
; 16.1 Initialization and Main Loop subroutines.......... 61
; 16.2 - OPDINI, Get operating system information....... 61
; 16.3 IPCF message subroutines.......................... 62
; 16.4 - SNDQSR, send a message to QUASAR............... 62
; 16.5 - SNDBAK, IPCF reply to last sender.............. 63
; 16.6 - RSETUP, response to setup (to QUASAR).......... 64
; 16.7 - QRLSE, requeue/release (to QUASAR)............. 65
; 16.8 - INIPAG, set up job pages....................... 66
; 16.9 - Queue create message handling.................. 67
; 16.10 - INIQRQ, Initialize queue request to default... 67
; 16.11 - INSENT, Insert entry.......................... 68
; 16.12 - FNDENT, Find entry............................ 69
; 16.13 Task control subroutines.......................... 71
; 16.14 - MAKLB, create line block....................... 71
; 16.15 - BLDTSK, create task............................ 72
; 16.16 - RELTKB, release task block..................... 73
; 16.17 - BUFSZ, calculate task's buffer size............ 74
; 16.18 - RELLB, delete a line block..................... 75
; 16.19 Search subroutines................................ 76
; 16.20 - FNDPOR, Find port block........................ 76
; 16.21 - FNDLB, Find line block......................... 77
; 16.22 - FNDNOD, Find line block for a node............. 78
; 16.23 - FNDTSK, Find task from port,line,dev,unit...... 79
; 16.24 - TSKCUR, Make TK value current entry............ 80
; 16.25 - FNDOBJ, Find task from QUASAR object block..... 81
; 16.26 I/O subroutines................................... 82
; 16.27 - LOGCHR, put character in log................... 82
; 16.28 - LOGBUF, get another log buffer................. 83
; 16.29 - COPY, copy a file.............................. 84
; 16.30 - GETDSK, read a record from disk................ 85
; 16.31 - GETIBM, read a record from DN60................ 86
; 16.32 - PUTDSK, write a record to disk................. 87
; 16.33 - PUTIBM, write a record to DN60................. 88
; 16.34 - PUTCNO, put a record into CNO queue............ 89
; 16.35 - DEVOPN, open a D60JSY device................... 90
; 16.36 - CHKDSK, Checkpoint a disk file................. 91
; 16.37 - LINSTS, get current line status................ 92
; 16.40 - GETLNO, ensure output is possible.............. 95
; 16.41 - DISABL, routine to disable a line.............. 96
; 16.42 - SGNFIL, SGFFIL, signon/signoff file setup...... 97
; 16.43 - IBMLFR, scan incoming records.................. 98
; 16.44 - CLLUSR, pass record to user exit............... 99
; 16.45 - BLDFDB, build FD for holding files............. 100
; 16.46 Debugging subroutines............................. 101
; 16.47 - LBVER, verify LB address....................... 101
; 16.48 DISPOS, dispose of files read from IBM host....... 102
; 16.49 - SETACT, set print file account string.......... 103
; 16.50 - SETLMT, Set print file page limit.............. 104
; 17. .......................................................... 105
; 18. .......................................................... 106
; 19. .......................................................... 107
; 20. .......................................................... 108
; 21. .......................................................... 109
; 22. .......................................................... 110
; 23. .......................................................... 111
; 24. .......................................................... 112
; 25. .......................................................... 113
; 26. .......................................................... 114
; 27. .......................................................... 115
; 28. .......................................................... 116
; 29. Task scheduler blocking checker........................... 117
; 30. Externally callable task descheduler...................... 118
; 31. D60JSY error analyzer..................................... 119
; 32. .......................................................... 120
; 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
PROLOGUE (IBMSPL) ; Initialize Galaxy symbol definitions
; Version
XP IBMVER, 3 ; Major version number
XP IBMMIN, 0 ; Minor version number
XP IBMEDT, 211 ; 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,\"<"A"+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 0
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.
&
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, 0 ; Accounting
ND FTCLOG, 0 ; IBMSPL central log file
ND FTIBM, 0 ; Support for the IBM program
DEFINE FTLOG <IFN FTLOG>
DEFINE FTACCT <IFN FTACCT>
DEFINE FTCLOG <IFN FTCLOG>
DEFINE FTIBM <IFN FTIBM>
SUBTTL Symbol Definitions -- Parameters
; Parameters which may be changed at assembly time
ND PDSIZE,100 ; Size of pushdown list
IFN FTDEBUG,<
ND TKPDLN,170 ; Bigger stack if debugging
>;End if FTDEBUG
ND TKPDLN,70 ; 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,^d2 ; Number of desched checks before a
; task will for forced to deschedule
ND PATPLN,^d250 ; Length of stack for pattern matching
; 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,^D6 ; Polling interval, in UDT units
XP SGNINT,^D60*^D3*^D5 ; 5 minutes for signon to happen
SUBTTL Symbol Definitions -- External symbol definitions
EXTERNAL D60INI,D60OPN,D60SIN ; D60JSY routines
EXTERNAL D60SOU,D60EOF,D60STS
EXTERNAL D60RLS,D60OPR,D60CND
EXTERNAL D60DIS
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)
NODEL==1B10 ; INSENT should not replace an already
; existing entry of the same type
HASP==1B11 ; We are doing hasp
FLSH==1B12 ; We are flushing input before signalling EOF
CHKLOG==1B13 ; Check for console output in IBM 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
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 -- D60JSY interface
; Error codes
DEFINE ERRS(SYM,TXT) <
SYM=ZZ
ZZ==ZZ+1
>;End DEFINE ERRS
ZZ==660000
D60ERR ; Invoke error definitions
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
SETZM 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
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) <
XLIST
CAIA
JRST .+3
MOVEI TF,FNC
PUSHJ P,[PUSH P,[EXP D60ANL]
IFN FTDEBUG,<
MOVEM TF,LSTD60 ;; Save PC of last call in case of trap
>;End if FTDEBUG
JRST @TF]
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
CURATE: BLOCK 1 ; Address of current Active Task List entry
SCHDGO: BLOCK 1 ; If non-zero, do another scheduling pass
; 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
FDBARE: BLOCK FDXSIZ ; Maximum area for file name
; File rename block
FRB: BLOCK FRB.SZ ; Maximum size
LOWEND==. ; End of zeroed area plus 1
; 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 5,0 ; Length
SGNFSP: BLOCK 4 ; Reserve at most 20 characters
>;End if TOPS20
PDLSAV: BLOCK 1 ; Temporary storage for stack pointer
PDL: BLOCK PDSIZE ; Stack for MAIN context
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
$SET (HEL.OB,,.OTIBM) ; Object
$EOB
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
; 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 Database Definitions -- Miscellaneous cells
WTORNM: EXP 5000 ; ACK code to usr for WTOR (incremented)
; 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
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 !
; !-------------------------------------------------------!
; ! 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 !
; !-------------------------------------------------------!
; ! 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 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 !
; !=======================================================!
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
$. 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
$ 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
$ 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
$ 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
$
$ 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
D60 D60INI ; Initialize interface to DN60
$CALL INTINI ; Initialize interrupt system
$CALL OPDINI ; Get operating system information
$CALL I%ION ; Turn on interrupts
MOVEI T1,HELLO ; Point to "hello" message
$CALL SNDQSR ; and send it to QUASAR
$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
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: HRLOI S1,377777 ; Get maximum positive value
MOVEM S1,POLTIM ; Save as next time to poll
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
MAIN.1: SETZM SCHDGO ; Clear scheduling pass flag
HRLOI S1,377777 ; Get maximum positive value
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
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
CAML S1,POLTIM ; Check if polling should be next
MOVE S1,POLTIM ; Yes .. min time is for POLL
SUB S1,NOW ; Calculate time to sleep
ADDI S1,2 ; in seconds, insuring
IDIVI S1,3 ; at least one second sleep
CAIL S1,^d60 ; Check for greater than 1 minute
MOVX S1,^d60 ; Yes .. limit to 1 minute max
$CALL I%SLP ; Go to sleep
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
CAML S1,WAKTIM ; Check if time for scheduling pass
JRST MAIN.1 ; Yes .. go execute tasks
JRST MAIN.3 ; No .. just go check IPCF and POLL
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
STORE T2,,T.WCN ; Save event flags causing wakeup
ANDCM T1,T2 ; Clear events causing wakeup
STORE T1,,A.WKB ; Save events yet to be woken on
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 and trys to reschedule the task by using the SCHED
; co-routine. If the task can't be rescheduled, the MAIN context
; is re-invoked.
;
; 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: JUMPE TK,[MOVE P,PDLSAV ; If task deleted itself
SETZM CURATE ; Yes .. reset from task context
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
$RET] ; Return to main context
MOVEM TF,T%STS ; Save wakeup status flags
TXNE TF,(TW.IOD) ; Check for I/O wait
SETZM POLTIM ; Yes .. force poll task to run
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
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save what time it is
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
ZERO ,A.WKT ; Clear time to wake up at
LOAD T1,,T.WKD ; Get wakeup time delay
JUMPE T1,SCHED ; If none, go try to SCHED on events
ADD T1,NOW ; Get time when to wake task
STORE T1,,A.WKT ; Save for SCHED
PJRST SCHED ; Go try to re-schedule this task
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: $STOP TNE,<Task not active>
SUBTTL Subroutines -- - 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: $STOP CAT,<Cannot activate task>
SUBTTL Subroutines -- - 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,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
SETOM SCHDGO ; Force another scheduler pass
$RETT ; Return true
SUBTTL Subroutines -- - 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 TASK -- 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 POLNON ; No, so don't bother checking
$CALL L%FIRST ; Yes, point to first entry
JUMPF POLNON ; If none, skip activity checking
; Loop to look at each port
POLL0: JUMPF POLLEX ; Exit loop if no entry
MOVE P1,S2 ; Get pointer to port entry
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 ; Get status
JUMPF POLLER ; If it failed, go analyze why
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
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,NOW ; Save it
ADDI S1,POLINT ; Add polling interval
MOVEM S1,POLTIM ; to make new poll time
$RETT ; Return to MAIN context
; Reading port status failed
POLLER: LOAD LB,,P.FLB ; Get first line on port
POLLE1: $SIGNL TW.LGN,LINE ; Let all tasks know line went away
LOAD LB,,L.PFW ; Get next line entry
JUMPN LB,POLLE1 ; If there was one, mark it down too
JRST POLL0E ; and on to the next port
; No ports to poll
POLNON: HRLOI S1,377777 ; Get largest number possible
MOVEM S1,POLTIM ; Set poll time to then
$RETT ; Return to MAIN context
SUBTTL TASK -- IPCF, 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
SKIPE MDBADR ; Check for message still around
$CALL C%REL ; Yes .. release it
SETZM MDBADR ; Clear messgae block address
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
JRST MSGCHK ; Go onto next message
SUBTTL TASK -- 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
TXNN S2,SI.FLG ; Are we using special system index?
JRST MSGPR1 ; No, don't check from whom
TXO S,F.IPCSY ; Indicate we have a system message
ANDX S2,SI.IDX ; Leave only the index
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
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 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 <Bad IPCF message>,<Message type ^O/S1/ not allowed 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 0,.QOREQ ; Requeue message
NMSGT==.-MSGTAB ; Size of table
SUBTTL Message processors -- Text message response
; Routine - TEXTMS
;
; Function - To send a text IPCF message that IBMSPL has received to
; OPR.
TEXTMS: XWD TEXTM1,TEXTM1
TEXTM1: $WTOJ <Bad IPCF message>,<IBMSPL IPCF error message: ^T/.OHDRS+ARG.DA(P1)/>,OBJBLK
$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.
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 SETSN1 ; If we can't, send error to QUASAR
MOVEI S1,0(P1) ; Get address of setup message
$CALL D60CND ; Condition the line to what is needed
JUMPF SETSN1 ; Couldn't condition line .. fail
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
MOVE T1,[XWD -SETTKN,SETTSK] ; Default to 2780/3780 task table
TXNE S,F.HASP ; See if HASP line
MOVE T1,[XWD -SETHSN,SETHSP] ; Yes, get HASP task table instead
; 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, skip response till 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
CAIE P2,%RSUOK ; Was it all right?
JRST SHTALL ; No, 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
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 -
;
; P3/ Port,,line
; P4/ Dev,,unit
; Here to shutdown all (signoff)
SHTALL: JUMPE LB,SHTERR ; If no line block, stop
PUSH P,TK ; Save our entry task block
$CALL LINSTS ; Get best line status
JUMPF SHTAL0 ; If error, assume line is down
SETCMM S2 ; Ones complement all the bits
TXNE S2,L.UP!L.SND ; If line is up and signed on
CAIA ; No .. shutdown immediate
JRST SHTALD ; Do delayed signoff
; Here to do shutdown right away
SHTAL0: SETZ TK, ; Zero task pointer
PUSH P,TK ; Push zero on stack to flag end
LOAD TK,,L.FTK ; Get control task's TKB
JUMPE TK,SHTAL2 ; If none, just release line block
; Loop to release tasks
SHTAL1: CAMN TK,-1(P) ; About to free entry task block?
MOVEM TK,0(P) ; Yes, flag it
LOAD T1,,T.PFW ; Get address of next TKB in chain
$CALL RELTKB ; Release this one
MOVE TK,T1 ; Get next one into proper register
JUMPN TK,SHTAL1 ; and if there was next one, release it
; Here to release line block
SHTAL2: $CALL RELLB ; Release line block too
POP P,TK ; Get "last freed" 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
$SIGNL TW.SFR,TASK ; Wake him to do signoff
SETZ TK, ; Indicate we didn't delete ourselves
; Here to exit from shutdown
SHTEXT: POP P,S1 ; Get entry task block
EXCH S1,TK ; Swap with last deleted one
SKPTSK ; Skip if from task context
$RET ; Exit via return to msgprc
CAME S1,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: $STOP DNA,<QUASAR Shutting down inactive device>
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.
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
LOAD S,S+T%ACS ; Get S
TXOE S,GOODBY!ABORT ; Set abort and end processing bits
$RET ; If already on, ignore request
; TXNE S,DSKOPN ; See if disk is being read
; $CALL INPFEF ; Yes, force input end of file
STORE S,S+T%ACS ; Put back updated status bits
$CALL WAKTSK ; Wake up task unconditionally
$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.
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
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
$TEXT (LOGCHR,<^I/IBMSG/Job cancelled by operator>)
$WTOJ <Cancelling>,<^R/.EQJBB(J)/>,@T%OBA
$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.
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
LOAD S,S+T%ACS ; Get task status bits
TXOE S,QSRREQ ; Indicate we have a request
$STOP MRR,<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>,<Cannot find object block>,@T%OBA
$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.
VSTATS: XWD SHWSTS,0 ; Only system programs for now.
SHWSTS: $SAVE <S,J,P2,LB,TK> ; Save some registers
MOVE P2,.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
MOVE LB,S2 ; Put line block addr in correct place
LOAD S2,,L.NAM ; Get name of node for this line
CAMN S2,P2 ; Check if one we are looking for
JRST SHWFND ; Yes .. found line block for node
$CALL L%NEXT ; No .. continue looking
JRST SHWLP1 ; Go check next list entry
SHWFND: $CALL M%GPAG ; Get a page for the text
MOVE P2,S1 ; Save the page address
HRLI S1,(POINT 7,) ; Make byte pointer to text buffer
MOVEM S1,TEXTBP ; Save for $TEXT processing routine
$TEXT (DEPBP,<^T/STSHDR/>^A) ; Output the status header string
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)/^T16/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
HLRZ S2,.EQSEQ(J) ; Get sequence number of job
TOPS20< $TEXT (DEPBP,<^D4/S2/ ^W9/.EQJOB(J)/^T/.EQOWN(J)/>)>
TOPS10< $TEXT (DEPBP,<^D4/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
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: TXNE S,ACTIVE ; Check for an active task
$TEXT (DEPBP,< Started at: ^H/T%TMS/ transferred ^D/T%TBC/ bytes>)
SHWTST: LOAD TK,,T.PFW ; Get next task on this line
JUMPN TK,SHWLP2 ; If there is one .. continue output
$ACK (< IBM node ^W/.OHDRS+ARG.DA+OBJ.ND(P1)/ device status >,<^T/0(P2)/>,,<.MSCOD(P1)>,<$WTFLG (WT.NFO)>)
MOVE S1,P2 ; Get message page address back
PJRST M%RPAG ; Return page to free pool
; Return to message vectoring routine
SHWER1: $ACK (<IBM node ^W/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,< Unknown node status requested>,,<.MSCOD(P1)>)
$RET
STSHDR: ASCIZ \
Device Status Seq# 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.
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
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
;
; 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: PJRST SNDQSR ; Send it to QUASAR
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.
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
LOAD LB,LB+T%ACS ; Get pointer to line block
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
HRRI S1,1(T1) ; Point to start of data part
HRLI S1,440700 ; and make it into a byte pointer
SNDCI0: ILDB S2,S1 ; Get next character
CAIE S2,"=" ; Is it colon?
JRST SNDCI0 ; No, keep looking
SNDCI1: ILDB S2,S1 ; Get next character
CAIN S2,76 ; Is it right angle bracket?
JRST SNDCI1 ; Yes, go back for more
MOVE T3,S1 ; No, save pointer to here
MOVEI T2,1 ; Initialize count of chars
JRST SNDCI3 ; and dive in with first character
SNDCI2: ILDB S2,S1 ; Get next character
SNDCI3: AOS T2 ; Count it
CAIE S2,12 ; Is it linefeed?
JRST SNDCI2 ; No, keep looking
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
LDB S1,T3 ; Get first byte of message
JRST SNDCI5 ; and dive into loop
SNDCI4: ILDB S1,T3 ; Get next character
SNDCI5: IDPB S1,S2 ; Store it in entry
SOJG T2,SNDCI4 ; Loop till no more characters left
$SIGNL TW.CNI,LINE ; and inform world its there
$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 /cannot create CNI queue entry/]
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
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,<$WTFLG (WT.NFO)>
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*5 ;get number of characters that will fit
$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
SHTALL.
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 SHTALL 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
$STOP ILW,<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
$CALL I%NOW ;get current time
ADDI S1,SGNINT ;add signon interval to it
MOVE P2,S1 ;save result
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
$CALL I%NOW ;see what time it is
CAMLE S1,P2 ;are we past signon interval?
JRST CTSFAI ;yes, say we failed
$DSCHD 0,1 ;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
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
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
$CALL GETLNO ;request output permission
JUMPF CTSFAI ;if it fails, abort
EXCH TK,T1 ;put back card reader TK
CTSGOA: ;here to store card parameters as ours
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
TXNE S,LGA ;see if line went away
JRST CTSFAI ;yes, go complain
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: ;here to check for signon
$CALL I%NOW ;get current time in S1
CAMLE S1,P2 ;past his time limit?
JRST CTSFAI ;yes, tell world that line has gone
$DSCHD 0,3 ;wait a second
$CALL LINSTS ;yes, get line status
TXNE S1,L.UP ;has "up" bit been zeroed
TXNE S,LGA ; or did D60JSY flag serious error?
JRST CTSFAI ;yes, indicate failure
TXNN S2,SLSON ;check signon bit
JRST CTSGOX ;not yet, loop
MOVE S1,P1 ;get handle
D60 D60RLS ;release signon device
CTSGO3: ;here when OK to continue
$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
LOAD S1,,L.STS ;get line status
TXO S1,L.SND ;flag that we are signed on
STORE S1,,L.STS ;restore it
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
$RET
CTSGO5: $STOP CAS,<Cannot accomplish SIGNON>
CTSGO4: $WTOJ <Signon error>,<Error "^T/@GLXERR(S1)/" opening signon file>,@T%OBA
JRST CTSFA0
; Here when line goes away
CTSFAI: $WTOJ <Line went away>,,@T%OBA
CTSFA0: 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
$CALL SHTALL ;kill all the tasks
$DSCHD DELETE ;Deschedule task forever
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
QUIESC: ;here to wait for all tasks to
; exit gracefully (i.e. DSCHD for
; neither time nor bits)
LOAD TK,,L.FTK ;point to control task (us)
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,QUIES1 ;if there, can't kill him yet
LOAD S1,,T.WKB ;get his wakeup bits
JUMPN S1,QUIES1 ;if any, also cannot wake him yet
QUIKIL: ;here to kill task
$CALL RELTKB ;release task block
JRST QUIESC ;go try for more
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
LOAD TK,,L.FTK ;point to control task (us)
$DSCHD 0,^D6 ;wait a couple of seconds
JRST QUIESC ;and try again
QUIDON: ;here when all tasks have exited
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 ;complement all but up and signed on
TXCN S1,L.UP!L.SND ;put em back and skip if not both on
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
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
LOAD S1,,T.WCN ;get wakeup conditions
JUMPN S1,CDEXT ;if any still left, go handle them
MOVEI S1,[ASCIZ /Idle/] ;display idle
STORE S1,,T.DST ; state
$DSCHD TW.QRQ!TW.CNI,1 ;wait for job or console input or both
CDEXT: 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
LOAD S1,,T.WCN ;get condition(s) which woke us
JUMPE S1,CDTURN ;if timeout, go try to turn line around
TXZE S1,TW.CNI ;if console input (which thus has priority)
JRST CDCNI ; go do it
TXZE S1,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: MOVE T1,TK ; Save task pointer
LOAD TK,,T.OTK ; Get line printer task pointer
HRRZ S1,P1+T%ACS ; Get device handle
D60 D60STS ; Get LPT status
JUMPF CDTRN1 ; If failed .. go check on CDR
TXNN S2,SDIRN!SDIPR!SDIPW ; Check for input coming
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 input complete bit
STORE S1,,T.WCN ; and put them back
JRST CDMAIN ; 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: $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 waits trying to get output
permission until it succeeds, then initializes the
transmit buffer. It sends a message to all watchers indicating
that console input is going to be sent, then loops
getting messages, sending them to watchers and putting them
into the buffer (outputting when necessary). If an error
occurs it goes to CDCNER to send message to watchers
and to flag line down. When there are no more messages
it transmits and end of file to IBM and a "sent" message
to watchers, 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
MOVE T1,S1 ;save updated wakeup conditions
; (so we know not to try more console input)
MOVEI S1,[ASCIZ /Waiting to send console input/];get state
STORE S1,,T.DST ;and make it visible
$CALL GETLNO ;get output permission
JUMPF CDCNIZ ;if we cannot do output, try input
STORE T1,,T.WCN ;store updated wakeup conditions
MOVEI S1,[ASCIZ /Sending console input/];our new state
STORE S1,,T.DST ; in the usual place
$CALL TBFINI ;initialize the buffer page pointers
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 GETCNI ;get next message
JUMPF CDCNI2 ;if none, close out file
$CALL PUTIBM ;put into buffer (and output if necessary)
JUMPT CDCNI1 ;if no error, go back for more
IFN FTDEBUG,<
CAIN S1,D6CGO
JRST CDCNIZ
CAIE S1,D6CTF ;is the error line went away?
$STOP UIE,<Unexpected error ^D/S1/>
>;end IFN FTDEBUG
CDCNER: $WATCH <Console input aborted by error>;tell watchers
JRST CDERR ;and die
CDCNI2: ;here at end of messages
TXO S,OUTEOF ;dummy up EOF for PUTIBM
SETZ T2, ;and indicate no data
$CALL PUTIBM ;force buffer out and send EOF
JUMPF CDCNER ;if error, report it
$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
MOVE T1,S1 ;copy updated wake condition bits
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
STORE T1,,T.WCN ;save updated wake condition bits
$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
JUMPT CDEXT ;if job succeeded, continue
LOAD S1,,T.GTE ;get error code for get
CAIE S1,D6CGO ;could we get output?
JRST CDEXT ;no, something else, go see if we have more work
CDJOB0: $SIGNL TW.QRQ ;wake ourselves up
JRST CDTURN ;and try to get input
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 - Preserves all AC's
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
MOVEI S1,[ASCIZ /Sending job/];our current state
STORE S1,,T.DST ; is now visible
$CALL CHKPNT ;make sure QUASAR knows it
$TEXT (LOGCHR,<^M^J^I/IBDAT/IBMSPL version ^V/[%%.IBM]/ ^T/CNF/>);put first line
; in log file
$TEXT (LOGCHR,<^I/IBDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on IBM CDR^D/T%UNI,T.UNI/ on P^O/L%PRT,L.PRT/L^O/L%LIN,L.LIN/>);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
$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
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
$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
$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 must point to file block
;
; 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
TXNE S,ABORT ;if abort flag set, exit immediately
$RETT ;pretend we copied file
$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!CHKSWT ;don't do input checking
ZERO ,T.GTE ;zero get error code
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 FILE2 ;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
FILE2B: ;here to print error message
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/ERRIBM(S1)/" writing file ^F/0(P3)/>)
;note, if input error occurred, GETDSK will have
; already reported it
FILE2A: TXO S,RQB!ABORT ;requeue request and set abort to
; prevent I/O to IBM
FILE1: ;here when finished with file
$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
$TEXT (LOGCHR,<^I/IBMSG/File transfer aborted because of input ^F/0(P3)/>)
TXZ S,DSKOPN ;indicate file is closed
$RETF ;return false
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
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
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
$CALL LPTJOB ; Call common routine to process file
TXNE S,CHKLOG ; Was it a log file?
JRST LPCONO ; Yes, matched console pattern
$CALL DISPOS ; No, take care of disposition
TXZ S,ACTIVE!ABORT!CHECK ; Logging no longer allowed
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 intput
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>,<Error "^T/@GLXERR(S1)/" 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 F%IOPN ; 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
STRPBL: 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)
SOJG T2,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.
;
; Note - Destroys S1, S2, T1, T2
LPTJOB: TXO S,ACTIVE ; Set job to active state
MOVEI T2,.OTLPT ; Type of queue to initialize
$CALL OPNHLD ; Open holding file, dispose of old one
$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
MOVEI S1,[ASCIZ /Receiving job/]
STORE S1,,T.DST ; Save status for display messages
TXO S,CHECK!CHKSWT!DOCHKP ; Checkpointing and switch checking
$WTOJ <Receiving output>,<Starting output to file ^F/0(P3)/>,@T%OBA
$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
$TEXT (LOGCHR,<^I/IBLPT/Reading file into ^F/0(P3)/>)
$CALL COPY ; Copy the file
SKIPT ; If no error .. skip error message
$TEXT (LOGCHR,<^I/IBLPT/Error ^T/ERRIBM(S1)/ writing file ^F/0(P3)/>)
$TEXT (LOGCHR,<^I/IBLPT/Finished file ^F/0(P3)/>)
$WTOJ <Finished output>,<Finished output to file ^F/0(P3)/>,@T%OBA
$RETT ; Return
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 ; Complement all but 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
TKHCR0: MOVEI S1,[ASCIZ /Idle/] ; Display idle
STORE S1,,T.DST ; State for message
$DSCHD TW.QRQ,0 ; Wait for job
LOAD S1,,L.STS ; Get status
TXNN S1,L.SFS ; If signoff sent
TXNE S,LGA ; or line gone away
JRST CDERR ; Wait for control task to kill us
TKHCR1: MOVEI S1,[asciz /Sending job/]
STORE S1,,T.DST ; State for status message
$CALL DOJOB ; Get next job and do it
TXNE S,LGA ; See if line went away
JRST CDERR ; Wait to be killed if line went away
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
LPHMAI: MOVEI S1,[ASCIZ /Idle/] ; Get state
STORE S1,,T.DST ; and save it for status
$DSCHD TW.IOD ; Wait for activity
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
HRRZ S1,P1 ; Get device handle
D60 D60STS ; 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
$CALL DISPOS ; Take care of disposition
TXZ S,ACTIVE!ABORT!CHECK ; Logging no longer allowed
FTLOG <
; 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
TXNE S,LGA ; Has line gone away?
JRST CDERR ; Yes, die gracefully
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: LOAD S1,,L.STS ; Get the line status
TXNN S1,L.SFS ; If signoff sent
TXNE S,LGA ; or line gone away
JRST CDERR ; Exit gracefully
$DSCHD TW.CNI,0 ; Wait for some
LOAD S1,,L.CNI ; Get handle for CNI queue
$CALL L%FIRST ; Point to first entry
; Loop to process console messages to IBM
TKHCI0: JUMPF TKHCNI ; If no more, go wait for some
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
MOVE S1,P1 ; Get device handle
D60 D60SOU ; Output data
QQ==<<ERRIBM-IBMNAM>-660000>&777777 ; Modulo 18-bit displacement for error
; table, note this won't work in
; non-zero sections.
TXNE S,LGA ; Has line gone away?
JRST CDERR ; Yes, do null wait
SKIPT ; If success, we don't have to complain
$WTOJ <Console send error>,<Error was "/@QQ(S1)/^M^JMessage was--^T/1(T2)/^A>,@T%OBA
LOAD S1,,L.CNI ; Get list handle
$CALL L%DENT ; Delete this entry
$CALL L%NEXT ; and on to next
JRST TKHCI0 ; Loop over rest
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
LOAD T4,,T.RIA ; Point to record buffer
HRLI T4,440700 ; and convert to bypte pointer
SETZ P2, ; Initialize "in use" count
TKHCN0: $DSCHD TW.IOD ; Wait for input available
LOAD S1,,L.STS ; Get status
TXNN S1,L.SFS ; If signoff sent
TXNE S,LGA ; or line gone away
JRST CDERR ; Wait to be kill off
HRRZ S1,P1 ; Get device handle
D60 D60STS ; Get device status
JUMPF TKHCN0 ; Failed .. go back to sleep
TXNN S2,SDIPR!SDIRN!SDIPW ; Check for device input ready
JRST TKHCN0 ; False alarm .. back to sleep
TKHCN1: MOVE S1,P1 ; Get handle
MOVE S2,T4 ; Point where in record data should go
HRROI T1,-<<MXLPBF-1>*5> ; Get maximum length to read
ADD T1,P2 ; Subtract how much is in use
MOVM P3,T1 ; Save count we asked for
D60 D60SIN ; Get a record
TXNE S,LGA ; Has line gone away?
JRST CDERR ; Yes, go wait to be killed off
JUMPF TKHCN2 ; If we get error
TKHCN4: MOVE T2,P3 ; Get bytes we asked for
MOVM T3,T1 ; and positive bytes left to do
SUB T2,T3 ; Calculate what we got
JUMPE T2,TKHCN3 ; If no bytes, wait a while
ADDB P2,T2 ; Add for total byte count
TKHCN5: LOAD T4,,T.RIA ; Point to record buffer
HRLI T4,440700 ; Make it into byte pointer
JUMPE P2,TKHCN0 ; If no more, go wait for some
TKHCN6: ILDB S1,T4 ; Get next character
CAIN S1,12 ; Is it linefeed (i.e. end of message)?
JRST TKHCN7 ; Yes, go queue this message
SOJG T2,TKHCN6 ; No, decrement count until end
JRST TKHCN0 ; and go to get more
TKHCN7: MOVE S2,P2 ; Get amount of data in buffer
SOS T2 ; Account of linefeed we didn't count
SUBB S2,T2 ; Compute chars in this message
TXO S,OUTEOF ; Dummy up EOF for PUTCNO
LOAD T1,,T.RIA ; Point to record
$CALL PUTCNO ; Add it to CNO queue
MOVE T3,T4 ; Copy byte pointer
LOAD T4,,T.RIA ; Point to record
HRLI T4,440700 ; in byte pointer form
SUBB P2,T2 ; Reduce count by bytes in this message
JUMPE P2,TKHCN5 ; If all, no need to shift rest down
TKHCN8: ILDB S1,T3 ; Get next character
IDPB S1,T4 ; Move it towards beginning of buffer
SOJG T2,TKHCN8 ; Loop till all characters copied
MOVE T2,P2 ; Get count of chars remaining
JRST TKHCN5 ; See if we can copy another
TKHCN2: CAIE S1,D6NBR ; Non-blocking or
CAIN S1,D6DOL ; Off-line error?
JRST TKHCN4 ; Treat as OK for now.
TRZ S1,660000 ; Get error code by itself
$WTOJ <D60JSY error>,<Error "^T/@ERRIBM(S1)/" while reading console output>,@T%OBA
TKHCN3: $DSCHD 0,^D10 ; Wait a few seconds
JRST TKHCN0 ; and try again
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 -- 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 - Always true
;
; Note - Destroys S1, S2
; Changes SAB (send argument block for C%SEND)
; Stopcodes on false return from 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.
&
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
JUMPT .POPJ ;return true if successful
$STOP SQF,<Send to QUASAR failed>
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 always
;
; Note - Destroys S1, S2, T1 and T2
; Changes contents of MSGBLK
RSETUP: ;subroutine to send response to setup
MOVE T2,S1 ;save condition code
CAIE T2,%RSUOK ;is it OK?
$CALL DISABL ;no, disable line
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
MOVE T1,S2 ;get address of message for SNDQSR
PJRST SNDQSR ;go send message to QUASAR and return to caller
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
TXNE 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
MOVX S1,RQ.HBO ;get "hold by operator" bit
STORE S1,REQ.FL(T1) ;store it in flags word of message
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
$RETT ;return true always
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
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 - T2/ Queue type
;
; Returns - False if INSENT fails, True otherwise
;
; Note - Destroys S1(R1), S2, T1 and T2
; Changes queue request page for task
INIQRQ: ;here to initialize queue request page
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
MOVEI S1,T1 ;point to it
$CALL INSENT ;store it
JUMPF .POPJ ;propagate error if there is one
$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
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 6,S1] ;pointer to characters of random name
MOVEI T2,6 ;count of characters in random name
IBP S2 ;make ILDB into DPB type pointer
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
DPB T3,S2 ;store at pointer
IBP S2 ;point to next character
SOJG T2,INIQR0 ;keep looping till all done
>;end TOPS10
TOPS20 <PUSH P,S2 ;save byte pointer to end of FDB
LOAD R2,,T.RNM ;get UDT random name
HRROI S1,INIQDT ;point to work area for date/time
MOVX R3,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,INIQR1 ;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
INIQR1: ;here to calculate new FDB length
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
MOVE P3,S1 ;save address of eventual FDB for messages
MOVEI S1,[XWD 2,.QCODP ;output disposition
EXP 1] ; of delete
$CALL INSENT ;insert it
$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, 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
HLRZ S2,S2 ;get length of old entry
MOVE P3,S2 ;copy it
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
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
CAILE P1,1000(J) ;off the end of the page?
$RETF ;yes, return error
AOS CQARGN(J) ;no, we now have one more argument
SOS P1 ;convert into last word to transfer
HRL P3,S1 ;make BLT pointer
HRRZ S1,P3 ;save destination for return to caller
BLT P3,0(P1) ;copy new entry
$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
;
; Note - Destroys S2 and T1
FNDENT:: ;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
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
$STOP IDC,<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
SKIPE T4 ;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
SKIPN T4 ;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
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
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
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: TRZ S1,660000 ;clear D60JSY error flag
$WTOJ <D60JSY error>,<Error "^T/@ERRIBM(S1)/" 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
$STOP IT2,<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
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
$STOP RTT,<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
LOAD S1,P1+T%ACS ;get handle from TKB
JUMPE S1,RELTK4 ;if none, skip it
D60 D60RLS ;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
$STOP ERT,<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 ;if console output
JRST BUFSZ0 ; use large size buffer
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
$STOP NPB,<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
$STOP TSQ,<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
$STOP NLB,<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: all 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
$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
; 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 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.
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
$STOP LNA,<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
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.
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
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: 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
SOJL S1,COPY2 ; If EOF, go write out last
AOS S1 ; Restore error code
STORE S1,,T.GTE ; Save it
TXO S,INPEOF+OUTEOF ; Set EOF flag bits
SETOM S1 ; and code as if EOF
SETZB T1,T2 ; and no records
PUSHJ P,@T%PTR ; Go close output file
JUMPF COPY3 ; Store error if we cannot
$RETF ; 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 COPY3 ; 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 COPY ; No, just copy another record
PUSHJ P,@T%CKP ; Yes, call checkpoint routine
JRST COPY ; and continue with loop
COPY3: STORE S1,,T.PTE ; Save error
$RETF ; Return failure
COPY2: PUSHJ P,@T%PTR ; Output buffer, if S1=-1 write EOF
JUMPF COPY3 ; If an error, save it
$RETT ; otherwise, all ok return
SUBTTL Subroutines -- - GETDSK, read a record from disk
; Routine - GETDSK
;
; Function - Reads disk blocks in to a record buffer.
;
; Parameters - TK/ Task block address
;
; 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
IDPB S2,T%RIP ; Store it in record
AOS T2,T%RIC ; Increment real count and user copy
CAIE S2,12 ; Was it LF?
CAIN S2,23 ; or DC3?
JRST GETDRT ; Yes, return to caller
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
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/@GLXERR(S1)/" reading file ^F/0(P3)/>)
$RETF ; and give false return
GETDRT: $CALL RPCTLS ; Replace control-S if necessary
IFN FTDEBUG,<
SETZ S2, ; Get a null byte to store
IDPB S2,T%RIP ; at end of record to make ASCIZ
>;end IFN FTDEBUG
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
RPCTLS: TXNN S,NOCTLS ; Did caller request ctl-S replacment
$RET ; No, return
CAIE S2,23 ; Is character CTL-S?
$RET ; No, return
MOVEI S2,12 ; Yes, get linefeed
DPB S,T%RIP ; and replace 23 we just deposited
$RET ; Return to caller
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
;
; 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
LOAD T1,,T.RIA ;get address of record
LOAD T2,,T.RIC ; and current count now in
; case we get EOF
GETIB0: ;character loop
SOSGE T%DIC ;a character left from last IBM buffer?
JRST GETIBF ;no, go get more
ILDB S1,T%DIP ;yes, get it
IDPB S1,T%RIP ;store it in record
AOS T2,T%RIC ;increment both real count and copy for user
TXNE S,TCR ;Check if last character was CR
JRST GETIRT ; Yes .. end rec'd on current character
CAIN S1,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 S1,12 ;was it LF?
CAIN S1,23 ;or DC3?
JRST GETIRT ;yes, return to caller
CAIE S1,14 ;is it FF?
JRST GETIB0 ;no, continue looping
JRST GETIRT ;yes, return to caller
GETIBF: ;here to read another buffer of IBM data
TXNE S,FLSH!ABORT ;have we gotten all we are going to get or want?
JRST GETIB2 ;yes, return data plus EOF indicators
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
MOVEI T1,1000*5 ;number of bytes to read
MOVN T1,T1 ;make into negative byte count
D60 D60SIN ;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
JUMPE S1,GETINO ;if nothing, try waiting awhile
MOVEM S1,T%DIC ;store byte count
LOAD T1,,T.RIA ;restore record address
$CALL CHKSNZ ;Check if this task is hanging everyone
JRST GETIB0 ;and try putting a character into the record again
GETIER: ;here on error or EOF
CAIE S1,D6NBR ;is it non-blocking return
CAIN S1,D6DOL ; or off-line?
JRST GETIB1 ;if so, see if we got data
CAIE S1,D6EOF ;was it EOF?
JRST GETIE0 ;no, go report it
TXO S,FLSH ;mark that EOF was seen
JRST GETIB1 ;and continue merrily passing records
GETIE0: ;here on error other than EOF
TXNN S,ACTIVE ;see if we can log things
JRST GETIEX ;no, just store code
TRZ S1,660000 ;clear off high bits
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/@ERRIBM(S1)/" reading into file ^F/0(P3)/>)
GETIEX: TRO S1,660000 ;put back D60JSY indicator
$RETF ;give error return
GETIB2: ;here to return EOF to caller
$CALL GETIRT ;set up byte pointers
TXO S,INPEOF!OUTEOF ;set visible bits
TXZ S,FLSH!NOCTLS ;and clear our bit and control-s convert
SETZ S1, ;return code
$RETF ;return false
GETIRT: ;normal return
$CALL RPCTLS ;replace control-S if necessary
IFN FTDEBUG,<
SETZ S1, ;get null byte
IDPB S1,T%RIP ;store at end of record for ASCIZ
>;end IFN FTDEBUG
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
$DSCHD TW.IOD,Q ;wait a little
JRST GETIBF ;and try to get a buffer again
SUBTTL Subroutines -- - PUTDSK, write a record to disk
; Routine - PUTDSK
;
; Function - Copies data in record to disk, if OUTEOF set an EOF is sent.
;
; Parameters - T1/ Address of record
; T2/ Byte count
;
; Returns - True, unless an output error occurs
;
; Note - Destroys S1, S2
PUTDSK: ;subroutine to write a record to disk
MOVE S1,P4 ;get disk handle
JUMPLE T2,PUTDET ;if no bytes, go check for EOF
ADDM T2,T%TBC ;Update transferred byte count
MOVE S2,T1 ;get address in RH
HRL S2,T2 ; and count in LH
$CALL F%OBUF ;output this buffer
PUTDET: ;here after buffer written
MOVE S1,P4 ;get handle in case we need to close
TXZE S,OUTEOF ;see if we need to write EOF
$CALL F%REL ;close the file
$RET ;and return
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
;
; 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: 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
; PJRST PUTIBF ;yes, close out file and return
PUTIBF: ;here to write a buffer out
$SAVE <T1,T2> ;save record pointers
LOAD T1,,T.XBN ;get max bytes in buffer
SUB T1,T%XRC ;calculate count to output
JUMPE T1,PUTIRT ;if zero, we don't have to
ADDM T1,T%TBC ;update transfered byte count
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
D60 D60SOU ;do simulated SOUT
JUMPF PUTIER ;if we don't succeed, return error code
JUMPE T1,PUTIRT ;if no bytes remaining, we are done
PUTIB2: $DSCHD TW.IOD,Q ;wait a little
JRST PUTIB3 ;and continue
PUTIRT: $CALL CHKSNZ ;Check if this task blocking everyone
TXZE S,OUTEOF ;were we supposed to close it?
D60 D60EOF ;yes, do it
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,D6NBR ;if none-blocking
JRST PUTIB2 ; go snooze a bit
CAIN S1,D6DOL ;if device off-line ??
JRST PUTIB2 ; try it too ??
$RET ;propagate failure
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
SOJLE T2,PUTCNE ;if no data, just do EOF processing
ADDI T2,6 ;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
HRLI S1,(BLT S2,) ;fill in rest of BLT instruction
XCT S1 ;copy data
MOVE S2,0(S1) ;get last word of data
TDZ S2,[BYTE (7)177,177,177,177,177
BYTE (7)0,177,177,177,177
BYTE (7)0,0,177,177,177
BYTE (7)0,0,0,177,177
BYTE (7)0,0,0,0,177](T3);clear out extra bytes
MOVEM S2,0(S1) ;and put word back
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/ Port,,line
; S2/ Device,,unit
; LB must be setup
;
; Returns - False: S1/ error code
; True: Handle to use when referencing device
DEVOPN: ;do open of device
PUSH P,S2 ; ...
MOVEM S1,OPNBLK ;save port,,line
MOVEM S2,OPNBLK+1 ; and dev,,unit in open block
LOAD S1,,L.SIG ;get line signature
MOVEM S1,OPNBLK+2 ;store it in block
MOVNI S1,3 ;get minus length
MOVEI S2,OPNBLK ;point to block
D60 D60OPN ;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
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/@GLXERR(S1)/" trying to checkpoint hold file>)
$WTOJ <Checkpoint error>,<Error "^T/@GLXERR(S1)/" 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 -- - LINSTS, 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 ;get the line status
JUMPF LINST0 ;if error, handle it
TXC S2,SLDTR!SLDSR ;check if both DTR and DSR are set
TXCE S2,SLDTR!SLDSR ;skip if both were set
JRST LINST1 ;mark line as down
LOAD S1,,L.STS ;get status bits
TXO S1,L.UP ;assume line is up
LINST2: STORE S1,,L.STS ;store new status
$RETT
LINST0: JRST .RETF ;pass error on to caller
LINST1: LOAD S1,,L.STS ;get our line status bits
TXZ S1,L.UP ;clear "up" bit
JRST LINST2 ;and go store new state
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 <S1,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,1 ;short sleep
GETLN1: MOVE S1,P1 ;get handle
MOVEI S2,.MORQI ;get D60OPR function code
D60 D60OPR ;do request for output
JUMPT .POPJ ;if successful, just return
CAIE S1,D6CGO ;if "can't get output" don't retry
SOJG T1,GETLN0 ;else loop for count
$RETF ;D60JSY 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
$SAVE S ;save a register D60JSY doesn't use
LOAD S,,L.LNI ;get port,,line
MOVEI S1,S ;point to argument block
D60 D60DIS ;do condition call to disable line
$RETT ;ignore any errors
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,[ASCIZ/PS:<DN60>/] ;point to beginning of name
SOUT ;copy to FDB
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 F%IOPN ;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
$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
TXNN S,CHKLOG ;are we checking for a log file?
JRST IBMLF0 ;no, just continue
$CALL PATLOG ;see if match on console output pattern
JUMPT IBMLF0 ;if yes, continue
TXZ S,CHKLOG ;if not, negate flag both, prevents
; needless checking and reports failure
MOVEM S,.LACS+S ;put flags in commonly accessible place
; Here to check for user switches
IBMLF0: TXNN S,CHKSWT ;checking for switches?
JRST IBMLFE ;no, exit, passing record to user exit
$CALL PATSWT ;see if record matches switch pattern
JUMPF IBMLFE ;if not, exit
$CALL DOSWT ;if it does, process the switch
JUMPF IBMLFE ;if failed, don't write queue info file
MOVE TK,.LACS+TK ;restore TKB pointer
$CALL WRTQUE ;update queue info file to current info
; Here to exit by passing record to user exit
IBMLFE: POP P,T2 ;get back original length
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,R1>>
TOPS20 <DEFINE STSH < HRROI R2,P1
SOUT>;end DEFINE STSH
>;end TOPS20
TOPS10 <HLDWD==1+1+1+1> ;str+name+ext+ppn
TOPS20 <HLDCH==6+3+5+7+3+1 ;<DN60>+dev+"-IBM-"+"PnnLnn."+dev+null
HLDWD==<HLDCH+4>/5> ;number of words needed
HLDFDB=1+HLDWD ;size of FDB = length word plus file
; description
BLDFDB: ;subroutine to build device FD
$SAVE <R3,P1,P2,P3,P4> ;save some registers
PUSH P,R1 ;save address of destination where we
; can easily get at it
MOVE P3,R2 ;save table address
SETZM 0(R1) ;zero first word
MOVS R3,R1 ;copy address to LH
HRRI R3,1(R1) ;make BLT pointer
MOVEI R2,HLDFDB-1(R1) ;address of last word to copy
BLT R3,0(R2) ;zero out block
TOPS10 <HRLI R1,004400> ;make into fullword byte pointer
TOPS20 <HRRO R1,R1 ;make into a byte pointer
SETZ R3,> ;no length for SOUT
AOS R1 ;point to word after length
TOPS10 <MOVSI P1,(SIXBIT /D60/)> ;get device name
TOPS20 <DMOVE P1,[ASCIZ /<DN60>/]> ;and point to directory
STSH
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
TOPS10 <MOVE P1,[POINT 6,P4,17] ;point to proper place
MOVEI P3,'0'> ; and get a zero
TOPS20 <MOVE P1,[POINT 7,P4,20] ;point to last character
MOVEI P3,"0"> ; and get a zero digit
LOAD P2,,T.UNI ;get device number
ADD P2,P3 ;convert to octal digit
DPB 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
DMOVE P1,[ASCIZ /-IBM-/] ;get next part of name
STSH> ;put into FD
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 R2,,L.PRT ;get port number
$CALL BLDFD1 ;stuff it in
LOAD R2,,L.LIN ;get line number
$CALL BLDFD1 ;put it in also
STSH ;store result in FDB
POP P,P1 ;get device string again
STSH ;put it as extension
TOPS20 <MOVEM R1,BLDFD2> ;save pointer after file spec for TOPS20
MOVSI R2,HLDFDB ;get length of FDB
POP P,R1 ;get destination address again
MOVEM R2,0(R1) ;store length word
MOVE R2,BLDFD2 ;get pointer to name
$RETT ;return
BLDFD1: ;subroutine add in two octal digits
PUSH P,R2 ;save argument
IBP P3 ;skip over character
ANDI R2,70 ;get high order digit
LSH R2,-3 ; all by itself
LDB P4,P3 ;get a "0"
ADD P4,R2 ;add our value in
DPB P4,P3 ;and put it back
POP P,R2 ;get original value
ANDI R2,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
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 -- 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).
;
; Parameters - J/ Queue request page
;
; Returns - False: if no filename or rename fails
;
; Note - Destroys S1, S2 and T1
DISPOS: $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
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
$STOP CFF,<Couldn't find file entry>
DISPO1: MOVEM S1,FRB+1 ;store address in second half of rename block
MOVEI S1,2 ;get length
MOVEI S2,FRB ; and pointer to rename block
$CALL F%REN ;rename file
JUMPF DISPER ;if error, report it
MOVEI T2,.QCODP ;get disposition block code
$CALL FNDENT ;get its block (if any)
JUMPF DELQUE ;if none, delete it
SKIPE 1(S1) ;if disposition is delete, then
JRST DISPSN ; go print user job
MOVE S1,FRB+1 ;get address of file specification
$WTOJ <File held for user>,<^F/0(S1)/>,@T%OBA
JRST DELQUE ;go delete hold file queue info
DISPSN: $CALL SETACT ; Setup the account string if needed
$CALL SETLMT ; Set the printer page limit
$CALL SNDQUE ; Send request to QUASAR
JUMPF DELQUE ; Delete if send failed
$RETT ; All done here
; Here on error while disposing of file
DISPER: MOVE P1,FRB+1 ;get address of FDB to rename to
$WTOJ <Rename failure>,<^F/0(P1)/>,@T%OBA
MOVEI T2,.QCODP ;code for output disposition
$CALL FNDENT ;find it
SKIPE 1(S1) ;check value
JRST DISPE1 ;if disp=delete, complain and delete file
$WTOJ <Couldn't hold file>,<^F/FDBARE/ requeued to LPT>,@T%OBA
$CALL INIQRQ ;re-initialize queue info
JRST DISPOS ;and try again
DISPE1: ;here on error for delete file
$TEXT (LOGCHR,<Could not dispose of file ^F/FDBARE/>)
$WTOJ <Couldn't queue file>,<^F/FDBARE/ deleted>,@T%OBA
MOVEI S1,1 ;size of FOB
MOVE S2,FRB ;address of FOB
$CALL F%DEL ;delete the file
$RETF
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
HRRZS P1 ; Clear left half
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.
;
; The number of pages is found from:
;
; .6 * (# of 200 word blocks)
;
; or 1 page/1067 characters
;
; Parameters - none
SETLMT: STKVAR <<LMTBUF,^d2>> ; Buffer for Q msg create entry
MOVEI S1,LMTBUF ; Get address of buffer
LOAD S2,,T.TBC ; Get number of bytes transferred
IDIVI S2,^d1067 ; Find number of pages
AOS S2 ; Always round up for first page
CAIGE S2,^d9 ; Check for minimum number of pages
MOVX S2,^d9 ; Too small .. make reasonable
MOVE T1,[2,,.QCLIM] ; /LIMIT entry
MOVEM T1,(S1) ; First word in entry
MOVEM S2,1(S1) ; Put number of pages in next word
PJRST INSENT ; Insert entry and return
SUBTTL
; Routine - QUEFDB
;
; Function -
;
; Parameters -
;
; Returns -
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,[POINT 7,FDBARE+3] ;point to first character of second word
MOVEI S2,"Q" ;get a "Q"
IDPB S2,S1 ;make filename <DN60>dev-QBM-P...
>;end TOPS20
TOPS10 <MOVE S1,[POINT 6,FDBARE+1] ;point to first character
MOVEI S2,(SIXBIT / Q/) ;get "Q"
IDPB S2,S1 ;make filename QnnLnn
>;end TOPS10
$RETT
SUBTTL
; Routine - WRTQUE
;
; Function -
;
; Parameters -
;
; Returns -
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 F%OOPN ;open it for output
JUMPT WRTQU0 ;continue if successful
QUEERR: ;here on queue info file manipulation error
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/@GLXERR(S1)/" on queue info hold file ^F/FDBARE/>)
$WTOJ <File error>,<Error "^T/@GLXERR(S1)/" 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
; Routine - QUECLS
;
; Function -
;
; Parameters -
;
; Returns -
QUECLS: ;routine to close queue info file
POP P,S1
$CALL F%REL
$RETT ;ignore errors
SUBTTL
; Routine - RDQUE
;
; Function -
;
; Parameters -
;
; Returns -
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 F%IOPN ;open for input
JUMPF .POPJ ;complain if we cannot
PUSH P,S1 ;save IFN
PUSH P,[EXP QUECLS] ; and address of routine to close it
$SAVE <T1,T2,T3> ;preserve a few registers
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
$CALL F%IBUF ;get a bufferful
JUMPT RDQUE1 ;if we succeeded, continue
CAIN S1,EREOF$ ;check for EOF error
$RETT ;if so, return true
PUSH P,S1 ;save error code
$CALL INIQRQ ;re-initialize queue page if we
; got a real error (who knows what
; it might have!)
POP P,S1 ;get error code back
JRST QUEERR ;and report error
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
; Routine - DELQUE
;
; Function -
;
; Parameters -
;
; Returns -
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: EXP FDBARE ;address of FDB
EXP ^D36 ;byte size
SUBTTL
; Routine - SNDQUE
;
; Function -
;
; Parameters -
;
; Returns -
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
; Routine - PRCQRQ
;
; Function -
;
; Parameters -
;
; Returns -
PRCQRQ: ;routine to re-arrange queue info
MOVEI T2,.QCODP ;find
$CALL FNDENT ; disposition block
SKIPE 1(S1) ;see if disp=delete
JRST PRCALL ;yes, just do always processing
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
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 ;no, skip this
$CALL CHGUSR ;change user in file spec
MOVEI T2,.IBMST ;code for structure entry
$CALL FNDENT ;see if structure present
JUMPF PRCALL ;no, skip processing
$CALL CHGSTR ;replace structure in file spec
PRCALL: ;here to do processing which always
; has to be done
MOVEI T2,.IBMST ;find structure block
$CALL FNDENT
JUMPF PRCAL0 ;if none, finished
MOVEI S1,[EXP .IBMST] ;point to zero length entry
$CALL INSENT ;delete old one by inserting zero length one
PRCAL0: ;here to do rest of always processing
$RET
SUBTTL
; Routine -
;
; Function -
;
; Parameters -
;
; Returns -
notyet: HALT
WATCH: $RETT
WATSND: JRST NOTYET
CTSGOF: JRST NOTYET
GETCNI: JRST NOTYET
SUBTTL
; Routine - TBFINI
;
; Function -
;
; Parameters -
;
; Returns -
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
; Routine - INIJOB
;
; Function -
;
; Parameters -
;
; Returns -
INIJOB:
SETZM T$GIC(TK)
POPJ P,
SUBTTL
; Routine - OPNHLD
;
; Function -
;
; Parameters -
;
; Returns -
OPNHLD: ;subroutine to open hold file
$CALL INIQRQ ;initialize queue create message page
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 F%OOPN ;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
$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
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/@GLXERR(S1)/ opening hold file ^F/FDBARE/>)
$WTOJ <File error>,<Error "^T/@GLXERR(S1)/ opening hold file ^F/FDBARE/>,@T%OBA
OPNHE0: ;loop to keep trying to open hold file
$DSCHD 0,^D60 ;wait a fairly long time
MOVEI S1,2 ;size
MOVEI S2,OBLK ; and address of FOB
$CALL F%OOPN ;try to open it
JUMPT OPNHL0 ;if we succeeded continue with processing
CAIE S1,ERFAE$ ;is it file already exists error?
JRST OPNHE0 ;no, keep trying
OPNOLD: ;here when we have an old hold file
; lying around
$CALL RDQUE ;read whatever queue info file exists
$CALL DISPOS ;and dispose of file accordingly
JRST OPNHLD ;and try opening hold file again
OBLK: EXP FDBARE
EXP 7+FB.NFO ;byte size of 7 and require new file
NMNTAB: ASCIZ /LPT/
ASCIZ /CDP/
ASCIZ /CDR/
SUBTTL
; Routine - INPOPN
;
; Function -
;
; Parameters -
;
; Returns -
INPOPN: MOVEI P4,FB.LSN+7 ; 7 bit bytes with line number striping
MOVEI S1,2
MOVEI S2,P3
$CALL F%IOPN
JUMPT INPOP0
$TEXT (LOGCHR,<^I/IBMSG/Error "^T/@GLXERR(S1)/" opening file ^F/0(P3)/>)
INPOP0: MOVEM S1,P4
SETZM T$DIC(TK)
$RET
DEFINE ERR(A,B) <
[ASCIZ/B/]
>;end DEFINE ERR
GLXERR: [ASCIZ/No error???/]
ERRORS
DEFINE ERRS(A,B) <
[ASCIZ %'B'%]
>;end DEFINE ERRS
ERRIBM: D60ERR
SUBTTL Task scheduler blocking checker
; 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 ; 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.IOD ; Wait on I/O done
PJRST SNZTSK ; His time has run out .. let him sleep
SUBTTL Externally callable task descheduler
; 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 I%SLP ; 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 D60JSY error analyzer
; Routine - D60ANL
;
; Function - To check an error returned from a D60JSY call and do the
; appropriate action depending on the fatality level of the error.
;
; Parameters - S1/ Error code
;
; Returns -
D60ANL:
IFN FTDEBUG,<
MOVEM TF,LSTTF
MOVEM S1,LSTS1
MOVEM S2,LSTS2
MOVEM T1,LSTT1
>;end IFN FTDEBUG
SKIPF ; If failed .. check error code
$RET ; Else just return
CAIL S1,660000 ;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
$RET
D60PRD: ;here on serious error
$SAVE <P1,P2,P3,LB,TK,S1,S2> ;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
SUBTTL
; Routine - CHGNAM
;
; Function -
;
; Parameters -
;
; Returns -
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,0(S1) ;get argument
MOVE T3,S2 ;save displacement
MOVEI T2,.QCFIL ;code for file block
$CALL FNDENT ;find it
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
>;End if TOPS10
TOPS20 <
CHGUSR: ;subroutine to change user
$SAVE <S1,S2,T1,T2,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
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
MOVE T1,0(S1) ;get first word of entry
MOVEM T1,FDBARE ;and save it
CHGUS0: ;loop to copy till user start
ILDB S1,S2 ;get a character
IDPB S1,T2 ;no, copy character
CAIE S1,74 ;is it left angle bracket?
JRST CHGUS0 ;no, go back for another
CHGUS1: ;loop to skip over user
ILDB S1,S2 ;get next character
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
IDPB S1,T2 ;save in new file spec
JRST CHGUS2 ;and look for more
CHGUS3: ;here to put right angle bracket in
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
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,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
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
MOVEI T2,FDBARE+1 ;point to destination string
HRLI T2,440700 ; as ASCII byte pointer
CHGNA0: ;loop to copy through user
ILDB S1,S2 ;get byte
IDPB S1,T2 ;put byte
CAIE S1,76 ;if right angle bracket, skip
JRST CHGNA0 ;else just get another character
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
IDPB S1,T2 ;store in destination
SOJG T1,CHGNA1 ; and continue
CHGNA5: MOVEI T1,7 ;count of characters to skip
CHGNA2: ILDB S1,S2
SOJG T1,CHGNA2 ;skip over LPT-IBM
CHGNA3: ILDB S1,S2 ;copy rest of file-spec
IDPB S1,T2
JUMPN S1,CHGNA3
JRST CHGCOM
CHGSTR: ;change structure part of TOPS20 name
$RETT ;not implemented, so ignore
>;End if TOPS20
END IBMSPL