Trailing-Edge
-
PDP-10 Archives
-
BB-CH18A-BM_1985
-
sna-rje/rjespl.mac
There are no other files named rjespl.mac in the archive.
; RJESPL - Emulation spooler for SNA RJE Workstations
;
ASCIZ /
COPYRIGHT (c) 1984, 1985
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 RJESPL
;
;
; Section Page
; 1. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 2. Searches and version . . . . . . . . . . . . . . . . . 3
; 3. Edit history . . . . . . . . . . . . . . . . . . . . . 4
; 4. Symbol definitions
; 4.1. AC Definitions. . . . . . . . . . . . . . . . 5
; 4.2. Feature Test Switches . . . . . . . . . . . . 6
; 4.3. Parameters. . . . . . . . . . . . . . . . . . 7
; 4.4. External symbol definitions . . . . . . . . . 7
; 4.5. Device/task type codes. . . . . . . . . . . . 8
; 4.6. Message processor status bits (in S). . . . . 8
; 4.7. Debug bits (in word 135). . . . . . . . . . . 8
; 4.8. Task status bits (in S while task is running) 8
; 4.9. Checkpoint request block offsets (from QUASAR) 8
; 5. Macro definitions
; 5.1. $DSCHD, de-schedule a task. . . . . . . . . . 9
; 5.2. $SIGNL, indicate wakeup condition . . . . . . 10
; 5.3. $WBUSY, Wait if Workstation busy. . . . . . . 11
; 5.4. SKPTSK, skip if in task context . . . . . . . 12
; 6. Database definitions
; 6.1. Random static storage . . . . . . . . . . . . 13
; 6.2. Constant static storage . . . . . . . . . . . 14
; 6.3. IB, Initialization block for GLXLIB . . . . . 14
; 6.4. HELLO, message for QUASAR at startup. . . . . 14
; 6.5. ITEXT strings . . . . . . . . . . . . . . . . 14
; 6.6. Miscellaneous cells . . . . . . . . . . . . . 14
; 6.7. Interrupt system database . . . . . . . . . . 15
; 7. Dynamic storage definitions
; 7.1. Active task list (ATL) entry "A.xxx". . . . . 16
; 7.2. Argument block offsets "B.xxx" . . . . . . . 17
; 7.3. Workstation list entry "W.xxx". . . . . . . . 18
; 7.4. Task block list entry "T.xxx" . . . . . . . . 19
; 8. Interrupt code
; 8.1. INTINI, Interrupt system initialization . . . 20
; 8.2. INTIPC, IPCF Interrupt routine. . . . . . . . 20
; 8.3. INTDEC, DECnet Interrupt routine. . . . . . . 20
; 9. Initialization code. . . . . . . . . . . . . . . . . . 21
; 10. Scheduler
; 10.1. MAIN loop . . . . . . . . . . . . . . . . . . 22
; 10.2. SCHED, Schedule a task. . . . . . . . . . . . 24
; 10.3. DESCHD, Deschedule a task . . . . . . . . . . 25
; 10.4. ACTTSK, activate a task . . . . . . . . . . . 26
; 10.5. DEATSK, Deactivate a task . . . . . . . . . . 27
; 10.6. WAKTSK, wake a task unconditionally . . . . . 28
; 10.7. SGNTSK, signal a task . . . . . . . . . . . . 29
; 10.8. SGNLIN, signal all tasks on a line. . . . . . 30
; 10.9. POLL, active device signalling. . . . . . . . 31
; 11. Scheduler IPCF handling
; 11.1. MSGCHK, message checker . . . . . . . . . . . 32
; 11.2. MSGPRC, IPCF message processor. . . . . . . . 33
; 12. Message processors
; 12.1. TEXTMS, Text message response . . . . . . . . 35
; 12.2. SETUP, Setup/shutdown message . . . . . . . . 36
; 12.3. SETALL, setup a new station . . . . . . . . . 37
; 12.4. SHTDWN, shutdown station (signoff). . . . . . 41
; 12.5. USRCN, User cancel message. . . . . . . . . . 42
; 12.6. OPRCN, Operator cancel message. . . . . . . . 43
; 12.7. OPRRQ, Operator requeue message . . . . . . . 44
; 12.8. NXTJB, Nextjob message. . . . . . . . . . . . 45
; 12.9. SHWSTS, Show status message . . . . . . . . . 46
; 12.10. RQCHK, Request checkpoint message . . . . . . 47
; 12.11. CHKPNT, CHKPNB, send checkpoint . . . . . . . 48
; 12.12. SNDCI, send console input to IBM. . . . . . . 49
; 13. Tasks
; 13.1. Description . . . . . . . . . . . . . . . . . 50
; 13.2. TKSND, console output distribution. . . . . . 51
; 13.3. TKCTL, control for SNA-Workstation. . . . . . 52
; 13.4. . CTSGON, set workstation on . . . . . . . . 53
; 13.5. . CTSGOF, do shutdown. . . . . . . . . . . . 59
; 13.6. . CTLNGN, link gone while active processing. 60
; 13.7. TKCDR, Card Reader. . . . . . . . . . . . . . 61
; 13.8. . DOJOB, process "batch" job. . . . . . . . 62
; 13.9. . FILE, copy a disk file to IBM . . . . . . 64
; 13.10. . NXTFIL, advance to next file in job . . . 67
; 13.11. TKHCDP, Card Punch. . . . . . . . . . . . . . 68
; 13.12. TKHLPT, Line Printer. . . . . . . . . . . . . 68
; 13.13. . LPTJOB, process printer job. . . . . . . . 69
; 13.14. TKHCNI, Console Input to IBM. . . . . . . . . 70
; 14. Subroutines
; 14.1. Initialization and Main Loop subroutines. . . 71
; 14.2. . OPDINI, Get operating system information . 71
; 14.3. . QUIESC, wait for tasks to settle . . . . . 72
; 14.4. IPCF message subroutines. . . . . . . . . . . 73
; 14.5. . SNDQSR, send a message to QUASAR . . . . . 73
; 14.6. . SNDBAK, IPCF reply to last sender. . . . . 74
; 14.7. . RSETUP, response to setup (to QUASAR). . . 75
; 14.8. . QRLSE, requeue/release (to QUASAR) . . . . 76
; 14.9. . INIXBA, set up single page buffer. . . . . 77
; 14.10. . INIPAG, set up job pages . . . . . . . . . 77
; 14.11. Task control subroutines. . . . . . . . . . . 78
; 14.12. . MAKWS, Create a Workstation. . . . . . . . 78
; 14.13. . BLDTSK, Create a task. . . . . . . . . . . 79
; 14.14. . INITSK, initialize a device task . . . . . 82
; 14.15. . RELTKB, release task block . . . . . . . . 83
; 14.16. . RELWS, Delete a Workstation. . . . . . . . 84
; 14.17. Search subroutines. . . . . . . . . . . . . . 85
; 14.18. . FNDWS, Find Workstation. . . . . . . . . . 85
; 14.19. . FNDTSK, Find task from node name,dev,unit. 86
; 14.20. . FNDSID, Find task from IBM stream ID . . . 87
; 14.21. . TSKCUR, Make TK value current entry. . . . 88
; 14.22. . FNDOBJ, Find task from QUASAR object block 89
; 14.23. I/O subroutines . . . . . . . . . . . . . . . 90
; 14.24. . LOGCHR, put character in log . . . . . . . 90
; 14.25. . LOGBUF, get another log buffer . . . . . . 91
; 14.26. . PUTCNI, send console input to IBM. . . . . 92
; 14.27. . PUTCNO, put a record into CNO queue. . . . 93
; 14.28. Gateway message subroutines . . . . . . . . . 94
; 14.29. . ERRMSG, process an ERROR message . . . . . 94
; 14.30. . EVTMSG, process an EVENT message . . . . . 95
; 14.31. . EVTSPC, process a special event. . . . . . 96
; 14.32. . EVTSTA, process a stream started event . . 97
; 14.33. . EVTABO, process a stream aborted event . . 98
; 14.34. . EVTEND, process a stream ended event . . . 99
; 14.35. . EVTLGN, process IBM link gone. . . . . . . 100
; 14.36. . EVTDEA, process a stream deactivated event 101
; 14.37. Task Control Subroutines. . . . . . . . . . . 102
; 14.38. . DEVCHK, Check device status. . . . . . . . 102
; 14.39. . TSKDIE, Kill off a task. . . . . . . . . . 103
; 14.40. . ABTDEV, Abort IO stream on a device. . . . 104
; 14.41. Miscellaneous subroutines . . . . . . . . . . 105
; 14.42. . TRANSX, process character translation file 105
; 14.43. . TBFINI, initialize task IO buffer. . . . . 106
; 14.44. . INIJOB, initialize a job . . . . . . . . . 107
; 14.45. . MISLP, sleep for specified time. . . . . . 108
; 15. Debugger
; 15.1. DEBUG, Output debugging messages. . . . . . . 109
; 15.2. . DBGLST Output Task List. . . . . . . . . 110
; 15.3. . DBGATL Output ATL. . . . . . . . . . . . 110
; 15.4. . DBGTRC Set DECnet message trace. . . . . 111
; 16. Literals . . . . . . . . . . . . . . . . . . . . . . . 112
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 RJESYM ; Search SNA RJE Symbols
PROLOGUE (RJESPL) ; Initialize Galaxy symbol definitions
; Version
XP RJEVER, 1 ; Major version number
XP RJEMIN, 0 ; Minor version number
XP RJEEDT, 10 ; Edit level
XP RJEWHO, 0 ; Who did last edit (0=DEC)
; Version
%%.RJE=:<VRSN. (RJE)> ; Set value of edit level/version
; Print title/version information to log during compilation
Define VOUTX ($S1,$S2,$S3,$S4)
<TITLE $S1 $S2'$S3'('$S4')
PRINTX $S1 $S2'$S3'('$S4')>
IF1,<
IFN <RJEMIN>,<VOUTX (RJESPL - RJE Emulation Spooler for DECnet/SNA Gateway,\RJEVER,\"<"@"+RJEMIN>,\RJEEDT)>
IFE <RJEMIN>,<VOUTX (RJESPL - RJE Emulation Spooler for DECnet/SNA Gateway,\RJEVER,,\RJEEDT)>
> ;End If PASS1
IF2,<PRINTX Pass 2.>
LOC 137 ; Jobver
VERWRD: EXP %%.RJE
RELOC
RJENAM: ASCIZ /RJESPL/ ; Name of program
EXP 0
SUBTTL Edit history
COMMENT &
Edit Date Who Why
1(0) 1-May-84 DRB Development of new product from IMBSPL.MAC
1(1) 23-Oct-84 DRB Call R%RNW to get next WS number
1(2) 31-Oct-84 DRB Add code to load translation table
1(3) 9-Nov-84 DRB Check why LPT task wakes before calling LPTJOB
1(4) 20-Nov-84 DRB Don't let QUIESC wake a task waiting for event
1(5) 26-Nov-84 DRB Don't use events to signal completion for
reader streams
1(6) 27-Nov-84 DRB Use $WBUSY to make sure previous request
completes before sending next request
1(7) 25-Jan-85 DRB Wait in TSKDIE before sending "deassign" to
avoid fatal race condition in RJSRV in Gateway
1(10) 8-Feb-85 DRB Report error when translation table looading
fails.
&
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)
WS=:14 ; Workstation 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 FTCLOG, 0 ; Write user log file
DEFINE FTCLOG <IFN FTCLOG>
SUBTTL Symbol definitions -- Parameters
; Parameters which may be changed at assembly time
ND PDSIZE,450 ; Size of pushdown list (from 120)
ND TKPDLN,450 ; Size of per task PDL (from 150)
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
; System dependent parameters
SYSPRM SYSNML,5,10 ; Number of word in system name
; Constant parameters
XP MSBSIZ,30 ; Size of message block
XP MXLNBT,^D40 ; Maximum bytes on a line of status info
XP MXCDBF,<^D80/4>+2 ; Maximum record buffer size for card reader
XP MXLPBF,<^D144/5>+2 ; Maximum record buffer size for printer
XP POLINT,^D10*3 ; Polling interval, in UDT units - when all is quiet
SUBTTL Symbol definitions -- External symbol definitions
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
SUBTTL Symbol definitions -- Debug bits (in word 135)
DB.TSK==1B34 ; Debug tasks
DB.TRC==1B33 ; Debug trace of DECnet messages
SUBTTL Symbol definitions -- Task status bits (in S while task is running)
LGA==1B0 ; DECnet link to gateway has gone away
ABORT==1B1 ; We should abort
CANCEL==1B2 ; We are cleaning up (we are cancelling)
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
SHUTDOWN==1B7 ; Shutdown this device
STREAM==1B8 ; A Stream is assigned for this device
RDA==1B9 ; Read error occured during file transfer
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 Macro definitions -- $DSCHD, de-schedule a task
; Macro - $DSCHD
;
; Function - Set wake conditions and return to scheduler (de-schedule).
;
; This macro generates code that sets the bits for wakup conditions and
; the wakeup delay time and calls the scheduler. If an argument is
; omitted the corresponding function is not done.
;
; Parameters -
;
; BITS Bits defining wakeup event flags
; or keywords:
; DELETE Indicates task no longer exists
; DEACTIVATE Indicates task is removed from ATL
; TIME Time delay (in 1/3 secs) for unconditional wakeup
DEFINE $DSCHD (BITS,TIME) <
%%.DS==0 ;; Flag keyword not found yet
IFIDN <BITS>,<DELETE>,< ;; If task has been deleted
SETZ TK, ;; Clear task block pointer
PJRST DESCHD ;; Jump back to MAIN context
%%.DS==-1
> ;;End if DELETE
IFIDN <BITS>,<DEACTIVATE>,< ;; If task has been deactivated
SETZB TF,CURATE ;; Clear Active Task List pointer
$CALL DESCHD ;; Call descheduler
%%.DS==-1
> ;;End if DEACTIVATE
IFE %%.DS,< ;; If normal task descheduling
MOVX TF,<BITS,,TIME> ;; Set wakeup conditions
$CALL DESCHD ;; Call descheduler
> ;;End if normal deschedule
>;End DEFINE $DSCHD
DEFINE VDSCHD (BITS,TIME) <
MOVE TF,TIME ;; Set wakeup conditions
HRLI TF,<BITS>
$CALL DESCHD ;; Call descheduler
>;END VDSCHD
SUBTTL Macro definitions -- $SIGNL, indicate wakeup condition
; Macro - $SIGNL
;
; Function - To signal either a task or all the tasks on a line of a
; schedulable event. Any task that matches it's wakeup flags
; against the event signaled to it on the next scheduler pass
; is run.
;
; Parameters -
;
; BITS Wakeup event flags
; TYPE "LINE" or "TASK", the default is "TASK"
DEFINE $SIGNL (BITS,TYPE<TASK>) <
XLIST
..TM==0
IFIDN <TYPE>,<TASK>,<
MOVEI S1,BITS
$CALL SGNTSK
..TM==1
>;END IFIDN <TYPE>,<TASK>
IFIDN <TYPE>,<LINE>,<
MOVEI S1,BITS
$CALL SGNLIN
..TM==1
>;END IFIDN <TYPE>,<LINE>
IFE ..TM,<
PRINTX ?Illegal argument "type" in $SIGNL call -- using TASK
MOVEI S1,BITS
$CALL SGNTSK
>;END IFE ..TM
PURGE ..TM
LIST
>;End DEFINE $SIGNL
SUBTTL Macro definitions -- $WBUSY, Wait if Workstation busy
; Macro - $WBUSY
;
; Function - Wait until Workstation has no outstanding requests
;
; This macro generates code that checks the BUSY bit for the
; workstation, and if it is set the task is descheduled for
; 1 second.
;
DEFINE $WBUSY (%A,%B) <
%A: MOVE S1,W$STS(WS) ; Get status bits for Workstation
TXNN S1,W.BSY ; Is request outstanding?
JRST %B ; No
$DSCHD (,1) ; Yes, wait a while
JRST %A ; And try again
%B:
>;End DEFINE $WBUSY
SUBTTL Macro definitions -- SKPTSK, skip if in task context
DEFINE SKPTSK <
SKIPN CURATE
>;End DEFINE SKPTSK
SUBTTL Database definitions -- Random static storage
LOWBEG==. ; Start of area to zero
; Scheduler cells
NOW: BLOCK 1 ; Current date/time (in UDT format)
WAKTIM: BLOCK 1 ; Time when to do next task scheduling loop
POLTIM: BLOCK 1 ; Time when to poll active devices on all ports
LSTPOL: BLOCK 1 ; last time poll happened
CURATE: BLOCK 1 ; Address of current Active Task List entry
SCHDGO: BLOCK 1 ; If non-zero, do another scheduling pass
; Handles for data structure linked lists
WSNAM: BLOCK 1 ; Handle for Workstation list
TSKNAM: BLOCK 1 ; Handle for task block list
ATLNAM: BLOCK 1 ; Handle of list of (potentially) active tasks
; Environmental information
CNF: BLOCK SYSNML ; Monitor name string
CNTSTA: BLOCK 1 ; Node number of central station
NODNAM: BLOCK 1 ; Node name of this node (in SIXBIT)
; 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
; Block in which to build FDB's
FDBARE: BLOCK FDXSIZ ; Maximum area for file name
; File open block (long form)
FOB: BLOCK FOB.SZ ; Reserve space for a long-form FOB
LOWEND==. ; End of zeroed area plus 1
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,RJENAM) ; 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,,<'RJESPL'>) ; 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,,.OTSNA) ; 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
MSNDR: Z ; last IPCF msg sender name
; Dummy Object block for SNA-Workstation
SNABLK: EXP .OTSNA ; We are an IBM SNA object
EXP 0 ; No unit number
EXP 0 ; No station
; Dummy Object block (used for some error messages)
OBJBLK: EXP 0 ; Object type
EXP 0 ; Unit number
EXP 0 ; 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, channel 0
XWD 1,INTDEC ; DECnet interrupt on level 1, channel 1
BLOCK ^D34 ; 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 -- Argument block offsets "B.xxx"
;
; Argument block offsets for R%xxx
;
; !=======================================================!
; ! Status Flags ! Station number !
; !-------------------------------------------------------!
; ! RC ! P Code ! Data Size ! Return Data Address !
; !-------------------------------------------------------!
; / /
; / Call-dependent arguments /
; / /
; !=======================================================!
DATAST B,S1 ; Data structure prefixed by "B"
; offset by register S1
$ ARG,,,1 ; Argument block header
$. FLG,^D18 ; Flags / Interrupt channel number
B.BIN==1B10 ; Don't translate data received on
; this stream
B.XLT==1B10 ; Translate (Set if LOGON DATA is
; in ASCII)
B.SPL==1B11 ; Spool files received on this stream
B.EOS==1B12 ; End of Stream
B.NTB==1B13 ; Set if user specified /NOTAB
$. NUM,^D18 ; Workstation number
$ RET,,,1 ; Return word
$. COD,^D2 ; Return code
$. PRO,^D8 ; Protocol code
$. DSZ,^D8 ; Return Data Size
$. DAT,^D18 ; Return data block address
$ GWY,,,1 ; Pointer to Gateway name
$ SID,0 ; Stream ID
$ ACC,0 ; Pointer to Access Name
$ CIN,0 ; Pointer to Console Input Data
$ OFF,0 ; OFF / ON State
$. LTC,^D18 ; Count of translation data
$. SEQ,^D18 ; Sequence Number
$ NAM,,,1 ; Pointer to Workstation name
$ CIR,0 ; Pointer to Circuit-ID
$ SIP,0 ; Pointer to Stream ID Definition
$ LTT,0 ; Pointer to translation data
$ FIL,0 ; Pointer to filespec
$ LOM,,,1 ; Pointer to LOGON MODE Table name
$. RSV,^D18 ; Reserved
$. WRK,^D18 ; Address of Work area
$ PLU,,,1 ; Pointer to PLU name
$ LOD,,,1 ; Pointer to LOGON DATA
$ SLU,,,1 ; SLU Table (unused)
$
$ SIZ,0
SUBTTL Dynamic storage definitions -- Workstation list entry "W.xxx"
; !=======================================================!
; ! Workstation Status !
; !-------------------------------------------------------!
; ! First task block ! Last task block !
; !-------------------------------------------------------!
; ! Workstation Number !
; !-------------------------------------------------------!
; ! Gateway name (SIXBIT node name) !
; !-------------------------------------------------------!
; ! Object Block Type (.OTSNA) !
; !-------------------------------------------------------!
; ! Object Unit Number !
; !-------------------------------------------------------!
; ! Station name (SIXBIT node name) !
; !-------------------------------------------------------!
; / Station name (ASCIZ) /
; / (2 words) /
; !-------------------------------------------------------!
; / Gateway name (ASCIZ) /
; / (2 words) /
; !-------------------------------------------------------!
; / Access Name /
; / (3 words) /
; !-------------------------------------------------------!
; / LOGON Data /
; / (7 words) /
; !-------------------------------------------------------!
; / LOGON Mode /
; / (2 words) /
; !-------------------------------------------------------!
; / Application /
; / (2 words) /
; !-------------------------------------------------------!
; / Circuit /
; / (2 words) /
; !-------------------------------------------------------!
; / Translation File FD /
; / (FDXSIZ words) /
; !-------------------------------------------------------!
; ! Translation Seq Num ! Translation Table Address !
; !-------------------------------------------------------!
; ! Work Area Address ! Argument Block Address !
; !-------------------------------------------------------!
; ! Console output queue ! Console input queue !
; !=======================================================!
DATAST W,WS ; Data structure prefixed by "W"
; offset by register WS
$ STS,,,1 ; Status bits
W.WON==1b0 ; Workstation is ON
W.SDR==1b1 ; Shutdown requested
W.CON==1b2 ; DECnet Link to gateway is connected
W.BSY==1b3 ; Workstation has request outstanding
W.TRC==1b4 ; Workstation DECnet Trace Flag
$ TKB,,,1 ; Task block chain head
$. FTK,^D18 ; First task in chain
$. LTK,^D18 ; Last task in chain
$ NUM ; Workstation number
$ GW6 ; Gateway name in SIXBIT
$ OBJ,,3,1 ; Object block for workstation
$. OTY ; Station object type
$. OUN ; Station unit number
$. ONO ; Station name in SIXBIT
$ NAM,,2 ; Station name in ASCIZ
$ GWY,,2 ; Gateway name in ASCIZ
$ ACC,,3 ; Access Name in ASCIZ
$ LOD,,7 ; LOGON Data in ASCIZ
$ LOM,,2 ; LOGON Mode in ASCIZ
$ PLU,,2 ; Application (PLU) in ASCIZ
$ CIR,,2 ; Circuit in ASCIZ
$ CHS,,FDXSIZ ; FD of Character Translation File
$ LTT,,,1 ; Load Translation Table data
$. LTS,^D18 ; Translation table sequence num
$. LTA,^D18 ; Address of translation table
$ PAG,,,1 ; Page of dynamic memory
$. WRK,^D18 ; Address of work area
$. ARG,^D18 ; Address of argument block
$ QUE,,,1 ; Console I/O queues for this link
$. CNO,^D18 ; Console output queue (from IBM)
$. CNI,^D18 ; Console input queue (to IBM)
$
$ SIZ,0 ; Size of Workstation
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 !
; !-------------------------------------------------------!
; ! Stream ID for this device !
; !-------------------------------------------------------!
; / /
; ! string associated with this Stream ID !
; / /
; !-------------------------------------------------------!
; ! Stream Flags !
; !-------------------------------------------------------!
; / /
; ! ASCIZ string of current file !
; / /
; !-------------------------------------------------------!
; ! $WTOR ACK code !
; !-------------------------------------------------------!
; ! Initial byte pointer for transmission buffer !
; !-------------------------------------------------------!
; ! !
; \ Addresses of log pages \
; ! !
; !-------------------------------------------------------!
; ! Count of log pages in use !
; !-------------------------------------------------------!
; ! Count of log lines !
; !-------------------------------------------------------!
; ! Input byte count !
; !-------------------------------------------------------!
; ! Input byte pointer !
; !-------------------------------------------------------!
; ! State string address ! Other task (2780/3780) !
; !-------------------------------------------------------!
; ! Time job received !
; !-------------------------------------------------------!
; ! Time job started !
; !-------------------------------------------------------!
; ! Time file started !
; !-------------------------------------------------------!
; ! Time file done !
; !-------------------------------------------------------!
; ! Number of files in request !
; !-------------------------------------------------------!
; ! Number of files processed !
; !-------------------------------------------------------!
; ! Number of records transferred !
; !-------------------------------------------------------!
; ! Log file spec address !
; !-------------------------------------------------------!
; ! Record buffer address !
; !-------------------------------------------------------!
; ! Record buffer byte count !
; !-------------------------------------------------------!
; ! Record buffer byte pointer !
; !-------------------------------------------------------!
; ! Disk buffer byte count !
; !-------------------------------------------------------!
; ! Transmission buffer byte count !
; !-------------------------------------------------------!
; ! Transmission buffer byte pointer !
; !-------------------------------------------------------!
; ! LH of ptr for Xmt buffer ! Max bytes in Xmt buffer !
; !=======================================================!
DATAST T,TK ; Data structure prefixed by "T"
; offset by register TK
$ STS,,,1 ; Task wakeup status
$. WKB,^D18 ; Desired wakeup bits
TW.ACK==1B35 ; ACK response
TW.COT==1B34 ; COT message
TW.ERR==1B33 ; ERR response
TW.EVT==1B32 ; EVT response
TW.RDA==1B31 ; RDA response
TW.RDD==1B30 ; RDD response
TW.SCH==1B29 ; SCH, SCO, WCH, WCO response
TW.VER==1B28 ; VER response
TW.UNK==1B27 ; Unknown response
TW.LGN==1B26 ; DECnet Link to Gateway is gone
TW.BSY==1B25 ; Workstation has request outstanding
TW.CNI==1B24 ; Console input queued to CNI queue
TW.CNO==1B23 ; Console output queued to CNO queue
TW.ON==1B22 ; Set workstation on requested
TW.OFF==1B21 ; Set workstation off requested
TW.WON==1B20 ; Workstation is ON
TW.QRQ==1B19 ; QUASAR request received
TW.XFI==1B18 ; File transfer has been initiated
$. 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 Workstation
$. PFW,^D18 ; Forward link
$. PBK,^D18 ; Backward link
$ OBA ; Address of object block
$ OBJ,,3,1 ; Object block
$. OTY ; Type
$. OUN ; Unit
$. ONO ; Node
$ SID ; Stream ID for this device
$ SIT,,DSTSIZ ; Associated text for Stream ID
$ FLG ; Device flags
$ CFS,,FDXSIZ ; File spec of current file
$ WAC ; $WTOR ack code
$ XBA ; Initial byte pointer for xmt buffer
$ GBA,,LGNUM ; Addresses of log pages
$ GCT ; Count of log pages in use
$ GLN ; Count of log lines
$ GIC ; Input byte count
$ GIP ; Input byte pointer
$ DST,^D18 ; State description address (ASCIZ)
$ OTK,^D18 ; Other task address (used by 2780/3780
; CDR to save LPT and LPT to save CDR
$ TMR ; Time job received
$ TMS ; Time job started
$ TFS ; Time of 1st io to/from front end
$ TFD ; Time of last io to/from front end
$ NFL ; Number of files in request
$ NFP ; Number of files processed
$ NRS ; Number of records transferred
$ LFS ; Address of log file spec
$ RIA ; Record buffer address
$ RIC ; Record buffer byte count
$ RIP ; Record buffer byte pointer
$ DIC ; Disk buffer byte count
$ 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
$
$ 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 Interrupt code -- INTDEC, DECnet Interrupt routine
INTDEC: $BGINT 1, ; Set up interrupt context
$DEBRK ; Exit interrupt
SUBTTL Initialization code
RJESPL: 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
$CALL INTINI ; Initialize interrupt system
$CALL OPDINI ; Get operating system information
$CALL I%ION ; Turn on interrupts
PUSH P,P1 ; send hello to QUASAR when it comes up
MOVEI P1,^D300/^D30 ; 30 second retries for 5 minutes
RJESP1: MOVEI T1,HELLO ; Point to "hello" message
$CALL SNDQSR ; and send it to QUASAR
JUMPT RJESP2 ; did it!
SOJL P1, [POP P,P1
JRST QSRDTH] ; die ignomineously
HRROI S1,[ASCIZ \RJESPL sleep - waiting for QUASAR to start
\]
$CALL K%SOUT ; tell the user
MOVEI S1,^D30 ; still hoping for the best
$CALL MISLP ; retire a while
JRST RJESP1 ; and try again
RJESP2: POP P,P1 ; QUASAR is alive & well
$CALL L%CLST ; Create a linked list
MOVEM S1,TSKNAM ; Save handle for task list
$CALL L%CLST ; Create another
MOVEM S1,WSNAM ; Save handle for workstation 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 Workstation 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 30 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 and MSGCHK.
;
MAIN: $CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
MOVEM S1,POLTIM ; Save as next time to poll
SETOM SCHDGO ; make sure we schedule 1st time around
JRST MAIN.3 ; enter the primary schedule loop
MAIN.1: SETZM SCHDGO ; Clear scheduling pass flag
MOVE S1,POLTIM ; poll time is the outer bound time
MOVEM S1,WAKTIM ; Save as next time to wakeup scheduler
MOVE S1,ATLNAM ; Get name of Active Task List
$CALL L%FIRST ; Point to first entry on list
JUMPF MAIN.3 ; If none .. go check IPCF queue
MAIN.2: $CALL SCHED ; Go conditionally schedule task
$CALL I%NOW ; update the local clock
MOVEM S1,NOW
$CALL MSGCHK ; Check for IPCF messages
MOVE S1,ATLNAM ; Get name of list again
$CALL L%NEXT ; Point to next entry on active list
JUMPT MAIN.2 ; If there is one, try to sched it
MAIN.3: $CALL MSGCHK ; Check for IPCF messages
$CALL DEBUG ; Check for debugging
$CALL POLL ; Always poll for new activity
SKIPE SCHDGO ; Check for another pass to be done
JRST MAIN.1 ; Yes .. some task has been signaled
MOVE S1,WAKTIM ; Get minimum time to make next pass
CAMG S1,NOW ; Check if it's time already
JRST MAIN.1 ; Yes .. go do another pass
SUB S1,NOW ; Calculate time to sleep
ADDI S1,2 ; in seconds, insuring
IDIVI S1,3 ; at least one second sleep
CAIL S1,^d30 ; Check for greater than 1/2 minute
MOVEI S1,^d30 ; Yes .. limit to 1/2 minute max
$CALL I%SLP ; Go to sleep
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
JRST MAIN.3 ; check messages and new device activity
SUBTTL Scheduler -- SCHED, Schedule a task
; Routine - SCHED
;
; Function - To conditionally schedule tasks. This routine is called
; with the address of an Active Task List entry. This entry
; is checked against NOW and the flags in the associated TasK Block
; to see if the task should be run. If it is to be run the
; wakeup conditions are set, MAIN context PDL saved, and the task
; context restored. If it is not to be run, WAKTIM is updated
; to the the minimum of this task's wake time and the previous
; value.
;
; See also the co-routine DESCHD, which is called when a task
; wishes to switch back to MAIN context.
;
; Parameters -
;
; S2/ Address of Active Task List entry
;
; Note - This routine destroys all registers except the stack pointer.
SCHED: LOAD TK,,A.TKB ; Get address of TasK Block
LOAD T1,,A.WKB ; Get events to wake up task with
LOAD T2,,T.WKB ; Get events task is waiting for
LOAD T3,,A.WKT ; Get time to wakeup task at
AND T2,T1 ; Mask events
JUMPN T2,OKSCHD ; If event hit, schedule task
JUMPE T3,.POPJ ; If no wakeup time, return to MAIN
CAMG T3,NOW ; Check against current time
JRST OKSCHD ; Yes .. schedule task
CAMG T3,WAKTIM ; No, check against minimum sleep time
MOVEM T3,WAKTIM ; Minimum seen so far .. save it
$RET ; Return to MAIN
OKSCHD: HRRZM S2,CURATE ; Save address of current active task
ANDCM T1,T2 ; Clear events causing wakeup
STORE T1,,A.WKB ; Save events yet to be woken on
STORE T2,,T.WCN ; Save event flags causing wakeup
ZERO ,A.WKT ; Clear wakeup time
MOVEM P,PDLSAV ; Save MAIN stack context
MOVSI R17,T%ACS ; Swap registers for the
BLT R17,R17 ; current task's registers
POPJ P, ; Return to task
SUBTTL Scheduler -- DESCHD, Deschedule a task
; Routine - DESCHD
;
; Function - To deschedule a task and return to MAIN context. This routine
; saves the current task context (if it still exists), updates the
; current time.
; If the task descheduling itself is deactivated the cell CURATE
; (Current Active Task list Entry) should be cleared. If the task
; has deleted itself (task no longer exists) the task block pointer
; (register TK) should be cleared.
;
; The normal manner for calling is this routine is through the
; $DSCHD macro.
;
; Parameters -
;
; TF/ Wakeup-events,,Wakeup-time-delay
; TK/ Address of this task's task block
; (If zero, then this task has deleted itself)
; CURATE/ Address of pointer into Active Task List
; (If zero, then this task has deactivated itself)
DESCHD: SETOM SCHDGO ; ensure a second scheduling loop
JUMPE TK,[MOVE P,PDLSAV ; If task deleted itself
SETZM CURATE ; Yes .. reset from task context
$RET] ; Return to main context
MOVEM TF,T%STS ; Save wakeup status flags
MOVEM R0,R0+T%ACS ; Save a scratch register
MOVEI R0,R1+T%ACS ; Save the task's register
HRLI R0,1 ; context
BLT R0,R17+T%ACS ; in the task block
MOVE P,PDLSAV ; Get MAIN stack context back
SKIPN CURATE ; Is task still active
$RET ; No .. just retun to MAIN context
SETZM CURATE ; Clear task context flag
ZERO ,T.WCN ; Clear events woken on
LOAD S2,,T.ATE ; Point to Active Task List entry
JUMPE S2,.POPJ ; If deactivated, return to MAIN
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save what time it is
DESCH1: ZERO ,A.WKT ; Clear time to wake up at
LOAD T1,,T.WKD ; Get wakeup time delay
JUMPE T1,.POPJ ; If none, go try to SCHED on events
ADD T1,NOW ; Get time when to wake task
STORE T1,,A.WKT ; Save for SCHED
$RET
SUBTTL Scheduler -- ACTTSK, activate a task
; Routine - ACTTSK
;
; Function - Trys to activate a task, puts new entry on active task list for
; the newly activated task. If task already active it just returns.
;
; Parameters - TK/ Address of task to be activated.
;
; Returns - True it task activated, false if cannot make ATL entry
;
; Note - Destroys S2
; Changes current entry for active task list
ACTTSK: SKPE S1,,T.ATE ; Get active task list pointer
$RETT ; Already active, so return
MOVE S1,ATLNAM ; Get name of Active Task List
MOVEI S2,A$SIZ ; Get size of entry
$CALL L%CENT ; Create an entry
JUMPF .POPJ ; If cannot, propagate failure
STORE TK,,A.TKB ; Save task address in ATL entry
STORE S2,,T.ATE ; Save ATL entry address in task block
LOAD S1,,T.WCN ; Get saved wakeup conditions
STORE S1,,A.WKB ; Save in wakeup bits
ZERO ,T.WCN ; Clear wakeup conditions
LOAD S1,NOW ; Get current time
STORE S1,,A.WKT ; store as wakeup time so task will run
SETOM SCHDGO ; Force another scheduling pass
$RETT ; Return true
SUBTTL Scheduler -- DEATSK, Deactivate a task
; Routine - DEATSK
;
; Function - Removes a task from the Active Task List (ATL) and goes back
; to the scheduler. This routine assumes normal operation of the
; scheduler. Also it assumes that only the task that is running
; can deactivate itself. Therefore the Active Task List should
; be pointing directly at the task.
;
; Parameters - TK/ Address of task to deactivate
;
; Returns - Doesn't return until task is reactivated
;
; Note - Changes "current" entry of active task list
DEATSK: $SAVE <S1,S2,T1>
MOVE S1,ATLNAM ; Get handle for list
LOAD T1,,T.ATE ; Get pointer to current entry
$CALL L%CURR ; Position to current entry
JUMPF DEATS1 ; If none, start at beginning
CAMN T1,S2 ; Is this the proper entry?
JRST DEAFND
DEATS1: $CALL L%FIRST ; Start from top of list
JUMPF DEAERR ; If no entries at all .. stop
DEATS2: CAMN T1,S2 ; Is this our entry?
JRST DEAFND ; Yes, go delete it
$CALL L%NEXT ; No, point to next entry
JUMPF DEAERR ; No more entries .. error
JRST DEATS2 ; Go try this entry
DEAFND: LOAD S1,,A.WKB ; Get events that have already happened
STORE S1,,T.WCN ; Save in convenient place
LOAD S1,ATLNAM ; Get handle for active task list again
$CALL L%DENT ; Delete it
JUMPF DEAERR ; If we cannot, stop
ZERO ,T.ATE ; Clear active task entry
$DSCHD DEACTIVATE ; Return to MAIN
$RET ; Task has been re-activated
DEAERR: $STOP TNE,<Task not active>
SUBTTL Scheduler -- WAKTSK, wake a task unconditionally
; Routine - WAKTSK
;
; Function - If task is not active it is activated; then it set wakeup time
; to "NOW" so scheduler will pick it up on next pass.
;
; Parameters - TK/ Address of task block to be awakened
;
; Returns - True always
;
; Note - Destroys S1 and S2
; May move current entry for active task list (ATL)
; Stopcodes if active task entry cannot be created.
WAKTSK: SKPE S2,,T.ATE ; Is task active?
JRST WAKTS1 ; Yes, just set time
$CALL ACTTSK ; No, activate it
JUMPF WAKERR ; If failed .. fatal error
WAKTS1: MOVE S1,NOW ; Get current time
STORE S1,,A.WKT ; Store it as wake time
SETOM SCHDGO ; Force another scheduler pass
$RETT ; Return true
WAKERR: $STOP CAT,<Cannot activate task>
SUBTTL Scheduler -- SGNTSK, signal a task
; Routine - SGNTSK
;
; Function - Sets argument bits in active list entry to flag a condition
; for a task.
;
; Parameters - TK/ Task to be signalled
; S1/ Bits to signal task with in RH
;
; Returns - True if task is active, false if task is not already active
;
; Note - Destroys S2
SGNTSK: LOAD S2,,T.ATE ; Get active list entry
JUMPE S2,.RETF ; If not active return error
PUSH P,S1 ; save original bits [4(240)]
PUSH P,S2 ; Save it for a bit
LOAD S2,,A.WKB ; Get existing bits
IOR S1,S2 ; OR into desired bits
POP P,S2 ; Get ATL entry address back
STORE S1,,A.WKB ; Store the new wakeup bits
POP P,S1 ; get back original bits [4(240)]
SETOM SCHDGO ; Force another scheduler pass
$RETT ; Return true
SUBTTL Scheduler -- SGNLIN, signal all tasks on a line
; Routine - SGNLIN
;
; Function - Sets argument bits for all tasks on a particular line.
;
; Parameters - WS/ 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,,W.FTK ; Get first in Workstation chain
JUMPE TK,.RETT ; If none, done
SGNLI1: $CALL SGNTSK ; Set bits
LOAD TK,,T.PFW ; Get pointer to next task
JUMPN TK,SGNLI1 ; If there is one, go back to loop
$RETT ; Return true
SUBTTL Scheduler -- POLL, active device signalling
; Routine - POLL
;
; Function - This routine loops through the list of Workstations making a
; call to Service each workstation that has been initialized. If
; the call returns a status flag, this routine checks all tasks for
; the Workstation and signals those tasks waiting for the returned
; flag. Finally, it sets up a new value for POLTIM (when to do next
; poll).
POLL: SKIPN S1,WSNAM ; Is there a "Workstation" list yet?
JRST POLLEX ; No, so don't bother checking
$CALL L%FIRST ; Yes, point to first entry
; Loop to look at each Workstation
POLL1: JUMPF POLLEX ; Exit loop if no entry
MOVE WS,S2 ; Get pointer to entry for this station
LOAD S1,,W.NUM ; Get station number
CAIN S1,-1 ; If not set up yet
JRST POLL1E ; try next Workstation
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get workstation number
STORE T1,,B.NUM
$CALL R%SWR## ; Service workstation
LOAD P2,,B.FLG ; Get the status bits
LOAD T1,P2,TW.BSY ; Get busy status
STORE T1,W$STS(WS),W.BSY ; Save busy flag in Workstation
TXZ P2,TW.BSY ; Clear it
CAXN P2,TW.COT ; If console output
JRST [$CALL PUTCNO ; queue it up
JRST POLL1E] ; and go on to next Workstation
CAXN P2,TW.EVT ; If an event
JRST [$CALL EVTMSG ; go process it
$CALL EVTSPC ; and see if a special event
JRST POLL1E] ; and go on to next Workstation
LOAD TK,,W.FTK ; Get control task TKB pointer
CAXN P2,TW.LGN ; If DECnet Link to Gateway is gone
JRST [$CALL ACTTSK ; Activate control task
$SIGNL TW.LGN ; Signal it, link has gone
JRST POLL1E] ; and go on to next Workstation
; Loop to look at each task on a Workstation
POLL2: LOAD S1,,T.WKB ; Get bits task wants to wake on
TDNN P2,S1 ; Is this one of them?
JRST POLL2E ; No, go look at next task
TXNN P2,TW.RDD!TW.RDA ; Is this a "stream completion"
JRST POLL2A ; No, go signal task
LOAD S1,,W.ARG ; Get argument block
MOVE S2,B$SID(S1) ; Get Stream ID
CAME S2,T%SID ; Belong to this task?
JRST POLL2E ; No, go look at next task
POLL2A: $SIGNL @P2 ; Yes, signal that the event happened
; Advance to next device in task chain for current link
POLL2E: LOAD TK,,T.PFW ; Get next TKB entry
JUMPN TK,POLL2 ; If we got one, go back to check it
; Advance to next Workstation
POLL1E: MOVE S1,WSNAM ; Get handle name
$CALL L%NEXT ; Advance to next entry
JRST POLL1 ; and go back
; Done polling
POLLEX: $CALL I%NOW ; Get current time
MOVEM S1,LSTPOL ; track time polled
ADDI S1,POLINT ; Add polling interval
MOVEM S1,POLTIM ; to make new poll time
$RET ; Return to MAIN context
SUBTTL Scheduler IPCF handling -- MSGCHK, message checker
; Routine - MSGCHK
;
; Function - This is a special purpose task executed by the MAIN routine.
; For each IPCF message that exists the routine MSGPRC is called.
; If any message processing routine causes the change in state
; of a task the flag SCHDGO is set. After each message is processed
; the current time NOW is updated.
;
; Returns - always
;
; NOW/ Most current time
; SCHDGO/ Turned on if any task state is changed
MSGCHK: $CALL C%RECV ; Get the next IPCF message
JUMPF .POPJ ; If none .. just return
$CALL MSGPRC ; Process this message
$CALL C%REL ; Now, .. release it
$CALL I%NOW ; Get current time
MOVEM S1,NOW ; Save it
JRST MSGCHK ; Go onto next message
SUBTTL Scheduler IPCF handling -- MSGPRC, IPCF message processor
; Routine - MSGPRC
;
; Function - This subroutine processes IPCF messages received from QUASAR
; and ORION. MSGPRC determines if message is from someone it knows,
; and then dispatches to the proper message processing routine.
;
; Upon entry, S1 has the address of the Message Data Block (MDB) for the
; message. When this routine dispatches to the message processors, P1
; will have the address of the message and S will have flags indicating
; what type of program sent the message, whether or not it is for
; HASP line, etc.
MSGPRC: MOVEM S1,MDBADR ; Store message data block address
MOVE S2,MDB.SI(S1) ; Get special index word
SETZ S, ; Clear flags
TXZN S2,SI.FLG ; Are we using special system index?
$RET ; No, don't process it
TXO S,F.IPCSY ; Indicate we have a system message
CAIE S2,SP.OPR ; It better be ORION
CAIN S2,SP.QSR ; or QUASAR
JRST MSGPR1 ; Yes, go process it
$WTOJ <Bad IPCF message>,<Message received from unknown system component (^O/S2/)>,SNABLK
$RET ; Return to main loop after error
; Here after checking system message source
MSGPR1: LOAD P1,MDB.MS(S1),MD.ADR ; Get address of message
CAIE S2,SP.OPR ; save name of sender
SKIPA S1,[[ASCIZ /QUASAR/]]
MOVEI S1,[ASCIZ /ORION/]
MOVEM S1,MSNDR
LOAD S1,.MSTYP(P1),MS.TYP ; Get message type
MOVSI S2,-NMSGT ; Make AOBJN pointer for table
; Loop to scan MSGTAB for processing routine for this message
MSGPR2: HRRZ T1,MSGTAB(S2) ; Get message type from current entry
CAMN T1,S1 ; Is it the same as our message?
JRST MSGPR3 ; Yes, go process it
AOBJN S2,MSGPR2 ; No keep looking
$WTOJ <Bad IPCF message>,<Message received from ^T/@MSNDR/ with unknown type code (^O/S1/)>,SNABLK
$RET ; Return to main loop
; Here when we have found MSGTAB entry for this message type
MSGPR3: HLRZ T2,MSGTAB(S2) ; Get entry vector address for msg type
JUMPE T2,.POPJ ; If no vector, ignore message
MOVE T2,@T2 ; Get contents of vector
TXNE S,F.IPCSY ; Are we processing system request?
MOVS T2,T2 ; Yes, swap vector
HRRZ T2,T2 ; Clear out inappropriate half
JUMPN T2,@T2 ; If we still have an address, go to it
$WTOJ <Invalid IPCF message type>,<"^T/MSGTNM(S2)/" message received from ^T/@MSNDR/ not valid for this component type>,SNABLK
$RET ; Return to main loop after error
; Table of type,,entry vector for message process dispatch
; Entry vector points to a word that contains dispatch addresses:
; system-message-routine,,non-system-message-routine
MSGTAB: XWD VSETUP,.QOSUP ; Setup/shutdown message
XWD VUSRCN,.QOABO ; User cancel
XWD VNXTJB,.QONEX ; Nextjob
XWD VOPRCN,.OMCAN ; Operator cancel
XWD VSNDCI,.OMSND ; Send console message to IBM
XWD VSTATS,.OMSHS ; ORION show status command
XWD VRQCHK,.QORCK ; Request for a checkpoint
XWD TEXTMS,MT.TXT ; Text message
XWD 0,.OMPAU ; Stop message
XWD 0,.OMCON ; Continue message
XWD VRQMSG,.OMREQ ; Requeue message
XWD 0,.OMSHP ; ORION show parameters command
NMSGT==.-MSGTAB ; Size of table
MSGTNM: ASCIZ \Setup/shutdown\
ASCIZ /User cancel/
ASCIZ /Nextjob/
ASCIZ /Operator cancel/
ASCIZ /Send console message to IBM/
ASCIZ /ORION show status command/
ASCIZ /Request for a checkpoint/
ASCIZ /Text/
ASCIZ /Stop/
ASCIZ /Continue/
ASCIZ /Requeue/
ASCIZ /ORION show parameters command/
SUBTTL Message processors -- TEXTMS, Text message response
; Routine - TEXTMS
;
; Function - To send a text IPCF message that IBMSPL has received to
; OPR.
; P1/QUASAR message ptr
TEXTMS: XWD TEXTM1,TEXTM1
TEXTM1: ;QUASAR sends these(null) to see who
; is still around
$RET ; Return to main loop
SUBTTL Message processors -- SETUP, Setup/shutdown message
; Routine - SETUP
;
; Function - This routine loads P3 and P4 and then decides what to do:
; whether to setup or shutdown a whole station or a single object.
; Throughout this processing, P1 has the address of the message,
; P3 has the object type and P4 the unit number.
;
VSETUP: XWD SETUP,0 ; Only system msgs may setup/shutdown
SETUP: MOVE P3,SUP.TY(P1) ; Get object type
MOVEM P3,OBJBLK ; Save away
MOVE P4,SUP.UN(P1) ; Get unit number
MOVEM P4,OBJBLK+1 ; Save away
MOVE S1,SUP.NO(P1) ; Get station name from message
MOVEM S1,OBJBLK+2 ; Save away
MOVE T1,SUP.FL(P1) ; Get flags word from message
TXNE T1,SUFSHT ; Is it really shutdown?
JRST SHTDWN ; Yes, Shut down object
; ; No .. go setup object
;
SUBTTL Message processors -- SETALL, setup a new station
; Routine - SETALL
;
; Function - To build the Workstation and associated tasks for a new
; station.
;
; The tasks created are chained to the Workstation and have
; forward/reverse links between all of them. For an SNA Workstation
; there is a control task (to do station startup and shutdown), a card
; reader task (to send jobs to 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).
;
; After all the tasks are built the card reader task is started.
; When the Gateway acknowledges that the link to the IBM host has
; been established, a setup response message is sent back to
; QUASAR indicating either success or failure. If a failure occured,
; the tasks that were setup are marked for SHUTDOWN and subsequently
; deleted.
;
; Parameters -
;
; P1/ Address of setup message
; P3/ Object type
; P4/ Object unit number
; S1/ Station name (in SIXBIT)
;
SETALL: LOAD T1,SUP.ST(P1),NT.TYP ; Get station type field
CAIE T1,DF.SNA ; Is it SNA Workstation?
JRST [MOVEI P2,%MSNSW ; No, should never happen!!
PJRST SETSND] ; Send response and return
CAIL P4,1 ; Is unit number in range?
CAILE P4,7 ; Only 1-7 are valid
JRST [MOVEI P2,%MSBUN ; No, set error message
PJRST SETSND] ; Send response and return
CAIN P3,.OTBAT ; Is this the main batch stream
CAIE P4,1 ; (Batch Stream 1) ?
JRST SETOBJ ; No, just go setup object
; Yes, so setup the workstation now
$CALL MAKWS ; Create a Workstation Block
JUMPF SETCHK ; If we can't, do some checking
MOVE T1,[XWD -SETTKN,SETTSK] ; Get task table
;
;
; Loop to add all tasks in appropriate task table
SETAL1: HLRZ S1,0(T1) ; Get current task table entry
SETZ S2, ; Make a default device 0
$CALL BLDTSK ; Build task for it
JUMPF [MOVE P2,S1 ; Get error code
PJRST SETSND] ; send error to QUASAR
$CALL ACTTSK ; Activate the task
AOBJN T1,SETAL1 ; Loop through whole table
; Here to setup a task for an object
SETOBJ: MOVEI S1,SUP.TY(P1) ; Point to object block
$CALL FNDOBJ ; Search existing tasks for this device
JUMPT SETOB1 ; If there go find out why
SETZ S2, ; Start with zero
MOVEI P2,%MSUDE ; and a pessimistic error code
CAIN P3,.OTBAT ; Is this a batch stream object?
MOVEI S2,.TCDR ; Yes, use card reader device
CAIN P3,.OTLPT ; Is this a line printer object?
MOVEI S2,.TLPT ; Yes, use line printer device
CAIN P3,.OTCDP ; Is this a card punch object?
MOVEI S2,.TCDP ; Yes, use card punch device
CAIN P3,.OTRDR ; Is this a card reader object?
MOVEI P2,%MSMUB ; Yes, must use batch; special error
JUMPE S2,SETSND ; Device is not supported
MOVE S1,SUP.NO(P1) ; Get node name
$CALL FNDWS ; Has a workstation been setup yet
JUMPF [MOVEI P2,%MSNWS ; No, set error message
PJRST SETSND] ; Send response and return
MOVE S1,S2 ; Get device type
MOVE S2,P4 ; Get unit number
$CALL BLDTSK ; Build task for it
JUMPF [MOVE P2,S1 ; Get error code
PJRST SETSND] ; send error to QUASAR
; Here when task is built
$CALL ACTTSK ; Activate the task
$RET
; Here when object being setup already exists
;
SETOB1: MOVEI P2,%MSSIP ; Assume a shutdown is underway
LOAD S1,,W.STS ; Get station status
TXNE S1,W.SDR ; Is shutdown pending?
JRST SETSND ; Yes
MOVE S1,S+T%ACS ; Get task bits for task
TXNE S1,SHUTDOWN ; Is shutdown pending?
JRST SETSND ; Yes
; No, should not happen
; Send message but don't tell QUASAR
$WTOJ <Startup failed>,<Object already started>,OBJBLK
$RET
; Here when attempt to build a Workstation fails
;
SETCHK: MOVEI P2,%MSISR ; Assume insufficient resources
JUMPE WS,SETSND ; If no WS, fail now.
LOAD S1,,W.STS ; Get station status
TXNN S1,W.SDR ; Is shutdown pending?
JRST SETSND ; No
SETZ WS,0 ; Yes, don't force shutdown now
MOVEI P2,%MSSIP ; Setup message
JRST SETSND
; Here to send failure "response to setup" to QUASAR
;
; P1/ address of SETUP message
; P2/ SETMSG index of message to return
;
SETSND: MOVEI S1,%RSUDE ; Device not available
$CALL RSETUP ; Send the response to setup message
$WTOJ <Startup failed>,<^T/@SETMSG(P2)/>,OBJBLK
$RET
SETMSG: [ASCIZ /Node is not an SNA Workstation/]
[ASCIZ /Illegal unit number for an SNA Workstation object/]
[ASCIZ /START NODE before starting additional SNA Workstation objects/]
[ASCIZ /Device not available on an SNA Workstation/]
[ASCIZ /START a BATCH-STREAM rather than a READER/]
[ASCIZ /Previous SHUTDOWN still in progress for this node/]
[ASCIZ /Insufficient resources for creating Workstation block/]
[ASCIZ /No destination string specified/]
;
%MSNSW==0 ; Not an SNA Workstation
%MSBUN==1 ; Illegal unit number
%MSNWS==2 ; No Workstation setup, yet
%MSUDE==3 ; Illegal object type
%MSMUB==4 ; Must use batch object
%MSSIP==5 ; SHUTDOWN still in progress
%MSISR==6 ; Insufficient resources
%MSNDS==7 ; No Stream Destination Supplied
;
; Task tables
; Entry format is type code (.Txxx where xxx is device)
; in LH, and first entry point of task in RH.
SETTSK: XWD .TCTL,TKCTL ; Control task (must be first)
XWD .TCNI,TKHCNI ; Console input sender task
XWD .TSND,TKSND ; Console output distributor
SETTKN==.-SETTSK ; Length of table
SUBTTL Message processors -- SHTDWN, shutdown station (signoff)
; Routine - SHTDWN
;
; Function - To shutdown a Workstation or one of its objects. If an entire
; Workstation is to be shutdown, the control task for the Workstation
; is awakened and it will wait for all activity to cease before
; shutting down the devices. If shutdown of an individual object is
; requested, the SHUTDOWN bit for the task is set.
;
; Parameters -
;
; P1/ QUASAR message ptr
; S1/ Workstation Name
SHTDWN: $CALL FNDWS ; Go find Workstation for this node
JUMPE WS,SHTERR ; If no Workstation, stop
CAIN P3,.OTBAT ; Is this the main batch stream
CAIE P4,1 ; (Batch Stream 1) ?
JRST SHTOBJ ; No, just go shutdown object
; Here to shutdown all
LOAD S1,,W.STS ; Get status bits
TXO S1,W.SDR ; Set workstation shutdown requested
STORE S1,,W.STS ; and save status bits
LOAD TK,,W.FTK ; Get control task TKB
JUMPE TK,[$CALL RELWS ; If none, just release Workstation
$RET]
$CALL ACTTSK ; activate control task
$SIGNL TW.OFF,TASK ; Wake him to do shutdown
$RET ; return to message processor
; Here to shutdown an individual object
SHTOBJ: MOVEI S1,SUP.TY(P1) ; Point to object block
$CALL FNDOBJ ; Search existing tasks for this device
JUMPF SHTERR ; Not here
MOVE S1,S+T%ACS ; Get task's S
TXO S1,SHUTDOWN ; Set flag
MOVEM S1,S+T%ACS ; and put status back
TXNN S1,ACTIVE ; Device currently active
$CALL WAKTSK ; No, wake task
$RET
; Here if device does not exist that QUASAR is shutting down.
SHTERR: $WTOJ <QUASAR Shutting down inactive device>,,<SUP.TY(P1)>
$RET
SUBTTL Message processors -- USRCN, User cancel message
; Routine - USRCN
;
; Function - This routine tests if the job is already aborting or exiting,
; and if so exits.
; It sets the CANCEL bit in the task's S, wakes the task,
; makes an entry into the log file and sends a message to operators.
; P1/QUASAR message ptr
VUSRCN: XWD USRCN,0 ; Only system components can do cancels
USRCN: MOVEI S1,ABO.TY(P1) ; Point to object block in message
$CALL FNDOBJ ; Set up TK, WS and J
JUMPF .POPJ ; Return if we cannot find it
; TK,WS,J setup
LOAD S,S+T%ACS ; Get S
TXOE S,CANCEL ; Set cancel processing bit
$RET ; If already on, ignore request
STORE S,S+T%ACS ; Put back updated status bits
$CALL WAKTSK ; Wake up task unconditionally
FTCLOG< $TEXT (LOGCHR,<^I/IBMSG/Job cancelled by user ^U/ABO.ID(P1)/>)>
MOVEI S1,[ITEXT()] ; Start with null
TXNE S,JVALID ; If job page set up
MOVEI S1,[ITEXT(^R/.EQJBB(J)/)] ; Use Job Status
$WTOJ <Cancelling by user ^U/ABO.ID(P1)/>,<^I/(S1)/>,@T%OBA
$RET ; Exit
SUBTTL Message processors -- OPRCN, Operator cancel message
; Routine - VOPRCN
;
; Function - This routine does effectly the same thing as USRCN except
; the cancel request has come from the operator instead of a user.
; P1/QUASAR message ptr
VOPRCN: XWD OPRCN,0 ; Operator cancel legal only from
; system component
OPRCN: MOVEI S1,.OHDRS+1(P1) ; Point to object block
LOAD S2,-1(S1),AR.TYP ; Get type of block
CAIE S2,.OROBJ ; Is it ORION object block?
$RET ; No, ignore bad message
$CALL FNDOBJ ; Find the task for the object type
JUMPF .POPJ ; Return if we cannot find it
; TK,WS,J setup
LOAD S,S+T%ACS ; Get status
TXOE S,CANCEL ; Set cancel processing bit
$RET ; If it was already doing it, exit
STORE S,S+T%ACS ; Stash status again
$CALL WAKTSK ; Make task wake up
FTCLOG< $TEXT (LOGCHR,<^I/IBMSG/Job cancelled by operator>)>
MOVEI S1,[ITEXT()] ; Start with null
TXNE S,JVALID ; If job page set up
MOVEI S1,[ITEXT(^R/.EQJBB(J)/)] ; Use Job Status
$WTOJ <Cancelling>,<^I/(S1)/>,@T%OBA
$RET
SUBTTL Message processors -- OPRRQ, Operator requeue message
; Routine - VOPRRQ
;
; Function - this routine checks to see if the job is already aborting
; or exiting and if so, returns. If not, we set the RQB bit and
; the CANCEL and ABORT bits in the task status and calls WAKTSK to
; cause a scheduler cycle, make a log entry and send a message to the
; operator.
VRQMSG: XWD OPRRQ,0 ; operator cancel is legal only
; from system components.
OPRRQ: MOVEI S1,.OHDRS+1(P1) ; Point to object block
LOAD S2,-1(S1),AR.TYP ; Get type of block
CAIE S2,.OROBJ ; Is it ORION object block?
$RET ; No, ignore bad message
$CALL FNDOBJ ; Find the task for the object type
JUMPF .POPJ ; Return if we cannot find it
; TK,WS,J setup
LOAD S2,,T.TYP ; find out which flavor task
CAIE S2,.TCDR ; is it a CDR?
JRST RQDER ; no, can't requeue it
LOAD S,S+T%ACS ; yes, get status
TXNE S,CANCEL!ABORT!RQB ; Are we already stopping?
$RET ; yes, no more can be done
TXO S,CANCEL!RQB ; no, we are now though!
STORE S,S+T%ACS ; store the status ac away in context
$CALL WAKTSK ; wake up the task
FTCLOG< $TEXT (LOGCHR,<^I/IBMSG/ Job Requeued By Operator>)>
$WTOJ <Requeuing>,<^R/.EQJBB(J)/>,@T%OBA
$RET ; and wait for the scheduler
RQDER: $WTOJ <Can't requeue a job being received, use the ABORT command.>
$RET
SUBTTL Message processors -- NXTJB, Nextjob message
; Routine - NXTJB
;
; Function - This routine save the current time as that when the request
; was received, copies the request into the first job page for
; the task (also sets the bit indicating that it is present)
; and finally signals a "request from QUASAR" wake condition
; for the task.
; P1/QUASAR message ptr
VNXTJB: XWD NXTJB,0 ; Only system programs can give a job
NXTJB: MOVEI S1,.EQROB(P1) ; Point to object block
$CALL FNDOBJ ; Set up world
JUMPF NXTJER ; Issue message if we cannot find it
; TK,WS,J setup
LOAD S1,,T.TYP ; Get task type
CAIE S1,.TCDR ; We only process batch requests
$STOP NNB,<NEXTJOB Request not for batch processor>
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>,<Link gone away - job requeued>,@T%OBA
TXO S,RQB ; set requeue flag
MOVE J,P1 ; set job page ptr to msg block
$CALL QRLSE ; release the job
$RET
SUBTTL Message processors -- SHWSTS, Show status message
; Routine - SHWSTS
;
; Function - This routine sets up the ack message to send to the
; operator (OPR) telling him what the status of the emulation
; devices on a particular node are doing.
; P1/QUASAR message ptr
VSTATS: XWD SHWSTS,0 ; Only system programs for now.
SHWSTS: $SAVE <S,J,P2,P3,P4,T2,T3,T4,WS,TK> ; Save some registers
SETZB P2,P4 ; init msg counter
SHWST0: ; P2 will hold the work page for the duration
; P3 will hold node name requested
; P4 will hold count of nodes reported on
; T3 will hold ptr to current message block
; T4 will hold correct node name
MOVE P3,.OHDRS+ARG.DA+OBJ.ND(P1) ; Get node name (SIXBIT)
MOVE S1,WSNAM ; Get name of Workstation list
$CALL L%FIRST ; Point to first entry on list
SHWLP1: JUMPF SHWER1 ; If no more .. didn't find node
PUSH P,S1 ; save list handle
MOVE WS,S2 ; Put Workstation addr in correct place
LOAD S2,,W.ONO ; Get name of node for this line
CAME P3,[-1] ; check for "all"
CAMN S2,P3 ; Check if one we are looking for
$CALL SHWFND ; Yes .. found Workstation for node
POP P,S1 ; restore list handle
JUMPF .POPJ ; exit if error happened
CAME P3,[-1] ; check for "all"
JUMPN P4,SHWER1 ; done if only requested one
$CALL L%NEXT ; No .. continue looking
JRST SHWLP1 ; Go check next list entry
SHWFND: MOVE T4,S2 ; copy current node name
JUMPN P2,SHWFN1 ; check if message started yet
SHWFN0: $CALL SHWMSI ; init msg
JUMPF .POPJ
SHWFN1: $CALL SHWNXT ; make sure there is room for more
JUMPE P2,SHWFN0 ; check if the partial message went
$CALL SHWTIT ; insert node title and set up body
$TEXT (DEPBP,<^T/STSHDR/>^A) ; Output the status header string
AOS P4 ; count this node status
LOAD TK,,W.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
LOAD T2,,T.UNI ; Get unit number
$TEXT (DEPBP,<^T12/@STSNAM-1(S2)/^D2/T2/ ^T30/0(S1)/ ^A>)
MOVE J,J+T%ACS ; Get pointer to JOB pages
LOAD S2,,T.TYP ; Get device type again
CAIE S2,.TCDR ; Check for a card reader (batch strm)
JRST SHWLPT ; No .. go show LPT or CDP
TXNN S,QSRREQ ; Check for request page setup
JRST SHWLF ; No .. just end the line
MOVE S2,.EQRID(J) ; Get request ID number of job
TOPS20< $TEXT (DEPBP,<^D6/S2/ ^W9/.EQJOB(J)/^T/.EQOWN(J)/>)>
TOPS10< $TEXT (DEPBP,<^D6/S2/ ^W9/.EQJOB(J)/^W6/.EQOWN(J)/^W6/.EQOWN+1(J)/>)>
JRST SHWRUN ; Go output transfer start time
SHWLPT:
SHWLF: $TEXT (DEPBP,<>) ; Put CRLF at end of line if needed
SHWRUN: TXNN S,ACTIVE ; Check for an active task
JRST SHWTST
$TEXT (DEPBP,< Started at: ^H/T%TMS/>)
LOAD S1,,T.CFS ; A current file name?
SKIPE S1 ; No
$TEXT (DEPBP,< File is: ^T/T%CFS/>)
SHWTST: LOAD TK,,T.PFW ; Get next task on this line
JUMPN TK,SHWLP2 ; If there is one .. continue output
$CALL SHWTRM ; terminate current message block
$RETT
SHWNXT: MOVE S1,T3 ; find out how much room left
SUBI S1,(P2)
CAIGE S1,PAGSIZ*5-^D80*6 ; need six lines worth
$RET
MOVX S1,WT.MOR ; send what we have
IORM S1,.OFLAG(P2)
SHWLST: MOVE S1,T3 ; do final formatting of message
SUBI S1,(P2)
HRLM S1,.MSTYP(P2) ; total length
MOVE T1,P2
$CALL SNDOPR ; ship it
SETZ P2, ; this message no longer exists
$RETT
SHWER1: JUMPN P4,SHWLST ; check if we reported something
CAMN P3,[-1] ; check for "all"
JRST SHWEND ; not an error if "all" request
$ACK (<SNA Workstation ^N/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,< Unknown workstation status requested>,,<.MSCOD(P1)>)
$RET
SHWEND: $ACK (<no SNA Workstations started>,,,<.MSCOD(p1)>)
$RET
SHWMSI: $CALL M%GPAG ; get a work page
JUMPT SHWMS0
$ACK (<SNA Workstation ^N/.OHDRS+ARG.DA+OBJ.ND(P1)/ status>,< failed to get workspace to build response>,,<.MSCOD(P1)>)
$RETF ; ignore request
SHWMS0: MOVE P2,S1 ; put message ptr in its permanent home
MOVEI S1,.OMACS ; do some formatting
MOVEM S1,.MSTYP(P2)
SETZM .MSFLG(P2)
MOVE S1,.MSCOD(P1)
MOVEM S1,.MSCOD(P2)
MOVX S1,WT.SJI!WT.NFO
MOVEM S1,.OFLAG(P2)
SETZM .OARGC(P2)
MOVEI T3,.OHDRS(P2) ; T3/ptr to current message block
$RETT
SHWTIT: $CALL SHWARG ; set up new message block
$CALL I%NOW ; get time stamp
MOVEM S1,ARG.DA(T3)
AOS TEXTBP ; push text ptr to next word
; insert title for this node status
$TEXT (DEPBP,< SNA Workstation ^N/T4/ on gateway ^N/W$GW6(WS)/ ^A>)
$CALL SHWTRM ; terminate this message
SHWART: SKIPA S1,[.CMTXT] ; set up body of node status message
SHWARG: MOVEI S1,.ORDSP ; set up title of node status message
MOVEM S1,ARG.HD(T3)
MOVEI S1,ARG.DA(T3) ; now init byte ptr for msg text
HRLI S1,(POINT 7)
MOVEM S1,TEXTBP
AOS .OARGC(P2) ; count this message block in whole
$RET
SHWTRM: SETZ S1, ; terminate message
IDPB S1,TEXTBP
AOS S1,TEXTBP ; count size of it
SUB S1,T3
HRLM S1,ARG.HD(T3) ; stuff it in msg block hdr
HRRZ T3,TEXTBP ; ptr to next msg block
$RET
STSHDR: ASCIZ \
Device Status Req# Jobname Username
-------------- ------------------------------ ------ ------- --------
\
STSNAM: [ASCIZ \Line printer\]
[ASCIZ \Card punch\]
[ASCIZ \Card reader\]
SUBTTL Message processors -- RQCHK, Request checkpoint message
; Routine - RQCHK
;
; Function - This routine merely sets up the task context and calls
; the CHKPNT to build and send the message; if the request
; was from a non-system program it calls the subroutine at the
; CHKPNB entry point.
; P1/QUASAR message ptr
VRQCHK: XWD RQCHK,RQCHK ; Both types can request checkpoints
RQCHK: MOVEI S1,RCK.TY(P1) ; Point object block sent by QUASAR
$CALL FNDOBJ ; Set up TK and WS and J
JUMPF .POPJ ; Ignore it if we cannot find it
; TK,WS,J setup
LOAD S1,S+T%ACS ; Set task's status bits
TXNN S1,QSRREQ ; See if we are processing a request
$RET ; No, QUASAR doesn't expect chkpnt
MOVEI T1,CHKPNT ; Assume only to QUASAR
TXNN S,F.IPCSY ; See if request came from system
MOVEI T1,CHKPNB ; No, use other entry point
PJRST @T1 ; Go there and then return to main loop
SUBTTL Message processors -- CHKPNT, CHKPNB, send checkpoint
; Routine - CHKPNT, CHKPNB
;
; Function - CHKPNT is the subroutine to build a checkpoint message in
; the message block and then send it to QUASAR; CHKPNB is an entry
; point that can be used only from the message processing level to
; send a checkpoint message both to QUASAR and to the NON-SYSTEM PROGRAM
; that sent the request.
;
; THIS IS CALLED WITH TASK CONTEXT SET UP --- DRB
;
; Parameters - WS must be set up
; P1/QUASAR message ptr
;
; Returns - True if SNDQSR does
;
; Note - Destroys S1 and S2
CHKPNB: TDZA S2,S2 ; Entry to send checkpoint to both
CHKPNT: SETOM S2 ; Set QUASAR-only flag true
$SAVE <S,TK,J,T1,T2,T3,T4> ; Save registers
LOAD S1,,T.TYP ; Get caller's context type
SETZ T4, ; Provisionally clear register to hold
; device selected for checkpoint information
CAIN S1,.TCDR ; Is it a card reader device?
HRRZ T4,TK ; Yes, use it
MOVEI T1,MSGBLK ; Point to block in which to build
; message (can do this since we are
; not interruptible until WE do
; a $DSCHD
MOVX S1,CH.FCH ; Indicate that we have checkpoint info
STORE S1,CHE.FL(T1) ; Store flags in message
LOAD TK,,W.FTK ; Point to first device on line
JUMPE TK,CHKLO4 ; If none, we are done
CHKLOP: LOAD T2,,T.TYP ; Get task/device type
SKIPE T4 ; Selected device for checkpoint info?
JRST CHKLO1 ; Yes, go see if they match
CAIE T2,.TCDR ; No, see if this is a candidate
JRST CHKLO2 ; No, just do continue
HRRZ T4,TK ; Yes, select him
CHKLO1: CAME TK,T4 ; Device we wish to checkpoint?
JRST CHKLO2 ; No, just continue to next task
LOAD S1,,T.NFP ; Get number of files processed
STORE S1,CHE.IN+CKFIL(T1) ; Save it in checkpoint block
LOAD S1,,T.NRS ; Get number of records processed
STORE S1,CHE.IN+CKTRS(T1) ; Save it too
LOAD J,J+T%ACS ; Get address of request
LOAD S1,.EQITN(J) ; Get internal number from request
STORE S1,CHE.IT(T1) ; and save it also
MOVX S1,CKFCHK ; Flag that job has been checkpointed
STORE S1,CHE.IN+CKFLG(T1) ; Set it in block
CHKLO2: LOAD TK,,T.PFW ; Get next task in chain
JUMPN TK,CHKLOP ; If there was one, go back to loop
CHKLO4: MOVX S1,CHE.ST ; Get length of message
STORE S1,.MSTYP(T1),MS.CNT ; Save as length of message
MOVX S1,.QOCHE ; Get function (checkpoint)
STORE S1,.MSTYP(T1),MS.TYP ; And save it in header too
SKIPE S2 ; See it we are to send to caller
JRST CHKLO5 ; No, just to QUASAR
SKPTSK ; Only message processors can send back to caller
$CALL SNDBAK ; Send it back
CHKLO5: $CALL SNDQSR ; Send it to QUASAR
JUMPF QSRDTH ; die if can't do it
$RET
SUBTTL Message processors -- SNDCI, send console input to IBM
; Routine - SNDCI
;
; Function - This routine receives a message from either OPR (send to
; batch stream) or a non-system component (with the same codes for
; simplicity) which is a console line intended to be sent to IBM.
; After some validity checking, it merely copies it into a console
; input queue (CNI) entry and signals TW.CNI to the appropriate task.
; P1/QUASAR message ptr
VSNDCI: XWD SNDCI,SNDCI ; Both types can do this
SNDCI: MOVEI S1,.OHDRS(P1) ; Point past message header
LOAD S2,ARG.HD(S1),AR.TYP ; Get type of first block
LOAD T1,ARG.HD(S1),AR.LEN ; and length
ADD T1,S1 ; Compute address of next block
SETZM SNDCEC ; Initialize error code
CAIE S2,.OROBJ ; Is first block object block?
JRST SNDCIE ; No, inform world of error
AOS SNDCEC ; Increment error code
AOS S1 ; Point to start of object type
$CALL FNDOBJ ; Yes, set up TK properly
JUMPF SNDCIE ; If cannot, something is very wrong
; TK,WS,J setup
LOAD S2,ARG.HD(T1),AR.TYP ; Get type of second block
AOS SNDCEC ; Increment error code to 2
CAIE S2,.CMTXT ; It better be text type
JRST SNDCIE ; It isn't, so complain
AOS SNDCEC ; next possible error
HRRI S1,1(T1) ; Point to start of data part
HRLI S1,440700 ; and make it into a byte pointer
LOAD T2,ARG.HD(T1),AR.LEN ; get the text length
SOS T2 ; flush word count
IMULI T2,5 ; make bytes
; now scan line for =>
SNDCI0: SOJL T2,SNDCIE ; msg too short
ILDB S2,S1 ; Get next character
SNDCI1: CAIE S2,"=" ; Is it = ?
JRST SNDCI0 ; No, keep looking
; =
SOJL T2,SNDCIE ; msg too short
ILDB S2,S1 ; Get next character
CAIE S2,76 ; Is it right angle bracket?
JRST SNDCI1 ; no, keep scanning
; => ...the IBM console msg follows
MOVE T3,S1 ; save the ptr, T2/no. bytes in msg
LOAD S1,,W.CNI ; Get CNI queue list handle
MOVE S2,T2 ; Copy length in bytes
ADDI S2,4+5 ; Compute length
IDIVI S2,5 ; in words (accounting for length word)
AOS SNDCEC ; Increment error code to 3
$CALL L%CENT ; and get a new entry
JUMPF SNDCIE ; If no room, go complain
MOVEM T2,0(S2) ; Store length in first word
ADD S2,[XWD 440700,1] ; Make entry address into byte pointer
CAIA
SNDCI4: JUMPE S1,SNDCI5 ; when the null char is found, stop source
ILDB S1,T3 ; Get next character
SNDCI5: IDPB S1,S2 ; Store it in entry
SOJG T2,SNDCI4 ; Loop till no more characters left
TDZA S1,S1 ; make sure there is a null char to stuff
SNDCI6: IDPB S1,S2
TLNE S2,760000 ; only done when last dest word is filled
JRST SNDCI6
$SIGNL TW.CNI,LINE ; and inform world its there
$RET ; Return to MSGPRC
SNDCIE: MOVE S2,SNDCEC ; Get error code
$WTOJ <Console error>,<Error "^T/@SNDERR(S2)/" processing send message.>,@T%OBA
$RET
SNDCEC: EXP -1
EXP [ASCIZ /illegal error code/]
SNDERR: EXP [ASCIZ /first block in msg not object/]
EXP [ASCIZ /can't find task for object block/]
EXP [ASCIZ /second block in msg not text/]
EXP [ASCIZ /illformed IBM console msg/]
EXP [ASCIZ /cannot create CNI queue entry/]
SUBTTL Tasks -- Description
COMMENT &
The tasks RJESPL uses can be divided into common tasks (TKCTL, TKSND,
TKHCNI) and device-type tasks (TKCDR, TKHLPT, TKHCPD).
TKSND takes console output from the CNO queue (it was placed there
during the POLL of the workstation) and distributes it
to all "watchers" of the console line.
The control task (TKCTL) is responsible for startup and shutdown.
The card reader tasks copy (TKCDR) jobs to IBM.
The lineprinter and punch (TKHLPT and TKHCDP) tasks receive jobs
from the IBM host.
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.
&
SUBTTL Tasks -- TKSND, console output distribution
; Task - TKSND
;
; Function - This task distributes console output arriving from the IBM
; host to all programs that have declared themselves "watchers" of
; the console line. (OPRs)
;
; This tasks wakes upon an TW.CNO signal, which is set up during
; polling by PUTCNO after it has queued console
; output to the CNO list for the workstation.
;
; This task dequeues messages from this list.
; Then it loops over the list of watchers, sending the message
; to all.
TKSND: LOAD S1,,W.STS ; Get status
TXNN S1,W.SDR ; If shutdown requested
TXNE S,LGA ; or line gone away
JRST TSKDIE ; Exit and wait to die
MOVEI S1,[ASCIZ \Waiting for console output from IBM\]
STORE S1,,T.DST ;set state
$DSCHD TW.CNO,0 ; Wait only on CNO queued signal
$CALL DEVCHK ; Check to see if
LOAD S1,,W.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
$CALL TSSTSH ; Store in collected messages
LOAD S1,,W.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
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)
$WTOJ <Console output>,<^T/0(P1)/^A>,W%OBJ,<$WTFLG(WT.SJI!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*3 ;get number of characters that will fit
;we don't use whole page because WTOJ croaks
$RET
SUBTTL Tasks -- TKCTL, control for SNA-Workstation
COMMENT &
This task wakes on TW.ON (a "set workstation on" request from
a main [i.e. CDR] task), on TW.OFF (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).
&
TKCTL: ;SNA Workstation control task
MOVE T1,TK ;save task block pointer
LOAD S1,,W.ONO ;get station name
MOVEI S2,1 ;Unit # 1
HRLI S2,.TCDR ;get card-type,,1 as dev,,unit
$CALL FNDTSK ;get main 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.ON!TW.OFF!TW.LGN> ;wait for "on" request, "off" request
; or link gone
TKCTL1: SKPN S1,,T.WCN ;get conditions which caused us to wake
$STOP ILW,<Illegal wakeup>
TXZE S1,TW.ON ;if "set workstation on" request
JRST CTSGON ;go process it
TXZE S1,TW.LGN ;if link gone (which thus has priority
; over off)
JRST CTLNGN ;go process it
TXZE S1,TW.OFF ;if "set workstation off" request
JRST CTSGOF ;go do it
;
; Here to exit control task
;
CTEXT: MOVEI S1,[ASCIZ \inactive\]
STORE S1,,T.DST ;set state
$CALL DEATSK ;deactivate
JRST TKCTL0 ;and go back to beginning
SUBTTL Tasks -- . CTSGON, set workstation on
CTSGON: MOVE T1,TK ;save task block pointer
LOAD S1,,W.ONO ;Get station name
MOVEI S2,1 ;Unit # 1
HRLI S2,.TCDR ;get card-type,,1 as dev,,unit
$CALL FNDTSK ;find its task
EXCH TK,T1 ;swap task block addresses
; (restoring ours)
STORE T1,,T.OTK ;save pointer to master card reader
;
;
;
; Connect to SNA Gateway
;
MOVEI S1,[ASCIZ \connecting to gateway\]
STORE S1,,T.DST ;set state
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
$CALL R%RNW## ; Get next workstation number
LOAD T1,,B.NUM ; Get workstation number returned
STORE T1,,W.OUN ; Save in object block
; so next message looks correct
$WTOJ <Initializing>,<connecting to gateway ^N/W%GW6/ ...>,W%OBJ
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
MOVEI T1,1 ; Interrupt on Channel 1
STORE T1,,B.FLG
MOVEI T1,W%GWY ; Get address of gateway name
HRLI T1,(POINT 7) ; Make a pointer
STORE T1,,B.GWY ; Save it
MOVEI T1,W%NAM ; Get address of station name
HRLI T1,(POINT 7) ; Make a pointer
STORE T1,,B.NAM ; Save it
LOAD T1,,W.WRK ; Address of work area
STORE T1,,B.WRK ; Save it
$CALL R%INI## ; Initialize workstation
LOAD TF,,B.COD ; Get return code
SKIPT ; See if failed
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF] ; and force a shutdown
LOAD T1,,B.NUM ; Get workstation number
STORE T1,,W.NUM ; Save in Workstation
STORE T1,,W.OUN ; and object block in Workstation
$DSCHD <TW.VER!TW.ERR!TW.OFF!TW.LGN> ; Wait for gateway response
LOAD T1,,T.WCN ;get conditions which caused us to wake
TXZE T1,TW.ERR ;if error response
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
TXZN T1,TW.VER ;if version confirmation continue on
JRST TKCTL1 ; otherwise make one last try
MOVX S1,W.CON ; "link up" flag is set
IORM S1,W$STS(WS)
$WTOJ <Initializing>,<connected to gateway ^N/W%GW6/>,W%OBJ
;
; Set Workstation Characteristics
;
MOVEI S1,[ASCIZ \setting workstation characteristics\]
STORE S1,,T.DST ;set state
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get Workstation number
STORE T1,,B.NUM
MOVEI T1,1 ; Get a 1
STORE T1,B$FLG(S1),B.XLT ; Set Translate Bit
MOVEI T1,W%ACC ; Get address of Access Name
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$ACC(S1) ; Save it
MOVEI T1,W%CIR ; Get address of Circuit
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$CIR(S1) ; Save it
MOVEI T1,W%LOM ; Get address of LOGON Mode
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$LOM(S1) ; Save it
MOVEI T1,W%PLU ; Get address of Application
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$PLU(S1) ; Save it
MOVEI T1,W%LOD ; Get address of LOGON Data
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$LOD(S1) ; Save it
$CALL R%CHA## ; Set characteristics
LOAD TF,,B.COD ; Get return code
SKIPT ; See if failed
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
$DSCHD <TW.ACK!TW.ERR!TW.OFF!TW.LGN> ; Wait for gateway response
LOAD T1,,T.WCN ;get conditions which caused us to wake
TXZE T1,TW.ERR ;if error response
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
TXZN T1,TW.ACK ;if ACK, continue on
JRST TKCTL1 ; otherwise make one last try
;
; Load Translation Table
;
LOAD S1,,W.CHS ; Translation Table specified
JUMPE S1,CTSGN4 ; No, continue on
MOVEI S1,[ASCIZ \loading character set table\]
STORE S1,,T.DST ; set state
MOVEI T1,1 ; Get starting sequence number
STORE T1,,W.LTS ; Save in Workstation
MOVEI T1,FDXSIZ-1 ; Build an FD Header
STORE T1,FDBARE,FD.LEN ; Save it
MOVEI T1,FDBARE+1 ; Area to build an FD spec
HRLI T1,W%CHS ; Get address of Filespec
BLT T1,FDBARE+FDXSIZ-2 ; Set it up
$CALL M%GPAG ; Get a page of memory
STORE S1,,W.LTA ; Save address of translation table
MOVE S2,S1 ; Address to S2
MOVEI S1,FDBARE ; Address of FD to S1
$CALL TRANSX ; Read file
JUMPT CTSGN1 ; If OK, continue on
; Otherwise, report error
$WTOJ <Initializing>,<failed to load character set from ^T/W%CHS/^I/(S2)/>,W%OBJ
LOAD S1,,W.LTA ; Address of page
$CALL M%RPAG ; Release page
JRST CTSGOF ; and force a shutdown
CTSGN1: MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get Workstation number
STORE T1,,B.NUM
MOVEI T1,^D128 ; Get byte count
STORE T1,,B.LTC ; Save it
LOAD T1,,W.LTS ; Get sequence number
STORE T1,,B.SEQ ; Save it
LOAD T2,,W.LTA ; Get address of translation table
CAIN T1,1 ; Set offset into translation table
ADDI T2,^D128 ; depending on which section
CAIN T1,2 ; is being transferred
ADDI T2,^D128+^D64 ;
CAIN T1,4 ;
ADDI T2,^D64 ;
HRLI T2,(POINT 18) ; Make a pointer
MOVEM T2,B$LTT(S1) ; Save it
$CALL R%LTT## ; Initialize workstation
LOAD TF,,B.COD ; Get return code
SKIPT ; See if failed
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF] ; and force a shutdown
$DSCHD <TW.ACK!TW.ERR!TW.OFF!TW.LGN> ; Wait for gateway response
LOAD T1,,T.WCN ;get conditions which caused us to wake
TXZE T1,TW.ACK ;if ACK,
JRST CTSGN2 ; continue on
LOAD S1,,W.LTA ;Address of page
$CALL M%RPAG ;Release page
TXZE T1,TW.ERR ;if error response
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
JRST TKCTL1 ; otherwise make one last try
CTSGN2: LOAD S1,,W.LTS ; Get sequence #
AOS S1
STORE S1,,W.LTS ; Update sequence # in Workstation
CAIGE S1,5
JRST CTSGN1
LOAD S1,,W.LTA ;Address of page
$CALL M%RPAG ;Release page
;
; Terminate Translation Table Loading; Load Filespec
;
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get Workstation number
STORE T1,,B.NUM
LOAD T1,,W.LTS ; Get sequence number
STORE T1,,B.SEQ ; Save it
MOVEI T1,W%CHS ; Get address of Filespec
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$FIL(S1) ; Save it
$CALL R%LTF## ; Specify filespec
LOAD TF,,B.COD ; Get return code
SKIPT ; See if failed
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF] ; and force a shutdown
$DSCHD <TW.ACK!TW.ERR!TW.OFF!TW.LGN> ; Wait for gateway response
LOAD T1,,T.WCN ;get conditions which caused us to wake
TXZE T1,TW.ERR ;if error response
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
TXZN T1,TW.ACK ;if ACK, continue on
JRST TKCTL1 ; otherwise make one last try
$WTOJ <Initializing>,<loaded character set from ^T/W%CHS/>,W%OBJ
;
; Set Workstation State to ON
;
CTSGN4: MOVEI S1,[ASCIZ \activating workstation\]
STORE S1,,T.DST ;set state
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get Workstation number
STORE T1,,B.NUM
MOVEI T1,RS%ON ; ON State Code
MOVEM T1,B$OFF(S1) ; Save it
$CALL R%SWS## ; Initialize workstation
LOAD TF,,B.COD ; Get return code
SKIPT ; See if failed
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
$DSCHD <TW.ACK!TW.ERR!TW.OFF!TW.LGN> ; Wait for gateway response
LOAD T1,,T.WCN ;get conditions which caused us to wake
TXZE T1,TW.ERR ;if error response
JRST [$CALL ERRMSG ; go process it
JRST CTSGOF]
TXZN T1,TW.ACK ;if ACK, continue on
JRST TKCTL1 ; otherwise make one last try
MOVX S1,W.WON ; set "workstation on" flag
IORM S1,W$STS(WS)
$SIGNL TW.WON,LINE ;let everyone know station is on
JRST CTEXT ;and exit task
CTSSTP: $STOP IW1,<Illegal wakeup>
SUBTTL Tasks -- . CTSGOF, do shutdown
CTSGOF: ;here to do SHUTDOWN processing
MOVEI S1,[ASCIZ \waiting for active tasks to finish\]
STORE S1,,T.DST ; Set dying state
LOAD TK,,T.PFW ; Get first real task
JUMPE TK,CTSDIE ; If none, continue on
CTSGO1: ; Loop setting SHUTDOWN for tasks
MOVE S1,S+T%ACS ; Get task's S
TXO S1,SHUTDOWN ; Set flag
MOVEM S1,S+T%ACS ; and put status back
TXNN S1,ACTIVE ; Device currently active
$CALL WAKTSK ; No, wake task
LOAD TK,,T.PFW ; Point to next task
JUMPN TK,CTSGO1 ; And process it too
;
; Here when appropriate task status bits have been set
; and we are waiting for tasks to die
;
CTSDIE: LOAD TK,,W.FTK ; Point to our task block again
$CALL QUIESC ; Wait for tasks to go away
$CALL RELTKB ; Release our task block
$CALL RELWS ; Release Workstation
$DSCHD DELETE ; Deschedule this task forever
SUBTTL Tasks -- . CTLNGN, link gone while active processing
CTLNGN:
$WTOJ <Shutting down>,<Link to gateway ^N/W%GW6/ disconnected>,W%OBJ
CTLABT: LOAD TK,,W.FTK ;get first task pointer (ctl task)
LOAD TK,,T.PFW ;get first real task
JUMPE TK,CTSDIE ;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 link 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
JRST CTSDIE ;and finally shut down
SUBTTL Tasks -- TKCDR, Card Reader
; Task - TKCDR
;
; 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.
TKCDR: LOAD S1,,W.STS ; Get status
TXC S1,W.CON!W.WON ; check both link up and station on
TXCN S1,W.CON!W.WON ; Put em back and skip if not both on
JRST TKCDR1 ; Go immediately to initialize
LOAD T1,,T.OUN ; Get unit number
CAIE T1,1 ; Are we the master batch stream?
JRST TKCDR0 ; No
LOAD T1,,W.FTK ; Yes, Get address of control task
EXCH T1,TK ; Save our task pointer
$CALL ACTTSK ; Activate control task
$SIGNL <TW.ON>,TASK ; Tell it to set workstation on
MOVE TK,T1 ; Get our pointer back
TKCDR0: MOVEI S1,[ASCIZ /Waiting for LOGON to IBM/]
STORE S1,,T.DST ; State for status message
$DSCHD TW.WON,0 ; Wait for workstation to come on
TKCDR1: $CALL DEVCHK ; Check if everything OK
$CALL INITSK ; Initialize task
LOAD S1,,T.WCN ; Get wakeup conditions
TXNE S1,TW.QRQ ; Has QUASAR been fast?
JRST TKCDR3 ; Yes, don't do delay
TKCDR2: MOVEI S1,[ASCIZ /Idle/] ; Display idle
STORE S1,,T.DST ; State for message
$DSCHD TW.QRQ,0 ; Wait for job
TKCDR3: $CALL DEVCHK ; check if everything OK
$CALL DOJOB ; Get next job and do it
$CALL DEVCHK ; See if everything still viable
JRST TKCDR2 ; Go back for more
SUBTTL Tasks -- . DOJOB, process "batch" job
; Routine - DOJOB
;
; Function - Loops through files of request, copying them to IBM if
; necessary.
;
; Parameters - TK, WS and J must be set up, P1 must have device handle
;
; Returns - False when line goes away.
;
; Note - MUNGS S1,S2,T1,T2,P2,P3
DOJOB: ;here to fulfill a request from QUASAR
$CALL INIJOB ;clean up job-related task block entries
ZERO ,T.CFS ;Clear out current file spec
TXZ S,ABORT!CANCEL!RQB!RDA ;clear possible abort from last time
TXO S,ACTIVE ;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
;put first line in log file
FTCLOG<
$TEXT (LOGCHR,<^M^J^I/IBDAT/RJESPL version ^V/[%%.RJE]/ ^T/CNF/>)
LOAD S1,,T.UNI
LOAD S2,,W%ONO
LOAD T1,,W%GW6
$TEXT (LOGCHR,<^I/IBDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on CDR ^D/S1/ on SNA Workstation ^W/S2/ using Gateway ^W/T1/>) ;and next
SKIPN T2,.EQCHK+CKFLG(J) ;was this job requeued?
JRST DOJOB0 ;no, just process it
MOVEI T1,[ASCIZ /system failure/];assume it was because of system failure
TXNE T2,CKFREQ ;was it really operator requeue?
MOVEI T1,[ASCIZ /requeue by operator/];yes, use proper string
$TEXT (LOGCHR,<^I/IBMSG/Job being restarted after ^T/0(T1)/>) ;write it into log
DOJOB0: ;here after writing initial log file lines
> ;end FTCLOG
$CALL I%NOW ;get time
STORE S1,,T.TMS ;save as time we started job
LOAD S2,,T.TMR ;see when we received it
SUB S1,S2 ;get time difference
FTCLOG<
CAILE S1,INSIGN ;if it is insignificant, skip message
$TEXT (LOGCHR,<^I/IBMSG/Job received at ^C/S2/ and delayed ^C/S1/>) ;put entry into log file
> ;end FTCLOG
$WTOJ <Begin>,<^R/.EQJBB(J)/>,@T%OBA
$CALL TBFINI ;initialize the buffer
LOAD P2,.EQLEN(J),EQ.LOH ;get length of header of request
ADD P2,J ;add to start to get beginning
;of file blocks (P2 is pointer
;to next file block within DOJOB)
LOAD S1,.FPLEN(P2),FP.LEN ;get length of parameters
MOVE P3,P2 ;copy base address
ADD P3,S1 ;point to FDB
LOAD T2,.EQSPC(J),EQ.NUM ;get number of files in request
STORE T2,,T.NFL ;save as number of files
SKIPN .EQCHK+CKFLG(J) ;is this a restarted job?
JRST DOJOB4 ;no, just start at beginning
LOAD T1,.EQCHK+CKFIL(J) ;yes, get how many files already done
STORE T1,,T.NFP ;save as number of files processed
DOJOB1: ;loop to skip already send files
SOJL T1,DOJOB2 ;jump if we have skipped enough
$CALL NXTFIL ;advance to next file block
JUMPF DOJOB7 ;finish up processing if we skipped them all
JRST DOJOB1 ;go try to skip another
DOJOB2: ;here after skipping already done files
LOAD T1,.EQCHK+CKTRS(J) ;get checkpointed count of
;total number of records sent
STORE T1,,T.NRS ;save as our num records sent
DOJOB4: ;here to loop sending files
$CALL FILE ;do a file
JUMPF .POPJ ;return failure to caller if error
TXNE S,RQB!RDA ;did job get requeued or did xfer fail
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 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
DOJEND: ;here when all done with job
ZERO ,T.CFS ;Clear out current file spec
TXZ S,QSRREQ!ACTIVE ;indicate 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, WS and J must be set up
; P2/ptr to file block
; P3/ptr to file FD
;
;
; Note - Destroys S1
FILE: TXNN S,ABORT!SHUTDOWN!LGA ;if flag set, exit immediately
JRST FILE.0
TXO S,RQB ;exiting - make sure requeue is set
$RETT ;pretend we copied file
FILE.0: TXNE S,CANCEL ; If cancel flag set,
JRST [TXZ S,QSRREQ!ACTIVE ; Indicate we no longer have a request
$RETF] ; Fail (DEVCHK will do actual cancel)
MOVEI S1,FDBARE ; Point to area to build file string
HRLI S1,(POINT 7) ; Make a pointer
MOVEM S1,TEXTBP ; Save it for DEPBP
;
;
MOVEI S2,1(P3) ; Make a pointer
HRLI S2,(POINT 7) ; to file specification
FIL0.1: ILDB S1,S2 ; Get a character
JUMPE S1,FIL0.2 ; All done
CAIE S1,":" ; A colon?
JRST FIL0.1 ; No keep looking
ILDB S1,S2 ; Get next byte
CAIE S1,":" ; A double colon?
FIL0.2: $TEXT (DEPBP,^W/NODNAM/::^A) ; No, so we need to furnish node
$TEXT (DEPBP,^F/(P3)/^0) ; Add file spec in FD
$WBUSY ; Wait until workstation not busy
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get Workstation number
STORE T1,,B.NUM
MOVEI T1,1 ; Get a 1
LOAD T2,,T.NFL ; Get number of files left
CAIN T2,2 ; If just us and a log file,
STORE T1,B$FLG(S1),B.EOS ; set End of Stream Bit
LOAD T2,.FPINF(P2),FP.TAB ; Get /TAB /NOTAB flag
SKIPN T2 ; Was /TAB specified?
STORE T1,B$FLG(S1),B.NTB ; No, so set NOTABS flag
LOAD T2,.FPINF(P2),FP.NXL ; Get /TRANSLATE /NOTRANSLATE flag
SKIPE T2 ; Was /NOTRANSLATE specified?
STORE T1,B$FLG(S1),B.BIN ; Yes, so set BINARY flag
LOAD T1,,T.SID ; Get Stream ID
MOVEM T1,B$SID(S1) ; Save it
LOAD T1,.FPINF(P2),FP.RCL ; Get Record Length
HRLM T1,B$SID(S1) ; Save it
MOVEI T1,FDBARE ; Get address of File Spec
HRLI T1,(POINT 7) ; Make a pointer
MOVEM T1,B$FIL(S1) ; Save it
$CALL R%SUB## ; Submit job
LOAD TF,,B.COD ; Get return code
SKIPT ; See if failed
JRST [$CALL ERRMSG ; go process it
TXO S,RQB ; force a requeue
$RETT] ; We are done with this file
$DSCHD <TW.ACK!TW.ERR> ; Wait for gateway response
TXNN S,ABORT!LGA ; If flag set, quit now
JRST FILE.2
TXO S,RQB ;exiting - make sure requeue is set
$RETT ;pretend we copied file
FILE.2: TXNE S,CANCEL ; If cancel flag set,
JRST [TXZ S,QSRREQ!ACTIVE ; Indicate we no longer have a request
$RETF] ; Fail (DEVCHK will do actual cancel)
LOAD T1,,T.WCN ; Get conditions that caused us to wake
TXZE T1,TW.ERR ; If error response
JRST [$CALL ERRMSG ; Go process it
TXO S,RDA ; Must be something wrong with file
$RETT] ; We are done with this file
TXZN T1,TW.ACK ; If ACK, continue on
JRST CTSSTP ; otherwise die
$DSCHD <TW.RDD!TW.RDA> ; Wait for file transfer
TXNN S,ABORT!LGA ; If flag set, quit now
JRST FILE.3
TXO S,RQB ;exiting - make sure requeue is set
$RETT ;pretend we copied file
FILE.3: TXNE S,CANCEL ; If cancel flag set,
JRST [TXZ S,QSRREQ!ACTIVE ; Indicate we no longer have a request
$RETF] ; Fail (DEVCHK will do actual cancel)
LOAD T1,,T.WCN ;get conditions which caused us to wake
TXZE T1,TW.RDA ;if error response
JRST [TXO S,RDA ; Force job termination
$RETT] ; We are done with this file
TXZN T1,TW.RDD ; If success, continue on
JRST CTSSTP ; otherwise die
$RETT
SUBTTL Tasks -- . NXTFIL, advance to next file in job
; Routine - NXTFIL
;
; Function - Advances P2 and P3 to the next file-spec in the QUASAR request
;
; Parameters - P2 must point to current parameter area of FDB within request.
;
; Returns - P2 on true points to next parameter area, P3 to next FDB
; true if another file to process, false otherwise
;
; Note - destroys S1, decrements file count (T.FLN), sets T.LFS if
; log-file spec encountered.
COMMENT &
This routine advances the pointer to the current file
(kept in P2 and P3) to point to the next file-spec in the request sent
by QUASAR; if the next specification is for a log-file, it
saves its address (at T.LFS) and goes to the next one.
If there are no more, it returns false.
&
NXTFIL: ;subroutine to advance P2 to next file spec
SOSG T%NFL ;decrement count of files
$RETF ;if no more, return false
AOS T%NFP ;If more, count one more done.
LOAD S1,.FPLEN(P2),FP.LEN ;get length of the file parameter area
ADD P2,S1 ;advance to next FDB
LOAD S1,.FDLEN(P2),FD.LEN ;get length of FDB
ADD P2,S1 ;advance to next parameter area
LOAD S1,.FPLEN(P2),FP.LEN ;get length of parameter area
MOVE P3,P2 ;copy address of parameter area
ADD P3,S1 ;set up P3 to point to FDB
; LOAD S1,.FPINF(P2),FP.FLG ;get log-file flag
LOAD S1,,T.NFL ;?? get number of files left
SUBI S1,1 ;?? if just 1, we have real file
JUMPN S1,.RETT ;return if not log file
STORE P2,,T.LFS ;save log-file address for later
JRST NXTFIL ;and go get next real spec (if any)
SUBTTL Tasks -- TKHCDP, Card Punch
SUBTTL Tasks -- TKHLPT, Line Printer
; Task - TKHCDP, TKHLPT
;
; Function - To service line-printer and card-punch streams.
TKHCDP:
TKHLPT:
LOAD S1,,W.STS ; Get status
TXC S1,W.CON!W.WON ; check both link up and station on
TXCN S1,W.CON!W.WON ; Put em back and skip if not both on
JRST TKLPT0 ; Go immediately to initialize
MOVEI S1,[ASCIZ /Waiting for LOGON to IBM/]
STORE S1,,T.DST ; State for status message
$DSCHD TW.WON,0 ; Wait for workstation to come on
TKLPT0: $CALL DEVCHK ; check if everything OK
$CALL INITSK ; Initialize task
TKLPT1: MOVEI S1,[ASCIZ /Idle/] ; Get state
STORE S1,,T.DST ; and save it for status
$DSCHD TW.XFI ; Wait for activity
$CALL DEVCHK ; check if workstation still viable
LOAD T1,,T.WCN ; Get conditions that caused us to wake
TXZN T1,TW.XFI ; If transfer initiated, proceed
JRST TKLPT1 ; otherwise, go back and wait
$CALL LPTJOB ; Call common routine to process file
$CALL DEVCHK
JRST TKLPT1 ; No, go back and look for more work
SUBTTL Tasks -- . LPTJOB, process printer job
; Routine - LPTJOB
;
; Function - Sets task ACTIVE bit and waits for transfer to complete.
; Task will be signalled with transfer complete during special
; event message processing.
;
; Returns - Always true
;
LPTJOB: TXO S,ACTIVE ; Device is active
MOVEI S1,[ASCIZ /receiving file from IBM/]
STORE S1,,T.DST ; Save status for display messages
$CALL I%NOW ; Get starting time
STORE S1,,T.TMS ; Save it in task starting time
$DSCHD <TW.RDD!TW.RDA> ; Wait for transfer to complete
TXZ S,ACTIVE ; Device no longer active
$RETT ; Return
SUBTTL Tasks -- TKHCNI, Console Input to IBM
; Task - TKHCNI
;
; Function - To take entries from the console input queue and send them
; down the console input pipe.
TKHCNI: ;Here to send console input to IBM
MOVEI S1,[ASCIZ /Waiting to send console input/];get state
STORE S1,,T.DST ;and make it visible
$DSCHD TW.CNI,0 ; Wait for some
MOVEI S1,[ASCIZ /Sending console input/];our new state
STORE S1,,T.DST ; in the usual place
$CALL PUTCNI ; use the worker fcn
$CALL DEVCHK ; check if line is viable
JUMPF TSKDIE ; no - expire gracefully
JRST TKHCNI ; and try to continue
SUBTTL Subroutines -- Initialization and Main Loop subroutines
SUBTTL Subroutines -- . OPDINI, Get operating system information
; Routine - OPDINI
;
; Function - Gets central site node number and monitor name
;
; Parameters - None
;
; Returns - True always
; CNTSTA is set to node number
; CNF is set to monitor name
;
; Note - Destroys T1-T3
OPDINI: ;operating system dependent
; initialization
TOPS10 <
CNFDSP==(%CNFG0) ;get displacement
CNFDSP==CNFDSP&RHMASK ; of first word in table
MOVE T3,[XWD -SYSNML,CNFDSP] ;LH=number of words to get,
; RH=first index for GETTAB
OPDIN1: MOVEI T2,.GTCNF ;get table number in RH
HRL T2,T3 ;get current index in LH
GETTAB T2, ;get that word into T2
SETZ T2, ;no GETTAB, no monitor name
MOVEM T2,CNF-CNFDSP(T3) ;put the word into the proper place in CNFG
; (the -CNFDSP is only necessary in
; case its value (now 0) changes
AOBJN T3,OPDIN1 ;loop control, index register advancement
; and index advancement for GETTAB
; in one instruction
MOVEI T1,.GTLOC ;table name for location
GETTAB T1, ;get central site number
SETZ T1, ;set to 0 if we don't have UUO
HRRZM T1,CNTSTA ;save it
>;End if TOPS10
TOPS20 <
SETZM CNTSTA ; set central site number to 0
$CALL I%HOST ; Get local node name
MOVEM S1,NODNAM ; Where nodename goes
MOVX R1,'SYSVER' ;get name of table
SYSGT ;convert into table number
HRLZ T1,R2 ;get table#,,0
MOVEI T2,SYSNML ;get number of words
OPDNI1: MOVS R1,T1 ;get n,,table#
GETAB ;get the entry
SETZ S1, ;use 0 if error
MOVEM S1,CNF(T1) ;store the result
CAILE T2,(T1) ;done enough?
AOJA T1,OPDNI1 ;no, go back for more
>;End if TOPS20
$RETT ;always return true
SUBTTL Subroutines -- . QUIESC, wait for tasks to settle
; Routine - QUIESC
;
; Function - Waits for all tasks to be idle
;
; Parameters - none (TK and WS must be set up)
;
; Returns - always .POPJ when all tasks are idle
;
; Note - Destroys S1, S2
;
QUIESC: ;here to wait for all tasks to
; exit gracefully (i.e. DSCHD for
; neither time nor bits)
$SAVE <P1,P2> ;get a couple of registers
MOVE P1,TK ;save original TK
QUILOP: SETZ P2, ;clear non-waiting count
LOAD TK,,W.FTK ;point to control task
LOAD TK,,T.PFW ;get first real task
JUMPE TK,QUIDON ;if no tasks, we are done
QUIES0: ;loop to check tasks
LOAD S2,,T.ATE ;point to active task list
JUMPE S2,[$CALL RELTKB ; Illegal, delete task
JRST QUILOP] ; and start over
LOAD S1,,A.WKT ;get wakeup time
JUMPN S1,QUIES2 ;if there, can't kill him yet
LOAD S1,,T.WKB ;get his wakeup bits
SKIPN S1 ;if none,
$CALL WAKTSK ; wake task up
QUIES2: AOS P2 ;indicate another task not ready
QUIES1: ;here if we cannot kill this
LOAD TK,,T.PFW ;get next task
JUMPN TK,QUIES0 ;if we got one, try to kill it
JUMPE P2,QUIDON ;if none not-waiting, we are finished
LOAD TK,,W.FTK ;point to control task (us)
$DSCHD 0,^D6 ;wait a couple of seconds
JRST QUILOP ;and try again
QUIDON: MOVEM P1,TK ;restore original TK
$RET
SUBTTL Subroutines -- IPCF message subroutines
SUBTTL Subroutines -- . SNDQSR, send a message to QUASAR
; Routine - SNDQSR
;
; Function - Gets system index flag, puts QUASAR's index in, puts length
; and address of message in, and calls C%SEND to send message
;
; Parameters - T1/ Address of message
;
; Returns - true if send succeeds
; false if not, S1/C%SEND error code
;
; Note - Destroys S1, S2
; Changes SAB (send argument block for C%SEND)
SNDOPR: SKIPA S1,[SP.OPR] ;here to send message to ORION
SNDQSR: ;here to send message to QUASAR
MOVX S1,SP.QSR ;get QUASAR's system PID index
TXO S1,SI.FLG ; and turn on flag to indicate we
; are using system PIDs
STORE S1,SAB+SAB.SI ;store in system index word of send
; argument block
SETZM SAB+SAB.PD ;clear the destination PID word
LOAD S1,.MSTYP(T1),MS.CNT ;get length of message from the header
STORE S1,SAB+SAB.LN ;and store in length word
STORE T1,SAB+SAB.MS ;store message address also
MOVEI S1,SAB.SZ ;put length of send argument block into
; parameter register
MOVEI S2,SAB ;and its address
$CALL C%SEND ;call GLXLIB routine to send message
$RET ; return results of C%SEND
QSRDTH: $STOP SQF,<Send to QUASAR failed> ; SNDQSR users can come here to die
; when they cannot tolerate failure
SUBTTL Subroutines -- . SNDBAK, IPCF reply to last sender
; Routine - SNDBAK
;
; Function - Gets PID from current message, puts it in header, puts length
; and address of message in and calls C%SEND to send message.
;
; Parameters - none
;
; Returns - True always
;
; Note - Destroys S1, S2
; Changes SAB (send argument block for C%SEND)
SNDBAK: ;here to send message back
SETZ S1, ;clear system PID indicator
STORE S1,SAB+SAB.SI ;store in system index word of send
; argument block
LOAD S2,MDBADR ;get MDB address
LOAD S1,MDB.SP(S2) ;get sender's PID
STORE S1,SAB+SAB.PD ;store it in the SAB
LOAD T1,MDB.MS(S2),MD.ADR ;get message address
LOAD S1,.MSTYP(T1),MS.CNT ;get length of message from the header
STORE S1,SAB+SAB.LN ;and store in length word
STORE T1,SAB+SAB.MS ;store message address also
MOVEI S1,SAB.SZ ;put length of send argument block into
; parameter register
MOVEI S2,SAB ;and its address
$CALL C%SEND ;call GLXLIB routine to send message
$RETT ;ignore errors
SUBTTL Subroutines -- . RSETUP, response to setup (to QUASAR)
; Routine - RSETUP
;
; Function - Builds a response to setup message in MSGBLK and sends it
; to QUASAR; if the response was not ok (%RSUOK set) it also
; disables the line (so that dial-up phone hangs up).
;
; Parameters - S1/ Condition code to return to QUASAR
;
; Returns - True if succeeds, dies otherwise
;
; Note - Destroys S1, S2, T1 and T2
; Changes contents of MSGBLK
RSETUP: ;subroutine to send response to setup
MOVE T2,S1 ;save condition code
MOVEI S1,RSU.SZ ;get length of this message
MOVEI S2,MSGBLK ;and start of where we want to build it
$CALL .ZCHNK ;zero out the message
STORE S1,.MSTYP(S2),MS.CNT ;store size
MOVX S1,.QORSU ;get message function code
STORE S1,.MSTYP(S2),MS.TYP ;save it in message also
MOVEI S1,SUP.TY(P1) ;get address of object block
MOVS S1,S1 ;get it into LH for BLT pointer
HRRI S1,RSU.TY(S2) ;get destination address in RH
BLT S1,RSU.TY+OBJ.SZ-1(S2) ;copy object block into message
STORE T2,RSU.CO(S2) ;store response code
MOVE T1,S2 ;get address of message for SNDQSR
$CALL SNDQSR ;go send message to QUASAR and return to caller
JUMPF QSRDTH ; die if can't do it
$RET ; return true
SUBTTL Subroutines -- . QRLSE, requeue/release (to QUASAR)
; Routine - QRLSE
;
; Function - Sends message to operator and then builds a release/requeue
; message for QUASAR.
;
; Parameters - none
;
; Returns - True always
;
; Note - Destroys S1, S2 and MSGBLK contents
QRLSE: ;send a requeue/release message to QUASAR
$WTOJ <End>,<^R/.EQJBB(J)/>,@T%OBA
MOVEI S1,MSBSIZ ;get size of message block
MOVEI S2,MSGBLK ; and its address
$CALL .ZCHNK ;zero it out
MOVEI T1,MSGBLK ;point to start of block
TXZE S,RQB ;are we requeuing the job?
JRST QRLSE0 ;yes, go set up for it
LOAD S1,.EQITN(J) ;get internal identification number (ITN)
STORE S1,REL.IT(T1) ;and put it into message
MOVX S1,REL.SZ ;load size of release message
MOVX S2,.QOREL ; and function for
JRST QRLSE1 ; common code
QRLSE0: ;here on job requeue
LOAD S1,.EQITN(J) ;get internal identification
STORE S1,REQ.IT(T1) ;save in message
LOAD S1,,T.NFP ;get number of files processed
STORE S1,REQ.IN+CKFIL(T1) ;store in message
MOVX S1,CKFREQ ;get requeue bit
STORE S1,REQ.IN+CKFLG(T1) ;store it in message
;don't set RQ.HBO in REQ.FL
MOVX S1,REQ.SZ ;get size of requeue message
MOVX S2,.QOREQ ; and function
QRLSE1: ;common code for requeue and release
STORE S1,.MSTYP(T1),MS.CNT ;save size
STORE S2,.MSTYP(T1),MS.TYP ; and function in header
MOVEI T1,MSGBLK ;get address of message
$CALL SNDQSR ;send it to QUASAR
JUMPF QSRDTH ; die if can't do it
$RET ;return true
SUBTTL Subroutines -- . INIXBA, set up single page buffer
INIXBA: ;get and setup T.XBA buffer
$CALL M%GPAG ;get a page from QUASAR
JUMPF @.POPJ ;propagate error if we cannot
STORE S1,,T.XBA ;store as transmission buffer
PJRST INIXBF ; and initialize rest
SUBTTL Subroutines -- . INIPAG, set up job pages
INIPAG: ;set up job pages if necessary
LOAD S1,S+T%ACS ;get task's status bits
TXNE S1,JVALID ;already set up?
$RETT ;yes, return
MOVEI S1,3 ;number of pages to acquire
$CALL M%AQNP ;get them
JUMPF .POPJ ;if we have error, return it
PG2ADR S1 ;convert page addr to real address
STORE S1,J+T%ACS ;save it as task's J register
LOAD S2,S+T%ACS ;get task's S register (flags)
TXO S2,JVALID ;set the J register valid bit
STORE S2,S+T%ACS ;and put it back
ADDI S1,1000 ;calculate address of 2nd page
STORE S1,,T.XBA ;store as device buffer address
ADDI S1,1000 ;get address of third page
STORE S1,,T.GBA ;store as log file page number 1
INIXBF: MOVEI S1,440700 ;default byte pointer is ASCII
HRLM S1,T%XBA ;save in LF of buffer address
MOVEI S1,1000*5 ;default number of bytes
STORE S1,,T.XBN ;save for later
$RETT
SUBTTL Subroutines -- Task control subroutines
SUBTTL Subroutines -- . MAKWS, Create a Workstation
; Routine - MAKWS
;
; Function - Tries to find the specified workstation (if it is already there)
; then creates an entry in the workstation list, initializes it, and
; loads WS with the address.
;
; Parameters - S1/ Station name (SIXBIT)
; P1/ QUASAR SETUP message pointer
;
; Returns - False if entry already exists or L%CENT fails to create one
; WS/ Address of Workstation
;
; Note - All registers preserved (except WS)
; Changes Workstation list "current" entry
MAKWS: ;subroutine to create a Workstation
$CALL FNDWS ;see if one already exists
JUMPT .RETF ;return false if it does
$SAVE <T1,T2,S1,S2> ;save some registers
MOVE T1,S1 ;copy station name
MOVE S1,WSNAM ;get name of Workstation list
$CALL L%LAST ;position to end of list
MOVE S1,WSNAM ;get name again
MOVX S2,W$SIZ ;get size of entry
$CALL L%CENT ;create entry
JUMPF .POPJ ;if it failed, propagate false return
MOVE WS,S2 ;get address of new Workstation
MOVEI S1,.OTSNA ; Get Object Type
STORE S1,,W.OTY ; Save in block
STORE T1,,W.ONO ; Save name of station in Workstation
MOVEI S1,W%NAM ; Get address for ASCIZ station name
HRLI S1,(POINT 7) ; Make a pointer
MOVEM S1,TEXTBP ; Save it
$TEXT (DEPBP,<^N/W%ONO/^0>) ; Save ASCIZ string
MOVE T1,SUP.GW(P1) ; Get Gateway name
STORE T1,,W.GW6 ; Save name of Gateway in Workstation
MOVEI S1,W%GWY ; Get address for ASCIZ gateway name
HRLI S1,(POINT 7) ; Make a pointer
MOVEM S1,TEXTBP ; Save it
$TEXT (DEPBP,<^N/W%GW6/^0>) ; Save ASCIZ string
HRLI T1,SUP.AN(P1) ; Get Access Name
HRRI T1,W%ACC ; Where to save it in Workstation
BLT T1,W$LOD-1(WS) ; Save it
HRLI T1,SUP.AB(P1) ; Get Node Attribute Block
HRRI T1,W%LOD ; Where to save it in Workstation
BLT T1,W$PAG-1(WS) ; Save it
MOVEI S1,-1 ; Indicate no
STORE S1,,W.NUM ; workstation number
$CALL L%CLST ;get a list handle
JUMPF MAKWS4 ;if we cannot, better undo this
STORE S1,,W.CNO ;save as console output queue
$CALL L%CLST ;get another list handle
JUMPF MAKWS4 ;if cannot, abort this
STORE S1,,W.CNI ;save as console input queue
$CALL M%GPAG ; Need 1 page for work space
JUMPF MAKWS4 ; If cannot, abort this
STORE S1,,W.ARG ; Save first part
ADDI S1,B$SIZ ; for argument block
STORE S1,,W.WRK ; Rest is work area
$RETT ; and return true
MAKWS4: ;here to delete WS entry and return
; false
SETZ WS,0 ;Workstation is not valid
MOVE S1,WSNAM ;point to WS list
$CALL L%DENT ;delete current entry
; (we just created it)
$RETF ;tell caller of error
SUBTTL Subroutines -- . BLDTSK, Create a task
; Routine - BLDTSK
;
; Function - Acquires a TKB (task block), links it into TKB chain (chain of
; tasks for a particular workstation), and initializes task registers.
;
; Parameters - WS/ Address of Workstation
; S1/ Type code for task
; S2/ Unit number for device (if applicable)
;
; Returns - If true: TK/ Address of task block
; If false: S1/ Error Code
;
; Note - Destroys S1 and S2
; Changes TKB chain for workstation
; Makes the new TKB current entry of list
BLDTSK: ;subroutine to build a task
$CALL .SAVET ;save the T's
DMOVE T1,S1 ;copy the parameters to them
SETZ TK,0 ;no task block created yet
CAIL S1,.TCTL ;make sure task/device type is
CAILE S1,.TSND ; within range
$STOP IDC,<Illegal task/device type code> ; No
LOAD S1,TSKNAM ;get handle for task list
MOVEI S2,T$SIZ ;and get size of TKB
$CALL L%CENT ;create an entry
MOVEI S1,%MSISR ;prepare for error return
JUMPF .POPJ ;if we cannot, return failure
MOVE TK,S2 ;let everyone know we have a new TKB!
MOVEI S1,-1+T%PDL ;get address of stack-1
HRLI S1,-TKPDLN ;put -length into LH
HRRZ T3,TSKTAB(T1) ;get 0,,entry address of task
PUSH S1,T3 ;and store it on top of stack
HRL T2,T1 ;get device/task type,,unit
MOVEM S1,P+T%ACS ;save stack pointer in task's ACs
MOVEM TK,TK+T%ACS ;as well as TK register
SETZ S1, ;zero task status bits
MOVEM S1,S+T%ACS ;store it
STORE T2,,T.DEV ;and also save type,,unit
STORE WS,WS+T%ACS ;save Workstation address for task
MOVEI S1,[ASCIZ /Initializing/];get initial device state
STORE S1,,T.DST ;and save it for checkpointers
HLRZ T1,T2 ;get 0,,type
CAIL T1,.TLPT ;if less than first device
CAILE T1,.TCDR ;or greater than last device
JRST BLDTS2 ; don't set device attributes
MOVE S1,SUP.TY(P1) ; Get object type from message
STORE S1,,T.OTY ; Store in task block
MOVE S1,SUP.UN(P1) ; Get object unit from message
STORE S1,,T.OUN ; Store in task block
MOVE S1,SUP.NO(P1) ; Get object node from message
STORE S1,,T.ONO ; Store in task block
MOVEI S1,T%OBJ ; Get address of object block
STORE S1,,T.OBA ; and store it away
LOAD S1,SIDTAB-.TLPT(T1) ;get starting stream ID
; for this device type
LOAD S2,,T.UNI ;get unit number
ADDI S1,-1(S2) ;make stream ID for this unit
STORE S1,,T.SID ;and save for later in TKB
MOVE T1,SUP.TY(P1) ; Get object type from message
CAIE T1,.OTBAT ; Is this a batch stream
JRST BLDTS0 ; No
MOVE S1,[ASCII/Batch/] ; Yes, get stream ID text
STORE S1,,T.SIT ; and save for later in TKB
$CALL INIPAG ; Set up job pages
MOVEI S1,%MSISR ; Prepare for error return
JUMPF BLDERR ; Cannot; return failure
JRST BLDTS2
BLDTS0: ; Here for LPT and CDP objects
MOVEI S1,SUP.AB(P1) ; S1 contains address of NOB
MOVE T1,NOBFLG(S1) ; Get flags
STORE T1,,T.FLG ; Save in task block
MOVEI T1,NOBDST(S1) ; Source of Stream ID text
HRLI T1,(POINT 7) ; Make a pointer
BLDTS1: ILDB T2,T1 ; Get a character
JUMPE T2,[MOVEI S1,%MSNDS ; If terminator, set error code
JRST BLDERR] ; and quit
CAIN T2," " ; Is it a blank?
JRST BLDTS1 ; Yes, keep looking
CAIN T2," " ; Is it a tab?
JRST BLDTS1 ; Yes, keep looking
; No, some string is here
MOVEI T1,T$SIT(TK) ; Destination for Stream ID text
MOVE T2,T1
HRLI T1,NOBDST(S1) ; Source of Stream ID text
BLT T1,DSTSIZ-1(T2) ; Move it
BLDTS2: ;here to link task in the WS's chain
LOAD S1,,W.LTK ;get last TKB in chain
JUMPN S1,BLDTS3 ;if there is one, go handle that
STORE TK,,W.LTK ;if none, its easy; store us as last
STORE TK,,W.FTK ;and first
JRST BLDTS4 ;and we are done
; (our link word is already 0)
BLDTS3: ;here to add when chain already exits
STORE TK,,W.LTK ;we are new last entry
Q==T.PFW ;mask ??
STORE TK,T$PFW(S1),Q ;store us in previous last's
; forward pointer
STORE S1,,T.PBK ;and point our backward pointer
; to previous last
BLDTS4: ;here when TKB attached to WS chain
$RETT ;take success return
;
; here if error building task after TKB acquired
;
BLDERR: PUSH P,S1 ;Save error code
LOAD S1,TSKNAM ;point to task list
$CALL L%DENT ;delete the entry we created
SETZ TK, ;and wipe out pointer to him
POP P,S1 ;return error code
$RETF ;take error return
;
; Task tables
; Entry format is type code (.Txxx where xxx is device)
; in LH, and first entry point of task in RH.
TSKTAB: XWD .TCTL,TKCTL ; Control task (must be first)
XWD .TLPT,TKHLPT ; Line printer task
XWD .TCDP,TKHCDP ; Card punch task
XWD .TCDR,TKCDR ; Card reader task
XWD .TCNI,TKHCNI ; Console input sender task
XWD .TCNO,TKERR ; Console output (not used)
XWD .TSND,TKSND ; Console output distributor
TKERR: ;dummy entry for illegal tasks
$STOP IT2,<Illegal task type for SNA-Workstation>
SIDTAB: ;table of stream IDs
EXP SI%PR1 ;stream ID for LPT 1
EXP SI%PU1 ;stream ID for CDP 1
EXP SI%RD1 ;stream ID for CDR 1
SUBTTL Subroutines -- . INITSK, initialize a device task
; Routine - INITSK
;
; Function -
;
; Parameters - TK/ Address of task block to initialize
;
; Returns - If true:
;
INITSK:
$SAVE <P1,S1,S2> ; Return these as is
LOAD S1,,T.TYP ; Get device type
CAIL S1,.TLPT ; If not a
CAILE S1,.TCDR ; device
$RETT ; all done
MOVEI S1,[ASCIZ /establishing stream to IBM/] ;get state
STORE S1,,T.DST ;and make it visible
$WBUSY ; Wait until workstation not busy
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD S2,,W.NUM ; Get workstation number
STORE S2,,B.NUM
MOVEI P1,1 ; Get a 1
LOAD S2,,T.FLG ; Get Special Flags
TXNE S2,NOBNTL ; Check /NOTRANSLATE
STORE P1,B$FLG(S1),B.BIN ; Set argument flag
TXNE S2,NOBSPL ; Check /SPOOL
STORE P1,B$FLG(S1),B.SPL ; Set argument flag
LOAD S2,,T.SID ; Get Stream ID
MOVEM S2,B$SID(S1) ; Save it
MOVEI S2,T$SIT(TK) ; Get Stream ID text
HRLI S2,(POINT 7) ; Make a pointer
MOVEM S2,B$SIP(S1) ; Save it
$CALL R%ASS## ; Assign stream
LOAD TF,,B.COD ; Get return code
JUMPF [$CALL ERRMSG ; If failed, go process error
TXO S,ABORT ; Set for task abort
$CALL DEVCHK] ; Go handle it
$DSCHD <TW.ACK!TW.ERR> ; Wait for gateway response
$CALL DEVCHK ; See if everything still viable
LOAD P1,,T.WCN ; Conditions which caused us to wake
TXZE P1,TW.ERR ; If error response
JRST [$CALL ERRMSG ; Go process it
TXO S,ABORT ; Set for abort
JRST DEVCHK] ; Go handle it
TXZN P1,TW.ACK ; If ACK, continue on
JRST CTSSTP ; otherwise die
TXO S,STREAM ; Flag that task has associated stream
MOVEI S1,%RSUOK ; Code for unit is OK
LOAD P1,,T.OBA ; Address of object block
SUBI P1,SUP.TY ; Dummy up for RSETUP
PJRST RSETUP ; Send "response to setup" and return
SUBTTL Subroutines -- . RELTKB, release task block
; Routine - RELTKB
;
; Function - Releases all storage associated with a task block, then deletes
; the task list entry for the block.
;
; Parameters - TK/ Task block address to be released
;
; Returns - True always
;
; Note - Destroys S1 and S2
; Stopcodes if any of the called routines fail
RELTKB: ;subroutine to release a task block
$SAVE <T1,T2> ;save some registers
$CALL TSKCUR ;make TK value current tast table entry
SKIPT ;skip error message if we succeed
$STOP RTT,<Couldn't find task to be released>
RELTK0: ;here to check for storage to release
LOAD S1,S+T%ACS ;get task's S
TXNN S1,JVALID ;is J set up to 3-page block?
JRST RELTK1 ;no, continue
LOAD S2,J+T%ACS ;yes, get address of 3-page block
ADR2PG S2 ;convert to page number
MOVEI S1,3 ;number of pages
$CALL M%RLNP ;release them all
JUMPF RELTKE ;stopcode if we get error
$CALL M%CLNC ;and delete them (why not?)
JUMPF RELTKE ;if we cannot, something must be VERY wrong
RELTK1: ;here to check for log pages
LOAD T2,,T.GCT ;get count of log pages in use
CAIG T2,1 ;is it only the first?
JRST RELTK3 ;yes, try next test
SOS T2 ;make into index
MOVEI T1,T%GBA ;get address of first entry
ADD T1,T2 ;make address of last entry
RELTK2: ;loop to delete log pages
LOAD S1,0(T1) ;get current entry
$CALL M%RPAG ;release the page
JUMPF RELTKE ;if we cannot, die
$CALL M%CLNC ;clean up working set
JUMPF RELTKE ;we couldn't?? ugh
SOS T1 ;decrement slot pointer
SOJG T2,RELTK2 ;loop till no more
RELTK3: ;here to check for active task list entry
LOAD T1,,T.ATE ;get pointer to ATL entry
JUMPE T1,RELTK6 ;if none, skip this business
LOAD S1,ATLNAM ;get name of list
$CALL L%FIRST ;get address of first entry
JUMPF RELTKE ;if none, we also blew it
RELTK5: ;loop looking for our entry
CAMN S2,T1 ;compare this entry with one from TKB
JRST RELTK7 ;if the same, delete it
$CALL L%NEXT ;find next one
JUMPF RELTKE ;blew it if none
JRST RELTK5 ; and try again
RELTK7: ;here to delete ATL entry
$CALL L%DENT ;delete the entry
JUMPF RELTKE ;if we cannot, die
RELTK6: ;here to de-link from WS chain
LOAD S1,,T.PFW ;get our forward pointer
LOAD S2,,T.PBK ; and backward pointer
MOVEI T1,T$PFW(S2) ;get normal destination of forward pointer
SKIPN S2 ;see if there really is a next TKB
MOVEI T1,W%FTK ;no, change destination to be list head
STORE S1,0(T1),LHMASK ;and store pointer to next TKB
MOVEI T1,T$PBK(S1) ;get normal dest (back pointer cell of next TKB)
SKIPN S1 ;see if there is a next TKB
MOVEI T1,W%LTK ;no, store it in Workstation instead
STORE S2,0(T1),RHMASK ;store pointer to previous WS
MOVE S1,TSKNAM ;get handle for task block list
$CALL L%DENT ;delete this entry
JUMPF RELTKE ;if cannot, die
$RETT ;and return
RELTKE: ;here on unexpected error
MOVE T1,1(P) ;get return PC from last call
$STOP ERT,<Unexpected error in RELTKB>
SUBTTL Subroutines -- . RELWS, Delete a Workstation
; Routine - RELWS
;
; Function - Deletes the Workstation pointed to by WS.
; was the last line on the port). Stopcodes if WS not in port chain or
; still has TKBS attached.
;
; Parameters - WS/ Address of Workstation
;
; Returns - False if L%DENT fails
;
; Note - Destroys S1
; Changes current entry of Workstation list and port list
RELWS: ;subroutine to release a Workstation
$SAVE <T1,S1,S2> ;save some registers
LOAD S1,,W.TKB ;get task chain
SKIPE S1 ;if zero, OK
$STOP TSQ,<Tasks still queued to Workstation on release>
LOAD S1,,W.ONO ;get station name
MOVE T1,WS ;save WS address
$CALL FNDWS ;make sure that it is the current entry
SKIPF
CAME T1,WS ;check that he found ours
$STOP NWS,<Error finding Workstation>
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD T1,,W.NUM ; Get Workstation number
STORE T1,,B.NUM
MOVEI T1,RS%CLR ; CLEAR State Code
MOVEM T1,B$OFF(S1) ; Save it
$CALL R%SWS## ; CLEAR the workstation
; we don't care if this fails
LOAD S1,,W.ARG ;get address of work page
$CALL M%RPAG ;release it
MOVE S1,WSNAM ;get handle for Workstation list
$CALL L%DENT ;delete this entry
$RET ;and return
SUBTTL Subroutines -- Search subroutines
SUBTTL Subroutines -- . FNDWS, Find Workstation
; Routine - FNDWS
;
; Function - Scan Workstation list to find one with specified node name.
;
; Parameters - S1/ Sixbit node name
;
; Returns - True: WS/ Workstation address
; False:WS/0, other registers preserved .. didn't find entry
;
; Note - "Current" entry for Workstation list is changed.
FNDWS: $SAVE <S1,S2,T1> ; Save parameter regs and a work reg
MOVE T1,S1 ; Copy port,,line
LOAD S1,WSNAM ; Get handle for WS list
SETZ WS,0 ; preset false exit value
$CALL L%FIRST ; Position it to the first entry
JUMPF .POPJ ; If none, propagate false return
; Loop to compare WS's against given node name
FNDWS1: CAMN T1,W$ONO(S2) ; Is this the right Workstation?
JRST FNDLOK ; Yes, go return it in WS
$CALL L%NEXT ; Advance to next WS
JUMPF .POPJ ; If none, propagate failure
JRST FNDWS1 ; else continue looking
; Here when we have found the WS we want
FNDLOK: LOAD WS,S2 ; Copy into Workstation register
$RETT ; and return true
SUBTTL Subroutines -- . FNDTSK, Find task from node name,dev,unit
; Routine - FNDTSK
;
; Function - Find Workstation for station name and then search for task
; associated with device/unit on the task chain given in the Workstation.
;
; Parameters - S1/ Station name
; S2/ Device,,unit
;
; Returns - False: if didn't find either Workstation or task block
; True: WS/ Workstation address
; TK/ Task block address
;
; Note - Changes "current" entry for line and task lists
FNDTSK: ;subroutine to find a set up TK
$CALL FNDWS ;find Workstation
JUMPF .POPJ ;if none, propagate failure
LOAD TK,,W.FTK ;get first task in Workstation chain
FNDTS1: ;loop to see if this is correct task
JUMPE TK,.RETF ;if none, exit false
CAMN S2,T%DEV ;compare with type,,unit
$RETT ;return true if the same
LOAD TK,,T.PFW ;get next entry in forward chain
JRST FNDTS1 ;else go looking some more
SUBTTL Subroutines -- . FNDSID, Find task from IBM stream ID
; Routine - FNDSID
;
; Function - Find task block for station name and then search for task
; associated with device/unit on the task chain given in the Workstation.
;
; Parameters - WS/ Workstation
; S2/ Stream ID
;
; Returns - False: if didn't find either Workstation or task block
; True: WS/ Workstation address
; TK/ Task block address
;
FNDSID: ;subroutine to find a set up TK
LOAD TK,,W.FTK ;get first task in Workstation chain
SKIPA
;loop to see if this is correct task
FNDSI1: LOAD TK,,T.PFW ;get next entry in forward chain
JUMPE TK,.RETF ;if none, exit false
LOAD T1,,T.TYP ;get device type
CAIL T1,.TLPT ;if less than first device
CAILE T1,.TCDR ;or greater than last device
JRST FNDSI1 ;keep looking
CAME S2,T%SID ;compare with stream ID
JRST FNDSI1 ;different, go look some more
$RETT ;return true if the same
SUBTTL Subroutines -- . TSKCUR, Make TK value current entry
; Routine - TSKCUR
;
; Function - Scans task (TSK) list for entry whose address is in TK.
;
; Parameters - TK/ Task block (TKB) address that is to be made "current".
;
; Returns - False: no entry on task list matches address in TK
;
; Note - Destroys S1, S2
; Sets TSK (task list) "current" pointer to specified task.
TSKCUR: ;subroutine to make TK current task
LOAD S1,TSKNAM ;get list handle
$CALL L%FIRST ;point to first entry
TSKCU0: ;loop looking at TSK list entries
JUMPF .POPJ ;propagate error if none there
CAMN S2,TK ;compare this entry with requested
$RETT ;return true if they are identical
$CALL L%NEXT ;point to next (if any)
JRST TSKCU0 ;and try again
SUBTTL Subroutines -- . FNDOBJ, Find task from QUASAR object block
; Routine - FNDOBJ
;
; Function - Scan TSK (task) list for one with the specified object type.
;
; Parameters - S1/ Object block address (GALAXY format)
;
; Returns - False: cannot find task with specified object type
; True: TK/ Task block address
; WS/ Workstation address
; J/ Job page address
;
; Note - Destroys S1, S2
FNDOBJ: ;subroutine to set up TK and J from object type
$CALL .SAVET ;save the temporary registers
; we will use them for the parts of the object type
LOAD T1,.ROBTY(S1) ;get type from object block
LOAD T2,.ROBAT(S1) ; and unit
LOAD T3,.ROBND(S1) ; and node
LOAD S1,TSKNAM ;get task list handle
$CALL L%FIRST ;position list to first entry
JUMPF .POPJ ;error return if none
FNDOB1: ;loop to compare object block in TKB with desired
; object block (T1-T3)
CAMN T1,T$OTY(S2) ;if type doesn't match
CAME T2,T$OUN(S2) ;or unit
JRST FNDOB2 ;go on to next entry
CAMN T3,T$ONO(S2) ;is node the same?
JRST FNDOB3 ;yes, go set up regs and exit
FNDOB2: ;here on mismatch to bump to next TKB
$CALL L%NEXT ;get next entry
JUMPT FNDOB1 ;if there is one, do compare again
$RETF ;propagate failure to caller
FNDOB3: ;here when match found
MOVE TK,S2 ;load pointer to task block
MOVE WS,WS+T%ACS ;get Workstation ptr
MOVE J,J+T%ACS ;and load address of job page
$RETT ;return true
SUBTTL Subroutines -- I/O subroutines
SUBTTL Subroutines -- . LOGCHR, put character in log
; Routine - LOGCHR
;
; Function - Stores character in log buffer. If no room, get another page
; until limit of LGNUM is reached, then starts throwing away characters.
;
; Parameters - S1/ Character to store
;
; Returns - True always
;
; Note - May change log file pointer, count, count of log pages
; and addresses of log pages.
FTCLOG <
LOGCHR: ;here to log a character
TXNN S,JVALID ; If no job pages set up,
$RET ; just return
CAIE S1,.CHLFD ;is it LF?
CAIN S1,23 ; or DC3?
INCR ,T.GLN ;yes, count another line
LOGCH1: ;here to put char in buffer
SOSGE T%GIC ;any room in buffer?
JRST LOGCH2 ;no, get a new buffer
IDPB S1,T%GIP ;yes, store character
$RETT ;and exit
LOGCH2: ;here to get another buffer and retry
; storing character
PUSH P,S1 ;save character
$CALL LOGBUF ;get another buffer
POP P,S1 ;get character back
JUMPT LOGCH1 ;if we succeeded, go store character
$RETT ;else throw it away
>; end FTCLOG
SUBTTL Subroutines -- . LOGBUF, get another log buffer
; Routine - LOGBUF
;
; Function - Gets another page and adds it to the log file buffer list.
;
; Parameters - none
;
; Returns - True if another buffer available
;
; Note - Changes buffer count, log character pointer and count.
FTCLOG <
LOGBUF: ;get another log buffer
$CALL .SAVE1 ;save P1
AOS P1,T%GCT ;increment count of buffers in use
CAIN P1,1 ;see if first time
JRST LOGBU0 ;yes, just initialize
CAIL P1,LGNUM ;if too many
JRST LOGBU2 ;signal error
PUSHJ P,M%GPAG ;get a page of memory
JUMPF LOGBU2 ;if cannot, set erroor
ADDI P1,-1(TK) ;calculate address
MOVEM S1,T$GBA(P1) ;and store in appropriate slot
CAIA ;skip next instruction
LOGBU0: LOAD S1,T$GBA(TK) ;load with address of first buffer
LOGBU1: ;here to initialize pointer and count and return
HRLI S1,(POINT 7,0) ;make a byte pointer
MOVEM S1,T%GIP ;save it
MOVEI S1,<5*1000-1> ;get count
MOVEM S1,T%GIC ;store it too
$RETT
LOGBU2: ;here if we cannot do it
SOS T%GCT ;decrement count again
SETZM T%GIC ;and zero count
$RETF ;before returning false
>; end FTCLOG
SUBTTL Subroutines -- . PUTCNI, send console input to IBM
; Routine - PUTCNI
;
; Function - sends all console msg queued up to IBM,then does an EOF to
; clear the output state.
;
; Parameters - task context, gets msgs from W.CNI queue
; P1/device handle
;
; Returns - TRUE unless a D60JSY error occurs
;
; Note: mungs S1,S2,T1,T2
PUTCNI: LOAD S1,,W.CNI ; Get handle for CNI queue
$CALL L%FIRST ; Point to first entry
SKIPT ; make sure there is something to do
$RETT
; loop to process console messages to IBM
PUTCI0: MOVE T2,S2 ; Save msg address
$WBUSY ; Wait until workstation not busy
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD S2,,W.NUM ; Get workstation number
STORE S2,,B.NUM
HRRZI S2,1(T2) ; Point to start of data
HRLI S2,(POINT 7) ; Make a byte pointer
MOVEM S2,B$CIN(S1) ; Save it
$CALL R%CIN## ; Send message
LOAD TF,,B.COD ; Get return code
JUMPF [$CALL ERRMSG ; Go report it
JRST PUTCI1] ; On to next message
$DSCHD <TW.ACK!TW.ERR> ; Wait for gateway response
$CALL DEVCHK ; See if everything still viable
LOAD P1,,T.WCN ; Conditions which caused us to wake
TXZE P1,TW.ERR ; If error response
JRST [$CALL ERRMSG ; Go report it
JRST PUTCI1] ; On to next message
TXZN P1,TW.ACK ; If ACK, continue on
JRST CTSSTP ; otherwise die
PUTCI1: LOAD S1,,W.CNI ; Get list handle
$CALL L%DENT ; Delete this entry
$CALL L%NEXT ; and on to next
JUMPT PUTCI0 ; if any
$RET ; return whatever
SUBTTL Subroutines -- . PUTCNO, put a record into CNO queue
; Routine - PUTCNO
;
; Function - Copies record into entry in CNO (console output) queue for
; SND (console sending) task. Signals SND task that it has something
; to process.
;
; Parameters - WS/ Address of Workstation
;
; Returns - True always
;
; Note - Destroys S1, S2
PUTCNO: ;subroutine to put records into console
; output queue
$SAVE <T1,T2,T3> ;preserve these registers
LOAD S1,,W.ARG ;Address of argument block
LOAD T1,,B.DAT ;Address of data
LOAD T2,,B.DSZ ; and data size
JUMPLE T2,PUTCN2 ;if no data, just do EOF processing
ADDI T2,5 ;fudge to byte count
IDIVI T2,5 ; and calculate number of words
PUTCN1: ;here to create CNO entry
MOVE S2,T2 ;get length
LOAD S1,,W.CNO ; and list handle
$CALL L%CENT ;create an entry
JUMPF PUTCND ;if we fail, go wait and try later
HRL S2,T1 ;make BLT word
HRRI S1,-1(S2) ;get address before destination
ADD S1,T2 ; and add length for end of BLT
BLT S2,(S1) ;send all of it
;here when done copying data into entry
MOVE T3,TK ;save TK
LOAD S1,,W.ONO ; Get station name
HRLZI S2,.TSND ; type,,number
$CALL FNDTSK ;find it
$SIGNL TW.CNO,TASK ;wake task
MOVE TK,T3 ;restore task pointer
PUTCN2: ;here when all done
$RETT ;and return
PUTCND: ;here to delay and try again
$DSCHD 0,^D10 ;wait three seconds
JRST PUTCN1 ; and try again
SUBTTL Subroutines -- Gateway message subroutines
SUBTTL Subroutines -- . ERRMSG, process an ERROR message
; Routine - ERRMSG
;
; Parameters - WS/ Address of Workstation
;
; Returns - true
;
ERRMSG:
$SAVE <S1,S2> ; Return these as is
LOAD S1,,W.ARG ; Address of argument block
LOAD S2,,B.DAT ; Address of data
LOAD S1,,B.DSZ ; Size of data
$CALL MSGERR## ; Format a message
$WTOJ <Gateway Error>,<^T/@S1/>,W%OBJ
$RETT
SUBTTL Subroutines -- . EVTMSG, process an EVENT message
; Routine - EVTMSG
;
; Parameters - WS/ Address of Workstation
;
; Returns - true
;
EVTMSG:
$SAVE <S1,S2,P1> ; Return these as is
MOVEI P1,W%OBJ ; Get object block for workstation
LOAD S2,,B.DAT ; Address of data
LOAD S1,,B.DSZ ; Size of data
$CALL MSGEVT## ; Format a message
$WTOJ <Gateway Event>,<^T/@S1/>,@P1
$RETT
SUBTTL Subroutines -- . EVTSPC, process a special event
; Routine - EVTSPC
;
; Function - This routine checks for special Gateway Event Messages
; that require additional processing.
;
; Parameters - WS/ Address of Workstation
;
; Returns - true
;
EVTSPC: $SAVE <S1,S2,T1,T2> ; Return these as is
LOAD S1,,B.DAT ; Address of data
MOVSI S2,-EVTTND ; Make AOBJN pointer to table
EVTS.1: HRRZ T1,EVTTAB(S2) ; Get special event from table
CAMN T1,(S1) ; A match
JRST [HLRZ T1,EVTTAB(S2) ; Yes, get dispatch address
JRST @T1] ; and branch
AOBJN S2,EVTS.1 ; Keep looking
$RETT ; Return if no match
;
; Table of sepcial events
;
EVTTAB: XWD EVTSTA,M00048## ; Stream started
XWD EVTABO,M00026## ; Stream aborted
XWD EVTABO,M00023## ; File open failed
XWD EVTABO,M00024## ; File read failed
XWD EVTABO,M00030## ; File write failed
XWD EVTEND,M00046## ; Stream ended
XWD EVTLGN,M00052## ; Received UNBIND
XWD EVTLGN,M00050## ; Unexpected line condition
XWD EVTDEA,M00054## ; Stream deactivated
EVTTND==.-EVTTAB ; Size of table
SUBTTL Subroutines -- . EVTSTA, process a stream started event
; Routine - EVTSTA
;
; Function - This routine signals the associated task that a
; data transfer on this stream has started.
;
; Parameters - WS/ Address of Workstation
; S1/ Address of Data Block
;
; Returns - true
;
EVTSTA: LOAD S2,,W.ARG ; Address of argument block
MOVE S2,B$SID(S2) ; Get stream ID that was returned
$CALL FNDSID ; Get associated task
JUMPF .POPJ ; Return if no match
MOVE T2,4(S1) ; Get byte pointer in T2
ILDB S1,T2 ; Get char count in S1
MOVEI T1,T$CFS(TK) ; Address where file spec goes
HRLI T1,(POINT 7) ; Make a byte pointer
E.STA1: SOSGE S1
JRST E.STA2 ; All done here
ILDB S2,T2 ; Get a byte
IDPB S2,T1 ; Store it
JRST E.STA1
E.STA2: SETZ S2,0 ; Ensure an ASCIZ
IDPB S2,T1 ; string
LOAD T1,,T.TYP ; Get device type
CAIN T1,.TCDR ; If a card reader
$RETT ; All done
$SIGNL TW.XFI ; LPT / CDP output has started
$RETT
SUBTTL Subroutines -- . EVTABO, process a stream aborted event
; Routine - EVTABO
;
; Function - This routine signals the associated task that the
; data transfer on this stream has been aborted.
;
;
; Parameters - WS/ Address of Workstation
; S1/ Address of Data Block
;
; Returns - true
;
EVTABO: LOAD S2,,W.ARG ; Address of argument block
MOVE S2,B$SID(S2) ; Get stream ID that was returned
$CALL FNDSID ; Get associated task
JUMPF .POPJ ; Return if no match
ZERO ,T.CFS ; Clear current file spec
LOAD T1,,T.TYP ; Get device type
CAIN T1,.TCDR ; If a reader,
$RETT ; quit now.
$SIGNL <TW.RDA> ; Otherwise, signal transfer aborted
$RETT ; Return
SUBTTL Subroutines -- . EVTEND, process a stream ended event
; Routine - EVTEND
;
; Function - This routine signals the associated task that the
; data transfer on this stream has completed.
;
; Parameters - WS/ Address of Workstation
; S1/ Address of Data Block
;
; Returns - true
;
EVTEND: LOAD S2,,W.ARG ; Address of argument block
MOVE S2,B$SID(S2) ; Get stream ID that was returned
$CALL FNDSID ; Get associated task
JUMPF .POPJ ; Return if no match
ZERO ,T.CFS ; Clear current file spec
LOAD T1,,T.TYP ; Get device type
CAIN T1,.TCDR ; If a reader,
$RETT ; quit now.
$SIGNL <TW.RDD> ; Otherwise, signal transfer completed
$RETT ; Return
SUBTTL Subroutines -- . EVTLGN, process IBM link gone
; Routine - EVTLGN
;
; Function - This routine signals the control task that the
; communication link is no longer available.
;
; Parameters - WS/ Address of Workstation
; S1/ Address of Data Block
;
; Returns - true
;
EVTLGN: LOAD TK,,W.FTK ; Get control task TKB pointer
$CALL ACTTSK ; Activate control task
$SIGNL TW.LGN ; Signal it, link has gone
$RETT
SUBTTL Subroutines -- . EVTDEA, process a stream deactivated event
; Routine - EVTDEA
;
; Function - This routine sets the ABORT bit for a task when the
; Gateway sends an event message indicating that the
; stream has been deactivated
;
; Parameters - WS/ Address of Workstation
; S1/ Address of Data Block
;
; Returns - true
;
EVTDEA: LOAD S2,,W.ARG ; Address of argument block
MOVE S2,B$SID(S2) ; Get stream ID that was returned
$CALL FNDSID ; Get associated task
JUMPF .POPJ ; Return if no match
MOVE S1,S+T%ACS ; Get task's S
TXO S1,ABORT ; Set flag
MOVEM S1,S+T%ACS ; and put status back
$CALL WAKTSK ; No, wake task
$RETT
SUBTTL Subroutines -- Task Control Subroutines
SUBTTL Subroutines -- . DEVCHK, Check device status
; Routine - DEVCHK
;
; Function -
; Called to return status information
;
; Parameters - WS/ address of Workstation
;
; Returns - True: unless line goes away
; S1/ Workstation status word (W.STS)
;
DEVCHK: LOAD S1,,W.STS ; Get Workstation status bits
TXNN S1,W.WON ; Workstation still "on"?
JRST TSKDIE ; No, go kill off this task
TXZE S,CANCEL ; Are we cancelling this job
PJRST ABTDEV ; Yes, clear flag and go do it
TXNE S,ABORT ; Are we aborting?
JRST TSKDIE ; Yes, go kill off this task
TXNE S,SHUTDOWN ; Are we shutting down?
TXNE S,ACTIVE ; Yes, only do it if not active
$RETT ; Things seem to be ok
JRST TSKDIE ; Go kill off this task
SUBTTL Subroutines -- . TSKDIE, Kill off a task
;
; This is where tasks jump when settling down to be killed off.
;
TSKDIE: TXNN S,STREAM ; Is there a STREAM
JRST TSKD.1 ; No
; Yes, Deassign it
TXNE S,LGA ; If link already gone,
JRST TSKD.1 ; don't even try
$DSCHD (,3) ; Unconditionally wait for 1 second
; before sending RJ$DAS. This
; prevents a race condition with V1.2
; of Gateway.
;
$WBUSY ; Wait until workstation not busy
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD S2,,W.NUM ; Get workstation number
STORE S2,,B.NUM
LOAD S2,,T.SID ; Get Stream ID
MOVEM S2,B$SID(S1) ; Save it
$CALL R%DAS## ; Deassign stream
LOAD TF,,B.COD ; Get return code
JUMPF [$CALL ERRMSG ; If failed, go process error
JRST TSKD.1] ; Go handle it
$DSCHD <TW.ACK!TW.ERR> ; Wait for gateway response
; We don't care what wakes us
TSKD.1: MOVEI S1,%RSUDE ; Code for device doesn't exist
LOAD P1,,T.OBA ; Get address of object block
JUMPE P1,TSKD.2 ; Send no response if no object block
SUBI P1,SUP.TY ; Dummy up for RSETUP
$CALL RSETUP ; Send response to setup
TSKD.2: $CALL RELTKB ; Release task block
$DSCHD DELETE
$STOP KTR,<Killed task was reincarnated>
SUBTTL Subroutines -- . ABTDEV, Abort IO stream on a device
; Routine - ABTDEV
;
; Function - sends appropriate stream abort to IBM
;
; Parameters - P1/device handle
;
; Returns - nothing of particular interest
ABTDEV: TXNE S,LGA ; If link already gone,
$RET ; don't even try
$WBUSY ; Wait until workstation not busy
MOVEI S1,B$SIZ ; S1 is size of argument block
LOAD S2,,W.ARG ; S2 Points to argument block
$CALL .ZCHNK ; Initialize ARGBLK
MOVE S1,S2 ; S1 points to argument block
LOAD S2,,W.NUM ; Get workstation number
STORE S2,,B.NUM
LOAD S2,,T.SID ; Get Stream ID
MOVEM S2,B$SID(S1) ; Save it
$CALL R%SAB## ; Abort stream
LOAD TF,,B.COD ; Get return code
JUMPF [$CALL ERRMSG ; If failed, go process error
$RET]
$DSCHD <TW.ACK!TW.ERR> ; Wait for gateway response
$CALL DEVCHK ; See if everything still viable
LOAD S1,,T.WCN ; Get conditions that caused us to wake
TXZE S1,TW.ERR ; If error response
$CALL ERRMSG ; report it
$RET
SUBTTL Subroutines -- Miscellaneous subroutines
SUBTTL Subroutines -- . TRANSX, process character translation file
; This module reads in a rel file that contains
; ASCII/EBCDIC to EBCDIC/ASCII translation information
; and formats the data in to two translation tables
; in the form of
; 0/ 0,,1
; 1/ 2,,3
; ect. with two bytes per word. The two tables are each
; 128 words, the first table is for EBCDIC to ASCII,
; the second ASCII to EBCDIC. It directly follows the
; first in memory, so that 256 words of storage in all
; are needed.
;
; This module accepts the address of the FD of the rel
; file in S1, and the address of the 256 word buffer to
; deposit the resulting table in S2.
;
; Error codes are returned in S1 with TF set accordingly.
; On error, S2 contains address of ITEXT string of error message
;
TRANSX: $SAVE <T1,T2,T3>
MOVE T3,S2 ; Save the buffer address
MOVEM S1,FOB ; Put FD FOB
MOVEI T1,^D36 ; Byte Size
MOVEM T1,FOB+1 ; Store in the FOB
MOVEI S1,2 ; SIZE OF FOB
MOVEI S2,FOB ; Address of FOB
$CALL F%IOPN## ; open the source file
JUMPF BADOPN ; Any error is fatal
$CALL F%IBYT## ; Get a BYTE
JUMPF BADOPN ; Any error is fatal
CAME S2,[XWD 4,0] ; Must be a type 4 REL blk
JRST BADFIL ; Any error is fatal
MOVEI S2,6 ; Skip over the crud
MOVE T1,S1 ; Save IFN
$CALL F%POS## ; Position to the correct word
JUMPF BADFIL ; Any error is fatal
MOVE S1,T1 ; Restore IFN
SETZ T2,T1
BLOOP: $CALL F%IBYT## ; Get the count
JUMPF BADFIL ; Any error is fatal
HRRZ T1,S2
SOS T1 ; Have to adjust the count
ADD T2,T1 ; Update count
$CALL F%IBYT## ; Skip over Rel
JUMPF BADFIL ; Any error is fatal
$CALL F%IBYT## ; block info
JUMPF BADFIL ; Any error is fatal
LOOP: $CALL F%IBYT## ; Get a Byte (36-bits)
JUMPF BADFIL ; Any error is fatal
MOVEM S2,(T3) ; Store in the buffer
CAIL T2,^D256 ; Done with table?
JRST DONE ; Yes
AOS T3 ; Up the index
SOJG T1,LOOP ; A Word a a time
JRST BLOOP
DONE: $CALL F%IBYT## ; Get a BYTE
JUMPF BADFIL ; Any error is fatal
HLRZ S2,S2 ; Ignore count field
CAIE S2,2 ; Must be a type 2 REL blk
JRST BADFIL ; Any error is fatal
$CALL F%REL## ; all done
$RETT
;
; TRANSX Error Processing
;
BADOPN: MOVEI S2,[ITEXT(^M^J^E/S1/)] ; Galaxy error code
$RETF
BADFIL: MOVEI S2,[ITEXT(^M^Jfile is not a valid translation table)]
$RETF
SUBTTL Subroutines -- . TBFINI, initialize task IO buffer
; Routine - TBFINI
;
; Function - initialize task IO buffer
;
; Parameters - TK/task block ptr
;
; Returns - TRUE always
TBFINI: SETZM T$DIC(TK)
SETZM T$RIC(TK)
MOVE S1,T$RIA(TK)
HLL S1,T%XBA
MOVEM S1,T$RIP(TK)
LOAD S1,,T.XBA
STORE S1,,T.XRP
LOAD S1,,T.XBN
STORE S1,,T.XRC
$RETT
SUBTTL Subroutines -- . INIJOB, initialize a job
; Routine - INIJOB
;
; Function - initialize a job
;
; Parameters - TK/task block ptr
;
; Returns -
INIJOB: SETZM T$GIC(TK)
SETZM T$NFP(TK) ;set no files processed
POPJ P,
SUBTTL Subroutines -- . MISLP, sleep for specified time
; Routine - MISLP
;
; Function - sleep for a specified amount of time
;
; Parameters - S1/no. of seconds
;
; RETURNS - TRUE always
MISLP: IMULI S1,3 ;sleep for a while in spite of interrupts
PUSH P,S1
$CALL I%NOW ; get now
ADDM S1,(P) ; keep wake time on pdl
MISLP1: $CALL I%NOW ; get new now
SUB S1,(P) ; find out how long to go
MOVNS S1 ; forwards
JUMPLE S1,MISLPX ; done
IDIVI S1,3 ; make seconds
SKIPE S2
AOS S1 ; at least 1
$CALL I%SLP ; try to sleep the whole time
JRST MISLP1
MISLPX: POP P,S1 ; time to awake
$RETT
SUBTTL Debugger -- DEBUG, Output debugging messages
; Routine - DEBUG
;
;
DEBUG: MOVE S1,135 ; Get debugging flags
TXZN S1,DB.TSK ; Check task trace flag and clear it
PJRST DBGTRC ; Check for other debugging flags
MOVEM S1,135 ; Restore DEBUG word
$TEXT (,<Active Task List>) ; Begin Task Trace Debugging
MOVE S1,ATLNAM ; Index of ATL
$CALL DBGATL
$TEXT (,<^M^JTask List>)
MOVE S1,TSKNAM ; Index of Task List
$CALL DBGLST
PJRST DBGTRC ; Check for other debugging flags
SUBTTL Debugger -- . DBGLST Output Task List
;
; $CALL with S1 containing list index
;
DBGLST:
$CALL L%FIRST ; Get first entry in list
JUMPF .POPJ ; Return if no entry
DBGL1: MOVE TK,S2 ; Set up Task Block Address
$TEXT (,<^M^J Task at: ^O/TK/>)
LOAD T1,,T.TYP ; Get task type,,unit number
$TEXT (,< Task type: ^O/T1/>)
LOAD T1,,T.DST ; Get address of task state string
$TEXT (,< State: ^T/0(T1)/>)
$CALL L%NEXT ; Get next entry
JUMPT DBGL1 ; If one, loop for processing
$RET ; Otherwise, wrap it up
SUBTTL Debugger -- . DBGATL Output ATL
;
; $CALL with S1 containing list index
;
DBGATL:
$CALL L%FIRST ; Get first entry in list
JUMPF .POPJ ; Return if no entry
DBGA1: LOAD TK,,A.TKB ; Set up Task Block Address
$TEXT (,< Task at: ^O/TK/>)
$CALL L%NEXT ; Get next entry
JUMPT DBGA1 ; If one, loop for processing
$RET ; Otherwise, wrap it up
SUBTTL Debugger -- . DBGTRC Set DECnet message trace
;
;
;
DBGTRC: MOVE S1,135 ; Get debugging flags
TXNN S1,DB.TRC ; Check trace flag
$RET
$RET
SUBTTL Literals
RJELIT: XLIST
LIT
LIST
RJEEND:
END RJESPL
; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Start:;
; Comment Begin:;
; Word Abbrev Mode:1
; End: