Trailing-Edge
-
PDP-10 Archives
-
BB-J724B-SM_1982
-
sources/ibmspl.mac
Click sources/ibmspl.mac to
see without markup as text/plain
There are 24 other files named ibmspl.mac in the archive. Click here to see a list.
; IBMSPL - Emulation spooler for DN60 IBM communications
;
;
ASCIZ /
COPYRIGHT (c) 1978, 1979, 1980, 1981, 1982
DIGITAL EQUIPMENT CORPORATION
/
; This software is furnished under a license and may be used
; and copied only in accordance with the terms of such license
; and with the inclusion of the above copyright notice. This
; software or any other copies thereof may not be provided or
; otherwise made available to any other person. No title to
; and ownership of the software is hereby transferred.
;
; The information in this software is subject to change
; without notice and should not be construed as a commitment
; by DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL assumes no responsibility for the use or reliability
; of its software on equipment which is not supplied by
; DIGITAL.
;
SUBTTL Table of contents
; TABLE OF CONTENTS FOR IBMSPL
;
;
; SECTION PAGE
; 1. Table of contents......................................... 2
; 2. Searches and version...................................... 3
; 3. Edit history.............................................. 4
; 4. Symbol definitions
; 4.1 AC Definitions.................................... 5
; 4.2 Feature Test Switches............................. 6
; 4.3 Parameters........................................ 7
; 4.4 External symbol definitions....................... 7
; 4.5 Device/task type codes............................ 8
; 4.6 Message processor status bits (in S).............. 8
; 4.7 Task status bits (in S while task is running)..... 8
; 4.8 Checkpoint request block offsets (from QUASAR).... 8
; 4.9 Create queue entry message offsets (from QUASAR).. 8
; 4.10 D60JSY interface.................................. 8
; 4.11 DN60 Port status device active bits............... 8
; 5. Macro definitions
; 5.1 $DSCHD, de-schedule a task........................ 9
; 5.2 $SIGNL, indicate wakeup condition................. 10
; 5.3 $WATCH, queue message for watchers macro.......... 11
; 5.4 SKPTSK, skip if in task context................... 11
; 5.5 D60, call D60JSY and analyze error return......... 11
; 6. Database definitions
; 6.1 Random static storage............................. 12
; 6.2 Constant static storage........................... 13
; 6.3 IB, Initialization block for GLXLIB............... 13
; 6.4 HELLO, message for QUASAR at startup.............. 13
; 6.5 ITEXT strings..................................... 13
; 6.6 Miscellaneous cells............................... 13
; 6.7 Interrupt system database......................... 14
; 7. Dynamic storage definitions
; 7.1 Active task list (ATL) entry "A.xxx".............. 15
; 7.2 Port list entry "P.xxx"........................... 16
; 7.3 Line block list entry "L.xxx"..................... 17
; 7.4 Task block list entry "T.xxx"..................... 18
; 8. Interrupt code
; 8.1 INTINI, Interrupt system initialization........... 19
; 8.2 INTIPC, IPCF Interrupt routine.................... 19
; 9. Initialization code....................................... 20
; 10. Scheduler
; 10.1 MAIN loop......................................... 21
; 10.2 SCHED, Schedule a task............................ 22
; 10.3 DESCHD, Deschedule a task......................... 23
; 10.4 ACTTSK, activate a task........................... 24
; 10.5 DEATSK, Deactivate a task......................... 25
; 10.6 WAKTSK, wake a task unconditionally............... 26
; 10.7 SGNTSK, signal a task............................. 27
; 10.8 SGNLIN, signal all tasks on a line................ 28
; 10.9 POLL, active device signalling.................... 29
; 11. Scheduler IPCF handling
; 11.1 MSGCHK, message checker........................... 30
; 11.2 MSGPRC, IPCF message processor.................... 31
; 12. Message processors
; 12.1 TEXTMS, Text message response..................... 32
; 12.2 SETUP, Setup/shutdown message..................... 33
; 12.3 SETALL, setup a new station....................... 34
; 12.4 SHTALL, shutdown station (signoff)................ 35
; 12.5 USRCN, User cancel message........................ 36
; 12.6 OPRCN, Operator cancel message.................... 37
; 12.7 NXTJB, Nextjob message............................ 38
; 12.8 SHWSTS, Show status message....................... 39
; 12.9 RQCHK, Request checkpoint message................. 40
; 12.10 CHKPNT, CHKPNB, send checkpoint................... 41
; 12.11 SNDCI, send console input to IBM.................. 42
; 13. Tasks
; 13.1 Description....................................... 43
; 13.2 TKSND, console output distribution................ 44
; 13.3 TKCTL, control for 2780/3780...................... 45
; 13.4 . CTSGON, wait for signon........................ 46
; 13.5 . CTSGOF, do signoff............................. 47
; 13.6 . CTLNGN, line gone while active processing...... 48
; 13.7 TKCDR, 2780/3780 card reader...................... 49
; 13.8 . CDCNI, send console input to IBM............... 50
; 13.9 . CDJOB, send job to IBM......................... 51
; 13.10 . DOJOB, process "batch" job.................... 52
; 13.11 . FILE, copy a disk file to IBM................. 53
; 13.12 . NXTFIL, advance to next file in job........... 54
; 13.13 TKLPT, 2780/3780 line printer..................... 55
; 13.14 . LPTJOB, process printer job.................... 56
; 13.15 TKHCDR, HASP card reader.......................... 57
; 13.16 TKHCDP, HASP card punch........................... 58
; 13.17 TKHLPT, HASP line printer......................... 58
; 13.18 TKHCNI, HASP console input to IBM................. 59
; 13.19 TKHCNO, HASP console output from IBM.............. 60
; 14. Subroutines
; 14.1 Initialization and Main Loop subroutines.......... 61
; 14.2 . OPDINI, Get operating system information....... 61
; 14.3 . QUIESC, wait for tasks to settle............... 62
; 14.4 IPCF message subroutines.......................... 63
; 14.5 . SNDQSR, send a message to QUASAR............... 63
; 14.6 . SNDBAK, IPCF reply to last sender.............. 64
; 14.7 . RSETUP, response to setup (to QUASAR).......... 65
; 14.8 . QRLSE, requeue/release (to QUASAR)............. 66
; 14.9 . INIXBA, set up single page buffer............... 67
; 14.10 . INIPAG, set up job pages....................... 67
; 14.11 Queue create message handling..................... 68
; 14.12 . INIQRQ, Initialize queue request to default... 68
; 14.13 . INSENT, Insert entry.......................... 69
; 14.14 . FNDENT, Find entry............................ 70
; 14.15 Task control subroutines.......................... 72
; 14.16 . MAKLB, create line block....................... 72
; 14.17 . BLDTSK, create task............................ 73
; 14.18 . RELTKB, release task block..................... 74
; 14.19 . BUFSZ, calculate task's buffer size............ 75
; 14.20 . RELLB, delete a line block..................... 76
; 14.21 Search subroutines................................ 77
; 14.22 . FNDPOR, Find port block........................ 77
; 14.23 . FNDLB, Find line block......................... 78
; 14.24 . FNDNOD, Find line block for a node............. 79
; 14.25 . FNDTSK, Find task from port,line,dev,unit...... 80
; 14.26 . TSKCUR, Make TK value current entry............ 81
; 14.27 . FNDOBJ, Find task from QUASAR object block..... 82
; 14.28 I/O subroutines................................... 83
; 14.29 . LOGCHR, put character in log................... 83
; 14.30 . LOGBUF, get another log buffer................. 84
; 14.31 . COPY, copy a file.............................. 85
; 14.32 . GETDSK, read a record from disk................ 86
; 14.33 . GETIBM, read a record from DN60................ 87
; 14.34 . PUTDSK, write a record to disk................. 88
; 14.35 . PUTIBM, write a record to DN60................. 89
; 14.36 . PUTCNI, send console input to IBM.............. 90
; 14.37 . PUTCNO, put a record into CNO queue............ 91
; 14.38 . DEVOPN, open a D60JSY device................... 92
; 14.39 . CHKDSK, Checkpoint a disk file................. 93
; 14.40 DN60 Control subroutines.......................... 94
; 14.41 . LINSTS, get current line status................ 94
; 14.42 . GETLNO, ensure output is possible.............. 95
; 14.43 . DISABL, routine to disable a line.............. 96
; 14.44 . SGNFIL, SGFFIL, signon/signoff file setup...... 97
; 14.45 . IBMLFR, scan incoming records.................. 98
; 14.46 . CLLUSR, pass record to user exit............... 99
; 14.47 . BLDFDB, build FD for holding files............. 100
; 14.48 Debugging subroutines............................. 101
; 14.49 . LBVER, verify LB address....................... 101
; 14.50 Disposition subroutines........................... 102
; 14.51 . DISPOS, dispose of files read from IBM host..... 102
; 14.52 . SETACT, set print file account string.......... 103
; 14.53 . SETLMT, Set print file page limit.............. 104
; 14.54 . QUEFDB, build q-create variant of hold file.... 105
; 14.55 . WRTQUE, write out the queue info page.......... 106
; 14.56 . QECLS, close the queue info file............... 107
; 14.57 . RDQUE, read the queue info file................ 108
; 14.58 . DELQUE, flush the queue info file.............. 109
; 14.59 . SNDQUE, send queue info to QUASAR.............. 110
; 14.60 . PRCQRQ, modify queue info...................... 111
; 14.61 Miscellaneous subroutines......................... 113
; 14.62 . TBFINI, initialize task IO buffer.............. 113
; 14.63 . INIJOB, initialize a job....................... 114
; 14.64 . IBMOOP, IBMIOP - special opens for hold file... 115
; 14.65 . OPNHLD, open the hold file..................... 116
; 14.66 . INPOPN, open a file for input.................. 117
; 14.67 . CHKSNZ, check if task should deschedule......... 118
; 14.68 . SNZ, task or non-task time wait................. 119
; 14.69 . D60ANL, D60JSY call interface................... 120
; 14.70 . D60FAL, check for non-fatal errors.............. 120
; 14.71 . CHGNAM,CHGUSR,CHGSTR, modify hold file from swi 121
; 14.72 . MISLP, sleep for specified time................. 122
; 15. Literals.................................................. 123
; TITLE IBMSPL - Emulation spooler for DN60 IBM communications
SUBTTL Searches and version
SALL ; Make nice clean listings
.DIRECTIVE FLBLST ; List only 1st binary word in multi
; word text strings
SEARCH IBMMAC ; IBMSPL specific definitions
SEARCH GLXMAC ; Use GALAXY group's macros/symbols
SEARCH QSRMAC ; Symbols for setup message
SEARCH ORNMAC ; ORION communications symbols
SEARCH D60UNV ; Search for linkage symbols
SEARCH ACTSYM ; Search Accounting Symbols
PROLOGUE (IBMSPL) ; Initialize Galaxy symbol definitions
; Version
XP IBMVER, 4 ; Major version number
XP IBMMIN, 2 ; Minor version number
XP IBMEDT, 350 ; 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
IBMNAM: ASCIZ /IBMSPL/ ; Name of program
EXP 0
SUBTTL Edit history
COMMENT &
Edit Date Who Why
0(103) 9-May-79 K Reti Development of new product
1(104) 9-May-79 KR Added TOC, and made it version 1 for loadtest
1(105) 15-May-79 KR Fixed wrong object type for RSETUP, better
messages
1(106) 15-May-79 KR Make D60 skippable
1(107) 16-May-79 KR Made IBMLFR use its own (larger) stack for
pattern match calls; cut down register saving
overhead
1(110) 17-May-79 KR Took out IBMSPL from $MSG calls to WTOR, added
error codes to SNDCIE
1(111) 17-May-79 KR Add version printing
1(112) 18-May-79 KR Fix LPCONO bugs and change version printing to
use version cell when available
1(113) 23-May-79 KR Fix wrong D60JSY error message at BLDERR
1(114) 23-May-79 KR Add line signature code
1(115) 23-May-79 KR Fix console copy code in TKHCNO
1(116) 29-May-79 KR Change response to setup to be sent only after
successful signon
1(117) 30-May-79 KR Various bug fixes
1(120) 30-May-79 KR Release ATL entries also at RELTKB
1(121) 31-May-79 KR Make COPY call put routine to do EOF on error
1(122) 1-Jun-79 KR Fix console input to HASP
1(123) 1-Jun-79 KR Fix recognition of console output for 2780/3780
1(124) 4-Jun-79 KR Add code so that negative POLTIM means no polling,
fix WAKTIM calculations, and cause RELLB to delete
port also if line was last on port;
also change begin and end messages for CDR to
use ^R
1(125) 4-Jun-79 KR Fix FNDOBJ calls to take false return
1(126) 6-Jun-79 KR Add support for IOWAIT argument on SNOOZE to
improve performance
1(127) 6-Jun-79 KR Add code to detect new D6LGA return code
1(130) 7-Jun-79 KR Fix line gone detection code
1(131) 8-Jun-79 KR Fix single setup to send response, HASP signon
wait loop to notice line going away, task quiesce
code, FNDPOR and RELTKB
1(132) 10-Jun-79 KR Fix various bugs in line gone away code
2(133) 10-Jun-79 KR Make line status bits change to conform to
version 3 11-code and version 2 D60JSY
2(134) 10-Jun-79 KR Make LPTJOB set active earlier so OPNHLD error
messages can get in log file.
2(135) 14-Jun-79 KR Change bit definitions for line status to use D60JSY bits,
add code to disable line on shutdown, change format
or console input reception to conform to new
string format
2(136) 15-Jun-79 KR Get the rest of the bits edit 135 didn't catch
2(137) 15-Jun-79 KR Fix minor bugs in POLDWN and TKCDR
2(140) 18-Jun-79 KR Add code to OPDINI for TOPS20 to allow structure
access without prior structure mount.
2(141) 19-Jun-79 KR Bug fixes
2(142) 20-Jun-79 KR Strip blank lines from 2780/3780 console output
also fix restartup of card-reader bug
2(143) 20-Jun-79 KR collect console messages destined for OPR
2(144) 21-Jun-79 KR don't send CHKPNT to QUASAR if there is no job
(it complains!); also timeout CTSGOX loop
2(145) 27-Jun-79 KR Move SALL earlier, add debugging code to look
for one line taking another down bug
2(146) 29-Jun-79 KR Add code at DISPER to try requeuing hold
files as printer files, and to delete printer
files, also add TOPS10 CHGNAM, CHGUSR, CHGSTR.
2(147) 10-July-79 SMJ Remove JXO instruction so GLXEXT can be heaved.
2(150) 11-July-79 SMJ Increase the signon interval to 5 minutes.
2(151) 20-July-79 SMJ Output the correct message on a 700000 type
IPCF message.
2(152) 15-Aug-79 SMJ Put line conditioning code in SETALL.
2(153) 15-Aug-79 SMJ Fix INPOPN so that it doesn't try line sequence
number stripping.
2(154) 29-Aug-79 SMJ Add support for ORION show status message.
2(155) 4-Sep-79 SMJ Change call to D60CND to now pass SETUP msg.
2(156) 4-Sep-79 SMJ Some changes to try to reduce assembly time.
2(157) 5-Sep-79 SMJ Remove status info from checkpoint message.
2(160) 18-Sep-79 SMJ Cosmetic fixes to the code at end that was
never commented properly.
2(161) 25-Sep-79 SMJ Add account string code for printing
disposition.
2(162) 28-Sep-79 SMJ Fix task descheduling (CHKSNZ and SNZ) so that
if D60SIN/D60SOU never desched a task it can't
lock out the others until it's done.
2(163) 3-Oct-79 SMJ Fix GETIBM to properly handle carriage returns
that are not followed by LF, FF or DC3.
2(164) 17-Oct-79 SMJ Change name of D60JSY.UNV to D60UNV.UNV.
2(165) 29-Oct-79 SMJ Change LOOP/SCHED/DSCHED so that IPCF messages
can't get locked out for extended periods.
2(166) 31-Oct-79 SMJ Clean up status message format a bit.
2(167) 1-Nov-79 SMJ Change routine in INIQRQ to create a more
readable job name from the internal time.
2(170) 10-Nov-79 SMJ More code cleanup. Desupport multiple devices
on a HASP line, since FE can't handle them. Fix
startup/shutdown code.
2(171) 19-Nov-79 SMJ Put in fix in MSGPRC so that specified message
types can be ignored w/o processing and w/o
giving an error.
2(172) 25-Nov-79 SMJ Add code to COPY, LPTJOB and DISPOS to handle
printer page calculations.
2(173) 28-Nov-79 SMJ Fix TKLPT (2780/3780) so that the device status
goes idle after turning line back over to CDR.
Also fix TKHCNI so it really checks the line
status flags (not random garbage in S1).
2(174) 19-Jan-80 SMJ Update copyright date
2(175) 20-Jan-80 SMJ Fix MOVEM (should be MOVE) in POLL that
destroyed real value in NOW.
2(176) 20-Jan-80 SMJ Add bytes transfered to status message
2(177) 20-Jan-80 SMJ Fix edit 167 which destroyed T.RNM, thus giving
very funny dates for holding file names.
2(200) 21-Jan-80 SMJ When adding new port check if POLTIM already
set.
2(201) 21-Jan-80 SMJ Make minimum of 9 page LIMIT in SETLMT.
******** Version 3
3(202) 22-Jan-80 SMJ Rewrite routines LOOP (now called MAIN), SCHED,
DESCHD, MSGCHK, ACTTSK, DEATSK, SGNTSK, SGNLIN,
WAKTSK. This major fix cleans up the garbage
happening during task scheduling, improves code
readability and increase performance. Also the
routine POLL was changed to a subroutine,
instead of the crazy JRST/JRST stuff that was
going on.
Because of massive change, increment version.
2(203) 22-Jan-80 SMJ Rewrite $DSCHD macro to use new scheduling
format.
3(204) 23-Jan-80 SMJ Remove $MSG macro. Change to $STOP and $WTOJ
macros. This improves source to .EXE mapping
for debugging (besides not generating the
correct code in the first place). Not also
that the assembly time dropped by 1 CPU minute.
3(205) 24-Jan-80 SMJ Remove superfluous unreferenced cells and
symbols.
3(206) 24-Jan-80 SMJ Remove code checking for a M%GPAG failure at
TSCRP0+1 (this routine always stopcodes on
failure).
3(207) 25-Jan-80 SMJ Remove isolated code at TKHERR and RBUF.
3(210) 26-Jan-80 SMJ Fix PUTIBM to update transfered byte count
properly.
3(211) 28-Jan-80 SMJ Performance improvements. Eliminate routine
CHKLNI; let POLL do the work designed for it.
CHKLNI was only checking activity flags anyhow.
Also if task desched on TW.IOD (I/O wait),
force an immediate device polling.
3(212) 20-FEB-80 RLS Changed C%SEND failure in SNDQSR to return the
failure value instead of STOPCODE. Users of
SNDQSR fixed to decide what to do. In particular
IBMSPL startup changed to wait awhile for QUASAR
to come to life. Routine MISLP created to
provide sleep impervious to interrupts.
3(213) 25-FEB-80 RLS SNDCI fixed to send multiline msgs to IBM.
2780/3780 console input(to IBM) routine(CDCNI)
fixed to actually send msgs instead of halting.
New subr PUTCNI created from TKHCNI subr to do
the work. TKHCNI uses the same subr now.
PUTDSK modified to recognize null files and
set T.TBC to zero at closing. DISPOS modified
to complexly delete null files.
3(214) 27-FEB-80 RLS Fixed register and logic inconsistencies in
GETDSK and GETIBM for DC3 replacement.
Made OPNHLD check error return from INIQRQ
and log errors(made INSENT return a null error
code - others possible are defined GLXERRs).
DISPOS stopcodes if request to QUASAR fails.
3(215) 10-MAR-80 RLS Added cruft to implement logical name for hold
file device - affects primarily TOPS20. The string
IBMDEV holds the logical name used by BLDFDB. ALL
calls to F%OOP and F%IOP replaced by calls to
local routines IBMOOP and IBMIOP respectively.
3(216) 12-MAR-80 RLS IBMLFR changed to quit checking for switches
in IBM input after 8000. characters have been
processed.
3(217) 19-MAR-80 RLS modifications to dispos to take care of
crash/restart problems.RDQUE fixed to init
queue info if the queue info file doesn't exist.
3(220) 26-MAR-80 RLS added L.SGN flag to line block status. Means
SIGNON is required for station. SETALL fixed to
get this from setup msg and use it.
Fixed RQCHK to load LB(line block ptr)
Caused crash when QUASAR asked for a checkpoint.
3(221) 5-MAY-80 RLS Fixed calls to D60SIN and D60SOU
to reflect non-blocking return.
3(222) 8-MAY-80 RLS fix tops10 things dealing with hold
file names,queue create msg file name entry.
4(223) 30-JUN-80 RLS Modify to use D60JSY version 4 : non-blocking
IO. D60 macro changed to include retry return
for innocuous errors. D60ANL expanded to cope
with this change. SNZ function called when
"wait" condition is returned by D60JSY.
4(224) 1-JUL-80 RLS Modify BUFSZ to return 2*MXLPBF for lpt
buffer size to better accomodate line accumulation.
Fix TKHCNO to dump buffer when less than MXLPBF
space left in buffer.
4(225) 23-JUL-80 RLS Add SYSERR logging enable(D60INI arg)
4(226) 5-AUG-80 RLS Undo edit 220(SIGNON parts). SIGNON is required
for emulation mode by FE in order for flow
control to work properly...FE couldn't resume
transfers after halt due to not being signed on
4(227) 11-AUG-80 RLS FIX $DSCHD macro so DEACTIVATE arg clears TF
well as CURATE(TF/args deliverd to DESCHD).
4(230) 2-SEP-80 RLS fix FNDOBJ to set up LB on success exit.
relates to patch 220 - RQCHK.
4(231) 15-SEP-80 RLS remove patch 216. Fix LINSTS to set L.SND.
4(232) 18-SEP-80 RLS removed infinite retry in OPNHLD. will try
five times then give error return if fails. LPTJOB
modified to handle OPNHLD error return - log
and opr msgs then returns error. TKLPT AND TKHLPT
modified to handle the LPTJOB error - lpt input
cannot proceed at this point.
4(233) 22-SEP-80 RLS add more info on all DISPOS error msgs. more
analysis and directed action on DISPOS errors.
retry count for disposal implemented.
fixes bug on rename error(due to P1 being munged)
which caused lpt io to cease after rename error.
4(234) 23-SEP-80 RLS add file copy to DISPOS for use when
strucutres are different for rename. tops10
conditional used to check actual structure
before renaming. tops20 renames and will get
erfds$ error(hopefully).
4(235) 24-SEP-80 RLS add rbs(record buffer size) to task block.
change TKHCNO to use copy command.
4(236) 26-SEP-80 RLS add extension incrementing to dispos/rename.
4(237) 23-Oct-80 KR Fix bug in GETIBM that caused TRPILM stopcodes.
4(240) 4-Nov-80 KR Add delayed signoff code to fix multiple
hold files open problem; also fix signal line
bug.
4(241) 5-Nov-80 KR Fix bugs introduced by 4(240).
4(242) 7-Nov-80 KR Make immediate shutdown hang up line too.
4(243) 18-Nov-80 KR Fix TKCDR's losing track of job.
4(244) 22-Nov-80 KR Make signoff process more informative
Also fix CTSGOF register problem
8-JAN-81 TOPS-10 FTT #1
4(245) 12-JAN-81 RLS swap a pop and store instruction in
SGNTSK - effect was to forget all pending signals
whenever any new signal to a task was done.
This fixes(hopefully) 2780/3780 problem where
a card job waiting for lpt io done is forgotten.
Similar problem with console messages.
Removed temporary patch in CDEXT which
went out on FTT #1.
4(246) 26-FEB-81 KR Fix IBMLFR to pass record count and not mung T1
for USRLPT.
4(247) 03-MAR-81 RLS Add NDLESS flag to S to warn downstream processors
of input records that the record has no LF.
Add lots of abort messages and abort checking- sned
IO abort command to FE (D60OPR - .MOABT).
Make IPCF message error messages more explicit.
Requeue/HOLD NEXTJOB request when it cannot be
processed for a variety of reasons.
Ignore possible line error states when doing cleanup
in signon/signoff tasks.
COPY now will make sure input function sees ABORT
flag when output function sees fatal error conditions
- prevents open files from hanging around.
GETDSK now checks his buffer limits while looking
for LF - sets NDLESS if buffer filled before LF
seen.
Add new function ABTDEV - aborts IO on a device.
Make copy/rename function in DISPOS insist on new
file generation - use extension modification if
necessary to get unique file name.
remove error message when receiving tex type IPCF
message - QUASAR now sends them to see who is alive.
4(250) 23-Mar-81 RLS Polling now done every time main scheduler wakess
from its idle sleep, but not oftener than once per
second. Polling interval(POLINT) lengthened to
5 seconds. PUTIBM,GETIBM set their own retry timers
so polling is for new device activity only.
If next wakeup time in scheduler is less than 1
second in the future, the clock is advanced to
avoid the overhead of sleeping and waking.
PUTIBM fixed to update byte xferred count only
after successfully outputting a string.
4(251) 25-Mar-81 RLS Add timeout and associated error message to line
conditioning(SETALL). Add error message for D60
error failure of line condition. Change signon
timeout to 15 minutes. Now will only be applied to
lines with signon required, others will still
sign on but will not be timed.
Replace all references to ERRIBM with use of
itext D60ERM.
Replace all refereences to GLXERR with use of
itext DGLXER.
4(252) 17-APR-81 RLS Fix FILE to not requeue jobs whose input open
failed. Error msg removed from INPOPN.
4(253) 6-May-81 CLB Add CHGSTR routine for TOPS20's use.
Increase size of per task PDL = TKPDLN
4(254) 6-May-81 WEM Fix problem of rename to existing file not
causing an error return. Symptom is older
file gets superceded.
This edit will be obsolete when F%REN on
TOPS20 is patched to detect this case.
4(255) 6-May-81 WEM INIQRQ fails to append NUL to filename it is
working on. Fix it.
4(256) 7-MAY-81 RLS Fix problem of CHGNAM assuming that the
filename it is working with has a directory
field. Now it will assume that the logical
name field is present.
4(257) 8-MAY-81 WEM Fix same problem fixed by edit 256 to
CHGNAM in CHGUSR and CHGSTR.
4(261) 12-May-81 WEM Modify code to handle input and output
aborts more reliably. If an incoming file
is aborted, dispose of the file normally
but with a distinct filename.
4(262) 20-MAY-81 RLS Move opening of hold file to PUTDSK from
LPTJOB - avoids opening file for IBM null
file case.
4(263) 19-Jun-81 WEM Bug fixes in PUTDSK and IBMLF0
Add code to handle DISPOS failure in OPNOLD
4(264) 23-Jul-81 WEM Improve inport abort handling.
4(265) 27-Jul-81 WEM Fix handling of ERFNF$ error in DISPOS.
Specifically, check for case of ERFNF$ being
returned for destination filename problems.
4(266) 20-AUG-81 RLS Set L.SND in L.STS at CTSGO3. Fixes problem
of abrupt shutdown of line(2780/3780) when only
lpt job is active(ie, no card jobs pending).
4(267) 22-OCT-81 TJW Added accounting routines and database
(first pass)
4(270) 02-NOV-81 RLS Added poll estimate usage...various bug fixes.
4(271) 04-NOV-81 RLS Changed status display to use .ORDSP form of
message.
4(272) 17-NOV-81 RLS Remove 264 - makes it complain bitterly about
every null file sent by IBM.
4(273) 19-NOV-81 RLS Add xfer rate to status messages.
4(274) 23-NOV-81 TJW Fix IBMSPL to not try to talk to a terminal
when it can't find QUASAR
4(275) 23-NOV-81 TJW Add REQUE message processor
4(276) 25-NOV-81 RLS fix various obscure bugs. detect input abort
more reliably in GETIBM. Add output abort
processing to PUTIBM. Check for it in FILE.
4(277) 01-DEC-81 RLS Change console pattern matching conventions to
match 1st line of file only. New S switch
created(CONPAT). New parameter(CONLMT) created
to turn off CONPAT if file too big.
4(300) 01-DEC-81 RLS Add T.TFS and T.TFD variables to task data base
to receive actual io start time and done time.
Flag IOBEG in S added to gate checking for
start time.
4(301) 02-DEC-81 RLS Change $DSCHD macro to accomodate use of
variable sleep time.
4(302) 07-DEC-81 TJW Fix accounting to work for both input and output
4(303) 09-DEC-81 TJW Fix requeue logic to handle jobs which are
waiting on line turnaround
4(304) 28-DEC-81 RLS Remove crock put in to append portions of hold
file name to /LNAM request(TOPS-20).
4(305) 29-DEC-81 TJW Fix several bugs in accounting stuff having to
do with register allocation. Fix the handling
deleted control files. etc.
4(306) 25-FEB-81 RLS Make DISABL more aggressive.
4(307) 04-MAR-82 RLS Restructure "MAIN" scheduler loop SCHED/DESCHD
to get more responsiveness to front end line
conditions. Might also improve response to OPR
requests.
4(310) 07-MAR-82 RLS GCO 4.2.1249 - Add CHKSNZ's to GETIBM,PUTIBM.
Make use of conditional FTCLOG since we don't
use the feature.
4(311) 07-MAR-82 RLS GCO 4.2.1251 - set FR.NFO in FRB for DISPOS
rename.
4(312) 08-MAR-82 RLS GCO 4.2.1254 - delete PNAME entry when mapping
LSTR to D60:.
4(313) 08-MAR-82 RLS GCO 4.1.1255 - send response to shutdown after
all shutdown processing is complete.
4(314) 10-MAR-82 RLS GCO 4.2.1261 - check for input abort and input
eof at CDTURR.
4(315) 23-MAR-82 RLS GCO 4.2.1293 - at DCPF2C, delete LSTR entry and
call INIQRF to recreate default file name.
4(316) 29-MAR-82 RLS GCO 4.2.1308 - in FILE, set requeue flag(RQB) w
with ABORT at FILE2D so line errors cause job to
be requeued. Don't set hold flag(RQ.HBO in
REQ.FL) in QRLSE.
4(317) 21-APR-82 RLS GCO 4.2.1328 - use F%RREL to close output file
at DCPFCL in DISPOS copy routine.
4(320) 21-APR-82 RLS GCO 4.2.1330 - use T.TYP as index into set of
device names for "file queued to device" message
in DISPOS.
4(321) 04-MAY-82 RLS GCO 4.2.1338 - fix field alignment in status
msg. add cdr performance statistics. change
wording of lpt status mesgs.
4(322) 27-MAY-82 RLS GCO 4.2.1349 - make GETLNO not wait forever on
D6NBR returns.
4(323) 09-JUN-82 RLS GCO 4.2.1379 - close file in PUTDSK if output
error occurs.
4(324) 18-JUN-82 RLS GCO 4.2.1392 - in GETIBM account for input done
on input aborts.
4(325) 23-JUN-82 TJW GCO 4.2.1395 - answer to QAR 20-01022 - clear
input and output record counts when starting
a new job.
4(326) 24-JUN-82 RLS GCO 4.2.1397 - in GETLNO, don't save S1.
4(327) 30-JUN-82 TJW GCO 4.2.1413 answer to QAR 20-01011. fix
SETACT to build .QCACT correctly
4(330) 08-JUL-82 RLS GCO 4.2.1428 - use default sleep time in DISABL
4(331) 12-JUL-82 RLS GCO 4.2.1444 - use T.ICT instead of T%ICT at
IBMLFE to get record for user exit.
4(332) 15-JUL-82 RLS GCO 4.2.1448 - at PUTIB2, don't sleep if last
sout transferred nonzero number of bytes.
4(333) 19-JUL-82 RLS GCO 4.2.1453 - in DISPOS, interlock use disposal
to avoid interference in FDBARE usage.
4(334) 21-JUL-82 RLS GCO 4.2.1459 - in FILE, if input file fails to
open just send a message and do not abort line.
4(335) 29-JUL-82 RLS GCO 4.2.1471 - in PRCQRQ, if there is a PNAME
entry but not an LSTR entry, insert real name
of structure of D60:.
4(336) 01-AUG-82 RLS GCO 4.2.1475 - don't return ptr in P3 from
INIQRQ/INIQRF.
4(337) 09-UAG-82 RLS GCO 4.2.1486 - POLEST can be 0
GCO 4.2.1487 - Add fcn LINCHK which rules on
line viability and use it in appropriate places
GCO 4.2.1488 - add timer in CTSGOFF after sending
signoff card so JESx systems can send one last
message.
4(340) 16-AUG-82 RLS GCO 4.2.1490 - in ABTDEV, also do an eof for
hasp output devices.
4(341) 18-AUG-82 RLS GCO 4.2.1493 - in INSENT, specifically clear
word after end of list after all inserts and
deletes.
4(342) 23-AUG-82 RLS GCO 4.2.1500 - in SNDCI, fill out last word of
copied OPR message with nulls.
4(343) 24-AUG-82 RLS GCO 4.2.1502 - in CTSGOF, protect control task
pointer better while sending signoff file.
4(344) 08-AUG-82 RLS GCO 4.2.1509 - at GETIRT check if buffer still
has characters left and take normal exit if so,
not checking for eof.
4(345) 20-SEP-82 RLS GCO 4.2.1512 - put tops20 conditional around
call to RELSTR.
4(346) 01-OCT-82 TJW GCO 4.2.1518 fixup output spooler accounting
record
4(347) 04-nov-82 TJW GCO 4.2.1527 Fix bad WTO for accounting
failure.
4(350) 13-NOV-82 DEK GCO 4.2.1528 Fix Copyright.
&
SUBTTL Symbol definitions -- AC Definitions
; Preserved AC's
J=:13 ; Job context pointer (address of 3-page area:
; request page, buffer page, log buffer page)
LB=:14 ; Line block pointer
TK=:15 ; Task block pointer
S=:16 ; Status flags
; Symbolic register definitions for when absolute register numbers
; must be used (so we can see them in the cross reference)
REGS ; Generate mnemonic names for physical
; registers, i.e. R0, R1, etc.
SUBTTL Symbol definitions -- Feature Test Switches
COMMENT &
The following symbols enable or disable certain features in IBMSPL; the
only supported settings of these switches are the default settings given
below (although it is expected that this may change in the future).
All the symbol enable the feature with a non-zero value, and disable the
feature with a zero value WITH ONE EXCEPTION, namely FTDEBUG which (for
ease of assembly) enables the debug code if defined (with any value) and
disables the debug code if undefined. Its default is undefined, and it
is not included in the list below.
These feature test symbols are then converted to macros, to make testing
for the feature easier (and more readable) in the code. Each macro has the
same name as the feature test switch.
&
ND FTLOG, 0 ; Log files for users
ND FTACCT, -1 ; Accounting
ND FTCLOG, 0 ; IBMSPL central log file
ND FTIBMS, 0 ; Support for the IBM program
DEFINE FTLOG <IFN FTLOG>
DEFINE FTACCT <IFN FTACCT>
DEFINE FTCLOG <IFN FTCLOG>
DEFINE FTIBM <IFN FTIBMS>
DEFINE FACT <IFN FTFACT,>
SUBTTL Symbol definitions -- Parameters
; Parameters which may be changed at assembly time
ND PDSIZE,120 ; Size of pushdown list
IFN FTDEBUG,<
ND TKPDLN,250 ; Bigger stack if debugging
>;End if FTDEBUG
ND TKPDLN,150 ; Size of per task PDL
ND LGNUM,10 ; Number of log pages to keep
ND MAXDEV,^D50 ; Maximum number of devices we will service
ND INSIGN,^D15 ; Time delay between receipt and
; start of job considered insignificant
ND CHKCNT,^D200 ; Number of records between checkpoints
; of the "hold" files for input from IBM
ND CHKRTV,^D10 ; Number of records between checkpoint
; attempts if an error occurred on the
; last checkpoint
ND SNZINT,^D1 ; Number of desched checks before a
; task will for forced to deschedule
ND PATPLN,^D250 ; Length of stack for pattern matching
; System dependent parameters
SYSPRM SYSNML,5,10 ; Number of word in system name
; Constant parameters
XP MSBSIZ,30 ; Size of message block
XP MXLNBT,^D40 ; Maximum bytes on a line of status info
XP MXCDBF,<^D80/4>+2 ; Maximum record buffer size for card reader
XP MXLPBF,<^D144/5>+2 ; Maximum record buffer size for printer
XP POLINT,^D10*3 ;[261] Polling interval, in UDT units - when all is quiet
XP SPLINT,^D5*3 ; sampling interval for 2780/3780 to check for input
XP CONLMT,^D5000 ; maximum allowable size for console message in
; 2780/3780...larger is DISPOS'd of.
SUBTTL Symbol definitions -- External symbol definitions
EXTERNAL D60INI,D60OPN,D60SIN ; D60JSY routines
EXTERNAL D60SOU,D60EOF,D60STS
EXTERNAL D60RLS,D60OPR,D60CND
EXTERNAL D60DIS
EXTERNAL POLEST ; D60JSY's estimate of next optimal poll time
EXTERNAL STSBUF ; D60JSY full status buffer - referenced
; by D60UNV field definition macroes
EXTERNAL USRCDR,USRLPT,USRCDP ; User exits to validate records
EXTERNAL PATLOG,PATSWT,DOSWT ; Pattern matching entries to IBMPAT
SUBTTL Symbol definitions -- Device/task type codes
.TCTL==0 ; Control task type
.TLPT==1 ; LPT device type
.TCDP==2 ; CDP device type
.TCDR==3 ; CDR device type
.TCNI==4 ; Console in device type
.TCNO==5 ; Console out device type
.TSND==6 ; "Send console messages to "watchers"
; (programs OPR and IBM) task type
; NOTE: the routine BLDTSK uses the fact that all the device
; (as opposed to task) codes are contiguous and begin with .TLPT
; and end with .TCNO.
SUBTTL Symbol definitions -- Message processor status bits (in S)
F.IPCSY==1B0 ; Message was from a GALAXY component
F.HASP==1B1 ; Request was for a HASP line
SUBTTL Symbol definitions -- Task status bits (in S while task is running)
DSKOPN==1B0 ; Disk file is open
ABORT==1B1 ; We should abort
GOODBY==1B2 ; We are cleaning up
QSRREQ==1B3 ; Request page has data in it
ACTIVE==1B4 ; Active (i.e. console msgs should be logged)
JVALID==1B5 ; Pointer to job pages is set up
RQB==1B6 ; Job must be requeued
INPEOF==1B7 ; Input EOF seen
OUTEOF==1B8 ; Flag to write output EOF
CHECK==1B9 ; Checking of records should be done (in COPY)
HASP==1B10 ; We are doing hasp
FLSH==1B11 ; We are flushing input before signalling EOF
CHKLOG==1B12 ; Check for console output in IBM output
CONPAT==1B13 ; input file is console output
CHKSWT==1B14 ; Check for user switches in IBM output
DOCHKP==1B15 ; Do checkpoints on output file
NOCTLS==1B16 ; Convert ^S (23 octal) to LF (12 octal)
; (self-resetting on input EOF)
LGA==1B17 ; Line has gone away
TCR==1B18 ; CR seen in input IBM stream
PEOF==1B19 ; pretend end-of-file when no input
; (GETIBM for console)
NDLESS==1B20 ; this input record has no line feed
IOABT==1B21 ;[261] soft abort has been seen on line
NODEL==1B22 ; INSENT should not replace an already
; existing entry of the same type
IOBEG==1B23 ; set until 1st nonblank record transferred
; to/from front end
SUBTTL Symbol definitions -- Checkpoint request block offsets (from QUASAR)
XP CKFIL,0 ; Number of files processed
XP CKTRS,3 ; Total records processed
XP CKFLG,4 ; Flags
XP CKFREQ,1B0 ; Requeued by operator
XP CKFCHK,1B1 ; Job was checkpointed
SUBTTL Symbol definitions -- Create queue entry message offsets (from QUASAR)
XP CQBEG,MSHSIZ+2 ; Beginning of entries
XP CQARGN,MSHSIZ+1 ; Number of entries (arguments)
SUBTTL Symbol definitions -- DN60 Port status device active bits
XP LP0BIT,1B23 ; LPT0 active
XP CP0BIT,1B31 ; CDP0 active
XP CR0BIT,1B15 ; CDR0 active
XP CNIBIT,1B1 ; Input console active
XP CNOBIT,1B0 ; Output console active
XP BUNUSD,1B2+1B3+1B4+1B5+1B6+1B7 ; Unused bits (line abort)
SUBTTL Macro definitions -- $DSCHD, de-schedule a task
; Macro - $DSCHD
;
; Function - Set wake conditions and return to scheduler (de-schedule).
;
; This macro generates code that sets the bits for wakup conditions and
; the wakeup delay time and calls the scheduler. If an argument is
; omitted the corresponding function is not done.
;
; Parameters -
;
; BITS Bits defining wakeup event flags
; or keywords:
; DELETE Indicates task no longer exists
; DEACTIVATE Indicates task is removed from ATL
; TIME Time delay (in 1/3 secs) for unconditional wakeup
DEFINE $DSCHD (BITS,TIME) <
%%.DS==0 ;; Flag keyword not found yet
IFIDN <BITS>,<DELETE>,< ;; If task has been deleted
SETZ TK, ;; Clear task block pointer
PJRST DESCHD ;; Jump back to MAIN context
%%.DS==-1
> ;;End if DELETE
IFIDN <BITS>,<DEACTIVATE>,< ;; If task has been deactivated
SETZB TF,CURATE ;; Clear Active Task List pointer
$CALL DESCHD ;; Call descheduler
%%.DS==-1
> ;;End if DEACTIVATE
IFE %%.DS,< ;; If normal task descheduling
MOVX TF,<BITS,,TIME> ;; Set wakeup conditions
$CALL DESCHD ;; Call descheduler
> ;;End if normal deschedule
>;End DEFINE $DSCHD
DEFINE VDSCHD (BITS,TIME) <
MOVE TF,TIME ;; Set wakeup conditions
HRLI TF,<BITS>
$CALL DESCHD ;; Call descheduler
>;END VDSCHD
SUBTTL Macro definitions -- $SIGNL, indicate wakeup condition
; Macro - $SIGNL
;
; Function - To signal either a task or all the tasks on a line of a
; schedulable event. Any task that matches it's wakeup flags
; against the event signaled to it on the next scheduler pass
; is run.
;
; Parameters -
;
; BITS Wakeup event flags
; TYPE "LINE" or "TASK", the default is "TASK"
DEFINE $SIGNL (BITS,TYPE<TASK>) <
XLIST
..TM==0
IFIDN <TYPE>,<TASK>,<
MOVEI S1,BITS
$CALL SGNTSK
..TM==1
>;END IFIDN <TYPE>,<TASK>
IFIDN <TYPE>,<LINE>,<
MOVEI S1,BITS
$CALL SGNLIN
..TM==1
>;END IFIDN <TYPE>,<LINE>
IFE ..TM,<
PRINTX ?Illegal argument "type" in $SIGNL call -- using TASK
MOVEI S1,BITS
$CALL SGNTSK
>;END IFE ..TM
PURGE ..TM
LIST
>;End DEFINE $SIGNL
SUBTTL Macro definitions -- $WATCH, queue message for watchers macro
DEFINE $WATCH (STRING) <
$CALL WATCH
CAI [ASCIZ %'STRING'%]
>;End DEFINE $WATCH
SUBTTL Macro definitions -- SKPTSK, skip if in task context
DEFINE SKPTSK <
SKIPN CURATE
>;End DEFINE SKPTSK
SUBTTL Macro definitions -- D60, call D60JSY and analyze error return
DEFINE D60 (FNC,RTRY,WTIM) <
XLIST
$$WTIM==3
IFNB <WTIM>,<$$WTIM==WTIM>
CAIA
JRST .+3
MOVE TF,[@[FNC
$$WTIM
RTRY]]
$CALL D60ANL
LIST
>;End DEFINE D60
SUBTTL Database definitions -- Random static storage
LOWBEG==. ; Start of area to zero
; Scheduler cells
NOW: BLOCK 1 ; Current date/time (in UDT format)
WAKTIM: BLOCK 1 ; Time when to do next task scheduling loop
POLTIM: BLOCK 1 ; Time when to poll active devices on all ports
LSTPOL: BLOCK 1 ; last time poll happened
CURATE: BLOCK 1 ; Address of current Active Task List entry
SCHDGO: BLOCK 1 ; If non-zero, do another scheduling pass
; Handles for data structure linked lists
LBNAM: BLOCK 1 ; Handle for line block list
TSKNAM: BLOCK 1 ; Handle for task block list
ATLNAM: BLOCK 1 ; Handle of list of (potentially) active tasks
WATNAM: BLOCK 1 ; Handle for watcher list
PTLNAM: BLOCK 1 ; Handle for port list
; Environmental information
CNF: BLOCK SYSNML ; Monitor name string
CNTSTA: BLOCK 1 ; Node number of central station
TOPS20 <
SPLDIR: BLOCK 1 ; Directory number for PS:<SPOOL>
>;End if TOPS20
; IPCF Message handling cells
MDBADR: BLOCK 1 ; Message data block address for IPCF
SAB: BLOCK SAB.SZ ; Send argument block for sending messages
MSGBLK: BLOCK MSBSIZ ; Block to build messages in
MSGLIM: BLOCK <<MXLNBT+4>/5>+1 ; Buffer area for status line overflow
; Multiple device status return block
DEVBTS: BLOCK ^D12 ; Twelve lines maximum
BLOCK 1 ; (overrun protection)
; Block in which to build FDB's
DSPLOK: BLOCK 1 ; DISPOS interlock
FDBARE: BLOCK FDXSIZ ; Maximum area for file name
; File rename block
FRB: BLOCK FRB.SZ ; Maximum size
REALST: BLOCK 2 ; holds real structure name
LOWEND==. ; End of zeroed area plus 1
IBMDEV: ; logical device name for hold file
TOPS10 <SIXBIT /D60/> ; use ersatx device
TOPS20 <ASCIZ /D60/ ; use system logical name
HLDDVW==.-IBMDEV
>
; Pattern matching and scanning stack/AC preservation area
PATPDL: BLOCK PATPLN ; Reserve space for it
.LACS:: BLOCK 20 ; AC save area for record examine rtns
; Signon/Signoff file cells
SGNFOB: EXP SGNFDB ; Address of FDB
EXP 7 ; Byte size
TOPS10 <
SGNFDB: XWD 5,0 ; Length of FDB
SIXBIT /D60/ ; Device name
SGNNAM: EXP 0 ; Filename (station name)
SGNTYP: EXP 0 ; Extension (.SON or .SOF)
EXP 0 ; PPN
>;End if TOPS10
TOPS20 <
SGNTYP: EXP 0 ; Temporary pointer to extension
SGNFDB: XWD 1+^D8,0 ; Length of FDB
SGNFSP: BLOCK ^D8 ; Reserve at most 39 characters
>;End if TOPS20
PDLSAV: BLOCK 1 ; Temporary storage for stack pointer
PDL: BLOCK PDSIZE ; Stack for MAIN context
;Random accounting locations
;DAEMON block for FACT accounting
TOPS10<
FACT< EXP .FACT ;DAEMON WRITE FACT FILE FUNCTION
FACTBL: BLOCK 13 > ;FACT BLOCK FILLED IN
>
L.JOB: BLOCK 1 ;job number
L.TTY: BLOCK 1 ;tty designator
L.LINE: BLOCK 1 ;tty line number
L.NODE: BLOCK 1 ;node name
NODNUM: BLOCK 1 ;node number
TOPS10<
ACTPNM: BLOCK 1 ;holds PPN
>;End of TOPS10 Conditional
TOPS20<
ACTPNM: BLOCK 10 ;holds user name
>;End of TOPS20 Conditional
ACTACT: BLOCK 10 ;holds account string
SUBTTL Database definitions -- Constant static storage
TOPS10 <
INTVEC==VECTOR ; Define interrupt vector address
>;End if TOPS10
TOPS20 <
INTVEC==:LEVTAB,,CHNTAB ; Define interrupt vector address
>;End if TOPS20
SUBTTL Database definitions -- IB, Initialization block for GLXLIB
IB: $BUILD IB.SZ ; Initialization block
$SET (IB.PRG,,%%.MOD) ; Sixbit program name (from PROLOG)
$SET (IB.INT,,INTVEC) ; Interrupt system base
$SET (IB.OUT,,T%TTY) ; Global TTY handling routine
$SET (IB.PIB,,PIB) ; Address of PSI block
$SET (IB.FLG,IP.STP,1) ; Send stopcodes to ORION
$EOB
PIB: $BUILD PB.MXS ; PSI information block
$SET (PB.HDR,PB.LEN,PB.MNS) ; Length of block is standard
$SET (PB.FLG,IP.PSI,1) ; PSI notification of IPCF message
$SET (PB.INT,IP.CHN,0) ; Use PSI channel 0
$SET (PB.FLG,IP.RSE,1) ; Return send errors immediately
$SET (PB.SYS,IP.SQT,511) ; Its send quota is large
$SET (PB.SYS,IP.RQT,511) ; Likewise its receive quota
$SET (PB.NAM,FWMASK,IBMNAM) ; Set name to be
$EOB
SUBTTL Database definitions -- HELLO, message for QUASAR at startup
HELLO: $BUILD HEL.SZ ; "HELLO" message block
$SET (.MSTYP,MS.TYP,.QOHEL) ; Message type is "hello" message (1)
$SET (.MSTYP,MS.CNT,HEL.SZ) ; Its size
$SET (HEL.NM,,<'IBMSPL'>) ; Name of the spooler in SIXBIT
$SET (HEL.FL,HEFVER,%%.QSR) ; QUASAR version
$SET (HEL.NO,HENNOT,1) ; Max objects spooler handles
$SET (HEL.NO,HENMAX,MAXDEV) ; Max number of jobs it will handle
$SET (HEL.OB,,.OTIBM) ; Object
$EOB
; The following is the message that is send to QUASAR to indicate
; activity using the DN60-IBMCOM
IFN FTIBMS,<
IBMSTM: $BUILD (MSHSIZ+1) ; Header plus status
; word
$SET (.MSTYP,MS.CNT,MSHSIZ+1) ; Length of message
$SET (.MSTYP,MS.TYP,.QOIBM) ; IBMCOM statistics is
; message type
$EOB ; Everything else is
; zero
> ;End of FTIBMS
SUBTTL Database definitions -- ITEXT strings
; USRSPC is user'S name and PPN (TOPS10) or directory (TOPS20)
TOPS10 <
USRSPC: ITEXT (<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/ ^U/.EQOID(J)/>)
>;End if TOPS10
TOPS20 <
USRSPC: ITEXT (<^T/.EQOWN(J)/>)
>;End if TOPS20
;miscellaneous msgs
OLPTER: ITEXT (<failed to open hold file ^F/FDBARE/ - cannot receive lpt input.>)
DGLXER: ITEXT (<error "^E/S1/">)
DCPERM: ITEXT (<copying hold file ^F/@FRB/ to user file ^F/@FRB+1/>)
IBMOAB: ITEXT (<aborting output to IBM>)
IBMIAB: ITEXT (<aborting input from IBM>)
WRTFLM: ITEXT (<while writing file ^F/(P3)/>)
D60ERM: ITEXT (<error "^T/@ERRD60-D6HEAD(S1)/">)
; Log file stamps
IBMSG: ITEXT (<^C/[-1]/ IBMSG >)
IBDAT: ITEXT (<^C/[-1]/ IBDAT >)
IBCON: ITEXT (<^C/[-1]/ IBCON >)
IBLPT: ITEXT (<^C/[-1]/ IBLPT >)
JOBID: ITEXT (<^I/JOBREQ/ for: ^I/USRSPC/>)
JOBREQ: ITEXT (<Job ^W/.EQJOB(J)/ Req # ^D/.EQRID(J)/>)
SUBTTL Symbol definitions -- D60JSY interface
; Error codes & messages
ERRD60: D60ERR ASSTXT ; Invoke error definitions
SUBTTL Database definitions -- Miscellaneous cells
WTORNM: EXP 5000 ; ACK code to usr for WTOR (incremented)
MSNDR: Z ; last IPCF msg sender name
; Dummy Object block
OBJBLK: EXP .OTIBM ; We are an IBM object
EXP 0 ; No unit number
EXP 0 ; No station
; Text processing utility
TEXTBP: Z ; Byte pointer used by DEPBP
DEPBP: IDPB S1,TEXTBP ; Store byte at byte pointer
$RETT ; and return true
; Miscellaneous storage
PRTFAL: Z ;poll flag for port status failure
SUBTTL Database definitions -- Interrupt system database
TOPS10 <
VECTOR: BLOCK 0 ; Start of interrupt vectors
VECIPC: BLOCK 4 ; IPCF vectors
ENDVEC==.-1 ; Symbol marking last vector
>;End if TOPS10
TOPS20 <
LEVTAB: EXP LEV1PC ; Where to store level 1 PC
EXP LEV2PC ; Where to store level 2 PC
EXP LEV3PC ; Where to store level 3 PC
CHNTAB: XWD 1,INTIPC ; IPCF interrupt on level 1
BLOCK ^D35 ; Rest of table
LEV1PC: EXP 0 ; Level 1 PC
LEV2PC: EXP 0 ; Level 2 PC
LEV3PC: EXP 0 ; Level 3 PC
>;End if TOPS20
SUBTTL Dynamic storage definitions -- Active task list (ATL) entry "A.xxx"
; !=======================================================!
; ! Time to wake up in UDT format !
; !-------------------------------------------------------!
; ! Wakeup event bits ! Address of task block !
; !=======================================================!
DATAST A,S2 ; Data structure prefixed by "A"
; offset by register S2
$ WKT ; Time to wakeup (UDT) or 0
$ WKB,^D18 ; Wakeup conditions that occurred
$ TKB,^D18 ; Address of task block
$ ; Force new word
$ SIZ,0 ; Size of block
SUBTTL Dynamic storage definitions -- Port list entry "P.xxx"
; !=======================================================!
; ! Port number !
; !-------------------------------------------------------!
; ! First list block ! Last line block !
; !=======================================================!
DATAST P,P1 ; Data structure prefixed by "P"
; offset by register P1
$ PRT ; Port number
$ CHN,,,1 ; Chain of line blocks on this port
$. FLB,^D18 ; First line block
$. LLB,^D18 ; Last line block
$
$ SIZ,0 ; Size of port list entry
SUBTTL Dynamic storage definitions -- Line block list entry "L.xxx"
; !=======================================================!
; ! Line status !
; !-------------------------------------------------------!
; ! First task block ! Last task block !
; !-------------------------------------------------------!
; ! Port number ! Line number !
; !-------------------------------------------------------!
; ! Line signature !
; !-------------------------------------------------------!
; ! Station name (SIXBIT node name) !
; !-------------------------------------------------------!
; ! Next line block ! Previous line block !
; !-------------------------------------------------------!
; ! Console output queue ! Console input queue !
; !=======================================================!
DATAST L,LB ; Data structure prefixed by "L"
; offset by register LB
$ STS,,,1 ; Status bits
L.SND==1b0 ; Signed on
L.SFR==1b1 ; Signoff requested
L.SFS==1b2 ; Signoff sent
L.UP==1b3 ; Line up
L.HSP==1b4 ; Line is HASP
$ TKB,,,1 ; Task block chain head
$. FTK,^D18 ; First task in chain
$. LTK,^D18 ; Last task in chain
$ LNI,,,1 ; Line information
$. PRT,^D18 ; Port
$. LIN,^D18 ; Line on port
$ SIG ; Line signature
$ NAM ; Station name (for SIGNON/OFF)
$ CHN,,,1 ; Chain of LB's on port
$. PFW,^D18 ; Forward pointer
$. PBK,^D18 ; Backward pointer
$ CNO ; Console output queue (from IBM)
$ CNI ; Console input queue (to IBM)
$
$ SIZ,0 ; Size of line block
SUBTTL Dynamic storage definitions -- Task block list entry "T.xxx"
; !=======================================================!
; ! Wakeup event flags ! Wake time delay (1/3 sec) !
; !-------------------------------------------------------!
; ! Events causing wakeup ! Active task list entry !
; !-------------------------------------------------------!
; ! !
; \ Task's registers \
; ! !
; !-------------------------------------------------------!
; ! !
; \ Task's stack \
; ! !
; !-------------------------------------------------------!
; ! Task/device type ! Unit number !
; !-------------------------------------------------------!
; ! Next task on line ! Previous task on line !
; !-------------------------------------------------------!
; ! queue for device requests !
; !-------------------------------------------------------!
; ! Address of object block !
; !-------------------------------------------------------!
; ! Object type !
; !-------------------------------------------------------!
; ! Object unit !
; !-------------------------------------------------------!
; ! Object node !
; !-------------------------------------------------------!
; ! Device handle for D60JSY !
; !-------------------------------------------------------!
; ! Bit for this device in activity status !
; !-------------------------------------------------------!
; ! $WTOR ACK code !
; !-------------------------------------------------------!
; ! Initial byte pointer for transmission buffer !
; !-------------------------------------------------------!
; ! !
; \ Addresses of log pages \
; ! !
; !-------------------------------------------------------!
; ! Count of log pages in use !
; !-------------------------------------------------------!
; ! Count of log lines !
; !-------------------------------------------------------!
; ! Input byte count !
; !-------------------------------------------------------!
; ! Input byte pointer !
; !-------------------------------------------------------!
; ! State string address ! Other task (2780/3780) !
; !-------------------------------------------------------!
; ! Time job received !
; !-------------------------------------------------------!
; ! Time job started !
; !-------------------------------------------------------!
; ! Time file started !
; !-------------------------------------------------------!
; ! Time file done !
; !-------------------------------------------------------!
; ! Number of files in request !
; !-------------------------------------------------------!
; ! Number of files processed !
; !-------------------------------------------------------!
; ! Number of records transferred !
; !-------------------------------------------------------!
; ! Log file spec address !
; !-------------------------------------------------------!
; ! Address of "get" record routine !
; !-------------------------------------------------------!
; ! Address of "put" record routine !
; !-------------------------------------------------------!
; ! Last "get" error ! Last "put" error !
; !-------------------------------------------------------!
; ! Address of "check" record routine !
; !-------------------------------------------------------!
; ! Checkpoint routine address !
; !-------------------------------------------------------!
; ! Record buffer address !
; !-------------------------------------------------------!
; ! Record buffer size(bytes) !
; !-------------------------------------------------------!
; ! Record buffer byte count !
; !-------------------------------------------------------!
; ! Record buffer byte pointer !
; !-------------------------------------------------------!
; ! Disk buffer byte count !
; !-------------------------------------------------------!
; ! Disk buffer byte pointer !
; !-------------------------------------------------------!
; ! Transmission buffer byte count !
; !-------------------------------------------------------!
; ! Transmission buffer byte pointer !
; !-------------------------------------------------------!
; ! LH of ptr for Xmt buffer ! Max bytes in Xmt buffer !
; !-------------------------------------------------------!
; ! Unique transaction name !
; !-------------------------------------------------------!
; ! Input record count !
; !-------------------------------------------------------!
; ! Output record count !
; !-------------------------------------------------------!
; ! Output records left before next checkpoint !
; !-------------------------------------------------------!
; ! Transfer count for forced task descheduling !
; !-------------------------------------------------------!
; ! Cumulative bytes transferred for current job !
; !-------------------------------------------------------!
; ! Job's priority !
; !-------------------------------------------------------!
; ! Queue name !
; !-------------------------------------------------------!
; ! Sequence number !
; !-------------------------------------------------------!
; ! Physical device name !
; !-------------------------------------------------------!
; ! Disposition !
; !-------------------------------------------------------!
; ! Scheduled time !
; !-------------------------------------------------------!
; ! Destination node name !
; !-------------------------------------------------------!
; ! Job name !
; !=======================================================!
DATAST T,TK ; Data structure prefixed by "T"
; offset by register TK
$ STS,,,1 ; Task wakeup status
$. WKB,^D18 ; Desired wakeup bits
TW.WAK==1B18 ; Wake by another task
TW.QRQ==1B19 ; QUASAR request received
TW.LGN==1B20 ; Line gone
TW.SFR==1B21 ; Signoff requested
TW.CIR==1B22 ; Console input received
TW.COR==1B23 ; Console output received
TW.WMR==1B24 ; Watch/unwatch message received
TW.SMR==1B25 ; Send message received
TW.SNR==1B26 ; Signon requested
TW.SND==1B27 ; Signon done
TW.ICP==1B28 ; Input complete
TW.CNI==1B29 ; Console input queued to CNI queue
TW.IAV==1B30 ; Input available
TW.CNO==1B31 ; Console output queued to CNO queue
TW.IOD==1B32 ; Input/output done
TW.GEN==1B35 ;** special wakeup bit for generous tasks **
; causes a scheduling pass to let
; other tasks run, then wakes up
; original task. The task merely
; turns on TW.GEN in its $DSCHD call;
; it is self-signalling and results
; in a time wakeup (i.e. TW.GEN is
; not set).
$. WKD,^D18 ; Wake time delay (in UDT units)
$ WCN,^D18 ; Wakeup conditions causing SCHED
$ ATE,^D18 ; Entry in active task list
$ ACS,,20 ; Task's AC's
$ PDL,,TKPDLN ; Task's stack
$ DEV,,,1 ; Device information
$. TYP,^D18 ; Device (or task) type
$. UNI,^D18 ; Unit number
$ CHN,,,1 ; Chain of tasks on a line block
$. PFW,^D18 ; Forward link
$. PBK,^D18 ; Backward link
$ QOB ; queue object type for queue request
; to QUASAR
$ OBA ; Address of object block
$ OBJ,,3,1 ; Object block
$. OTY ; Type
$. OUN ; Unit
$. ONO ; Node
$ DHA ; Device handle from D60JSY
$ BIT ; Bit representation for this device
$ WAC ; $WTOR ack code
$ XBA ; Initial byte pointer for xmt buffer
$ GBA,,LGNUM ; Addresses of log pages
$ GCT ; Count of log pages in use
$ GLN ; Count of log lines
$ GIC ; Input byte count
$ GIP ; Input byte pointer
$ DST,^D18 ; State description address (ASCIZ)
$ OTK,^D18 ; Other task address (used by 2780/3780
; CDR to save LPT and LPT to save CDR
$ TMR ; Time job received
$ TMS ; Time job started
$ TFS ; Time of 1st io to/from front end
$ TFD ; Time of last io to/from front end
$ NFL ; Number of files in request
$ NFP ; Number of files processed
$ NRS ; Number of records transferred
$ LFS ; Address of log file spec
$ GTR ; Address of routine for gets
$ PTR ; Address of routine for puts
$ GTE,^D18 ; Last error on get
$ PTE,^D18 ; Last error on put
$ CKR ; Check record routine
$ CKP ; Address of checkpoint routine
$ RIA ; Record buffer address
$ RBS ; record buffer size
$ RIC ; Record buffer byte count
$ RIP ; Record buffer byte pointer
$ DIC ; Disk buffer byte count
$ DIP ; Disk buffer byte pointer
$ XRC ; Transmission buffer byte count
$ XRP ; Transmission buffer byte pointer
$ XBT,^D18 ; Left half of byte ptr for xmt buffer
$ XBN,^D18 ; Max bytes fitting into xmt buffer
$ RNM ; Unique name for transaction
$ ICT ; Input record count
$ OCT ; Output record count
$ OCK ; Minus records before checkpoint
$ SNZ ; Forced task descheduling counter
$ TBC ; Transferred byte count
$ PRI ; job's priority
$ QNM ; Queue name
$ SEQ ; Sequence number
$ PDV ; Physical device name
$ DSP ; Disposition
$ STM ; Scheduled time
$ NOD ; destination node name
$ LNM ; hold file name
$ FRM ; forms
$ STR ; structure
$
$ SIZ,0 ; Size of block
SUBTTL Interrupt code -- INTINI, Interrupt system initialization
; Here to initialize interrupt system
TOPS10 <
INTINI: MOVEI S1,INTIPC ; Address of IPCF interrupt routine
MOVEM S1,VECIPC+.PSVNP ; Save it in the vector
$RETT ; Return true always
>;End if TOPS10
TOPS20 <
INTINI: MOVX R1,.FHSLF ; Get fork handle
MOVX R2,1B0!1B1 ; Set channels 1 and 0
AIC ; Activate interrupt channels
$RETT ; Return
>;End if TOPS20
SUBTTL Interrupt code -- INTIPC, IPCF Interrupt routine
INTIPC: $BGINT 1, ; Set up interrupt context
$CALL C%INTR ; Call GLXLIB routine to post interrupt
$DEBRK ; Exit interrupt
SUBTTL Initialization code
IBMSPL: RESET ; Clear out I/O system in case of start
MOVE P,[IOWD PDSIZE,PDL] ; Load stack pointer with initial value
MOVEI S1,IB.SZ ; Put size of initialization
MOVEI S2,IB ; block and address in argument regs
$CALL I%INIT ; and initialize GLXLIB
MOVEI S1,<LOWEND-LOWBEG> ; Get size of area to be zeroed
MOVEI S2,LOWBEG ; and start address
$CALL .ZCHNK ; and call GLXLIB routine to do it
IBMSP0: SETO S1, ; turn on SYSERR logging
D60 D60INI,IBMSP0 ; Initialize interface to DN60
$CALL INTINI ; Initialize interrupt system
$CALL OPDINI ; Get operating system information
$CALL I%ION ; Turn on interrupts
PUSH P,P1 ; send hello to QUASAR when it comes up
MOVEI P1,^D300/^D30 ; 30 second retries for 5 minutes
IBMSP1: MOVEI T1,HELLO ; Point to "hello" message
$CALL SNDQSR ; and send it to QUASAR
JUMPT IBMSP2 ; did it!
SOJL P1, [POP P,P1
JRST QSRDTH] ; die ignomineously
HRROI S1,[ASCIZ \IBMSPL sleep - waiting for QUASAR to start
\]
$CALL K%SOUT ; tell the user
MOVEI S1,^D30 ; still hoping for the best
$CALL MISLP ; retire a while
JRST IBMSP1 ; and try again
IBMSP2: POP P,P1 ; QUASAR is alive & well
$CALL L%CLST ; Create a linked list
MOVEM S1,TSKNAM ; Save handle for task list
$CALL L%CLST ; Create another
MOVEM S1,LBNAM ; Save handle for line list
$CALL L%CLST ; Create another
MOVEM S1,WATNAM ; Save handle for line list
$CALL L%CLST ; Create list for the active task list
MOVEM S1,ATLNAM ; Save name for future use
FTACCT< $CALL ACTINI> ; Set up accounting
JRST MAIN ; Start main loop
SUBTTL Scheduler -- MAIN loop
; Routine - MAIN
;
; Function - This is the main scheduling loop. Whenever there is a task
; to be scheduled this loop is executed. Also there are two special
; tasks that get scheduled after a pass through the active task list.
; These are the IPCF message processor and the active device POLLer.
;
; After all tasks have been conditionally run, a check is made against
; the flag SCHDGO. If this is non-zero, another scheduling pass will
; be made of the active task list immediately. Otherwise the job will
; go to sleep. This flag is set non-zero by ACTTSK (activate task)
; and SGNTSK (signal task).
;
; The sleep time is the minimum of three values: WAKTIM (least time
; set by any task to wakeup), POLTIM (time to poll for activity flags),
; and 60 seconds.
;
; After sleeping a check against WAKTIM is done to see if it is time
; to schedule active tasks. If not, the IPCF message queue is checked
; and POLLing is conditionally done.
;
; The flow of the scheduler is such that each routine that uses a
; substantial amount of time is responsible for updating the cell NOW
; which contains the current time. The routines that currently update
; NOW are SCHED, MSGCHK and POLL.
MAIN: $CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
MOVEM S1,POLTIM ; Save as next time to poll
SETOM SCHDGO ; make sure we schedule 1st time around
JRST MAIN.3 ; enter the primary schedule loop
MAIN.1: SETZM SCHDGO ; Clear scheduling pass flag
MOVE S1,POLTIM ; poll time is the outer bound time
MOVEM S1,WAKTIM ; Save as next time to wakeup scheduler
MOVE S1,ATLNAM ; Get name of Active Task List
$CALL L%FIRST ; Point to first entry on list
JUMPF MAIN.3 ; If none .. go check IPCF queue
MAIN.2: $CALL SCHED ; Go conditionally schedule task
$CALL I%NOW ; update the local clock
MOVEM S1,NOW
$CALL MSGCHK ; Check for IPCF messages
MOVE S1,ATLNAM ; Get name of list again
$CALL L%NEXT ; Point to next entry on active list
JUMPT MAIN.2 ; If there is one, try to sched it
MAIN.3: $CALL MSGCHK ; Check for IPCF messages
MOVE S1,POLTIM ; Get polling time
CAMG S1,NOW ; Check if it's time yet
$CALL POLL ; Yes .. poll for new activity
SKIPE SCHDGO ; Check for another pass to be done
JRST MAIN.1 ; Yes .. some task has been signaled
MOVE S1,WAKTIM ; Get minimum time to make next pass
CAMG S1,NOW ; Check if it's time already
JRST MAIN.1 ; Yes .. go do another pass
SUB S1,NOW ; Calculate time to sleep
ADDI S1,2 ; in seconds, insuring
IDIVI S1,3 ; at least one second sleep
CAIL S1,^d30 ; Check for greater than 1/2 minute
MOVEI S1,^d30 ; Yes .. limit to 1/2 minute max
$CALL I%SLP ; Go to sleep
$CALL I%NOW ; Get current time
MAIN.5: MOVEM S1,NOW ; Save it
JRST MAIN.3 ; check messages and new device activity
SUBTTL Scheduler -- SCHED, Schedule a task
; Routine - SCHED
;
; Function - To conditionally schedule tasks. This routine is called
; with the address of an Active Task List entry. This entry
; is checked against NOW and the flags in the associated TasK Block
; to see if the task should be run. If it is to be run the
; wakeup conditions are set, MAIN context PDL saved, and the task
; context restored. If it is not to be run, WAKTIM is updated
; to the the minimum of this task's wake time and the previous
; value.
;
; See also the co-routine DESCHD, which is called when a task
; wishes to switch back to MAIN context.
;
; Parameters -
;
; S2/ Address of Active Task List entry
;
; Note - This routine destroys all registers except the stack pointer.
SCHED: LOAD TK,,A.TKB ; Get address of TasK Block
LOAD T1,,A.WKB ; Get events to wake up task with
LOAD T2,,T.WKB ; Get events task is waiting for
LOAD T3,,A.WKT ; Get time to wakeup task at
AND T2,T1 ; Mask events
JUMPN T2,OKSCHD ; If event hit, schedule task
JUMPE T3,.POPJ ; If no wakeup time, return to MAIN
CAMG T3,NOW ; Check against current time
JRST OKSCHD ; Yes .. schedule task
CAMG T3,WAKTIM ; No, check against minimum sleep time
MOVEM T3,WAKTIM ; Minimum seen so far .. save it
$RET ; Return to MAIN
OKSCHD: HRRZM S2,CURATE ; Save address of current active task
ANDCM T1,T2 ; Clear events causing wakeup
STORE T1,,A.WKB ; Save events yet to be woken on
TXZ T2,TW.IOD ; don't record TW.IOD as wakeup condition
STORE T2,,T.WCN ; Save event flags causing wakeup
ZERO ,A.WKT ; Clear wakeup time
MOVEM P,PDLSAV ; Save MAIN stack context
MOVSI R17,T%ACS ; Swap registers for the
BLT R17,R17 ; current task's registers
POPJ P, ; Return to task
SUBTTL Scheduler -- DESCHD, Deschedule a task
; Routine - DESCHD
;
; Function - To deschedule a task and return to MAIN context. This routine
; saves the current task context (if it still exists), updates the
; current time.
; If the task descheduling itself is deactivated the cell CURATE
; (Current Active Task list Entry) should be cleared. If the task
; has deleted itself (task no longer exists) the task block pointer
; (register TK) should be cleared.
;
; The normal manner for calling is this routine is through the
; $DSCHD macro.
;
; Parameters -
;
; TF/ Wakeup-events,,Wakeup-time-delay
; TK/ Address of this task's task block
; (If zero, then this task has deleted itself)
; CURATE/ Address of pointer into Active Task List
; (If zero, then this task has deactivated itself)
DESCHD: SETOM SCHDGO ; ensure a second scheduling loop
JUMPE TK,[MOVE P,PDLSAV ; If task deleted itself
SETZM CURATE ; Yes .. reset from task context
$RET] ; Return to main context
MOVEM TF,T%STS ; Save wakeup status flags
MOVEM R0,R0+T%ACS ; Save a scratch register
MOVEI R0,R1+T%ACS ; Save the task's register
HRLI R0,1 ; context
BLT R0,R17+T%ACS ; in the task block
MOVE P,PDLSAV ; Get MAIN stack context back
SKIPN CURATE ; Is task still active
$RET ; No .. just retun to MAIN context
SETZM CURATE ; Clear task context flag
ZERO ,T.WCN ; Clear events woken on
LOAD S2,,T.ATE ; Point to Active Task List entry
JUMPE S2,.POPJ ; If deactivated, return to MAIN
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save what time it is
LOAD T1,,T.WKB ; get conditions on which to be awakened
TXNN T1,TW.GEN ; is task being generous (i.e. giving up
; CPU to other tasks)?
JRST DESCH1 ; no, just continue
MOVE T1,NOW ; get current time
STORE T1,,A.WKT ; store it as time to wake him up
$RET ; return to scheduling loop
DESCH1: ZERO ,A.WKT ; Clear time to wake up at
LOAD T1,,T.WKD ; Get wakeup time delay
JUMPE T1,.POPJ ; If none, go try to SCHED on events
ADD T1,NOW ; Get time when to wake task
STORE T1,,A.WKT ; Save for SCHED
$RET
SUBTTL Scheduler -- ACTTSK, activate a task
; Routine - ACTTSK
;
; Function - Trys to activate a task, puts new entry on active task list for
; the newly activated task. If task already active it just returns.
;
; Parameters - TK/ Address of task to be activated.
;
; Returns - True it task activated, false if cannot make ATL entry
;
; Note - Destroys S2
; Changes current entry for active task list
ACTTSK: SKPE S1,,T.ATE ; Get active task list pointer
$RETT ; Already active, so return
MOVE S1,ATLNAM ; Get name of Active Task List
MOVEI S2,A$SIZ ; Get size of entry
$CALL L%CENT ; Create an entry
JUMPF .POPJ ; If cannot, propagate failure
STORE TK,,A.TKB ; Save task address in ATL entry
STORE S2,,T.ATE ; Save ATL entry address in task block
LOAD S1,,T.WCN ; Get saved wakeup conditions
STORE S1,,A.WKB ; Save in wakeup bits
ZERO ,T.WCN ; Clear wakeup conditions
LOAD S1,NOW ; Get current time
STORE S1,,A.WKT ; store as wakeup time so task will run
SETOM SCHDGO ; Force another scheduling pass
$RETT ; Return true
SUBTTL Scheduler -- DEATSK, Deactivate a task
; Routine - DEATSK
;
; Function - Removes a task from the Active Task List (ATL) and goes back
; to the scheduler. This routine assumes normal operation of the
; scheduler. Also it assumes that only the task that is running
; can deactivate itself. Therefore the Active Task List should
; be pointing directly at the task.
;
; Parameters - TK/ Address of task to deactivate
;
; Returns - Doesn't return until task is reactivated
;
; Note - Changes "current" entry of active task list
DEATSK: $SAVE <S1,S2,T1>
MOVE S1,ATLNAM ; Get handle for list
LOAD T1,,T.ATE ; Get pointer to current entry
$CALL L%CURR ; Position to current entry
JUMPF DEATS1 ; If none, start at beginning
CAMN T1,S2 ; Is this the proper entry?
JRST DEAFND
DEATS1: $CALL L%FIRST ; Start from top of list
JUMPF DEAERR ; If no entries at all .. stop
DEATS2: CAMN T1,S2 ; Is this our entry?
JRST DEAFND ; Yes, go delete it
$CALL L%NEXT ; No, point to next entry
JUMPF DEAERR ; No more entries .. error
JRST DEATS2 ; Go try this entry
DEAFND: LOAD S1,,A.WKB ; Get events that have already happened
STORE S1,,T.WCN ; Save in convenient place
LOAD S1,ATLNAM ; Get handle for active task list again
$CALL L%DENT ; Delete it
JUMPF DEAERR ; If we cannot, stop
ZERO ,T.ATE ; Clear active task entry
$DSCHD DEACTIVATE ; Return to MAIN
$RET ; Task has been re-activated
DEAERR: $STOP TNE,<Task not active>
SUBTTL Scheduler -- WAKTSK, wake a task unconditionally
; Routine - WAKTSK
;
; Function - If task is not active it is activated; then it set wakeup time
; to "NOW" so scheduler will pick it up on next pass.
;
; Parameters - TK/ Address of task block to be awakened
;
; Returns - True always
;
; Note - Destroys S1 and S2
; May move current entry for active task list (ATL)
; Stopcodes if active task entry cannot be created.
WAKTSK: SKPE S2,,T.ATE ; Is task active?
JRST WAKTS1 ; Yes, just set time
$CALL ACTTSK ; No, activate it
JUMPF WAKERR ; If failed .. fatal error
WAKTS1: MOVE S1,NOW ; Get current time
STORE S1,,A.WKT ; Store it as wake time
SETOM SCHDGO ; Force another scheduler pass
$RETT ; Return true
WAKERR: $STOP CAT,<Cannot activate task>
SUBTTL Scheduler -- SGNTSK, signal a task
; Routine - SGNTSK
;
; Function - Sets argument bits in active list entry to flag a condition
; for a task.
;
; Parameters - TK/ Task to be signalled
; S1/ Bits to signal task with in RH
;
; Returns - True if task is active, false if task is not already active
;
; Note - Destroys S2
SGNTSK: LOAD S2,,T.ATE ; Get active list entry
JUMPE S2,.RETF ; If not active return error
PUSH P,S1 ; save original bits [4(240)]
PUSH P,S2 ; Save it for a bit
LOAD S2,,A.WKB ; Get existing bits
IOR S1,S2 ; OR into desired bits
POP P,S2 ; Get ATL entry address back
STORE S1,,A.WKB ; Store the new wakeup bits
POP P,S1 ; get back original bits [4(240)]
SETOM SCHDGO ; Force another scheduler pass
$RETT ; Return true
SUBTTL Scheduler -- SGNLIN, signal all tasks on a line
; Routine - SGNLIN
;
; Function - Sets argument bits for all tasks on a particular line.
;
; Parameters - LB/ Line whose tasks are to be signalled
; S1/ Bits in RH to signal tasks with
;
; Returns - True always
;
; Note - Destroys S2
SGNLIN: $SAVE <TK> ; Save task pointer
LOAD TK,,L.FTK ; Get first in line block chain
JUMPE TK,.RETT ; If none, done
SGNLI1: $CALL SGNTSK ; Set bits
LOAD TK,,T.PFW ; Get pointer to next task
JUMPN TK,SGNLI1 ; If there is one, go back to loop
$RETT ; Return true
SUBTTL Scheduler -- POLL, active device signalling
; Routine - POLL
;
; Function - This routine loops through the port list (tags POLL0-POLL0E)
; reading the port status. For each port it loops through the line
; blocks chain to the port block (POLL1-POLL1E); for each line block
; it loops through all the TKB's associated with it. If the active
; bit is on for that device in the port status and the task is waiting
; for I/O done (TW.IOD) to set, it wakes the task. After looking at
; all the tasks on a line, if there are still active bits unaccounted
; for it creates new tasks to handle them. Finally, it sets up a new
; value for POLTIM (when to do next poll).
POLL: SKIPN S1,PTLNAM ; Is there a port list yet?
JRST POLLEX ; No, so don't bother checking
$CALL L%FIRST ; Yes, point to first entry
; Loop to look at each port
POLL0: JUMPF POLLEX ; Exit loop if no entry
MOVE P1,S2 ; Get pointer to port entry
POLL0R: LOAD S1,,P.PRT ; Get port number
HRLI S1,.STPRT ; and flag that it is multiple status
MOVEI S2,DEVBTS ; Where to put device bits
D60 D60STS,POLL0R,0 ; Get status
SETCAM TF,PRTFAL ; save success/failure for later checking
LOAD LB,,P.FLB ; Point to first line block
; Loop to look at each line on the current port
POLL1: LOAD S1,,L.LIN ; Get line number
SKIPN P2,PRTFAL ; dummy all active bits set if port status failed
MOVE P2,DEVBTS(S1) ; Get the active bits for that line
JUMPE P2,POLL1E ; If none are active, try next line
LOAD TK,,L.FTK ; Get control task TKB pointer
TXC P2,BUNUSD ; Complement bits for line abort check
TXCN P2,BUNUSD ; Is it the abort bits?
JRST [$CALL ACTTSK ; Activate it (in case its 2780/3780)
$SIGNL TW.LGN ; Signal control task, line has gone
JRST POLL1E] ; and go on to next line
; Loop to look at each task on a line
POLL2: LOAD P3,,T.BIT ; Get bit for this device
JUMPE P3,POLL2E ; If none, go select next device
TDZN P2,P3 ; Is active bit is on for this device?
JRST POLL2E ; No, continue scanning TKB's
LOAD S1,,T.WKB ; Get bits task wants to wake on
TXNN S1,TW.IOD ; Is it waiting for I/O done?
JRST POLL2E ; No, go look at next device
$SIGNL TW.IOD ; Yes, signal that I/O done occurred
; Advance to next device in task chain on current line
POLL2E: LOAD TK,,T.PFW ; Get next TKB entry
JUMPN TK,POLL2 ; If we got one, go back to check it
; Advance to next line on port
POLL1E: LOAD LB,,L.PFW ; Get forward chain pointer
JUMPN LB,POLL1 ; If there was one, go back to check it
; Get next port
POLL0E: MOVE S1,PTLNAM ; Get handle name
$CALL L%NEXT ; Advance to next entry
JRST POLL0 ; and go back
; Done polling
POLLEX: $CALL I%NOW ; Get current time
MOVEM S1,LSTPOL ; track time polled
ADDI S1,POLINT ; Add polling interval
MOVEM S1,POLTIM ; to make new poll time
$RET ; Return to MAIN context
SUBTTL Scheduler IPCF handling -- MSGCHK, message checker
; Routine - MSGCHK
;
; Function - This is a special purpose task executed by the MAIN routine.
; For each IPCF message that exists the routine MSGPRC is called.
; If any message processing routine causes the change in state
; of a task the flag SCHDGO is set. After each message is processed
; the current time NOW is updated.
;
; Returns - always
;
; NOW/ Most current time
; SCHDGO/ Turned on if any task state is changed
MSGCHK: $CALL C%RECV ; Get the next IPCF message
JUMPF .POPJ ; If none .. just return
$CALL MSGPRC ; Process this message
$CALL C%REL ; Now, .. release it
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
JRST MSGCHK ; Go onto next message
SUBTTL Scheduler IPCF handling -- MSGPRC, IPCF message processor
; Routine - MSGPRC
;
; Function - This subroutine processes IPCF messages received from QUASAR
; and ORION. MSGPRC determines if message is from someone it knows,
; and then dispatches to the proper message processing routine.
;
; Upon entry, S1 has the address of the Message Data Block (MDB) for the
; message. When this routine dispatches to the message processors, P1
; will have the address of the message and S will have flags indicating
; what type of program sent the message, whether or not it is for
; HASP line, etc.
MSGPRC: MOVEM S1,MDBADR ; Store message data block address
MOVE S2,MDB.SI(S1) ; Get special index word
SETZ S, ; Clear flags
TXZN S2,SI.FLG ; Are we using special system index?
$RET ; No, don't process it
TXO S,F.IPCSY ; Indicate we have a system message
CAIE S2,SP.OPR ; It better be ORION
CAIN S2,SP.QSR ; or QUASAR
JRST MSGPR1 ; Yes, go process it
$WTOJ <Bad IPCF message>,<Message received from unknown system component (^O/S2/)>,OBJBLK
$RET ; Return to main loop after error
; Here after checking system message source
MSGPR1: MOVE P1,MDB.MS(S1) ; Get address of message
CAIE S2,SP.OPR ; save name of sender
SKIPA S1,[[ASCIZ /QUASAR/]]
MOVEI S1,[ASCIZ /ORION/]
MOVEM S1,MSNDR
LOAD S1,.MSTYP(P1),MS.TYP ; Get message type
MOVSI S2,-NMSGT ; Make AOBJN pointer for table
; Loop to scan MSGTAB for processing routine for this message
MSGPR2: HRRZ T1,MSGTAB(S2) ; Get message type from current entry
CAMN T1,S1 ; Is it the same as our message?
JRST MSGPR3 ; Yes, go process it
AOBJN S2,MSGPR2 ; No keep looking
$WTOJ <Bad IPCF message>,<Message received from ^T/@MSNDR/ with unknown type code (^O/S1/)>,OBJBLK
$RET ; Return to main loop
; Here when we have found MSGTAB entry for this message type
MSGPR3: HLRZ T2,MSGTAB(S2) ; Get entry vector address for msg type
JUMPE T2,.POPJ ; If no vector, ignore message
MOVE T2,@T2 ; Get contents of vector
TXNE S,F.IPCSY ; Are we processing system request?
MOVS T2,T2 ; Yes, swap vector
HRRZ T2,T2 ; Clear out inappropriate half
JUMPN T2,@T2 ; If we still have an address, go to it
$WTOJ <Invalid IPCF message type>,<"^T/MSGTNM(S2)/" message received from ^T/@MSNDR/ not valid for this component type>,OBJBLK
$RET ; Return to main loop after error
; Table of type,,entry vector for message process dispatch
; Entry vector points to a word that contains dispatch addresses:
; system-message-routine,,non-system-message-routine
MSGTAB: XWD VSETUP,.QOSUP ; Setup/shutdown message
XWD VUSRCN,.QOABO ; User cancel
XWD VNXTJB,.QONEX ; Nextjob
XWD VOPRCN,.OMCAN ; Operator cancel
XWD VSNDCI,.OMSND ; Send console message to IBM
XWD VSTATS,.OMSHS ; ORION show status command
XWD VRQCHK,.QORCK ; Request for a checkpoint
XWD TEXTMS,MT.TXT ; Text message
XWD 0,.OMPAU ; Stop message
XWD 0,.OMCON ; Continue message
XWD VRQMSG,.OMREQ ; Requeue message
NMSGT==.-MSGTAB ; Size of table
MSGTNM: ASCIZ \Setup/shutdown\
ASCIZ /User cancel/
ASCIZ /Nextjob/
ASCIZ /Operator cancel/
ASCIZ /Send console message to IBM/
ASCIZ /ORION show status command/
ASCIZ /Request for a checkpoint/
ASCIZ /Text/
ASCIZ /Stop/
ASCIZ /Continue/
ASCIZ /Requeue/
SUBTTL Message processors -- TEXTMS, Text message response
; Routine - TEXTMS
;
; Function - To send a text IPCF message that IBMSPL has received to
; OPR.
; P1/QUASAR message ptr
TEXTMS: XWD TEXTM1,TEXTM1
TEXTM1: ;QUASAR sends these(null) to see who
; is still around
$RET ; Return to main loop
SUBTTL Message processors -- SETUP, Setup/shutdown message
; Routine - SETUP
;
; Function - This routine loads some important information (such as line,,port
; and device type,,unit into P3 and P4) then decides what to do;
; whether to setup or shutdown a whole station. Throughout this
; processing, P1 has the address of the message, P3 has port,,line
; and P4 has type,,unit-number.
; P1/QUASAR message ptr
VSETUP: XWD SETUP,0 ; Only system msgs may setup/shutdown
SETUP: MOVE P3,SUP.CN(P1) ; Get port,,line number
MOVE P4,SUP.UN(P1) ; Get unit number from message
HRLI P4,.TCDR ; and make into dev,,uni
MOVE T4,SUP.NO(P1) ; Get station name from message
LOAD T3,SUP.CN(P1),CN$SIG ; Get line signature from message
LOAD S2,SUP.ST(P1),NT.TYP ; Get station type field
CAIN S2,DF.HSP ; Is it HASP?
TXO S,F.HASP ; Yes, light our HASP bit
MOVE S2,SUP.FL(P1) ; Get flags word from message
TXNN S2,SUFSHT ; Is it really shutdown?
JRST SETALL ; No .. go setup station
MOVE S1,T4 ; Node name for FNDNOD routine
SETZ LB, ; Clear LB to say LB not found yet
$CALL FNDNOD ; Go find line block for this node
LOAD P3,,L.LNI ; Get port,,line from line block
JRST SHTALL ; Shut down all
SUBTTL Message processors -- SETALL, setup a new station
; Routine - SETALL
;
; Function - To build the line block and associated tasks for a new
; station.
;
; The tasks created are chained to the line block and have
; forward/reverse links between all of them. For a 2780/3780
; station there is a control task (to do signon/signoff), a card
; reader task (to send jobs to the IBM host), a line printer task
; (to read jobs from the IBM host), a console input task (to accept
; data, from the operator, to be sent to the IBM host as console
; input), and a send task (which sends the console output back to
; the operators). A HASP station gets all the tasks given to a
; 2780/3780 station plus a punch task (to read punch jobs from
; the IBM host) and a console output task (to read console output
; from the IBM host and give it to the send task for distribution).
;
; After all the tasks are built the card reader task is started.
; When this line initialization has been done and the line to the
; stations is signed on, a setup response message is sent back to
; QUASAR indicating either success or failure. If a failure occured
; control is passed to the shutdown routines and the all the setup
; that just executed is undone.
;
; Parameters -
;
; P1/ Address of setup message
; P3/ Port,,line
; P4/ Dev,,unit
;
; Returns -
;
; P2/ Response code for setup response
SETALL: MOVX P2,%RSUDE ; Pre-load pessimistic setup response
MOVE S1,P3 ; Get port,,line
$CALL MAKLB ; Create a line block for port,,line
JUMPF SETSN1 ; If we can't, send error to QUASAR
$CALL I%NOW ; get the time
MOVE T2,S1 ; save it for the duration of line condition
JRST SETAL0
SETALA: $CALL I%NOW ; check on time
SUB S1,T2 ; delta t from start
JUMPL S1,SETER1 ; just in case this gets screwed up
CAILE S1,^D30*3 ; allow 30 seconds to enable line
JRST SETER1 ; something is wrong
SETAL0: MOVEI S1,0(P1) ; Get address of setup message
D60 D60CND,SETALA ; Condition the line to what is needed
JUMPF SETER2 ; Couldn't condition line .. fail
$CALL LINSTS ; get line status
STORE T4,,L.NAM ; Save name of station in line block
LOAD T4,,L.STS ; Get line status flags
LOAD T1,S,F.HASP ; Get HASP bit from status in S
SKIPE T1 ; Check for HASP flag on
IORX T4,L.HSP ; Yes .. turn on HASP flag
STORE T4,,L.STS ; Set new line status
TXNE S,F.HASP ; See if HASP line
SKIPA T1,[XWD -SETHSN,SETHSP] ; Yes, get HASP task table instead
MOVE T1,[XWD -SETTKN,SETTSK] ; Default to 2780/3780 task table
; Loop to add all tasks in appropriate task table
SETAL1: MOVE S1,0(T1) ; Get current task table entry
SETZ S2, ; Make a default device 0
$CALL BLDTSK ; Build task for it and acquire device
JUMPF SETSN1 ; If either no core or couldn't get
; device, send error to QUASAR
AOBJN T1,SETAL1 ; Loop through whole table
DMOVE S1,P3 ; Get parameters to identify device
$CALL FNDTSK ; Search existing tasks for this device
JUMPT SETOK ; If there go initialize it
HRRZ S1,P4 ; Get unit number
JUMPE S1,SETADD ; If 0, then no need for more checking
TXNN S,F.HASP ; If non-zero, is this a HASP line?
JRST SETSN1 ; No, don't allow it
; Here to add main card reader task to chain
SETADD: MOVEI S1,.TCDR ; Get task type
HRRZ S2,P4 ; Get unit number
$CALL BLDTSK ; Build the task
JUMPF SETSN1 ; If error, inform QUASAR no device
; Here when main task is built
SETOK: $CALL INIPAG ; Set up job pages
JUMPF SETSN1 ; Cannot; tell QUASAR to give up
STORE LB,LB+T%ACS ; Save line block address in
; task's LB register
MOVE T1,SUP.TY(P1) ; Get batch stream object type
STORE T1,,T.OTY ; Store in task block
MOVE T1,SUP.UN(P1) ; Get object unit from message
STORE T1,,T.OUN ; Store in task block
MOVE T1,SUP.NO(P1) ; Get object node from message
STORE T1,,T.ONO ; Store in task block
MOVEI T1,T%OBJ ; Get address of object block
STORE T1,,T.OBA ; and store it away
$CALL ACTTSK ; Activate the main task
MOVX P2,%RSUOK ; Indicate we have device
; Send setup response to QUASAR (P2 has code)
LOAD S1,,L.STS ; Get line status bits
TXC S1,L.UP!L.SND ; is line up and signed on ?
TXCE S1,L.UP!L.SND
JRST SETSN0 ; no - setttle back and rest til SIGNON
; Here to send response to QUASAR
SETSN1: MOVE S1,P2 ; Get response code
$CALL RSETUP ; Send the response to setup message
MOVE S1,SUP.UN(P1) ; Get unit from request
STORE S1,OBJBLK+1 ; Store in unit
MOVE S1,SUP.NO(P1) ; Get node
STORE S1,OBJBLK+2 ; Store it in object block
$WTOJ <Setup response>,<^1/SUP.TY(P1)/ ^O/SUP.UN(P1)/ on ^N/SUP.NO(P1)/ ^T/@SETMSG(P2)/>,OBJBLK
JUMPE LB,SETSN0 ; no need to shut down if no line block
CAIN P2,%RSUOK ; Was it all right?
JRST SETSN0 ; yes - exit
$CALL DISABL ; no - disable the line
JRST SHTAL0 ; go shutdown the whole shmear
; Here to exit setup message processing
SETSN0: AOS S1,WTORNM ; Make a unique number
STORE S1,,T.WAC ; and save it as $WTOR ack code
$RET ; Yes, return to message processor
SETER1: $WTOJ <failed to condition line>,<timed out attempting to condition line for node ^N/SUP.NO(P1)/>,SUP.TY(P1)
JRST SETSN1
SETER2: $WTOJ <failed to condition line>,<^I/D60ERM/ while trying to condition line for node ^N/SUP.NO(P1)/>,SUP.TY(P1)
JRST SETSN1
SETMSG: [ASCIZ /started/] ; This message if started
EXP 0 ; Temporarily unavailable
[ASCIZ /not available/] ; This message if failed
; Task tables
; Entry format is type code (.Txxx where xxx is device)
; in LH, and first entry point of task in RH.
SETTSK: EXP .TCTL ; Control task MUST be first
EXP .TLPT ; LPT task
EXP .TCDR ; CDR task
EXP .TSND ; Console output distributor task
SETTKN==.-SETTSK ; Length of table
SETHSP: EXP .TCTL ; HASP control task (must be first)
EXP .TLPT ; HASP line printer task
EXP .TCDP ; HASP card punch task
EXP .TCDR ; HASP card reader task
EXP .TCNO ; HASP console output receiver task
EXP .TSND ; Console output distributor (not HASP specific)
EXP .TCNI ; HASP console input sender task
SETHSN==.-SETHSP ; Length of HASP table
SUBTTL Message processors -- SHTALL, shutdown station (signoff)
; Routine - SHTALL
;
; Function - To shutdown a line (all devices). If this line is signed on
; the control task for the line is awakened and it will wait for all
; activity to cease before shutting down the devices. The control task
; will then call this routine again at task level to destroy the tasks.
; If the line is not signed on, the tasks will be released immediately.
;
; Exit is made via SHTEXT code which either returns by $RET or goes to
; the scheduler depending on whether it deleted its entry TKB (task)
; if it came from task context.
;
; Parameters -
;
; P1/QUASAR message ptr
; P3/ Port,,line
; P4/ Dev,,unit
; Here to shutdown all (signoff)
SHTALL: JUMPE LB,SHTERR ; If no line block, stop
LOAD S2,,L.STS ; get last line status
TXNE S2,L.SND ; If line was ever signed on
JRST SHTALD ; Do delayed signoff
$CALL LINSTS ; no, see if line not up
JUMPF SHTAL0 ; if down, assume disabled
TXNN S1,L.UP ; is line up
JRST SHTAL0 ; no, don't have to take it down
$CALL DISABL ; yes, hang up
; Here to do shutdown right away
SHTTSK:
SHTAL0: SETZ T1, ; Zero task pointer
PUSH P,T1 ; Push zero on stack to flag end
MOVE T1,TK ; save incoming TK
LOAD TK,,L.FTK ; Get control task's TKB
JUMPE TK,SHTAL2 ; If none, just release line block
; Loop to release tasks
SHTAL1: $CALL RELTKB ; Release this one
LOAD TK,,T.PFW ; Get address of next TKB in chain
JUMPE TK,SHTAL2 ; and if there was next one, release it
CAMN TK,T1 ; About to free entry task block?
MOVEM TK,0(P) ; Yes, flag it
JRST SHTAL1
; Here to release line block
SHTAL2: $CALL RELLB ; Release line block too
POP P,T1 ; Get "freed myself" task or 0
JRST SHTEXT ; Exit
; Here to do delayed shutdown
SHTALD: TXO S1,L.SFR ; Set line block bit shutdown requested
STORE S1,,L.STS ; and save line status bits
LOAD TK,,L.FTK ; Get control task TKB
$CALL ACTTSK ; activate control task
$SIGNL TW.SFR,TASK ; Wake him to do signoff
$RET ;return to message processor
; Here to exit from shutdown
SHTEXT: SKPTSK ; Skip if from task context
$RET ; Exit via return to msgprc
CAME T1,TK ; Did we delete ourselves?
$RET ; No, exit via return to task
$DSCHD DELETE ; Deschedule this task forever
; Here if device does not exist that QUASAR is shutting down.
SHTERR: $WTOJ <QUASAR Shutting down inactive device>,,<SUP.TY(P1)>
$RET
SUBTTL Message processors -- USRCN, User cancel message
; Routine - USRCN
;
; Function - This routine tests if the job is already aborting or exiting,
; and if so exits. Then it tests if the disk file is open, and
; if so sets it to return end of file on the next read. Finally
; it sets the GOODBY and ABORT bits in the task's S, wakes the task,
; makes an entry into the log file and sends a message to operators.
; P1/QUASAR message ptr
VUSRCN: XWD USRCN,0 ; Only system components can do cancels
USRCN: MOVEI S1,ABO.TY(P1) ; Point to object block in message
$CALL FNDOBJ ; Set up TK, LB and J
JUMPF .POPJ ; Return if we cannot find it
; TK,LB,J setup
LOAD S,S+T%ACS ; Get S
TXOE S,GOODBY!ABORT ; Set abort and end processing bits
$RET ; If already on, ignore request
STORE S,S+T%ACS ; Put back updated status bits
$CALL WAKTSK ; Wake up task unconditionally
FTCLOG< $TEXT (LOGCHR,<^I/IBMSG/Job cancelled by user ^U/ABO.ID(P1)/>)>
$WTOJ <Cancelling>,<^R/.EQJBB(J)/>,@T%OBA
$RET ; Exit
SUBTTL Message processors -- OPRCN, Operator cancel message
; Routine - VOPRCN
;
; Function - This routine does effectly the same thing as USRCN except
; the cancel request has come from the operator instead of a user.
; P1/QUASAR message ptr
VOPRCN: XWD OPRCN,0 ; Operator cancel legal only from
; system component
OPRCN: MOVEI S1,.OHDRS+1(P1) ; Point to object block
LOAD S2,-1(S1),AR.TYP ; Get type of block
CAIE S2,.OROBJ ; Is it ORION object block?
$RET ; No, ignore bad message
$CALL FNDOBJ ; Find the task for the object type
JUMPF .POPJ ; Return if we cannot find it
; TK,LB,J setup
LOAD S,S+T%ACS ; Get status
TXOE S,GOODBY!ABORT ; Tell low level to get out
$RET ; If it was already doing it, exit
STORE S,S+T%ACS ; Stash status again
$CALL WAKTSK ; Make task wake up
FTCLOG< $TEXT (LOGCHR,<^I/IBMSG/Job cancelled by operator>)>
$WTOJ <Cancelling>,<^R/.EQJBB(J)/>,@T%OBA
$RET
SUBTTL Message processors -- OPRRQ, Operator requeue message
; Routine - VOPRRQ
;
; Function - this routine checks to see if the job is already aborting
; or exiting and if so, returns. If not, we set the RQB bit and
; the GOODBY and ABORT bits in the task status and calls WAKTSK to
; cause a scheduler cycle, make a log entry and send a message to the
; operator.
VRQMSG: XWD OPRRQ,0 ; operator cancel is legal only
; from system components.
OPRRQ: MOVEI S1,.OHDRS+1(P1) ; Point to object block
LOAD S2,-1(S1),AR.TYP ; Get type of block
CAIE S2,.OROBJ ; Is it ORION object block?
$RET ; No, ignore bad message
$CALL FNDOBJ ; Find the task for the object type
JUMPF .POPJ ; Return if we cannot find it
; TK,LB,J setup
LOAD S2,,T.TYP ; find out which flavor task
CAIE S2,.TCDR ; is it a CDR?
JRST RQDER ; no, can't requeue it
LOAD S,S+T%ACS ; yes, get status
TXNE S,GOODBY!ABORT!RQB ; Are we already stopping?
$RET ; yes, no more can be done
TXO S,GOODBY!ABORT!RQB ; no, we are now though!
STORE S,S+T%ACS ; store the status ac away in context
$CALL WAKTSK ; wake up the task
FTCLOG< $TEXT (LOGCHR,<^I/IBMSG/ Job Requeued By Operator>)>
$WTOJ <Requeuing>,<^R/.EQJBB(J)/>,@T%OBA
$RET ; and wait for the scheduler
RQDER: $WTOJ <Can't requeue a job being received, use the ABORT command.>
$RET
SUBTTL Message processors -- NXTJB, Nextjob message
; Routine - NXTJB
;
; Function - This routine save the current time as that when the request
; was received, copies the request into the first job page for
; the task (also sets the bit indicating that it is present)
; and finally signals a "request from QUASAR" wake condition
; for the task.
; P1/QUASAR message ptr
VNXTJB: XWD NXTJB,0 ; Only system programs can give a job
NXTJB: MOVEI S1,.EQROB(P1) ; Point to object block
$CALL FNDOBJ ; Set up world
JUMPF NXTJER ; Issue message if we cannot find it
; TK,LB,J setup
LOAD S,S+T%ACS ; Get task status bits
TXOE S,QSRREQ ; Indicate we have a request
$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>,<either invalid object type or line gone away - job requeued>,@T%OBA
TXO S,RQB ; set requeue flag
MOVE J,P1 ; set job page ptr to msg block
$CALL QRLSE ; release the job
$RET
SUBTTL Message processors -- SHWSTS, Show status message
; Routine - SHWSTS
;
; Function - This routine sets up the ack message to send to the
; operator (OPR) telling him what the status of the emulation
; devices on a particular node are doing.
; P1/QUASAR message ptr
VSTATS: XWD SHWSTS,0 ; Only system programs for now.
SHWSTS: $SAVE <S,J,P2,P3,P4,T2,T3,T4,LB,TK> ; Save some registers
SETZB P2,P4 ; init msg counter
SHWST0: ; P2 will hold the work page for the duration
; P3 will hold node name requested
; P4 will hold count of nodes reported on
; T3 will hold ptr to current message block
; T4 will hold correct node name
MOVE P3,.OHDRS+ARG.DA+OBJ.ND(P1) ; Get node name (SIXBIT)
MOVE S1,LBNAM ; Get name of line block list
$CALL L%FIRST ; Point to first entry on list
SHWLP1: JUMPF SHWER1 ; If no more .. didn't find node
PUSH P,S1 ; save list handle
MOVE LB,S2 ; Put line block addr in correct place
LOAD S2,,L.NAM ; Get name of node for this line
CAME P3,[-1] ; check for "all"
CAMN S2,P3 ; Check if one we are looking for
$CALL SHWFND ; Yes .. found line block for node
POP P,S1 ; restore list handle
JUMPF .POPJ ; exit if error happened
CAME P3,[-1] ; check for "all"
JUMPN P4,SHWER1 ; done if only requested one
$CALL L%NEXT ; No .. continue looking
JRST SHWLP1 ; Go check next list entry
SHWFND: MOVE T4,S2 ; copy current node name
JUMPN P2,SHWFN1 ; check if message started yet
SHWFN0: $CALL SHWMSI ; init msg
JUMPF .POPJ
SHWFN1: $CALL SHWNXT ; make sure there is room for more
JUMPE P2,SHWFN0 ; check if the partial message went
$CALL SHWTIT ; insert node title and set up body
$TEXT (DEPBP,<^T/STSHDR/>^A) ; Output the status header string
AOS P4 ; count this node status
LOAD TK,,L.FTK ; Get address of first task block
SHWLP2: MOVE S,S+T%ACS ; Get status registers
LOAD S2,,T.TYP ; Get task type
CAIL S2,.TLPT ; Check for within range of
CAILE S2,.TCDR ; device type tasks
JRST SHWTST ; No .. ignore control tasks
LOAD S1,,T.DST ; Get address of task state string
$TEXT (DEPBP,<^T14/@STSNAM-1(S2)/^T30/0(S1)/ ^A>)
MOVE J,J+T%ACS ; Get pointer to JOB pages
LOAD S2,,T.TYP ; Get device type again
CAIE S2,.TCDR ; Check for a card reader (batch strm)
JRST SHWLPT ; No .. go show LPT or CDP
TXNN S,QSRREQ ; Check for request page setup
JRST SHWLF ; No .. just end the line
MOVE S2,.EQRID(J) ; Get request ID number of job
TOPS20< $TEXT (DEPBP,<^D6/S2/ ^W9/.EQJOB(J)/^T/.EQOWN(J)/>)>
TOPS10< $TEXT (DEPBP,<^D6/S2/ ^W9/.EQJOB(J)/^W6/.EQOWN(J)/^W6/.EQOWN+1(J)/>)>
JRST SHWRUN ; Go output transfer start time
SHWLPT: TXNE S,ACTIVE ; Check for device really active
TXNN S,JVALID ; Check for job pages existant
JRST SHWLF ; No .. end the status line
LOAD S1,,T.TBC ; check if any io has been done
JUMPE S1,SHWLF ; no - don't report 0 bytes xfer'd
MOVX T2,.QCJBN ; Find the job name entry
$CALL FNDENT ; in the queue request create page
JUMPF SHWNJB ; No job name .. just output blanks
$TEXT (DEPBP,< ^W9/1(S1)/^A>)
CAIA
SHWNJB: $TEXT (DEPBP,< ^A>)
MOVX T2,.QCNAM ; Find the user name entry
$CALL FNDENT ; in the queue request create page
JUMPF SHWLF ; None .. just close off the line
TOPS20< $TEXT (DEPBP,<^T/1(S1)/^A>)> ; Output name from queue entry
TOPS10< $TEXT (DEPBP,<^W6/1(S1)/^W6/2(S1)/^A>)>
SHWLF: $TEXT (DEPBP,<>) ; Put CRLF at end of line if needed
SHWRUN: TXNN S,ACTIVE ; Check for an active task
JRST SHWTST
$CALL XFRAT ;calc xfer rate
$TEXT (DEPBP,< Started at: ^H/T%TMS/ transferred ^D/T%TBC/ bytes at ^D/S1/ Bps>)
SHWTST: LOAD TK,,T.PFW ; Get next task on this line
JUMPN TK,SHWLP2 ; If there is one .. continue output
$CALL SHWTRM ; terminate current message block
$RETT
SHWNXT: MOVE S1,T3 ; find out how much room left
SUBI S1,(P2)
CAIGE S1,PAGSIZ*5-^D80*6 ; need six lines worth
$RET
MOVX S1,WT.MOR ; send what we have
IORM S1,.OFLAG(P2)
SHWLST: MOVE S1,T3 ; do final formatting of message
SUBI S1,(P2)
HRLM S1,.MSTYP(P2) ; total length
MOVE T1,P2
$CALL SNDOPR ; ship it
SETZ P2, ; this message no longer exists
$RETT
SHWER1: JUMPN P4,SHWLST ; check if we reported something
CAMN P3,[-1] ; check for "all"
JRST SHWEND ; not an error if "all" request
$ACK (<IBM emulation node ^N/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,< Unknown node status requested>,,<.MSCOD(P1)>)
$RET
SHWEND: $ACK (<no IBM emulation nodes started>,,,<.MSCOD(p1)>)
$RET
SHWMSI: $CALL M%GPAG ; get a work page
JUMPT SHWMS0
$ACK (<IBM emulation node ^N/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,< failed to get workspace to build response>,,<.MSCOD(P1)>)
$RETF ; ignore request
SHWMS0: MOVE P2,S1 ; put message ptr in its permanent home
MOVEI S1,.OMACS ; do some formatting
MOVEM S1,.MSTYP(P2)
SETZM .MSFLG(P2)
MOVE S1,.MSCOD(P1)
MOVEM S1,.MSCOD(P2)
MOVX S1,WT.SJI!WT.NFO
MOVEM S1,.OFLAG(P2)
SETZM .OARGC(P2)
MOVEI T3,.OHDRS(P2) ; T3/ptr to current message block
$RETT
SHWTIT: $CALL SHWARG ; set up new message block
$CALL I%NOW ; get time stamp
MOVEM S1,ARG.DA(T3)
AOS TEXTBP ; push text ptr to next word
; insert title for this node status
$TEXT (DEPBP,< IBM emulation node ^N/T4/ device status ^A>)
$CALL SHWTRM ; terminate this message
SHWART: SKIPA S1,[.CMTXT] ; set up body of node status message
SHWARG: MOVEI S1,.ORDSP ; set up title of node status message
MOVEM S1,ARG.HD(T3)
MOVEI S1,ARG.DA(T3) ; now init byte ptr for msg text
HRLI S1,(POINT 7)
MOVEM S1,TEXTBP
AOS .OARGC(P2) ; count this message block in whole
$RET
SHWTRM: SETZ S1, ; terminate message
IDPB S1,TEXTBP
AOS S1,TEXTBP ; count size of it
SUB S1,T3
HRLM S1,ARG.HD(T3) ; stuff it in msg block hdr
HRRZ T3,TEXTBP ; ptr to next msg block
$RET
STSHDR: ASCIZ \
Device Status Req# Jobname Username
----------- ------------------------------ ------ ------- --------
\
STSNAM: [ASCIZ \Line printer\]
[ASCIZ \Card punch\]
[ASCIZ \Card reader\]
SUBTTL Message processors -- RQCHK, Request checkpoint message
; Routine - RQCHK
;
; Function - This routine merely sets up the task context and calls
; the CHKPNT to build and send the message; if the request
; was from a non-system program it calls the subroutine at the
; CHKPNB entry point.
; P1/QUASAR message ptr
VRQCHK: XWD RQCHK,RQCHK ; Both types can request checkpoints
RQCHK: MOVEI S1,RCK.TY(P1) ; Point object block sent by QUASAR
$CALL FNDOBJ ; Set up TK and LB and J
JUMPF .POPJ ; Ignore it if we cannot find it
; TK,LB,J setup
LOAD S1,S+T%ACS ; Set task's status bits
TXNN S1,QSRREQ ; See if we are processing a request
$RET ; No, QUASAR doesn't expect chkpnt
MOVEI T1,CHKPNT ; Assume only to QUASAR
TXNN S,F.IPCSY ; See if request came from system
MOVEI T1,CHKPNB ; No, use other entry point
PJRST @T1 ; Go there and then return to main loop
SUBTTL Message processors -- CHKPNT, CHKPNB, send checkpoint
; Routine - CHKPNT, CHKPNB
;
; Function - CHKPNT is the subroutine to build a checkpoint message in
; the message block and then send it to QUASAR; CHKPNB is an entry
; point that can be used only from the message processing level to
; send a checkpoint message both to QUASAR and to the NON-SYSTEM PROGRAM
; that sent the request.
;
; Parameters - LB must be set up
; P1/QUASAR message ptr
;
; Returns - True if SNDQSR does
;
; Note - Destroys S1 and S2
CHKPNB: TDZA S2,S2 ; Entry to send checkpoint to both
CHKPNT: SETOM S2 ; Set QUASAR-only flag true
$SAVE <S,TK,J,T1,T2,T3,T4> ; Save registers
LOAD S1,,T.TYP ; Get caller's context type
SETZ T4, ; Provisionally clear register to hold
; device selected for checkpoint information
CAIN S1,.TCDR ; Is it a card reader device?
HRRZ T4,TK ; Yes, use it
MOVEI T1,MSGBLK ; Point to block in which to build
; message (can do this since we are
; not interruptible until WE do
; a $DSCHD
MOVX S1,CH.FCH ; Indicate that we have checkpoint info
STORE S1,CHE.FL(T1) ; Store flags in message
LOAD TK,,L.FTK ; Point to first device on line
JUMPE TK,CHKLO4 ; If none, we are done
CHKLOP: LOAD T2,,T.TYP ; Get task/device type
SKIPE T4 ; Selected device for checkpoint info?
JRST CHKLO1 ; Yes, go see if they match
CAIE T2,.TCDR ; No, see if this is a candidate
JRST CHKLO2 ; No, just do continue
HRRZ T4,TK ; Yes, select him
CHKLO1: CAME TK,T4 ; Device we wish to checkpoint?
JRST CHKLO2 ; No, just continue to next task
LOAD S1,,T.NFP ; Get number of files processed
STORE S1,CHE.IN+CKFIL(T1) ; Save it in checkpoint block
LOAD S1,,T.NRS ; Get number of records processed
STORE S1,CHE.IN+CKTRS(T1) ; Save it too
LOAD J,J+T%ACS ; Get address of request
LOAD S1,.EQITN(J) ; Get internal number from request
STORE S1,CHE.IT(T1) ; and save it also
MOVX S1,CKFCHK ; Flag that job has been checkpointed
STORE S1,CHE.IN+CKFLG(T1) ; Set it in block
CHKLO2: LOAD TK,,T.PFW ; Get next task in chain
JUMPN TK,CHKLOP ; If there was one, go back to loop
CHKLO4: MOVX S1,CHE.ST ; Get length of message
STORE S1,.MSTYP(T1),MS.CNT ; Save as length of message
MOVX S1,.QOCHE ; Get function (checkpoint)
STORE S1,.MSTYP(T1),MS.TYP ; And save it in header too
SKIPE S2 ; See it we are to send to caller
JRST CHKLO5 ; No, just to QUASAR
SKPTSK ; Only message processors can send back to caller
$CALL SNDBAK ; Send it back
CHKLO5: $CALL SNDQSR ; Send it to QUASAR
JUMPF QSRDTH ; die if can't do it
$RET
SUBTTL Message processors -- SNDCI, send console input to IBM
; Routine - SNDCI
;
; Function - This routine receives a message from either OPR (send to
; batch stream) or a non-system component (with the same codes for
; simplicity) which is a console line intended to be sent to IBM.
; After some validity checking, it merely copies it into a console
; input queue (CNI) entry and signals TW.CNI to the appropriate task.
; P1/QUASAR message ptr
VSNDCI: XWD SNDCI,SNDCI ; Both types can do this
SNDCI: MOVEI S1,.OHDRS(P1) ; Point past message header
LOAD S2,ARG.HD(S1),AR.TYP ; Get type of first block
LOAD T1,ARG.HD(S1),AR.LEN ; and length
ADD T1,S1 ; Compute address of next block
SETZM SNDCEC ; Initialize error code
CAIE S2,.OROBJ ; Is first block object block?
JRST SNDCIE ; No, inform world of error
AOS SNDCEC ; Increment error code
AOS S1 ; Point to start of object type
$CALL FNDOBJ ; Yes, set up TK properly
JUMPF SNDCIE ; If cannot, something is very wrong
; TK,LB,J setup
LOAD S2,ARG.HD(T1),AR.TYP ; Get type of second block
AOS SNDCEC ; Increment error code to 2
CAIE S2,.CMTXT ; It better be text type
JRST SNDCIE ; It isn't, so complain
AOS SNDCEC ; next possible error
HRRI S1,1(T1) ; Point to start of data part
HRLI S1,440700 ; and make it into a byte pointer
LOAD T2,ARG.HD(T1),AR.LEN ; get the text length
SOS T2 ; flush word count
IMULI T2,5 ; make bytes
; now scan line for =>
SNDCI0: SOJL T2,SNDCIE ; msg too short
ILDB S2,S1 ; Get next character
SNDCI1: CAIE S2,"=" ; Is it = ?
JRST SNDCI0 ; No, keep looking
; =
SOJL T2,SNDCIE ; msg too short
ILDB S2,S1 ; Get next character
CAIE S2,76 ; Is it right angle bracket?
JRST SNDCI1 ; no, keep scanning
; => ...the IBM console msg follows
MOVE T3,S1 ; save the ptr, T2/no. bytes in msg
LOAD S1,,L.CNI ; Get CNI queue list handle
MOVE S2,T2 ; Copy length in bytes
ADDI S2,4+5 ; Compute length
IDIVI S2,5 ; in words (accounting for length word)
AOS SNDCEC ; Increment error code to 3
$CALL L%CENT ; and get a new entry
JUMPF SNDCIE ; If no room, go complain
MOVEM T2,0(S2) ; Store length in first word
ADD S2,[XWD 440700,1] ; Make entry address into byte pointer
CAIA
SNDCI4: JUMPE S1,SNDCI5 ; when the null char is found, stop source
ILDB S1,T3 ; Get next character
SNDCI5: IDPB S1,S2 ; Store it in entry
SOJG T2,SNDCI4 ; Loop till no more characters left
TDZA S1,S1 ; make sure there is a null char to stuff
SNDCI6: IDPB S1,S2
TLNE S2,760000 ; only done when last dest word is filled
JRST SNDCI6
$SIGNL TW.CNI,LINE ; and inform world its there
IFN FTIBMS,<
MOVEI S1,%ECNI ; inform QUASAR
$CALL IBMSTS
> ;End of FTIBMS
$RET ; Return to MSGPRC
SNDCIE: MOVE S2,SNDCEC ; Get error code
$WTOJ <Console error>,<Error "^T/@SNDERR(S2)/" processing send message.>,@T%OBA
$RET
SNDCEC: EXP -1
EXP [ASCIZ /illegal error code/]
SNDERR: EXP [ASCIZ /first block in msg not object/]
EXP [ASCIZ /can't find task for object block/]
EXP [ASCIZ /second block in msg not text/]
EXP [ASCIZ /illformed IBM console msg/]
EXP [ASCIZ /cannot create CNI queue entry/]
SUBTTL Tasks -- Description
COMMENT &
The tasks IBMSPL uses can be divided into common tasks (TKCTL, TKSND)
and line-type dependent tasks (TKCDR-TKHCDR, TKLPT-TKHLPT,
TKHCNI, TKHCNO and TKHPUN).
TKSND takes console output from the CNO queue (it was placed there
either by TKLPT for 2780/3780 or by TKHCNO for HASP) and distributes it
to all "watchers" of the console line. These include OPRs (for a short
time after the operator issues a "send" command), IBMs (the program
specifically designed for watching the console) and the log files for
jobs coming in from IBM (so that the eventual user can see what was
done to his job by operators or other users).
The control task (TKCTL) is responsible for signon and signoff.
The card reader tasks (TKCDR for 2780/3780 and TKHCDR for HASP) copy
jobs to IBM.
The lineprinter and punch (TKLPT, TKHLPT and TKHPUN) tasks copy jobs
from the IBM host to disk files, and then either rename them to
the user's area or queue them to the appropriate device on the 10/20. They
obtain the information on what to do by scanning the received data for
specific switches (a process called log-file recognition, or recognition
for short).
The console input (TKHCNI) task copies messages from the CNI queue
to the IBM host; entries are placed in the queue by the send message
processor.
The console output task (TKHCNO) copies output messages from the
IBM host to the CNO queue and wakes up the send task to
distribute them to whomever is interested.
&
SUBTTL Tasks -- TKSND, console output distribution
; Task - TKSND
;
; Function - This task distributes console output arriving from the IBM
; host to 1) all log files of active devices for that port,,line and
; 2) all programs that have declared themselves "watchers" of the
; console line. There are two programs intended to be watchers,
; OPR (which becomes a watcher for a small period of time after
; issuing a "send to batch-stream" command; and non-system programs
; which allow a user of the DN6x to send messages and receive replies
; over the console pipe to IBM.
;
; This tasks wakes upon an TW.CNO signal, which is set by TKLPT
; (2780/3780) or by TKHCNO (HASP) after after they have queued console
; output to the CNO list for the line.
;
; This task dequeues messages from this list, loops over all devices
; on the line and inserts the message into the log file for all active
; devices; then it loops over the list of watchers, sending the message
; to all.
TKSND: LOAD S1,,L.STS ; Get status
TXNN S1,L.SFS ; If signoff sent
TXNE S,LGA ; or line gone away
JRST CDERR ; Exit and wait to die
$DSCHD TW.CNO,0 ; Wait only on CNO queued signal
LOAD S1,,L.CNO ; Get handle for CNO list
$CALL L%FIRST ; Position to the beginning of the list
TSLOOP: JUMPF TKSDON ; If none, send to OPR then wait again
MOVE T1,S2 ; Copy address of message entry
LOAD T2,,L.FTK ; Get first task in line block chain
JUMPE T2,TSWAT ; If none, go send it to watchers
EXCH TK,T2 ; Save our task context and use his
TSLOG: LOAD S,S+T%ACS ; Get task's status
FTCLOG< TXNE S,ACTIVE ; Is it active?
$TEXT (LOGCHR,<^I/IBCON/^T/0(T1)/>)
>
LOAD TK,,T.PFW ; Get next task in chain
JUMPN TK,TSLOG ; If there is one, go back
EXCH T2,TK ; Otherwise restore our context again
TSWAT: MOVE S1,WATNAM ; Get handle for watcher list
$CALL L%FIRST ; Get first entry in watcher list
JUMPF TSNEXT ; If none, try getting another message
TSWAT0: $CALL WATSND ; Send the message
$CALL L%NEXT ; Advance to next watcher
JUMPT TSWAT0 ; If there is one, go back
TSNEXT: $CALL TSSTSH ; Store in collected messages
LOAD S1,,L.CNO ; Get list handle back
$CALL L%DENT ; Delete current entry, just sent it
$CALL L%NEXT ; And get next entry
JRST TSLOOP ; Go back to check if we won or lost
LOGOBJ: EXP .OTIBM ; Object block used for console msgs
EXP 0 ; Line
EXP 0 ; Node
TSOPR: JUMPE P3,.POPJ ;exit if no current byte pointer
SETZ S1, ;get a null
IDPB S1,P2 ;wipe out last CRLF (OPR adds it)
LOAD S1,,L.LIN ;get line number
STORE S1,LOGOBJ+1 ;store in object block
LOAD S1,,L.NAM ;get node name
STORE S1,LOGOBJ+2 ;store in object block
$WTOJ <Console output>,<^T/0(P1)/^A>,LOGOBJ
MOVE S1,P1 ;point to start of page
$CALL M%RPAG ;releases it
$CALL M%CLNC ;and clean up working set
SETZB P1,P3 ;zero out pointers
$RET
TKSDON: ;here to send collected message to OPR
$CALL TSOPR ;send it
JRST TKSND ;go wait for more work
TSSTSH: ;subroutine to stash messages in page
;P1=start of page or 0, P2=pointer to last CRLF
;P3=current byte pointer, P4=count to go
$SAVE <S1,S2,T1,T2,T3,T4,J> ;save registers
MOVE J,T1 ;save start of message
TSSTR: ;restart point if page got full
MOVE S2,J ;get address of message
HRLI S2,440700 ;make into byte pointer
DMOVE T1,P1 ;save current page parameters
DMOVE T3,P3 ; in T1-4
SKIPN P3 ;page already there?
$CALL TSCRPG ;no, create one -- will set up P's
SETZ P2, ;current attempt has no CRLF yet
TSST0: ;loop to look at message characters
ILDB S1,S2 ;get source character
JUMPE S1,TSST1 ;if null, we are done
CAIE S1,12 ;if LF
CAIN S1,15 ; or CR
$CALL TSUPL ;update P2
CAIN S1,14 ;also FF (for safety)
$CALL TSUPL ;update P2
IDPB S1,P3 ;store it page
SOJG P4,TSST0 ;continue till no room in page
DMOVE P1,T1 ;restore old pointers
DMOVE P3,T3 ; ...
$CALL TSOPR ;send this page to OPR
JRST TSSTR ;and restart us
TSST1: ;here when null seen
$RET ;exit
TSUPL: ;update CRLF pointer
SKIPN P2 ;don't update if we already have value
MOVE P2,P3 ;save current as CRLF pointer
$RET ;exit
TSCRPG: ;subroutine to create the page
$SAVE <S1,S2>
TSCRP0: $CALL M%GPAG
MOVE P1,S1 ;copy start address
SETZ P2,
MOVE P3,S1 ;copy address again
HRLI P3,440700 ;and make into a byte pointer
MOVEI P4,^D512*3 ;get number of characters that will fit
;we don't use whole page because WTOJ croaks
$RET
SUBTTL Tasks -- TKCTL, control for 2780/3780
COMMENT &
This task wakes on TW.SNR (a signon request from
a main [i.e. CDR] task), on TW.SFR (a signoff request
by a special shutdown message from QUASAR) and TW.LGN
(a line gone signal because of front end crash or line abort
set by any task getting such an error).
On a signon request, it gets the signon string from SYS:nodename.SON;
then if the line is not up it waits for it to come up (DTR and
DSR on). Once the line is up, it requests output permission
and waits till it gets it. Then it sends the signon message
to the IBM host and alternately tries to get either input or
output permission. Once it succeeds, it considers the
station signed on, sets the bit in the line block, signals
TW.SND (signon done) and goes to sleep again.
On a signoff request, this task gets the signoff string
from SYS:nodename.SOF, queues it to the CNI queue,
signals TW.CNI to get card reader task to send it, and
then waits for the line to go away (IBM hangs up).
When this happens, the task sends a message to all watchers.
It then deletes all the tasks and the line block by calling
SHTTSK.
On a line-gone condition it sends messages to the world,
waits for everything to complete (all watcher messages out,
log files written, etc.) and then calls SHTTSK to
delete station.
&
TKCTL: ;2780/3780 control task
MOVE T1,TK ;save task block pointer
LOAD S1,,L.LNI ;get line information
HRLZI S2,.TCDR ;get card-type,,0 as dev,,unit
$CALL FNDTSK ;get card reader task address
LOAD S1,,T.OBA ;address of object block
EXCH T1,TK ;get our task block back
STORE S1,,T.OBA ;save address of object block
TKCTL0: $DSCHD <TW.SNR!TW.SFR!TW.LGN> ;wait for signon request, signoff request
; or line gone
SKPN S1,,T.WCN ;get conditions which caused us to wake
$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
CTSLIN: ;loop to wait for line to come up
$CALL LINSTS ;get most recent line status
LOAD S1,,L.STS ;get line status from list entry
TXNE S1,L.UP ;is line up?
JRST CTSGO1 ; yes, go on
MOVEI S1,[ASCIZ /waiting for line to become active(DSR on)/]
STORE S1,,T.DST
$DSCHD 0,^D2*3 ;no, wait a little
JRST CTSLIN ;and try again
CTSGO1: ;here to prepare for signon
MOVE T1,TK ;save task block pointer
MOVSI S2,.TCDR ;get type,,unit 0
LOAD S1,,L.LNI ;and port,,line
$CALL FNDTSK ;find its task
TXNE S,HASP ;are we HASP Multileaving?
JRST CTSGOA ;yes, don't get things we don't need
LOAD P1,P1+T%ACS ;get device handle
PUSHJ P,CTSXBT ;exchange bit fields
EXCH TK,T1 ;put back our TK
CTSGOW: $CALL GETLNO ;request output permission
JUMPF [CAIE S1,D6NBR ;analyze failure
CAIN S1,D6DOL
JRST CTSGOW ;just hang in here
JRST CTSFAI] ;if it fails, abort
EXCH TK,T1 ;put back card reader TK
CTSGOA: ;here to store card parameters as ours
LOAD S1,,T.RIA ;get address of his record buffer
LOAD S2,,T.XBA ;get his big buffer
LOAD T2,,T.XBN ; and its size
EXCH TK,T1 ;swap task block addresses (restoring ours)
STORE S1,,T.RIA ;save record address
STORE S2,,T.XBA ;save big buffer address
STORE T2,,T.XBN ; and size
STORE T1,,T.OTK ;and pointer to CDR0 task (for later)
$CALL TBFINI ;initialize counts and pointers
$CALL SGNFIL ;setup to read signon file
JUMPF CTSGO4 ;if error, complain
TXZ S,CHECK ;ensure we don't call checking routines
$CALL COPY ;write signon message
JUMPF CTSFAI ;complain if it didn't work
ZERO ,T.RIA ;clear our record pointer,
ZERO ,T.XBA ; buffer pointer
ZERO ,T.XBN ; and size
TXNE S,HASP ;this a HASP line?
JRST CTSGO7 ;yes, don't do unnecessary wind-down
SETZ P1, ;clear out handle register
LOAD T1,,T.OTK ;get card reader TKB address
PUSHJ P,CTSXBT ;exchange T.BIT between TK and T1
CTSGO7: ;here to test result of copy
JUMPF CTSFAI ;if we cannot, abort
TXNN S,HASP ;is this HASP line?
JRST CTSGO3 ;no, assume it came up
CTSGOX: $CALL LINSTS ;yes, get line status
TXNE S1,L.UP ;has "up" bit been zeroed
TXNE S,LGA!ABORT ; or did D60JSY flag serious error?
JRST CTSFAI ;yes, indicate failure
TXNE S1,L.SND ;check signon bit
JRST CTSGOR ;it's up
$DSCHD 0,3 ;wait a second
JRST CTSGOX ;not yet, loop
CTSGOR: MOVE S1,P1 ;get handle
D60 D60RLS,CTSGOR ;release signon device
CTSGO3: ;here when OK to continue
MOVX S1,L.SND ;make sure local signon flag is set
IORM S1,L$STS(LB)
$WTOJ <Signed on>,,@T%OBA ;tell world we are signed on
MOVE T4,TK ;save task block pointer
LOAD TK,,L.FTK ;get first task on LB
CTSGO8: ;loop to activate tasks
JUMPE TK,CTSGO9 ;exit if no more TKB's
$CALL ACTTSK ;activate this one
JUMPF CTSGO5 ;die if we cannot
LOAD TK,,T.PFW ;get next one
JRST CTSGO8 ;and try again
CTSGO9: ;here when all tasks active
MOVE TK,T4 ;restore our task
MOVEI S1,%RSUOK ;code for unit is OK
LOAD P1,,T.OBA ;address of object block
SUBI P1,SUP.TY ;dummy up for RSETUP
$CALL RSETUP ;send response to setup
$SIGNL TW.SND,LINE ;let everyone know that signon has happened
MOVE TK,T4 ;restore our task
JRST CTEXT ;and exit task
CTSXBT: ;here to swap TK and T1 T.BIT fields
$SAVE S1 ;preserve register we will use
LOAD S1,,T.BIT ;get TK's bit field
EXCH S1,T$BIT(T1) ;swap them
STORE S1,,T.BIT ;save other version
$RET
CTSGO5: $STOP CAS,<Cannot accomplish SIGNON>
CTSGO4: $WTOJ <Signon error>,<^I/DGLXER/ opening signon file>,@T%OBA
JRST CTSFA0
; Here when line goes away
CTSFAI: LOAD S2,,L.LIN ;get line number
LOAD P1,,L.PRT ; and port
$WTOJ <Line ^O/S2/ on port ^O/P1/ went away>,,@T%OBA
CTSFA0: ;ignore possible error states on line
MOVEI S1,[ASCIZ /disabling line/]
STORE S1,,T.DST
LOAD S1,,L.PRT ;get port number
LOAD S2,,L.LIN ;get line number
$WTOJ <Hanging up line ^O/S2/ on port ^O/S1/>,,@T%OBA
$CALL DISABL ;turn off the line
MOVEI S1,%RSUDE ;code for device doesn't exist
LOAD P1,,T.OBA ;get address of object block
SUBI P1,SUP.TY ;dummy up for RSETUP
$CALL RSETUP ;send response to setup
SETZ S1,
STORE S1,,L.STS ;make sure status has L.UP bit off
CTSGF0: PJRST SHTTSK ;kill all the tasks
SUBTTL Tasks -- . CTSGOF, do signoff
CTSGOF: ;here to do SIGNOFF processing
LOAD S1,,L.STS ;get last line status
TXO S1,L.SFS ;indicate signoff send
STORE S1,,L.STS ;save it where all tasks can see
LOAD S2,,L.LIN ;get line number
LOAD P1,,L.PRT ; and port
MOVEI S1,[ASCIZ \waiting for active tasks to finish\]
STORE S1,,T.DST ;set dying state
$SIGNL TW.IOD,LINE ;wake any tasks waiting to do I/O
$CALL QUIESC ;wait for all tasks to settle down
PUSH P,TK ;save out task address
MOVSI S2,.TCDR ;get task id for card reader
LOAD S1,,L.LNI ;get port,,line
$CALL FNDTSK ;become card reader
JUMPF [POP P,TK ;restore task ptr
JRST CTSGF0] ;if we cannot, skip sending SIGNOFF file
MOVEI S1,[ASCIZ /Signing off/]
STORE S1,,T.DST
LOAD S2,,L.LIN ;get line number
LOAD P1,,L.PRT ; and port
$WTOJ <Line ^O/S2/ on port ^O/P1/ signing off>,,@T%OBA
LOAD P1,P1+T%ACS ;get card reader handle
$CALL TBFINI ;initialize buffer
$CALL SGFFIL ;find SIGNOFF file, initialize COPY parameters and switches
SKIPF ;don't copy it if not there
$CALL COPY ;send it out
$CALL LINSTS ; check if line is already dead
POP P,TK ; restore control task ptr now
JUMPF CTSFA0 ; make everything go away
TXNE S1,L.UP
TXNE S1,LGA
JRST CTSFA0 ; its dead
$DSCHD ,^D4*3 ; wait for the host to kill it(maybe)
JRST CTSFA0
SUBTTL Tasks -- . CTLNGN, line gone while active processing
CTLNGN: ;here if D60PRD activates control
; task and signals line has gone away
LOAD TK,,L.FTK ;get first task pointer (ctl task)
LOAD TK,,T.PFW ;get first real task
JUMPE TK,QUIDON ;if none, we don't have to wait
CTLNG0: ;loop setting ABORT and LGA for tasks
MOVE S1,S+T%ACS ;get task's S
TXO S1,ABORT+LGA ;set abort and line gone
MOVEM S1,S+T%ACS ;and put status back
$CALL WAKTSK ;activate and wake it
LOAD TK,,T.PFW ;point to next task
JUMPN TK,CTLNG0 ;and process it too, if there
$CALL QUIESC ;wait for tasks to go away [4(240)]
LOAD TK,,L.FTK ;point to our task block again
JRST CTSFAI ;and finally shut down
SUBTTL Tasks -- TKCDR, 2780/3780 card reader
COMMENT &
This task is given control by the setup routine; it first
checks if the station is up and signed on; if not, it activates
the control task, signals signon request, and waits for signon done.
Once the station is signed on, it waits