; IBMSPL - Emulation spooler for DN60 IBM communications ; ; ; COPYRIGHT (c) 1978, 1979, 1980 ; DIGITAL EQUIPMENT CORPORATION ; ; This software is furnished under a license and may be used ; and copied only in accordance with the terms of such license ; and with the inclusion of the above copyright notice. This ; software or any other copies thereof may not be provided or ; otherwise made available to any other person. No title to ; and ownership of the software is hereby transferred. ; ; The information in this software is subject to change ; without notice and should not be construed as a commitment ; by DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL assumes no responsibility for the use or reliability ; of its software on equipment which is not supplied by ; DIGITAL. ; SUBTTL Table of contents ; TABLE OF CONTENTS FOR IBMSPL ; ; ; SECTION PAGE ; 1. Table of contents......................................... 3 ; 2. Searches and version...................................... 3 ; 3. Edit history.............................................. 4 ; 4. Symbol Definitions ; 4.1 AC Definitions.................................... 5 ; 4.2 Feature Test Switches............................. 6 ; 4.3 Parameters........................................ 7 ; 4.4 External symbol definitions....................... 7 ; 5. Symbol definitions ; 5.1 Device/task type codes............................ 8 ; 5.2 Message processor status bits (in S).............. 8 ; 5.3 Task status bits (in S while task is running)..... 8 ; 5.4 Checkpoint request block offsets (from QUASAR).... 8 ; 5.5 Create queue entry message offsets (from QUASAR).. 8 ; 5.6 D60JSY interface.................................. 8 ; 5.7 DN60 Port status device active bits............... 8 ; 6. Macro definitions ; 6.1 $DSCHD, de-schedule a task........................ 9 ; 6.2 $SIGNL, indicate wakeup condition................. 10 ; 6.3 $WATCH, queue message for watchers macro.......... 11 ; 6.4 SKPTSK, skip if in task context................... 11 ; 6.5 D60, call D60JSY and analyze error return......... 11 ; 7. Database Definitions ; 7.1 Random static storage............................. 12 ; 7.2 Constant static storage........................... 13 ; 7.3 IB, Initialization block for GLXLIB............... 13 ; 7.4 HELLO, message for QUASAR at startup.............. 13 ; 7.5 ITEXT strings..................................... 13 ; 7.6 Miscellaneous cells............................... 13 ; 7.7 Interrupt system database......................... 14 ; 8. Dynamic storage definitions ; 8.1 Active task list (ATL) entry "A.xxx".............. 15 ; 8.2 Port list entry "P.xxx"........................... 16 ; 8.3 Line block list entry "L.xxx"..................... 17 ; 8.4 Task block list entry "T.xxx"..................... 18 ; 9. Interrupt code ; 9.1 INTINI, Interrupt system initialization........... 19 ; 9.2 INTIPC, IPCF Interrupt routine.................... 19 ; 10. Initialization code....................................... 20 ; 11. SCHEDULER ; 11.1 MAIN loop......................................... 21 ; 11.2 SCHED, Schedule a task............................ 22 ; 11.3 DESCHD, Deschedule a task......................... 23 ; 11.4 ACTTSK, activate a task........................... 24 ; 11.5 DEATSK, Deactivate a task......................... 25 ; 12. Subroutines ; 12.1 - WAKTSK, wake a task unconditionally............ 26 ; 12.2 - SGNTSK, signal a task.......................... 27 ; 12.3 - SGNLIN, signal all tasks on a line............. 28 ; 13. TASK ; 13.1 POLL, active device signalling.................... 29 ; 13.2 IPCF, message checker............................. 30 ; 13.3 IPCF, message processor........................... 31 ; 14. Message processors ; 14.1 Text message response............................. 32 ; 14.2 SETUP, Setup/shutdown message..................... 33 ; 14.3 - SETALL, setup a new station.................... 34 ; 14.4 - SETTSK and SETHSP, task tables................. 35 ; 14.5 - SHTALL, shutdown station (signoff)............. 36 ; 14.6 USRCN, User cancel message........................ 37 ; 14.7 OPRCN, Operator cancel message.................... 38 ; 14.8 NXTJB, Nextjob message............................ 39 ; 14.9 SHWSTS, Show status message....................... 40 ; 14.10 RQCHK, Request checkpoint message................. 41 ; 14.11 - CHKPNT, CHKPNB, send checkpoint................ 42 ; 14.12 SNDCI, send console input to IBM.................. 43 ; 15. Tasks ; 15.1 description....................................... 44 ; 15.2 TKSND, console output distribution................ 45 ; 15.3 TKCTL, control for 2780/3780...................... 46 ; 15.4 - CTSGON, wait for signon........................ 47 ; 15.5 - CTLNGN, line gone while active processing...... 48 ; 15.6 TKCDR, 2780/3780 card reader...................... 49 ; 15.7 - CDCNI, send console input to IBM............... 50 ; 15.8 - CDJOB, send job to IBM......................... 51 ; 15.9 - DOJOB, process "batch" job.................... 52 ; 15.10 - FILE, copy a disk file to IBM................. 53 ; 15.11 - NXTFIL, advance to next file in job........... 54 ; 15.12 TKLPT, 2780/3780 line printer..................... 55 ; 15.13 - LPTJOB, process printer job.................... 56 ; 15.14 TKHCDR, HASP card reader.......................... 57 ; 15.15 TKHCDP, HASP card punch........................... 58 ; 15.16 TKHLPT, HASP line printer......................... 58 ; 15.17 TKHCNI, HASP console input to IBM................. 59 ; 15.18 TKHCNO, HASP console output from IBM.............. 60 ; 16. Subroutines ; 16.1 Initialization and Main Loop subroutines.......... 61 ; 16.2 - OPDINI, Get operating system information....... 61 ; 16.3 IPCF message subroutines.......................... 62 ; 16.4 - SNDQSR, send a message to QUASAR............... 62 ; 16.5 - SNDBAK, IPCF reply to last sender.............. 63 ; 16.6 - RSETUP, response to setup (to QUASAR).......... 64 ; 16.7 - QRLSE, requeue/release (to QUASAR)............. 65 ; 16.8 - INIPAG, set up job pages....................... 66 ; 16.9 - Queue create message handling.................. 67 ; 16.10 - INIQRQ, Initialize queue request to default... 67 ; 16.11 - INSENT, Insert entry.......................... 68 ; 16.12 - FNDENT, Find entry............................ 69 ; 16.13 Task control subroutines.......................... 71 ; 16.14 - MAKLB, create line block....................... 71 ; 16.15 - BLDTSK, create task............................ 72 ; 16.16 - RELTKB, release task block..................... 73 ; 16.17 - BUFSZ, calculate task's buffer size............ 74 ; 16.18 - RELLB, delete a line block..................... 75 ; 16.19 Search subroutines................................ 76 ; 16.20 - FNDPOR, Find port block........................ 76 ; 16.21 - FNDLB, Find line block......................... 77 ; 16.22 - FNDNOD, Find line block for a node............. 78 ; 16.23 - FNDTSK, Find task from port,line,dev,unit...... 79 ; 16.24 - TSKCUR, Make TK value current entry............ 80 ; 16.25 - FNDOBJ, Find task from QUASAR object block..... 81 ; 16.26 I/O subroutines................................... 82 ; 16.27 - LOGCHR, put character in log................... 82 ; 16.28 - LOGBUF, get another log buffer................. 83 ; 16.29 - COPY, copy a file.............................. 84 ; 16.30 - GETDSK, read a record from disk................ 85 ; 16.31 - GETIBM, read a record from DN60................ 86 ; 16.32 - PUTDSK, write a record to disk................. 87 ; 16.33 - PUTIBM, write a record to DN60................. 88 ; 16.34 - PUTCNO, put a record into CNO queue............ 89 ; 16.35 - DEVOPN, open a D60JSY device................... 90 ; 16.36 - CHKDSK, Checkpoint a disk file................. 91 ; 16.37 - LINSTS, get current line status................ 92 ; 16.40 - GETLNO, ensure output is possible.............. 95 ; 16.41 - DISABL, routine to disable a line.............. 96 ; 16.42 - SGNFIL, SGFFIL, signon/signoff file setup...... 97 ; 16.43 - IBMLFR, scan incoming records.................. 98 ; 16.44 - CLLUSR, pass record to user exit............... 99 ; 16.45 - BLDFDB, build FD for holding files............. 100 ; 16.46 Debugging subroutines............................. 101 ; 16.47 - LBVER, verify LB address....................... 101 ; 16.48 DISPOS, dispose of files read from IBM host....... 102 ; 16.49 - SETACT, set print file account string.......... 103 ; 16.50 - SETLMT, Set print file page limit.............. 104 ; 17. .......................................................... 105 ; 18. .......................................................... 106 ; 19. .......................................................... 107 ; 20. .......................................................... 108 ; 21. .......................................................... 109 ; 22. .......................................................... 110 ; 23. .......................................................... 111 ; 24. .......................................................... 112 ; 25. .......................................................... 113 ; 26. .......................................................... 114 ; 27. .......................................................... 115 ; 28. .......................................................... 116 ; 29. Task scheduler blocking checker........................... 117 ; 30. Externally callable task descheduler...................... 118 ; 31. D60JSY error analyzer..................................... 119 ; 32. .......................................................... 120 ; TITLE IBMSPL - Emulation spooler for DN60 IBM communications SUBTTL Searches and version SALL ; Make nice clean listings .DIRECTIVE FLBLST ; List only 1st binary word in multi ; word text strings SEARCH IBMMAC ; IBMSPL specific definitions SEARCH GLXMAC ; Use GALAXY group's macros/symbols SEARCH QSRMAC ; Symbols for setup message SEARCH ORNMAC ; ORION communications symbols SEARCH D60UNV ; Search for linkage symbols PROLOGUE (IBMSPL) ; Initialize Galaxy symbol definitions ; Version XP IBMVER, 3 ; Major version number XP IBMMIN, 0 ; Minor version number XP IBMEDT, 211 ; Edit level XP IBMWHO, 0 ; Who did last edit (0=DEC) ; Conditional assembly flags. ND FTDEBUG, 0 ; If on .. then generate debuging code ; Version %%.IBM=: ; Set value of edit level/version ; Print title/version information to log during compilation Define VOUTX ($S1,$S2,$S3,$S4) IF1,< IFN <IBMMIN>,<VOUTX (IBMSPL - GALAXY IBM emulation spooler,\IBMVER,\"<"A"+IBMMIN>,\IBMEDT)> IFE <IBMMIN>,<VOUTX (IBMSPL - GALAXY IBM emulation spooler,\IBMVER,,\IBMEDT)> IFN FTDEBUG,<PRINTX . with DEBUG features> > ;End If PASS1 IF2,<PRINTX Pass 2.> LOC 137 ; Jobver VERWRD: EXP %%.IBM RELOC 0 IBMNAM: ASCIZ /IBMSPL/ ; Name of program EXP 0 SUBTTL Edit history COMMENT & Edit Date Who Why 0(103) 9-May-79 K Reti Development of new product 1(104) 9-May-79 KR Added TOC, and made it version 1 for loadtest 1(105) 15-May-79 KR Fixed wrong object type for RSETUP, better messages 1(106) 15-May-79 KR Make D60 skippable 1(107) 16-May-79 KR Made IBMLFR use its own (larger) stack for pattern match calls; cut down register saving overhead 1(110) 17-May-79 KR Took out IBMSPL from $MSG calls to WTOR, added error codes to SNDCIE 1(111) 17-May-79 KR Add version printing 1(112) 18-May-79 KR Fix LPCONO bugs and change version printing to use version cell when available 1(113) 23-May-79 KR Fix wrong D60JSY error message at BLDERR 1(114) 23-May-79 KR Add line signature code 1(115) 23-May-79 KR Fix console copy code in TKHCNO 1(116) 29-May-79 KR Change response to setup to be sent only after successful signon 1(117) 30-May-79 KR Various bug fixes 1(120) 30-May-79 KR Release ATL entries also at RELTKB 1(121) 31-May-79 KR Make COPY call put routine to do EOF on error 1(122) 1-Jun-79 KR Fix console input to HASP 1(123) 1-Jun-79 KR Fix recognition of console output for 2780/3780 1(124) 4-Jun-79 KR Add code so that negative POLTIM means no polling, fix WAKTIM calculations, and cause RELLB to delete port also if line was last on port; also change begin and end messages for CDR to use ^R 1(125) 4-Jun-79 KR Fix FNDOBJ calls to take false return 1(126) 6-Jun-79 KR Add support for IOWAIT argument on SNOOZE to improve performance 1(127) 6-Jun-79 KR Add code to detect new D6LGA return code 1(130) 7-Jun-79 KR Fix line gone detection code 1(131) 8-Jun-79 KR Fix single setup to send response, HASP signon wait loop to notice line going away, task quiesce code, FNDPOR and RELTKB 1(132) 10-Jun-79 KR Fix various bugs in line gone away code 2(133) 10-Jun-79 KR Make line status bits change to conform to version 3 11-code and version 2 D60JSY 2(134) 10-Jun-79 KR Make LPTJOB set active earlier so OPNHLD error messages can get in log file. 2(135) 14-Jun-79 KR Change bit definitions for line status to use D60JSY bits, add code to disable line on shutdown, change format or console input reception to conform to new string format 2(136) 15-Jun-79 KR Get the rest of the bits edit 135 didn't catch 2(137) 15-Jun-79 KR Fix minor bugs in POLDWN and TKCDR 2(140) 18-Jun-79 KR Add code to OPDINI for TOPS20 to allow structure access without prior structure mount. 2(141) 19-Jun-79 KR Bug fixes 2(142) 20-Jun-79 KR Strip blank lines from 2780/3780 console output also fix restartup of card-reader bug 2(143) 20-Jun-79 KR collect console messages destined for OPR 2(144) 21-Jun-79 KR don't send CHKPNT to QUASAR if there is no job (it complains!); also timeout CTSGOX loop 2(145) 27-Jun-79 KR Move SALL earlier, add debugging code to look for one line taking another down bug 2(146) 29-Jun-79 KR Add code at DISPER to try requeuing hold files as printer files, and to delete printer files, also add TOPS10 CHGNAM, CHGUSR, CHGSTR. 2(147) 10-July-79 SMJ Remove JXO instruction so GLXEXT can be heaved. 2(150) 11-July-79 SMJ Increase the signon interval to 5 minutes. 2(151) 20-July-79 SMJ Output the correct message on a 700000 type IPCF message. 2(152) 15-Aug-79 SMJ Put line conditioning code in SETALL. 2(153) 15-Aug-79 SMJ Fix INPOPN so that it doesn't try line sequence number stripping. 2(154) 29-Aug-79 SMJ Add support for ORION show status message. 2(155) 4-Sep-79 SMJ Change call to D60CND to now pass SETUP msg. 2(156) 4-Sep-79 SMJ Some changes to try to reduce assembly time. 2(157) 5-Sep-79 SMJ Remove status info from checkpoint message. 2(160) 18-Sep-79 SMJ Cosmetic fixes to the code at end that was never commented properly. 2(161) 25-Sep-79 SMJ Add account string code for printing disposition. 2(162) 28-Sep-79 SMJ Fix task descheduling (CHKSNZ and SNZ) so that if D60SIN/D60SOU never desched a task it can't lock out the others until it's done. 2(163) 3-Oct-79 SMJ Fix GETIBM to properly handle carriage returns that are not followed by LF, FF or DC3. 2(164) 17-Oct-79 SMJ Change name of D60JSY.UNV to D60UNV.UNV. 2(165) 29-Oct-79 SMJ Change LOOP/SCHED/DSCHED so that IPCF messages can't get locked out for extended periods. 2(166) 31-Oct-79 SMJ Clean up status message format a bit. 2(167) 1-Nov-79 SMJ Change routine in INIQRQ to create a more readable job name from the internal time. 2(170) 10-Nov-79 SMJ More code cleanup. Desupport multiple devices on a HASP line, since FE can't handle them. Fix startup/shutdown code. 2(171) 19-Nov-79 SMJ Put in fix in MSGPRC so that specified message types can be ignored w/o processing and w/o giving an error. 2(172) 25-Nov-79 SMJ Add code to COPY, LPTJOB and DISPOS to handle printer page calculations. 2(173) 28-Nov-79 SMJ Fix TKLPT (2780/3780) so that the device status goes idle after turning line back over to CDR. Also fix TKHCNI so it really checks the line status flags (not random garbage in S1). 2(174) 19-Jan-80 SMJ Update copyright date 2(175) 20-Jan-80 SMJ Fix MOVEM (should be MOVE) in POLL that destroyed real value in NOW. 2(176) 20-Jan-80 SMJ Add bytes transfered to status message 2(177) 20-Jan-80 SMJ Fix edit 167 which destroyed T.RNM, thus giving very funny dates for holding file names. 2(200) 21-Jan-80 SMJ When adding new port check if POLTIM already set. 2(201) 21-Jan-80 SMJ Make minimum of 9 page LIMIT in SETLMT. ******** Version 3 3(202) 22-Jan-80 SMJ Rewrite routines LOOP (now called MAIN), SCHED, DESCHD, MSGCHK, ACTTSK, DEATSK, SGNTSK, SGNLIN, WAKTSK. This major fix cleans up the garbage happening during task scheduling, improves code readability and increase performance. Also the routine POLL was changed to a subroutine, instead of the crazy JRST/JRST stuff that was going on. Because of massive change, increment version. 2(203) 22-Jan-80 SMJ Rewrite $DSCHD macro to use new scheduling format. 3(204) 23-Jan-80 SMJ Remove $MSG macro. Change to $STOP and $WTOJ macros. This improves source to .EXE mapping for debugging (besides not generating the correct code in the first place). Not also that the assembly time dropped by 1 CPU minute. 3(205) 24-Jan-80 SMJ Remove superfluous unreferenced cells and symbols. 3(206) 24-Jan-80 SMJ Remove code checking for a M%GPAG failure at TSCRP0+1 (this routine always stopcodes on failure). 3(207) 25-Jan-80 SMJ Remove isolated code at TKHERR and RBUF. 3(210) 26-Jan-80 SMJ Fix PUTIBM to update transfered byte count properly. 3(211) 28-Jan-80 SMJ Performance improvements. Eliminate routine CHKLNI; let POLL do the work designed for it. CHKLNI was only checking activity flags anyhow. Also if task desched on TW.IOD (I/O wait), force an immediate device polling. & SUBTTL Symbol Definitions -- AC Definitions ; Preserved AC's J=13 ; Job context pointer (address of 3-page area: ; request page, buffer page, log buffer page) LB=14 ; Line block pointer TK=15 ; Task block pointer S=16 ; Status flags ; Symbolic register definitions for when absolute register numbers ; must be used (so we can see them in the cross reference) REGS ; Generate mnemonic names for physical ; registers, i.e. R0, R1, etc. SUBTTL Symbol Definitions -- Feature Test Switches COMMENT & The following symbols enable or disable certain features in IBMSPL; the only supported settings of these switches are the default settings given below (although it is expected that this may change in the future). All the symbol enable the feature with a non-zero value, and disable the feature with a zero value WITH ONE EXCEPTION, namely FTDEBUG which (for ease of assembly) enables the debug code if defined (with any value) and disables the debug code if undefined. Its default is undefined, and it is not included in the list below. These feature test symbols are then converted to macros, to make testing for the feature easier (and more readable) in the code. Each macro has the same name as the feature test switch. & ND FTLOG, 0 ; Log files for users ND FTACCT, 0 ; Accounting ND FTCLOG, 0 ; IBMSPL central log file ND FTIBM, 0 ; Support for the IBM program DEFINE FTLOG <IFN FTLOG> DEFINE FTACCT <IFN FTACCT> DEFINE FTCLOG <IFN FTCLOG> DEFINE FTIBM <IFN FTIBM> SUBTTL Symbol Definitions -- Parameters ; Parameters which may be changed at assembly time ND PDSIZE,100 ; Size of pushdown list IFN FTDEBUG,< ND TKPDLN,170 ; Bigger stack if debugging >;End if FTDEBUG ND TKPDLN,70 ; Size of per task PDL ND LGNUM,10 ; Number of log pages to keep ND MAXDEV,^D50 ; Maximum number of devices we will service ND INSIGN,^D15 ; Time delay between receipt and ; start of job considered insignificant ND CHKCNT,^D200 ; Number of records between checkpoints ; of the "hold" files for input from IBM ND CHKRTV,^D10 ; Number of records between checkpoint ; attempts if an error occurred on the ; last checkpoint ND SNZINT,^d2 ; Number of desched checks before a ; task will for forced to deschedule ND PATPLN,^d250 ; Length of stack for pattern matching ; System dependent parameters SYSPRM SYSNML,5,10 ; Number of word in system name ; Constant parameters XP MSBSIZ,30 ; Size of message block XP MXLNBT,^D40 ; Maximum bytes on a line of status info XP MXCDBF,<^D80/4>+2 ; Maximum record buffer size for card reader XP MXLPBF,<^D144/5>+2 ; Maximum record buffer size for printer XP POLINT,^D6 ; Polling interval, in UDT units XP SGNINT,^D60*^D3*^D5 ; 5 minutes for signon to happen SUBTTL Symbol Definitions -- External symbol definitions EXTERNAL D60INI,D60OPN,D60SIN ; D60JSY routines EXTERNAL D60SOU,D60EOF,D60STS EXTERNAL D60RLS,D60OPR,D60CND EXTERNAL D60DIS EXTERNAL USRCDR,USRLPT,USRCDP ; User exits to validate records EXTERNAL PATLOG,PATSWT,DOSWT ; Pattern matching entries to IBMPAT SUBTTL Symbol definitions -- Device/task type codes .TCTL==0 ; Control task type .TLPT==1 ; LPT device type .TCDP==2 ; CDP device type .TCDR==3 ; CDR device type .TCNI==4 ; Console in device type .TCNO==5 ; Console out device type .TSND==6 ; "Send console messages to "watchers" ; (programs OPR and IBM) task type ; NOTE: the routine BLDTSK uses the fact that all the device ; (as opposed to task) codes are contiguous and begin with .TLPT ; and end with .TCNO. SUBTTL Symbol definitions -- Message processor status bits (in S) F.IPCSY==1B0 ; Message was from a GALAXY component F.HASP==1B1 ; Request was for a HASP line SUBTTL Symbol definitions -- Task status bits (in S while task is running) DSKOPN==1B0 ; Disk file is open ABORT==1B1 ; We should abort GOODBY==1B2 ; We are cleaning up QSRREQ==1B3 ; Request page has data in it ACTIVE==1B4 ; Active (i.e. console msgs should be logged) JVALID==1B5 ; Pointer to job pages is set up RQB==1B6 ; Job must be requeued INPEOF==1B7 ; Input EOF seen OUTEOF==1B8 ; Flag to write output EOF CHECK==1B9 ; Checking of records should be done (in COPY) NODEL==1B10 ; INSENT should not replace an already ; existing entry of the same type HASP==1B11 ; We are doing hasp FLSH==1B12 ; We are flushing input before signalling EOF CHKLOG==1B13 ; Check for console output in IBM output CHKSWT==1B14 ; Check for user switches in IBM output DOCHKP==1B15 ; Do checkpoints on output file NOCTLS==1B16 ; Convert ^S (23 octal) to LF (12 octal) ; (self-resetting on input EOF) LGA==1B17 ; Line has gone away TCR==1b18 ; CR seen in input IBM stream SUBTTL Symbol definitions -- Checkpoint request block offsets (from QUASAR) XP CKFIL,0 ; Number of files processed XP CKTRS,3 ; Total records processed XP CKFLG,4 ; Flags XP CKFREQ,1B0 ; Requeued by operator XP CKFCHK,1B1 ; Job was checkpointed SUBTTL Symbol definitions -- Create queue entry message offsets (from QUASAR) XP CQBEG,MSHSIZ+2 ; Beginning of entries XP CQARGN,MSHSIZ+1 ; Number of entries (arguments) SUBTTL Symbol definitions -- D60JSY interface ; Error codes DEFINE ERRS(SYM,TXT) < SYM=ZZ ZZ==ZZ+1 >;End DEFINE ERRS ZZ==660000 D60ERR ; Invoke error definitions SUBTTL Symbol definitions -- DN60 Port status device active bits XP LP0BIT,1B23 ; LPT0 active XP CP0BIT,1B31 ; CDP0 active XP CR0BIT,1B15 ; CDR0 active XP CNIBIT,1B1 ; Input console active XP CNOBIT,1B0 ; Output console active XP BUNUSD,1B2+1B3+1B4+1B5+1B6+1B7 ; Unused bits (line abort) SUBTTL Macro definitions -- $DSCHD, de-schedule a task ; Macro - $DSCHD ; ; Function - Set wake conditions and return to scheduler (de-schedule). ; ; This macro generates code that sets the bits for wakup conditions and ; the wakeup delay time and calls the scheduler. If an argument is ; omitted the corresponding function is not done. ; ; Parameters - ; ; BITS Bits defining wakeup event flags ; or keywords: ; DELETE Indicates task no longer exists ; DEACTIVATE Indicates task is removed from ATL ; TIME Time delay (in 1/3 secs) for unconditional wakeup DEFINE $DSCHD (BITS,TIME) < %%.DS==0 ;; Flag keyword not found yet IFIDN <BITS>,<DELETE>,< ;; If task has been deleted SETZ TK, ;; Clear task block pointer PJRST DESCHD ;; Jump back to MAIN context %%.DS==-1 > ;;End if DELETE IFIDN <BITS>,<DEACTIVATE>,< ;; If task has been deactivated SETZM CURATE ;; Clear Active Task List pointer $CALL DESCHD ;; Call descheduler %%.DS==-1 > ;;End if DEACTIVATE IFE %%.DS,< ;; If normal task descheduling MOVX TF,<BITS,,TIME> ;; Set wakeup conditions $CALL DESCHD ;; Call descheduler > ;;End if normal deschedule >;End DEFINE $DSCHD SUBTTL Macro definitions -- $SIGNL, indicate wakeup condition ; Macro - $SIGNL ; ; Function - To signal either a task or all the tasks on a line of a ; schedulable event. Any task that matches it's wakeup flags ; against the event signaled to it on the next scheduler pass ; is run. ; ; Parameters - ; ; BITS Wakeup event flags ; TYPE "LINE" or "TASK", the default is "TASK" DEFINE $SIGNL (BITS,TYPE<TASK>) < XLIST ..TM==0 IFIDN <TYPE>,<TASK>,< MOVEI S1,BITS $CALL SGNTSK ..TM==1 >;END IFIDN <TYPE>,<TASK> IFIDN <TYPE>,<LINE>,< MOVEI S1,BITS $CALL SGNLIN ..TM==1 >;END IFIDN <TYPE>,<LINE> IFE ..TM,< PRINTX ?Illegal argument "type" in $SIGNL call -- using TASK MOVEI S1,BITS $CALL SGNTSK >;END IFE ..TM PURGE ..TM LIST >;End DEFINE $SIGNL SUBTTL Macro definitions -- $WATCH, queue message for watchers macro DEFINE $WATCH (STRING) < $CALL WATCH CAI [ASCIZ %'STRING'%] >;End DEFINE $WATCH SUBTTL Macro definitions -- SKPTSK, skip if in task context DEFINE SKPTSK < SKIPN CURATE >;End DEFINE SKPTSK SUBTTL Macro definitions -- D60, call D60JSY and analyze error return DEFINE D60 (FNC) < XLIST CAIA JRST .+3 MOVEI TF,FNC PUSHJ P,[PUSH P,[EXP D60ANL] IFN FTDEBUG,< MOVEM TF,LSTD60 ;; Save PC of last call in case of trap >;End if FTDEBUG JRST @TF] LIST >;End DEFINE D60 SUBTTL Database Definitions -- Random static storage LOWBEG==. ; Start of area to zero ; Scheduler cells NOW: BLOCK 1 ; Current date/time (in UDT format) WAKTIM: BLOCK 1 ; Time when to do next task scheduling loop POLTIM: BLOCK 1 ; Time when to poll active devices on all ports CURATE: BLOCK 1 ; Address of current Active Task List entry SCHDGO: BLOCK 1 ; If non-zero, do another scheduling pass ; Handles for data structure linked lists LBNAM: BLOCK 1 ; Handle for line block list TSKNAM: BLOCK 1 ; Handle for task block list ATLNAM: BLOCK 1 ; Handle of list of (potentially) active tasks WATNAM: BLOCK 1 ; Handle for watcher list PTLNAM: BLOCK 1 ; Handle for port list ; Environmental information CNF: BLOCK SYSNML ; Monitor name string CNTSTA: BLOCK 1 ; Node number of central station TOPS20 < SPLDIR: BLOCK 1 ; Directory number for PS:<SPOOL> >;End if TOPS20 ; IPCF Message handling cells MDBADR: BLOCK 1 ; Message data block address for IPCF SAB: BLOCK SAB.SZ ; Send argument block for sending messages MSGBLK: BLOCK MSBSIZ ; Block to build messages in MSGLIM: BLOCK <<MXLNBT+4>/5>+1 ; Buffer area for status line overflow ; Multiple device status return block DEVBTS: BLOCK ^D12 ; Twelve lines maximum BLOCK 1 ; (overrun protection) ; Block in which to build FDB's FDBARE: BLOCK FDXSIZ ; Maximum area for file name ; File rename block FRB: BLOCK FRB.SZ ; Maximum size LOWEND==. ; End of zeroed area plus 1 ; Pattern matching and scanning stack/AC preservation area PATPDL: BLOCK PATPLN ; Reserve space for it .LACS: BLOCK 20 ; AC save area for record examine rtns ; Signon/Signoff file cells SGNFOB: EXP SGNFDB ; Address of FDB EXP 7 ; Byte size TOPS10 < SGNFDB: XWD 5,0 ; Length of FDB SIXBIT /D60/ ; Device name SGNNAM: EXP 0 ; Filename (station name) SGNTYP: EXP 0 ; Extension (.SON or .SOF) EXP 0 ; PPN >;End if TOPS10 TOPS20 < SGNTYP: EXP 0 ; Temporary pointer to extension SGNFDB: XWD 5,0 ; Length SGNFSP: BLOCK 4 ; Reserve at most 20 characters >;End if TOPS20 PDLSAV: BLOCK 1 ; Temporary storage for stack pointer PDL: BLOCK PDSIZE ; Stack for MAIN context SUBTTL Database Definitions -- Constant static storage TOPS10 < INTVEC==VECTOR ; Define interrupt vector address >;End if TOPS10 TOPS20 < INTVEC==:LEVTAB,,CHNTAB ; Define interrupt vector address >;End if TOPS20 SUBTTL Database Definitions -- IB, Initialization block for GLXLIB IB: $BUILD IB.SZ ; Initialization block $SET (IB.PRG,,%%.MOD) ; Sixbit program name (from PROLOG) $SET (IB.INT,,INTVEC) ; Interrupt system base $SET (IB.OUT,,T%TTY) ; Global TTY handling routine $SET (IB.PIB,,PIB) ; Address of PSI block $SET (IB.FLG,IP.STP,1) ; Send stopcodes to ORION $EOB PIB: $BUILD PB.MXS ; PSI information block $SET (PB.HDR,PB.LEN,PB.MNS) ; Length of block is standard $SET (PB.FLG,IP.PSI,1) ; PSI notification of IPCF message $SET (PB.INT,IP.CHN,0) ; Use PSI channel 0 $SET (PB.FLG,IP.RSE,1) ; Return send errors immediately $SET (PB.SYS,IP.SQT,511) ; Its send quota is large $SET (PB.SYS,IP.RQT,511) ; Likewise its receive quota $SET (PB.NAM,FWMASK,IBMNAM) ; Set name to be $EOB SUBTTL Database Definitions -- HELLO, message for QUASAR at startup HELLO: $BUILD HEL.SZ ; "HELLO" message block $SET (.MSTYP,MS.TYP,.QOHEL) ; Message type is "hello" message (1) $SET (.MSTYP,MS.CNT,HEL.SZ) ; Its size $SET (HEL.NM,,<'IBMSPL'>) ; Name of the spooler in SIXBIT $SET (HEL.FL,HEFVER,%%.QSR) ; QUASAR version $SET (HEL.NO,HENNOT,1) ; Max objects spooler handles $SET (HEL.NO,HENMAX,MAXDEV) ; Max number of jobs it will handle $SET (HEL.OB,,.OTIBM) ; Object $EOB SUBTTL Database Definitions -- ITEXT strings ; USRSPC is user'S name and PPN (TOPS10) or directory (TOPS20) TOPS10 < USRSPC: ITEXT (<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/ ^U/.EQOID(J)/>) >;End if TOPS10 TOPS20 < USRSPC: ITEXT (<^T/.EQOWN(J)/>) >;End if TOPS20 ; Log file stamps IBMSG: ITEXT (<^C/[-1]/ IBMSG >) IBDAT: ITEXT (<^C/[-1]/ IBDAT >) IBCON: ITEXT (<^C/[-1]/ IBCON >) IBLPT: ITEXT (<^C/[-1]/ IBLPT >) JOBID: ITEXT (<^I/JOBREQ/ for: ^I/USRSPC/>) JOBREQ: ITEXT (<Job ^W/.EQJOB(J)/ Req # ^D/.EQRID(J)/>) SUBTTL Database Definitions -- Miscellaneous cells WTORNM: EXP 5000 ; ACK code to usr for WTOR (incremented) ; Dummy Object block OBJBLK: EXP .OTIBM ; We are an IBM object EXP 0 ; No unit number EXP 0 ; No station ; Text processing utility TEXTBP: Z ; Byte pointer used by DEPBP DEPBP: IDPB S1,TEXTBP ; Store byte at byte pointer $RETT ; and return true SUBTTL Database Definitions -- Interrupt system database TOPS10 < VECTOR: BLOCK 0 ; Start of interrupt vectors VECIPC: BLOCK 4 ; IPCF vectors ENDVEC==.-1 ; Symbol marking last vector >;End if TOPS10 TOPS20 < LEVTAB: EXP LEV1PC ; Where to store level 1 PC EXP LEV2PC ; Where to store level 2 PC EXP LEV3PC ; Where to store level 3 PC CHNTAB: XWD 1,INTIPC ; IPCF interrupt on level 1 BLOCK ^D35 ; Rest of table LEV1PC: EXP 0 ; Level 1 PC LEV2PC: EXP 0 ; Level 2 PC LEV3PC: EXP 0 ; Level 3 PC >;End if TOPS20 SUBTTL Dynamic storage definitions -- Active task list (ATL) entry "A.xxx" ; !=======================================================! ; ! Time to wake up in UDT format ! ; !-------------------------------------------------------! ; ! Wakeup event bits ! Address of task block ! ; !=======================================================! DATAST A,S2 ; Data structure prefixed by "A" ; offset by register S2 $ WKT ; Time to wakeup (UDT) or 0 $ WKB,^D18 ; Wakeup conditions that occurred $ TKB,^D18 ; Address of task block $ ; Force new word $ SIZ,0 ; Size of block SUBTTL Dynamic storage definitions -- Port list entry "P.xxx" ; !=======================================================! ; ! Port number ! ; !-------------------------------------------------------! ; ! First list block ! Last line block ! ; !=======================================================! DATAST P,P1 ; Data structure prefixed by "P" ; offset by register P1 $ PRT ; Port number $ CHN,,,1 ; Chain of line blocks on this port $. FLB,^D18 ; First line block $. LLB,^D18 ; Last line block $ $ SIZ,0 ; Size of port list entry SUBTTL Dynamic storage definitions -- Line block list entry "L.xxx" ; !=======================================================! ; ! Line status ! ; !-------------------------------------------------------! ; ! First task block ! Last task block ! ; !-------------------------------------------------------! ; ! Port number ! Line number ! ; !-------------------------------------------------------! ; ! Line signature ! ; !-------------------------------------------------------! ; ! Station name (SIXBIT node name) ! ; !-------------------------------------------------------! ; ! Next line block ! Previous line block ! ; !-------------------------------------------------------! ; ! Console output queue ! Console input queue ! ; !=======================================================! DATAST L,LB ; Data structure prefixed by "L" ; offset by register LB $ STS,,,1 ; Status bits L.SND==1b0 ; Signed on L.SFR==1b1 ; Signoff requested L.SFS==1b2 ; Signoff sent L.UP==1b3 ; Line up L.HSP==1b4 ; Line is HASP $ TKB,,,1 ; Task block chain head $. FTK,^D18 ; First task in chain $. LTK,^D18 ; Last task in chain $ LNI,,,1 ; Line information $. PRT,^D18 ; Port $. LIN,^D18 ; Line on port $ SIG ; Line signature $ NAM ; Station name (for SIGNON/OFF) $ CHN,,,1 ; Chain of LB's on port $. PFW,^D18 ; Forward pointer $. PBK,^D18 ; Backward pointer $ CNO ; Console output queue (from IBM) $ CNI ; Console input queue (to IBM) $ $ SIZ,0 ; Size of line block SUBTTL Dynamic storage definitions -- Task block list entry "T.xxx" ; !=======================================================! ; ! Wakeup event flags ! Wake time delay (1/3 sec) ! ; !-------------------------------------------------------! ; ! Events causing wakeup ! Active task list entry ! ; !-------------------------------------------------------! ; ! ! ; \ Task's registers \ ; ! ! ; !-------------------------------------------------------! ; ! ! ; \ Task's stack \ ; ! ! ; !-------------------------------------------------------! ; ! Task/device type ! Unit number ! ; !-------------------------------------------------------! ; ! Next task on line ! Previous task on line ! ; !-------------------------------------------------------! ; ! Address of object block ! ; !-------------------------------------------------------! ; ! Object type ! ; !-------------------------------------------------------! ; ! Object unit ! ; !-------------------------------------------------------! ; ! Object node ! ; !-------------------------------------------------------! ; ! Device handle for D60JSY ! ; !-------------------------------------------------------! ; ! Bit for this device in activity status ! ; !-------------------------------------------------------! ; ! $WTOR ACK code ! ; !-------------------------------------------------------! ; ! Initial byte pointer for transmission buffer ! ; !-------------------------------------------------------! ; ! ! ; \ Addresses of log pages \ ; ! ! ; !-------------------------------------------------------! ; ! Count of log pages in use ! ; !-------------------------------------------------------! ; ! Count of log lines ! ; !-------------------------------------------------------! ; ! Input byte count ! ; !-------------------------------------------------------! ; ! Input byte pointer ! ; !-------------------------------------------------------! ; ! State string address ! Other task (2780/3780) ! ; !-------------------------------------------------------! ; ! Time job received ! ; !-------------------------------------------------------! ; ! Time job started ! ; !-------------------------------------------------------! ; ! Number of files in request ! ; !-------------------------------------------------------! ; ! Number of files processed ! ; !-------------------------------------------------------! ; ! Number of records transferred ! ; !-------------------------------------------------------! ; ! Log file spec address ! ; !-------------------------------------------------------! ; ! Address of "get" record routine ! ; !-------------------------------------------------------! ; ! Address of "put" record routine ! ; !-------------------------------------------------------! ; ! Last "get" error ! Last "put" error ! ; !-------------------------------------------------------! ; ! Address of "check" record routine ! ; !-------------------------------------------------------! ; ! Checkpoint routine address ! ; !-------------------------------------------------------! ; ! Record buffer address ! ; !-------------------------------------------------------! ; ! Record buffer byte count ! ; !-------------------------------------------------------! ; ! Record buffer byte pointer ! ; !-------------------------------------------------------! ; ! Disk buffer byte count ! ; !-------------------------------------------------------! ; ! Disk buffer byte pointer ! ; !-------------------------------------------------------! ; ! Transmission buffer byte count ! ; !-------------------------------------------------------! ; ! Transmission buffer byte pointer ! ; !-------------------------------------------------------! ; ! LH of ptr for Xmt buffer ! Max bytes in Xmt buffer ! ; !-------------------------------------------------------! ; ! Unique transaction name ! ; !-------------------------------------------------------! ; ! Input record count ! ; !-------------------------------------------------------! ; ! Output record count ! ; !-------------------------------------------------------! ; ! Output records left before next checkpoint ! ; !-------------------------------------------------------! ; ! Transfer count for forced task descheduling ! ; !-------------------------------------------------------! ; ! Cumulative bytes transferred for current job ! ; !=======================================================! DATAST T,TK ; Data structure prefixed by "T" ; offset by register TK $ STS,,,1 ; Task wakeup status $. WKB,^D18 ; Desired wakeup bits TW.WAK==1B18 ; Wake by another task TW.QRQ==1B19 ; QUASAR request received TW.LGN==1B20 ; Line gone TW.SFR==1B21 ; Signoff requested TW.CIR==1B22 ; Console input received TW.COR==1B23 ; Console output received TW.WMR==1B24 ; Watch/unwatch message received TW.SMR==1B25 ; Send message received TW.SNR==1B26 ; Signon requested TW.SND==1B27 ; Signon done TW.ICP==1B28 ; Input complete TW.CNI==1B29 ; Console input queued to CNI queue TW.IAV==1B30 ; Input available TW.CNO==1B31 ; Console output queued to CNO queue TW.IOD==1B32 ; Input/output done $. WKD,^D18 ; Wake time delay (in UDT units) $ WCN,^D18 ; Wakeup conditions causing SCHED $ ATE,^D18 ; Entry in active task list $ ACS,,20 ; Task's AC's $ PDL,,TKPDLN ; Task's stack $ DEV,,,1 ; Device information $. TYP,^D18 ; Device (or task) type $. UNI,^D18 ; Unit number $ CHN,,,1 ; Chain of tasks on a line block $. PFW,^D18 ; Forward link $. PBK,^D18 ; Backward link $ OBA ; Address of object block $ OBJ,,3,1 ; Object block $. OTY ; Type $. OUN ; Unit $. ONO ; Node $ DHA ; Device handle from D60JSY $ BIT ; Bit representation for this device $ WAC ; $WTOR ack code $ XBA ; Initial byte pointer for xmt buffer $ GBA,,LGNUM ; Addresses of log pages $ GCT ; Count of log pages in use $ GLN ; Count of log lines $ GIC ; Input byte count $ GIP ; Input byte pointer $ DST,^D18 ; State description address (ASCIZ) $ OTK,^D18 ; Other task address (used by 2780/3780 ; CDR to save LPT and LPT to save CDR $ TMR ; Time job received $ TMS ; Time job started $ NFL ; Number of files in request $ NFP ; Number of files processed $ NRS ; Number of records transferred $ LFS ; Address of log file spec $ GTR ; Address of routine for gets $ PTR ; Address of routine for puts $ GTE,^D18 ; Last error on get $ PTE,^D18 ; Last error on put $ CKR ; Check record routine $ CKP ; Address of checkpoint routine $ RIA ; Record buffer address $ RIC ; Record buffer byte count $ RIP ; Record buffer byte pointer $ DIC ; Disk buffer byte count $ DIP ; Disk buffer byte pointer $ XRC ; Transmission buffer byte count $ XRP ; Transmission buffer byte pointer $ XBT,^D18 ; Left half of byte ptr for xmt buffer $ XBN,^D18 ; Max bytes fitting into xmt buffer $ RNM ; Unique name for transaction $ ICT ; Input record count $ OCT ; Output record count $ OCK ; Minus records before checkpoint $ SNZ ; Forced task descheduling counter $ TBC ; Transferred byte count $ $ SIZ,0 ; Size of block SUBTTL Interrupt code -- INTINI, Interrupt system initialization ; Here to initialize interrupt system TOPS10 < INTINI: MOVEI S1,INTIPC ; Address of IPCF interrupt routine MOVEM S1,VECIPC+.PSVNP ; Save it in the vector $RETT ; Return true always >;End if TOPS10 TOPS20 < INTINI: MOVX R1,.FHSLF ; Get fork handle MOVX R2,1B0!1B1 ; Set channels 1 and 0 AIC ; Activate interrupt channels $RETT ; Return >;End if TOPS20 SUBTTL Interrupt code -- INTIPC, IPCF Interrupt routine INTIPC: $BGINT 1, ; Set up interrupt context $CALL C%INTR ; Call GLXLIB routine to post interrupt $DEBRK ; Exit interrupt SUBTTL Initialization code IBMSPL: RESET ; Clear out I/O system in case of start MOVE P,[IOWD PDSIZE,PDL] ; Load stack pointer with initial value MOVEI S1,IB.SZ ; Put size of initialization MOVEI S2,IB ; block and address in argument regs $CALL I%INIT ; and initialize GLXLIB MOVEI S1,<LOWEND-LOWBEG> ; Get size of area to be zeroed MOVEI S2,LOWBEG ; and start address $CALL .ZCHNK ; and call GLXLIB routine to do it D60 D60INI ; Initialize interface to DN60 $CALL INTINI ; Initialize interrupt system $CALL OPDINI ; Get operating system information $CALL I%ION ; Turn on interrupts MOVEI T1,HELLO ; Point to "hello" message $CALL SNDQSR ; and send it to QUASAR $CALL L%CLST ; Create a linked list MOVEM S1,TSKNAM ; Save handle for task list $CALL L%CLST ; Create another MOVEM S1,LBNAM ; Save handle for line list $CALL L%CLST ; Create another MOVEM S1,WATNAM ; Save handle for line list $CALL L%CLST ; Create list for the active task list MOVEM S1,ATLNAM ; Save name for future use JRST MAIN ; Start main loop SUBTTL SCHEDULER -- MAIN loop ; Routine - MAIN ; ; Function - This is the main scheduling loop. Whenever there is a task ; to be scheduled this loop is executed. Also there are two special ; tasks that get scheduled after a pass through the active task list. ; These are the IPCF message processor and the active device POLLer. ; ; After all tasks have been conditionally run, a check is made against ; the flag SCHDGO. If this is non-zero, another scheduling pass will ; be made of the active task list immediately. Otherwise the job will ; go to sleep. This flag is set non-zero by ACTTSK (activate task) ; and SGNTSK (signal task). ; ; The sleep time is the minimum of three values: WAKTIM (least time ; set by any task to wakeup), POLTIM (time to poll for activity flags), ; and 60 seconds. ; ; After sleeping a check against WAKTIM is done to see if it is time ; to schedule active tasks. If not, the IPCF message queue is checked ; and POLLing is conditionally done. ; ; The flow of the scheduler is such that each routine that uses a ; substantial amount of time is responsible for updating the cell NOW ; which contains the current time. The routines that currently update ; NOW are SCHED, MSGCHK and POLL. MAIN: HRLOI S1,377777 ; Get maximum positive value MOVEM S1,POLTIM ; Save as next time to poll $CALL I%NOW ; Get current time MOVEM S1,NOW ; Save it MAIN.1: SETZM SCHDGO ; Clear scheduling pass flag HRLOI S1,377777 ; Get maximum positive value MOVEM S1,WAKTIM ; Save as next time to wakeup scheduler MOVE S1,ATLNAM ; Get name of Active Task List $CALL L%FIRST ; Point to first entry on list JUMPF MAIN.3 ; If none .. go check IPCF queue MAIN.2: $CALL SCHED ; Go conditionally schedule task MOVE S1,ATLNAM ; Get name of list again $CALL L%NEXT ; Point to next entry on active list JUMPT MAIN.2 ; If there is one, try to sched it MAIN.3: $CALL MSGCHK ; Check for IPCF messages MOVE S1,POLTIM ; Get polling time CAMG S1,NOW ; Check if it's time yet $CALL POLL ; Yes .. poll for new activity SKIPE SCHDGO ; Check for another pass to be done JRST MAIN.1 ; Yes .. some task has been signaled MOVE S1,WAKTIM ; Get minimum time to make next pass CAMG S1,NOW ; Check if it's time already JRST MAIN.1 ; Yes .. go do another pass CAML S1,POLTIM ; Check if polling should be next MOVE S1,POLTIM ; Yes .. min time is for POLL SUB S1,NOW ; Calculate time to sleep ADDI S1,2 ; in seconds, insuring IDIVI S1,3 ; at least one second sleep CAIL S1,^d60 ; Check for greater than 1 minute MOVX S1,^d60 ; Yes .. limit to 1 minute max $CALL I%SLP ; Go to sleep $CALL I%NOW ; Get current time MOVEM S1,NOW ; Save it CAML S1,WAKTIM ; Check if time for scheduling pass JRST MAIN.1 ; Yes .. go execute tasks JRST MAIN.3 ; No .. just go check IPCF and POLL SUBTTL SCHEDULER -- SCHED, Schedule a task ; Routine - SCHED ; ; Function - To conditionally schedule tasks. This routine is called ; with the address of an Active Task List entry. This entry ; is checked against NOW and the flags in the associated TasK Block ; to see if the task should be run. If it is to be run the ; wakeup conditions are set, MAIN context PDL saved, and the task ; context restored. If it is not to be run, WAKTIM is updated ; to the the minimum of this task's wake time and the previous ; value. ; ; See also the co-routine DESCHD, which is called when a task ; wishes to switch back to MAIN context. ; ; Parameters - ; ; S2/ Address of Active Task List entry ; ; Note - This routine destroys all registers except the stack pointer. SCHED: LOAD TK,,A.TKB ; Get address of TasK Block LOAD T1,,A.WKB ; Get events to wake up task with LOAD T2,,T.WKB ; Get events task is waiting for LOAD T3,,A.WKT ; Get time to wakeup task at AND T2,T1 ; Mask events JUMPN T2,OKSCHD ; If event hit, schedule task JUMPE T3,.POPJ ; If no wakeup time, return to MAIN CAMG T3,NOW ; Check against current time JRST OKSCHD ; Yes .. schedule task CAMG T3,WAKTIM ; No, check against minimum sleep time MOVEM T3,WAKTIM ; Minimum seen so far .. save it $RET ; Return to MAIN OKSCHD: HRRZM S2,CURATE ; Save address of current active task STORE T2,,T.WCN ; Save event flags causing wakeup ANDCM T1,T2 ; Clear events causing wakeup STORE T1,,A.WKB ; Save events yet to be woken on ZERO ,A.WKT ; Clear wakeup time MOVEM P,PDLSAV ; Save MAIN stack context MOVSI R17,T%ACS ; Swap registers for the BLT R17,R17 ; current task's registers POPJ P, ; Return to task SUBTTL SCHEDULER -- DESCHD, Deschedule a task ; Routine - DESCHD ; ; Function - To deschedule a task and return to MAIN context. This routine ; saves the current task context (if it still exists), updates the ; current time and trys to reschedule the task by using the SCHED ; co-routine. If the task can't be rescheduled, the MAIN context ; is re-invoked. ; ; If the task descheduling itself is deactivated the cell CURATE ; (Current Active Task list Entry) should be cleared. If the task ; has deleted itself (task no longer exists) the task block pointer ; (register TK) should be cleared. ; ; The normal manner for calling is this routine is through the ; $DSCHD macro. ; ; Parameters - ; ; TF/ Wakeup-events,,Wakeup-time-delay ; TK/ Address of this task's task block ; (If zero, then this task has deleted itself) ; CURATE/ Address of pointer into Active Task List ; (If zero, then this task has deactivated itself) DESCHD: JUMPE TK,[MOVE P,PDLSAV ; If task deleted itself SETZM CURATE ; Yes .. reset from task context $CALL I%NOW ; Get current time MOVEM S1,NOW ; Save it $RET] ; Return to main context MOVEM TF,T%STS ; Save wakeup status flags TXNE TF,(TW.IOD) ; Check for I/O wait SETZM POLTIM ; Yes .. force poll task to run MOVEM R0,R0+T%ACS ; Save a scratch register MOVEI R0,R1+T%ACS ; Save the task's register HRLI R0,1 ; context BLT R0,R17+T%ACS ; in the task block MOVE P,PDLSAV ; Get MAIN stack context back $CALL I%NOW ; Get current time MOVEM S1,NOW ; Save what time it is SKIPN CURATE ; Is task still active $RET ; No .. just retun to MAIN context SETZM CURATE ; Clear task context flag ZERO ,T.WCN ; Clear events woken on LOAD S2,,T.ATE ; Point to Active Task List entry JUMPE S2,.POPJ ; If deactivated, return to MAIN ZERO ,A.WKT ; Clear time to wake up at LOAD T1,,T.WKD ; Get wakeup time delay JUMPE T1,SCHED ; If none, go try to SCHED on events ADD T1,NOW ; Get time when to wake task STORE T1,,A.WKT ; Save for SCHED PJRST SCHED ; Go try to re-schedule this task SUBTTL SCHEDULER -- ACTTSK, activate a task ; Routine - ACTTSK ; ; Function - Trys to activate a task, puts new entry on active task list for ; the newly activated task. If task already active it just returns. ; ; Parameters - TK/ Address of task to be activated. ; ; Returns - True it task activated, false if cannot make ATL entry ; ; Note - Destroys S2 ; Changes current entry for active task list ACTTSK: SKPE S1,,T.ATE ; Get active task list pointer $RETT ; Already active, so return MOVE S1,ATLNAM ; Get name of Active Task List MOVEI S2,A$SIZ ; Get size of entry $CALL L%CENT ; Create an entry JUMPF .POPJ ; If cannot, propagate failure STORE TK,,A.TKB ; Save task address in ATL entry STORE S2,,T.ATE ; Save ATL entry address in task block LOAD S1,,T.WCN ; Get saved wakeup conditions STORE S1,,A.WKB ; Save in wakeup bits ZERO ,T.WCN ; Clear wakeup conditions LOAD S1,NOW ; Get current time STORE S1,,A.WKT ; store as wakeup time so task will run SETOM SCHDGO ; Force another scheduling pass $RETT ; Return true SUBTTL SCHEDULER -- DEATSK, Deactivate a task ; Routine - DEATSK ; ; Function - Removes a task from the Active Task List (ATL) and goes back ; to the scheduler. This routine assumes normal operation of the ; scheduler. Also it assumes that only the task that is running ; can deactivate itself. Therefore the Active Task List should ; be pointing directly at the task. ; ; Parameters - TK/ Address of task to deactivate ; ; Returns - Doesn't return until task is reactivated ; ; Note - Changes "current" entry of active task list DEATSK: $SAVE <S1,S2,T1> MOVE S1,ATLNAM ; Get handle for list LOAD T1,,T.ATE ; Get pointer to current entry $CALL L%CURR ; Position to current entry JUMPF DEATS1 ; If none, start at beginning CAMN T1,S2 ; Is this the proper entry? JRST DEAFND DEATS1: $CALL L%FIRST ; Start from top of list JUMPF DEAERR ; If no entries at all .. stop DEATS2: CAMN T1,S2 ; Is this our entry? JRST DEAFND ; Yes, go delete it $CALL L%NEXT ; No, point to next entry JUMPF DEAERR ; No more entries .. error JRST DEATS2 ; Go try this entry DEAFND: LOAD S1,,A.WKB ; Get events that have already happened STORE S1,,T.WCN ; Save in convenient place LOAD S1,ATLNAM ; Get handle for active task list again $CALL L%DENT ; Delete it JUMPF DEAERR ; If we cannot, stop ZERO ,T.ATE ; Clear active task entry $DSCHD DEACTIVATE ; Return to MAIN $RET ; Task has been re-activated DEAERR: $STOP TNE,<Task not active> SUBTTL Subroutines -- - WAKTSK, wake a task unconditionally ; Routine - WAKTSK ; ; Function - If task is not active it is activated; then it set wakeup time ; to "NOW" so scheduler will pick it up on next pass. ; ; Parameters - TK/ Address of task block to be awakened ; ; Returns - True always ; ; Note - Destroys S1 and S2 ; May move current entry for active task list (ATL) ; Stopcodes if active task entry cannot be created. WAKTSK: SKPE S2,,T.ATE ; Is task active? JRST WAKTS1 ; Yes, just set time $CALL ACTTSK ; No, activate it JUMPF WAKERR ; If failed .. fatal error WAKTS1: MOVE S1,NOW ; Get current time STORE S1,,A.WKT ; Store it as wake time SETOM SCHDGO ; Force another scheduler pass $RETT ; Return true WAKERR: $STOP CAT,<Cannot activate task> SUBTTL Subroutines -- - SGNTSK, signal a task ; Routine - SGNTSK ; ; Function - Sets argument bits in active list entry to flag a condition ; for a task. ; ; Parameters - TK/ Task to be signalled ; S1/ Bits to signal task with in RH ; ; Returns - True if task is active, false if task is not already active ; ; Note - Destroys S2 SGNTSK: LOAD S2,,T.ATE ; Get active list entry JUMPE S2,.RETF ; If not active return error PUSH P,S2 ; Save it for a bit LOAD S2,,A.WKB ; Get existing bits IOR S1,S2 ; OR into desired bits POP P,S2 ; Get ATL entry address back STORE S1,,A.WKB ; Store the new wakeup bits SETOM SCHDGO ; Force another scheduler pass $RETT ; Return true SUBTTL Subroutines -- - SGNLIN, signal all tasks on a line ; Routine - SGNLIN ; ; Function - Sets argument bits for all tasks on a particular line. ; ; Parameters - LB/ Line whose tasks are to be signalled ; S1/ Bits in RH to signal tasks with ; ; Returns - True always ; ; Note - Destroys S2 SGNLIN: $SAVE <TK> ; Save task pointer LOAD TK,,L.FTK ; Get first in line block chain JUMPE TK,.RETT ; If none, done SGNLI1: $CALL SGNTSK ; Set bits LOAD TK,,T.PFW ; Get pointer to next task JUMPN TK,SGNLI1 ; If there is one, go back to loop $RETT ; Return true SUBTTL TASK -- POLL, active device signalling ; Routine - POLL ; ; Function - This routine loops through the port list (tags POLL0-POLL0E) ; reading the port status. For each port it loops through the line ; blocks chain to the port block (POLL1-POLL1E); for each line block ; it loops through all the TKB's associated with it. If the active ; bit is on for that device in the port status and the task is waiting ; for I/O done (TW.IOD) to set, it wakes the task. After looking at ; all the tasks on a line, if there are still active bits unaccounted ; for it creates new tasks to handle them. Finally, it sets up a new ; value for POLTIM (when to do next poll). POLL: SKIPN S1,PTLNAM ; Is there a port list yet? JRST POLNON ; No, so don't bother checking $CALL L%FIRST ; Yes, point to first entry JUMPF POLNON ; If none, skip activity checking ; Loop to look at each port POLL0: JUMPF POLLEX ; Exit loop if no entry MOVE P1,S2 ; Get pointer to port entry LOAD S1,,P.PRT ; Get port number HRLI S1,.STPRT ; and flag that it is multiple status MOVEI S2,DEVBTS ; Where to put device bits D60 D60STS ; Get status JUMPF POLLER ; If it failed, go analyze why LOAD LB,,P.FLB ; Point to first line block ; Loop to look at each line on the current port POLL1: LOAD S1,,L.LIN ; Get line number MOVE P2,DEVBTS(S1) ; Get the active bits for that line JUMPE P2,POLL1E ; If none are active, try next line LOAD TK,,L.FTK ; Get control task TKB pointer TXC P2,BUNUSD ; Complement bits for line abort check TXCN P2,BUNUSD ; Is it the abort bits? JRST [$CALL ACTTSK ; Activate it (in case its 2780/3780) $SIGNL TW.LGN ; Signal control task, line has gone JRST POLL1E] ; and go on to next line ; Loop to look at each task on a line POLL2: LOAD P3,,T.BIT ; Get bit for this device JUMPE P3,POLL2E ; If none, go select next device TDZN P2,P3 ; Is active bit is on for this device? JRST POLL2E ; No, continue scanning TKB's LOAD S1,,T.WKB ; Get bits task wants to wake on TXNN S1,TW.IOD ; Is it waiting for I/O done? JRST POLL2E ; No, go look at next device $SIGNL TW.IOD ; Yes, signal that I/O done occurred ; Advance to next device in task chain on current line POLL2E: LOAD TK,,T.PFW ; Get next TKB entry JUMPN TK,POLL2 ; If we got one, go back to check it ; Advance to next line on port POLL1E: LOAD LB,,L.PFW ; Get forward chain pointer JUMPN LB,POLL1 ; If there was one, go back to check it ; Get next port POLL0E: MOVE S1,PTLNAM ; Get handle name $CALL L%NEXT ; Advance to next entry JRST POLL0 ; and go back ; Done polling POLLEX: $CALL I%NOW ; Get current time MOVEM S1,NOW ; Save it ADDI S1,POLINT ; Add polling interval MOVEM S1,POLTIM ; to make new poll time $RETT ; Return to MAIN context ; Reading port status failed POLLER: LOAD LB,,P.FLB ; Get first line on port POLLE1: $SIGNL TW.LGN,LINE ; Let all tasks know line went away LOAD LB,,L.PFW ; Get next line entry JUMPN LB,POLLE1 ; If there was one, mark it down too JRST POLL0E ; and on to the next port ; No ports to poll POLNON: HRLOI S1,377777 ; Get largest number possible MOVEM S1,POLTIM ; Set poll time to then $RETT ; Return to MAIN context SUBTTL TASK -- IPCF, message checker ; Routine - MSGCHK ; ; Function - This is a special purpose task executed by the MAIN routine. ; For each IPCF message that exists the routine MSGPRC is called. ; If any message processing routine causes the change in state ; of a task the flag SCHDGO is set. After each message is processed ; the current time NOW is updated. ; ; Returns - always ; ; NOW/ Most current time ; SCHDGO/ Turned on if any task state is changed MSGCHK: $CALL C%RECV ; Get the next IPCF message JUMPF .POPJ ; If none .. just return $CALL MSGPRC ; Process this message SKIPE MDBADR ; Check for message still around $CALL C%REL ; Yes .. release it SETZM MDBADR ; Clear messgae block address $CALL I%NOW ; Get current time MOVEM S1,NOW ; Save it JRST MSGCHK ; Go onto next message SUBTTL TASK -- IPCF message processor ; Routine - MSGPRC ; ; Function - This subroutine processes IPCF messages received from QUASAR ; and ORION. MSGPRC determines if message is from someone it knows, ; and then dispatches to the proper message processing routine. ; ; Upon entry, S1 has the address of the Message Data Block (MDB) for the ; message. When this routine dispatches to the message processors, P1 ; will have the address of the message and S will have flags indicating ; what type of program sent the message, whether or not it is for ; HASP line, etc. MSGPRC: MOVEM S1,MDBADR ; Store message data block address MOVE S2,MDB.SI(S1) ; Get special index word SETZ S, ; Clear flags TXNN S2,SI.FLG ; Are we using special system index? JRST MSGPR1 ; No, don't check from whom TXO S,F.IPCSY ; Indicate we have a system message ANDX S2,SI.IDX ; Leave only the index CAIE S2,SP.OPR ; It better be ORION CAIN S2,SP.QSR ; or QUASAR JRST MSGPR1 ; Yes, go process it $WTOJ <Bad IPCF message>,<Message received from unknown system component ^O/S2/>,OBJBLK $RET ; Return to main loop after error ; Here after checking system message source MSGPR1: MOVE P1,MDB.MS(S1) ; Get address of message LOAD S1,.MSTYP(P1),MS.TYP ; Get message type MOVSI S2,-NMSGT ; Make AOBJN pointer for table ; Loop to scan MSGTAB for processing routine for this message MSGPR2: HRRZ T1,MSGTAB(S2) ; Get message type from current entry CAMN T1,S1 ; Is it the same as our message? JRST MSGPR3 ; Yes, go process it AOBJN S2,MSGPR2 ; No keep looking $WTOJ <Bad IPCF message>,<Message received with unknown type code ^O/S1/>,OBJBLK $RET ; Return to main loop ; Here when we have found MSGTAB entry for this message type MSGPR3: HLRZ T2,MSGTAB(S2) ; Get entry vector address for msg type JUMPE T2,.POPJ ; If no vector, ignore message MOVE T2,@T2 ; Get contents of vector TXNE S,F.IPCSY ; Are we processing system request? MOVS T2,T2 ; Yes, swap vector HRRZ T2,T2 ; Clear out inappropriate half JUMPN T2,@T2 ; If we still have an address, go to it $WTOJ <Bad IPCF message>,<Message type ^O/S1/ not allowed for this component type>,OBJBLK $RET ; Return to main loop after error ; Table of type,,entry vector for message process dispatch ; Entry vector points to a word that contains dispatch addresses: ; system-message-routine,,non-system-message-routine MSGTAB: XWD VSETUP,.QOSUP ; Setup/shutdown message XWD VUSRCN,.QOABO ; User cancel XWD VNXTJB,.QONEX ; Nextjob XWD VOPRCN,.OMCAN ; Operator cancel XWD VSNDCI,.OMSND ; Send console message to IBM XWD VSTATS,.OMSHS ; ORION show status command XWD VRQCHK,.QORCK ; Request for a checkpoint XWD TEXTMS,MT.TXT ; Text message XWD 0,.OMPAU ; Stop message XWD 0,.OMCON ; Continue message XWD 0,.QOREQ ; Requeue message NMSGT==.-MSGTAB ; Size of table SUBTTL Message processors -- Text message response ; Routine - TEXTMS ; ; Function - To send a text IPCF message that IBMSPL has received to ; OPR. TEXTMS: XWD TEXTM1,TEXTM1 TEXTM1: $WTOJ <Bad IPCF message>,<IBMSPL IPCF error message: ^T/.OHDRS+ARG.DA(P1)/>,OBJBLK $RET ; Return to main loop SUBTTL Message processors -- SETUP, Setup/shutdown message ; Routine - SETUP ; ; Function - This routine loads some important information (such as line,,port ; and device type,,unit into P3 and P4) then decides what to do; ; whether to setup or shutdown a whole station. Throughout this ; processing, P1 has the address of the message, P3 has port,,line ; and P4 has type,,unit-number. VSETUP: XWD SETUP,0 ; Only system msgs may setup/shutdown SETUP: MOVE P3,SUP.CN(P1) ; Get port,,line number MOVE P4,SUP.UN(P1) ; Get unit number from message HRLI P4,.TCDR ; and make into dev,,uni MOVE T4,SUP.NO(P1) ; Get station name from message LOAD T3,SUP.CN(P1),CN$SIG ; Get line signature from message LOAD S2,SUP.ST(P1),NT.TYP ; Get station type field CAIN S2,DF.HSP ; Is it HASP? TXO S,F.HASP ; Yes, light our HASP bit MOVE S2,SUP.FL(P1) ; Get flags word from message TXNN S2,SUFSHT ; Is it really shutdown? JRST SETALL ; No .. go setup station MOVE S1,T4 ; Node name for FNDNOD routine SETZ LB, ; Clear LB to say LB not found yet $CALL FNDNOD ; Go find line block for this node LOAD P3,,L.LNI ; Get port,,line from line block JRST SHTALL ; Shut down all SUBTTL Message processors -- - SETALL, setup a new station ; Routine - SETALL ; ; Function - To build the line block and associated tasks for a new ; station. ; ; The tasks created are chained to the line block and have ; forward/reverse links between all of them. For a 2780/3780 ; station there is a control task (to do signon/signoff), a card ; reader task (to send jobs to the IBM host), a line printer task ; (to read jobs from the IBM host), a console input task (to accept ; data, from the operator, to be sent to the IBM host as console ; input), and a send task (which sends the console output back to ; the operators). A HASP station gets all the tasks given to a ; 2780/3780 station plus a punch task (to read punch jobs from ; the IBM host) and a console output task (to read console output ; from the IBM host and give it to the send task for distribution). ; ; After all the tasks are built the card reader task is started. ; When this line initialization has been done and the line to the ; stations is signed on, a setup response message is sent back to ; QUASAR indicating either success or failure. If a failure occured ; control is passed to the shutdown routines and the all the setup ; that just executed is undone. ; ; Parameters - ; ; P1/ Address of setup message ; P3/ Port,,line ; P4/ Dev,,unit ; ; Returns - ; ; P2/ Response code for setup response SETALL: MOVX P2,%RSUDE ; Pre-load pessimistic setup response MOVE S1,P3 ; Get port,,line $CALL MAKLB ; Create a line block for port,,line JUMPF SETSN1 ; If we can't, send error to QUASAR MOVEI S1,0(P1) ; Get address of setup message $CALL D60CND ; Condition the line to what is needed JUMPF SETSN1 ; Couldn't condition line .. fail STORE T4,,L.NAM ; Save name of station in line block LOAD T4,,L.STS ; Get line status flags LOAD T1,S,F.HASP ; Get HASP bit from status in S SKIPE T1 ; Check for HASP flag on IORX T4,L.HSP ; Yes .. turn on HASP flag STORE T4,,L.STS ; Set new line status MOVE T1,[XWD -SETTKN,SETTSK] ; Default to 2780/3780 task table TXNE S,F.HASP ; See if HASP line MOVE T1,[XWD -SETHSN,SETHSP] ; Yes, get HASP task table instead ; Loop to add all tasks in appropriate task table SETAL1: MOVE S1,0(T1) ; Get current task table entry SETZ S2, ; Make a default device 0 $CALL BLDTSK ; Build task for it and acquire device JUMPF SETSN1 ; If either no core or couldn't get ; device, send error to QUASAR AOBJN T1,SETAL1 ; Loop through whole table DMOVE S1,P3 ; Get parameters to identify device $CALL FNDTSK ; Search existing tasks for this device JUMPT SETOK ; If there go initialize it HRRZ S1,P4 ; Get unit number JUMPE S1,SETADD ; If 0, then no need for more checking TXNN S,F.HASP ; If non-zero, is this a HASP line? JRST SETSN1 ; No, don't allow it ; Here to add main card reader task to chain SETADD: MOVEI S1,.TCDR ; Get task type HRRZ S2,P4 ; Get unit number $CALL BLDTSK ; Build the task JUMPF SETSN1 ; If error, inform QUASAR no device ; Here when main task is built SETOK: $CALL INIPAG ; Set up job pages JUMPF SETSN1 ; Cannot; tell QUASAR to give up STORE LB,LB+T%ACS ; Save line block address in ; task's LB register MOVE T1,SUP.TY(P1) ; Get batch stream object type STORE T1,,T.OTY ; Store in task block MOVE T1,SUP.UN(P1) ; Get object unit from message STORE T1,,T.OUN ; Store in task block MOVE T1,SUP.NO(P1) ; Get object node from message STORE T1,,T.ONO ; Store in task block MOVEI T1,T%OBJ ; Get address of object block STORE T1,,T.OBA ; and store it away $CALL ACTTSK ; Activate the main task MOVX P2,%RSUOK ; Indicate we have device ; Send setup response to QUASAR (P2 has code) LOAD S1,,L.STS ; Get line status bits TXC S1,L.UP!L.SND ; Is line up and signed on? TXCE S1,L.UP!L.SND ; ... JRST SETSN0 ; No, skip response till signon ; Here to send response to QUASAR SETSN1: MOVE S1,P2 ; Get response code $CALL RSETUP ; Send the response to setup message MOVE S1,SUP.UN(P1) ; Get unit from request STORE S1,OBJBLK+1 ; Store in unit MOVE S1,SUP.NO(P1) ; Get node STORE S1,OBJBLK+2 ; Store it in object block $WTOJ <Setup response>,<^1/SUP.TY(P1)/ ^O/SUP.UN(P1)/ on ^N/SUP.NO(P1)/ ^T/@SETMSG(P2)/>,OBJBLK CAIE P2,%RSUOK ; Was it all right? JRST SHTALL ; No, go shutdown the whole shmear ; Here to exit setup message processing SETSN0: AOS S1,WTORNM ; Make a unique number STORE S1,,T.WAC ; and save it as $WTOR ack code $RET ; Yes, return to message processor SETMSG: [ASCIZ /started/] ; This message if started EXP 0 ; Temporarily unavailable [ASCIZ /not available/] ; This message if failed ; Task tables ; Entry format is type code (.Txxx where xxx is device) ; in LH, and first entry point of task in RH. SETTSK: EXP .TCTL ; Control task MUST be first EXP .TLPT ; LPT task EXP .TCDR ; CDR task EXP .TSND ; Console output distributor task SETTKN==.-SETTSK ; Length of table SETHSP: EXP .TCTL ; HASP control task (must be first) EXP .TLPT ; HASP line printer task EXP .TCDP ; HASP card punch task EXP .TCDR ; HASP card reader task EXP .TCNO ; HASP console output receiver task EXP .TSND ; Console output distributor (not HASP specific) EXP .TCNI ; HASP console input sender task SETHSN==.-SETHSP ; Length of HASP table SUBTTL Message processors -- - SHTALL, shutdown station (signoff) ; Routine - SHTALL ; ; Function - To shutdown a line (all devices). If this line is signed on ; the control task for the line is awakened and it will wait for all ; activity to cease before shutting down the devices. The control task ; will then call this routine again at task level to destroy the tasks. ; If the line is not signed on, the tasks will be released immediately. ; ; Exit is made via SHTEXT code which either returns by $RET or goes to ; the scheduler depending on whether it deleted its entry TKB (task) ; if it came from task context. ; ; Parameters - ; ; P3/ Port,,line ; P4/ Dev,,unit ; Here to shutdown all (signoff) SHTALL: JUMPE LB,SHTERR ; If no line block, stop PUSH P,TK ; Save our entry task block $CALL LINSTS ; Get best line status JUMPF SHTAL0 ; If error, assume line is down SETCMM S2 ; Ones complement all the bits TXNE S2,L.UP!L.SND ; If line is up and signed on CAIA ; No .. shutdown immediate JRST SHTALD ; Do delayed signoff ; Here to do shutdown right away SHTAL0: SETZ TK, ; Zero task pointer PUSH P,TK ; Push zero on stack to flag end LOAD TK,,L.FTK ; Get control task's TKB JUMPE TK,SHTAL2 ; If none, just release line block ; Loop to release tasks SHTAL1: CAMN TK,-1(P) ; About to free entry task block? MOVEM TK,0(P) ; Yes, flag it LOAD T1,,T.PFW ; Get address of next TKB in chain $CALL RELTKB ; Release this one MOVE TK,T1 ; Get next one into proper register JUMPN TK,SHTAL1 ; and if there was next one, release it ; Here to release line block SHTAL2: $CALL RELLB ; Release line block too POP P,TK ; Get "last freed" task or 0 JRST SHTEXT ; Exit ; Here to do delayed shutdown SHTALD: TXO S1,L.SFR ; Set line block bit shutdown requested STORE S1,,L.STS ; and save line status bits LOAD TK,,L.FTK ; Get control task TKB $SIGNL TW.SFR,TASK ; Wake him to do signoff SETZ TK, ; Indicate we didn't delete ourselves ; Here to exit from shutdown SHTEXT: POP P,S1 ; Get entry task block EXCH S1,TK ; Swap with last deleted one SKPTSK ; Skip if from task context $RET ; Exit via return to msgprc CAME S1,TK ; Did we delete ourselves? $RET ; No, exit via return to task $DSCHD DELETE ; Deschedule this task forever ; Here if device does not exist that QUASAR is shutting down. SHTERR: $STOP DNA,<QUASAR Shutting down inactive device> SUBTTL Message processors -- USRCN, User cancel message ; Routine - USRCN ; ; Function - This routine tests if the job is already aborting or exiting, ; and if so exits. Then it tests if the disk file is open, and ; if so sets it to return end of file on the next read. Finally ; it sets the GOODBY and ABORT bits in the task's S, wakes the task, ; makes an entry into the log file and sends a message to operators. VUSRCN: XWD USRCN,0 ; Only system components can do cancels USRCN: MOVEI S1,ABO.TY(P1) ; Point to object block in message $CALL FNDOBJ ; Set up TK, LB and J JUMPF .POPJ ; Return if we cannot find it LOAD S,S+T%ACS ; Get S TXOE S,GOODBY!ABORT ; Set abort and end processing bits $RET ; If already on, ignore request ; TXNE S,DSKOPN ; See if disk is being read ; $CALL INPFEF ; Yes, force input end of file STORE S,S+T%ACS ; Put back updated status bits $CALL WAKTSK ; Wake up task unconditionally $TEXT (LOGCHR,<^I/IBMSG/Job cancelled by user ^U/ABO.ID(P1)/>) $WTOJ <Cancelling>,<^R/.EQJBB(J)/>,@T%OBA $RET ; Exit SUBTTL Message processors -- OPRCN, Operator cancel message ; Routine - VOPRCN ; ; Function - This routine does effectly the same thing as USRCN except ; the cancel request has come from the operator instead of a user. VOPRCN: XWD OPRCN,0 ; Operator cancel legal only from ; system component OPRCN: MOVEI S1,.OHDRS+1(P1) ; Point to object block LOAD S2,-1(S1),AR.TYP ; Get type of block CAIE S2,.OROBJ ; Is it ORION object block? $RET ; No, ignore bad message $CALL FNDOBJ ; Find the task for the object type JUMPF .POPJ ; Return if we cannot find it LOAD S,S+T%ACS ; Get status TXOE S,GOODBY!ABORT ; Tell low level to get out $RET ; If it was already doing it, exit STORE S,S+T%ACS ; Stash status again $CALL WAKTSK ; Make task wake up $TEXT (LOGCHR,<^I/IBMSG/Job cancelled by operator>) $WTOJ <Cancelling>,<^R/.EQJBB(J)/>,@T%OBA $RET SUBTTL Message processors -- NXTJB, Nextjob message ; Routine - NXTJB ; ; Function - This routine save the current time as that when the request ; was received, copies the request into the first job page for ; the task (also sets the bit indicating that it is present) ; and finally signals a "request from QUASAR" wake condition ; for the task. VNXTJB: XWD NXTJB,0 ; Only system programs can give a job NXTJB: MOVEI S1,.EQROB(P1) ; Point to object block $CALL FNDOBJ ; Set up world JUMPF NXTJER ; Issue message if we cannot find it LOAD S,S+T%ACS ; Get task status bits TXOE S,QSRREQ ; Indicate we have a request $STOP MRR,<Request received while another active> STORE S,S+T%ACS ; Save S for task $CALL I%NOW ; Get current time STORE S1,,T.TMR ; Save it as receive time of request HRR S1,J ; Get destination for request in RH HRL S1,P1 ; and source in LH LOAD S2,.MSTYP(P1),MS.CNT ; Get length of message ADDI S2,-1(J) ; Compute last word address BLT S1,0(S2) ; Copy message $SIGNL TW.QRQ,TASK ; Tell task request is there $RET ; And exit NXTJER: $WTOJ <Nextjob error>,<Cannot find object block>,@T%OBA $RET SUBTTL Message processors -- SHWSTS, Show status message ; Routine - SHWSTS ; ; Function - This routine sets up the ack message to send to the ; operator (OPR) telling him what the status of the emulation ; devices on a particular node are doing. VSTATS: XWD SHWSTS,0 ; Only system programs for now. SHWSTS: $SAVE <S,J,P2,LB,TK> ; Save some registers MOVE P2,.OHDRS+ARG.DA+OBJ.ND(P1) ; Get node name (SIXBIT) MOVE S1,LBNAM ; Get name of line block list $CALL L%FIRST ; Point to first entry on list SHWLP1: JUMPF SHWER1 ; If no more .. didn't find node MOVE LB,S2 ; Put line block addr in correct place LOAD S2,,L.NAM ; Get name of node for this line CAMN S2,P2 ; Check if one we are looking for JRST SHWFND ; Yes .. found line block for node $CALL L%NEXT ; No .. continue looking JRST SHWLP1 ; Go check next list entry SHWFND: $CALL M%GPAG ; Get a page for the text MOVE P2,S1 ; Save the page address HRLI S1,(POINT 7,) ; Make byte pointer to text buffer MOVEM S1,TEXTBP ; Save for $TEXT processing routine $TEXT (DEPBP,<^T/STSHDR/>^A) ; Output the status header string LOAD TK,,L.FTK ; Get address of first task block SHWLP2: MOVE S,S+T%ACS ; Get status registers LOAD S2,,T.TYP ; Get task type CAIL S2,.TLPT ; Check for within range of CAILE S2,.TCDR ; device type tasks JRST SHWTST ; No .. ignore control tasks LOAD S1,,T.DST ; Get address of task state string $TEXT (DEPBP,<^T14/@STSNAM-1(S2)/^T16/0(S1)/>^A) MOVE J,J+T%ACS ; Get pointer to JOB pages LOAD S2,,T.TYP ; Get device type again CAIE S2,.TCDR ; Check for a card reader (batch strm) JRST SHWLPT ; No .. go show LPT or CDP TXNN S,QSRREQ ; Check for request page setup JRST SHWLF ; No .. just end the line HLRZ S2,.EQSEQ(J) ; Get sequence number of job TOPS20< $TEXT (DEPBP,<^D4/S2/ ^W9/.EQJOB(J)/^T/.EQOWN(J)/>)> TOPS10< $TEXT (DEPBP,<^D4/S2/ ^W9/.EQJOB(J)/^W6/.EQOWN(J)/^W6/.EQOWN+1(J)/>)> JRST SHWRUN ; Go output transfer start time SHWLPT: TXNE S,ACTIVE ; Check for device really active TXNN S,JVALID ; Check for job pages existant JRST SHWLF ; No .. end the status line MOVX T2,.QCJBN ; Find the job name entry $CALL FNDENT ; in the queue request create page JUMPF SHWNJB ; No job name .. just output blanks $TEXT (DEPBP,< ^W9/1(S1)/^A>) CAIA SHWNJB: $TEXT (DEPBP,< ^A>) MOVX T2,.QCNAM ; Find the user name entry $CALL FNDENT ; in the queue request create page JUMPF SHWLF ; None .. just close off the line TOPS20< $TEXT (DEPBP,<^T/1(S1)/^A>)> ; Output name from queue entry TOPS10< $TEXT (DEPBP,<^W6/1(S1)/^W6/2(S1)/^A>)> SHWLF: $TEXT (DEPBP,<>) ; Put CRLF at end of line if needed SHWRUN: TXNE S,ACTIVE ; Check for an active task $TEXT (DEPBP,< Started at: ^H/T%TMS/ transferred ^D/T%TBC/ bytes>) SHWTST: LOAD TK,,T.PFW ; Get next task on this line JUMPN TK,SHWLP2 ; If there is one .. continue output $ACK (< IBM node ^W/.OHDRS+ARG.DA+OBJ.ND(P1)/ device status >,<^T/0(P2)/>,,<.MSCOD(P1)>,<$WTFLG (WT.NFO)>) MOVE S1,P2 ; Get message page address back PJRST M%RPAG ; Return page to free pool ; Return to message vectoring routine SHWER1: $ACK (<IBM node ^W/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,< Unknown node status requested>,,<.MSCOD(P1)>) $RET STSHDR: ASCIZ \ Device Status Seq# Jobname Username ----------- ------------ ---- ------- -------- \ STSNAM: [ASCIZ \Line printer\] [ASCIZ \Card punch\] [ASCIZ \Card reader\] SUBTTL Message processors -- RQCHK, Request checkpoint message ; Routine - RQCHK ; ; Function - This routine merely sets up the task context and calls ; the CHKPNT to build and send the message; if the request ; was from a non-system program it calls the subroutine at the ; CHKPNB entry point. VRQCHK: XWD RQCHK,RQCHK ; Both types can request checkpoints RQCHK: MOVEI S1,RCK.TY(P1) ; Point object block sent by QUASAR $CALL FNDOBJ ; Set up TK and LB and J JUMPF .POPJ ; Ignore it if we cannot find it LOAD S1,S+T%ACS ; Set task's status bits TXNN S1,QSRREQ ; See if we are processing a request $RET ; No, QUASAR doesn't expect chkpnt MOVEI T1,CHKPNT ; Assume only to QUASAR TXNN S,F.IPCSY ; See if request came from system MOVEI T1,CHKPNB ; No, use other entry point PJRST @T1 ; Go there and then return to main loop SUBTTL Message processors -- - CHKPNT, CHKPNB, send checkpoint ; Routine - CHKPNT, CHKPNB ; ; Function - CHKPNT is the subroutine to build a checkpoint message in ; the message block and then send it to QUASAR; CHKPNB is an entry ; point that can be used only from the message processing level to ; send a checkpoint message both to QUASAR and to the NON-SYSTEM PROGRAM ; that sent the request. ; ; Parameters - LB must be set up ; ; Returns - True if SNDQSR does ; ; Note - Destroys S1 and S2 CHKPNB: TDZA S2,S2 ; Entry to send checkpoint to both CHKPNT: SETOM S2 ; Set QUASAR-only flag true $SAVE <S,TK,J,T1,T2,T3,T4> ; Save registers LOAD S1,,T.TYP ; Get caller's context type SETZ T4, ; Provisionally clear register to hold ; device selected for checkpoint information CAIN S1,.TCDR ; Is it a card reader device? HRRZ T4,TK ; Yes, use it MOVEI T1,MSGBLK ; Point to block in which to build ; message (can do this since we are ; not interruptible until WE do ; a $DSCHD MOVX S1,CH.FCH ; Indicate that we have checkpoint info STORE S1,CHE.FL(T1) ; Store flags in message LOAD TK,,L.FTK ; Point to first device on line JUMPE TK,CHKLO4 ; If none, we are done CHKLOP: LOAD T2,,T.TYP ; Get task/device type SKIPE T4 ; Selected device for checkpoint info? JRST CHKLO1 ; Yes, go see if they match CAIE T2,.TCDR ; No, see if this is a candidate JRST CHKLO2 ; No, just do continue HRRZ T4,TK ; Yes, select him CHKLO1: CAME TK,T4 ; Device we wish to checkpoint? JRST CHKLO2 ; No, just continue to next task LOAD S1,,T.NFP ; Get number of files processed STORE S1,CHE.IN+CKFIL(T1) ; Save it in checkpoint block LOAD S1,,T.NRS ; Get number of records processed STORE S1,CHE.IN+CKTRS(T1) ; Save it too LOAD J,J+T%ACS ; Get address of request LOAD S1,.EQITN(J) ; Get internal number from request STORE S1,CHE.IT(T1) ; and save it also MOVX S1,CKFCHK ; Flag that job has been checkpointed STORE S1,CHE.IN+CKFLG(T1) ; Set it in block CHKLO2: LOAD TK,,T.PFW ; Get next task in chain JUMPN TK,CHKLOP ; If there was one, go back to loop CHKLO4: MOVX S1,CHE.ST ; Get length of message STORE S1,.MSTYP(T1),MS.CNT ; Save as length of message MOVX S1,.QOCHE ; Get function (checkpoint) STORE S1,.MSTYP(T1),MS.TYP ; And save it in header too SKIPE S2 ; See it we are to send to caller JRST CHKLO5 ; No, just to QUASAR SKPTSK ; Only message processors can send back to caller $CALL SNDBAK ; Send it back CHKLO5: PJRST SNDQSR ; Send it to QUASAR SUBTTL Message processors -- SNDCI, send console input to IBM ; Routine - SNDCI ; ; Function - This routine receives a message from either OPR (send to ; batch stream) or a non-system component (with the same codes for ; simplicity) which is a console line intended to be sent to IBM. ; After some validity checking, it merely copies it into a console ; input queue (CNI) entry and signals TW.CNI to the appropriate task. VSNDCI: XWD SNDCI,SNDCI ; Both types can do this SNDCI: MOVEI S1,.OHDRS(P1) ; Point past message header LOAD S2,ARG.HD(S1),AR.TYP ; Get type of first block LOAD T1,ARG.HD(S1),AR.LEN ; and length ADD T1,S1 ; Compute address of next block SETZM SNDCEC ; Initialize error code CAIE S2,.OROBJ ; Is first block object block? JRST SNDCIE ; No, inform world of error AOS SNDCEC ; Increment error code AOS S1 ; Point to start of object type $CALL FNDOBJ ; Yes, set up TK properly JUMPF SNDCIE ; If cannot, something is very wrong LOAD LB,LB+T%ACS ; Get pointer to line block LOAD S2,ARG.HD(T1),AR.TYP ; Get type of second block AOS SNDCEC ; Increment error code to 2 CAIE S2,.CMTXT ; It better be text type JRST SNDCIE ; It isn't, so complain HRRI S1,1(T1) ; Point to start of data part HRLI S1,440700 ; and make it into a byte pointer SNDCI0: ILDB S2,S1 ; Get next character CAIE S2,"=" ; Is it colon? JRST SNDCI0 ; No, keep looking SNDCI1: ILDB S2,S1 ; Get next character CAIN S2,76 ; Is it right angle bracket? JRST SNDCI1 ; Yes, go back for more MOVE T3,S1 ; No, save pointer to here MOVEI T2,1 ; Initialize count of chars JRST SNDCI3 ; and dive in with first character SNDCI2: ILDB S2,S1 ; Get next character SNDCI3: AOS T2 ; Count it CAIE S2,12 ; Is it linefeed? JRST SNDCI2 ; No, keep looking LOAD S1,,L.CNI ; Get CNI queue list handle MOVE S2,T2 ; Copy length in bytes ADDI S2,4+5 ; Compute length IDIVI S2,5 ; in words (accounting for length word) AOS SNDCEC ; Increment error code to 3 $CALL L%CENT ; and get a new entry JUMPF SNDCIE ; If no room, go complain MOVEM T2,0(S2) ; Store length in first word ADD S2,[XWD 440700,1] ; Make entry address into byte pointer LDB S1,T3 ; Get first byte of message JRST SNDCI5 ; and dive into loop SNDCI4: ILDB S1,T3 ; Get next character SNDCI5: IDPB S1,S2 ; Store it in entry SOJG T2,SNDCI4 ; Loop till no more characters left $SIGNL TW.CNI,LINE ; and inform world its there $RET ; Return to MSGPRC SNDCIE: MOVE S2,SNDCEC ; Get error code $WTOJ <Console error>,<Error "^T/@SNDERR(S2)/" processing send message.>,@T%OBA $RET SNDCEC: EXP -1 EXP [ASCIZ /illegal error code/] SNDERR: EXP [ASCIZ /first block in msg not object/] EXP [ASCIZ /can't find task for object block/] EXP [ASCIZ /second block in msg not text/] EXP [ASCIZ /cannot create CNI queue entry/] SUBTTL Tasks -- description COMMENT & The tasks IBMSPL uses can be divided into common tasks (TKCTL, TKSND) and line-type dependent tasks (TKCDR-TKHCDR, TKLPT-TKHLPT, TKHCNI, TKHCNO and TKHPUN). TKSND takes console output from the CNO queue (it was placed there either by TKLPT for 2780/3780 or by TKHCNO for HASP) and distributes it to all "watchers" of the console line. These include OPRs (for a short time after the operator issues a "send" command), IBMs (the program specifically designed for watching the console) and the log files for jobs coming in from IBM (so that the eventual user can see what was done to his job by operators or other users). The control task (TKCTL) is responsible for signon and signoff. The card reader tasks (TKCDR for 2780/3780 and TKHCDR for HASP) copy jobs to IBM. The lineprinter and punch (TKLPT, TKHLPT and TKHPUN) tasks copy jobs from the IBM host to disk files, and then either rename them to the user's area or queue them to the appropriate device on the 10/20. They obtain the information on what to do by scanning the received data for specific switches (a process called log-file recognition, or recognition for short). The console input (TKHCNI) task copies messages from the CNI queue to the IBM host; entries are placed in the queue by the send message processor. The console output task (TKHCNO) copies output messages from the IBM host to the CNO queue and wakes up the send task to distribute them to whomever is interested. & SUBTTL Tasks -- TKSND, console output distribution ; Task - TKSND ; ; Function - This task distributes console output arriving from the IBM ; host to 1) all log files of active devices for that port,,line and ; 2) all programs that have declared themselves "watchers" of the ; console line. There are two programs intended to be watchers, ; OPR (which becomes a watcher for a small period of time after ; issuing a "send to batch-stream" command; and non-system programs ; which allow a user of the DN6x to send messages and receive replies ; over the console pipe to IBM. ; ; This tasks wakes upon an TW.CNO signal, which is set by TKLPT ; (2780/3780) or by TKHCNO (HASP) after after they have queued console ; output to the CNO list for the line. ; ; This task dequeues messages from this list, loops over all devices ; on the line and inserts the message into the log file for all active ; devices; then it loops over the list of watchers, sending the message ; to all. TKSND: LOAD S1,,L.STS ; Get status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Exit and wait to die $DSCHD TW.CNO,0 ; Wait only on CNO queued signal LOAD S1,,L.CNO ; Get handle for CNO list $CALL L%FIRST ; Position to the beginning of the list TSLOOP: JUMPF TKSDON ; If none, send to OPR then wait again MOVE T1,S2 ; Copy address of message entry LOAD T2,,L.FTK ; Get first task in line block chain JUMPE T2,TSWAT ; If none, go send it to watchers EXCH TK,T2 ; Save our task context and use his TSLOG: LOAD S,S+T%ACS ; Get task's status TXNE S,ACTIVE ; Is it active? $TEXT (LOGCHR,<^I/IBCON/^T/0(T1)/>) LOAD TK,,T.PFW ; Get next task in chain JUMPN TK,TSLOG ; If there is one, go back EXCH T2,TK ; Otherwise restore our context again TSWAT: MOVE S1,WATNAM ; Get handle for watcher list $CALL L%FIRST ; Get first entry in watcher list JUMPF TSNEXT ; If none, try getting another message TSWAT0: $CALL WATSND ; Send the message $CALL L%NEXT ; Advance to next watcher JUMPT TSWAT0 ; If there is one, go back TSNEXT: $CALL TSSTSH ; Store in collected messages LOAD S1,,L.CNO ; Get list handle back $CALL L%DENT ; Delete current entry, just sent it $CALL L%NEXT ; And get next entry JRST TSLOOP ; Go back to check if we won or lost LOGOBJ: EXP .OTIBM ; Object block used for console msgs EXP 0 ; Line EXP 0 ; Node TSOPR: JUMPE P3,.POPJ ;exit if no current byte pointer SETZ S1, ;get a null IDPB S1,P2 ;wipe out last CRLF (OPR adds it) LOAD S1,,L.LIN ;get line number STORE S1,LOGOBJ+1 ;store in object block LOAD S1,,L.NAM ;get node name STORE S1,LOGOBJ+2 ;store in object block $WTOJ <Console output>,<^T/0(P1)/^A>,LOGOBJ,<$WTFLG (WT.NFO)> MOVE S1,P1 ;point to start of page $CALL M%RPAG ;releases it $CALL M%CLNC ;and clean up working set SETZB P1,P3 ;zero out pointers $RET TKSDON: ;here to send collected message to OPR $CALL TSOPR ;send it JRST TKSND ;go wait for more work TSSTSH: ;subroutine to stash messages in page ;P1=start of page or 0, P2=pointer to last CRLF ;P3=current byte pointer, P4=count to go $SAVE <S1,S2,T1,T2,T3,T4,J> ;save registers MOVE J,T1 ;save start of message TSSTR: ;restart point if page got full MOVE S2,J ;get address of message HRLI S2,440700 ;make into byte pointer DMOVE T1,P1 ;save current page parameters DMOVE T3,P3 ; in T1-4 SKIPN P3 ;page already there? $CALL TSCRPG ;no, create one -- will set up P's SETZ P2, ;current attempt has no CRLF yet TSST0: ;loop to look at message characters ILDB S1,S2 ;get source character JUMPE S1,TSST1 ;if null, we are done CAIE S1,12 ;if LF CAIN S1,15 ; or CR $CALL TSUPL ;update P2 CAIN S1,14 ;also FF (for safety) $CALL TSUPL ;update P2 IDPB S1,P3 ;store it page SOJG P4,TSST0 ;continue till no room in page DMOVE P1,T1 ;restore old pointers DMOVE P3,T3 ; ... $CALL TSOPR ;send this page to OPR JRST TSSTR ;and restart us TSST1: ;here when null seen $RET ;exit TSUPL: ;update CRLF pointer SKIPN P2 ;don't update if we already have value MOVE P2,P3 ;save current as CRLF pointer $RET ;exit TSCRPG: ;subroutine to create the page $SAVE <S1,S2> TSCRP0: $CALL M%GPAG MOVE P1,S1 ;copy start address SETZ P2, MOVE P3,S1 ;copy address again HRLI P3,440700 ;and make into a byte pointer MOVEI P4,^D512*5 ;get number of characters that will fit $RET SUBTTL Tasks -- TKCTL, control for 2780/3780 COMMENT & This task wakes on TW.SNR (a signon request from a main [i.e. CDR] task), on TW.SFR (a signoff request by a special shutdown message from QUASAR) and TW.LGN (a line gone signal because of front end crash or line abort set by any task getting such an error). On a signon request, it gets the signon string from SYS:nodename.SON; then if the line is not up it waits for it to come up (DTR and DSR on). Once the line is up, it requests output permission and waits till it gets it. Then it sends the signon message to the IBM host and alternately tries to get either input or output permission. Once it succeeds, it considers the station signed on, sets the bit in the line block, signals TW.SND (signon done) and goes to sleep again. On a signoff request, this task gets the signoff string from SYS:nodename.SOF, queues it to the CNI queue, signals TW.CNI to get card reader task to send it, and then waits for the line to go away (IBM hangs up). When this happens, the task sends a message to all watchers. It then deletes all the tasks and the line block by calling SHTALL. On a line-gone condition it sends messages to the world, waits for everything to complete (all watcher messages out, log files written, etc.) and then calls SHTALL to delete station. & TKCTL: ;2780/3780 control task MOVE T1,TK ;save task block pointer LOAD S1,,L.LNI ;get line information HRLZI S2,.TCDR ;get card-type,,0 as dev,,unit $CALL FNDTSK ;get card reader task address LOAD S1,,T.OBA ;address of object block EXCH T1,TK ;get our task block back STORE S1,,T.OBA ;save address of object block TKCTL0: $DSCHD <TW.SNR!TW.SFR!TW.LGN> ;wait for signon request, signoff request ; or line gone SKPN S1,,T.WCN ;get conditions which caused us to wake $STOP ILW,<Illegal wakeup> TXZE S1,TW.SNR ;if signon request JRST CTSGON ;go process it TXZE S1,TW.LGN ;if line gone (which thus has priority ; over signoff) JRST CTLNGN ;go process it TXZE S1,TW.SFR ;if signoff request JRST CTSGOF ;go do it CTEXT: ;here to exit control task $CALL DEATSK ;deactivate JRST TKCTL0 ;and go back to beginning SUBTTL Tasks -- - CTSGON, wait for signon CTSGON: ;here to do signon $CALL I%NOW ;get current time ADDI S1,SGNINT ;add signon interval to it MOVE P2,S1 ;save result CTSLIN: ;loop to wait for line to come up $CALL LINSTS ;get most recent line status LOAD S1,,L.STS ;get line status from list entry TXNE S1,L.UP ;is line up? JRST CTSGO1 ; yes, go on $CALL I%NOW ;see what time it is CAMLE S1,P2 ;are we past signon interval? JRST CTSFAI ;yes, say we failed $DSCHD 0,1 ;no, wait a little JRST CTSLIN ;and try again CTSGO1: ;here to prepare for signon MOVE T1,TK ;save task block pointer MOVSI S2,.TCDR ;get type,,unit 0 LOAD S1,,L.LNI ;and port,,line $CALL FNDTSK ;find its task LOAD S1,,T.RIA ;get address of his record buffer LOAD S2,,T.XBA ;get his big buffer LOAD T2,,T.XBN ; and its size TXNE S,HASP ;are we HASP Multileaving? JRST CTSGOA ;yes, don't get things we don't need LOAD P1,P1+T%ACS ;get device handle PUSHJ P,CTSXBT ;exchange bit fields EXCH TK,T1 ;put back our TK $CALL GETLNO ;request output permission JUMPF CTSFAI ;if it fails, abort EXCH TK,T1 ;put back card reader TK CTSGOA: ;here to store card parameters as ours EXCH TK,T1 ;swap task block addresses (restoring ours) STORE S1,,T.RIA ;save record address STORE S2,,T.XBA ;save big buffer address STORE T2,,T.XBN ; and size STORE T1,,T.OTK ;and pointer to CDR0 task (for later) $CALL TBFINI ;initialize counts and pointers $CALL SGNFIL ;setup to read signon file JUMPF CTSGO4 ;if error, complain TXZ S,CHECK ;ensure we don't call checking routines $CALL COPY ;write signon message TXNE S,LGA ;see if line went away JRST CTSFAI ;yes, go complain ZERO ,T.RIA ;clear our record pointer, ZERO ,T.XBA ; buffer pointer ZERO ,T.XBN ; and size TXNE S,HASP ;this a HASP line? JRST CTSGO7 ;yes, don't do unnecessary wind-down SETZ P1, ;clear out handle register LOAD T1,,T.OTK ;get card reader TKB address PUSHJ P,CTSXBT ;exchange T.BIT between TK and T1 CTSGO7: ;here to test result of copy JUMPF CTSFAI ;if we cannot, abort TXNN S,HASP ;is this HASP line? JRST CTSGO3 ;no, assume it came up CTSGOX: ;here to check for signon $CALL I%NOW ;get current time in S1 CAMLE S1,P2 ;past his time limit? JRST CTSFAI ;yes, tell world that line has gone $DSCHD 0,3 ;wait a second $CALL LINSTS ;yes, get line status TXNE S1,L.UP ;has "up" bit been zeroed TXNE S,LGA ; or did D60JSY flag serious error? JRST CTSFAI ;yes, indicate failure TXNN S2,SLSON ;check signon bit JRST CTSGOX ;not yet, loop MOVE S1,P1 ;get handle D60 D60RLS ;release signon device CTSGO3: ;here when OK to continue $WTOJ <Signed on>,,@T%OBA ;tell world we are signed on MOVE T4,TK ;save task block pointer LOAD TK,,L.FTK ;get first task on LB CTSGO8: ;loop to activate tasks JUMPE TK,CTSGO9 ;exit if no more TKB's $CALL ACTTSK ;activate this one JUMPF CTSGO5 ;die if we cannot LOAD TK,,T.PFW ;get next one JRST CTSGO8 ;and try again CTSGO9: ;here when all tasks active MOVE TK,T4 ;restore our task MOVEI S1,%RSUOK ;code for unit is OK LOAD P1,,T.OBA ;address of object block SUBI P1,SUP.TY ;dummy up for RSETUP $CALL RSETUP ;send response to setup $SIGNL TW.SND,LINE ;let everyone know that signon has happened MOVE TK,T4 ;restore our task LOAD S1,,L.STS ;get line status TXO S1,L.SND ;flag that we are signed on STORE S1,,L.STS ;restore it JRST CTEXT ;and exit task CTSXBT: ;here to swap TK and T1 T.BIT fields $SAVE S1 ;preserve register we will use LOAD S1,,T.BIT ;get TK's bit field EXCH S1,T$BIT(T1) ;swap them $RET CTSGO5: $STOP CAS,<Cannot accomplish SIGNON> CTSGO4: $WTOJ <Signon error>,<Error "^T/@GLXERR(S1)/" opening signon file>,@T%OBA JRST CTSFA0 ; Here when line goes away CTSFAI: $WTOJ <Line went away>,,@T%OBA CTSFA0: MOVEI S1,%RSUDE ;code for device doesn't exist LOAD P1,,T.OBA ;get address of object block SUBI P1,SUP.TY ;dummy up for RSETUP $CALL RSETUP ;send response to setup $CALL SHTALL ;kill all the tasks $DSCHD DELETE ;Deschedule task forever SUBTTL Tasks -- - CTLNGN, line gone while active processing CTLNGN: ;here if D60PRD activates control ; task and signals line has gone away LOAD TK,,L.FTK ;get first task pointer (ctl task) LOAD TK,,T.PFW ;get first real task JUMPE TK,QUIDON ;if none, we don't have to wait CTLNG0: ;loop setting ABORT and LGA for tasks MOVE S1,S+T%ACS ;get task's S TXO S1,ABORT+LGA ;set abort and line gone MOVEM S1,S+T%ACS ;and put status back $CALL WAKTSK ;activate and wake it LOAD TK,,T.PFW ;point to next task JUMPN TK,CTLNG0 ;and process it too, if there QUIESC: ;here to wait for all tasks to ; exit gracefully (i.e. DSCHD for ; neither time nor bits) LOAD TK,,L.FTK ;point to control task (us) LOAD TK,,T.PFW ;get first real task JUMPE TK,QUIDON ;if no tasks, we are done QUIES0: ;loop to check tasks LOAD S2,,T.ATE ;point to active task list JUMPE S2,QUIKIL ;illegal to be zero, kill task LOAD S1,,A.WKT ;get wakeup time JUMPN S1,QUIES1 ;if there, can't kill him yet LOAD S1,,T.WKB ;get his wakeup bits JUMPN S1,QUIES1 ;if any, also cannot wake him yet QUIKIL: ;here to kill task $CALL RELTKB ;release task block JRST QUIESC ;go try for more QUIES1: ;here if we cannot kill this LOAD TK,,T.PFW ;get next task JUMPN TK,QUIES0 ;if we got one, try to kill it LOAD TK,,L.FTK ;point to control task (us) $DSCHD 0,^D6 ;wait a couple of seconds JRST QUIESC ;and try again QUIDON: ;here when all tasks have exited LOAD TK,,L.FTK ;point to our task block again JRST CTSFAI ;and finally shut down SUBTTL Tasks -- TKCDR, 2780/3780 card reader COMMENT & This task is given control by the setup routine; it first checks if the station is up and signed on; if not, it activates the control task, signals signon request, and waits for signon done. Once the station is signed on, it waits on TW.QRQ (a request arrived from QUASAR) and TW.CNI (there is data in the CNI queue to be sent to IBM as console input messages). On console input, it gets output permission (sleeping and retrying if necessary), initializes the data buffer and then loops gathering messages from the queue, sending each to all watchers and then outputing them to IBM. When it reaches the queue, it forces an output end of file to IBM and exits. On receipt of a QUASAR request it gets output permission and then calls the DOJOB subroutine to copy the files of the request to IBM. & TKCDR: ;start of 2780/3780 card reader task MOVE T1,TK ;save TKB pointer LOAD S1,,L.LNI ;get port,,line HRLZI S2,.TLPT ;and lpt,,0 $CALL FNDTSK ;find its TKB EXCH TK,T1 ;restore our task pointer STORE T1,,T.OTK ;save address for future reference LOAD S1,,L.STS ;get line status TXC S1,L.UP!L.SND ;complement all but up and signed on TXCN S1,L.UP!L.SND ;put em back and skip if not both on JRST CDMAIN ;go immediately to idle wait LOAD T1,,L.FTK ;get address of control task EXCH T1,TK ;save our task pointer $CALL ACTTSK ;activate control task $SIGNL <TW.SNR>,TASK ;tell him to do signon MOVE TK,T1 ;get our pointer back MOVEI S1,[ASCIZ /Waiting for SIGNON/];display our current state STORE S1,,T.DST ; in status message $DSCHD TW.SND,0 ;wait only for signon done ZERO ,T.WCN ;clear wakeup conditions CDMAIN: ;main idle loop LOAD S1,,L.STS ;get line status TXNN S1,L.SFS ;if signoff sent TXNE S,LGA ; or line gone away JRST CDERR ;exit gracefully LOAD S1,,T.WCN ;get wakeup conditions JUMPN S1,CDEXT ;if any still left, go handle them MOVEI S1,[ASCIZ /Idle/] ;display idle STORE S1,,T.DST ; state $DSCHD TW.QRQ!TW.CNI,1 ;wait for job or console input or both CDEXT: LOAD S1,,L.STS ;get line status TXNN S1,L.SFS ;if signoff sent TXNE S,LGA ; or line gone away JRST CDERR ;exit gracefully LOAD S1,,T.WCN ;get condition(s) which woke us JUMPE S1,CDTURN ;if timeout, go try to turn line around TXZE S1,TW.CNI ;if console input (which thus has priority) JRST CDCNI ; go do it TXZE S1,TW.QRQ ;if a job JRST CDJOB ; go do that $WTOJ <Logic error>,<Illegal wakeup condition ^O/S1/>,@T%OBA ANDCAM S1,T%WCN ;clear offending bits JRST CDMAIN ;and go to main loop CDTURN: MOVE T1,TK ; Save task pointer LOAD TK,,T.OTK ; Get line printer task pointer HRRZ S1,P1+T%ACS ; Get device handle D60 D60STS ; Get LPT status JUMPF CDTRN1 ; If failed .. go check on CDR TXNN S2,SDIRN!SDIPR!SDIPW ; Check for input coming JRST CDTRN1 ; If none .. back to CDR service $CALL ACTTSK ; Activate it $SIGNL TW.IAV ; Tell him he has input available MOVE TK,T1 ; Restore our task pointer MOVEI S1,[ASCIZ /Input EOF wait/] STORE S1,,T.DST ; State for status messages $DSCHD TW.ICP,0 ; Wait for input complete LOAD S1,,T.WCN ; Get wakeup conditions TXZ S1,TW.ICP ; Clear input complete bit STORE S1,,T.WCN ; and put them back JRST CDMAIN ; Go back to check on CDR CDTRN1: MOVE TK,T1 ; Reset to CDR task pointer JRST CDMAIN ; and go check on card reader ; This is where tasks jump when settling down to be killed off. The ; control task waits for all others to be descheduled forever. CDERR: $DSCHD 0,0 ; Sleep till control task kills us JRST CDERR ; Just in case SUBTTL Tasks -- - CDCNI, send console input to IBM COMMENT & This routine waits trying to get output permission until it succeeds, then initializes the transmit buffer. It sends a message to all watchers indicating that console input is going to be sent, then loops getting messages, sending them to watchers and putting them into the buffer (outputting when necessary). If an error occurs it goes to CDCNER to send message to watchers and to flag line down. When there are no more messages it transmits and end of file to IBM and a "sent" message to watchers, then goes back to CDEXT to see if card reader task has to handle more conditions before idling. & CDCNI: ;here to send console input to IBM MOVE T1,S1 ;save updated wakeup conditions ; (so we know not to try more console input) MOVEI S1,[ASCIZ /Waiting to send console input/];get state STORE S1,,T.DST ;and make it visible $CALL GETLNO ;get output permission JUMPF CDCNIZ ;if we cannot do output, try input STORE T1,,T.WCN ;store updated wakeup conditions MOVEI S1,[ASCIZ /Sending console input/];our new state STORE S1,,T.DST ; in the usual place $CALL TBFINI ;initialize the buffer page pointers TXZ S,CHECK ;do not check records now $WATCH <Console input> ;tell watchers what follows is input CDCNI1: ;loop to get card images to send $CALL GETCNI ;get next message JUMPF CDCNI2 ;if none, close out file $CALL PUTIBM ;put into buffer (and output if necessary) JUMPT CDCNI1 ;if no error, go back for more IFN FTDEBUG,< CAIN S1,D6CGO JRST CDCNIZ CAIE S1,D6CTF ;is the error line went away? $STOP UIE,<Unexpected error ^D/S1/> >;end IFN FTDEBUG CDCNER: $WATCH <Console input aborted by error>;tell watchers JRST CDERR ;and die CDCNI2: ;here at end of messages TXO S,OUTEOF ;dummy up EOF for PUTIBM SETZ T2, ;and indicate no data $CALL PUTIBM ;force buffer out and send EOF JUMPF CDCNER ;if error, report it $WATCH <Console input sent> ;tell watchers we are done JRST CDEXT ;and go see if we have more to do CDCNIZ: $SIGNL TW.CNI JRST CDTURN SUBTTL Tasks -- - CDJOB, send job to IBM COMMENT & This routine simply waits for permission and calls DOJOB (which it shares with the HASP card reader task) to process the request from QUASAR. & CDJOB: ;here to send a job to IBM MOVE T1,S1 ;copy updated wake condition bits MOVEI S1,[ASCIZ /Grant wait/];describe new state STORE S1,,T.DST ; and make it visible $CALL GETLNO ;get output permission JUMPF CDJOB0 ;if cannot get permission, try input STORE T1,,T.WCN ;save updated wake condition bits $CALL DOJOB ;use subroutine to copy all the files ; of request, do checkpoints, etc. TXNE S,LGA ;see if line has gone away JRST CDERR ;die on line gone JUMPT CDEXT ;if job succeeded, continue LOAD S1,,T.GTE ;get error code for get CAIE S1,D6CGO ;could we get output? JRST CDEXT ;no, something else, go see if we have more work CDJOB0: $SIGNL TW.QRQ ;wake ourselves up JRST CDTURN ;and try to get input SUBTTL Tasks -- - DOJOB, process "batch" job ; Routine - DOJOB ; ; Function - Loops through files of request, copying them to IBM if ; necessary (also making log file entries and at end writing it). ; ; Parameters - TK, LB and J must be set up, P1 must have device handle ; ; Returns - False when line goes away. ; ; Note - Preserves all AC's COMMENT & This subroutine initializes the task-block data structure for the job, writes log file entries and messages to operator to show we are starting job, then loops over each file in request, skipping it if we were requeued and had completed it before, and sending it (via subroutine FILE) to IBM else. When it is finished, it writes the log file out to disk, and possibly queues it to a line printer queue. & DOJOB: ;here to fulfill a request from QUASAR $CALL INIJOB ;clean up job-related task block entries TXZ S,ABORT!INPEOF!OUTEOF!FLSH!GOODBY!RQB!NODEL;clear possible abort from last time TXO S,ACTIVE!CHECK ;indicate we are active and checking records MOVEI S1,[ASCIZ /Sending job/];our current state STORE S1,,T.DST ; is now visible $CALL CHKPNT ;make sure QUASAR knows it $TEXT (LOGCHR,<^M^J^I/IBDAT/IBMSPL version ^V/[%%.IBM]/ ^T/CNF/>);put first line ; in log file $TEXT (LOGCHR,<^I/IBDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on IBM CDR^D/T%UNI,T.UNI/ on P^O/L%PRT,L.PRT/L^O/L%LIN,L.LIN/>);and next SKIPN T2,.EQCHK+CKFLG(J) ;was this job requeued? JRST DOJOB0 ;no, just process it MOVEI T1,[ASCIZ /system failure/];assume it was because of system failure TXNE T2,CKFREQ ;was it really operator requeue? MOVEI T1,[ASCIZ /requeue by operator/];yes, use proper string $TEXT (LOGCHR,<^I/IBMSG/Job being restarted after ^T/0(T1)/>);write it into log DOJOB0: ;here after writing initial log file lines $CALL I%NOW ;get time STORE S1,,T.TMS ;save as time we started job LOAD S2,,T.TMR ;see when we received it SUB S1,S2 ;get time difference CAILE S1,INSIGN ;if it is insignificant, skip message $TEXT (LOGCHR,<^I/IBMSG/Job received at ^C/S2/ and delayed ^C/S1/>);put ; entry into log file $WTOJ <Begin>,<^R/.EQJBB(J)/>,@T%OBA $CALL TBFINI ;initialize the buffer LOAD P2,.EQLEN(J),EQ.LOH ;get length of header of request ADD P2,J ;add to start to get beginning ;of file blocks (P2 is pointer ;to next file block within DOJOB) LOAD S1,.FPLEN(P2),FP.LEN ;get length of parameters MOVE P3,P2 ;copy base address ADD P3,S1 ;point to FDB LOAD T2,.EQSPC(J),EQ.NUM ;get number of files in request STORE T2,,T.NFL ;save as number of files SKIPN .EQCHK+CKFLG(J) ;is this a restarted job? JRST DOJOB4 ;no, just start at beginning LOAD T1,.EQCHK+CKFIL(J) ;yes, get how many files already done STORE T1,,T.NFP ;save as number of files processed DOJOB1: ;loop to skip already send files SOJL T1,DOJOB2 ;jump if we have skipped enough $CALL NXTFIL ;advance to next file block JUMPF DOJOB7 ;finish up processing if we skipped them all JRST DOJOB1 ;go try to skip another DOJOB2: ;here after skipping already done files LOAD T1,.EQCHK+CKTRS(J) ;get checkpointed count of ;total number of records sent STORE T1,,T.NRS ;save as our num records sent DOJOB4: ;here to loop sending files $CALL FILE ;do a file JUMPF .POPJ ;return failure to caller if CGO error TXNE S,RQB ;did job get requeued while we were doing it? JRST DOJEND ;yes, go end job INCR ,T.NFP ;increment number of files processed $CALL CHKPNT ;and make sure the world knows it ; by sending checkpoint to QUASAR $CALL NXTFIL ;advance to next file JUMPT DOJOB4 ;if there was one, go process it DOJOB7: ;here when all files have been processed SKPN P2,,T.LFS ;get address of log file spec (set ; by NXTFIL) JRST DOJEND ;if none, end job TXZ S,ABORT ;clear abort flag FTLOG < MOVEI S1,LOGGET ;address of get routine STORE S1,,T.GTR ;save if for FILED routine $CALL FILED ;write log file to disk $CALL QUELPT ;queue it to DEC LPT queue >;end FTLOG DOJEND: ;here when all done with job TXO S,GOODBY ;let everyone know they cannot ; abort anything any more TXZ S,QSRREQ!ACTIVE ;indicate that we no longer have a request MOVEI S1,[ASCIZ /Finished job/] STORE S1,,T.DST ;save state $CALL CHKPNT ;and make sure world knows $CALL QRLSE ;send release/requeue message $RETT ;return to caller SUBTTL Tasks -- - FILE, copy a disk file to IBM ; Routine - FILE ; ; Function - Writes message into log file, opens disk input file, copies ; from disk to IBM till either EOF or error, writes appropriate ; message into log file, and exits ; ; Parameters - TK, LB and J must be set up, P2 must point to file block ; ; Returns - Propogates true or false from COPY ; ; Note - Destroys S1 COMMENT & This routine exits if the ABORT flag has been set; if not it opens the input file, writes a message to the log file, sets up the put and get routine addresses for the COPY subroutine, and then calls it to copy from source to destination. If there is an error upon return from COPY, it notes that in the log file; otherwise it notes that it finished the file and exits. & FILE: ;copy a file from DSK to IBM TXNE S,ABORT ;if abort flag set, exit immediately $RETT ;pretend we copied file $TEXT (LOGCHR,<^I/IBMSG/Starting file ^F/0(P3)/>);put line into ; log file MOVEI S1,GETDSK ;get address of routine to read from disk STORE S1,,T.GTR ;save it where COPY will find it MOVEI S1,PUTIBM ;likewise with STORE S1,,T.PTR ; output routine address MOVEI S1,IBMLFR ;get address of checker external routine STORE S1,,T.CKR ;save it for dispatch TXZ S,CHKLOG!CHKSWT ;don't do input checking ZERO ,T.GTE ;zero get error code ZERO ,T.PTE ; as well as put error code ZERO ,T.TBC ;clear transfered byte count $CALL INPOPN ;open input file and set DSKOPN flag JUMPF FILE2 ;if open failed, set abort $CALL COPY ;copy the file TXNE S,LGA ;has line gone away? JRST FILE2A ;yes, cause job to be requeued JUMPT FILE1 ;if success, exit normally FILE2: ;here on error during file transfer LOAD S1,,T.PTE ;see if put error code JUMPE S1,FILE2B ;jump if no error CAIN S1,D6CGO ;if can't get output, do special processing JRST FILCGO ;handle it FILE2B: ;here to print error message $TEXT (LOGCHR,<^I/IBMSG/Error "^T/ERRIBM(S1)/" writing file ^F/0(P3)/>) ;note, if input error occurred, GETDSK will have ; already reported it FILE2A: TXO S,RQB!ABORT ;requeue request and set abort to ; prevent I/O to IBM FILE1: ;here when finished with file $TEXT (LOGCHR,<^I/IBMSG/Finished file ^F/0(P3)/>) TXZ S,DSKOPN ;clear flag $RETT ;passs COPY return code on FILCGO: ;here if direction is wrong $TEXT (LOGCHR,<^I/IBMSG/File transfer aborted because of input ^F/0(P3)/>) TXZ S,DSKOPN ;indicate file is closed $RETF ;return false SUBTTL Tasks -- - NXTFIL, advance to next file in job ; Routine - NXTFIL ; ; Function - Advances P2 and P3 to the next file-spec in the QUASAR request ; ; Parameters - P2 must point to current parameter area of FDB within request. ; ; Returns - P2 on true points to next parameter area, P3 to next FDB ; true if another file to process, false otherwise ; ; Note - destroys S1, decrements file count (T.FLN), sets T.LFS if ; log-file spec encountered. COMMENT & This routine advances the pointer to the current file (kept in P2 and P3) to point to the next file-spec in the request sent by QUASAR; if the next specification is for a log-file, it saves its address (at T.LFS) and goes to the next one. If there are no more, it returns false. & NXTFIL: ;subroutine to advance P2 to next file spec SOSG T%NFL ;decrement count of files $RETF ;if no more, return false LOAD S1,.FPLEN(P2),FP.LEN ;get length of the file parameter area ADD P2,S1 ;advance to next FDB LOAD S1,.FDLEN(P2),FD.LEN ;get length of FDB ADD P2,S1 ;advance to next parameter area LOAD S1,.FPLEN(P2),FP.LEN ;get length of parameter area MOVE P3,P2 ;copy address of parameter area ADD P3,S1 ;set up P3 to point to FDB ; LOAD S1,.FPINF(P2),FP.FLG ;get log-file flag LOAD S1,,T.NFL ;?? get number of files left SUBI S1,1 ;?? if just 1, we have real file JUMPN S1,.RETT ;return if not log file STORE P2,,T.LFS ;save log-file address for later JRST NXTFIL ;and go get next real spec (if any) SUBTTL Tasks -- TKLPT, 2780/3780 line printer ; Routine - TKLPT ; ; Function - To control the 2780/3780 line printer input stream. ; ; This task wakes only on TW.IAV (input available) which is set by the ; main task (TKCDR) whenever it succeeds in turning the line around. It ; then opens a temporary holding file for the data; if one already exists ; (because of a system crash for example) it retrieves its disposition ; information and disposes of iT. Once the holding file is ready, it ; sets up the parameters for the subroutine LPTJOB and calls it to do ; the actual copying of line printer data from IBM to the disk. ; ; After the file is finished, the task gets its disposition information ; and queues it to the LPT queue or renames it into the user's directory. ; The task then disposes of the log file in the same way; this log file ; contains not only such job-related information as times started and ; finished, number of records read, etc. but also all console traffic to ; and from the IBM host while the file was being transferred (so that the ; user will have a record of what, if anything, was done to his job [e.g. ; restarting, making more copies, cancelling]). ; ; When the task is all finished with the file it signals TW.ICP to the ; card reader task and deactivates itself. TKLPT: MOVE T1,TK ; Save task block address LOAD S1,,L.LNI ; Get line information HRLZI S2,.TCDR ; Get card-type,,0 as dev,,unit $CALL FNDTSK ; Get card reader task address LOAD S1,,T.OBA ; Address of object block EXCH T1,TK ; Get our task block back STORE S1,,T.OBA ; Save address of object block STORE T1,,T.OTK ; and save other task address for later MOVEI S1,[ASCIZ /Idle/] ; Get state STORE S1,,T.DST ; and save it for status ; Here to wait for input ready signal from card reader task LPMAIN: $DSCHD TW.IAV,0 ; Wait only on TW.IAV LOAD S1,,L.STS ; Get line status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Exit gracefully TXO S,CHKLOG ; Checking for console output file $CALL LPTJOB ; Call common routine to process file TXNE S,CHKLOG ; Was it a log file? JRST LPCONO ; Yes, matched console pattern $CALL DISPOS ; No, take care of disposition TXZ S,ACTIVE!ABORT!CHECK ; Logging no longer allowed FTLOG < MOVEI S1,LOGGET ;address of get routine STORE S1,,T.GTR ;save it $CALL FILED ;write it to disk $CALL DISPOS ;dispose of it too >;end FTLOG ; Here when done with LPT file LPDONE: MOVEI S1,[ASCIZ /Idle/] ; Get state STORE S1,,T.DST ; and save it for status LOAD T1,,T.OTK ; Get card reader task EXCH T1,TK ; Switch to its task block $SIGNL TW.ICP ; Set input complete EXCH TK,T1 ; Switch back to ours TXNE S,LGA ; See if line has gone away JRST CDERR ; Yes, just wait for coup de grace $CALL DEATSK ; No, deactivate task LOAD S1,,L.STS ; Get line status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Exit gracefully JRST LPMAIN ; When re-activated, go back to loop ; Here when line printer file was really console output LPCONO: $CALL ROPNHL ; Open hold file for intput JUMPF LPCONE ; Complain if cannot MOVEI S1,GETDSK ; Address of get routine STORE S1,,T.GTR ; to vector MOVEI S1,PUTCNO ; Address of put routine STORE S1,,T.PTR ; to vector too MOVEI S1,STRPBL ; Address of rtn to strip blank lines STORE S1,,T.CKR ; to check routine vector TXZ S,ACTIVE!ABORT ; Logging no longer allowed TXO S,NOCTLS!CHECK ; Make sure we convert ctl-s $CALL TBFINI ; Initialize buffer pointers $CALL COPY ; and copy entire file to CNO queue $CALL ROPNHL ; Re-open hold file JUMPF LPCONE ; If cannot, complain $CALL F%DREL ; and release it JUMPT LPDONE ; Go finish up if no error ; Here if error handling hold file of console output LPCONE: $WTOJ <Spool file error>,<Error "^T/@GLXERR(S1)/" opening or closing hold file of console output>,@T%OBA JRST LPDONE ; Ignore rest of it ; Local subroutine to re-open hold file ROPNHL: MOVEI S1,FDBARE ; Point to FDB build area MOVEI S2,NMNTAB ; and table of names $CALL BLDFDB ; Get filename of hold file MOVEI S1,2 ; Size of open block MOVEI S2,FIB ; and address of open block $CALL F%IOPN ; Open hold file for input $RET ; Propagate true or false FIB: EXP FDBARE ; File open block for input EXP 7 ; Byte size ; Subroutine to strip blanks out of 2780/3780 console output STRPBL: HRLI T1,440700 ; Make byte pointer STRPB0: ILDB S1,T1 ; Get next character CAILE S1,40 ; If control or blank, continue $RET ; else return (i.e. leave line as is) SOJG T2,STRPB0 ; Continue until all accounted for SETZ T2, ; Line blank or cntl, clear count $RET ; Return SUBTTL Tasks -- - LPTJOB, process printer job ; Routine - LPTJOB ; ; Function - Opens hold file, initializes buffers and counters, puts ; messages into log file (FTLOG), copies the input file from IBM ; to disk until error or EOF occurs. ; ; Parameters - S must have CHKLOG on if log file checking desired. ; ; Returns - Always true ; CHKLOG turned off if no record matched log file pattern. ; ; Note - Destroys S1, S2, T1, T2 LPTJOB: TXO S,ACTIVE ; Set job to active state MOVEI T2,.OTLPT ; Type of queue to initialize $CALL OPNHLD ; Open holding file, dispose of old one $CALL TBFINI ; Initialize bufffer pointers MOVEI S1,GETIBM ; Address of routine to get from IBM STORE S1,,T.GTR ; Store as "get" routine MOVEI S1,IBMLFR ; Point to checking routine STORE S1,,T.CKR ; And save its address MOVEI S1,PUTDSK ; Address of routine to write to disk STORE S1,,T.PTR ; Store as "put" routine ZERO ,T.ICT ; Clear input count ZERO ,T.OCT ; and output count ZERO ,T.TBC ; Clear cumulative byte count MOVEI S1,[ASCIZ /Receiving job/] STORE S1,,T.DST ; Save status for display messages TXO S,CHECK!CHKSWT!DOCHKP ; Checkpointing and switch checking $WTOJ <Receiving output>,<Starting output to file ^F/0(P3)/>,@T%OBA $CALL I%NOW ; Get starting time STORE S1,,T.TMS ; Save it in task starting time HRREI S1,-CHKCNT ; Get record count between checkpoints STORE S1,,T.OCK ; and save it MOVEI S1,CHKDSK ; Address of checkpoint routine STORE S1,,T.CKP ; Store in vector $TEXT (LOGCHR,<^I/IBLPT/Reading file into ^F/0(P3)/>) $CALL COPY ; Copy the file SKIPT ; If no error .. skip error message $TEXT (LOGCHR,<^I/IBLPT/Error ^T/ERRIBM(S1)/ writing file ^F/0(P3)/>) $TEXT (LOGCHR,<^I/IBLPT/Finished file ^F/0(P3)/>) $WTOJ <Finished output>,<Finished output to file ^F/0(P3)/>,@T%OBA $RETT ; Return SUBTTL Tasks -- TKHCDR, HASP card reader ; Task - TKHCDR ; ; Function - This task is given control by the setup routine; it first ; checks if the station is up and signed on; if not, it activates ; the control task, signals signon request, and waits for signon done. ; ; Once the station is signed on, it waits on TW.QRQ ; (a request arrived from QUASAR). ; ; On receipt of a QUASAR request it calls the DOJOB subroutine ; to copy the files of the request to IBM. TKHCDR: LOAD S1,,L.STS ; Get line status TXC S1,L.UP!L.SND ; Complement all but up and signed on TXCN S1,L.UP!L.SND ; Put em back and skip if not both on JRST TKHCR0 ; Go immediately to idle wait LOAD T1,,L.FTK ; Get address of control task EXCH T1,TK ; Save our task pointer $CALL ACTTSK ; Activate control task $SIGNL <TW.SNR>,TASK ; Tell him to do signon MOVE TK,T1 ; Get our pointer back MOVEI S1,[ASCIZ /Waiting for SIGNON/] STORE S1,,T.DST ; State for status message $DSCHD TW.SND,0 ; Wait only for signon done LOAD S1,,T.DEV ; Get device code LOAD S2,,L.LNI ; and port,,line $CALL DEVOPN ; Open it because signon needed it TXNE S,LGA ; See if line has gone away JRST CDERR ; If line down, exit MOVE P1,S1 ; Copy dev handle into proper register LOAD S1,,T.WCN ; Get wakeup conditions TXNE S1,TW.QRQ ; Has QUASAR been fast? JRST TKHCR1 ; Yes, don't do delay TKHCR0: MOVEI S1,[ASCIZ /Idle/] ; Display idle STORE S1,,T.DST ; State for message $DSCHD TW.QRQ,0 ; Wait for job LOAD S1,,L.STS ; Get status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Wait for control task to kill us TKHCR1: MOVEI S1,[asciz /Sending job/] STORE S1,,T.DST ; State for status message $CALL DOJOB ; Get next job and do it TXNE S,LGA ; See if line went away JRST CDERR ; Wait to be killed if line went away JRST TKHCR0 ; Go back for more SUBTTL Tasks -- TKHCDP, HASP card punch SUBTTL Tasks -- TKHLPT, HASP line printer ; Task - TKHCDP, TKHLPT ; ; Function - To service HASP line-printer and card-punch streams. TKHCDP: TKHLPT: MOVE T1,TK ; Save task block address LOAD S1,,L.LNI ; Get line information HRLZI S2,.TCDR ; Get card-type,,0 as dev,,unit $CALL FNDTSK ; Get card reader task address LOAD S1,,T.OBA ; Address of object block EXCH T1,TK ; Get our task block back STORE S1,,T.OBA ; Save address of object block LPHMAI: MOVEI S1,[ASCIZ /Idle/] ; Get state STORE S1,,T.DST ; and save it for status $DSCHD TW.IOD ; Wait for activity LOAD S1,,L.STS ; Get status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Exit and wait to die HRRZ S1,P1 ; Get device handle D60 D60STS ; Get device status JUMPF LPHMAI ; If failed .. wait for I/O TXNN S2,SDIRN!SDIPW!SDIPR ; Check for input request JRST LPHMAI ; If none .. go back to sleep LPHJOB: $CALL LPTJOB ; Call common routine to process file $CALL DISPOS ; Take care of disposition TXZ S,ACTIVE!ABORT!CHECK ; Logging no longer allowed FTLOG < ; Set up log file parameters from recognized stuff MOVEI S1,LOGGET ; Address of get routine STORE S1,,T.GTR ; Save it $CALL FILED ; Write it to disk $CALL DISPOS ; Dispose of it too >;end FTLOG TXNE S,LGA ; Has line gone away? JRST CDERR ; Yes, die gracefully JRST LPHMAI ; No, go back and look for more work SUBTTL Tasks -- TKHCNI, HASP console input to IBM ; Task - TKHCNI ; ; Function - To take entries from the console input queue and send them ; down the HASP console input pipe. TKHCNI: LOAD S1,,L.STS ; Get the line status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Exit gracefully $DSCHD TW.CNI,0 ; Wait for some LOAD S1,,L.CNI ; Get handle for CNI queue $CALL L%FIRST ; Point to first entry ; Loop to process console messages to IBM TKHCI0: JUMPF TKHCNI ; If no more, go wait for some MOVE T2,S2 ; Save msg address for any error MOVN T1,0(S2) ; Get length (as negative for D60SOU) HRROI S2,1(S2) ; Point to start of data MOVE S1,P1 ; Get device handle D60 D60SOU ; Output data QQ==<<ERRIBM-IBMNAM>-660000>&777777 ; Modulo 18-bit displacement for error ; table, note this won't work in ; non-zero sections. TXNE S,LGA ; Has line gone away? JRST CDERR ; Yes, do null wait SKIPT ; If success, we don't have to complain $WTOJ <Console send error>,<Error was "/@QQ(S1)/^M^JMessage was--^T/1(T2)/^A>,@T%OBA LOAD S1,,L.CNI ; Get list handle $CALL L%DENT ; Delete this entry $CALL L%NEXT ; and on to next JRST TKHCI0 ; Loop over rest SUBTTL Tasks -- TKHCNO, HASP console output from IBM ; Task - TKHCNO ; ; Function - To read console output coming from the IBM host and queue ; it to the SND task to be distributed. TKHCNO: MOVE T1,TK ; Save task block address LOAD S1,,L.LNI ; Get line information HRLZI S2,.TCDR ; Get card-type,,0 as dev,,unit $CALL FNDTSK ; Get card reader task address LOAD S1,,T.OBA ; Address of object block EXCH T1,TK ; Get our task block back STORE S1,,T.OBA ; Save address of object block LOAD T4,,T.RIA ; Point to record buffer HRLI T4,440700 ; and convert to bypte pointer SETZ P2, ; Initialize "in use" count TKHCN0: $DSCHD TW.IOD ; Wait for input available LOAD S1,,L.STS ; Get status TXNN S1,L.SFS ; If signoff sent TXNE S,LGA ; or line gone away JRST CDERR ; Wait to be kill off HRRZ S1,P1 ; Get device handle D60 D60STS ; Get device status JUMPF TKHCN0 ; Failed .. go back to sleep TXNN S2,SDIPR!SDIRN!SDIPW ; Check for device input ready JRST TKHCN0 ; False alarm .. back to sleep TKHCN1: MOVE S1,P1 ; Get handle MOVE S2,T4 ; Point where in record data should go HRROI T1,-<<MXLPBF-1>*5> ; Get maximum length to read ADD T1,P2 ; Subtract how much is in use MOVM P3,T1 ; Save count we asked for D60 D60SIN ; Get a record TXNE S,LGA ; Has line gone away? JRST CDERR ; Yes, go wait to be killed off JUMPF TKHCN2 ; If we get error TKHCN4: MOVE T2,P3 ; Get bytes we asked for MOVM T3,T1 ; and positive bytes left to do SUB T2,T3 ; Calculate what we got JUMPE T2,TKHCN3 ; If no bytes, wait a while ADDB P2,T2 ; Add for total byte count TKHCN5: LOAD T4,,T.RIA ; Point to record buffer HRLI T4,440700 ; Make it into byte pointer JUMPE P2,TKHCN0 ; If no more, go wait for some TKHCN6: ILDB S1,T4 ; Get next character CAIN S1,12 ; Is it linefeed (i.e. end of message)? JRST TKHCN7 ; Yes, go queue this message SOJG T2,TKHCN6 ; No, decrement count until end JRST TKHCN0 ; and go to get more TKHCN7: MOVE S2,P2 ; Get amount of data in buffer SOS T2 ; Account of linefeed we didn't count SUBB S2,T2 ; Compute chars in this message TXO S,OUTEOF ; Dummy up EOF for PUTCNO LOAD T1,,T.RIA ; Point to record $CALL PUTCNO ; Add it to CNO queue MOVE T3,T4 ; Copy byte pointer LOAD T4,,T.RIA ; Point to record HRLI T4,440700 ; in byte pointer form SUBB P2,T2 ; Reduce count by bytes in this message JUMPE P2,TKHCN5 ; If all, no need to shift rest down TKHCN8: ILDB S1,T3 ; Get next character IDPB S1,T4 ; Move it towards beginning of buffer SOJG T2,TKHCN8 ; Loop till all characters copied MOVE T2,P2 ; Get count of chars remaining JRST TKHCN5 ; See if we can copy another TKHCN2: CAIE S1,D6NBR ; Non-blocking or CAIN S1,D6DOL ; Off-line error? JRST TKHCN4 ; Treat as OK for now. TRZ S1,660000 ; Get error code by itself $WTOJ <D60JSY error>,<Error "^T/@ERRIBM(S1)/" while reading console output>,@T%OBA TKHCN3: $DSCHD 0,^D10 ; Wait a few seconds JRST TKHCN0 ; and try again SUBTTL Subroutines -- Initialization and Main Loop subroutines SUBTTL Subroutines -- - OPDINI, Get operating system information ; Routine - OPDINI ; ; Function - Gets central site node number, monitor name and (if 20) the ; directory number for PS:<SPOOL>. ; ; Parameters - None ; ; Returns - True always ; CNTSTR is set to node number ; CNF is set to monitor name ; SPLDIR is set to PS:<SPOOL> directory number if TOPS20 ; ; Note - Destroys T1-T3 COMMENT & This routine is operating system dependent. For TOPS-10 it gets the name of the monitor, and then the station number of the central site. For TOPS-20 it zeros the station number, gets the monitor name, gets the directory number for PS:<SPOOL> and finally issues MSTR to allow structure access without prior mount. & OPDINI: ;operating system dependent ; initialization TOPS10 < CNFDSP==(%CNFG0)