Trailing-Edge
-
PDP-10 Archives
-
tops20_version7_0_monitor_sources_clock
-
monitor-sources/cludgr.mac
There are 13 other files named cludgr.mac in the archive. Click here to see a list.
; UPD ID= 8696, RIP:<7.MONITOR>CLUDGR.MAC.30, 12-Apr-88 14:51:01 by RASPUZZI
;TCO 7.1273 - Don't wake up forks that are waiting for a response from another
; system (the one not crashing). Sure, have another wine cooler.
; UPD ID= 8690, RIP:<7.MONITOR>CLUDGR.MAC.29, 24-Mar-88 14:19:20 by RASPUZZI
;TCO 7.1262 - Prevent XBLTALs again by putting our port number in the SCA
; buffers and not the node we are sending to.
; UPD ID= 8687, RIP:<7.MONITOR>CLUDGR.MAC.28, 17-Mar-88 19:27:37 by RASPUZZI
;TCO 7.1259 - Make call to LCLWAT scheduler test be right.
; UPD ID= 8678, RIP:<7.MONITOR>CLUDGR.MAC.27, 4-Mar-88 19:39:06 by RASPUZZI
;Fix mishandling of the SCA buffers when more than one comes in as a
;response for the CLRCVQ. This never worked. Also, clean up some gross
;code.
; UPD ID= 8672, RIP:<7.MONITOR>CLUDGR.MAC.26, 1-Mar-88 15:23:29 by RASPUZZI
;TCO 7.1247 - Add some DEBUG code to ensure that CLUID is used once.
; UPD ID= 8669, RIP:<7.MONITOR>CLUDGR.MAC.25, 26-Feb-88 08:50:26 by RASPUZZI
;Remove code that no longer has any meaning.
; UPD ID= 8668, RIP:<7.MONITOR>CLUDGR.MAC.24, 25-Feb-88 18:27:46 by RASPUZZI
;Make CLUID obtainment be one instruction.
; UPD ID= 8491, RIP:<7.MONITOR>CLUDGR.MAC.23, 9-Feb-88 12:17:58 by GSCOTT
;TCO 7.1218 - Insert copyright notice.
; UPD ID= 8461, RIP:<7.MONITOR>CLUDGR.MAC.22, 5-Feb-88 09:38:49 by GSCOTT
;TCO 7.1210 - Set CLDISC, CLUCON, and CLUNFE normally not dumpable.
; UPD ID= 8424, RIP:<7.MONITOR>CLUDGR.MAC.21, 4-Feb-88 13:24:59 by RASPUZZI
;TCO 7.1212 - Prevent ILMNRFs on remote systems by making sure that when
; this system can't make a request block, we tell the remote
; system there was an error here (light CL%ERR in PUNTIT).
; UPD ID= 8400, RIP:<7.MONITOR>CLUDGR.MAC.20, 2-Feb-88 14:55:34 by RASPUZZI
;TCO 7.1205 - Fix all IMCALLs for JSYSes that now exist in XCDSEC.
; UPD ID= 8387, RIP:<7.MONITOR>CLUDGR.MAC.19, 27-Jan-88 10:30:09 by GSCOTT
;TCO 7.1200 - GETRTL is now in XCDSEC.
; UPD ID= 306, RIP:<7.MONITOR>CLUDGR.MAC.18, 19-Nov-87 14:52:30 by RASPUZZI
;TCO 7.1141 - When ACJ denies an INFO% request, make sure we ITERR from
; section 1 right away.
; UPD ID= 304, RIP:<7.MONITOR>CLUDGR.MAC.17, 17-Nov-87 16:21:56 by RASPUZZI
;Fix problem in INFALO. Local test is not succeeding.
; UPD ID= 303, RIP:<7.MONITOR>CLUDGR.MAC.16, 17-Nov-87 13:51:53 by RASPUZZI
;User right test when checking for GALAXY jobs.
; UPD ID= 297, RIP:<7.MONITOR>CLUDGR.MAC.15, 14-Nov-87 11:52:42 by RASPUZZI
;When asking ACJ, use global job number.
; UPD ID= 279, RIP:<7.MONITOR>CLUDGR.MAC.14, 10-Nov-87 14:59:58 by RASPUZZI
;TCO 7.1121 - Move CLDISC, CLUCON and CLORBF under CIBUGX.
; UPD ID= 257, RIP:<7.MONITOR>CLUDGR.MAC.13, 5-Nov-87 14:42:58 by RASPUZZI
;TCO 7.1114 - Prevent ILMNRFs, KLPHOGs and various sundries of RELxxx BUGHLTs
; out of INFLNS because of improper free space useage.
; UPD ID= 238, RIP:<7.MONITOR>CLUDGR.MAC.12, 3-Nov-87 10:49:46 by RASPUZZI
;TCO 7.1105 - Make sure we use CLASSF instead AVALON for class scheduling
; UPD ID= 232, RIP:<7.MONITOR>CLUDGR.MAC.11, 29-Oct-87 16:05:08 by RASPUZZI
;TCO 7.1102 - Take out check for <SYSTEM>INFO in CHKPID.
; UPD ID= 229, RIP:<7.MONITOR>CLUDGR.MAC.10, 28-Oct-87 19:00:35 by RASPUZZI
;Add missing portions of TCO 7.1090 that I didn't REDIT in.
; UPD ID= 224, RIP:<7.MONITOR>CLUDGR.MAC.9, 28-Oct-87 14:16:31 by RASPUZZI
;TCO 7.1094 - Make sure .MSGSS of MSTR done through .INMSR returns the
; correct information in the user space. Also, don't trash
; user's byte pointers.
; UPD ID= 220, RIP:<7.MONITOR>CLUDGR.MAC.8, 28-Oct-87 10:26:38 by RASPUZZI
;TCO 7.1090 - ***PERFORMANCE*** Have the CLUDGR SYSAP send over the exact
; Amount of words to the remote system. Add another argument
; in the BLSUB. FILLIN.
; UPD ID= 198, RIP:<7.MONITOR>CLUDGR.MAC.7, 23-Oct-87 12:49:32 by RASPUZZI
;TCO 7.1080 - Make CHKGAL now recognize NEBULA as part of GALAXY
; UPD ID= 197, RIP:<7.MONITOR>CLUDGR.MAC.5, 22-Oct-87 18:20:48 by RASPUZZI
;More of TCO 7.1076 - Make CHKGAL use global job and not local job number
; UPD ID= 195, RIP:<7.MONITOR>CLUDGR.MAC.4, 22-Oct-87 08:26:32 by RASPUZZI
;More of TCO 7.1076 - Make SC.CON send connection data address
; UPD ID= 194, RIP:<7.MONITOR>CLUDGR.MAC.3, 22-Oct-87 08:17:50 by RASPUZZI
;More of TCO 7.1076 - Fix problem in .INMTO for local system
; UPD ID= 187, RIP:<7.MONITOR>CLUDGR.MAC.2, 21-Oct-87 17:31:40 by RASPUZZI
;TCO 7.1076 - Add CLUDGR SYSAP. This file contains connection management,
; JSYS support (INFO%, SMON%/TMON%, TTMSG%) and SCA buffer
; management.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988.
; ALL RIGHTS RESERVED.
;
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH CLUPAR,PROLOG,SCAPAR,TTYDEF
TTITLE (CLUDGR,,< - CLuster User Data GatheRing Service>)
; M. Raspuzzi October 87
EXTERN HSTSIZ
SALL
;CLUDGR - CLuster User Data GatheRing.
;INFO%'s dispatch tables must be the same length else there is a possiblity
;of getting crashes when a user calls INFO%.
IFN LCLLEN-INFLEN,<PRINTX ?INFO%'s dispatch tables are not the same length>
Subttl Table of Contents
; Table of Contents for CLUDGR
;
; Section Page
;
;
; 1. CLUDGR Storage . . . . . . . . . . . . . . . . . . . . 5
; 2. CLUDGR Initialization
; 2.1 CLUINI . . . . . . . . . . . . . . . . . . . . 6
; 3. Connection Management
; 3.1 CLULSN (Make CLUDGR listener) . . . . . . . . 7
; 3.2 BADSCA (Bad SCA callback) . . . . . . . . . . 9
; 3.3 NEWCLU (New node in cluster) . . . . . . . . . 10
; 3.4 CLUVAC (Remote system left cluster) . . . . . 12
; 3.5 GOTCLU (Message arrived for CLUDGR) . . . . . 13
; 3.6 CONLSN (Connect to listener) . . . . . . . . . 18
; 3.7 CLWHAT (Connect response here) . . . . . . . . 20
; 3.8 OKCLU (OK to send) . . . . . . . . . . . . . . 22
; 4. Buffer Management
; 4.1 GIVBCK (Return an SCA buffer) . . . . . . . . 23
; 4.2 CLUCRD (Credit is available) . . . . . . . . . 24
; 4.3 CLNEED (CLUDGR needs buffers) . . . . . . . . 25
; 5. SYSAP Entry Point
; 5.1 CL.SCA . . . . . . . . . . . . . . . . . . . . 26
; 6. CLUDGR SYSAP Work Routines
; 6.1 CLWAKE (Wake up sleeping forks) . . . . . . . 27
; 6.2 FILLIN (To fill in a chain of SCA buffers) . . 28
; 7. INFO%
; 7.1 The JSYS that does it all . . . . . . . . . . 29
; 7.2 RESACS (Restore ACs) . . . . . . . . . . . . . 32
; 7.3 INFCIN (Get all CI nodes doing INFO%) . . . . 35
; 7.4 LCLDVT (Local DEVST%) . . . . . . . . . . . . 37
; 7.5 LCLSTV (Local STDEV%) . . . . . . . . . . . . 38
; 7.6 LCLNTF (Local NTINF%) . . . . . . . . . . . . 39
; 7.7 LCLDVC (Local DVCHR%) . . . . . . . . . . . . 40
; 7.8 LCLXPK (Local XPEEK%) . . . . . . . . . . . . 41
; 7.9 LCLTMN (Local TMON%) . . . . . . . . . . . . . 42
; 7.10 LCLSGT (Local SYSGT%) . . . . . . . . . . . . 43
; 7.11 LCLSNP (Local SNOOP%) . . . . . . . . . . . . 44
; 7.12 LCLSKD (Local SKED%) . . . . . . . . . . . . . 45
; 7.13 LCLRCR or LCLRCD (Local RCUSR% or RCDIR%) . . 46
; 7.14 LCLMUT (Local MUTIL%) . . . . . . . . . . . . 47
; 7.15 LCLMTO (Local MTOPR%) . . . . . . . . . . . . 48
; 7.16 LCLLNM (Local LNMST%) . . . . . . . . . . . . 49
; 7.17 LCLINL (Local INLNM%) . . . . . . . . . . . . 50
; 7.18 LCLGTY (Local GTTYP%) . . . . . . . . . . . . 51
; 7.19 LCLGTB (Local GETAB%) . . . . . . . . . . . . 52
; 7.20 LCLDST (Local DIRST%) . . . . . . . . . . . . 53
; 7.21 LCLCFG (Local CNFIG%) . . . . . . . . . . . . 54
; 7.22 LCLSYS (INFO%'s SYSTAT function) . . . . . . . 55
; 7.23 LCLJOB (Get username's job numbers) . . . . . 59
; 7.24 LCLGJI (Local GETJI%) . . . . . . . . . . . . 61
; 7.25 LCLMSR (Local MSTR%) . . . . . . . . . . . . . 62
Subttl Table of Contents (page 2)
; Table of Contents for CLUDGR
;
; Section Page
;
;
; 7.26 LCLTIM (Local TIME% JSYS) . . . . . . . . . . 63
; 7.27 INFSYS (Remote SYSTAT information) . . . . . . 64
; 7.28 INFCFG (Remote CNFIG%) . . . . . . . . . . . . 67
; 7.29 INFDST (Remote DIRST%) . . . . . . . . . . . . 70
; 7.30 INFGTB (Remote GETAB%) . . . . . . . . . . . . 71
; 7.31 INFGTY (Remote GTTYP%) . . . . . . . . . . . . 72
; 7.32 INFINL (Remote INLNM%) . . . . . . . . . . . . 73
; 7.33 INFLNS (Remote LNMST%) . . . . . . . . . . . . 74
; 7.34 INFJOB (Get jobs of user on remote system) . . 76
; 7.35 INFMTO (Remote MTOPR%) . . . . . . . . . . . . 77
; 7.36 INFMUT (Remote MUTIL%) . . . . . . . . . . . . 78
; 7.37 INFRCR/INFRCD (Remote RCUSR%/RCDIR%) . . . . . 80
; 7.38 INFSKD (Remote SKED%) . . . . . . . . . . . . 82
; 7.39 INFSNP (Remote SNOOP%) . . . . . . . . . . . . 84
; 7.40 INFSGT (Remote SYSGT%) . . . . . . . . . . . . 85
; 7.41 INFTMN (Remote TMON%) . . . . . . . . . . . . 86
; 7.42 INFXPK (Remote XPEEK%) . . . . . . . . . . . . 87
; 7.43 INFDVC (Remote DVCHR%) . . . . . . . . . . . . 89
; 7.44 INFSTV (Remote STDEV%) . . . . . . . . . . . . 90
; 7.45 INFDVT (Remote DEVST%) . . . . . . . . . . . . 92
; 7.46 INFNTF (Remote NTINF%) . . . . . . . . . . . . 93
; 7.47 INFGJI (Remote GETJI%) . . . . . . . . . . . . 95
; 7.48 INFMSR (Remote MSTR%) . . . . . . . . . . . . 97
; 7.49 INFGTB (Remote GETAB%) . . . . . . . . . . . . 102
; 7.50 CL.ENT (Entry point to CLUDGR from user level) 103
; 7.51 CLURSM (Reassemble SCA buffers into free space 111
; 7.52 REMQ (Remove from receive queue) . . . . . . . 113
; 7.53 CLUWAT (Wait routine) . . . . . . . . . . . . 114
; 7.54 LCLWAT (Little credit, so we wait) . . . . . . 115
; 7.55 INFALO (Remote node allowing?) . . . . . . . . 116
; 7.56 CLGOOD (All is well) . . . . . . . . . . . . . 117
; 7.57 CLFAIL (CL.ENT failed) . . . . . . . . . . . . 118
; 7.58 CLREMR (Remote error) . . . . . . . . . . . . 119
; 7.59 DOACS (Fill in fake ACs) . . . . . . . . . . . 120
; 7.60 CHKGAL (Check to see if we are GALAXY) . . . . 121
; 7.61 CHKPID (Check for GALAXY PID) . . . . . . . . 123
; 8. Cluster Sendall
; 8.1 CLTMSG . . . . . . . . . . . . . . . . . . . . 124
; 8.2 CHKSND (Check to see if OK to send to remote) 128
; 9. SMON% Functions
; 9.1 SETCLU (Disable CLUDGR) . . . . . . . . . . . 129
; 9.2 CLRCLU (Enable CLUDGR) . . . . . . . . . . . . 130
; 9.3 SETTMG (Disable Cluster sendalls) . . . . . . 131
; 9.4 CLRTMG (Enable Cluster sendalls) . . . . . . . 132
; 9.5 CLNTFY (Notify all nodes) . . . . . . . . . . 133
; 10. End of CLUDGR . . . . . . . . . . . . . . . . . . . . 134
SUBTTL CLUDGR Storage
;Keep these 4 words in order because they are sent over during connection
;initialization!
RSI (CLUSET,-1) ;INFO% control word, -1 allows remote INFO%s
RSI (CLUTMG,-1) ;Remote send all control word (-1 allows)
RSI (CLUXX1,0) ;First extra word for CLUDGR
RSI (CLUXX2,0) ;Second extra word for CLUDGR
CLSETW==4 ;There are this many setting words (only 2 in use now)
RSI (CLUFLG,0) ;"Run the CLUDGR fork" flag <> 0
RS (CLREQQ,1) ;Pointer to head of CLUDGR request queue
RS (CLRCVQ,1) ;Pointer to head of CLUDGR receive queue
RS (CLUID,1) ;Running CLUDGR ID counter
IFN DEBUG,< ;[7.1247] Only in DEBUG
RS (PREVID) ;[7.1247] Last used CLUID number
> ;[7.1247] End IFN DEBUG
RS (CLUBUF,1) ;Number of SCA buffers in use by CLUDGR
XRESCD
CLUNAM: ASCI8 (<LCS20$CLUDGR >) ;CLUDGR SYSAP name
SUBTTL CLUDGR Initialization -- CLUINI
;CLUINI - Routine to initialize the CLUDGR SYSAP. Called by
;SCA when it loops through INITAB.
;
; Call with:
; no arguments
; CALL INITAB(AC)
;
; Returns:
; +1 - Always, CLUDGR SYSAP initialized
XRESCD
CLUINI::SETZM CLREQQ ;Initialize CLUDGR request queue
SETZM CLRCVQ ;Initialize CLUDGR receive queue
SETZM CLUID ;Reset CLUDGR ID counter
IFN DEBUG,< ;[7.1247] If DEBUGging
SETZM PREVID ;[7.1247] Clear this too
> ;[7.1247] End IFN DEBUG
SETZM CLUBUF ;Note that no SCA buffers are being used
CALL CLULSN ;(/) Establish a CLUDGR listener
NOP ;That's life
BLCAL. (<XENT SC.SOA>,<<.,CL.SCA>>) ;Tell SCA how to get to CLUDGR
BUG.(CHK,CLNOLA,CLUDGR,SOFT,<CLUINI - SCA set online failed>,<<T1,ERR>>,<
Cause: Calling SC.SOA to notify SCA of CLUDGR's online address table
failed. This indicates a problem with SCA.
Data: ERR - Error code as returned by SCA.
>) ;Let everyone know we failed..
RET
SUBTTL Connection Management -- CLULSN (Make CLUDGR listener)
;CLULSN - Routine called to establish CLUDGR listener.
;
; Call with:
; no arguments
; CALL CLULSN
;
; Returns:
; +1 - Error, T1=0, no more host slots
; T1<>0, some SCA error
; +2 - Success, CLUDGR listener has ear to ground
XRESCD ;Called at PI level
CLULSN: SAVEQ ;Save destructive registers
CIOFF ;Don't let anyone else in for now
MOVSI T1,-HSTSIZ ;Init AOBJN counter
DO. ;Loop and find a free slot
SKIPE CLUHST(T1) ;Is this entry being used?
IFSKP. ;No,
SETOM CLUHST(T1) ;Say we are listening on this one
SETZM CLUSTS(T1) ;And init its status
CION ;Turn the CI back on
HRRZ Q1,T1 ;Preserve index over call
BLCAL. (<XENT SC.LIS>,<<.,CLUNAM>,<.,CLUNAM>,[-1],<.,CL.SCA>,Q1,[SCRDIT],[RCRDIT]>)
IFNSK. ;SCA didn't like our call
SETZM CLUHST(T1) ;No longer listening
BUG.(HLT,CLNOLS,CLUDGR,SOFT,<CLULSN - CLUDGR listener not created>,<<T1,ERR>>,<
Cause: Calling SC.LIS to establish a CLUDGR listener failed. This
indicates a problem with SCA.
Data: ERR - Error code as returned by SCA.
>) ;Can't continue
ENDIF. ;End of error handling
MOVEM T1,CLUSTS(Q1) ;Save CID in this table for now
RETSKP ;Finished
ENDIF.
AOBJN T1,TOP. ;Do next entry in table
CION ;Turn CION before going back
ENDDO. ;End of loop
BUG. (CHK,CLUNFE,CLUDGR,SOFT,<CLUDGR - No free entry in table>,,<
Cause: CLULSN was called to set up a CLUDGR listener for the local
system. However, this routine could not find a free entry in
the CLUHST table. This indicates a possible coding problem,
SCA malfunction, or an oversized cluster (possibly too many
KLs in the cluster).
Action: Check to see if there are more than the supported number of
KLs in the cluster. If so, remove the excess machines. If this
is not the cause and this problem becomes persistent, change
the BUGCHK to a BUGHLT and submit an SPR.
>,,<DB%NND>) ;[7.1210]
SETZ T1, ;Could not find an entry
RET
SUBTTL Connection Management -- BADSCA (Bad SCA callback)
;BADSCA - This routine is called by CL.SCA when SCA gives it a callback
;that it is not prepared to handle. It simply BUGCHKs and returns.
;
; Called with:
; T1/ Bogus SCA callback function code
; CALL BADSCA
;
; Returns:
; +1 - Always, with the CLUNKR BUGINF issued
XRESCD ;Called from PI level
BADSCA: BUG.(CHK,CLUNKR,CLUDGR,SOFT,<CLUDGR - Unknown callback, returning>,<<T1,CBACK>>,<
Cause: The CLUDGR SYSAP received an unexpected callback from SCA. It
was not prepared to handle this callback. Therefore, a BUGCHK
is issued and the monitor simply returns to SCA. This could be
due to a malfunction in SCA.
Action: If this BUGCHK occurs often, change it to a BUGHLT and submit
an SPR.
Data: CBACK - Callback function from SCA
>)
RET ;Back to the caller
SUBTTL Connection Management -- NEWCLU (New node in cluster)
;NEWCLU - Called when CL.SCA has a new node for us to check out. Connection
;is made only if the system has a lower CI node than ours.
;
; Call with:
; T2/ CI node number
; CALL NEWCLU
;
; Returns:
; +1 - Always
XRESCD ;Called from PI level
NEWCLU: SAVEQ ;Don't trash good things
MOVE Q2,T2 ;Put node here.
CALLX (MSEC1,SC.PRT) ;(/T1) Get our port number
RETBAD() ;Failed
CAMG T1,Q2 ;Should we try to talk to this guy?
RET ;No, he has a higher CI node than us
CALLX (MSEC1,IS7020) ;(T2/) Do we want to talk to this node?
RET ;No, no chance he is running CLUDGR
MOVSI Q1,-HSTSIZ ;Make AOBJN pointer
CIOFF ;Turn CIOFF for now
DO.
SKIPN CLUHST(Q1) ;Is this entry free?
EXIT. ;Yes, use it.
AOBJN Q1,TOP. ;Do next entry
CION ;Turn CION
SETZM T1 ;Indicate no more entries in table
JRST NEWCL1
ENDDO.
CION ;Turn CI back on
MOVE T2,Q1 ;Get table index back
BLCAL. (<XENT SC.CON>,<<.,CLUNAM>,<.,CLUNAM>,Q2,[SCRDIT],[RCRDIT],<.,CL.SCA>,T2,[CLUSET],[BUFINI],[0]>) ;Do connect
IFNSK.
NEWCL1: BUG. (CHK,CLULES,CLUDGR,SOFT,<No CLUDGR connection established with remote node>,<<T1,WHY>>,<
Cause: The call to SC.CON failed to allow this machine to establish a
CLUDGR connection with the remote machine or there are no more
entries in the CLUHST table.
Action: If this is due to no more entries in CLUHST (WHY=0) then there may
be too many systems in this cluster. If the cause is a failing
call to SC.CON (WHY<>0) and this problem becomes chronic then
change this to a BUGHLT and submit an SPR.
Data: WHY - 0 if CLUHST table is full or
Error code from call to SC.CON
>)
SETZM CLUHST(Q1) ;If failed, no longer listening
SETZM CLUSTS(Q1) ;And no status
RETBAD() ;Pass error back from SCA
ENDIF.
SETZM CLUSTS(Q1) ;Init status
MOVEM T1,CLUHST(Q1) ;Save CID in table
MOVX T1,CL%OPN ;Indicate connection becoming open...
IORM T1,CLUSTS(Q1) ;...for this system
MOVEI T1,BUFINI ;Note that CLUDGR just queued up buffers
ADDM T1,CLUBUF ;By adding the count to the buffer count word
ADDM T1,CLUSTS(Q1) ;Say how many buffers in use by this connection
RETSKP ;Done
SUBTTL Connection Management -- CLUVAC (Remote system left cluster)
;CLUVAC - Routine called through CL.SCA by SCA when a system in the
;cluster vacates the cluster.
;
; Call with:
; T1/ .SSRID or .SSPBC
; T2/ Connect ID or -1 for generic disconnect
; T3/ CI node or disconnect reason
;
; Returns:
; +1 - Always
XRESCD ;Here from PI level
CLUVAC: JUMPL T2,R ;Is this an extraneous callback? If so, return
LOAD T3,SID,T2 ;Get index into CLUHST table
SKIPN T1,CLUHST(T3) ;Is this node active?
IFSKP. ;If so,
CALL <XENT SC.NOD> ;(T1/T1,T2) Get node number
SKIPE CIBUGX ;[7.1121] Wanna see this?
BUG.(INF,CLDISC,CLUDGR,SOFT,<CLUVAC - CLUDGR SYSAP disconnect>,<<T2,NODE>,<T1,CID>>,<
Cause: A CLUDGR disconnect request has been received from a remote
node on the CI-20.
Data: NODE - Remote CI node number
CID - Connect ID.
>,,<DB%NND>) ;[7.1210] Let someone know, not normally dumped
MOVE T1,CLUSTS(T3) ;[7.1273] Get status
TXNE T1,CL%RDY ;[7.1273] If it was ready to receive stuff
CALL CLWAKE ;[7.1273] (T2/) Wake up outstanding forks
LOAD T1,CIDBUF,(T3) ;Get number of buffers in use by this CID
SUBM T1,CLUBUF ;Discount them here
ENDIF.
SETZM CLUHST(T3) ;Indicate this entry is now gone
SETZM CLUSTS(T3) ;No status on null entry
RET ;And back to caller
SUBTTL Connection Management -- GOTCLU (Message arrived for CLUDGR)
;GOTCLU - Routine called by CL.SCA when SCA tells the CLUDGR SYSAP
;that it got a message for it. This routine places the SCA buffer on
;the appropriate queue if necessary.
;
; Call with:
; T2/ Connect ID
; T3/ SCA packet address
; T4/ Routine to call to return packet
;
; Returns:
; +1 - Always
XRESCD ;Here from PI level
GOTCLU: SAVEQ ;Save some work registers
SETZM .CLFLI(T3) ;Ensure no FLINK at all, this packet is in
;limbo until it gets placed somewhere
LOAD Q1,SID,T2 ;Get table index
SOS CLUSTS(Q1) ;Discount this buffer from receive credit
MOVE Q3,T2 ;Save connect ID
LOAD T1,.CLFUN,(T3) ;Get function
CAIE T1,CLCHNG ;Is this a special function?
IFSKP. ;If so,
CIOFF ;No interruptions
LOAD T1,.CLPTR,(T3) ;Get pointer to data area
ADD T1,T3 ;Find data area word
MOVE T4,CLDFUN(T1) ;Get CLUDGR setting for remote node
MOVX Q2,CL%DNY ;Get flag for remote INFO%'s
ANDCAM Q2,CLUSTS(Q1) ;Turn it off in the status word
SKIPN T4 ;Is the remote system allowing INFO%'s?
IORM Q2,CLUSTS(Q1) ;Say this system is denying INFO%'s
AOS T1 ;Move to the TTMSG% set word
MOVE T4,CLDFUN(T1) ;Get setting from remote node
MOVX Q2,CL%NOS ;This is the send all flag
ANDCAM Q2,CLUSTS(Q1) ;Say remote system allowing sendalls, unless...
SKIPN T4 ;Is remote allowing TTMSG%'s?
IORM Q2,CLUSTS(Q1) ;Set the bit
CION ;Done with status words
CALLRET GIVBCK ;Return SCA buffer appropriately
ENDIF.
; ...
; ...
;Here when buffer must go on CLREQQ or CLRCVQ
MOVE T1,CLDFLG(T3) ;Get flags
TXNE T1,CL%REQ ;Is this a request for us to work?
CALLRET PUTREQ ;Yes, put it on CLREQQ
MOVE T1,CLRCVQ ;Get first entry in receive queue
DO. ;Loop over all entries until we find ours
JUMPE T1,ENDLP. ;Is there another entry?
LOAD Q1,REQNUM,(T1) ;Get request number for this block
LOAD Q2,.CLREQ,(T3) ;Get request number this SCA buffer belongs to
CAME Q1,Q2 ;Are they the same
IFSKP. ;Yes,
SKIPE Q1,REQSCA(T1) ;Follow SCA buffer chain
IFSKP. ;If no chain,
MOVEM T3,REQSCA(T1) ;Make this the first SCA buffer
JRST GOTCL1 ;And go on
ENDIF. ;If so, then follow SCA buffer chain
DO. ;Until the last one is reached
SKIPN Q2,.CLFLI(Q1) ;Is there more to look at?
EXIT. ;No, we have reached the end of the chain
MOVE Q1,Q2 ;Save last buffer looked at
JRST TOP. ;And follow it
ENDDO. ;Chain followed
MOVEM T3,.CLFLI(Q1) ;Tack this buffer on the end of the chain
GOTCL1: LOAD Q1,.CLPKT,(T3) ;Get position in buffer chain
LOAD Q2,.CLTPK,(T3) ;Get count of total expected in chain
CAME Q1,Q2 ;Is this the last packet?
IFSKP. ;Yes,
MOVE Q1,CLDFLG(T3) ;Get flag word
TXNE Q1,CL%ERR ;Was there an error on remote?
SKIPA Q1,[CL%ALL!CL%RER] ;Yes, the gang's all here with an error
MOVX Q1,CL%ALL ;Say all buffers here for this request
IORM Q1,REQFLG(T1);Set it up
ENDIF.
RET ;Finished, go back
ENDIF.
;Here when we must move to next entry in the CLRCVQ
MOVE T1,REQFLK(T1) ;Get next entry in receive queue
JRST TOP. ;And go process it
ENDDO.
SKIPE CIBUGX ;[7.1121] Crash if debugging
BUG.(INF,CLORBF,CLUDGR,SOFT,<Orphaned buffer received by CLUDGR>,,<
Cause: The CLUDGR SYSAP received an SCA buffer from a remote system
but it could not find a request to associate it with. Somehow,
the request block dissappeared. This could be due to a cluster
state transition.
Cure: If this becomes a problem, then take a dump and try to determine
what happened to the orphaned request.
>) ;[7.1121] Could not find request
SETZ T2, ;[7.1121] No connect ID
MOVE T3,Q1 ;[7.1121] Get SCA buffer here
CALLRET GIVBCK ;[7.1121] (T2,T3/) Give it back to SCA
;Here when an SCA buffer has arrived for the CLUDGR fork. Make
;an entry in the CLREQQ if necessary. Otherwise, put this buffer
;in the existing entry and wake up the CLUDGR fork when all buffers
;have arrived for the request.
PUTREQ: MOVE T1,CLREQQ ;Get first entry in request queue
XMOVEI Q1,CLREQQ ;Remember where we started
DO. ;Loop over all entries until we find ours
JUMPE T1,ENDLP. ;Is there another entry?
LOAD Q1,.RQNOD,(T1) ;Get node number
LOAD Q2,.CLNOD,(T3) ;Get node number of request
CAME Q1,Q2 ;Are they the same?
JRST PUTRQ1 ;No, don't bother checking request ID
;Nodes match, make sure it is the correct request ID.
LOAD Q1,REQNUM,(T1) ;Get request number for this block
LOAD Q2,.CLREQ,(T3) ;Get request number this SCA buffer belongs to
CAME Q1,Q2 ;Are they the same
IFSKP. ;Yes,
MOVE Q1,REQSCA(T1) ;Follow SCA buffer chain
;At this point, there should be a request block and at least one SCA
;buffer hanging off it. This is true because the request block is made
;when the first SCA buffer arrives.
XMOVEI Q2,REQSCA(T1);Just in case there are no SCA buffers
DO. ;Until the last one is reached
JUMPE Q1,ENDLP. ;Are we there yet?
MOVE Q2,Q1 ;Save last buffer looked at
MOVE Q1,.CLFLI(Q1);Get next buffer in chain
JRST TOP. ;And follow it
ENDDO. ;Chain followed
MOVEM T3,.CLFLI(Q2) ;Tack this buffer on the end of the chain
LOAD Q1,.CLPKT,(T3) ;Get position in buffer chain
LOAD Q2,.CLTPK,(T3) ;Get count of total expected in chain
CAME Q1,Q2 ;Is this the last packet?
IFSKP. ;Yes,
MOVX Q1,CL%ALL ;Say all buffers here for this request
IORM Q1,REQFLG(T1);Set it up
AOS CLUFLG ;Now wakeup CLUDGR fork
ENDIF.
RET ;Finished, go back
ENDIF.
;Here when we must move to next entry in the CLREQQ
PUTRQ1: MOVE Q1,T1 ;Save previous block in case new one needs to be made
MOVE T1,REQFLK(T1) ;Get next entry in receive queue
JRST TOP. ;And go process it
ENDDO.
;Here when we must make a request block and put it on the CLREQQ.
MOVE Q2,T3 ;Get SCA buffer address for safe keeping
HRLI T1,.RESP1 ;Priority for free space
HRRI T1,REQMAX ;This many words
MOVEI T2,.RESGP ;Get it from the general pool
CALLX (MSEC1,ASGRES) ;(T1,T2/T1) Get request block
CALLRET PUNTIT ;(Q2,Q3/) Couldn't get free space, inform remote node
MOVEM T1,REQFLK(Q1) ;Tack this request block on the end of CLREQQ
MOVE T3,Q2 ;Get SCA address back
HLL Q1,CLDFUN(T3) ;Get function code
HRR Q1,CLDFLG(T3) ;Get request number
MOVEM Q1,REQCOD(T1) ;Save in request block
MOVE Q1,CLDFRK(T3) ;Get fork number and CI node
MOVEM Q1,REQFRK(T1) ;Save it in request block
MOVEM T3,REQSCA(T1) ;Save SCA buffer address in request block
MOVEM Q3,REQCID(T1) ;Put connect ID in request block
LOAD Q1,.CLPKT,(T3) ;We know its the first in a group
LOAD Q2,.CLTPK,(T3) ;But how many are in the group?
CAME Q1,Q2 ;Is this 1 of 1?
IFSKP. ;If so,
MOVX Q1,CL%ALL ;Flag they're all here (all one of them)
IORM Q1,REQFLG(T1) ;Set it in the request block
AOS CLUFLG ;And nudge the CLUDGR fork
ENDIF.
RET
;Here when insufficient resources to make new request block. Check to
;see if this packet is 1 of N. If it is not, then just toss it. If it
;is the first one, then tell remote node we have insufficient system
;resources.
PUNTIT: MOVE T3,Q2 ;Get SCA buffer back
MOVE T2,Q3 ;Get connect ID
LOAD T1,.CLPKT,(T3) ;Get this packet's number
CAIE T1,1 ;Is it the first one of N?
CALLRET GIVBCK ;No, pitch it
STOR T1,.CLTPK,(T3) ;Say response will be 1 of 1
MOVX T1,CL%REQ ;This is not a request for the remote node
ANDCAM T1,CLDFLG(T3) ;So turn off the request bit
MOVX T1,CL%ERR ;[7.1212] We had a remote error
IORM T1,CLDFLG(T3) ;[7.1212] Flag it so
MOVEI T1,INFX08 ;Send this error code back
MOVEM T1,CLDATA(T3) ;Place in buffer
MOVEI T1,<CLDATA-CLDFUN>;Get offset to data
STOR T1,.CLPTR,(T3) ;And tell remote system where it is
BLCAL. (<XENT SC.SMG>,<T2,[F.RTB+F.SPM],[CLDATA+1],T3,[CLUPRI],[0],[0]>) ;[7.1090]
NOP ;Don't care about failure
RET ;Now wait for response
SUBTTL Connection Management -- CONLSN (Connect to listener)
;CONLSN - Routine called when CL.SCA hears buffalo a coming.
;CLUDGR only connects to small buffalos (lower CI nodes).
;
; Call with:
; T2/ Connect ID
; T3/ Pointer to connection data
; CALL CONLSN
;
; Returns:
; +1 - Always
XRESCD ;Called at PI level
CONLSN: SAVEQ ;Save work registers
MOVE Q1,T3 ;Save connection data address
MOVE Q2,T2 ;Save CID for later
MOVE T1,T2 ;Need CID here
CALL <XENT SC.NOD> ;(T1/T1,T2) Get node calling us
CALLX (MSEC1,SC.PRT) ;(/T1) Get our port number
RETBAD() ;Yes we have no port today
CAML T1,T2 ;Are we lower than the caller?
BUG.(HLT,CLUWTF,CLUDGR,SOFT,<CLUDGR - Wrong type of format for connection>,<<T2,NODE>>,<
Cause: Some node tried to connect to our CLUDGR SYSYAP. Unfortunately,
the connecting node is lower than us. This is not the way CLUDGR
was designed. This BUGHLT indicates something is definitely wrong.
Data: NODE - CI node number of offending node
>) ;Bad connection, crash
BLCAL. (<XENT SC.ACC>,<Q2,[CLUSET],[BUFINI],[0]>) ;Accept connection
IFNSK. ;If failure,
BUG.(CHK,CLUACF,CLUDGR,SOFT,<CLUDGR - Accept connect failed>,<<T1,FAIL>>,<
Cause: The call to SC.ACC failed and the CLUDGR SYSAP failed to
accept a legitimate connection.
Action: If this problem becomes malignant, change this BUGCHK to a BUGHLT
and submit an SPR.
Data: FAIL - Error code as returned by SC.ACC
>)
CALL CLULSN ;[7.1121] (/) We must start up another listener
NOP ;[7.1121] Failure taken care of already
RET ;Not a critical error, just return
ENDIF.
LOAD T1,SID,Q2 ;Get table index
SETZM CLUSTS(T1) ;Init status of this node
MOVEM Q2,CLUHST(T1) ;Save connect ID - now we's active
MOVX T2,CL%OPN ;Connection is open but not ready to receive
IORM T2,CLUSTS(T1) ;Show we are open for business
MOVEI T2,BUFINI ;We just this many buffers
ADDM T2,CLUBUF ;Count them for CLUDGR SYSAP
ADDM T2,CLUSTS(T1) ;Say how many buffers in use by this connection
MOVX T2,CL%DNY ;Find out remote node's CLUDGR setting
ANDCAM T2,CLUSTS(T1) ;Allow remote requests to go to this node, unless
SKIPN .CLSET(Q1) ;Is remote denying CLUDGR requests?
IORM T2,CLUSTS(T1) ;Set bit to not allow requests to get through
MOVX T2,CL%NOS ;Now check remote send all setting
ANDCAM T2,CLUSTS(T1) ;Let it be known, unless...
SKIPN .CLTMG(Q1) ;Get remote send all setting
IORM T2,CLUSTS(T1) ;So don't let anyone do it
CALL CLULSN ;(/) Start new CLUDGR listener
NOP ;Yes we did not work but who cares
RET ;Fini
SUBTTL Connection Management -- CLWHAT (Connect response here)
;CLWHAT - Routine called when CL.SCA has a connect response for the
;local CLUDGR SYSAP. After this routine, the CLUDGR connection should be
;in operation.
;
; Call with:
; T2/ Connect ID
; T3/ Reply code (if any)
; T4/ Pointer to connection data
; CALL CLWHAT
;
; Returns:
; +1 - Always, connection fully operational
XRESCD ;Called at PI level by SCA
CLWHAT: SAVEQ ;Don't destroy the goods
MOVE Q1,T4 ;Save connection data address
MOVE Q2,T2 ;Save CID for BUGINF
LOAD T1,SID,T2 ;Get index into table
IFE. T3 ;Did remote node reject?
SETZM CLUHST(T1) ;Yes, must not be running CLUDGR
SETZM CLUSTS(T1) ;Clear this too
MOVEI T1,BUFINI ;Get count of buffers we initally queued
SUBM T1,CLUBUF ;And discount them
RET ;No more to do
ENDIF.
MOVEM T2,CLUHST(T1) ;Save connect ID
MOVX T2,CL%RDY ;Say this node is ready
IORM T2,CLUSTS(T1) ;Set the ready bit in status word
MOVX T2,CL%OPN ;Turn this thing off
ANDCAM T2,CLUSTS(T1) ;In the status word for this CID
MOVX T2,CL%DNY ;Find out remote node's CLUDGR setting
ANDCAM T2,CLUSTS(T1) ;Allow remote requests to go to this node, unless
SKIPN .CLSET(Q1) ;Is remote denying CLUDGR requests?
IORM T2,CLUSTS(T1) ;Set bit to not allow requests to get through
MOVX T2,CL%NOS ;Now check remote send all setting
ANDCAM T2,CLUSTS(T1) ;Assume allowing, unless...
SKIPN .CLTMG(Q1) ;Get remote send all setting
IORM T2,CLUSTS(T1) ;So don't let anyone do it
MOVE T1,Q2 ;Now get remote node's CI node number
CALL <XENT SC.NOD> ;(T1/T1,T2) And pass them to the BUGINF
; CALLRET CONDON ;(T2,Q2/) Connection is now complete
CONDON: SKIPE CIBUGX ;[7.1121] Wanna see this?
BUG.(INF,CLUCON,CLUDGR,SOFT,<CLUDGR - Connection completed>,<<T2,NODE>,<Q2,CID>>,<
Cause: A connection to the CLUDGR SYSAP has been completed with
another TOPS-20 node on the CI-20.
Data: NODE - CI node number of connector
CID - Connect ID
>,,<DB%NND>) ;[7.1210] Be noisy and not normally dumpable
RET ;Done
SUBTTL Connection Management -- OKCLU (OK to send)
;OKCLU - Routine called by CL.SCA when it has been determined that
;it is OK for the local node to send information to the remote
;system.
;
; Call with:
; T2/ Connect ID
; CALL OKCLU
;
; Returns:
; +1 Always
XRESCD ;Called from PI level
OKCLU: SAVEQ ;Save work regs
MOVE Q2,T2 ;Put CID here for safe keeping
LOAD T1,SID,T2 ;Get table index
MOVX T2,CL%RDY ;Get ready bit and set it in status word
IORM T2,CLUSTS(T1) ;Note that this entry is ready and willing
MOVX T2,CL%OPN ;Clear the OPEN bit
ANDCAM T2,CLUSTS(T1) ;Now we are ready fer sure
MOVE T1,Q2 ;Put connect ID here and get his node
CALL <XENT SC.NOD> ;(T1/T1,T2) Get the node that connected to us
CALLRET CONDON ;(T2,Q2/) Note connection ready
SUBTTL Buffer Management -- GIVBCK (Return an SCA buffer)
;GIVBCK - Routine to return an SCA buffer from CLUDGR. It will return
;the buffer to SCA if CLUDGR has a lot of buffers in use. Otherwise,
;the buffer gets requeued for the CLUDGR SYSAP. If CID is 0, then buffers
;automatically go to SCA no questions asked.
;
; Call with:
; T2/ Connect ID or 0
; T3/ Buffer address
; CALL GIVBCK
;
; Returns:
; +1 - Always with buffer queued for CLUDGR or given back to SCA
XRESCD ;Called from PI level
GIVBCK::CIOFF ;No interruptions while we deal with buffers
SKIPN T2 ;Do we have a connect ID?
JRST GIVSCA ;No, give buffer to SCA and only
;discount from overall SYSAP count
LOAD T1,SID,T2 ;Get index from CID
CAME T2,CLUHST(T1) ;Is this still a good connect ID?
JRST GIVSCA ;No, node must have gone away, give buffer
;just to SCA
LOAD T4,CIDBUF,(T1) ;Find out how many buffers in use by this CID
CAIG T4,BUFLOT ;If too many,
IFSKP. ;then return this one to SCA
GIVSCA: SOS CLUBUF ;And now discount from overall picture
MOVE T1,T3 ;Get buffer address
CALLX (MSEC1,SC.RBF) ;(T1/) Return buffer to SCA
ELSE. ;Else, requeue this buffer
AOS CLUSTS(T1) ;Increment the receive credit here
BLCAL. (<XENT SC.RMG>,<T2,[1],T3>) ;Requeue this buffer
NOP ;Not to worry
ENDIF.
CION ;We are finished
RET ;Go back to caller
SUBTTL Buffer Management -- CLUCRD (Credit is available)
;CLUCRD - This routine is called when a remote system has indicated
;that it has queued up some buffers. If a fork was trying to send to
;this system, it was failing because of little credit available over
;on that node. That node has just indicated that it has credit.
;
; Call with:
; T2/ Connect ID
; T3/ Current send credit
; T4/ Current receive credit
; CALL CLUCRD
;
; Returns:
; +1 - Always
XRESCD ;Called at PI level by SCA
CLUCRD: LOAD T1,SID,T2 ;Get index into CLUSTS table
MOVX T2,CL%LCL ;Little credit left on this node?
ANDCAM T2,CLUSTS(T1) ;Not any more. Let forks push on, McDuff.
RET ;This is a quickie
SUBTTL Buffer Management -- CLNEED (CLUDGR needs buffers)
;CLNEED - Routine called by CL.SCA when it notices that the CLUDGR SYSAP
;is getting low on queued buffers.
;
; Call with:
; T2/ Connect ID
; T3/ Minimum buffers to get over threshold
; CALL CLNEED
;
; Returns:
; +1 Always, with (hopefully) BUFQUE more buffers queued up
XRESCD ;Called by PI code
CLNEED: LOAD T1,SID,T2 ;Get index
LOAD T3,CIDBUF,(T1) ;Get buffer count for this CID
CAIG T3,BUFMAX ;Is it less than the max?
IFSKP.
BUG.(CHK,CLABIU,CLUDGR,SOFT,<CLUDGR - All buffers in use>,<<T2,ID>,<T3,BUF>>,<
Cause: The CLUDGR SYSAP is only allowed to use 2*NFKS buffers per CID.
When it reaches this limit, it cannot queue up anymore. The CLUDGR
fork is supposed to return buffers when it is done with them. Also,
any user process that uses SCA buffers is supposed to return them.
This BUGCHK is telling you that all buffers are in use by the
CLUDGR SYSAP.
Action: Determine who is using up all of the SCA buffers.
Data: ID - Connect ID using lots of buffers
BUF - Number of buffers in use by this CID
>)
RET ;Simply return with no more queued up
ENDIF.
MOVEI T4,BUFQUE ;Get count we are going to increase CID by
ADDM T4,CLUSTS(T1) ;Keep track of how many going to this CID
ADDM T4,CLUBUF ;Also, update overall SYSAP usage
BLCAL. (<XENT SC.RMG>,<T2,[BUFQUE],[0]>) ;Queue up some buffers
NOP ;SCAMPI told the CTY about problems already
RET ;Back to the future
SUBTTL SYSAP Entry Point -- CL.SCA
;CL.SCA - Routine that is called by SCA when it has a callback
;for the CLUDGR SYSAP. This routine dispatches to the appropriate
;supporting routine to handle the callback.
;
; Call with:
; T1/ SCA callback code
; T2/ connect ID
; T3/ callback related data if used
; T4/ callback related data if used
;
; Returns:
; +1 - Always
XRESCD ;Called at PI level!
CL.SCA::CAILE T1,CLUMAX ;Known function?
CALLRET BADSCA ;Unknown function, let someone know
CALL @CLUSCA(T1) ;Yes, do it
NOP ;Error already reported
RET ;Done
CLUSCA: XADDR. BADSCA ;.SSDGR - Datagram received
XADDR. GOTCLU ;.SSMGR - Message received
XADDR. CLUVAC ;.SSPBC - Port broke connection
XADDR. CONLSN ;.SSCTL - Connect to listener
XADDR. CLWHAT ;.SSCRA - Connect response available
XADDR. GIVBCK ;.SSMSC - Message send complete
XADDR. BADSCA ;.SSDDG - Datagram dropped
XADDR. CLNEED ;.SSLCL - Little credit left
XADDR. NEWCLU ;.SSNCO - Node came on line
XADDR. OKCLU ;.SSOSD - OK to send data
XADDR. CLUVAC ;.SSRID - Remote initiated disconnect
XADDR. CLUCRD ;.SSCIA - Credit is available
XADDR. BADSCA ;.SSDMA - DMA complete
CLUMAX==<.-CLUSCA>-1 ;Maximum number of entries in table
SUBTTL CLUDGR SYSAP Work Routines -- CLWAKE (Wake up sleeping forks)
;CLWAKE - Routine called when a node goes offline. This will wake up each
;fork that has an outstanding request for the remote node. It also loops
;through each entry in the CLREQQ and nullifies each entry that belong to
;the remote node. The CLUDGR fork will then discard these entries when it
;runs.
;
; Call with:
; T2/ CI node that disconnected
; CALL CLWAKE
;
; Returns:
; +1 - Always, with each sleeping fork now ready to wake
XRESCD ;Called at PI level
CLWAKE: CIOFF ;Shut things off when touching the queues
STKVAR <DISNOD> ;[7.1273] Save these
MOVEM T2,DISNOD ;[7.1273] Save node when incoming
MOVE T1,CLREQQ ;Check this queue
MOVX T2,CL%DED ;Indicate that this node has died
DO. ;Do all entries in this queue
JUMPE T1,ENDLP. ;All entries done?
LOAD T3,.RQNOD,(T1) ;[7.1273] Get remote node number for this request
CAME T3,DISNOD ;[7.1273] From the disconnect place?
JRST CLWAK1 ;[7.1273] No, ignore this
IORM T2,REQFLG(T1) ;Light the bit in the request block
AOS CLUFLG ;And wake up CLUDGR's fork
CLWAK1: MOVE T1,REQFLK(T1) ;[7.1273] Get next entry in queue
JRST TOP. ;And process it
ENDDO. ;Done with the CLREQQ
MOVE T1,CLRCVQ ;Now handle the receive queue
DO. ;Loop over all entries
JUMPE T1,ENDLP. ;All entries done?
LOAD T3,.RQNOD,(T1) ;[7.1273] Get requesting node
CAME T3,DISNOD ;[7.1273] Is this a node we care about?
JRST CLWAK2 ;[7.1273] No, ignore
IORM T2,REQFLG(T1) ;This will wake the fork
CLWAK2: MOVE T1,REQFLK(T1) ;[7.1273] Get next entry in the queue
JRST TOP. ;And process it
ENDDO. ;Both queues processed
CION ;Turn CI back on
RET
SUBTTL CLUDGR SYSAP Work Routines -- FILLIN (To fill in a chain of SCA buffers)
;FILLIN - This routine is called to fill in the header area used by the
;CLUDGR SYSAP.
;
; Called with:
; BLCAL. (FILLIN,<CS.BUF,CS.FLG,CS.REQ,CS.FUN,CS.FRK,CS.NOD,CS.USR>)
;
; Where:
; CS.BUF - Address of first SCA buffer in chain
; CS.FLG - Flags for buffers
; CS.REQ - Request number
; CS.FUN - Function code
; CS.FRK - Fork number
; CS.NOD - CI node number
; CS.USR - 36 bit user number
; CS.SIZ - Number of data words sent [7.1090]
;
; Returns:
; +1 - Always, chain of SCA buffers filled in
XSWAPCD ;Called by processes
FILLIN::BLSUB. (<CS.BUF,CS.FLG,CS.REQ,CS.FUN,CS.FRK,CS.NOD,CS.USR,CS.SIZ>) ;[7.1090]
SAVEQ ;Save these as we need temp storage
MOVE Q1,CS.BUF ;Get address of first SCA buffer
SETZ Q3, ;We count SCA buffers in this word
FILIN1: AOS Q3 ;Count an SCA buffer
STOR Q3,.CLPKT,(Q1) ;Store our number in the chain
SKIPE Q1,.PKFLI(Q1) ;Get next SCA buffer
JRST FILIN1 ;And count it
MOVE Q1,CS.BUF ;Again we step, start with the first one
FILIN2: STOR Q3,.CLTPK,(Q1) ;This is how many total packets
MOVE T1,CS.FLG ;Get flags
MOVEM T1,CLDFLG(Q1) ;Stash flags in buffer
MOVE T1,CS.REQ ;Now get request number
STOR T1,.CLREQ,(Q1) ;And put it in buffer
MOVE T1,CS.FUN ;Get function
STOR T1,.CLFUN,(Q1) ;And put it in the buffer
MOVE T1,CS.FRK ;Get fork number
STOR T1,.CLFRK,(Q1) ;And stash it
MOVE T1,CS.NOD ;Now get node number
STOR T1,.CLNOD,(Q1) ;And put it in the buffer
MOVE T1,CS.USR ;Now for the user number
STOR T1,.CLUSR,(Q1) ;Slam dunk it
MOVE T1,CS.SIZ ;[7.1090] Get size of data area
STOR T1,.CLLEN,(Q1) ;[7.1090] And save it in SCA buffer
MOVEI T1,<CLDATA-CLDFUN>;Get offset for data pointer
STOR T1,.CLPTR,(Q1) ;And put it in there
SKIPE Q1,(Q1) ;Get next SCA buffer
JRST FILIN2
RET ;All done
ENDBS.
SUBTTL INFO% -- The JSYS that does it all
;INFO% - JSYS to get information on local system or on another
;system within the cluster.
;
; Called with:
; T1/ address of argument block
;
; Returns:
; +1 - Always, data in argument block
; Causes an illegal instruction trap on error
XSWAPCD
.INFO:: MCENT ;Entering JSYS context
TRVAR <INFFUN,INFCI,INGLXY,LOCCI,INFARG,ARGLEN,UAC1,UAC2,UAC3,UAC4> ;Temp storage
;TRVAR variables and what they hold
; INFFUN - INFO% function as specified by the user
; INFCI - CI node sucker to do our work
; INGLXY - 0 => this job not part of GALAXY
; LOCCI - Our local CI node
; INFARG - Address of argument block in user space
; ARGLEN - Length of argument block
; UAC1-4 - These are used to hold callers ACs when INFO%
; was called. This is needed because user ACs have
; to be loaded with data when doing the IMCALL if the
; specified node was the local node.
MOVEM T1,UAC1 ;Save user ACs for restoration later
MOVEM T2,UAC2 ;They will be needed for IMCALL
MOVEM T3,UAC3
MOVEM T4,UAC4
UMOVE P1,.INFUN(T1) ;Get function code,,length of arg block
ERJMP INFBAB ;If user pulling our leg, then error
HLRZ P3,P1 ;Get INFO% function
CAIL P3,0 ;Is it too small?
CAILE P3,INFLEN ;Or too big?
ITERR (INFX01) ;Yes to either
MOVEM T1,INFARG ;Save user argument block address
MOVEM P3,INFFUN ;Save function
HRRZ P2,P1 ;Get the arg block length
CAIL P2,.INMIN ;Are we too small?
CAILE P2,.INMAX ;Or too big?
ITERR (INFX15) ;Yes bomb out
MOVEM P2,ARGLEN ;Save argument block for later
IFE. P3 ;If function 0, then don't care about
CALLX (MSEC1,SC.PRT) ;(/T1) Put our port here instead
ITERR (SCSNKP) ;If no KLIPA then this is silly
MOVEM T1,INFCI ;Save our node as the destination
JRST INFO1 ;And go on
ENDIF.
UMOVE P1,.INCID(T1) ;Get destination CI node
ERJMP INFBAB ;You lose
CAME P1,[-1] ;Want local node information?
IFSKP. ;Yes, better have a KLIPA then
CALLX (MSEC1,SC.PRT) ;(/T1) Get our port
ITERR (SCSNKP) ;No CI port, can't use this
MOVE P1,T1 ;Put our CI node here
ENDIF.
CAIL P1,0 ;Is CI node positive?
CAIL P1,C%SBLL ;And is it in range
ITERR (INFX02) ;None, can't do INFO's
MOVEM P1,INFCI ;Save it here
INFO1: SETOM INGLXY ;Assume GALAXY
CALL CHKGAL ;(/) See if we are GALAXY
SETZM INGLXY ;We are not almighty GALAXY, flag it
CAIN P2,.INCIN ;Is it this function?
JRST INFO2 ;Yes, don't see if INFO%'s denied
MOVE T1,INFCI ;Get CI node number
CALL INFALO ;(T1/) Is this node allowing INFO%'s?
IFNSK. ;INFO% being denied
SKIPE T1 ;Invalid CI node?
ITERR (INFX02) ;Yes, report it to user
SKIPE INGLXY ;Are we GALAXY?
IFSKP. ;No, than can't do this
MOVEI T1,INFX05 ;Pass this error to caller
JRST INFERR
ENDIF.
JRST INFO2 ;Join main code path
ENDIF.
INFO2: SKIPE INGLXY ;If not GALAXY,
IFSKP. ;Then we need ACJ's blessing
MOVE T1,GBLJNO ;Get our job number
S1XCT <GTOKM (.GOINF,<T1,P1,P2>,[ITERR()])> ;[7.1141] Job, dest node, function
ENDIF.
CALLX (MSEC1,SC.PRT) ;(/T1) Get our KLIPA port number
ITERR (SCSNKP) ;None, can't do INFO's
MOVEM T1,LOCCI ;Save our port number for later
CAME T1,INFCI ;Is the user trying to get stuff from our port?
IFSKP. ;Yes, dispatch to local routines
MOVE T1,INFARG ;Get INFO%'s argument block
CALL @LCLTAB(P3) ;(T1/) Do function locally
JRST INFERR ;Return failure
ELSE. ;User wants remote information
MOVE T1,INFARG ;Get user's INFO% block
CALL @INFTAB(P3) ;(T1/) Let's do it
JRST INFERR ;Report error but retore user's ACs
ENDIF.
CALL RESACS ;(/) Restore user ACs
TXNN T1,IN%RER ;Did remote error occur?
IFSKP. ;If so,
UMOVEM T1,1 ;Yes, update user's AC
HRRZM T1,LSTERR ;And update last error for process
ENDIF.
MRETNG ;Things worked out OK
INFERR: CALL RESACS ;(/) Restore user ACs before returning
ITERR () ;Some error, let user know
;Here when bad INFO% argument block
INFBAB: ITERR (INFX12) ;Return bad argument block error
SUBTTL INFO% -- RESACS (Restore ACs)
;RESACS - Called to return user's T1-T4 after INFO% monitor call. This
;is done because the local simulation of the appropriate monitor call
;does an IMCALL and this requires the arguments be in the users AC blocks.
;So, the simulation routines abuse the user's ACs but before we complete
;the INFO% monitor call, this routine restores them to their correct
;state.
;
; Called with:
; no arguments
; CALL RESACS
;
; Returns:
; +1 - Always, with user's T1-T4 just as they were when INFO% was
; entered.
;
;Clobbers no ACs!
XSWAPCD ;JSYS code
RESACS: SAVET
MOVE T2,UAC1 ;Get user's AC 1
UMOVEM T2,T1 ;Restore it
MOVE T2,UAC2 ;Set up user's old AC 2
UMOVEM T2,T2
MOVE T2,UAC3 ;Reset AC 3
UMOVEM T2,T3
MOVE T2,UAC4 ;Do the last argument AC
UMOVEM T2,T4
RET
;INFO%'s dispatch tables...
;For remotes
INFTAB: XADDR. INFCIN ;Get CI node numbers
XADDR. INFCFG ;Remote CNFIG% JSYS
XADDR. INFDST ;Remote DIRST% JSYS
XADDR. INFGTB ;Remote GETAB% JSYS
XADDR. INFGJI ;Remote GETJI% JSYS
XADDR. INFGTY ;Remote GTTYP% JSYS
XADDR. INFINL ;Remote INLNM% JSYS
XADDR. INFLNS ;Remote LNMST% JSYS
XADDR. INFMSR ;Remote MSTR% JSYS
XADDR. INFMTO ;Remote MTOPR% JSYS
XADDR. INFMUT ;Remote MUTIL% JSYS
XADDR. INFRCR ;Remote RCUSR% JSYS
XADDR. INFSKD ;Remote SKED% JSYS
XADDR. INFSNP ;Remote SNOOP% JSYS
XADDR. INFSGT ;Remote SYSGT% JSYS
XADDR. INFTMN ;Remote TMON% JSYS
XADDR. INFXPK ;Remote XPEEK% JSYS
XADDR. INFDVC ;Remote DVCHR% JSYS
XADDR. INFNTF ;Remote NTINF% JSYS
XADDR. INFSTV ;Remote STDEV% JSYS
XADDR. INFDVT ;Remote DEVST% JSYS
XADDR. INFSYS ;Remote "SYSTAT" function
XADDR. INFJOB ;Remote job information retreival
XADDR. INFRCD ;Remote RCDIR% JSYS
XADDR. INFTIM ;Remote TIME% JSYS
INFLEN==<.-INFTAB-1>
;For local INFO%s
LCLTAB: XADDR. LCLCIN ;Get CI node numbers
XADDR. LCLCFG ;Local CNFIG% JSYS
XADDR. LCLDST ;Local DIRST% JSYS
XADDR. LCLGTB ;Local GETAB% JSYS
XADDR. LCLGJI ;Local GETJI% JSYS
XADDR. LCLGTY ;Local GTTYP% JSYS
XADDR. LCLINL ;Local INLNM% JSYS
XADDR. LCLLNM ;Local LNMST% JSYS
XADDR. LCLMSR ;Local MSTR% JSYS
XADDR. LCLMTO ;Local MTOPR% JSYS
XADDR. LCLMUT ;Local MUTIL% JSYS
XADDR. LCLRCR ;Local RCUSR% JSYS
XADDR. LCLSKD ;Local SKED% JSYS
XADDR. LCLSNP ;Local SNOOP% JSYS
XADDR. LCLSGT ;Local SYSGT% JSYS
XADDR. LCLTMN ;Local TMON% JSYS
XADDR. LCLXPK ;Local XPEEK% JSYS
XADDR. LCLDVC ;Local DVCHR% JSYS
XADDR. LCLNTF ;Local NTINF% JSYS
XADDR. LCLSTV ;Local STDEV% JSYS
XADDR. LCLDVT ;Local DEVST% JSYS
XADDR. LCLSYS ;Local "SYSTAT" function
XADDR. LCLJOB ;Local job information retreival
XADDR. LCLRCD ;Local RCDIR% JSYS
XADDR. LCLTIM ;Local TIME% JSYS
LCLLEN==<.-LCLTAB-1>
SUBTTL INFO% -- INFCIN (Get all CI nodes doing INFO%)
;INFCIN - This routine (also the same for LCLCIN) is called when
;the user calls INFO% with function .INCIN. The user wants to know
;all CI nodes in the cluster allowing INFO%'s. This will tell him.
;
; Called with:
; T1/ INFO% argument block
; CALL INFCIN
; or
; CALL LCLCIN
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, with user's argument block updated
XSWAPCD ;JSYS stuff
LCLCIN: ;Just in case we come through either path
INFCIN: SAVEQ ;Save work registers
STKVAR <CURNOD> ;Place to save current working node
SETZ Q2, ;Our internal counter for words to be returned
UMOVE Q1,.INAC1(T1) ;Get address to store results
XCTU [SETZM (Q1)] ;Init it as zero
AOS Q2 ;Count length word
AOS Q1 ;This is where we start storing information
CALLX (MSEC1,SC.PRT) ;(/T1) Get our port
RETBAD () ;If no KLIPA blow up
UMOVEM T1,(Q1) ;Give local port to user
AOS Q2 ;Count us in returned argument block
AOS Q1 ;Move on to next word
MOVSI Q3,-HSTSIZ ;This is our loop counter
CIOFF ;No annoyances while we check the table
DO. ;Loop over all nodes
SKIPG T1,CLUHST(Q3) ;Get connect ID for this node
IFSKP. ;If this is a valid entry,
CALL <XENT SC.NOD> ;(T1/T1,T2) Get node number
MOVEM T2,CURNOD ;Save current node
MOVE T1,T2 ;Find out if its OK to do this node
CALL INFALO ;(T1/T1) See if INFO%'s allowed on this node
JRST INFCN1 ;Not allowed, so we don't give this back to user
MOVE T1,CURNOD ;Get current node back
XCTU [HRRZM T1,(Q1)] ;Give this node number to user
AOS Q1 ;Bump past this memory location to next one
AOS Q2 ;Increment our running counter
ENDIF.
INFCN1: AOBJN Q3,TOP. ;Do next node
ENDDO.
CION ;Allow interrupts
MOVE T1,INFARG ;Get INFO% arg block back
UMOVE T1,.INAC1(T1) ;This is where we have to store the count
UMOVEM Q2,(T1) ;Give count of how many words we returned
SETZ T1, ;Indicate no error happened
RETSKP ;And go back to caller
ENDSV.
SUBTTL INFO% -- LCLDVT (Local DEVST%)
;LCLDVT - Routine to perform the DEVST% JSYS for the INFO% function
;.INDVT.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLDVT
;
; Returns:
; +1 - Never
; +2 - Always, with .INAC1 updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
LCLDVT: XCTU [DMOVE T2,.INAC1(T1)] ;Get user's arguments
XCTU [DMOVEM T2,T1] ;And put them where they belong
IMCALL .DEVST,MSEC1 ;Do the work
ERJMP LCLERR ;When we fail
MOVE T1,INFARG ;Get arg block back
UMOVE T2,T1 ;Get updated byte pointer
UMOVEM T2,.INAC1(T1) ;And save it for user to see
SETZ T1, ;Things are well
RETSKP
SUBTTL INFO% -- LCLSTV (Local STDEV%)
;LCLSTV - Routine to do the local form INFO% of the STDEV% JSYS.
;
; Called with:
; T1/ INFO% argumnet block
; CALL LCLSTV
;
; Returns:
; +1 - Never
; +2 - Always, .INAC2 has device designator or error with
; T1/ IN%RER + Error code
XSWAPCD ;Swappable
LCLSTV: UMOVE T2,.INAC1(T1) ;Get byte pointer to device name
UMOVEM T2,T1 ;And set it up here
IMCALL .STDEV,MSEC1 ;Do the JSYS
;Note: STDEV% does not return as one would expect. This ERJMP gets
;the error that ws returned in T2 and then puts it into T1 and then
;takes the path to lite IN%RER. There's one in every operating system.
ERJMP LCLST1 ;Handle funky error return
MOVE T1,INFARG ;Get argument block back
UMOVE T2,T2 ;Else, get device designator from user AC
UMOVEM T2,.INAC2(T1) ;And return it here
SETZ T1, ;Good return
RETSKP
;Here with STDEV%'s idiosyncrosy
LCLST1: UMOVE T1,T2 ;Get error code from user AC
CALLRET LCLER1 ;(T1/) Now go through error return
SUBTTL INFO% -- LCLNTF (Local NTINF%)
;LCLNTF - Routine for INFO% to do the NTINF% shuffle on the local
;dance floor.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLNTF
;
; Returns:
; +1 - Never
; +2 - Always, with user space updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS level
LCLNTF: UMOVE T2,.INAC1(T1) ;Get address of argument block
UMOVEM T2,T1 ;Put it in user space
IMCALL .NTINF,MSEC1 ;Do the JSYS for user
ERJMP LCLERR ;If failed...
SETZ T1, ;No need to update things that are already done
RETSKP
SUBTTL INFO% -- LCLDVC (Local DVCHR%)
;LCLDVC - Do the local DVCHR%.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLDVC
;
; Returns:
; +1 - Nope
; +2 - Yup, with .INAC1, .INAC2, .INAC3 updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;Process code
LCLDVC: UMOVE T2,.INAC1(T1) ;Get device designator
UMOVEM T2,T1 ;Prepare for launch
IMCALL .DVCHR,MSEC1 ;Blast off
ERJMP LCLERR ;Mayday
MOVE T4,INFARG ;Make sure this is correct indexing
XCTU [DMOVE T1,T1] ;Get returned arguments
XCTU [DMOVEM T1,.INAC1(T4)] ;And pass them back
UMOVE T2,T3 ;Get unit word
UMOVEM T2,.INAC3(T4) ;And return it here
SETZ T1, ;No error
RETSKP ;Done
SUBTTL INFO% -- LCLXPK (Local XPEEK%)
;LCLXPK - INFO%'s local XPEEK% doer.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLXPK
;
; Returns:
; +1 - Never
; +2 - Always, with user's argument block updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
LCLXPK: UMOVE T2,.INAC1(T1) ;Get address of XPEEK% arg block
UMOVE T3,.XPCN1(T2) ;Get count of words the user wants
CAIG T3,PGSIZ ;If more than a page
IFSKP. ;Then return bad
MOVEI T1,INFX14 ;Say we can't do that
CALLRET LCLER1 ;(T1/) And return
ENDIF.
UMOVEM T2,T1 ;Store address of arg block for JSYS
IMCALL .XPEEK,XCDSEC ;[7.1205] Do it
ERJMP LCLERR ;Something gafawed
SETZ T1, ;Things are updated
RETSKP ;Back
SUBTTL INFO% -- LCLTMN (Local TMON%)
;LCLTMN - Routine used by INFO% to simulate the TMON% JSYS.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLTMN
;
; Returns:
; +1 - Never
; +2 - Always, with .INAC1 & .INAC2 updated accordingly or error with
; T1/ IN%RER + Error code
XSWAPCD ;Process code
LCLTMN: XCTU [DMOVE T2,.INAC1(T1)] ;Get user arguments
XCTU [DMOVEM T2,T1] ;Put them in user ACs
IMCALL .TMON,MSEC1 ;Do internal monitor call
ERJMP LCLERR ;Failed
MOVE T1,INFARG ;Arg block again
UMOVE T2,T2 ;Get results
UMOVEM T2,.INAC2(T1) ;And return to user here
SETZ T1, ;No error
RETSKP ;Done
SUBTTL INFO% -- LCLSGT (Local SYSGT%)
;LCLSGT - Routine to do the .INSGT function for INFO%
;
; Called with:
; T1/ Usual INFO% argument block
; CALL LCLSGT
;
; Returns:
; +1 - Never
; +2 - Always, with .INAC1 & .INAC2 updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS
LCLSGT: UMOVE T2,.INAC1(T1) ;Get SIXBIT table name
UMOVEM T2,T1 ;Put it here
IMCALL .SYSGT,XCDSEC ;[7.1205] Do the work
ERJMP LCLERR ;Failed
MOVE T4,INFARG ;Get arg block back
XCTU [DMOVE T1,T1] ;Get updated ACs
XCTU [DMOVEM T1,.INAC1(T4)] ;Pass back to user
SETZ T1, ;Happily we return
RETSKP ;To the caller
SUBTTL INFO% -- LCLSNP (Local SNOOP%)
;LCLSNP - Routine to do the .INSNP function for INFO%
;
; Called with:
; T1/ INFO% argument block
; CALL LCLSNP
;
; Returns:
; +1 - Never
; +2 - Always, with appropriate .INACx updated or error with
; T1/ IN%RER + Error
XSWAPCD ;JSYS again
LCLSNP: UMOVE T2,.INAC1(T1) ;Get function code
CAIN T2,.SNPSY ;Must be this one
JRST LCLSN1 ;If not, blow up
CAIN T2,.SNPAD ;Or this one
JRST LCLSN1 ;Do it
MOVEI T1,INFX14 ;Then say we can't do it
CALLRET LCLER1 ;(T1/) And return
LCLSN1: UMOVEM T2,T1 ;Store function for IMCALL
XCTU [DMOVE T2,.INAC2(T1)] ;Get next set of args
XCTU [DMOVEM T2,T2] ;Give to user
IMCALL .SNOOP,MSEC1 ;Do the work
ERJMP LCLERR ;Couldn't do it
MOVE T1,INFARG ;Recapture block
XCTU [DMOVE T2,T2] ;Get updated stuff
XCTU [DMOVEM T2,.INAC2(T1)] ;And store it here
SETZ T1, ;No bit spray
RETSKP ;Done
SUBTTL INFO% -- LCLSKD (Local SKED%)
;LCLSKD - Routine to handle the .INSKD function of INFO%.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLSKD
;
; Returns:
; +1 - Never
; +2 - Always, with SKED% argument block updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
;Legal SKED% functions for INFO%
SKDTAB::.SKRBC ;Read bias
.SKRCS ;Read class parameters
.SKRJP ;Read class parameters for job
.SKBCR ;Read class setting for batch jobs
.SKRCV ;Read status
SKDLEN==:<.-SKDTAB>
LCLSKD: SAVEQ ;The quasi's again
XCTU [DMOVE T2,.INAC1(T1)] ;Get function and block
MOVSI Q1,-SKDLEN ;Loop through each legal entry
DO.
CAMN T2,SKDTAB(Q1) ;Can we do this function?
EXIT. ;Yes, go on
AOBJN Q1,TOP. ;Check next entry in table
MOVEI T1,INFX14 ;Bad function for us
CALLRET LCLER1 ;(T1/) And back to user
ENDDO.
XCTU [DMOVEM T2,T1] ;Put arguments in right spot
IMCALL .SKED,MSEC1 ;Simulate
ERJMP LCLERR ;When we err, take the low road
SETZ T1, ;Indicate things are wonderful
RETSKP
SUBTTL INFO% -- LCLRCR or LCLRCD (Local RCUSR% or RCDIR%)
;LCLRCR - Routine to simulate the RCUSR% JSYS for INFO%. Alternate
;entry point LCLRCD simulates the RCDIR% JSYS.
;
; Called with:
; T1/ Address of INFO% arg block
; CALL LCLRCR or LCLRCD
;
; Returns:
; +1 - Never
; +2 - Always, with .INAC1, .INAC2, .INAC3 updated or error with
; T1/ IN%RER + Error
XSWAPCD ;Swappable
LCLRCD: TDZA T4,T4 ;Say we want RCDIR%
LCLRCR: SETO T4, ;Here's we want RCUSR%
XCTU [DMOVE T2,.INAC1(T1)] ;Get arguments
XCTU [DMOVEM T2,T1] ;Put in right spot
UMOVE T2,.INAC3(T1) ;Get 36 bit uer number for stepping
UMOVEM T2,T3 ;And stash
SKIPE T4 ;Do we want RCDIR%?
IFSKP. ;If so,
IMCALL .RCDIR,MSEC1 ;The go for it
ERJMP LCLERR ;But it no worky
ELSE. ;Else user wanted RCUSR%
IMCALL .RCUSR,MSEC1 ;Do the JSYS for the user
ERJMP LCLERR ;That's life
ENDIF.
MOVE T1,INFARG ;Get argument block again
XCTU [DMOVE T2,T1] ;Get arguments to return
XCTU [DMOVEM T2,.INAC1(T1)] ;Pass along
UMOVE T2,T3 ;Now for user number
UMOVEM T2,.INAC3(T1) ;And it goes here
SETZ T1, ;Prevent foolishness
RETSKP ;And done
SUBTTL INFO% -- LCLMUT (Local MUTIL%)
;LCLMUT - Routine to make INFO% simulate MUTIL%.
;
; Called with:
; T1/ INFO% arg block
; CALL LCLMUT
;
; Returns:
; +1 - Never
; +2 - Always, with given arg block updated by MUTIL% or error with
; T1/ IN%RER + Error
XSWAPCD ;Called at process level
;Table of MUTIL% functions that are legal
MUTTAB::.MUGTI ;PID for <SYSTEM>INFO
.MUFOJ ;Get job associated with PID
.MUFSQ ;Get send/receive quotas for PID
.MUFFP ;Return all PIDs for process given a PID
.MUFPQ ;Return max PIDs for this job
.MURSP ;Return PID from system PID table
.MUMPS ;Get system-wide max packet size
MUTLEN==:<.-MUTTAB>
LCLMUT: SAVEQ ;We needs these
UMOVE T2,.INAC2(T1) ;Get user's MUTIL% arg block
UMOVE T3,(T2) ;Get desired MUTIL% function
MOVSI Q1,-MUTLEN
DO. ;Loop over legal entries to make sure function is OK
CAMN T3,MUTTAB(Q1) ;Is it a good function?
EXIT. ;Yes, continue
AOBJN Q1,TOP. ;Nope, try the next one
MOVEI T1,INFX14 ;All out of legal functions
CALLRET LCLER1 ;(T1/) Take the error road
ENDDO.
UMOVEM T2,T2 ;Save MUTIL% arg block here for JSYS
UMOVE T2,.INAC1(T1) ;Now get length of arg block
UMOVEM T2,T1 ;And put in user space
IMCALL .MUTIL,MSEC1 ;And do the work
ERJMP LCLERR ;Didn't do what the user asked for
SETZ T1, ;No stray bits
RETSKP ;And return good
SUBTTL INFO% -- LCLMTO (Local MTOPR%)
;LCLMTO - Routine to simulate the doing of an MTOPR%.
;
; Called with:
; T1/ INFO% arg block
; CALL LCLMTO
;
; Returns:
; +1 - Not in your wildest dreams
; +2 - All the time with appropriate .INACx updated or error with
; T1/ IN%RER + Error
XSWAPCD ;JSYS code
;This table houses the legal MTOPR% functions that INFO% can simulate.
MTOTAB::.MOPIH ;PTY needs output
.MORSP ;Get TTY speed
.MORLW ;Terminal page width
.MORLL ;Terminal page length
.MORNT ;Receive message code
.MORBM ;128 character break mask
.MORFW ;Current value of width field
.MORXO ;Read end of page mode
.MORLC ;Terminal's line counter
.MORLM ;Read line maximum
.MOPCR ;Read pause/unpause characters
.MORTF ;Get message refusal level
.MORTC ;Read 2 character escape sequence
.MOCTM ;Is terminal CTERM
MTOLEN==:<.-MTOTAB>
LCLMTO: SAVEQ ;Save the quasi's
XCTU [DMOVE T2,.INAC1(T1)] ;Get function and device designator
MOVSI Q1,-MTOLEN ;Get table size
DO. ;Loop over all entries
CAMN T3,MTOTAB(Q1) ;Do we match the function?
EXIT. ;Yes we do, got a legal one
AOBJN Q1,TOP. ;No, keep scanning
MOVEI T1,INFX14 ;Couldn't find a legal function
CALLRET LCLER1 ;(T1/) So get out of here
ENDDO.
XCTU [DMOVEM T2,T1] ;Put in user space
UMOVE T2,.INAC3(T1) ;Get optional argument in there
UMOVEM T2,T3 ;Stash it
IMCALL .MTOPR,MSEC1 ;Do the JSYS and pray a lot
ERJMP LCLERR ;Can't win'em all
MOVE T1,INFARG ;Argument block al' dente
XCTU [DMOVE T2,T2] ;Get updated ACs
XCTU [DMOVEM T2,.INAC2(T1)] ;And pass them back
SETZ T1, ;Clear stray bits
RETSKP
SUBTTL INFO% -- LCLLNM (Local LNMST%)
;LCLLNM - Translate a logical name to string on this node using the
;INFO% JSYS.
;
; Called with:
; T1/ Address of INFO% arg block
; CALL LCLLNM
;
; Returns:
; +1 - Never
; +2 - Always, with .INAC3 updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;Swappable
LCLLNM: XCTU [SKIPE T2,.INAC1(T1)] ;Get user's function code
IFSKP. ;If not .LNSSY,
MOVEI T1,INFX14 ;Then we can't do it
CALLRET LCLER1 ;(T1/) Say we can't
ENDIF.
UMOVEM T2,T1 ;Put function code in right place
XCTU [DMOVE T2,.INAC2(T1)] ;Get user args
XCTU [DMOVEM T2,T2] ;Put in good place for IMCALL
IMCALL .LNMST,MSEC1 ;Do the JSYS
ERJMP LCLERR ;When we fail, go through fail routine
MOVE T1,INFARG ;Get argument block back
UMOVE T2,T3 ;Get updated byte pointer
UMOVEM T2,.INAC3(T1) ;And put it here
SETZ T1, ;No stray bits
RETSKP
SUBTTL INFO% -- LCLINL (Local INLNM%)
;LCLINL - Called when user wants INLNM% done for this node.
;
; Called with:
; T1/ Address of INFO% arg block
; CALL LCLINL
;
; Returns:
; +1 - Never
; +2 - Always with .INAC2 updated byte pointer or error
; T1/ IN%RER + Error
XSWAPCD ;Process context
LCLINL: UMOVE T2,.INAC1(T1) ;Get AC
HLRZ T3,T2 ;Get function code only
SKIPE T3 ;Can't be function .INLJB
IFSKP. ;If it is,
MOVEI T1,INFX14 ;Say we couldn't do it
CALLRET LCLER1 ;(T1/) And take IN%RER path back
ENDIF.
UMOVE T3,.INAC2(T1) ;Get byte pointer for logical name
XCTU [DMOVEM T2,T1] ;Must be in user space
IMCALL .INLNM,MSEC1 ;Do this for the user
ERJMP LCLERR ;When we fail, we set IN%RER et al
MOVE T1,INFARG ;Get argument block address
UMOVE T2,T2 ;Retrieve updated byte pointer
UMOVEM T2,.INAC2(T1) ;And save it here
SETZ T1, ;Blast stray bits
RETSKP ;Home
SUBTTL INFO% -- LCLGTY (Local GTTYP%)
;LCLGTY - Get TTY type for terminal indicated to be on this system.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLGTY
;
; Returns:
; +1 - No way
; +2 - Every time with .INAC2 and .INAC3 updated or error
; T1/ IN%RER + Error
XSWAPCD ;JSYS shuffle
LCLGTY: UMOVE T2,.INAC1(T1) ;Get terminal designator
UMOVEM T2,T1 ;GTTYP% expects it here
IMCALL .GTTYP,MSEC1 ;Now do the JSYS
ERJMP LCLERR ;When we err, show it
MOVE T1,INFARG ;Get argument block address
XCTU [DMOVE T2,T2] ;Get returned stuff
XCTU [DMOVEM T2,.INAC2(T1)] ;And save it here
SETZ T1, ;Get the basket and Toto
RETSKP ;Back to see the wizard
SUBTTL INFO% -- LCLGTB (Local GETAB%)
;LCLGTB - Routine to do a local GETAB% and put things in user space.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLGTB
;
; Returns:
; +1 - Never in a million years
; +2 - Whenever used, with .INAC1 update accordingly or error
; T1/ IN%RER + Error code
XSWAPCD ;For process context eyes only
LCLGTB: UMOVE T2,.INAC1(T1) ;Get user's argument
UMOVEM T2,T1 ;And post in user AC block
IMCALL .GETAB,XCDSEC ;[7.1205] Get the requested information
ERJMP LCLERR ;Curses, foiled again, give error and IN%RER
MOVE T1,INFARG ;Get argument block address
UMOVE T2,T1 ;Get what monitor returned
UMOVEM T2,.INAC1(T1) ;Store in correct place
SETZ T1, ;Now indicate we are pleased
RETSKP
SUBTTL INFO% -- LCLDST (Local DIRST%)
;LCLDST - Routine called when the user tries the DIRST% function
;of the INFO% JSYS but, lo, he wants the local node to supply the
;information.
;
; Called with:
; T1/ INFO% arg block
; CALL LCLDST
;
; Returns:
; +1 - Never
; +2 - With .INAC1 word updated or error with
; T1/ IN%RER + Error
XSWAPCD ;A JSYS we will do
LCLDST: XCTU [DMOVE T2,.INAC1(T1)] ;Get arguments
XCTU [DMOVEM T2,T1] ;Put them here
IMCALL .DIRST,MSEC1 ;Do it
ERJMP LCLERR ;Kaboom, give user the error
MOVE T1,INFARG ;Get INFO% argument block back
UMOVE T2,T1 ;Get updated designator
UMOVEM T2,.INAC1(T1) ;And update user's INFO% arg block
SETZ T1, ;Nothing left over
RETSKP ;Proceed
SUBTTL INFO% -- LCLCFG (Local CNFIG%)
;LCLCFG - Routine called when the user wants CNFIG% information and
;yet, the user has specified the local node as the CI node number.
;
; Called with:
; T1/ Address of INFO% argument block
; CALL LCLCFG
;
; Returns:
; +1 - Never
; +2 - User's arg block updated or error with
; T1/ IN%RER + Error code
XSWAPCD ;Doing the JSYS shuffle
LCLCFG: XCTU [DMOVE T2,.INAC1(T1)] ;Get user args
XCTU [DMOVEM T2,T1] ;And put them in user space
IMCALL .CNFIG,MSEC1 ;Simulate the JSYS
ERJMP LCLERR ;Can't win'em all
SETZ T1, ;Indicate no error
RETSKP ;And back to the caller
SUBTTL INFO% -- LCLSYS (INFO%'s SYSTAT function)
;LCLSYS - Called when the user wants to know specific SYSTAT information
;about a particular job on this node.
;
; Called with:
; T1/ User's INFO% arg block address
; CALL LCLSYS
;
; Returns:
; +1 - Never
; +2 - Always, with user's arg block updated or if error
; T1/ IN%RER + Error code
XSWAPCD
SYSLAT::ASCIZ /(LAT)/ ;String for LAT hosts
SYSCTM::ASCIZ /(CTM)/ ;String for CTERM hosts
SYSNRT::ASCIZ /(NRT)/ ;String for NRT lines
SYSTCP::ASCIZ /(TCP)/ ;String for ARPA TCP/IP lines
NOTLOG::3 ;Lookup pointer style
ASCIZ /Not logged in/ ;String for not logged in jobs
LCLSYS: SAVEPQ ;These are the scratch places
STKVAR <SYBLK,JOB,<SKDBLK,7>,<NTNBLK,10>,<ORGSTR,3*MAXLW>,TTY> ;Temp storage
UMOVE T2,.INAC1(T1) ;Get where the info is to be stored
MOVEM T2,SYBLK ;And save here
UMOVE T2,.INAC2(T1) ;Get job number/tty number
TXZN T2,.TTDES ;Was TTY given?
IFSKP. ;If so, .TTDES cleared and...
CAIL T2,0 ;Is the line number negative?
CAILE T2,NLINES ;Or is it within range?
IFNSK. ;If not,
MOVEI T1,GTJIX2 ;Say bad line number
CALLRET LCLER1 ;(T1/)
ENDIF.
NOSKED ;Make sure data base no move
CALLX (MSEC1,GTCJOB) ;(T2/T3) Get controlling job number
IFNSK. ;If no controlling terminal...
OKSKED ;Let scheduler do its thing
CALLRET LCLER1 ;(T1/) And do error
ENDIF.
OKSKED ;Terminal data base now touchable
MOVEM T3,JOB ;Save job number
ELSE. ;Job number given
MOVE T1,T2 ;Put job number here for call
CALLX (MSEC1,GL2LCL) ;(T1/T1) Get local job number
CALLRET LCLER1 ;(T1/) Bad job number
MOVEM T1,JOB ;Save job number here
ENDIF.
NOINT ;Can't be interruptable when using other JSB
MOVE T1,JOB ;Recapture job
CALLX (MSEC1,MAPJSB) ;(T1/T1) Map in foreign JSB
IFNSK. ;If no job,
OKINT ;Interrupts are OK
MOVEI T1,GTJIX4 ;Get error for this
CALLRET LCLER1 ;(T1/) And done
ENDIF.
MOVE Q1,T1 ;Save JSB index
MOVE Q2,SYBLK ;Get user's arg block
MOVE Q3,JOB ;Get job number here for usage
XCTU [SKIPN T1,.SYUSR(Q2)] ;User give us a byte pointer?
IFSKP. ;If so,
HRRZ T2,JOBDIR(Q3) ;Get logged in directory
SKIPE T2 ;Logged in?
IFSKP. ;If not,
MOVEI T2,NOTLOG ;Say not logged in
ELSE. ;Else, get user name string
MOVEI T2,USRNAM(Q1) ;Get job's user name
ENDIF.
MOVEI T3,.SYUSR(Q2) ;And put updated byte pointer in user space
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2) Give user the data
ENDIF.
XCTU [SKIPN T1,.SYDIR(Q2)] ;User give us this byte pointer?
IFSKP. ;If so,
MOVE T2,JSBSDN(Q1) ;Get job's connected directory number
UMOVEM T1,T1 ;Let DIRST% do work via an IMCALL
UMOVEM T2,T2 ;These will automatically get restored
IMCALL .DIRST,MSEC1 ;Give user the directory name
IFJER. ;When this fails,
MOVEI T2,"?" ;Say we don't know connected directory
CALLX (MSEC1,BOUTA) ;(T2/) Give this to the user
MOVEI T2,.CHNUL ;And terminate it correctly
CALLX (MSEC1,BOUTA) ;(T2/) Here's the null
ENDIF.
UMOVE T1,T1 ;Get updated byte pointer
UMOVEM T1,.SYDIR(Q2) ;And store it here
ENDIF.
MOVE T1,JOBPNM(Q3) ;Get job's SIXBIT program name
UMOVEM T1,.SYPRG(Q2) ;And toss it to the user
MOVE T1,JOB ;Get local job number
CALLX (MSEC1,LCL2GL) ;Get global job number
JRST LCLSY2 ;Oh, no...
UMOVEM T1,.SYJOB(Q2) ;Give user the job number
NOSKED ;We are touching terminal things
MOVE T2,CTRLTT(Q1) ;Get controlling terminal
UMOVEM T2,.SYTTY(Q2) ;And give to the user
XCTU [SETOM .SYSTT(Q2)] ;Assume running
IFGE. T2 ;Terminal active?
MOVEM T2,TTY ;Save terminal number for later
MOVEI T3,.TTDES(T2) ;Make it TTY designator for NTINF%
MOVEI T1,NTNBLK ;This is our NTINF% arg block
MOVEM T3,.NWLIN(T1) ;Save terminal designator here
SETZM .NWFNC(T1) ;Say function 0
MOVEI T3,10 ;This is the block length for NTINF%
MOVEM T3,.NWABC(T1) ;Store argument block length here
HRROI T3,ORGSTR ;Byte pointer for origin node string
MOVEM T3,.NWNNP(T1) ;Store byte pointer for NTINF%
NTINF% ;Do the JSYS
ERJMP SYSRUN ;If failed, probably bad terminal, so do next function
MOVE T3,.NWTTF(T1) ;Get flags returned
LDB T2,[POINT 9,T2,17] ;Get terminal network type
CAIN T2,NW%NNT ;Non-network line?
JRST SYSRUN ;Yup, ignore the rest of this stuff
XCTU [SKIPN T1,.SYORG(Q2)] ;Did user give us a byte pointer
IFSKP. ;If so, give him the origin string
MOVEI T2,ORGSTR ;Get origin string to give to user
SOS T2 ;Back this off for CPYTU1
MOVEI T3,.SYORG(Q2) ;Put updated byte pointer here
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give user originating host
MOVEI T2,NTNBLK ;Get NTINF% argument block
MOVE T2,.NWTTF(T2) ;Now we must check terminal type
LDB T2,[POINT 9,T2,17] ;Check terminal type
CAIE T2,NW%LAT ;Is it a LAT line?
IFSKP. ;If so,
MOVEI T2,SYSLAT ;Say so
JRST SYSORG ;And deposit in user space
ENDIF.
CAIE T2,NW%TCP ;How about TCP node?
IFSKP. ;If so,
MOVEI T2,SYSTCP ;Say so
JRST SYSORG ;And give it to the user
ENDIF.
MOVEI T2,NTNBLK ;We must check the other flags for these terminal types
HRRZ T2,.NWTTF(T2) ;Get the flags
CAIE T2,NW%CH ;Is this a CTERM host?
IFSKP. ;If so,
MOVEI T2,SYSCTM ;Say so
JRST SYSORG ;Now give whole string to user
ENDIF.
MOVEI T2,SYSNRT ;Else it must be a NRT line
SOS T2 ;This has to be LOC-1
SYSORG: CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give origin network to user
ENDIF. ;Done with the origin
SYSRUN: MOVE T2,TTY ;Get terminal back again
MOVE T1,TTACTL(T2) ;Get line block
LOAD T1,TWFRK,(T1) ;See if any forks in TI
CAIE T1,-1 ;-1 indicates no forks waiting
XCTU [SETZM .SYSTT(Q2)] ;But there are forks waiting
ENDIF.
CALLX (MSEC1,GTCJOB) ;(T2/T3) Ask for controlling job
IFNSK. ;If job disappeared, (shouldn't happen, we have JSB mapped)
OKSKED ;Allow scheduling
JRST LCLSY2 ;And bum out the caller
ENDIF.
OKSKED ;Scheduling is OK now
UMOVEM T3,.SYCJB(Q2) ;Give the controlling job to caller
MOVE T1,JOBRT(Q3) ;Get job's runtime
UMOVEM T1,.SYTIM(Q2) ;And pass it along
MOVE P1,JOB ;Get job number in this AC
CALL GETRTL ;[7.1200] (P1/T1) Get runtime limit
UMOVEM T1,.SYLIM(Q2) ;Give caller what we found
CALLX (MSEC1,CLRJSB) ;(/) Unmap other JSB and go OKINT
SKIPGE CLASSF ;[7.1105] Class scheduling on?
RETSKP ;No, don't bother with the rest of the info
MOVEI T2,SKDBLK ;Put the results here
MOVEI T1,7 ;Block length
MOVEM T1,.SACNT(T2) ;Store it in arg block
MOVE T1,JOB ;Get local job number
CALLX (MSEC1,LCL2GL) ;(T1/T1) Make it global
CALLRET LCLER1 ;(T1/) If blew up
MOVEM T1,.SAJOB(T2) ;Save job number in arg block
MOVEI T1,.SKRJP ;Read job paramters
SKED% ;From scheduler data base
ERJMP LCLERR ;Can't happen
MOVE T1,.SAJCL(T2) ;Get job's class
UMOVEM T1,.SYCLS(Q2) ;Give it up
MOVE T1,.SAJSH(T2) ;Get job share
UMOVEM T1,.SYSHR(Q2) ;Let user have it
MOVE T1,.SAJUS(T2) ;Get job utilization
UMOVEM T1,.SYUSE(Q2) ;Give it to caller
RETSKP ;Done fer sure
;Here when T1 has error
LCLSY2: CALLX (MSEC1,CLRJSB) ;Clear JSB mapping and go OKINT
CALLRET LCLERR
ENDSV.
SUBTTL INFO% -- LCLJOB (Get username's job numbers)
;LCLJOB - Given a username string, find all jobs his is logged into.
;
; Called with:
; T1/ User's INFO% argument block address
; CALL LCLJOB
;
; Returns:
; +1 - Never
; +2 - Always, with user's argument block updated or if error
; T1/ IN%RER + Error code
XSWAPCD ;Called from JSYS context
LCLJOB: SAVEQ ;Save some work storage
STKVAR <USRNUM,JBBLK,<USNAM,MAXLW+1>> ;Temp storage
UMOVE T2,.INAC2(T1) ;This is where the user wants the results
MOVEM T2,JBBLK ;Save for later
UMOVE T2,.INAC1(T1) ;Get user's byte pointer
XMOVEI T1,USNAM ;Put user string in this spot
SOS T1 ;Adjust for CPYFU6
MOVEI T3,MAXLC ;No more than this many characters
SETO T4, ;Don't trim the stack
CALLX (MSEC1,CPYFU6) ;(T1-T4/T1-T4) Get user's string
NOP ;Never here
MOVX T1,RC%EMO ;Must be an exact match username
HRROI T2,USNAM ;Here's the user string
RCUSR% ;Get 36 bit user number
ERJMP LCLERR ;Failed, must be because user messed up
TXNN T1,RC%NOM ;No match?
IFSKP. ;Yes
MOVEI T1,STRX08 ;Show it was a bad name
CALLRET LCLER1 ;(T1/) On remote...
ENDIF.
HRRZM T3,USRNUM ;Save user number for later (ignore left half)
MOVE Q1,JBBLK ;Get arg block user wants data in
MOVE Q2,JBBLK ;This will be used as a moving pointer
XCTU [SETZM .JOLEN(Q1)] ;Zero count of jobs returned
MOVSI Q3,-NJOBS ;Loop over all jobs
DO.
MOVE T1,JOBDIR(Q3) ;Get job's logged in directory number
CAME T1,USRNUM ;Is it one we are looking for?
IFSKP. ;If so,
HRRZ T1,Q3 ;Get just job number
CALL LCL2GL ;(T1/T1) Find the global job number
JRST LCLJB1 ;Failed, don't count this one
HRLZS T1 ;Put job number in left half
HLR T1,JOBPT(Q3) ;Get job's terminal number
AOS Q2 ;Get ready to store info in the next word
XCTU [AOS .JOLEN(Q1)] ;Increment our count for user
UMOVEM T1,(Q2) ;Give this data to user
ENDIF.
LCLJB1: AOBJN Q3,TOP. ;Do next job number
ENDDO.
CAME Q1,Q2 ;If the user was not logged in, these will be the same
IFSKP. ;If so,
MOVEI T1,INFX07 ;Get error code
CALLRET LCLER1 ;(T1/) Make it remote error
ELSE. ;If user was logged in,
XCTU [AOS .JOLEN(Q1)] ;Must now count the .JOLEN word in arg block
SETZ T1, ;Clear stray bits
ENDIF.
RETSKP ;And back to caller
ENDSV.
SUBTTL INFO% -- LCLGJI (Local GETJI%)
;LCLGJI - Called when INFO% was asked to perform a local GETJI%
;
; Called with:
; no arguments
; CALL LCLGJI
;
; Returns:
; +1 - Never
; +2 - Always, User's block updated or if error occured,
; T1/ IN%RER + Error code
XSWAPCD ;Process code
LCLGJI: UMOVE T2,.INAC3(T1) ;Get user's offset into table
UMOVEM T2,T3 ;Put it in the previous context AC
UMOVE T2,.INAC2(T1) ;Get address and length of arg block
UMOVEM T2,T2 ;Stash it here
XCTU [SKIPL T2,.INAC1(T1)] ;Get job or terminal designator
IFSKP. ;Can't use -1
MOVEI T1,INFX14 ;Give error to user
CALLRET LCLER1 ;(T1/) And go back to caller
ENDIF.
UMOVEM T2,T1 ;Put it in user space
IMCALL .GETJI,XCDSEC ;[7.1205] Do the JSYS
ERJMP LCLERR ;Do local error passing
MOVE T1,INFARG ;Get INFO% argument block back
XCTU [DMOVE T2,T1] ;Get updated arguments
XCTU [DMOVEM T2,.INAC1(T1)] ;Update arg block
UMOVE T2,T3 ;Last AC to update
UMOVEM T2,.INAC3(T1) ;Update user arg block
SETZ T1, ;Blast stray bits
RETSKP ;And things went wonderful
SUBTTL INFO% -- LCLMSR (Local MSTR%)
;LCLMSR - This routine is called when the INFO% JSYS is used but the
;requested MSTR% function belongs on the remote system.
;
; Called with:
; T1/ User's INFO% argument block address
; CALL LCLMSR
;
; Returns:
; +1 - Never
; +2 - Always, user's block updated or if error occured,
; T1/ IN%RER + Error code
XSWAPCD ;More process code
LCLMSR: XCTU [HRRZ T2,.INAC1(T1)] ;Get user's MSTR% function
CAIN T2,.MSRNU ;Is it this one?
JRST LCLMS0 ;Yes
CAIN T2,.MSRUS ;How about this?
JRST LCLMS0 ;Yes
CAIN T2,.MSGSS ;Or this one?
JRST LCLMS0 ;Yes
CAIN T2,.MSGSU ;Last chance?
JRST LCLMS0 ;Yes
MOVEI T1,INFX14 ;Say we can't do this
CALLRET LCLER1 ;(T1/) Outta here
LCLMS0: UMOVE T2,.INAC2(T1) ;Get user's argument block to return data
UMOVE T1,.INAC1(T1) ;Get user's AC 1
XCTU [DMOVEM T1,T1] ;Put MSTR% args here
IMCALL .MSTR,MSEC1 ;Do the JSYS for user
ERJMP LCLERR ;Had a problem
SETZ T1, ;Make sure no stray bits
RETSKP ;Done
LCLERR: MOVE T1,LSTERR ;Get last error
LCLER1: TXO T1,IN%RER ;Say error happened on "remote" system
RETSKP ;But still take good return
SUBTTL INFO% -- LCLTIM (Local TIME% JSYS)
;LCLTIM - Called when INFO% has a request to do a local TIME% JSYS.
;
; Called with:
; T1/ INFO% argument block
; CALL LCLTIM
;
; Returns:
; +1 - Not in this century
; +2 - All the time with user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD
LCLTIM: MOVE T2,TODCLK ;Get uptime
MOVEI T3,^D1000 ;This is always in T2
XCTU [DMOVEM T2,.INAC1(T1)] ;Give stuff to user
SETZ T1, ;No error
RETSKP ;And done
SUBTTL INFO% -- INFSYS (Remote SYSTAT information)
;INFSYS - Called when it is time to obtain information about a particular
;job/terminal on a remote system.
;
; Called with:
; T1/ INFO% Argument block
; CALL INFSYS
;
; Returns:
; +1 - Error
; T1/ Error code
; +2 - Success, with user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;Swappable because JSYS calls here
INFSYS: SAVEQ ;Save temps
STKVAR <SYSFSP,SYSCNT,SYSBLK> ;Temp storage
UMOVE T2,.INAC1(T1) ;Get argument block given by user
MOVEM T2,SYSBLK ;Save it for later
MOVEI T3,.INAC2(T1) ;Get job/terminal for remote system
MOVEI T4,1 ;Say only one word be sent to remote system
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function
NOINT ;No interruptions while we do work
CALL CL.ENT ;(T1-T4/T1,T2) Get results from remote system
RETBAD (,OKINT) ;Failed, go OKINT and back to caller
MOVEM T1,SYSFSP ;Stash free space we just got
MOVEM T2,SYSCNT ;And how many words in this free space
CAIE T2,1 ;Did we just get one word back?
IFSKP. ;Yep, this means we failed on the remote system
MOVE Q1,(T1) ;Get the error code
MOVE T3,SYSFSP ;Here's the free space to return
CALL CLFAIL ;(T2,T3/) Return free space and go OKINT
MOVE T1,Q1 ;Recapture error
TXO T1,IN%RER ;Say error was on remote
RETSKP ;And return
ENDIF.
MOVE Q1,SYSBLK ;Get user's argument block
MOVE Q2,SYSFSP ;Get free space address to remove data from
MOVE T1,(Q2) ;Get job program name
UMOVEM T1,.SYPRG(Q1) ;Give it to user
AOS Q2 ;Move to next data item
MOVE T1,(Q2) ;Get controlling terminal
UMOVEM T1,.SYTTY(Q1) ;Put in user space
AOS Q2 ;Next
MOVE T1,(Q2) ;Get controlling job number
UMOVEM T1,.SYCJB(Q1) ;Stash in user space
AOS Q2 ;Next
MOVE T1,(Q2) ;Get global job number
UMOVEM T1,.SYJOB(Q1) ;Give user global job number
AOS Q2 ;Next
MOVE T1,(Q2) ;Retrieve run state
UMOVEM T1,.SYSTT(Q1) ;Give it to user
AOS Q2 ;Move to next word
MOVE T1,(Q2) ;Next is job runtime
UMOVEM T1,.SYTIM(Q1) ;Give to user
AOS Q2 ;Bump our pointer
MOVE T1,(Q2) ;Get runtime limit
UMOVEM T1,.SYLIM(Q1) ;Pass along to user
AOS Q2 ;Next
MOVE T1,(Q2) ;Next is job class
UMOVEM T1,.SYCLS(Q1) ;Toss it in user space
AOS Q2 ;Next
MOVE T1,(Q2) ;Get job share
UMOVEM T1,.SYSHR(Q1) ;Give to user
AOS Q2 ;Next
MOVE T1,(Q2) ;Get job use
UMOVEM T1,.SYUSE(Q1) ;Pass it through
AOS Q2 ;Now do byte pointers
XCTU [SKIPN T1,.SYUSR(Q1)] ;Get given byte pointer if it exists
IFSKP. ;If it was given,
MOVE T2,Q2 ;Get start of user name string
MOVEI T3,.SYUSR(Q1) ;This where updated byte pointer goes
SOS T2 ;Back this up for CPYTU1
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give username
ENDIF.
ADDI Q2,MAXLW ;Account for user name string
XCTU [SKIPN T1,.SYDIR(Q1)] ;Get byte pointer to connect directory
IFSKP. ;If it was given
MOVE T2,Q2 ;Get start of connected directory string
MOVEI T3,.SYDIR(Q1) ;Give user the updated byte pointer
SOS T2 ;Back this off a little
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Copy the string over
ENDIF.
ADDI Q2,2*MAXLW ;Move past connected directory to origin
XCTU [SKIPN T1,.SYORG(Q1)] ;Get byte pointer if user supplied one
IFSKP. ;If it has been supplied
MOVE T2,Q2 ;Get start of origin
MOVEI T3,.SYORG(Q1) ;Put updated byte pointer here
SOS T2 ;Back this off a touch
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give user the origin
ENDIF.
MOVE T1,SYSFSP ;Get free space, we are done with it
MOVE T2,SYSCNT ;Get size of said free space
CALLRET CLGOOD ;(T1,T2/) Return free space, go OKINT
;and return to user
ENDSV.
SUBTTL INFO% -- INFCFG (Remote CNFIG%)
;INFCFG - Routine to make a remote system do a CNFIG% for us.
;
; Called with:
; T1/ INFO% Argument block
; CALL INFCFG
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, with user space updated or error on remote with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
INFCFG: SAVEQ ;Save these
STKVAR <CFGARG,CFGFUN,CFGLEN,CFGFSP> ;Temp storage
UMOVE T2,.INAC1(T1) ;Get function to do on remote node
MOVEM T2,CFGFUN ;Save function for later
UMOVE T2,.INAC2(T1) ;Get CNFIG% arg block address
MOVEM T2,CFGARG ;Save it for later
UMOVE T2,(T2) ;Now get the length as per user's specification
MOVEM T2,CFGLEN ;Save it for later
CAILE T2,PGSIZ ;If bigger than a page
RETBAD (CFGAAB) ;Then tell user this is not good
NOINT ;Now we are going to be doing the free space shuffle
MOVEI T1,2 ;Only need 2 word free space for sending
CALLX (MSEC1,ASGSWP) ;(T1/T1) Get some free space
RETBAD () ;If problem, report it
MOVEM T1,CFGFSP ;Save free space address for later
MOVE T2,CFGFUN ;Get function
MOVEM T2,(T1) ;Put it in free space to send
MOVE T2,CFGLEN ;Get arg block length too
MOVEM T2,1(T1) ;Save it in free space too
MOVE T1,INFFUN ;Get function
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T3,CAPENB ;Get our privs
TXNE T3,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T3,CFGFSP ;Here's what we want to send over
MOVEI T4,2 ;Only sending over 2 words
CALL CL.EN1 ;(T1-T4/T1,T2) Go get information
IFNSK. ;If failed,
MOVE T3,CFGFSP ;Then return free space
MOVEI T2,2 ;Only this many words
CALLRET CLFAIL ;(T2,T3) Return space, go OKINT and pass back error
ENDIF.
EXCH T1,CFGFSP ;Save one free space and return the other
MOVEM T2,CFGLEN ;Save free space length too
MOVEI T2,2 ;This is how long the other free space was
CALLX (MSEC1,RELSWP) ;(T1,T2/) Return our sent block
MOVE T2,CFGLEN ;Get returned length
CAIE T2,1 ;Did we just get one word back from remote?
IFSKP. ;If so, then we had an error
MOVE Q1,(T1) ;Get error code from remote system
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give back the error code free space
MOVE T1,CFGFSP ;Address of returned block
MOVEI T2,2 ;Return this many words
CALLX (MSEC1,RELSWP) ;(T1,T2/) Now return free space
OKINT ;Interruptions are OK now
TXO Q1,IN%RER ;Make sure error shows up
MOVE T1,Q1 ;Put error code in T1
RETSKP ;But take good return
ENDIF.
MOVE T1,CFGFUN ;Get function we just did
CAIE T1,.CFCND ;If this function
CAIN T1,.CFHSC ;Or this function
IFSKP. ;Handle these seperately (good old byte pointers)
MOVE T1,CFGFSP ;Here's the free space
LOAD T1,CF%WDP,(T1) ;Then length of argument block is here
ELSE. ;If not special function,
MOVE Q1,CFGFSP ;Get place where results where returned to
HLRZ Q3,(Q1) ;See how many nodes were found
AOS Q1 ;Get to starting point of byte pointers
MOVE Q2,CFGARG ;Find user's address of argument block
AOS Q2 ;Start here with the byte pointers
HRLI Q2,(POINT 7,) ;Make sure it looks like a byte pointer
ADD Q2,Q3 ;Figure in the node count
DO. ;Loop for each node
HRRM Q2,(Q1) ;Stash address here
SOSG Q3 ;Decrement our count
EXIT. ;No more byte pointers to update
ADDI Q2,2 ;Make next byte pointer
AOS Q1 ;And it will be put here
JRST TOP. ;And store it
ENDDO.
;Now calculate length of argument block for BLT
MOVE Q1,CFGFSP ;Get free space back
HLRZ T1,(Q1) ;See how many nodes were found
IMULI T1,3 ;That means there are 3*nodes words to give back
ENDIF.
AOS T1 ;This accounts for length word
MOVE T2,CFGFSP ;Get returned data
MOVE T3,CFGARG ;This is where user wants it
CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) Give it to him
MOVE T2,CFGLEN ;Get length of free space to give back
MOVE T1,CFGFSP ;Here's the free space
CALLRET CLGOOD ;(T1,T2/) Give it back and go OKINT
ENDSV.
SUBTTL INFO% -- INFDST (Remote DIRST%)
;INFDST - Performs a DIRST% on the remote system. We get results
;back here and return them to the user as specified in the .INAC1
;word of the argument block.
;
; Called with:
; T1/ INFO% argument block
; CALL INFDST
;
; Returns:
; +1 - Failure, with
; T1/ Error code
; +2 - Success, user space update or remote failure with
; T1/ IN%RER + Error code
XSWAPCD ;Process level code
INFDST: SAVEQ ;Preserved
STKVAR <DIRFSP,DIRCNT> ;Temp storage
MOVEI T3,.INAC2(T1) ;Get user/directory number
MOVEI T4,1 ;Say only one word here to be sent
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get INFO% function
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;If didn't work, we are done
MOVEM T1,DIRFSP ;Save string free space
MOVEM T2,DIRCNT ;Stash count of free space too
CAIN T2,1 ;If only one word, then remote error
CALLRET CLREMR ;If so, handle remote error
MOVE Q1,INFARG ;Get INFO% arg block back
UMOVE T2,.INAC1(Q1) ;Get user's destination designator
UMOVEM T2,T1 ;And put it here for JFNSSD
MOVE Q2,DIRFSP ;Get free space
HRLI Q2,(POINT 7,) ;Make a byte pointer
DO. ;Now loop over characters
ILDB T2,Q2 ;Get next character
CALLX (MSEC1,BOUTA) ;(A,B/A) Give character to previous context
JUMPN T2,TOP. ;Was it a null?
ENDDO.
UMOVE T2,T1 ;Get updated designator
UMOVEM T2,.INAC1(Q1) ;And return it here
MOVE T1,DIRFSP ;Get free space address back
MOVE T2,DIRCNT ;Get free space count back
CALLRET CLGOOD ;(T1,T2/) Return it, go OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFGTB (Remote GETAB%)
;INFGTB - Called when user wants a GETAB% done on another system.
;
; Called with:
; T1/ INFO% argument block
; CALL INFGTB
;
; Returns:
; +1 - Error with
; T1/ Error code
; +2 - Success, user space updated or error on remote with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS level code
INFGTB: SAVEQ ;Stash the temps
MOVEI T3,.INAC1(T1) ;Get GETAB% argument for remote node
MOVEI T4,1 ;Only sending 1 word over
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get INFO% function
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;If didn't work, we are done
CAIN T2,1 ;Did error happen on remote?
CALLRET CLREMR
MOVE Q1,INFARG ;Get info arg block back
MOVE Q2,(T1) ;Get remote results
UMOVEM Q2,.INAC1(Q1) ;Give it back to user
CALLRET CLGOOD ;(T1,T2/) Give free space, go OKINT and return to user
SUBTTL INFO% -- INFGTY (Remote GTTYP%)
;INFGTY - Routine called when a GTTYP% has been requested to be done
;on a remote system.
;
; Called with:
; T1/ INFO% argument block
; CALL INFGTY
;
; Returns:
; +1 - Error with
; T1/ Error code
; +2 - Success, user arg block updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS routine
INFGTY: SAVEQ ;Preserve like a good routine does
MOVEI T3,.INAC1(T1) ;Give user argument to remote system
MOVEI T4,1 ;Only one word to send
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Tell remote node what function to do
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;When we fail, admit it
CAIN T2,1 ;Only one word of free space returned?
CALLRET CLREMR ;Yes, give it back and return error
MOVE Q1,INFARG ;Recapture user's argument block
MOVE T3,.AC2(T1) ;Get terminal type and input buffers
UMOVEM T3,.INAC2(Q1) ;Return this result
MOVE T3,.AC3(T1) ;Get output buffer count
UMOVEM T3,.INAC3(Q1) ;And return to user space
CALLRET CLGOOD ;(T1,T2/) Now go back to user
SUBTTL INFO% -- INFINL (Remote INLNM%)
;INFINL - Called when user wants to know about system wide logical
;names on a remote system.
;
; Called with:
; T1/ INFO% argument block
; CALL INFINL
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success with user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS support
INFINL: SAVEQ ;Quasi's are used kind of
STKVAR <INLFSP,INLCNT> ;Temp storage
XCTU [HLRZ T2,.INAC1(T1)] ;Get function user wants
CAIN T2,.INLSY ;Can only do this one
IFSKP. ;If not given that one,
MOVEI T1,INFX14 ;Say remote couldn't do this
CALLRET LCLER1 ;(T1/) And go back to user
ENDIF.
MOVEI T3,.INAC1(T1) ;Give this word to be sent over
MOVEI T4,1 ;Only need to send this one word
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Tell remote node what function to do
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;When we fail, admit it
CAIN T2,1 ;Only one word of free space returned?
CALLRET CLREMR ;Do remote failure
MOVEM T1,INLFSP ;Save free space
MOVEM T2,INLCNT ;Save count of free space
MOVE T1,INFARG ;Recapture user argument block
MOVEI T3,.INAC2(T1) ;This is where the updated byte pointer goes
UMOVE T1,.INAC2(T1) ;Get byte pointer itself
MOVE T2,INLFSP ;Here's the monitor's string
SOS T2 ;Must be LOC-1
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Put string in user space
MOVE T1,INLFSP ;Now return free space
MOVE T2,INLCNT ;This many words of it
CALLRET CLGOOD ;(T1,T2/) And back to the user (go OKINT too)
ENDSV.
SUBTTL INFO% -- INFLNS (Remote LNMST%)
;INFLNS - Called when user wants a logical name translation for a logical
;name on a remote system.
;
; Called with:
; T1/ INFO% argument block
; CALL INFLNS
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success with user's argument block updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;Process stuff
INFLNS: SAVEQ ;Quasi preservation
STKVAR <LNSFSP,LNSCNT> ;Temp storage
UMOVE T2,.INAC1(T1) ;Get requested function
CAIN T2,.LNSSY ;Can only do this one
IFSKP. ;If not given this one,
MOVEI T1,INFX14 ;Say remote couldn't do this
CALLRET LCLER1 ;(T1/) And return
ENDIF.
NOINT ;Time to get free space, no interrupts
MOVEI T1,MAXLW ;Get this much free space
MOVEM T1,LNSCNT ;Save for later
CALLX (MSEC1,ASGSWP) ;(T1/T1) Get the free space
RETBAD (INFX06,OKINT) ;When out of free space, say so
MOVEM T1,LNSFSP ;Save address of free space for now
SOS T1 ;Must point to free space - 1 for CPYFU6
MOVE T2,INFARG ;Recapture argument block
UMOVE T2,.INAC2(T2) ;Get user's byte pointer
MOVEI T3,MAXLC ;This is max number of characters
SETO T4, ;Don't trim free space for me
CALLX (MSEC1,CPYFU6) ;(T1-T4/) Copy user's string into monitor space
NOP ;Never back here
MOVE T3,LNSFSP ;This is what is to be sent over the wire
MOVE T4,LNSCNT ;Here's the word count
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Tell remote node what function to do
CALL CL.EN1 ;(T1-T4/T1,T2) Send number over and wait for answer
IFNSK. ;If failed,
MOVE T3,LNSFSP ;Restore free space
MOVE T2,LNSCNT ;Of these many words
CALLRET CLFAIL ;(T2,T3/) Return space, go OKINT, and back to user
ENDIF.
CAIE T2,1 ;Was error on remote?
IFSKP. ;If so,
MOVE Q1,(T1) ;Get error code
CALLX (MSEC1,RELSWP) ;(T1,T2/) Return the free space with error code in it
MOVE T1,LNSFSP ;Now give back what we are tying up
MOVE T2,LNSCNT ;This many words
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give it back
OKINT ;Our hands are no longer tied
MOVE T1,Q1 ;Get remote error code back
TXO T1,IN%RER ;Say it was remote
RETSKP ;And return success
ENDIF.
EXCH T1,LNSFSP ;[7.1114] Save new free space, get old
EXCH T2,LNSCNT ;[7.1114] Now exchange free space sizes
CALLX (MSEC1,RELSWP) ;[7.1114] (T1,T2/) Give back this set
MOVE T1,INFARG ;Now we must return the logical name translation
MOVEI T3,.INAC3(T1) ;Updated byte pointer goes here for user
UMOVE T1,.INAC3(T1) ;Get the byte pointer
MOVE T2,LNSFSP ;Here's the string to transfer to user
SOS T2 ;Must be LOC-1
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/) Give the user what the remote system gave us
MOVE T1,LNSFSP ;Return this free space
MOVE T2,LNSCNT ;Here's the count
CALLRET CLGOOD ;(T1,T2/) And return wonderful, OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFJOB (Get jobs of user on remote system)
;INFJOB - This routine is called when a request is done for a remote
;system to give the jobs and terminals of the given username.
;
; Called with:
; T1/ INFO% argument block
; CALL INFJOB
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS support routine
INFJOB: SAVEQ ;Save these
STKVAR <USRNUM,<USERNM,MAXLW+1>,JOBFSP,JOBCNT> ;Temp storage
UMOVE T2,.INAC1(T1) ;Get users byte pointer
XMOVEI T1,USERNM ;Put user name here
SOS T1 ;Must back it up by a word
MOVEI T3,MAXLC ;Copy no more than this many characters
SETO T4, ;Don't trim on us
CALLX (MSEC1,CPYFU6) ;(T1-T4/T1-T4) Get user's byte string
NOP ;Never here
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T3,CAPENB ;Get our privs
TXNE T3,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Tell remote node what function to do
XMOVEI T3,USERNM ;Here's the user string to send over
MOVEI T4,<MAXLW+1> ;There is how many characters to send
NOINT ;No interruptions
CALL CL.EN1 ;(T1-T4/T1,T2) Send request over
RETBAD (,OKINT) ;When we fail, pass error back
CAIN T2,1 ;Was there an error on remote?
CALLRET CLREMR ;Yes, handle it
MOVEM T1,JOBFSP ;Save free space for return later
MOVEM T2,JOBCNT ;Save free space count
MOVE Q1,INFARG ;Get argument block back
UMOVE T3,.INAC2(Q1) ;Get user's block for returned data
MOVE T1,.JOLEN(T1) ;Get number of words to BLT
MOVE T2,JOBFSP ;Here's the free space to blast to user
CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) Give user the results
MOVE T1,JOBFSP ;Here's the free space to return
MOVE T2,JOBCNT ;Free space count to return
CALLRET CLGOOD ;(T1,T2/) Return space, OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFMTO (Remote MTOPR%)
;INFMTO - Do a remote MTOPR% function. The legal functions are kept in
;the MTOTAB.
;
; Called with:
; T1/ INFO% argument block
; CALL INFMTO
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, user's argument block updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;Process code
INFMTO: SAVEQ ;Quasi preservation
UMOVE T2,.INAC2(T1) ;Get user's function
MOVSI Q1,-MTOLEN ;Get table size
DO. ;Loop over all entries
CAMN T2,MTOTAB(Q1) ;Do we match the function?
EXIT. ;Yes we do, got a legal one
AOBJN Q1,TOP. ;No, keep scanning
MOVEI T1,INFX14 ;Couldn't find a legal function
CALLRET LCLER1 ;(T1/) So get out of here
ENDDO.
MOVEI T3,.INAC1(T1) ;Give this word to be sent over
MOVEI T4,3 ;Send over 3 ACs
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Tell remote node what function to do
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;When we fail, admit it
CAIN T2,1 ;Only one word of free space returned?
CALLRET CLREMR ;Yes, then error on remote
MOVE Q1,INFARG ;Get user's argument block back
MOVE T3,.AC2(T1) ;Retreive this data element
UMOVEM T3,.INAC2(Q1) ;And give it back to user
MOVE T3,.AC3(T1) ;Get this item too
UMOVEM T3,.INAC3(Q1) ;And give it to user
CALLRET CLGOOD ;(T1,T2) Get rid of free space, OKINT and back to user
SUBTTL INFO% -- INFMUT (Remote MUTIL%)
;INFMUT - Called when the user requests an MUTIL% function to be performed
;on the given remote system. Only functions in the MUTTAB are valid functions
;to be executed remotely.
;
; Called with:
; T1/ INFO% argument block
; CALL INFMUT
;
; Returns:
; +1 - Failure, with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
INFMUT: SAVEQ ;Quasi preservation
STKVAR <MUTFSP,MUTCNT,MUTFUN> ;Temp storage
UMOVE T2,.INAC2(T1) ;Get user's argument block for MUTIL%
UMOVE T2,(T2) ;Get user's requested function
MOVEM T2,MUTFUN ;Save MUTIL% function for later
MOVSI Q1,-MUTLEN ;Get table size
DO. ;Loop over all entries
CAMN T2,MUTTAB(Q1) ;Do we match the function?
EXIT. ;Yes we do, got a legal one
AOBJN Q1,TOP. ;No, keep scanning
MOVEI T1,INFX14 ;Couldn't find a legal function
CALLRET LCLER1 ;(T1/) So get out of here
ENDDO.
MOVEI T1,2 ;This is how many words of free space we need
MOVEM T1,MUTCNT ;Save count
NOINT ;No interrupts while we have free space
CALLX (MSEC1,ASGSWP) ;(T1/T1,T2) Get that free space
RETBAD (INFX06,OKINT) ;Return error and OKINT
MOVEM T1,MUTFSP ;Save free space
MOVE T2,INFARG ;Get argument block address back
UMOVE T3,.INAC1(T2) ;Get argument block size
CAIL T3,PGSIZ ;Is it under a page?
MOVEI T3,<PGSIZ-1> ;No, make it be only this big
MOVEM T3,.AC1(T1) ;Send this over to remote
MOVE T2,MUTFUN ;Get MUTIL% function
MOVEM T2,.AC2(T1) ;Save in free space
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Tell remote node what function to do
MOVE T3,MUTFSP ;Send over this free space
MOVE T4,MUTCNT ;Get count of free space to send
CALL CL.EN1 ;(T1-T4/T1,T2) Send number over and wait for answer
IFNSK. ;If failed,
MOVE T3,MUTFSP ;Get rid of free space
MOVE T2,MUTCNT ;This is how much of it
CALLRET CLFAIL ;(T2,T3/) Gid rid of free space, OKINT and back to user
ENDIF.
CAIE T2,1 ;Only one word of free space returned?
IFSKP. ;If, so remote error
MOVE Q1,(T1) ;Get remote error code
CALLX (MSEC1,RELSWP) ;(T1,T2/) Return free space
MOVE T1,MUTFSP ;Get rid of this too
MOVE T2,MUTCNT ;This is how many words to drop
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give it the monitor
OKINT ;Interrupts are fine now
MOVE T1,Q1 ;Get error code back
TXO T1,IN%RER ;Say it was remote
RETSKP ;And return to caller
ENDIF.
EXCH T1,MUTFSP ;Save one set of free space and get the other
EXCH T2,MUTCNT ;Samething with the free space counts
CALLX (MSEC1,RELSWP) ;(T1,T2/) Return what we do not need
MOVE Q1,INFARG ;Get INFO% argument block back
UMOVE T3,.INAC2(Q1) ;Get user's argument block
UMOVE T1,.INAC1(Q1) ;Get length of argument block
CAILE T1,MUTCNT ;Make sure it isn't too big
MOVE T1,MUTCNT ;If it is, then only give this many words back
MOVE T2,MUTFSP ;Here's the results
CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) Give them to user
MOVE T1,MUTFSP ;Now give back free space
MOVE T2,MUTCNT ;And the count of words in block
CALLRET CLGOOD ;(T1,T2) Give up free space and go OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFRCR/INFRCD (Remote RCUSR%/RCDIR%)
;INFRCR/INFRCD - Called when a user wants a remote system to perform a
;RCUSR% or RCDIR% monitor call.
;
; Called with:
; T1/ INFO% argument block
; CALL INFRCR for remote RCUSR%
; or
; CALL INFRCD for remote RCDIR%
;
; Returns:
; +1 - Failure, with
; T1/ Error code
; +2 - Success, with results in user space or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
INFRCR: ;Both entry points are the same
INFRCD: SAVEQ ;Save quasi's
STKVAR <FLAGS,NUMBER,RCFSP,RCCNT> ;Temp storage
;The extra 2 words for below are used for directory/user number and flags word
MOVEI T2,<2*MAXLW+3+2> ;Need this many words to hold string + 2 words
MOVEM T2,RCCNT ;Save count for later
NOINT ;No interrupts while using free space.
CALLX (MSEC1,ASGJFR) ;(T2/T1) Get job free space
RETBAD (,OKINT) ;When out of free space, say so
MOVEM T1,RCFSP ;Save free space address
MOVE T1,INFARG ;Get user block back
UMOVE T2,.INAC2(T1) ;Get user's string
MOVE T1,RCFSP ;Copy user string to here
AOS T1 ;Want string to start after flags and number
MOVEI T3,2*MAXLC+3 ;No more than this many characters
SETO T4, ;No trim the stack
CALLX (MSEC1,CPYFU6) ;(T1,T2,T3,T4/T1,T2) Get user's string
NOP ;Always a return of +2
MOVE T1,INFARG ;Get argument block address back
MOVE T3,RCFSP ;Get index to JSB free space
UMOVEM T2,.INAC2(T1) ;Give updated byte pointer back to user
UMOVE T2,.INAC1(T1) ;Get flags from user
MOVEM T2,.AC1(T3) ;Save flags for sending
UMOVE T2,.INAC3(T1) ;Get user/directory number for stepping
MOVEM T2,.AC2(T3) ;Save user number for sending too
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function code
MOVE T3,RCFSP ;Here's what to send
MOVE T4,RCCNT ;And how much to send
CALL CL.EN1 ;(T1-T4/T1,T2) Do the work
IFNSK. ;If we fail,
MOVE Q1,T1 ;Save error code
MOVE T2,RCFSP ;Return the free space
CALLX (MSEC1,RELJFR) ;(T2/) Give it back
OKINT ;Interrupts are OK
MOVE T1,Q1 ;Get error code back
RETBAD () ;And return failure
ENDIF.
CAIE T2,1 ;Remote error?
IFSKP. ;If remote error
MOVE Q1,(T1) ;Get the error code
CALLX (MSEC1,RELSWP) ;(T1,T2/) Get rid of the free space from CL.EN1
MOVE T2,RCFSP ;Now return the JSB free space
CALLX (MSEC1,RELJFR) ;(T2/) Give it back
OKINT ;Interrupts are now fine
MOVE T1,Q1 ;Get error code back
TXO T1,IN%RER ;Say it was remote
RETSKP ;And go back to the user
ENDIF.
EXCH T1,RCFSP ;Exchange what we got for what we are gonna return
MOVEM T2,RCCNT ;Stash count of what we just got
MOVE T2,T1 ;Put free space we used from JSB in correct AC
CALLX (MSEC1,RELJFR) ;(T2/) Release it
MOVE T2,INFARG ;Retrieve INFO% argument block
MOVE T1,RCFSP ;Get free space back
MOVE T3,.AC1(T1) ;Get updated flags
UMOVEM T3,.INAC1(T2) ;Give them to the user
MOVE T3,.AC2(T1) ;Now get the user/directory number
UMOVEM T3,.INAC3(T2) ;It goes here in user space
MOVE T2,RCCNT ;Now release free space gotten from CL.EN1
CALLRET CLGOOD ;(T1,T2/) Back to user and OKINT
ENDSV.
SUBTTL INFO% -- INFSKD (Remote SKED%)
;INFSKD - Called when the user does an INFO% JSYS and wants some
;SKED% results from a remote node.
;
; Called with:
; T1/ INFO% argument block
; CALL INFSKD
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;Process level code
INFSKD: SAVEQ ;Preserve what must be preserved
STKVAR <SKDFSP,SKDCNT> ;Brief storage
UMOVE T2,.INAC1(T1) ;Get the SKED% function code
MOVSI Q1,-SKDLEN ;Make AOBJN pointer
DO. ;Make sure user is doing a legal function
CAMN T2,SKDTAB(Q1) ;Is this the right function
EXIT. ;Yes, then go for it
AOBJN Q1,TOP. ;No, keep checking
MOVEI T1,INFX14 ;Say bas function to execute
CALLRET LCLER1 ;(T1/) But return as if error was on remote
ENDDO.
MOVEI T1,3 ;We only need 3 words of free space
MOVEM T1,SKDCNT ;Save count for later
NOINT ;No interruptions while we have free space
CALLX (MSEC1,ASGSWP) ;(T1/T1,T2) Get the free space
RETBAD (INFX06,OKINT) ;We tried
MOVEM T1,SKDFSP ;Save address for later
MOVE Q1,INFARG ;Refind argument block
UMOVE T2,.INAC1(Q1) ;Get requested function
MOVEM T2,.AC1(T1) ;Save function for remote system
UMOVE T2,.INAC2(Q1) ;Find address of argument block for SKED%
UMOVE T3,.SAJOB(T2) ;Get job number (if provided)
MOVEM T3,.AC3(T1) ;Send it across too
UMOVE T2,.SACNT(T2) ;Get its length
MOVEM T2,.AC2(T1) ;And put it in free space
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get the function code
MOVE T3,SKDFSP ;Here's what to send
MOVE T4,SKDCNT ;And how much to send
CALL CL.EN1 ;(T1-T4/T1,T2) Go get results
IFNSK. ;When failure
MOVE T3,SKDFSP ;Get free space address
MOVE T2,SKDCNT ;And how much
CALLRET CLFAIL ;(T2,T3/) Return it, OKINT and back to user
ENDIF.
CAIE T2,1 ;Was there an error on remote?
IFSKP. ;If so,
MOVE Q1,(T1) ;Save remote error code
CALLX (MSEC1,RELSWP) ;(T1,T2/) Return free space
MOVE T1,SKDFSP ;Now return this free space
MOVE T2,SKDCNT ;This is how many words
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give it back
OKINT ;Interrupts are OK now
MOVE T1,Q1 ;Get error code back
TXO T1,IN%RER ;Say remote error
RETSKP ;And return good to caller
ENDIF.
EXCH T1,SKDFSP ;Save results free space and return old stuff
EXCH T2,SKDCNT ;Same with count
CALLX (MSEC1,RELSWP) ;(T1,T2/) Return stuff we don't need any more
MOVE Q2,INFARG ;Get user's argument block back
MOVE T2,SKDFSP ;Here's where the results are
HRRZ T1,.AC1(T2) ;Here's how many words to blast
UMOVE T3,.INAC2(Q2) ;Here's where the user wants them
CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) Give it to the user
MOVE T1,SKDFSP ;Now get rid of the free space
MOVE T2,SKDCNT ;This is how many words
CALLRET CLGOOD ;(T1,T2/) Give back free space, OKINT and return
ENDSV.
SUBTTL INFO% -- INFSNP (Remote SNOOP%)
;INFSNP - Request for a remote system to do SNOOP% for this system. Remote
;system can only perform .SNPSY or .SNPAD functions.
;
; Called with:
; T1/ INFO% argument block
; CALL INFSNP
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;Process code
INFSNP: SAVEQ ;Save these
MOVE T2,CAPENB ;Get process capabilities
TXNN T2,SC%WHL!SC%OPR!SC%MNT ;Have enough privs?
RETBAD (SNOPX1) ;Say not enough privs
UMOVE T2,.INAC1(T1) ;Get requested function
CAIN T2,.SNPSY ;Is it this one?
JRST INFSN1 ;Yes, do it
CAIN T2,.SNPAD ;Or this one?
IFSKP. ;If neither
MOVEI T1,INFX14 ;Get error code
CALLRET LCLER1 ;(T1/) And say remote can't do it
ENDIF.
INFSN1: MOVEI T3,.INAC1(T1) ;This is what we are sending over
MOVEI T4,3 ;Send only 3 words
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR!SC%MNT ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function back
NOINT ;Can't be interrupted now
CALL CL.ENT ;(T1-T4/T1,T2) Send user's data over
RETBAD (,OKINT) ;Interrupts are fine when we fail
CAIN T2,1 ;Remote failure?
CALLRET CLREMR ;Yes, tell user
DMOVE Q2,.AC2(T1) ;Get updated data for ACs
MOVE Q1,INFARG ;Get argument block back
XCTU [DMOVEM Q2,.INAC2(Q1)] ;Now give both results to user
CALLRET CLGOOD ;(T1,T2/) And return free space, OKINT and back to user
SUBTTL INFO% -- INFSGT (Remote SYSGT%)
;INFSGT - Do a remote SYSGT% on the given node.
;
; Called with:
; T1/ INFO% argument block
; CALL INFSGT
;
; Returns:
; +1 - Error with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS
INFSGT: SAVEQ ;Preserve what must be
MOVEI T3,.INAC1(T1) ;Get word to be sent over
MOVEI T4,1 ;Say only one word
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function back
NOINT ;Can't be interrupted now
CALL CL.ENT ;(T1-T4/T1,T2) Send user's data over
RETBAD (,OKINT) ;Interrupts are fine when we fail
CAIN T2,1 ;Remote error?
CALLRET CLREMR ;Yes, give back free space and back to user
MOVE Q1,INFARG ;Get user's argument block back
DMOVE Q2,.AC1(T1) ;See what remote system said
XCTU [DMOVEM Q2,.INAC1(Q1)] ;Give it to user
CALLRET CLGOOD ;(T1,T2/) And return free space, OKINT etc.
SUBTTL INFO% -- INFTMN (Remote TMON%)
;INFTMN - Do a remote TMON% on the given node.
;
; Called with:
; T1/ INFO% argument block
; CALL INFTMN
;
; Returns:
; +1 - Error with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS
INFTMN: SAVEQ ;Preserve what must be
MOVEI T3,.INAC1(T1) ;Get word to be sent over
MOVEI T4,1 ;Say only one word
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function back
NOINT ;Can't be interrupted now
CALL CL.ENT ;(T1-T4/T1,T2) Send user's data over
RETBAD (,OKINT) ;Interrupts are fine when we fail
CAIN T2,1 ;Remote error?
CALLRET CLREMR ;Yes, give back free space and back to user
MOVE Q1,INFARG ;Get user's argument block back
MOVE Q2,.AC2(T1) ;See what remote system said
UMOVEM Q2,.INAC2(Q1) ;Give it to user
CALLRET CLGOOD ;(T1,T2/) And return free space, OKINT etc.
SUBTTL INFO% -- INFXPK (Remote XPEEK%)
;INFXPK - Called when a user requests a remote system for some XPEEK%
;information.
;
; Called with:
; T1/ INFO% argument block
; CALL INFXPK
;
; Returns:
; +1 - Failure, with
; T1/ Error code
; +2 - Success, user space updated or remote failure with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
INFXPK: SAVEQ ;Save these
STKVAR <XPKFSP,XPKCNT> ;Good ole temp storage
MOVE T2,CAPENB ;Get process capabilities
TXNN T2,SC%WHL!SC%OPR!SC%MNT ;Have enough privs?
RETBAD (CAPX2) ;Say not enough privs
UMOVE T2,.INAC1(T1) ;Get XPEEK% argument block
UMOVE T2,.XPCN1(T2) ;Get requested amount of words
CAIG T2,PGSIZ ;Is it small enough?
IFSKP. ;No, too big
MOVEI T1,INFX17 ;Return error to user
CALLRET LCLER1 ;(T1/) Make like error from remote
ENDIF.
UMOVE T3,.INAC1(T1) ;This is what we are sending over
MOVEI T4,.XPUAD ;Send this many words
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR!SC%MNT ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function back
NOINT ;Can't be interrupted now
CALL CL.ENT ;(T1-T4/T1,T2) Send user's data over
RETBAD (,OKINT) ;Interrupts are fine when we fail
CAIN T2,1 ;Remote failure?
CALLRET CLREMR ;Yes, tell user
MOVEM T1,XPKFSP ;Save free space address
MOVEM T2,XPKCNT ;Save free space count of words
MOVE T1,INFARG ;Get INFO% arg block back
UMOVE T3,.INAC1(T1) ;Find XPEEK% block
UMOVE T4,.XPCN1(T3) ;Get count user wanted
CAMLE T4,XPKCNT ;Is it less than what we have?
MOVE T4,XPKCNT ;No, then this is the correct count
UMOVEM T4,.XPCN2(T3) ;This is what user is going to get
MOVE T1,T4 ;Get length here
MOVE T2,XPKFSP ;Here's the space
UMOVE T3,.XPUAD(T3) ;Get user spot to start transfer
CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) Give the user the data
MOVE T1,XPKFSP ;Now return this free space
MOVE T2,XPKCNT ;This much of it
CALLRET CLGOOD ;(T1,T2/) Go OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFDVC (Remote DVCHR%)
;INFDVC - Routine called when a request has been handed to the monitor
;for a DVCHR% JSYS but the system to do the JSYS is not the local one.
;
; Called with:
; T1/ INFO% argument block
; CALL INFDVC
;
; Returns:
; +1 - Error, with
; T1/ Error code
; +2 - Success, with user space updated or remote failure with
; T1/ IN%RER + Error code
XSWAPCD ;User level code
INFDVC: SAVEQ ;Save what we destroy
MOVEI T3,.INAC1(T1) ;This is what we are sending over
MOVEI T4,1 ;Send this many words
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function back
NOINT ;Can't be interrupted now
CALL CL.ENT ;(T1-T4/T1,T2) Send user's data over
RETBAD (,OKINT) ;Interrupts are fine when we fail
CAIN T2,1 ;Remote failure?
CALLRET CLREMR ;Yes, tell user
MOVE Q2,INFARG ;Get user's arg block back
MOVE Q1,.AC1(T1) ;Get device designator
UMOVEM Q1,.INAC1(Q2) ;Give it to the user
MOVE Q1,.AC2(T1) ;Now for characteristics word
UMOVEM Q1,.INAC2(Q2) ;Pass it along
MOVE Q1,.AC3(T1) ;And who is using this device
UMOVEM Q1,.INAC3(Q2) ;Also give this to user
CALLRET CLGOOD ;(T1,T2/) Now done
SUBTTL INFO% -- INFSTV (Remote STDEV%)
;INFSTV - Called to have a remote system service a request for this
;system. The request is for a STDEV% JSYS to be executed.
;
; Called with:
; T1/ INFO% argument block
; CALL INFSTV
;
; Returns:
; +1 - Failure of some sort, with
; T1/ Error code
; +2 - Success, with user space updated or remote failure with
; T1/ IN%RER + Error code
XSWAPCD ;More JSYS code
INFSTV: SAVEQ ;These are used a little
STKVAR <STVFSP,STVCNT> ;Temp stuff
MOVEI T1,MAXLW ;This is the biggest string we need
MOVEM T1,STVCNT ;Save count for later
NOINT ;Tieing up free space
CALLX (MSEC1,ASGSWP) ;(T1/T1,T2)
RETBAD (INFX06,OKINT) ;Not enough space
MOVEM T1,STVFSP ;Save this for later
SOS T1 ;String copy routine wants free space - 1
MOVE T3,INFARG ;Find user's string to copy
UMOVE T2,.INAC1(T3) ;Here it is
MOVEI T3,MAXLC ;It's only this many characters
SETO T4, ;Don't trim my free space please
CALLX (MSEC1,CPYFU6) ;(T1-T4/T1-T4) Get user's string in monitor space
NOP ;Never here
HRRZ T2,INFCI ;Get CI node to do request on
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get function back
MOVE T3,STVFSP ;Here's what is to be sent
MOVE T4,STVCNT ;And how much of it
CALL CL.EN1 ;(T1-T4/T1,T2) Send it and wait for the return
IFNSK. ;If failure
MOVE T3,STVFSP ;Return this free space
MOVE T2,STVCNT ;This many words
CALLRET CLFAIL ;(T2,T3/) Give back free space, OKINT too
ENDIF.
CAIE T2,1 ;Remote failure?
IFSKP. ;If so,
EXCH T1,STVFSP ;Return what we have been tieing up
EXCH T2,STVCNT ;But save the new stuff
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give back our free space
MOVE T1,STVFSP ;Now do the error from remote routine
MOVE T2,STVCNT ;With this free space and the count
CALLRET CLREMR ;OKINT here and give remote error to user
ENDIF.
MOVE Q1,.AC2(T1) ;Get device designator
MOVE Q2,INFARG ;Get user's arg block back
UMOVEM Q1,.INAC2(Q2) ;Give user what we found
CALLRET CLGOOD ;(T1,T2/) Now return free space and OKINT then done
ENDSV.
SUBTTL INFO% -- INFDVT (Remote DEVST%)
;INFDVT - This routine is called to send a request over to a remote system
;and have it simulate a DEVST% JSYS for us.
;
; Called with:
; T1/ INFO% argument block
; CALL INFDVT
;
; Returns:
; +1 - Failure, with
; T1/ Error code
; +2 - Success, with user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS support
INFDVT: SAVEQ ;Preserved
STKVAR <DVTFSP,DVTCNT> ;Temp storage
MOVEI T3,.INAC2(T1) ;Get device designator
MOVEI T4,1 ;Say only one word here to be sent
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get INFO% function
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;If didn't work, we are done
MOVEM T1,DVTFSP ;Save string free space
MOVEM T2,DVTCNT ;Stash count of free space too
CAIN T2,1 ;If only one word, then remote error
CALLRET CLREMR ;If so, handle remote error
MOVE Q1,INFARG ;Get INFO% arg block back
UMOVE T2,.INAC1(Q1) ;Get user's destination designator
UMOVEM T2,T1 ;And put it here for JFNSSD
MOVE Q2,DVTFSP ;Here's the device name
HRLI Q2,(POINT 7,) ;Make a nice 7-bit byte pointer
DO. ;Now give the string to the user
ILDB T2,Q2 ;Get the byte
CALLX (MSEC1,BOUTA) ;(A,B/A) Give byte to user destination
JUMPN T2,TOP. ;Was it a null?
ENDDO.
UMOVE T2,T1 ;Get updated designator
UMOVEM T2,.INAC1(Q1) ;And return it here
MOVE T1,DVTFSP ;Get free space address back
MOVE T2,DVTCNT ;Get free space count back
CALLRET CLGOOD ;(T1,T2/) Return it, go OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFNTF (Remote NTINF%)
;INFNTF - Called when this system wants a remote system to do a
;NTINF% JSYS.
;
; Called with:
; T1/ INFO% argument block
; CALL INFNTF
;
; Returns:
; +1 - Failure, with
; T1/ Error code
; +2 - Success, with user space updated or remote failure
; T1/ IN%RER + Error code
XSWAPCD ;JSYS support
INFNTF: SAVEQ ;Preserved
STKVAR <NTFFSP,NTFCNT> ;Temp storage
MOVE T3,.INAC1(T1) ;Get NTINF% argument block
MOVEI T4,<.NWNU1+1> ;Send over this whole argument block
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get INFO% function
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;If didn't work, we are done
MOVEM T1,NTFFSP ;Save string free space
MOVEM T2,NTFCNT ;Stash count of free space too
CAIN T2,1 ;If only one word, then remote error
CALLRET CLREMR ;If so, handle remote error
MOVE Q1,INFARG ;Get INFO% arg block back
UMOVE Q2,.INAC1(Q1) ;Get NTINF% argument block
XCTU [SKIPE T1,.NWNNP(Q2)] ;User give us a destination designator?
IFSKP. ;If not,
MOVEI T1,DESX1 ;Say bad destination designator
MOVE T2,NTFCNT ;Get free space count
MOVE T3,NTFFSP ;Here's the free space
CALL CLFAIL ;(T2,T3/) Return space, OKINT
TXO T1,IN%RER ;Say remote error
RETSKP ;And done
ENDIF.
MOVEI T3,.NWNNP(Q2) ;Here's where the updated byte pointer goes
MOVE T2,NTFFSP ;Now find the string to give the user
ADDI T2,<.NWNU1+2> ;It starts here
SOS T2 ;Must be LOC-1
CALLX (MSEC1,CPYTU1) ;Give it to the user
MOVE T1,NTFFSP ;Get returned stuff and give it to user
MOVE Q1,.NWTTF(T1) ;Here's terminal flags
UMOVEM Q1,.NWTTF(Q2) ;Give them to the user
DMOVE T2,.NWNNU(T1) ;Get node number words
XCTU [DMOVEM T2,.NWNNU(Q2)] ;And give them to the user
MOVE T2,NTFCNT ;Get free space count back
CALLRET CLGOOD ;(T1,T2/) Return space, OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFGJI (Remote GETJI%)
;INFGJI - This routine is called to simulate a GETJI% on the remote system.
;
; Called with:
; T1/ INFO% argument block
; CALL INFGJI
;
; Returns:
; +1 - Error with
; T1/ Error code
; +2 - Success, user space updated or remote error with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS code
INFGJI: SAVEPQ ;Preserve the quasi motos
STKVAR <GJIFSP,GJICNT,OLDCNT,NEWCNT,GJIBK> ;Free space and count
XCTU [SKIPL .INAC1(T1)] ;See if user specified -1 as job
IFSKP. ;If so,
MOVEI T1,INFX14 ;Say remote node can't do this
CALLRET LCLER1 ;(T1/) And return
ENDIF.
XCTU [HRRZ T3,.INAC2(T1)] ;Get user's argument block address
MOVEM T3,GJIBK ;Save user's argument block
XCTU [HLRE T3,.INAC2(T1)] ;Get initial count
MOVEM T3,OLDCNT ;Save for later
MOVEI T3,.INAC1(T1) ;Start sending from here
MOVEI T4,3 ;Send over three ACs
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get INFO% function
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;If didn't work, we are done
CAIN T2,1 ;Error on remote?
CALLRET CLREMR ;If so, handle this
MOVEM T1,GJIFSP ;Save free space
MOVEM T2,GJICNT ;Save count of free space
MOVE Q1,INFARG ;Refetch the argument block
HLRE T2,.AC2(T1) ;Get updated count
MOVEM T2,NEWCNT ;Save updated count
XCTU [HLLM T2,.INAC2(Q1)] ;Give updated count to user
SETZ P3, ;Start with no session remark
UMOVE P1,.INAC3(Q1) ;Get index that user gave
MOVEI P2,.JISRM ;Get session remark place
SUB P2,P1 ;Figure out if session remark was to be included
SKIPGE P2 ;Was byte pointer in here?
IFSKP. ;Maybe...
MOVE T1,NEWCNT ;Get the new count
SUB T1,OLDCNT ;Subtract the old count
SUB T1,P2 ;This better pass this word
SKIPGE T1 ;Did we pass this word?
JRST INFGJ1 ;No, then we are done
XCTU [HRRZ P1,.INAC2(Q1)] ;Get argument block
ADD P1,P2 ;Session remark byte pointer is here
SETO P2, ;Say byte pointer was really here
UMOVE P3,(P1) ;Get byte pointer to session remark
ENDIF.
INFGJ1: MOVE T1,NEWCNT ;Get updated counter again
SUB T1,OLDCNT ;Subtract out old count and now we have
;number of words to BLT to user
XCTU [ADDM T1,.INAC2(Q1)] ;Also update argument block pointer
MOVE T2,GJIFSP ;Here's the data to be BLTed
ADDI T2,3 ;But it starts past the updated ACs
MOVE T3,GJIBK ;Get user's GETJI% block
CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) give the data to the user
IFN. P3 ;Session remark byte pointer present?
MOVE T1,P3 ;Here's the user byte pointer
MOVE T3,P1 ;Updated byte pointer goes here
MOVE T2,GJIFSP ;Here's the free space
ADDI T2,<3+.JILJI> ;Account for the ACs and arg block
SKIPE 1(T2) ;If no session remark then don't bother
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give it to user
ELSE. ;Was byte pointer really here?
SKIPL P2 ;Check to see
JRST INFGJ2 ;It wasn't
UMOVEM P3,(P1) ;Give the byte pointer back like a good monitor
ENDIF.
INFGJ2: MOVE T1,GJIFSP ;Now rid ourselves of this free space
MOVE T2,GJICNT ;Of this many words
CALLRET CLGOOD ;(T1,T2/) And go OKINT etc.
ENDSV.
SUBTTL INFO% -- INFMSR (Remote MSTR%)
;INFMSR - This routine is called by the INFO% JSYS when the user
;has passed in the .INMSR function. This will ask the appropriate
;system to perform the MSTR% JSYS.
;
; Called with:
; T1/ INFO% argument block
; CALL INFMSR
;
; Returns:
; +1 - Error
; T1/ Error code
; +2 - Success, user arg block updated or
; Failure on remote system. In this case, T1
; has IN%RER+remote error code
XSWAPCD ;JSYS code
INFMSR: SAVEQ ;Save work registers
STKVAR <MSBLK,ERR,RESPNS,CNT,UMSBLK,MSFUN,MSLEN> ;Temp storage
XCTU [HRRZ T1,.INAC1(T1)] ;Get user's MSTR% function
CAIN T1,.MSRNU ;Is it this one?
JRST INFMS0 ;Yes
CAIN T1,.MSRUS ;How about this?
JRST INFMS0 ;Yes
CAIN T1,.MSGSS ;Or this one?
JRST INFMS0 ;Yes
CAIN T1,.MSGSU ;Last chance?
JRST INFMS0 ;Yes
MOVEI T1,INFX14 ;Say we can't do this
CALLRET LCLER1 ;(T1/) Outta here
INFMS0: NOINT ;Time to get free space, let's not loose it
MOVEI T1,<.MSRLN+.INMAX+MAXLW+1> ;Going to need this much free space (max)
CALLX (MSEC1,ASGSWP) ;(T1/T1) Get that free space
RETBAD (INFX06,<OKINT>);Not enough system resources
MOVEM T1,MSBLK ;Save free space address
CALL DOACS ;(T1/) Put fake ACs in free space
MOVE T3,INFARG ;User's arg block
UMOVE T2,.INAC2(T3) ;Get user's arg block for the MSTR%
MOVEM T2,UMSBLK ;Save user's MSTR% block here
XCTU [HLRZ T1,.INAC1(T3)] ;Get length of arg block
CAIG T1,.MSRLN ;Make sure argument block is not too big
MOVEI T1,.MSRLN ;If so, this is the biggest it can be
MOVEM T1,MSLEN ;Save user arg block length
MOVE T3,MSBLK ;Get free space address
XMOVEI T3,.INMAX(T3) ;Skip over the AC area
CALLX (MSEC1,BLTUM1) ;(T1,T2,T3/T1,T2,T3) Get user arg block in free space
MOVE T1,INFARG ;Get user's arg block
XCTU [HRRZ T2,.INAC1(T1)] ;Get MSTR% function user wants
MOVEM T2,MSFUN ;Save user's MSTR% function
CAIN T2,.MSRNU ;If this function,
JRST INFMS1 ;Then just do it
CAIN T2,.MSRUS ;If this function,
JRST INFMS1 ;Then all set
;At this point we will have to get the device designator or the byte
;pointer to the structure name. If it is a byte pointer, then we must
;copy the structure name to monitor space and pass it over to other
;system.
MOVE T1,UMSBLK ;Get user's MSTR% block
UMOVE T2,(T1) ;Get first word of block
TLNN T2,-1 ;Device designators don't have left half
JRST INFMS1 ;It is a device designator
MOVE T1,MSBLK ;Get our free space block
SETOM .INMAX(T1) ;Indicate that a byte pointer is going after the argument block
ADDI T1,<.MSRLN+.INMAX> ;We want this address for CPYFU6
MOVEI T3,MAXLC ;No more than this many characters
SETO T4, ;Don't trim this please
CALLX (MSEC1,CPYFU6) ;(T1-T4/T1-T4) Copy the user's string please
NOP ;We never return here
MOVE T1,MSFUN ;Get function back
CAIE T1,.MSGSS ;If this function, then still another byte pointer!
JRST INFMS1 ;Not this function, go on
MOVE T1,MSLEN ;Get user's MSTR% block length
CAIGE T1,.MSGLN ;Is it at least this long?
JRST INFMS1 ;No, then he doesn't want physical name
MOVE T1,MSBLK ;Get address of block we are sending
ADDI T1,<.INMAX+.MSGLN> ;This is where the physical name byte pointer is
SETOM (T1) ;Let remote know we need this
; JRST INFMS1 ;Go on
;Now send block to remote system and let it swallow it whole
INFMS1: MOVE T1,INFFUN ;Get function
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T3,CAPENB ;Get our privs
TXNE T3,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T3,MSBLK ;Get address of free space to send
MOVEI T4,<.MSRLN+.INMAX+MAXLW+1> ;Send this many words
CALL CL.EN1 ;(T1,T2,T3,T4/T1,T2) Send it
IFNSK. ;If this failed
MOVEI T2,<.MSRLN+.INMAX+MAXLW+1> ;Return this many words
MOVE T3,MSBLK ;Get free space address
CALLRET CLFAIL ;(T2,T3/) Return free space and get back to caller
ENDIF.
MOVEM T1,RESPNS ;Save free space address
MOVEM T2,CNT ;Save number of words of free space
MOVE T1,MSBLK ;Restore this free space address
MOVEI T2,<.MSRLN+.INMAX+MAXLW+1> ;Return all of the free space
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give this free space back
MOVE T1,CNT ;Get word count returned from CL.EN1
CAIE T1,1 ;If 1 word, then
IFSKP. ; error happened on remote system
MOVE T1,RESPNS ;Address of returned block
MOVE Q1,(T1) ;Get error code from remote system
TXO Q1,IN%RER ;Make sure error shows up
MOVEI T2,1 ;Return this many words
CALLX (MSEC1,RELSWP) ;(T1,T2/) Now return free space
OKINT ;Interruptions are OK now
MOVE T1,Q1 ;Put error code in T1
RETSKP ;But take good return
ENDIF.
MOVE T1,MSFUN ;Get MSTR% function we just did
CAIN T1,.MSRUS ;If this one...
JRST INFKBP ;Then preserve the user's byte pointers
CAIN T1,.MSRNU ;Or if this function,
JRST INFKBP ;The preserve user byte pointers
CAIE T1,.MSGSS ;If not this one,
JRST INFM25 ; then move on
MOVE T2,RESPNS ;Get reponse data
ADDI T2,.INMAX ;[7.1094] Account for header area
SKIPN .MSGLN(T2) ;Did we get a physical structure name?
JRST INMS00 ;[7.1094] No, so give user arg block data
ADDI T2,.MSGLN ;Name of physical structure is here
MOVE T1,UMSBLK ;Get user's block address
MOVEI T3,.MSGSI(T1) ;Store updated byte pointer here
UMOVE T1,.MSGSI(T1) ;Find where to put physical structure name
SOS T2 ;Back off for LOC-1
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2) Copy physical str name to user space
INMS00: MOVEI T1,<.MSGSI-1> ;[7.1094] BLT this many words
MOVE T2,RESPNS ;[7.1094] Here's the response block
AOS T2 ;[7.1094] Don't overwrite the byte pointer
MOVE T3,UMSBLK ;[7.1094] Here's user's block
AOS T3 ;[7.1094] Move past user's byte pointer
JRST INFMS4 ;[7.1094] Now give stuff to user
INFM25: CAIE T1,.MSGSU ;Want this function?
JRST INFMS2 ;No, everything is all set
MOVE T2,RESPNS ;Get reponse block address
HRRZ T1,.MSUFL(T2) ;This is how many we will return to user
AOS T1 ;We must also count this word itself
MOVE T2,RESPNS ;This is where the response is
AOS T2 ;But we skip the first word
MOVE T3,UMSBLK ;Blast it to this part of user space
AOS T3 ;Again skipping the first word
JRST INFMS4 ;Go for it
INFKBP: MOVE T1,MSLEN ;Get arg block length
CAIG T1,.MSRST ;Is it too small?
JRST INFMS2 ;Yes, then ignore the byte pointers
MOVE T2,UMSBLK ;Retrieve user's byte pointer from arg block
UMOVE Q1,.MSRSN(T2) ;And save it here
CAIG T1,.MSRSN ;Have an alias byte pointer too?
JRST INFMS2 ;No, don't bother to save it
UMOVE Q2,.MSRSA(T2) ;Get byte pointer for later use
INFMS2: MOVE T1,MSLEN ;Argument block is this long
INFMS3: MOVE T2,RESPNS ;Get remote response block
MOVE T3,UMSBLK ;Get user's block
INFMS4: CALLX (MSEC1,BLTMU1) ;(T1,T2,T3/T1,T2,T3) Give the block to the user
MOVE T1,MSFUN ;Get MSTR% function
CAIE T1,.MSRNU ;Is it this function?
CAIN T1,.MSRUS ;Or this function?
IFSKP. <JRST INFMS6> ;Neither, we are done
INFMS5: MOVE T1,MSLEN ;Get argument block length
CAIG T1,.MSRST ;Is it at least this big?
JRST INFMS6 ;No, done
MOVE T2,UMSBLK ;Get user's MSTR% block
SKIPN T1,Q1 ;Get saved byte pointer for str name
IFSKP. ;If byte pointer exists
MOVEI T3,.MSRSN(T2) ;Store updated byte pointer here
MOVE T2,RESPNS ;Get response block
XMOVEI T2,.MSRLN(T2) ;Here's where the structure name is
SOS T2 ;Back to LOC-1
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give name to user
ENDIF.
MOVE T1,MSLEN ;Get length of MSTR% block again
CAIG T1,.MSRSN ;Have a byte pointer for alias?
JRST INFMS6 ;If not, then go on
MOVE T2,UMSBLK ;Get user's MSTR% block
SKIPN T1,Q2 ;Get saved byte pointer for alias
IFSKP. ;If byte pointer exists
MOVEI T3,.MSRSA(T2) ;Store updated byte pointer here
MOVE T2,RESPNS ;Get response block
XMOVEI T2,.MSRLN(T2) ;Here's where the structure name is
ADDI T2,1 ;But the alias name is 2 more words - 1 for CPYTU1
CALLX (MSEC1,CPYTU1) ;(T1,T2,T3/T1,T2,T3) Give name to user
ENDIF.
INFMS6: MOVE T1,RESPNS ;Get free space address as returned from CL.EN1
MOVE T2,CNT ;This is how many words CL.EN1 gave us
CALLRET CLGOOD ;(T1,T2/) Return the goods, go OKINT and back to user
ENDSV.
SUBTTL INFO% -- INFGTB (Remote GETAB%)
;INFTIM - Called when user wants a TIME% done on another system.
;
; Called with:
; T1/ INFO% argument block
; CALL INFGTB
;
; Returns:
; +1 - Error with
; T1/ Error code
; +2 - Success, user space updated or error on remote with
; T1/ IN%RER + Error code
XSWAPCD ;JSYS level code
INFTIM: SAVEQ ;Stash the temps
MOVEI T3,.INAC1(T1) ;Send over dummy data
MOVEI T4,1 ;Only sending 1 word over
HRRZ T2,INFCI ;Get remote CI node
SKIPE INGLXY ;Are part of GALAXY?
TXO T2,CL%GAL ;Yes, note it
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVE T1,INFFUN ;Get INFO% function
NOINT ;Don't bother us while we send
CALL CL.ENT ;(T1-T4/T1,T2) Send number over and wait for answer
RETBAD (,OKINT) ;If didn't work, we are done
CAIN T2,1 ;Did error happen on remote?
CALLRET CLREMR
MOVE Q1,INFARG ;Get info arg block back
MOVE Q2,(T1) ;Get remote results
MOVEI Q3,^D1000 ;Always returned
XCTU [DMOVEM Q2,.INAC1(Q1)] ;Return stuff to user
CALLRET CLGOOD ;(T1,T2/) Give free space, go OKINT and return to user
SUBTTL INFO% -- CL.ENT (Entry point to CLUDGR from user level)
;CL.ENT - Called when it is time to send a request to a remote system
;to do work. The current process will block until a response is received.
;
; Called with:
; T1/ Function code
; T2/ SCA buffer flags,,CI node to send to
; T3/ Address of data to be sent in monitor space or user space
; T4/ Length of block specified in T3
; CALL CL.ENT if T3 is user space
; or
; CALL CL.EN1 if T3 is monitor space
;
; Returns:
; +1 - Error, could not send to remote system
; T1/ Error code
; +2 - Success, data sent and response received
; T1/ Free space address with response
; T2/ Number of words in free space
;
;Note: caller must call RELSWP to get rid of the free space. Also,
;must be called NOINT to prevent free space lossage.
XSWAPCD ;Process context bro'
CL.ENT::SAVEPQ ;[7.1090] We love these scratch registers
STKVAR <USER,FUNC,FLAGS,CINOD,SENDAT,SENLEN,RETADR,CL.CID> ;Must be same as below
SETOM USER ;Flag we are user space
JRST CL.EN2 ;And join common code
CL.EN1::SAVEPQ ;[7.1090] We love these scratch registers
STKVAR <USER,FUNC,FLAGS,CINOD,SENDAT,SENLEN,RETADR,CL.CID> ;Same as CL.ENT!
SETZM USER ;Flag we have monitor space
CL.EN2: MOVEM T1,FUNC ;Save these thingies
TXO T2,CL%REQ ;Note that this will be a request on remote system
HLLZM T2,FLAGS ;Save SCA buffer flags
HRRZM T2,CINOD ;Save node number
MOVEM T3,SENDAT ;Stash send data address
MOVEM T4,SENLEN ;Finally save send length
MOVSI Q1,-HSTSIZ ;Get table size
CIOFF ;Be silent while we check for a valid CID
DO.
SKIPG T1,CLUHST(Q1) ;Get connect ID for this host
IFSKP. ;If not the listener and active,
CALL <XENT SC.NOD> ;(T1/T1,T2) Get the node number
CAMN T2,CINOD ;Is this the node we are looking for?
EXIT. ;Yes, leave the loop
ENDIF.
AOBJN Q1,TOP. ;Haven't found it yet
CION ;Couldn't find it at all
RETBAD (INFX02) ;Say bad CI node
ENDDO.
CION ;We found our destination node
MOVEM T1,CL.CID ;Save its connect ID here
LOAD T1,SID,CL.CID ;Get index into status table
MOVE T2,CLUSTS(T1) ;Get the status on this node
TXNE T2,CL%LCL ;Can we send to this node?
RETBAD (INFX16) ;Say not enough credit to send
NOSKED ;Don't let anyone else in yet
AOS Q3,CLUID ;Increment our INFO% id counter
IFN DEBUG,< ;[7.1247] If debugging,
CAMG Q3,PREVID ;[7.1247] Are we still increasing?
BUG.(HLT,CLUFUD,CLUDGR,SOFT,<CLUDGR - Found Used Id>,,<
Cause: Each request made to a remote system is supposed to be unique.
Unfortunately, the monitor has found that more than one person
is using the same unique ID code from the same system. This is
an illegal case and is only detected with DEBUGging code turned
on.
>) ;[7.1247] Used this twice!
MOVEM Q3,PREVID ;[7.1247] Save the newest old CLUID
> ;[7.1247]
OKSKED ;It's OK now to have someone else use CLUID
;Now put data into SCA buffers
MOVE T1,SENDAT ;Get our send data
HRLI T2,<CLDATA-.MHUDA> ;Put data in starting here
HRR T2,SENLEN ;This is how big SENDAT is
SKIPE USER ;Stuff in user space?
IFSKP. ;If not,
CALL SC.BRK ;(T1,T2/T1,T2,T3) Break data into SCA buffers
RETBAD (INFX10) ;Say not enough SCA free space
ELSE. ;If stuff in user space
CALL SC.BR1 ;(T1,T2/T1,T2,T3) Move into SCA buffers
RETBAD (INFX10) ;Say not enough SCA space
ENDIF.
MOVE Q2,T1 ;Save SCA buffer chain
ADDM T2,CLUBUF ;Count these buffers in the overall picture
MOVEM T3,RETADR ;Return the SCA buffers by calling here
MOVE T3,JOBNO ;Get our job number for our user number
BLCAL. (FILLIN,<T1,FLAGS,Q3,FUNC,FORKX,MYPOR4,JOBDIR(T3),SENLEN>) ;[7.1262]
;Fill in SCA header
MOVE T1,FUNC ;Get function code
CAIN T1,CLCHNG ;Special set code?
JRST CL.SET ;If so, then just send and no wait for response
;Now make request block for CLRCVQ
HRLI T1,.RESP1 ;Priority for free space
HRRI T1,REQMAX ;This many words
MOVEI T2,.RESGP ;Get it from the general pool
CALLX (MSEC1,ASGRES) ;(T1,T2/T1) Get request block
RETBAD () ;Out of free space, say so
MOVE Q1,T1 ;Save address of request block here
HRLZ T1,FUNC ;Get function code
HRR T1,Q3 ;Get request number
MOVEM T1,REQCOD(Q1) ;Save in request block
HRLZ T1,FORKX ;Get our fork number
HRR T1,CINOD ;And CI node number of remote system
MOVEM T1,REQFRK(Q1) ;And set this up
CIOFF ;Don't let anyone else touch the queue
SKIPE T1,CLRCVQ ;Start with first entry in queue
IFSKP. ;No entries in the queue
MOVEM Q1,CLRCVQ ;Now there is
JRST CL.EN3 ;Do the send
ENDIF.
DO. ;Loop over all queue entries
SKIPN REQFLK(T1) ;Is this the last entry?
EXIT. ;Yes'm
MOVE T1,REQFLK(T1) ;No, get next entry
JRST TOP. ;See if there really is a next entry
ENDDO.
MOVEM Q1,REQFLK(T1) ;Tack the new entry on the end
CL.EN3: CION ;Things can now use the queue
MOVE P1,SENLEN ;[7.1090] Get send length
CL.SND: MOVE T2,Q2 ;Get SCA buffer to send
MOVE Q3,(Q2) ;Get next buffer to be sent
MOVE P2,P1 ;[7.1090] Assume we can send this many
ADDI P2,CLDATA ;[7.1090] And account for header
CAILE P2,C%MUDA ;[7.1090] Are there too many words to send?
MOVEI P2,C%MUDA ;[7.1090] Yes only send this many
BLCAL. (<XENT SC.SMG>,<CL.CID,[F.RTB+F.SPM],P2,T2,[CLUPRI],[0],[0]>) ;[7.1090]
;Send it to remote system
IFNSK. ;If failed
CIOFF ;Turn CI off for a bit
CAIE T1,SCSNEC ;Not enough credit?
IFSKP. ;That's right!
LOAD T2,SID,CL.CID ;Get index into status table
MOVX T1,CL%LCL ;Indicate that there is little credit on this one
IORM T1,CLUSTS(T2) ;Show it in status table
HRRI T1,LCLWAT ;Get little credit wait test
HRL T1,T2 ;[7.1259] Get index into status table for sched test
CION ;Done with sensitive things
MDISMS ;Now wait for credit
JRST CL.SND ;Credit has returned
ENDIF.
MOVE T1,Q1 ;Get receive block address
CALL REMQ ;(T1/) Remove entry from CLRCVQ
CION ;Entry gone
DO. ;Return all SCA buffers
MOVE T1,Q2 ;Get SCA buffer in chain
SOS CLUBUF ;Discount it from overall SYSAP
CALL @RETADR ;(T1/) And give it back to SCA
SKIPE Q2,.PKFLI(Q2) ;Get next SCA buffer
JRST TOP. ;And give it back
ENDDO. ;No more buffers to give back
RETBAD (INFX04) ;Give error return
ENDIF.
IFN. Q3 ;Any more to send?
MOVE Q2,Q3 ;Get the next one to send
SUBI P2,<C%MUDA-CLDATA+.MHUDA> ;[7.1090] Subtract the words we just sent over
JRST CL.SND ;Now send it
ENDIF.
MOVE T1,FORKX ;Get our fork number
STOR Q1,FKST2,(T1) ;Save the request block in this table
MOVEI T1,CLUWAT ;Now wait for remote system to respond
MDISMS ;Do the scheduler test
MOVE Q2,REQSCA(Q1) ;Get address of first SCA buffer for later
MOVE Q3,REQFLG(Q1) ;Get result flags
MOVE T1,Q1 ;Get request block
CIOFF ;Must remove it with CIOFF
CALL REMQ ;(T1/) Remove it from CLRCVQ and return it
CION ;OK to use queue now
TXNN Q3,CL%RER ;Did we see a remote error?
IFSKP. ;Yes, only need to return 1 word
MOVE T3,Q2 ;Only 1 SCA buffer then, get its address here
LOAD T2,.CLPTR,(Q2) ;Get the offset to data
ADD T2,Q2 ;Account for this offset in SCA buffer
MOVE Q2,CLDFUN(T2) ;Get error code
MOVE T2,CL.CID ;Here's the connect ID
CALL GIVBCK ;(T2,T3/) Give the SCA buffer back correctly
MOVEI T1,1 ;Get one word of free space
CALLX (MSEC1,ASGSWP) ;(T1/T1) This is for the error code
RETBAD () ;Can't get free space for error code, oh well
MOVEM Q2,(T1) ;Save error code in free space
MOVEI T2,1 ;Say we only have one word of free space
RETSKP ;And go back to caller
ENDIF.
TXNN Q3,CL%DED ;Is this a dead letter?
IFSKP. ;If so,
DO. ;Get rid of all SCA buffers
JUMPE Q2,ENDLP. ;If no more, all done
SETZ T2, ;No connect ID for this
MOVE T3,Q2 ;Get packet address
CALL GIVBCK ;(T2,T3/) And return it to SCA
MOVE Q2,.CLFLI(Q2) ;Get next buffer in the chain
JRST TOP. ;And contine giving them back
ENDDO.
RETBAD (INFX04) ;Say remote node went away before we got stuff
ENDIF.
MOVE T1,Q2 ;Get SCA buffer chain
MOVE T2,CL.CID ;Get connect ID too
CALL CLURSM ;(T1,T2/T1,T2) Reassemble SCA buffer data into free space
RETBAD () ;Not enough free space
RETSKP ;Return to caller
;Here when user is trying to do an SMON% to tell everyone in the cluster
;about our receive status of cluster sends and remote INFO% requests.
CL.SET: MOVE T2,Q2 ;Get SCA buffer to send (only one)
BLCAL. (<XENT SC.SMG>,<CL.CID,[F.RTB+F.SPM],[CLDATA+CLSETW],T2,[CLUPRI],[0],[0]>) ;[7.1090]
;Send it to remote system
IFSKP. ;If success,
RETSKP ;Then done
ENDIF.
MOVE T1,Q2 ;Get SCA buffer
SOS CLUBUF ;Discount it from overall SYSAP
CALL @RETADR ;(T1/) And give it back to SCA
RETBAD (INFX04) ;Give error return
ENDSV.
SUBTTL INFO% -- CLURSM (Reassemble SCA buffers into free space)
;CLURSM - This routine is called when a bunch of SCA packets have arrived
;for a local INFO% request. It then reassembles them into free space. It
;also gives the SCA buffers back to CLUDGR or SCA. Note that this routine
;fails right away if we can't get enough free space to reassemble the
;packets.
;
; Called with:
; T1/ SCA buffer chain
; T2/ Connect ID
; CALL CLURSM
;
; Returns:
; +1 - Error
; T1/ Error code
; +2 - Success
; T1/ Address of free space
; T2/ Number of words in free space
;
;Caller must get rid of free space by calling routine RELSWP
XSWAPCD ;More JSYS code
CLURSM: SAVEQ ;Save non-destructos
STKVAR <CHAIN,COUNT,FSPADR,RSMCID,RSMFUN> ;Temp storage
SETZM RSMFUN ;Say not TTMSG% until we check
MOVEM T1,CHAIN ;Preserve SCA chain
MOVEM T2,RSMCID ;Preserve connect ID
LOAD T2,.CLFUN,(T1) ;Get function code
CAIE T2,CLSND ;Is it just TTMSG%?
IFSKP. ;If so, only get 1 word of free space
SETOM RSMFUN ;Indicate TTMSG% answer coming
MOVEI T1,1 ;This will hold success or failure
JRST CLURS0 ;Now get free space and give it to caller
ENDIF.
AOS T1,CLDLEN(T1) ;[7.1090] This is how many words we need
CLURS0: MOVEM T1,COUNT ;Save count of free space words here
CALLX (MSEC1,ASGSWP) ;(T1/T1) Assign the free space
JRST RSMRBF ;Couldn't get free space, return SCA buffers
MOVEM T1,FSPADR ;Save free space address
MOVE T3,FSPADR ;Start putting stuff at this location
SKIPN Q1,CHAIN ;Get chain back, must be at least one buffer
BUG. (HLT,CLUNSB,CLUFRK,SOFT,<No SCA buffers for response>,,<
Cause: This BUG indicates that a response for an INFO% request was
received by the local system from a remote system and the CL%ALL
bit was set in the request block. However, there were no SCA
buffers with the data. CL%ALL might have been erroneously set
somehow.
>) ;If no SCA buffers, die now
MOVE Q3,COUNT ;[7.1090] Init count of words to BLT
CLURS1: LOAD T2,.CLPTR,(Q1) ;Get pointer to data area
ADDI T2,CLDFUN ;Find out where data starts
ADD T2,Q1 ;Now make it absolute
MOVE T1,Q3 ;[7.1090] Assume we need to BLT this many
CAILE T1,<C%MUDA-CLDATA+.MHUDA> ;[7.1090] Is this too much?
MOVEI T1,<C%MUDA-CLDATA+.MHUDA> ;[7.1090] Yes, this is the max then
SKIPE RSMFUN ;Is this a response to a remote TTMSG%?
MOVEI T1,1 ;If so, only one word response
CALLX (MSEC1,XBLTAT) ;(T1,T2,T3/T1,T2,T3) Blast data to free space
SKIPN Q1,.CLFLI(Q1) ;[7.1090] Get next SCA buffer in chain
IFSKP. ;[7.1090] If there is another buffer...
SUBI Q3,<C%MUDA-CLDATA+.MHUDA> ;[7.1090] Account for words just BLTed
JRST CLURS1 ;[7.1090] Do next buffer
ENDIF. ;[7.1090]
CLURS2: MOVE T2,RSMCID ;Get connect ID
MOVE T3,CHAIN ;Get SCA buffer out of chain
MOVE Q1,.CLFLI(T3) ;Get next buffer in chain
MOVEM Q1,CHAIN ;And save it for next time around
CALL GIVBCK ;(T2,T3/) Give the buffer back correctly
SKIPE CHAIN ;Any more left in chain?
JRST CLURS2 ;Yes, return them too
MOVE T1,FSPADR ;Return free space to caller
MOVE T2,COUNT ;Also let caller know how many words
RETSKP ;All buffers reassembled
;Here when couldn't get free space to reassemble SCA buffers. Return
;them and then give error to user.
RSMRBF: MOVE T2,RSMCID ;Get connect ID
MOVE T3,CHAIN ;Get SCA buffer out of chain
MOVE T4,(T3) ;Get next buffer in chain
MOVEM T4,CHAIN ;And save it for next time around
CALL GIVBCK ;(T2,T3/) Give the buffer back correctly
SKIPE CHAIN ;Any more left in chain?
JRST RSMRBF ;Yes, return them too
RETBAD (INFX06) ;And say we didn't have enough free space
SUBTTL INFO% -- REMQ (Remove from receive queue)
;REMQ - Routine called to remove an entry from the CLRCVQ. Must
;be called with CIOFF!
;
; Called with:
; T1/ address of REQ block
; CALL REMQ
;
; Returns:
; +1 - Always, with block removed from CLRCVQ and given
; back to free space with CI still OFF
XSWAPCD ;JSYS code
REMQ: XMOVEI T3,CLRCVQ ;Get start of queue
DO. ;Loop over entire CLRCVQ
CAME T1,REQFLK(T3) ;So remove entry from CLRCVQ while still CIOFF
IFSKP. ;Found the entry
MOVE T2,REQFLK(T1) ;Get next one after us
MOVEM T2,REQFLK(T3) ;And make it the next one in the queue
EXIT. ;Now release SCA buffers
ENDIF.
MOVE T3,REQFLK(T3) ;Get next entry in receive queue
JRST TOP. ;And check it
ENDDO.
XCALLRET (MSEC1,RELRES) ;(T1/) Give it back to the system
SUBTTL INFO% -- CLUWAT (Wait routine)
;CLUWAT - Scheduler test to perform while waiting for a response
;from the remote system.
;
; Initiated with:
; T1/ CLUWAT
; MDISMS
;
; Called by scheduler with fork number in Q3 when scanning wait list
;
; Returns:
; +1 - Still no response to our request
; +2 - Remote node went down or response for fork has arrived
RESCD ;Like all good scheduler tests
CLUWAT: LOAD T1,FKST2,(Q3) ;Get the block on CLRCVQ
MOVE T1,REQFLG(T1) ;Get the flag word
TXNE T1,CL%ALL ;Are all SCA buffers for response here?
RETSKP ;Yes!
TXNE T1,CL%DED ;Did the remote system leave the cluster?
RETSKP ;Yes, so wake up the fork
RET ;Still waiting...
SUBTTL INFO% -- LCLWAT (Little credit, so we wait)
;LCLWAT - Scheduler test called when a remote system has insufficient
;credit to receive our request. When enough credit becomes available,
;then we will exit this scheduler test and try the send over.
;
; Initiated with:
; T1/ Index into CLUSTS,,LCLWAT
; MDISMS
;
; Called by the scheduler when scanning wait list. Q3 has for number
;
; Returns:
; +1 - System still doesn't have enough credit
; +2 - Credit available so send should succeed
RESCD ;Typical scheduler test
LCLWAT: MOVE T2,CLUSTS(T1) ;Get status word
TXNE T2,CL%LCL ;Still not enough credit?
RET ;Yes, keep waiting
RETSKP ;Credit is available, time to send
SUBTTL INFO% -- INFALO (Remote node allowing?)
;INFALO - This routine checks to see if the remote node is allowing
;INFO% requests to be serviced. Of course, all of GALAXY's requests
;are allowed regardless.
;
; Called with:
; T1/ CI node number
; CALL INFALO
;
; Returns:
; +1 - INFO% being denied or invalid CI node
; T1/ -1 for invalid CI node otherwise 0 if INFO% requests
; are being denied
; +2 - OK to send to this node
; T1/ connect ID to get to this node or CI node if the given
; node was the local node (there is no CID to the local
; node and there is no need to send to the local node)
XSWAPCD ;Used by JSYS
INFALO: SAVEQ ;Save goodies
MOVE Q2,T1 ;Safe keeping of the node
CALLX (MSEC1,SC.PRT) ;(/T1) Get our port
ITERR (SCSNKP) ;Yes, we have no KLIPA today
CAMN T1,Q2 ;Are we trying to INFO% the local node?
JRST INFAL2 ;Yes, check our allow word
MOVSI Q1,-HSTSIZ ;Loop through all hosts and find the right CID
CIOFF ;Stop CI while we check things out
DO. ;Top of loop
SKIPN T1,CLUHST(Q1) ;Something in this entry?
IFSKP. ;Yes,
CALL <XENT SC.NOD> ;(T1/T1,T2) Get its CI node
CAME T2,Q2 ;Is it this node?
JRST INFAL1 ;No, do next entry
CION ;Turn CI back on
LOAD T2,SID,T1 ;Get index into status table
MOVE T2,CLUSTS(T2) ;Now get the status of this node
TXNN T2,CL%DNY ;Is this node refusing INFO% requests?
RETSKP ;No, return with CID in T1
SETZ T1, ;Say this node is denying INFO% requests
RETBAD () ;And go back
ENDIF. ;Not this one, move on in table
INFAL1: AOBJN Q1,TOP. ;Do next entry
ENDDO. ;Have we done all nodes?
CION ;Yes, turn CION
SETO T1, ;Return no CID cause node ain't good
RETBAD ()
INFAL2: SKIPN CLUSET ;Are we denying INFO requests?
IFSKP. ;No, then say its OK
MOVE T1,Q2 ;Pass back our node number as the connect ID
RETSKP ;And return good
ENDIF.
SETZ T1, ;Show we are denying
RETBAD () ;And go back
SUBTTL INFO% -- CLGOOD (All is well)
;CLGOOD - Called when INFO%'s worker routine is finished moving stuff
;to user area. This is how the INFO% JSYS cleans up before returning to
;the caller
;
; Called with:
; T1/ Address of free space that came from CL.ENT
; T2/ Number of words in that free space
; CALL CLGOOD
;
; Returns:
; +2 - Always, with free space returned and OKINT with
; T1/ 0 <= to clear stray bits
XSWAPCD ;JSYS code
CLGOOD: CALLX (MSEC1,RELSWP) ;(T1,T2/) First chuck the free space
OKINT ;Now be fine
SETZ T1, ;Clear any stray bits
RETSKP ;And boogie on back
SUBTTL INFO% -- CLFAIL (CL.ENT failed)
;CLFAIL - Called when CL.ENT fails. However, this routine is called
;specifically to return some from free space and then return an error
;to the caller as passed in. Basically, a common exit point when CL.ENT
;gags. Note, goes OKINT too!
;
; Called with:
; T1/ Error code
; T2/ Count of free space words
; T3/ Address of free space to dispose of
; CALL CLFAIL
;
; Returns:
; +1 - Always, with free space returned
;
;Destroys nada
XSWAPCD ;Process level code
CLFAIL: SAVET ;Preserve ACs
MOVE T1,T3 ;Get free space address in good AC
CALLX (MSEC1,RELSWP) ;(T1,T2/) Get rid of free space
OKINT ;Interrupts are fine now
RET ;And back to caller
SUBTTL INFO% -- CLREMR (Remote error)
;CLREMR - This routine is called or gotten to when a remote system
;encountered an error while doing the requested function. It then
;returns the free space of 1 word as returned by CL.ENT/CL.EN1,
;goes OKINT and then returns to user. The error code is always the
;single element in the free space.
;
; Called with:
; T1/ Address of free space
; T2/ Length of free space (1 word usually)
; CALL CLREMR
;
; Returns:
; +1 - Never
; +2 - Always, with free space gone, and OKINT and
; T1/ IN%RER + Error code
XSWAPCD ;Process level code
CLREMR: STKVAR <ERROR> ;Place to save error
MOVE T3,(T1) ;Get error code
MOVEM T3,ERROR ;Save error code
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give back free space
OKINT ;Interrupts are OK now
MOVE T1,ERROR ;Get error code back
TXO T1,IN%RER ;Say remote error
RETSKP ;And return
SUBTTL INFO% -- DOACS (Fill in fake ACs)
;DOACS - This routine is called whenever an INFO% function needs to
;put ACs into an argument block. Basically, this routine copies .INACx
;words from user space into freespace specified in T1.
;
; Called with:
; T1/ Address of free space to place .INACx words into
; CALL DOACS
;
; Returns:
; +1 - Always, with T1 updated to point past .INACx words
XSWAPCD ;JSYS code
DOACS: SAVEQ ;Save work regs
MOVE Q1,ARGLEN ;Get user argument block length
SUBI Q1,2 ;Don't count .INFUN and .INCID words
JUMPLE Q1,R ;Better be something to put in
MOVE Q2,INFARG ;Get address of user's argument block
UMOVE Q3,.INAC1(Q2) ;Get .INAC1
MOVEM Q3,(T1) ;And put it in argument block
AOS T1 ;Move to next word
SOJLE Q1,R ;Any more .INACx words?
UMOVE Q3,.INAC2(Q2) ;Get .INAC1
MOVEM Q3,(T1) ;And put it in argument block
AOS T1 ;Move to next word
SOJLE Q1,R ;Any more .INACx words?
UMOVE Q3,.INAC3(Q2) ;Get .INAC1
MOVEM Q3,(T1) ;And put it in argument block
AOS T1 ;Move to next word
SOJLE Q1,R ;Any more .INACx words?
UMOVE Q3,.INAC4(Q2) ;Get .INAC1
MOVEM Q3,(T1) ;And put it in argument block
AOS T1 ;Move to next word
RET ;All ACs loaded
SUBTTL INFO% -- CHKGAL (Check to see if we are GALAXY)
;CHKGAL - Routine that is called to check and see if the current
;job is part of the GALAXY subsystem. This routine bases the
;decision on what PIDs are being used by this job (IPCF PIDs)
;and the system PIDs in SPIDTB.
;
; Call with:
; no arguments
; CALL CHKGAL
;
; Returns:
; +1 - Error, job is not a GALAXY job
; +2 - Job is part of GALAXY
;Clobbers no ACs!!
XSWAPCD
CHKGAL::SAVET ;Preserve work registers
STKVAR <ARGBLK,WRDCNT,ERROR> ;Temp storage
MOVE T2,JOBNO ;Get the current job number
LOAD T1,PIDPC,(T2) ;Get PID count for this job
JUMPE T1,R ;If zero, than this can't be a GALAXY job
LSH T1,1 ;Need 2*PID_COUNT+4 words of free space
ADDI T1,4 ;Make sure we have enough words
MOVEM T1,WRDCNT ;Save free space length here
;Count of free space words is now in the right of T1.
NOINT ;Prevent free space lossage
HRLI T1,.RESP3 ;Put priority in left half of T1
MOVEI T2,.RESGP ;Get free space from the general pool
CALLX (MSEC1,ASGRES) ;(T1,T2/T1) Get free space
IFNSK. ;If failure,
OKINT ;Go OKINT
JRST CHKGL3 ;Couldn't get free space, trouble
ENDIF.
MOVEM T1,ARGBLK ;Save address of this free space
MOVEI T2,.MUFJP ;Get all PIDs for this job
MOVEM T2,(T1) ;Save MUTIL% function in arg block
MOVE T2,GBLJNO ;Get global job number
MOVEM T2,1(T1) ;And put it in second word of arg block
MOVE T1,WRDCNT ;Get arg block length for MUTIL%
MOVE T2,ARGBLK ;Put address of arg block here
MUTIL% ;Do MUTIL%
IFNSK. ;If failed,
MOVEM T1,ERROR ;Save error code
MOVE T1,ARGBLK ;Free space to give back
CALL CHKG21 ;(T1/) Return free space and go OKINT
MOVE T1,ERROR ;Get JSYS error code back
JRST CHKGL3 ;MUTIL% failed us
ENDIF.
CHKGL1: ADDI T2,2 ;Every second word is a PID
SKIPN T1,(T2) ;No more PIDs?
CALLRET CHKGL2 ;All done, no match
CALL CHKPID ;(T1/) See if this PID is of the GALAXY persuasion
JRST CHKGL1 ;It wasn't, do next PID
MOVE T1,ARGBLK ;Now you see the free space...
CALLX (MSEC1,RELRES) ;(T1/) And now you don't
OKINT ;Interrupts are once again copacetic
RETSKP ;And get back to the caller
CHKGL2: MOVE T1,ARGBLK ;Return the free space
CHKG21: CALLX (MSEC1,RELRES) ;(T1/) Do it
OKINT ;Free space gone, ^C if you dare
RET ;Back to the caller
CHKGL3: BUG.(CHK,GALCHF,CLUDGR,SOFT,<GALCHK failed>,<<T1,ERROR>>,<
Cause: The call to GALCHK failed because GALCHK could not get
enough free space from the system pool to do an MUTIL%
JSYS or the call to MUTIL% failed. Therefore, it could
not verify whether or not this job was part of GALAXY.
If this BUGCHK appears, software engineering should be
notified.
Data: ERROR - Error code returned from MUTIL% or ASGRES.
>)
RET ;And go back to caller
ENDSV.
SUBTTL INFO% -- CHKPID (Check for GALAXY PID)
;CHKPID - Routine called to see if the given PID belongs to
;a GALAXY component. A GALAXY component is considered to be
;one of the following processes:
; <SYSTEM>INFO, QUASAR, ORION, MOUNTR, NEBULA
;
; Call with:
; T1/ PID
; CALL CHKPID
;
; Returns:
; +1 - Given PID is not a GALAXY PID
; +2 - Given PID is a GALAXY PID
;Clobbers no ACs
XSWAPCD
CHKPID: SAVEAC <T2> ;Save used ACs
XMOVEI T2,SPIDTB ;Here's where the system PIDs are
;[7.1102]
;Note - the following code has been repeat 0'ed out. This is because
;the system going down message comes from the CHKR fork and since
;<SYSTEM>INFO runs under job 0, this is considered GALAXY and hence,
;there is no way to stop the system going down message from appearing
;on other systems. If <SYSTEM>INFO ever does INFO%'s or sends, this
;code must be put back.
REPEAT 0,< ;Don't let job 0 do this
CAMN T1,.SPINF(T2) ;Is this <SYSTEM>INFO?
RETSKP ;Yes
> ;End repeat 0
CAMN T1,.SPQSR(T2) ;Is it QUASAR?
RETSKP ;That it is
CAMN T1,.SPMDA(T2) ;Is it MOUNTR?
RETSKP ;Yes
CAMN T1,.SPOPR(T2) ;How about ORION?
RETSKP ;Yes
CAMN T1,.SPNEB(T2) ;Is it NEBULA?
RETSKP ;Yes
RET ;It is not a GALAXY function at all
ENDTV. ;For INFO%'s TRVAR
SUBTTL Cluster Sendall -- CLTMSG
;CLTMSG - Routine called by TTMSG% when sending to a remote system.
;Must be called NOINT.
;
; Call with:
; T1/ CI node,,destination terminal
; T2/ Send all buffer address
; T3/ Count of character to be sent
; T4/ 0 if not prived, else prived caller
; CALL CLTMSG
;
; Returns:
; +1 - Error,
; T1/ Error code
; +2 - Success
XSWAPCD ;JSYS stuff
CLTMSG::SAVEP ;Save temps
STKVAR <TONODE,TERM,MSG,COUNT,GAL,SCAFLG,PRV,REMMSG> ;Temp variables
HLRZM T1,TONODE ;Save destination node
HRRZM T1,TERM ;Save terminal
MOVEM T2,MSG ;Save send all message
LSH T3,-2 ;Compute how many words in message
AOS T3 ;Account for null
MOVEM T3,COUNT ;Save it here
MOVEM T4,PRV ;Save priv setting
CALL CHKGAL ;(/) Are we GALAXY?
TDZA T1,T1 ;Nope
SETO T1, ;Say we are GALAXY
MOVEM T1,GAL ;And save setting here
AOS COUNT ;Must get one more word for sending
HRR T1,COUNT ;Get free space count needed
HRLI T1,.RESP3 ;Get some more free space
MOVEI T2,.RESTP ;From terminal pool
CALLX (MSEC1,ASGRES) ;(T1,T2/T1) Get free space
RETBAD () ;If no, then fail
MOVEM T1,REMMSG ;Save address here
MOVE T2,TERM ;Get destination terminal
MOVEM T2,(T1) ;Save this as first word in data to be sent
MOVE T1,COUNT ;Get count of words to BLT
;Note - the following code may seem a little out of the ordinary but if
;you knew what I went through to realize it must be as is, you can appreciate
;it. Basically, TTMSG%'s routine GETSAL that makes a sendall buffer has a
;slight crock in that it pads each linefeed in the string with 4 nulls.
;The following loop attempts to remove these when sending a string over
;to a remote system and have it do a sendall for us. It appears that these
;4 nulls were stuck in because of slow devices many years ago (like teletype
;33s) and these nulls were used as padding for when the rubber band was yanking
;the type writer ball back after doing a CRLF. These 4 nulls apparently were
;enough to prevent further output in that time frame. Yuk. Also, the loop
;strips off the parity that GETSAL may have stuck on because we don't need
;parity right now.
MOVE T1,REMMSG ;Here's the free space
AOS T1 ;Start here
TXO T1,<OWGP. 7> ;Make one-word global byte pointer
MOVE T2,MSG ;Here's our send all stuff
HRLI T2,(POINT 9,) ;Would you believe they are in 9-bit
SETZ P2, ;Indicate CR not seen yet
DO. ;Loop over each character
ILDB T3,T2 ;Get a send all byte
ANDI T3,177 ;Strip off that parity
IDPB T3,T1 ;Save byte in send all string
CAIE T3,.CHCRT ;<CR> seen?
IFSKP. ;If so,
SETO P2, ;Say we have finally seen a CR
JRST TOP. ;And do next character
ENDIF.
CAIE T3,.CHLFD ;<LF> seen?
IFSKP. ;If so,
IFL. P2 ;Was <CR> previously seen?
MOVEI T4,4 ;Adjust the byte pointer by 4 bytes
ADJBP T4,T2 ;Skip over the 4 nulls
MOVE T2,T4 ;Now get the updated byte pointer back
ENDIF.
ENDIF.
CAIN T3,.CHNUL ;Was it a legitimate null?
EXIT. ;Yes, then we have done our duty
SETZ P2, ;Was normal character, reset <CR> flag
JRST TOP. ;Do more fun stuff
ENDDO.
HRRE T1,TONODE ;Get CI node
JUMPGE T1,CLTMS1 ;Doing all nodes or just one?
MOVEI P2,<C%SBLL-1> ;This is max CI nodes
DO. ;Loop over all nodes
CALL SC.PRT ;(/T1) Get our port number
RETBAD () ;Can't do remote sends with out a port
CAMN T1,P2 ;Is this our node?
JRST CLTMS2 ;Yes, can't send to self through port
;Have no fear, when all nodes have been specified, local sends are
;handled upon return from this routine.
MOVE T1,P2 ;Get current node
CALL CHKSND ;(T1/T1) See if OK to send to this node
JRST CLTMS2 ;Can't send to this node, do next one
MOVEI T1,CLSND ;Tell CLUDGR we are doing remote send
MOVE T2,P2 ;Do this node
SKIPE PRV ;Are we prived?
TXO T2,CL%PRV ;Yes, indicate
SKIPE GAL ;Are we part of GALAXY
TXO T2,CL%GAL ;Yes, say so
MOVE T3,REMMSG ;Get send all buffer address
MOVE T4,COUNT ;Put count of words in buffer here
ADDI T4,2 ;[7.1090] Account for the extra header
CALL CL.EN1 ;(T1,T2,T3,T4/T1,T2) Do send all
IFSKP. ;If send worked,
MOVEI T2,1 ;Return this many words
CALLX (MSEC1,RELSWP);(T1,T2/) Now return free space
ENDIF.
CLTMS2: SOJGE P2,TOP. ;Decrement to next node
ENDDO.
CALLRET CLTGUD ;Always
;Here to send to a single node. We know it is not our node because
;TTMSG% already handled that.
CLTMS1: MOVE T1,TONODE ;Get destination node
CALL CHKSND ;(T1/T1) See if OK to send to this node
CALLRET CLTFAL ;It's not cool, return error
MOVEI T1,CLSND ;Tell CLUDGR we are doing remote TTMSG%
MOVE T2,TONODE ;Do this node
SKIPE PRV ;Are we prived?
TXO T2,CL%PRV ;Yes, indicate
SKIPE GAL ;Are we part of GALAXY
TXO T2,CL%GAL ;Yes, say so
MOVE T3,REMMSG ;Get send all buffer address
MOVE T4,COUNT ;Put count of words in buffer here
CALL CL.EN1 ;(T1,T2,T3,T4/T1,T2) Do send all
IFNSK. ;If send failed remotely,
CAIN T1,INFX02 ;Invalid CI node?
MOVEI T1,TTMSX3 ;Yes, translate it to correct error though
TXZ T1,IN%RER ;Clear remote error bit
CALLRET CLTFAL ;Return error to caller
ENDIF.
HRRE P1,TERM ;Was remote send to all terminals?
IFL. P1 ;Check to see
MOVEI T2,1 ;Return one word result because we don't care
CALLX (MSEC1,RELSWP) ;(T1,T2/) Give back free space
CALLRET CLTGUD ;Return free space and get out of here
ENDIF.
MOVE P1,(T1) ;Get remote result code
TXZN P1,IN%RER ;Remote error (clear IN%RER if so)
IFSKP. ;If so,
MOVEI T2,1 ;Return free space
CALLX (MSEC1,RELSWP) ;(T1,T2) Give it back here
MOVE T1,P1 ;Get remote error
CALLRET CLTFAL ;And go back to TTMSG%
ENDIF.
MOVEI T2,1 ;Return free space
CALLX (MSEC1,RELSWP) ;(T1,T2) Give it back here
CLTGUD: MOVE T1,REMMSG ;Return the free space we used
CALLX (MSEC1,RELRES) ;(T1/) Give it back to the terminal pool
RETSKP ;And say it went OK
CLTFAL: MOVE P1,T1 ;Save remote error while we cleanup
MOVE T1,REMMSG ;Return this free space
CALLX (MSEC1,RELRES) ;(T1/) Return the free space to terminal pool
MOVE T1,P1 ;Recapture error code
RETBAD () ;And tak failure path
ENDSV.
SUBTTL Cluster Sendall -- CHKSND (Check to see if OK to send to remote)
;CHKSND - Routine called to check to see if given CI node is accepting
;remote sendalls. This routine calls CHKGAL first. It allows GALAXY functions
;to do remote sends all the time.
;
; Call with:
; T1/ CI node
; CALL CHKSND
;
; Returns:
; +1 - Error, remote node not accepting sends
; +2 - OK to send to this node
XSWAPCD
CHKSND: SAVEP ;These are used for temp storage
MOVE P1,T1 ;Save CI node for later
MOVSI P2,-HSTSIZ ;Get size of table
CIOFF ;Be stable
DO. ;Loop over lots of entries
MOVE T1,CLUHST(P2) ;Get entry from host table
CALL <XENT SC.NOD> ;(T1/T1,T2) Get CI node for this entry
CAMN T2,P1 ;Match?
EXIT. ;Yes
AOBJN P2,TOP. ;No, do next entry
CION ;Done all entries and didn't find one
RETBAD(TTMSX3) ;Invalid CI node
ENDDO.
CION ;OK for interrupts now
CALL CHKGAL ;(/) Is this GALAXY?
$SKIP ;Not part of GALAXY, more checking
RETSKP ;GALAXY, so this is OK
MOVE T1,CLUSTS(P2) ;Get status of this node
TXNE T1,CL%NOS ;Is it OK to send?
RETBAD(TTMSX4) ;No it isn't
RETSKP ;Yes it is
ENDSV.
SUBTTL SMON% Functions -- SETCLU (Disable CLUDGR)
;SETCLU - This routine enables the ability of this machine to answer
;cluster INFO% requests.
;
; Called with:
; no arguments
; CALL SETCLU
;
; Returns:
; +1 - Always, with CLUSET -1 and each machine notified
XSWAPCD ;Called by user
SETCLU::NOINT ;Don't bother us while we let systems know
SETOM CLUSET ;Say we do INFO%'s
CALLRET CLNTFY ;Now notify all other nodes
SUBTTL SMON% Functions -- CLRCLU (Enable CLUDGR)
;CLRCLU - This routine disables the ability of this machine to answer
;cluster INFO% requests. However, these requests are still honored for
;GALAXY components.
;
; Called with:
; no arguments
; CALL CLRCLU
;
; Returns:
; +1 - Always, with CLUSET 0 and each machine notified
XSWAPCD ;Called by user
CLRCLU::NOINT ;Don't bother us while we let systems know
SETZM CLUSET ;Say we will do INFO%'s
CALLRET CLNTFY ;Now notify all other nodes
SUBTTL SMON% Functions -- SETTMG (Disable Cluster sendalls)
;SETTMG - This routine enables the ability of this machine to partake
;in cluster sendall requests.
;
; Called with:
; no arguments
; CALL SETTMG
;
; Returns:
; +1 - Always, with CLUTMG -1 and each machine notified
XSWAPCD ;Called by user
SETTMG::NOINT ;Don't bother us while we let systems know
SETOM CLUTMG ;Say we don't do cluster sendalls
CALLRET CLNTFY ;Now notify all other nodes
SUBTTL SMON% Functions -- CLRTMG (Enable Cluster sendalls)
;CLRTMG - This routine disables the ability of this machine to partake
;in cluster sendall requests. However, these requests are still honored for
;GALAXY components.
;
; Called with:
; no arguments
; CALL CLRTMG
;
; Returns:
; +1 - Always, with CLUTMG 0 and each machine notified
XSWAPCD ;Called by user
CLRTMG::NOINT ;Don't bother us while we let systems know
SETZM CLUTMG ;Say we honor send alls
CALLRET CLNTFY ;Now notify all other nodes
SUBTTL SMON% Functions -- CLNTFY (Notify all nodes)
;CLNTFY - This routine is called to notify the other systems in this
;cluster about our INFO% request status and our cluster send all
;status.
;
; Called with:
; Must be called NOINT!!!
; CLUSET/CLUTMG setup
; CALL CLNTFY
;
; Returns:
; +1 - Always, with remote systems notified and OKINT
XSWAPCD ;Process code from SMON% JSYS
CLNTFY: SAVEQ ;Save the used temps
MOVEI Q1,C%SBLL ;This is our counter (MAX nodes)
DO. ;Loop over each possible node
SOSGE Q1 ;Do next CI node
EXIT. ;No more CI nodes to do
CALL CHKGAL ;(/) See if we are GALAXY
$SKIP ;Not GALAXY don't set GALAXY bit
TXO T2,CL%GAL ;Yes, note it
HRR T2,Q1 ;Put CI node here
MOVE T1,CAPENB ;Get our privs
TXNE T1,SC%WHL!SC%OPR ;Do we look like a giant?
TXO T2,CL%PRV ;Yes we do, note it
MOVEI T1,CLCHNG ;Say this is a state change for our system
XMOVEI T3,CLUSET ;Send over our settings
MOVEI T4,CLSETW ;Send over 4 words
CALL CL.EN1 ;(T1,T2,T3,T4/T1,T2) Notify the system
JRST TOP. ;Who cares, do next node
JRST TOP. ;Do next node if we succeeded too
ENDDO.
OKINT ;All nodes done, we can be bothered
RET
SUBTTL End of CLUDGR
END