Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/galsrc/glxipc.mac
There are 26 other files named glxipc.mac in the archive. Click here to see a list.
TITLE GLXIPC -- IPCF INTERFACE FOR GALAXY PROGRAMS
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 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 GLXMAC ;SEARCH SUBSYSTEMS SYMBOLS
PROLOG(GLXIPC,IPC) ;PRODUCE PROLOG CODE
;THE PURPOSE OF THIS MODULE IS TO PROVIDE AN OPERATING SYSTEM INDEPENDENT
; IPCF INTERFACE TO GALAXY PROGRAMS (OR ANY OTHER PROGRAM WHICH
; WANTS TO USE IT).
;ALL SUBROUTINES IN THIS MODULE USE ACS S1 AND S2 (1 AND 2) AND GUARANTEE
; THAT ALL OTHER ACS WILL BE PRESERVED.
IPCMAN==:0 ;Maintenance edit number
IPCDEV==:111 ;Development edit number
VERSIN (IPC) ;Generate edit number
Subttl Table of Contents
; Table of Contents for GLXIPC
;
; Section Page
;
;
; 1. Revision History . . . . . . . . . . . . . . . . . . . 3
; 2. Entry Points found in GLXIPC . . . . . . . . . . . . . 4
; 3. Global Storage . . . . . . . . . . . . . . . . . . . . 5
; 4. C%INIT - Initialize the IPCF interface . . . . . . . . 6
; 5. C%CPID - Create a PID . . . . . . . . . . . . . . . . 7
; 6. CHKNAM - See if PIB has a name attached . . . . . . . 10
; 7. C%KPID, C%SPID . . . . . . . . . . . . . . . . . . . . 11
; 8. C%SEND Routine to send an IPCF Message . . . . . . . . 12
; 9. SNDMSG - Work routine to do actual IPCF send . . . . . 14
; 10. C%INTR - Interrupt level routine to flag message avail 16
; 11. RCVMSG - Work routine to do an actual IPCF receive . . 17
; 12. C%REL - Release the last message received . . . . . . 20
; 13. GETPID - Acquire a PID for this job . . . . . . . . . 21
; 14. KILPID Routine to delete a pid . . . . . . . . . . . . 22
; 15. SPID - Set a system PID . . . . . . . . . . . . . . . 23
; 16. RSPIDS Routine to read System Pid tables . . . . . . . 24
; 17. RSPID Routine to return a system pid . . . . . . . . . 25
; 18. RSYPD - Perform actual system pid read . . . . . . . . 27
; 19. C%MAXP - Read maximum short packet size . . . . . . . 28
; 20. CPIDI - Connect PID to specified interrupt channel . . 29
; 21. IPRM Read/Write IPCF parameters . . . . . . . . . . . 30
; 22. MNPRED/MNPWRT - Read/Write maximum number of PIDS . . 31
; 23. QTARED/QTAWRT - Read/Write the Send and Receive Quotas 32
; 24. SETNAM - Routine to declare our name to INFO . . . . . 33
; 25. SNDSYS - Routine to converse with [SYSTEM]INFO & IPCC 34
; 26. STAC - Routine to build INFO messages . . . . . . . . 36
; 27. C%PIDJ Return PID owners job number . . . . . . . . . 37
SUBTTL Revision History
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
64 4.2.1394
Insure all messages get received by setting MSGFLG early.
65 4.2.1574
Store word .IPCFC (enabled capabilities word) of IPCF message
sender in word MDB.PR of the MDB.
66 4.2.1584
Cause GLXIPC not to give up sending IPCF packets if the problem is
due to IPCF swapping space low.
***** Release 5.0 -- begin development edits *****
70 5.1002 28-Dec-82
Move to new development area. Clean up edit organization.
71 5.1023 8-Apr-83
If DB.IPC is set in the debug word, and if the process is ORION
or QUASAR, set the system debugging pids.
72 5.1025 4-May-83
In SPID, always set the system pid, i.e. don't quit because we THINK
it is already set. In RSPID, if DB.IPC is set in DEBUGW, try picking up
the debugging system wide pid before using the alternate table.
***** Release 5.0 -- begin maintenance edits *****
100 Increment maintenance edit level for version 5 of GALAXY.
101 5.1224 SPR#20908
In routine SNDM.5:, add check for error code MONX06 on a MSEND failure
and retry if so.
***** Release 6.0 -- begin development edits *****
105 6.1037 and 6.1034 23-Oct-87
Move from G5 to G6. In routine RCVM.2 check for SC%SEM and lite
MD.SEM if on. This will include the SEMI-OPERATOR priv bit in the MDB.
106 6.1066 9-Nov-87
Change C%SEND to not inform GLXMEM that an IPCFed page is now
available to be re-used if C%SEND detects that bit PT.KEE is turned on
in the SAB length AC.
107 6.1076 15-Nov-87
Check for NEBULA's PID when debugging.
110 6.1089 19-Nov-87
Don't turn on bit IP.JWP when obtaining a PID when debugging.
111 6.1225 8-Mar-88
Update copyright notice.
\ ;End of Revision History
SUBTTL Entry Points found in GLXIPC
ENTRY C%INIT ;INITIALIZE THE MODULE
ENTRY C%CPID ;CREATE A PID
ENTRY C%SPID ;SET DEFAULT SENDER PID
ENTRY C%KPID ;KILL A PID
ENTRY C%RPRM ;READ IPCF PARAMETERS
ENTRY C%INTR ;POST AND IPCF INTERRUPT
ENTRY C%SEND ;SEND AN IPCF MESSAGE
ENTRY C%RECV ;NON-BLOCKING IPCF RECEIVE
ENTRY C%BRCV ;BLOCKING IPCF RECEIVE
ENTRY C%REL ;RELEASE LAST IPCF MESSAGE
ENTRY C%MAXP ;MAX PACKET SIZE ENTRY POINT
ENTRY C%PIDJ ;RETURN PID OWNERS JOB NUMBER
SUBTTL Global Storage
EXT IIB ;USE GLOBAL IB
EXT MYJOB ;JOB NUMBER FROM GLXINT
$DATA IPCBEG,0 ;START OF ZEROABLE $DATA SPACE
$GDATA MYPID ;PROCESS IDENTIFIER
$DATA DEFPID ;Default (ie first) PID
$DATA FSTPFG ;Set after we define first PID
$GDATA IMOPR ;Set if we are ORION
$DATA PSIFLG ;FLAG SET IF IPCF IS CONNECT TO PSI SYSTEM
$DATA SNDFLG ;FLAGS TO USE FOR SEND
$DATA RCVFLG ;FLAGS TO USE FOR RECIEVE
$DATA RCVPAG ;PAGSIZ,,PAGADR RESERVED FOR RECV
$DATA MSGFLG ;SET AT INTERRUPT LEVEL (IF PSI USED)
$GDATA RSEFLG ;RETURN SEND ERROR FLAG
$GDATA MAXPAK ;LARGEST SIZE OF A SHORT MESSAGE
$DATA IPCINT ;INTERRUPT ADDRESS FOR IPCF STATUS
$DATA IPCSTS ;IPCF STATUS..ASSOCIATED VARIABLE
$DATA PIDTAB,SZ.PID ;TABLE OF SYSTEM PIDS
$DATA ALTNAM,SZ.PID ;Table of alternate names for system
;components. Debuggers can poke
;a slot to -1 to force a debugging library
;to talk to that system component.
;Or, the address of an ASCIZ string can
;be poked in to force a debugging
;library to talk to that named component
;instead of the standard library
;debugging conventions.
$DATA STACP ;BYTE POINTER FOR NAME CREATION
$DATA MTLBLK,3 ;MUTIL BLOCK
SYSPRM (IPCSLN,4,.IPCFP+1) ;Length of a send block
SYSPRM (IPCRLN,.IPCFC+1,.IPCLL+1) ;Length of a receive block
$DATA SNDBLK,IPCSLN ;IPCF SEND PACKET DESCRIPTOR BLOCK
$DATA RCVBLK,IPCRLN ;IPCF RECEIVE PDB
$DATA SNDSAB,SAB.SZ ;PLACE TO BUILD A SAB INTO
$DATA RCVMDB,MDB.SZ ;PLACE TO BUILD MDB INTO
$DATA ACTPTR ;POINTER TO USER AREA FOR ACCT STRING
$DATA NODPTR ;POINTER TO USER AREA FOR NODE STRING
$DATA PACKET,SZ.PAK ;PLACE TO RECEIVE SHORT MESSAGE INTO
$DATA QUELOK ;LOCK FOR THE INTERNAL IPCF QUEUE
$DATA IPCQUE ;LINK LIST ID OF THE INTERNAL IPCF QUEUE
$DATA KEPPAG ;[106]DON'T RELEASE THE PAGE AFTER A SEND
TOPS10< $DATA OPRPPN ;PPN OF THE OPERATOR
$DATA MNTPPN ;PPN FOR MAINT PRIVS
$DATA GOPHER ; [SYSTEM]GOPHER PID, THE EXEC PSUEDO PROCESS
> ;END TOPS10 CONDITIONAL
$DATA IPCEND,0 ;END OF ZEROABLE $DATA SPACE
;SPDNAM TABLE TO SETUP SEARCH FOR SPECIAL SYSTEM PIDS BY NAME
DEFINE .SPID(CANNAM,T10IDX,T20IDX,SYMNAM),<
IFNB <SYMNAM>,<
$SET (CANNAM,,<SIXBIT/SYMNAM/>)
>;;END IFNB SYMNAM
>;End DEFINE .SPID
SPDNAM: $BUILD (SZ.PID)
SPIDS ;Generate the Special names
$EOB
; INDIRECT TEXT STRING TO USE FOR BUILDING INFO NAME
TOPS10 <
NAMTXT: ITEXT(<^U/[-1]/^W/S1/>) ;OUR NAME+CUSP+NULL
>
TOPS20 <
NAMTXT: ITEXT(<[^U/[-1]/]^W/S1/>)
> ;END TOPS20 CONDITIONAL
DEFINE $SLEEP(TIME),<
XLIST
TOPS10 <MOVEI S1,TIME ;;GET THE TIME TO SLEEP IN SECONDS
SLEEP S1, ;;GO TO SLEEP
>
TOPS20 <MOVEI S1,TIME*^D1000 ;;GET THE TIME TO SLEEP IN MILLISECONDS
DISMS ;;GO TO SLEEP
>
LIST>
SUBTTL C%INIT - Initialize the IPCF interface
; Initializes IPCF interface, acquires PID and does alternate search.
;CALL IS: IIB setup by I%INI1 in GLXINT
;TRUE RETURN: Always, PID stored in the IIB
C%INIT: MOVE S1,[IPCBEG,,IPCBEG+1] ;BLT PTR TO ZEROABLE $DATA SPACE
SETZM IPCBEG ;ZERO THE FIRST LOC
BLT S1,IPCEND-1 ;AND DO THE REST WITH A BLT
; SETZM FSTPFG ;Clear first PID flag
; SETZM IMOPR ;Say that I'm not ORION
; SETZM MYPID ;We don't have a PID
; SETZM ACTPTR ;Clear out the acct string ptr
; SETZM NODPTR ;And clear out nod pointer, too
SETOM ALTNAM+SP.INF ;Always use real system info
PUSHJ P,C%MAXP ;READ MAXIMUM PACKET SIZE
CAXLE S1,SZ.PAK ;IS IT TOO LARGE?
$WARN <Packet size (^D/[SZ.PAK]/) too small. MAXPAK (^D/S1/).>
CAXLE S1,SZ.PAK ;PACKET SIZE OK?
MOVX S1,SZ.PAK ;NO -- GET OUR MAXIMUM
MOVEM S1,MAXPAK ;STORE FOR C%SEND
TOPS10<
MOVX S1,%IPCSP ;GETTAB INDEX FOR [SYSTEM]GOPHER'S PID
GETTAB S1, ;GET EXEC PSUEDO-PROCESS'S PID
$STOP (GOF,SYSTEM GOPHER IS NOT AROUND)
MOVEM S1,GOPHER ;SAVE FOR LATER
SETOM ALTNAM+SP.IPC ;Always use real IPCC, too
>;End TOPS10 conditional
SKIPN S2,IIB+IB.PIB ;Does the caller want to use IPCF?
$RETT ;No, nothing to do here!
LOAD S1,PB.HDR(S2),PB.LEN ;Yes, get length of block in S1
PUSHJ P,C%CPID ;Get the PID
JUMPT .RETT ;OK
$STOP (CGP,Can't Get a PID)
SUBTTL C%CPID - Create a PID
;This routine will create a PID, give it a name, connect it to
; the interrupt system, set its quotas, etc, etc, based on the PIB passed.
;Arguments:
; S1-Length of block
; S2-Addr of PIB
;Returns:
; True, all set
; False, ERARG$
C%CPID: CAIL S1,PB.MNS ;Small PIB?
CAILE S1,PB.MXS ;.. or big PIB
$RETE (ARG) ;No good
$SAVE <P1,P2> ;Save some work regs
DMOVE P1,S1 ;Copy the input args
SKIPE FSTPFG ;Has our data base been intialized?
JRST CPID.1 ;Yes, charge on!
SETOM MSGFLG ;SET MESSAGE AVAILABLE FLAG
SETZM SNDFLG ;INIT SEND FLAGS
MOVX S1,IP.TTL ;GET TRUNCATE LONG MESSAGE FLAG
MOVEM S1,RCVFLG ;INIT RECEIVE FLAGS
PUSHJ P,RSPIDS ;READ THE SYSTEM PIDS
TOPS10 <
MOVX S1,%LDFFA ;WE NEED OPR PPN FOR PRIV CHECK
GETTAB S1, ;SO GET IT
MOVX S1,<1,,2> ;USE A SUITABLE DEFAULT
MOVEM S1,OPRPPN ;SAVE IT
MOVX S1,%LDUMD ;GET MAINTANANCE PPN
GETTAB S1,
MOVX S1,<6,,6>
MOVEM S1,MNTPPN
> ;END TOPS10 CONDITIONAL
;C%CPID CONTINUED ON NEXT PAGE
;C%CPID CONTINUED FROM PREVIOUS PAGE
CPID.1: LOAD S2,PB.INT(P2),IP.SPI ;GET REQUESTED INDEX
JUMPE S2,CPID.3 ;JUMP IF WE ARE NOT SYSTEM TO JUST GET A PID
CAXN S2,SP.OPR ;Becoming ORION?
SETOM IMOPR ;Set flag for .STOP
SKIPN S1,PIDTAB(S2) ;IS THERE A PID THERE?
JRST CPID.2 ;NAME NOT THERE -- MUST GET A PID
MOVEM S1,PB.PID(P2) ;Save as ours
PUSHJ P,C%PIDJ ;GET PID'S JOB NUMBER
JUMPF CPID.2 ;NO OWNER -- MUST GET A PID
CAME S1,MYJOB ;IS IT MINE?
$FATAL (Requested Pid belongs to JOB ^D/S1/) ;NOPE
JRST CPID.7 ;NO NEED TO GET A PID
;We already own that PID
CPID.2: SKIPN DEBUGW ;Are we debugging?
JRST CPID.4 ;No, never bother INFO in production
PUSHJ P,CHKNAM ;Set up the name pointer
JUMPT CPID.5 ;All set, caller has special debug name
;Otherwise, set up library convention
LOAD S2,PB.INT(P2),IP.SPI ;Get back special index
SKIPN S1,SPDNAM(S2) ;Get debugging name from table
$FATAL (No debugging name for special index ^O/S2/) ;None there
MOVEI S2,NAMTXT ;Aim at ITEXT to convert debug name
JRST CPID.5 ;Go setup the name, get the PID
;Here if we're not becoming a system PID
CPID.3: PUSHJ P,CHKNAM ;Set up name pointers
JUMPT CPID.5 ;All set, use callers name
;otherwise, use noname
CPID.4: SETZ S2, ;Indicate no name desired
CPID.5: PUSHJ P,SETNAM ;Set name in message to IPCC or IPCF
LOAD S1,PB.FLG(P2),IP.JWP ;Get desired job-wide flag
SKIPE DEBUGW ;[110]Debugging?
SETZ S1, ;[110]Yes, so don't make it job-wide
PUSHJ P,GETPID ;GET A PID FOR MY JOB
MOVEM S1,PB.PID(P2) ;SAVE ACQUIRED PID
;C%CPID CONTINUED ON NEXT PAGE
;C%CPID CONTINUED FROM PREVIOUS PAGE
;Here when the PID and requisite name have been set up.
CPID.7: LOAD S2,PB.PID(P2) ;Get back pid
SKIPE FSTPFG ;First time 'round?
JRST CPID.8 ;No, the defaults were set last time
MOVEM S2,DEFPID ;Save as default for -1 to C%SPID
MOVEM S2,MYPID ;That's mine!
SETOM FSTPFG ;Note that we've been here
CPID.8: LOAD S1,PB.INT(P2),IP.SPI ;GET SPECIAL INDEX FIELD
SKIPE S1 ;WANT TO BE SYSTEM PID?
PUSHJ P,SPID ;YES -- GO SET IT
SETO S1, ;SET TO WRITE IPCF PARAMETERS
SKIPE S2,PB.SYS(P2) ;GET IPCF PARAMETER WORD
PUSHJ P,IPRM ;MAKE CHANGES
LOAD S1,PB.FLG(P2),IP.RSE ;WANT SEND FAILURES RETURNED?
MOVNM S1,RSEFLG ;SET OR CLEAR THE FLAG
LOAD S1,PB.FLG(P2),IP.SPB ;GET SENDER'S PRIV FLAG
SKIPN DEBUGW ;DEBUGGING?
STORE S1,RCVFLG,IP.CFP ;NO -- STORE IN RECIEVE FLAGS
LOAD S1,PB.INT(P2),IP.CHN ;GET CHANNEL OR OFFSET FOR PSI
LOAD S2,PB.FLG(P2),IP.PSI ;SEE WHETHER PSI IS TO BE USED
MOVNM S2,PSIFLG ;SET OR CLEAR THE FLAG
LOAD S2,PB.PID(P2) ;Get desired PID
SKIPE PSIFLG ;IS IPCF CONNECTION WANTED?
PUSHJ P,CPIDI ;YES, CONNECT PID TO INTERRUPT SYSTEM
PUSHJ P,CHKAND ;Check out account and node pointers
$RETT ;All done
SUBTTL CHKNAM - See if PIB has a name attached
;Call - P1/ length of PIB
; P2/ addr of PIB
;Returns - FALSE if PIB is too short or no name pointer in PIB
; TRUE - S1 has pointer, S2 has ITEXT to it (suitable for SETNAM)
CHKNAM: CAILE P1,PB.NAM ;Was a name supplied?
SKIPN S1,PB.NAM(P2) ;Was one?
$RETF ;No, Tell caller there's none
TLCE S1,-1 ;0 left half
TLCN S1,-1 ; or -1 left half?
HRLI S1,(POINT 7,) ;Yes, make a pointer
MOVEI S2,[ITEXT (<^Q/S1/>)] ;Aim at the pointer just built
$RETT ;Return S1,S2 setup
SUBTTL CHKAND - Check PIB to see if account and node pointers specified
;Call - P1/ length of PIB
; P2/ addr of PIB
;Returns - TRUE (always)
CHKAND: CAIG P1,PB.ACT ;Is there an act ptr on the block?
$RETT ;No, quit
SKIPE S1,PB.ACT(P2) ;Get ptr, if any
MOVEM S1,ACTPTR ;Save it if there is one
CAIG P1,PB.LOC ;Is there a logical location pointer
$RETT ;No
SKIPE S1,PB.LOC(P2) ;Maybe, get it
MOVEM S1,NODPTR ;Yes there is, save it
$RETT ;All done
SUBTTL C%KPID, C%SPID
;C%KPID - Kill a PID
; Call - S1/addr of PIB describing PID to be killed
; Return, TRUE - PID has been killed, and removed from system tables
; (if appilicable)
; FALSE - PID wasn't killed,perhaps because
; insufficient privs, or no such PID
C%KPID: $SAVE <P1> ;Save work reg
MOVE P1,S1 ;Copy input arg
SKIPN S1,PB.PID(P1) ;Get PID, if any
$RETT ;None there, all done!
TOPS10<
LOAD S2,PB.INT(P1),IP.SPI ;Get special PID index
SKIPE S2 ;If special index
SKIPN DEBUGW ; ... and we're debugging,
SKIPA ;(Not special, or not debug) skipa
JRST KPID.N ; ... must be named, kill via INFO
$SAVE <P2> ;Preserve another AC
PUSH P,S1 ;Save PID to be killed
MOVE P2,P1 ;Setup addr of PIB
LOAD P1,PB.HDR(P2),PB.LEN ;Get length of the PIB
PUSHJ P,CHKNAM ;See if this PIB is named
JUMPF [POP P,S1 ;No name, Get back PID
JRST KPID.U] ;And kill it either way
POP P,S1 ;There is a name, must kill via INFO
KPID.N: PUSHJ P,KILPDN ;Kill via INFO
SKIPA ;Reenter common flow
KPID.U:>;End TOPS10
PUSHJ P,KILPID ;Give it the gong
JUMPF .RETF ;Couldn't do it
MOVE S2,PB.PID(P1) ;Get back PID just killed
MOVSI S1,-SZ.PID ;Get AOBJN ptr for PIDTAB
KPID.1: CAMN S2,PIDTAB(S1) ;Does this one match?
SETZM PIDTAB(S1) ;Yes, kill it
AOBJN S1,KPID.1 ;Check all the pids in our table
$RETT ;Back to caller
;C%SPID - A routine to set the default send PID
;Call S1/addr of PIB describing new default or -1 to set original default
;Return - TRUE always
C%SPID: SKIPGE S1 ;Skip if a PIB is there, otherwise...
SKIPA S2,DEFPID ;Get original default PID
SKIPE S2,PB.PID(S1) ;Get PID to be set
MOVEM S2,MYPID ;Set as our sender default
$RETT
SUBTTL C%SEND Routine to send an IPCF Message
;CALL S1/ Length of SAB
; S2/ Address of SAB
;TRUE Return if message is sent Successfully
;FALSE Return if message cannot be sent for any reason
;POSSIBLE ERRORS
; ERARG$ Invalid Calling Argument
; ERNSP$ No Such Pid
; ERRQF$ Recievers Quota Full
; ERSQF$ Senders Quota Full
; ERSLE$ System Limits Exceeded
; ERUSE$ Unexpected System Error
C%SEND: SETZM KEPPAG ;[106]ASSUME WANT TO RELEASE THE PAGE
TXZE S1,PT.KEE ;[106]KEEP THIS PAGE AFTER A SEND?
SETOM KEPPAG ;[106]YES, INDICATE SO
CAIGE S1,SAB.SZ ;[106]PROPER SAB?
$RETE(ARG) ;NO -- RETURN ERROR
PUSHJ P,.SAVE2 ;PRESERVE P1-P2
LOAD P1,SAB.LN(S2) ;P1 IS MESSAGE LENGTH
MOVE P2,S2 ;P2 IS SAB ADDRESS
CAIL P1,1 ;MESSAGE LENGTH OK?
CAILE P1,PAGSIZ
$RETE(ARG) ;NO -- RETURN ERROR
LOAD S2,SAB.MS(P2) ;GET MESSAGE ADDRESS
CAMG P1,MAXPAK ;LARGR THAN A PACKET?
JRST SEND.4 ;NO -- SEND A PACKET
CAIN P1,PAGSIZ ;EXACTLY ONE PAGE?
JRST SEND.2 ;YES -- GO SEND IT
$CALL M%GPAG ;NO -- CREATE A PAGE AND COPY MESSAGE
HRL S1,SAB.MS(P2) ;FORM BLT POINTER
HRRZ S2,S1 ;GET NEW PAGE ADDRESS
ADDI S2,0(P1) ;ADDRESS + MESSAGE SIZE
BLT S1,-1(S2) ;MOVE ENTIRE MESSAGE TO NEW PAGE
SUBI S2,0(P1) ;RECLAIM NEW MESSAGE ADDRESS
SETZM KEPPAG ;[106]RETURN SUPPLIED PAGE
;HERE TO SEND A PAGE
SEND.2: TRNE S2,PAGSIZ-1 ;IS PAGE ON PAGE BOUNDRY?
$RETE(ARG) ;NO -- RETURN ERROR
ADR2PG S2 ;YES -- CONVERT TO PAGE NUMBER
HRLI S2,PAGSIZ ;SEND A FULL PAGE
MOVX S1,IP.CFV ;GET THE PAGE MODE FLAG
IORM S1,SNDFLG ;AND SET IT
MOVE S1,P2 ;POINT TO SAB
MOVEI P2,(S2) ;REMEMBER THE PAGE NUMBER
PUSHJ P,SNDMSG ;GO SEND THE MESSAGE
JUMPT .POPJ ;ANY ERRORS? NO, RETURN
CAIN P1,PAGSIZ ;YES, DID WE SUPPLY THIS PAGE?
$RET ;NO, USER GAVE US THE PAGE, RETURN F
$SAVE <TF,S1> ;SAVE FOR FINAL RETURN
MOVE S1,P2 ;RECLAIM PAGE NUMBER
$CALL M%RELP ;RELEASE THE PAGE WE GOT FOR THE BIG PACKET
$RET ;RETURN TF AND S1 FROM SNDMSG
;HERE TO SEND A PACKET
SEND.4: HRL S2,P1 ;FORM LENGTH,,ADDRESS
MOVX S1,IP.CFV ;GET PAGE MODE FLAG
ANDCAM S1,SNDFLG ;AND CLEAR IT
MOVE S1,P2 ;POINT TO SAB
PJRST SNDMSG ;FALL INTO COMMON CODE AND RETURN
SUBTTL SNDMSG - Work routine to do actual IPCF send
;CALL S1/ SAB Address
; S2/ Message Length,,Message Address
;If the message is paged, then a true return will
; leave the page unaddressable, and a false return will leave it addressable
SNDMSG: $SAVE <P1,P2,P3,P4>
DMOVE P1,S1 ;PRESERVE CALLING ARGS
SKIPN P3,RSEFLG ;RETURN SEND ERRORS?
MOVX P3,RT.SFL ;NO -- LOAD RETRY LIMIT
MOVE S1,MYPID ;GET MY PID
SKIPE S2,SAB.PB(P1) ;WANT TO SEND FOR A DIFFERENT PID?
MOVE S1,PB.PID(S2) ;YES, GET PID FROM PIB ATTACKED TO SAB
SKIPN S1 ;IS THERE REALLY A PID?
$RETE (ARG) ;NO, COMPLAIN
MOVEM S1,SNDBLK+.IPCFS ;I AM SENDER
LOAD S1,SAB.PD(P1) ;GET RECIEVERS PID OR ADDR OF PID'S NAME
SETO P4, ;SYSTEM INDEX OR -1 IF SEND BY PID
LOAD S2,SAB.SI(P1),SI.FLG ;GET SPECIAL INDEX FLAG
JUMPE S2,SNDM.2 ;SEND BY PID? NO, TRY OTHER FEATURES
LOAD S1,SAB.SI(P1),SI.IDX ;NO -- SEND BY INDEX
MOVE P4,S1 ;REMEMBER WHO IT IS
SKIPN P3,RSEFLG ;RETURN SEND ERRORS?
MOVX P3,RT.SCL ;NO -- GET SYSTEM RETRY LIMIT
SNDM.1: PUSHJ P,RSPID ;GET THE RECIEVERS PID
JUMPT SNDM.3 ;GOT IT, SO SEND TO IT
CAIE S1,ERNSP$ ;UNKNOWN PID FOR SYSTEM COMPONENT?
$RET ;NO -- RETURN THE ERROR
CAXN P3,RT.SCL ;YES -- FIRST RETRY?
SKIPN SPDNAM(P4) ;YES -- DOES PID HAVE A NAME?
CAIA ;NO -- DON'T PRINT THE MSG
SKIPN DEBUGW ;YES -- DEBUGGING?
CAIA ;NO -- DON'T PRINT THE MESSAGE
$WARN (Waiting for ^W/SPDNAM(P4)/ to start)
SOJL P3,.POPJ ;RETURN ERROR IF RETRY LIMIT EXAUSTED
$SLEEP RT.SLP ;SLEEP FOR A WHILE
MOVE S1,P4 ;RETORE DESIRED INDEX
JRST SNDM.1 ;AND TRY AGAIN
SNDM.2: LOAD S2,SAB.SI(P1),SI.NAM ;WANT TO SEND TO A NAMED PID?
JUMPE S2,SNDM.3 ;NO, JUST USE THE PID
MOVEI S2,[ITEXT(^Q/S1/)] ;YES, AIM AT THE TEXT (SAB.PD HAS ADDR)
PUSHJ P,FNDNAM ;GET THE NAME'S PID FROM INFO
JUMPF .POPJ ;QUIT IF INFO CAN'T MAP THE NAME
SNDM.3: MOVEM S1,SNDBLK+.IPCFR ;SAVE RECIEVERS PID
MOVEM P2,SNDBLK+.IPCFP ;SAVE PAGE/PACKET POINTER
MOVE S2,SNDFLG ;GET SEND FLAGS
TOPS10 <
CAME S1,GOPHER ;SENDING TO SYSTEM GOPHER?
CAMN S1,PIDTAB+SP.IPC ;SENDING TO IPCC?
IORX S2,IP.CFP ;YES -- ENABLE PRIVS
SETZ P1, ;CLEAR PAGE MODE TO GOPHER FLAG
CAMN S1,GOPHER ;SENDING TO GOPHER?
TXZN S2,IP.CFV ;SENDING A PAGE TO THE GOPHER?
JRST SNDM.4 ;NO, NOTHING SPECIAL
SETO P1, ;NOTE THAT WE FAKED A PAGE TO GOPHER
IORX S2,IP.CFL ;YES, SET LARGE PACKET BIT
HRRZ TF,P2 ;GOPHER DOESN'T LIKE PAGES
PG2ADR TF ;SO MAKE IT A LARGE PACKET
HRLI TF,PAGSIZ-2 ;AND LOSE 2 WORDS OF CALLER'S MESSAGE
MOVEM TF,SNDBLK+.IPCFP ;SEND LARGE PACKET INSTEAD
SNDM.4:
> ;END TOPS10 CONDITIONAL
MOVEM S2,SNDBLK+.IPCFL ;STORE SEND FLAGS
TOPS10 <
SNDM.5: MOVE S1,[IPCSLN,,SNDBLK] ;ARG FOR UUO
IPCFS. S1, ;SEND THE MESSAGE
JRST SNDERR ;SEE WHY WE LOST
> ;END TOPS10 CONDITIONAL
TOPS20 <
SNDM.5: MOVEI S1,IPCSLN ;NUMBER OF WORDS IN BLOCK
MOVEI S2,SNDBLK ;AND ITS ADDRESS
MSEND ;SEND IT
JRST SNDERR ;SEE WHY WE LOST
> ;END TOPS20 CONDITIONAL
;Here if the send wins
HLRZ S1,P2 ;GET DESIRED MESSAGE SIZE
CAIE S1,PAGSIZ ;WAS THE MESSAGE A PAGE?
$RETT ;NO, ALL DONE!
SKIPE KEPPAG ;[106]WANT TO KEEP THE PAGE?
$RETT ;[106]RETURN NOW
HRRZ S1,P2 ;GET THE ADRS OF THE PAGE
PUSHJ P,M%IPSN## ;NO, NOTIFY MEMORY MANAGER OF PAGE SENT
HRRZ S1,P2 ;GET PAGE NUMBER AGAIN
PJRST M%RELP## ;AND NOW SAY ITS OUT OF OUR ADRS SPACE
;SNDMSG CONTINUED ON NEXT PAGE
;SNDMSG CONTINUED FROM PREVIOUS PAGE
;HERE TO HANDLE SEND FAILURES WITH ERROR CODE IN S1
SNDERR: CAXE S1,IPE.SQ ;SENDER'S QUOTA FULL?
CAXN S1,IPE.RQ ;OR RECIEVER'S QUOTA FULL?
JRST SNDE.1 ;YES -- THEN TRY AGAIN
CAXE S1,IPE.SF ;FREE SPACE EXAUSTED?
;**;[101]At SNDERR:+4L add 2 lines JYCW 10/7/85
CAXN S1,IPE.SS ;[101]Swappable free space?
SKIPA ;[101]Yes, try again
JRST SNDE.3 ;NO -- THEN FAIL
;HERE TO HANDLE TRANSIENT SEND FAILURES
SNDE.1: SOJL P3,SNDE.2 ;TIME TO GIVE UP?
$SLEEP RT.SLP ;WAIT FOR CONDITION TO CLEAR
JRST SNDM.5 ;THEN TRY THE SEND AGAIN
;**;[101]At SNDE.2: add 1 line JYCW 10/7/85
SNDE.2: CAXE S1,IPE.SS ;[101]No swappable free space
CAXN S1,IPE.SF ;NO SYSTEM FREE SPACE?
JRST [ $WARN(IPCF Swapping Space Low - Will Retry Message Send)
MOVX P3,RT.SCL ;Reset Retry Count
JRST SNDM.5 ] ;Reattempt to send message
CAXN S1,IPE.RQ ;IS RECEIVER'S QUOTA FULL?
$RETE(RQF) ;YES -- RETURN ERROR
CAXN S1,IPE.SQ ;IS SENDER'S QUOTA FULL?
$RETE(SQF) ;YES -- RETURN ERROR
SNDE.3: CAXE S1,IPE.DU ;UNKNOWN DESTINATION?
$RETE(USE) ;NO -- UNEXPECTED SYSTEM ERROR
SKIPL P4 ;YES --WAS THERE A SYSTEM INDEX?
SETZM PIDTAB(P4) ;YES -- REMEMBER IT'S GONE AWAY
$RETE(NSP) ;RETURN NO SUCH PID
SUBTTL C%INTR - Interrupt level routine to flag message available
;Called to note the fact that an IPCF interrupt has occured
;CALL IS: No arguments
;
;TRUE RETURN: Always
C%INTR: SKIPN PSIFLG ;ARE IPCF INTERRUPTS EXPECTED?
$STOP(UIR,Unexpected IPCF interrupt received)
SETOM MSGFLG ;FLAG THAT INTERRUPT HAS OCCURED
TOPS10 <
MOVE S1,@IPCINT ;GET ASSOCIATED VARIABLE
SKIPN IPCSTS ;ALREADY SETUP
MOVEM S1,IPCSTS ;NO..SET IT UP
>;END TOPS10 CONDITIONAL
$RETT ;TAKE A GOOD RETURN
SUBTTL C%RECV - Non-blocking IPCF receive
;C%RECV returns the next message from the IPCF queue or error ERNMA$
; indicating that no messages are outstanding.
;
;CALL IS: No arguments
;
;TRUE RETURN: S1/ CONTAINS POINTER TO MDB (SEE GLXMAC)
; OR
;FALSE RETURN: S1/ CONTAINS ERROR CODE FOR FAILURE
C%RECV: AOSE MSGFLG ;IF FLAG SAYS THERE IS MESSAGE
SKIPN PSIFLG ; OR NO PSI CONNECTION
SKIPA S1,[IP.CFB] ;OK -- GET NON-BLOCKING FLAG
$RETE(NMA) ;OTHERWISE, NO MESSAGE AVAILABLE
IORM S1,RCVFLG ;SET THE FLAG
PJRST RCVMSG ;AND GO DO THE WORK
SUBTTL C%BRCV - Blocking IPCF Receive
;C%BRCV differs from C%RECV in that it never returns with the error
; condition ERNMA$. If no message is available, C%BRCV will block,
; waiting for the next IPCF message.
;
;CALL IS: No arguments
;
;TRUE RETURN: S1/ CONTAINS POINTER TO MDB (SEE GLXMAC)
; OR
;FALSE RETURN: S1/ CONTAINS ERROR CODE (SEE GLXMAC)
C%BRCV: MOVX S1,IP.CFB ;GET NON BLOCKING FLAG
ANDCAM S1,RCVFLG ;CLEAR IT AND GO DO RECIEVE
SUBTTL RCVMSG - Work routine to do an actual IPCF receive
RCVMSG: SKIPN QUELOK ;IS THE IPCF QUEUE LOCKED ???
SKIPN S1,IPCQUE ;NO,,ANY INTERNAL QUEUE ???
JRST RCVM.A ;LOCKED OR NO QUEUE,,GET REAL MSG
;Here to pick up an IPCF message off the internal queue
PUSHJ P,L%FIRST ;GET THE FIRST MSG ON THE QUEUE
JUMPF [MOVE S1,IPCQUE ;NO MSGS,,GET THE ID BACK
SETZM IPCQUE ;CLEAR THE QUEUE ID
PUSHJ P,L%DLST ;DELETE THE QUEUE
JRST RCVM.A ] ;AND GET A REAL MESSAGE
SETOM MSGFLG ;REMEMBER WE HAVE A PACKET
MOVSS S2 ;GET MDB ADDRESS,,0
HRRI S2,RCVMDB ;GET MDB ADDRESS,,DESTINATION
BLT S2,RCVMDB+MDB.SZ-1 ;COPY OVER TO PERMANENT MDB
PUSHJ P,L%DENT ;DELETE THE QUEUED MDB
LOAD S1,RCVMDB+MDB.MS,MD.CNT ;GET THE MESSAGE LENGTH
CAXN S1,PAGSIZ ;IS IT A PAGE ???
JRST RCVM.7 ;YES,,RETURN TO THE USER
LOAD S2,RCVMDB+MDB.MS,MD.ADR ;GET THE PACKET ADDRESS
PUSH P,S2 ;SAVE ITS ADDRESS
MOVSS S2 ;GET PACKET ADDRESS,,0
HRRI S2,PACKET ;GET PACKET ADDRESS,,NEW ADDRESS
BLT S2,PACKET-1(S1) ;COPY IT OVER
POP P,S2 ;GET THE ADDRESS BACK
PUSHJ P,M%RMEM ;DELETE THE QUEUED PACKET
MOVEI S1,PACKET ;GET THE NEW PACKET ADDRESS
STORE S1,RCVMDB+MDB.MS,MD.ADR ;AND SAVE IT
JRST RCVM.7 ;RETURN TO THE USER
;Here to recieve a real IPCF message
RCVM.A: PUSHJ P,.SAVE3 ;GET SOME AC'S
SETZ S1, ;SETUP TO TEST/CLEAR IPCSTS
EXCH S1,IPCSTS ;GET STATUS WORD AND RESET
SKIPN S1 ;ANYTHING SET?
TXOA S1,1 ;NO -- SET A BIT FOR PAGE MODE
LOAD S1,S1,IP.CFV ;YES -- GET ACTUAL MODE
STORE S1,RCVFLG,IP.CFV ;STORE MODE FLAG
JUMPE S1,RCVM.1 ;PACKET?
RCVM.0: SKIPE S1,RCVPAG ;NO -- DO WE HAVE A RECIVE PAGE?
JRST RCVM.1 ;YES -- NO NEED TO GET ONE
PUSHJ P,M%NXPG ;NO --GET A NON-EXISTENT PAGE
JUMPF [SETOM MSGFLG ;OOPS -- CAN'T GET ONE
$RETE (SLE)] ;RETURN ERROR
HRLI S1,PAGSIZ ;PLACE PAGE SIZE IN LEFT HALF
MOVEM S1,RCVPAG ;AND SAVE IT
RCVM.1: MOVE S1,RCVFLG ;GET FLAGS TO USE
MOVEM S1,RCVBLK+.IPCFL ;INIT RECIEVE BLOCK
TXNN S1,IP.CFV ;PAGE MODE?
SKIPA S2,[SZ.PAK,,PACKET] ;NO -- POINT TO PACKET
MOVE S2,RCVPAG ;YES -- GET PAGE TO USE
MOVEM S2,RCVBLK+.IPCFP ;SAVE PROPER POINTER
MOVE S1,MYPID ;RECIEVE ON MY BEHALF
MOVEM S1,RCVBLK+.IPCFR
SETZM RCVBLK+.IPCFS ;UNKNOWN SENDER -- UNTIL RECIEVE
TOPS10 <
RCVM.2: MOVE S1,[IPCRLN,,RCVBLK] ;UUO ARGUMENT
IPCFR. S1, ;DO THE RECEIVE
JRST RCVM.3 ;WE HAVE AN ERROR, GO ANALYZE IT
SKIPE S1 ;ANY ASSOCIATED VARIABLE
MOVEM S1,IPCSTS ;YES..UPDATE THE STATUS
LOAD S2,RCVBLK+.IPCFU ;GET LOGGED IN PPN OF USER
STORE S2,RCVMDB+MDB.SD ;STORE IT
STORE S2,RCVMDB+MDB.CD ;ALSO USE IT AS CONNECTED DIRECTORY
MOVE S2,RCVBLK+.IPCFC ;GET CAPABILTIES WORD
LOAD P1,S2,IP.SJN ;GET SENDERS JOB NUMBER
STORE P1,P1,MD.PJB ;STORE IT
TXNE S2,IP.JAC ;JACCT ON?
TXO P1,MD.PWH ;YES, TURN ON WHEEL
MOVE S2,RCVBLK+.IPCFU ;GET PPN WORD
CAMN S2,OPRPPN ;IS HE THE OPERATOR?
TXO P1,MD.POP ;YES, SET OPERATOR
CAMN S2,MNTPPN ;HAVE MAINTANANCE PRIVS?
TXO P1,MD.PMT ;YES, SET THE PRIV
LOAD S1,P1,MD.PJB ;GET THE JOB NUMBER
STORE P1,RCVMDB+MDB.PV ;SAVE SENDERS PRIVILEGES
SKIPN NODPTR ;WANT THE LOCATED NODE RETURNED?
PJRST RCVM.5 ;NO..PROCEED
MOVX S2,JI.LOC ;YES..GET THE INFO
$CALL I%JINF
JUMPF RCVM.5 ;SORRY ABOUT THAT
MOVE S1,NODPTR ;GET THE POINTER
$CALL SIXASC ;STORE SIXBIT AS ASCIZ
JRST RCVM.5 ;GO FINISH UP
> ;END TOPS10 CONDITIONAL
TOPS20 <
RCVM.2: MOVE S1,ACTPTR ;Get ptr to users acct area
MOVEM S1,RCVBLK+.IPCAS ;SAVE IT IN THE BLOCK.
MOVE S1,NODPTR ;Get ptr to users node area
MOVEM S1,RCVBLK+.IPCLL ;SAVE IT IN THE BLOCK
DMOVE S1,[EXP IPCRLN,RCVBLK] ;SET SIZE AND LOCATION OF BLOCK
MRECV ;DO THE RECEIVE
JRST RCVM.3 ;WE HAVE AN ERROR, ANALYZE IT
SKIPE S1 ;ANY ASSOCIATED VARIABLE
MOVEM S1,IPCSTS ;YES..UPDATE THE STATUS
MOVE S2,RCVBLK+.IPCFD ;GET LOGGED IN NUMBER
STORE S2,RCVMDB+MDB.SD ;STORE AS USER NUMBER
MOVE S2,RCVBLK+.IPCSD ;GET THE CONNECTED DIRECTORY
STORE S2,RCVMDB+MDB.CD ;AND STORE IT TOO
LOAD S1,RCVBLK+.IPCFS ;GET SENDERS PID
$CALL C%PIDJ ;GET SENDERS JOB NUMBER
SKIPT ;FAIL?
SETZ S1, ;YES..STORE A ZERO
SETZ P3, ;CLEAR ANY JUNK
STORE S1,P3,MD.PJB ;AND PUT IT IN THE CORRECT PLACE
MOVE S2,RCVBLK+.IPCFC ;GET OS CAPABILITIES
MOVEM S2,RCVMDB+MDB.PR ;Save enabled capabilites of sender
TXNE S2,SC%WHL ;SENDER A WHEEL?
TXO P3,MD.PWH ;YES
TXNE S2,SC%OPR ;SENDER AN OPERATOR?
TXO P3,MD.POP ;YES
TXNE S2,SC%MNT ;GOT MAINTAINACE PRIVS
TXO P3,MD.PMT ;YES!
TXNE S2,SC%SEM ;[6000]GOT SEMI-OPR PRIVS
TXO P3,MD.SEM ;YES!
MOVEM P3,RCVMDB+MDB.PV ;STORE THE PRIVS
JRST RCVM.5 ;GO FINISH UP THE RECEIVE
> ;END TOPS20 CONDITIONAL
; HERE TO WHEN IPCF RECIEVE FAILS
RCVM.3: CAXN S1,IPE.NM ;IS THIS "NO MESSAGE"?
$RETE (NMA) ;YES -- RETURN
CAXE S1,IPE.WM ;CHECK FOR "WRONG MODE" ERROR
JRST RCVM.4 ;NOPE -- MUST BE REAL ERROR
MOVX S1,IP.CFV ;YES --GET PAGE MODE BIT
XORB S1,RCVFLG ;SWITCH MODES
TXNE S1,IP.CFV ;PAGE MODE
JRST RCVM.0 ;YES -- GO GET IT RIGHT
JRST RCVM.1 ;NO -- GO GET A PACKET
RCVM.4: CAXE S1,IPE.NR ;CHECK FOR "NO ROOM" (TOPS-10)
$STOP(IRF,IPCF Reception failure)
PUSHJ P,M%IPRM ;TRY TO MAKE SOME ROOM
JUMPT RCVM.1 ;TRY AGAIN
$RETE (NPI) ;?NO FREE PAGES FOR IPCF RECEPTION
;HERE ON A SUCCESSFUL RECEIVE
RCVM.5: SKIPE IPCSTS ;MORE MESSAGES IN QUEUE?
SETOM MSGFLG ;YES -- SET MSG AVAILABLE FLAG
LOAD S1,RCVBLK+.IPCFL ;GET FLAGS
STORE S1,RCVMDB+MDB.FG ;STORE INTO MDB
TXNE S1,IP.CFV ;DID WE RECIVE A PAGE?
SETZM RCVPAG ;YES -- CLEAR OUR PAGE
LOAD S1,RCVBLK+.IPCFP ;GET LENGTH AND ADDRESS OF DATA
STORE S1,RCVMDB+MDB.MS ;STORE INTO MDB
LOAD S1,RCVBLK+.IPCFS ;GET PID OF SENDER
STORE S1,RCVMDB+MDB.SP ;STORE AS SENDER'S PID
LOAD S1,RCVBLK+.IPCFR ;GET RECEIVER'S PID
STORE S1,RCVMDB+MDB.RP ;STORE IT TOO
SETZM RCVMDB+MDB.SI ;ASSUME NOT A SPECIAL SENDER
MOVSI S1,-SZ.PID ;GET LENGTH OF TABLE
MOVE S2,RCVMDB+MDB.SP ;GET SENDER'S PID
CAME S2,PIDTAB(S1) ;MATCH SENDER'S PID?
AOBJN S1,.-1 ;KEEP LOOKING
TXZN S1,LHMASK ;WAS IT A MATCH?
JRST RCVM.6 ;NO -- GIVE UP
TXO S1,SI.FLG ;YES -- SET SPECIAL INDEX FLAG
MOVEM S1,RCVMDB+MDB.SI ;STORE INTO INDEX WORD
MOVX S1,MD.POP ;SET OPERATOR CAPABILITY
SKIPE DEBUGW ;DEBUGGING?
IORM S1,RCVMDB+MDB.PV ;YES..SET THE CAPABILITY
RCVM.6: LOAD S1,RCVMDB+MDB.MS,MD.CNT ;GET SIZE OF MESSAGE
CAXE S1,PAGSIZ ;IF NOT A PAGE
JRST RCVM.7 ;RETURN NOW
LOAD S1,RCVMDB+MDB.MS,MD.ADR ;GET PAGE NUMBER
PUSHJ P,M%IPRC ;NOTIFY THAT IT IS IN NOW
LOAD S1,RCVMDB+MDB.MS,MD.ADR ;GET PAGE NUMBER FROM MDB
PG2ADR S1 ;CONVERT IT TO AN ADDRESS
STORE S1,RCVMDB+MDB.MS,MD.ADR ;STORE IT BACK INTO MDB
RCVM.7: MOVEI S1,RCVMDB ;GET POINTER TO MDB AND TAKE
$RETT ;GENERATE A GOOD RETURN
SUBTTL C%REL - Release the last message received
; C%REL is used to release the last message received via C%RECV or C%BRCV.
;If this message is a packet, then this is a null operation, and if its
;a page, the page is released.
;CALL IS: No arguments
;
;TRUE RETURN: Always
C%REL: SKIPN S2,RCVMDB+MDB.MS ;GET SIZE AND ADDRESS OF MESSAGE
$STOP(RAR,Releasing already released IPCF message) ;ALREADY RELEASED
ZERO RCVMDB+MDB.MS ;MARK MESSAGE AS RELEASED
LOAD S1,S2,MD.CNT ;GET SIZE OF MESSAGE
CAXE S1,PAGSIZ ;IS THIS MESSAGE A PAGE?
$RETT ;NO, SO RETURN NOW
LOAD S1,S2,MD.ADR ;GET ADDRESS OF MESSAGE
ADR2PG S1 ;GET THE PAGE NUMBER
PJRST M%RELP ;RETURN AFTER RELEASING THE PAGE
SUBTTL C%RPRM Routine to read IPCF Parameters
;C%RPRM IS USED TO EXAMINE THE MOST COMMONLY NEEDED
;IPCF PARAMETERS. THESE INCLUDE THE TOTAL NUMBER OF PIDS AND THE
;IPCF RECEPTION / SEND QUOTAS.
;CALL IS: S1/ -1 TO READ PARAMETERS OF PID QUOTA, SND,RCV QUOTAS
; OR ELSE AN SP.??? SYMBOL TO RETURN THAT ENTRY FROM
; THE PID TABLE
;
;TRUE RETURN: IF THE INFORMATION IS AVAILABLE
; S1/<MAX PIDS>B17+<SND QUOTA>B26+<RCV QUOTA>B35 ;IF S1=-1
; S1/ PID TABLE ENTRY ; IF S1=0 OR +
C%RPRM: JUMPGE S1,RSPID ;IF NON-ZERO, WANT SYSTEM PID
SETZ S1, ;SET TO READ IPCF PARAMETERS
PJRST IPRM ;GO READ PARAMS AND RETURN
SUBTTL GETPID - Acquire a PID for this job
;CALL IS: First, Call SETNAM to setup name (if any)
; S1 - 1 means set JWP
;
;TRUE RETURN: S1/ PID acquired for this job
GETPID:
TOPS10 <
$SAVE <P1,P2,MYPID> ;Save some regs
PJOB S2, ;Get our job number
MOVX TF,IB.DPM ;GET A BIT
TDNE TF,IIB##+IB.FLG ;USE JOB NUMBER AS PID ?
JRST GETP.1 ;YES - THIS MAKES LIFE EASY FOR US
MOVEM S2,MYPID ;Save as our (temporary) PID
SKIPN P2,S1 ;Want JWP?
TXO S2,1B0 ;NO -- MAKE PID TEMPORARY
MOVEM S2,PACKET+.IPCI1 ;ARGUMENT
SETO P1, ;Set 'named PID flag'
SKIPE PACKET+.IPCI2 ;Is a name desired?
JRST GETP.3 ;Yes, must go thru INFO
SETZ P1, ;Clear 'named PID flag'
MOVE S1,[XWD C%INIT,.IPCSC] ;FUNCTION IS MAKE PID
MOVX S2,SP.IPC ;ASK IPCC TO DO IT
PUSHJ P,SNDSYS ;SEND IT OFF, GET REPLY
JUMPF GETP.2 ;Failed, maybe no privs, try INFO
MOVE S1,PACKET+.IPCS2 ;GET PID RETURNED BY IPCC
$RETT ;RETURN
; Here to use our job number fo r a PID
GETP.1: MOVE S1,S2 ;GET JOB NUMBER
$RETT ;RETURN
;Here to ask INFO for a PID (perhaps named)
GETP.2: SETZ S2, ;Indicate no name desired
PUSHJ P,SETNAM ;Set up the PACKET
GETP.3: MOVE S1,[XWD C%INIT,.IPCII] ;Function to make a named PID, till RESET
SKIPE P2 ;Want to be job-wide?
MOVE S1,[XWD C%INIT,.IPCIJ] ;Function to make a named PID, job wide
MOVX S2,SP.INF ;Ask INFO to do it
PUSHJ P,SNDSYS ;SEND IT OFF, GET REPLY
SKIPT ;Ok?, Yes, return it
$FATAL <Can't get a PID>
MOVE S1,PACKET+.IPCI1 ;Get the PID returned by INFO
SKIPN P1 ;Did we get a name?
$RETT ;Give that back
SKIPE DEBUGW ;ARE WE DEBUGGING?
$WARN <^I/NAMMSG/> ;Type the name we're getting
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
$SAVE <T1,T2,T3,T4> ;SAVE TEMPS
MOVX T1,.MUCRE ;CREATE A PID FUNCTION
MOVX T2,IP%CPD+.FHSLF ;CREATE A PID FOR ME
STORE S1,T2,IP%JWP ;SET OR CLEAR REQUEST FLAG
DMOVE S1,[EXP 3,T1] ;3 WORDS, START AT T1
MUTIL ;EXECUTE IT
$FATAL <Can't get a PID>
MOVEM T3,PACKET+.IPCI1 ;Save PID obtained
MOVE S1,T3 ;Set up for quick return
SKIPN PACKET+.IPCI2 ;Do we need a name?
$RETT ;No, all done!
PUSH P,MYPID ;Save whatever is there now
MOVEM S1,MYPID ;Save temp PID while we name ourselves
SKIPE DEBUGW ;ARE WE DEBUGGING?
$WARN <^I/NAMMSG/> ;TYPE OUT MESSAGE
MOVE S1,[XWD C%INIT,.IPCII] ;Setup code to assign name
MOVX S2,SP.INF ;Send to INFO
PUSHJ P,SNDSYS ;Get name assigned to our PID
SKIPT ;Did that work?
$FATAL <Can't name the PID. Error bits = ^O/RCVMDB+MDB.FG,IP.CFE/>
MOVE S1,MYPID ;Get back PID
POP P,MYPID ;Put back previous PID
$RETT ;OK
> ;END TOPS20 CONDITIONAL
;An ITEXT to print out the debugging name
NAMMSG: ITEXT <Becoming ^T20/PACKET+.IPCI2/ (PID = ^O/S1/)>
SUBTTL KILPID Routine to delete a pid
;KILL PID IS CALLED DURING INITIALIZATION TO RETURN ANY PID ACQUIRED
;THAT WE NO LONGER NEED.
;Tops10 Alternate entry at KILPDN, to kill a PID via INFO, since
; the PID to be killed is known to be named
;CALL S1/ Pid to be killed
;TRUE RETURN: Pid has been killed
;FALSE RETURN: Pid wasn't killed
TOPS10 <
KILPID: MOVEM S1,PACKET+.IPCI1 ;SAVE PID TO BE KILLED
MOVE S1,[KILPID,,.IPCSZ] ;CODE,,DELETE PID FUNCTION
MOVX S2,SP.IPC ;Try sending to IPCC
PUSHJ P,SNDSYS ;SEND IT OFF
JUMPT .RETT ;RETURN IF ALL SET
MOVE S1,PACKET+.IPCI1 ;Get back PID which should have gone
KILPDN: MOVEM S1,PACKET+.IPCI2 ;Save PID in message to INFO
MOVE S1,[KILPID,,.IPCID] ;IPCC won't listen, probably no privs
MOVX S2,SP.INF ;Try INFO
PJRST SNDSYS ;If that bombs, return F
> ;END TOPS10 CONDTIONAL
TOPS20 <
KILPID: MOVEM S1,MTLBLK+1 ;SAVE PID TO BE KILLED
DMOVE S1,[EXP 1,MTLBLK] ;POINT TO IT
MOVX S1,.MUDES ;DESTROY THE PID
MOVEM S1,MTLBLK ;SET THE FUNCTION
MUTIL
$RETF
$RETT
> ;END TOPS20 CONDITIONAL
SUBTTL SPID - Set a system PID
;SPID sets a system wide pid in the internal pid table and in the
;monitor pid table if not debugging.
;CALL IS: S1/ Index into the system pid table
; S2/ Pid to store in system Pid Table
;
;RETURN: Pid stored in internal and system pid table
; (if Debugging -- pid is stored in internal table only)
SPID: CAIL S1,1 ;MUST BE 1 THRU SZ.PID
CAXL S1,SZ.PID ;INDEX IN RANGE?
$STOP (PIR,PID Index out of range)
MOVEM S2,PIDTAB(S1) ;STORE MYPID IN INTERNAL TABLE
TOPS20 <
MOVEM S1,MTLBLK+1 ;STORE THE TABLE OFFSET
MOVEM S2,MTLBLK+2 ;STORE PID TOO
SKIPN S1,DEBUGW ;Debugging?
JRST SPID.1 ;No, go to set pid in system table
TXNN S1,DB.IPC ;Debugging IPC?
$RETT ;No, go no further
SETZ S2, ;Clear S2
MOVE S1,MTLBLK+1 ;Get index back
CAIN S1,.SPQSR ;Is it QUASAR?
MOVEI S2,.SDQSR ;Yes, set debugging system PID
CAIN S1,.SPOPR ;Is it ORION?
MOVEI S2,.SDOPR ;Yes, set debugging system PID
CAIN S1,.SPNEB ;[107]Is it NEBULA?
MOVEI S2,.SDNEB ;[107]Yes, set debugging system PID
SKIPN S2 ;Anything special set?
$RET ;No, just return
MOVEM S2,MTLBLK+1 ;Set for debugging system pid
SPID.1: MOVX S1,.MUSSP ;FUNCTION IS SET SYSTEM PID TABLE
MOVEM S1,MTLBLK+0 ;STORE IT
DMOVE S1,[EXP 3,MTLBLK] ;3 WORD MUTIL BLOCK
MUTIL ;ASK SYSTEM TO SET THE PID UP
$FATAL <Can't write System PID table>
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
TOPS10 <
SKIPE DEBUGW ;DEBUGGING?
$RETT ;YES -- DON'T TELL THE MONITOR
;NO -- SET PID IN SYSTEM TABLE
MOVEM S1,PACKET+.IPCS1 ;STORE FIRST WORD , THE INDEX
MOVEM S2,PACKET+.IPCS2 ;STORE PID TO SET
MOVE S1,[XWD SPID,.IPCWP] ;FUNCTION IS SET SYSTEM PID
MOVX S2,SP.IPC ;WANT TO SEND TO IPCC
PUSHJ P,SNDSYS ;SEND TO [SYSTEM]IPCC
JUMPT .POPJ ;RETURN ALL OK IF WE ARE IN GOOD SHAPE
$FATAL <Can't write System PID table>
> ;END TOPS10 CONDITIONAL
SUBTTL RSPIDS Routine to read System Pid tables
;RSPIDS is called from initialization to set up our internal System
;pid table. It requests all system pids from the monitor or from
;INFO if the pid has a name. If a Pid exists, it's entry in PIDTAB
;will be non-zero.
;RSPIDS is usually called only during intialization. It gets a PID for us,
;reads all the PIDS, then destroys the PID
;For hacking around, the ALTNAM table can be twiddled, and
;a debugger can do PUSHJ P,RSPIDS to set up some different PIDs
;CALL No Arguments
;TRUE RETURN PIDTAB Contains all valid system pids
RSPIDS: $SAVE <P1> ;PRESERVE P1
MOVE S1,[XWD PIDTAB,PIDTAB+1] ;Make BLT pointer
SETZM PIDTAB ;To clear all the PIDs
BLT S1,PIDTAB+MX.PID ;Clear it
TOPS20< SETZ S2, ;Indicate no name desired
PUSHJ P,SETNAM ;Set up our name
SETZ S1, ;Indicate No JWP desired
PUSHJ P,GETPID ;Get us a temporary PID
>;End TOPS20
TOPS10< MOVX S2,SP.INF ;GET SYSINF INDEX
PUSHJ P,RSPI.1 ;Find and save that one
PJOB S1, ;-10, just use job # as PID
>;End TOPS10
PUSH P,MYPID ;Save whatever is there now
MOVEM S1,MYPID ;Save as ours, for now
MOVSI P1,-SZ.PID ;DO ALL ENTRIES
RSPD.1: HRRZ S1,P1 ;LOAD THE INDEX
PUSHJ P,RSPID ;GET THE PID
JUMPF [CAIE S1,ERARG$ ;INVALID INDEX?
TDZA S1,S1 ;NO -- MUST BE NO SUCH PID
SETO S1, ;YES -- MARK INVALID ENTRY
JRST .+1] ;RETURN IN LINE
MOVEM S1,PIDTAB(P1) ;STORE THE ENTRY
RSPD.2: AOBJN P1,RSPD.1 ;LOOP THRU ALL ENTRIES
TOPS20< MOVE S1,MYPID ;Get our temporary PID
PUSHJ P,KILPID ;Flush it out
>;End TOPS20
POP P,MYPID ;Put back the old one
$RETT ;AND RETURN
SUBTTL RSPID Routine to return a system pid
;RSPID is called to return system PID when sending by special index.
;If the Pid is not found in our internal table, we request the Pid
;from the monitor (or from INFO if we are debugging and the System
;index has a name.)
;The PID is obtained from the system table unless
; 1) - the DEBUGW is set and DB.IPC is not
; and ALTNAM(index) contains an address of a string
;or
; 2) - the DEBUGW is set and DB.IPC is not
; and ALTNAM(index) = 0 (no fooling around), and SPDNAM has a SIXBIT
; library convention debug name.
;Under normal debug, ALTNAM is 0.
;To fool around, put a -1 in an entry to talk to system component, or
; put the address of a string which is the name of the PID you want to talk to.
;CALL IS: S1/ Index into System PID table
;
;TRUE RETURN: S1/ PID for that index
;FALSE RETURN: ERARG$ Invalid index
; ERNSP$ No Such Pid
RSPID: CAIL S1,0 ;INDEX VALID?
CAIL S1,SZ.PID
$RETE(ARG) ;NO -- FAIL
MOVE S2,S1 ;GET THE INDEX
SKIPE S1,PIDTAB(S2) ;IS ENTRY IN OUR INTERNAL TABLE?
$RETT ;YES -- RETURN
$SAVE <P1> ;Save an AC
MOVE P1,S2 ;Keep the index around
SKIPN S1,DEBUGW ;Are we debugging?
JRST RSPI.1 ;No, never use names
TXNN S1,DB.IPC ;Debugging IPCF?
JRST RSPI.0 ;No, go to use names
SETZ S1, ;Clear S1
CAIN S2,.SPQSR ;Is it QUASAR?
MOVEI S1,.SDQSR ;Yes, set debugging system PID
CAIN S2,.SPOPR ;Is it ORION?
MOVEI S1,.SDOPR ;Yes, set debugging system PID
CAIN S2,.SPNEB ;[107]Is it NEBULA?
MOVEI S1,.SDNEB ;[107]Yes, set debugging system PID
SKIPN S1 ;Anything special set?
JRST RSPI.0 ;No, go use names
MOVE S2,S1 ;Move the new index to the right place
$CALL RSYPD ;Go try to read the pid
JUMPT RSPI.4 ;Win, go finish
MOVE S2,P1 ;Lose, restore the original index
;RSPIDS is continued on the next page
;RSPIDS continued from previous page
RSPI.0: SKIPGE S1,ALTNAM(S2) ;Force use of system for component?
JRST RSPI.1 ;Yes, go thru system table
JUMPN S1,RSPI.3 ;If an addr was in there, use that name
SKIPE S1,SPDNAM(S2) ;0 in ALTNAM, is there a library entry?
JRST RSPI.3 ;Yes, use library convention
;Here to get PID from system table
RSPI.1:
TOPS10< MOVEI S1,.GTSID ;NO -- ASK THE MONITOR
HRL S1,S2 ;LOAD THE INDEX
GETTAB S1, ;GET THE ENTRY
$RETE(ARG) ;INVALID INDEX
SKIPN S1 ;ANY VALUE?
$RETE(NSP) ;NO -- RETURN NO SUCH PID
JRST RSPI.4 ;STORE THE PID
> ;END TOPS10 CONDITIONAL
TOPS20< $CALL RSYPD ;Go try to read pid
JUMPT RSPI.4 ;Win, go finish up
CAXE S1,IPCF27 ;NO SUCH PID?
$RETE(ARG) ;NO -- ASSUME INVALID INDEX
$RETE(NSP) ;YES -- RETURN THE ERROR
> ;END TOPS20 CONDITIONAL
;Here to find a system component thru INFO
;Enter with S1/addr of ASCIZ name (LH of S1 = 0)
; or S1/SIXBIT debug name (LH of S1 .NE. 0)
; S2/ special system index
RSPI.3: MOVEI S2,NAMTXT ;Assume library convention
TLNN S1,-1 ;Is S1 SIXBIT?
MOVEI S2,[ITEXT (<^T/(S1)/>)] ;No, use different arg
PUSHJ P,FNDNAM ;ASK INFO FOR THE PID
MOVE S2,P1 ;RESTORE THE INDEX
JUMPF .POPJ ;RETURN ERROR FROM FNDNAM
RSPI.4: MOVEM S1,PIDTAB(S2) ;STORE THE PID
$RETT
SUBTTL RSYPD - Perform actual system pid read
; Call is: S2 / PID index
; Returns: True if found, S1 / PID
; S2 / Index
; False if error, S1 / error code
; S2 / Index
RSYPD: MOVX S1,.MURSP ;READ SYSTEM PID FUNCTION
MOVEM S1,MTLBLK+0 ;SET FUNCTION
MOVEM S2,MTLBLK+1 ;SET INDEX
DMOVE S1,[EXP 3,MTLBLK] ;POINT TO ARGUMENTS
MUTIL ;AND ASK THE MONITOR
JRST [MOVE S2,MTLBLK+1 ;Not found, restore the index
$RETF] ;Quit
MOVE S1,MTLBLK+2 ;Get the pid
MOVE S2,MTLBLK+1 ;Restore the index
$RETT
SUBTTL C%MAXP - Read maximum short packet size
;CALL IS: No arguments
;
;TRUE RETURN: S1/ Largest size of short IPCF message
TOPS10 <
C%MAXP: MOVX S1,%IPCML ;ASK MONITOR FOR IT
GETTAB S1, ;
MOVEI S1,-1 ;WILL TAKE "TOO LARGE" FAILURE
$RETT ;RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
C%MAXP: MOVX S1,.MUMPS ;ASK MONITOR FOR
MOVEM S1,MTLBLK ;LARGEST PACKET SIZE
DMOVE S1,[EXP 2,MTLBLK] ;ARG COUNT AND ADDRESS
MUTIL ;
TROA S1,-1 ;LOAD LARGE NUMBER
MOVE S1,MTLBLK+1 ;GET SIZE OF PACKET
$RETT ;AND RETURN IT
> ;END TOPS20 CONDITIONAL
SUBTTL CPIDI - Connect PID to specified interrupt channel
;This routine connects the PID acquired
;to the specified interrupt channel.
;CALL IS: S1/ Channel to connect PID to
; S2 / PID to connect
; TOPS10, IIB is used to setup internal intrpt connection
;TRUE RETURN: Always
CPIDI:
TOPS20 <
MOVEM S1,MTLBLK+2 ;STORE CHANNEL
MOVX S1,.MUPIC ;FUNCTION IS CONNECT TO PSI
MOVEM S1,MTLBLK+0 ;SO STORE FUNCTION
MOVEM S2,MTLBLK+1 ;Save PID to connect
DMOVE S1,[EXP 3,MTLBLK] ;SIZE AND LOC OF MUTIL BLOCK
MUTIL ;DO THE ACTUAL EXEC FUNCTION
$STOP(IIF,IPCF to interrupt system connect failed)
MOVX S2,1B0 ;GET A BIT IN PLACE 0
MOVN S1,MTLBLK+2 ;GET CHANNEL NUMBER BACK
LSH S2,0(S1) ;PUT INTO PROPER PLACE
MOVX S1,.FHSLF ;FOR MYSELF
AIC ;ACTIVATE THE CHANNEL
ERJMP [$STOP(AII,Cannot activate IPCF interrupts)]
$RETT
> ;END TOPS20 CONDITIONAL
TOPS10 <
HRLZM S1,MTLBLK+1 ;STORE OFFSET,,0
PUSH P,S1 ;Save offset
MOVX S1,.PCIPC ;REASON IS IPCF RECEPTION
MOVEM S1,MTLBLK+0 ;STORE IT
SETZM MTLBLK+2 ;CLEAR PRIORITY LEVEL
MOVE S1,[PS.FAC+MTLBLK] ;ADD THE CONDITION
PISYS. S1, ;ADD IT
$STOP(IIF,IPCF to interrupt system connect failed)
LOAD S1,IIB+IB.INT ;ADDRESS OF INTERRUPT VECTOR
POP P,S2 ;GET VECTOR OFFSET FOR IPCF
ADDI S1,.PSVIS(S2) ;GET ADDRESS OF ASSOCIATED VARIABLE
MOVEM S1,IPCINT ;SAVE ADDRESS FOR C%INTR
$RETT ;RETURN
> ;END TOPS10 CONDITIONAL
SUBTTL IPRM Read/Write IPCF parameters
;CALL IS: S1 / -1 TO WRITE, 0 TO READ PARAMETERS
; S2 / PARAMETERS TO WRITE (IF S1=-1)
;
;TRUE RETURN: S1 / <MAX PIDS>B17+<SND QUOTA>B26+<RCV QUOTA>B35 ;IF S1=0
IPRM: PUSHJ P,.SAVE1 ;GET ONE AC
MOVE P1,S2 ;REMEMBER 2ND ARG
JUMPE S1,IPRM.2 ;IF READING, SKIP THIS
HLRZ S1,S2 ;GET THE PID MAX WANTED
JUMPE S1,IPRM.1 ;IF DEFAULTED, SKIP THIS
PUSHJ P,MNPRED ;GET THE CURRENT MAXIMUM
HLRZ S2,P1 ;GET THE REQUESTED NUMBER
ADD S1,S2 ;ADD TO CURRENT AMOUNT
CAIL S1,1000 ;MAXIMUM IN RANGE
MOVEI S1,777 ;NO..SET TO MAXIMUM
PUSHJ P,MNPWRT ;WRITE MAXIMUM NUMBER OF PIDS
SKIPT ;OK?
$FATAL <IPCF privileges required to set maximum number of pids>
IPRM.1: HRRZ S1,P1 ;GET THE QUOTAS
JUMPE S1,.RETT ;IF DEFAULTING, LEAVE IT ALONE
TOPS20< PUSHJ P,QTARED ;READ THE CURRENT SETTINGS
LOAD S2,S1,IP.SQT ;GET THE SEND QUOTAS
LOAD S1,P1,IP.SQT ;GET CURRENT SETTING REQUEST
ADD S1,S2 ;GET NEW SEND QUOTAS
> ;END OF TOPS20 CONDITIONAL
TOPS10< LOAD S1,P1,IP.SQT > ;GET THE QUOTAS
CAIL S1,1000 ;MAXIMUM IN RANGE
MOVEI S1,777 ;NO..SET TO MAXIMUM
STORE S1,P1,IP.SQT ;SAVE THE VALUES
HRRZ S1,P1 ;GET THE QUOTAS AGAIN
PUSHJ P,QTAWRT ;WRITE QUOTAS OUT
JUMPT .RETT ;IF ALL OK, RETURN NOW
$FATAL <IPCF privileges required to set IPCF quotas>
IPRM.2: PUSHJ P,MNPRED ;READ MAXIMUM NUMBER OF PIDS
MOVE P1,S1 ;REMEMBER THE ANSWER
PUSHJ P,QTARED ;AND THE QUOTA'S
SKIPT ;DID WE GET IT?
$FATAL <Can't read IPCF quotas>
HRLM P1,S1 ;MAKE UP THE TWO HALVES
$RETT ;AND RETURN
SUBTTL MNPRED/MNPWRT - Read/Write maximum number of PIDS
;THESE ROUTINES DO THE SYSTEM DEPENDENT WORK FOR SETTING THE MAXIMUM
;NUMBER OF PIDS FOR A JOB.
;
; CALL IS: READ/NO ARGUMENTS WRITE/S1 MAXIMUM NUMBER OF PIDS
;TRUE RETURN: READ/S1 MAX NR. OF PIDS WRITE/NO RETURNED VALUE
;FALSE RETURN: FAILURE OF SOME SORT
TOPS20 <
MNPWRT: SKIPA S2,[.MUSPQ] ;SET MAX. NUMBER OF PIDS
MNPRED: MOVX S2,.MUFPQ ;READ MAX. NUMBER OF PIDS
MOVEM S2,MTLBLK ;SET IT UP
MOVEM S1,MTLBLK+2 ;STORE THE DESIRED NUMBER (FOR WRITE)
MOVE S1,MYPID ;GET OUR PID
MOVEM S1,MTLBLK+1 ;SET IT UP
DMOVE S1,[EXP 3,MTLBLK] ;3 WORD BLOCK @ MTLBLK
MUTIL ;ASK THE MONITOR
$RETF ;FAILURE
MOVE S1,MTLBLK+2 ;PICK UP MAX NUMBER OF PIDS
$RETT ;SUCCESS
> ;END TOPS20 CONDITIONAL
TOPS10 <
MNPRED: MOVX S1,777 ;LARGE NUMBER OF PIDS AVAILABLE
MNPWRT: $RETT ;RETURN WITH IT
> ;END TOPS10 CONDITIONAL
SUBTTL QTARED/QTAWRT - Read/Write the Send and Receive Quotas
;CALL IS: S1/ 0,,<SND QUOTA>B26+<RCV QUOTA>B35 IF WRITING
;TRUE RETURN: S1/ 0,,<SND QUOTA>B26+<RCV QUOTA>B35 IF READING
;FALSE RETURN: ON ANY FAILURE OF TASK
TOPS20 <
QTARED: SKIPA S2,[EXP .MUFSQ] ;READ THE QUOTA FOR SEND/RECEIVE
QTAWRT: MOVX S2,.MUSSQ ;SET QUOTA
MOVEM S2,MTLBLK ;SET IT UP
MOVEM S1,MTLBLK+2 ;STORE THE DESIRED QUOTA (FOR WRITE)
MOVE S1,MYPID ;GET OUR PID
MOVEM S1,MTLBLK+1 ;SET IT UP
DMOVE S1,[EXP 3,MTLBLK] ;SET UP 3 WORD MUTIL BLOCK
MUTIL ;ASK THE MONITOR
$RETF ;FAILURE
MOVE S1,MTLBLK+2 ;PICK UP SEND/RECEIVE QUOTA
$RETT ;SUCCESS
> ;END TOPS20 CONDITIONAL
TOPS10 <
QTARED: SKIPA S2,[EXP .IPCSR] ;READ QUOTAS
QTAWRT: MOVX S2,.IPCSQ ;WRITE QUOTAS
HRLI S2,QTAWRT ;A GOOD CODE TO USE
MOVEM S1,PACKET+.IPCS2 ;STORE QUOTA FOR WRITE
MOVE S1,MYPID ;GET OUR PID
MOVEM S1,PACKET+.IPCS1 ;STORE IT AWAY
MOVX S1,SP.IPC ;SEND TO IPCC
EXCH S1,S2 ;WHOOPS, BUILT IT BACKWARDS
PUSHJ P,SNDSYS ;SEND IT OFF
MOVE S1,PACKET+.IPCS2 ;GET RESPONSE
POPJ P, ;PASS ON SNDSYS'S TF VALUE
> ;END TOPS10 CONDITIONAL
SUBTTL SETNAM - Routine to declare our name to INFO
;SETNAM is used to setup the name in the packet about to go to INFO or IPCC
;This allows programs to communicate
; by other means than the system PID table. This is useful for debugging
; purposes when multiple components are going to be used.
;SETNAM should always be called just before calling GETPID
;CALL: S2/ Addr of ITEXT of name to write
; or 0, to set up no name
;
;TRUE RETURN: Always, name has been established
; 2 nd word of PACKET has 0 or name,
; STACP has incremented pointer
SETNAM: SETZM PACKET+.IPCI2 ;Clear name from message
PUSH P,[POINT 7,PACKET+.IPCI2] ;GET POINTER TO MESSAGE AREA
POP P,STACP ;STORE THAT POINTER
JUMPE S2,.RETT ;If no name desired, we're done
$TEXT(STAC,<^I/(S2)/^0>) ;CREATE THE NAME
$RETT ;RETURN SUCCESS
;FNDNAM is used to ask INFO for the pid of a specified name
; It is called by GETPID to look for our name and by RSPIDX
; to check for Private Quasar and Private Orion
;CALL: S2/ addr of ITEXT to build name
;TRUE RETURN: S1/ Pid of Specified Name
FNDNAM: PUSHJ P,SETNAM ;Set up name in message
MOVE S1,[XWD FNDNAM,.IPCIW] ;FUNCTION IS FIND PID FOR NAME
MOVX S2,SP.INF ;COMMUNICATE WITH [SYSTEM]INFO
PUSHJ P,SNDSYS ;SEND TO SYSTEM, WAIT FOR REPLY
JUMPF [$RETE(NSP)] ;RETURN NO SUCH PID
MOVE S1,PACKET+.IPCI1 ;GET THE PID
SKIPE DEBUGW ;DEBUGGING ?
$WARN <Alternate ^T20/PACKET+.IPCI2/ (PID = ^O/S1/)> ;SHOW THE NAME
$RETT ;RETURN SUCCESS
SUBTTL SNDSYS - Routine to converse with [SYSTEM]INFO & IPCC
;SNDSYS is used to carry on a SEND-RECEIVE dialog with the system
; IPCF facilities
;CALL IS: S1/ CODE WORD TO USE, I.E. ID,,FUNCTION CODE
; S2/ CANONICAL SYSTEM INDEX TO SEND TO, EITHER SP.IPC OR SP.INF
;
;TRUE RETURN: If acknowledgement comes back successfully
;
;FALSE RETURN: If for any reason we cannot sent, or the
; response contains an error.
SNDSYS: $SAVE <P1,P2,SNDFLG,RCVMDB+MDB.MS> ;PRESERVE WHAT WE TOUCH
DMOVE P1,S1 ;SAVE INPUT ARGUMENTS
SETOM QUELOK ;LOCK THE INTERNAL IPCF QUEUE
MOVEM S1,PACKET+.IPCI0 ;STORE THE CODE WORD AWAY
CAXN P2,SP.INF ;IF SENDING TO INFO,
ZERO PACKET+.IPCI1 ;NO ONE IS TO BE COPIED
MOVEI S1,PACKET ;GET LOCATION OF PACKET
MOVEM S1,SNDSAB+SAB.MS ;STORE MESSAGE LOCATION
TOPS10< CAXN P2,SP.IPC ;SENDING TO IPCC?
SKIPA S1,[EXP PACKET+2] ;YES -- FORCE PACKET LENGTH TO 3
;NO -- COMPUTE PACKET LENGTH
> ;END TOPS10 CONDITIONAL
TOPS20< SKIPN MYPID ;DO WE HAVE A PID?
$STOP (SWP,Called SNDSYS without a PID) ;Something has gone wrong
> ;END TOPS20 CONDITIONAL
SNDS.1: HRRZ S1,STACP ;HERE TO SEND TO INFO
CAXN P2,SP.INF ;SENDING TO SYSTEM INFO ???
SKIPE PIDTAB+SP.INF ;IS SYSTEM INFO RUNNING ???
SKIPA ;SEND TO [IPCC] OR SYSINF RUNNING,,SKIP
$FATAL (<No IPCF privs or SYSINF is not running>)
SUBI S1,PACKET-1 ;COMPUTE SIZE
MOVEM S1,SNDSAB+SAB.LN ;STORE AS MESSAGE LENGTH
SKIPN S1,PIDTAB(P2) ;GET PROPER SYSTEM PID
$FATAL <Attempt to send to non-existant system component>
MOVEM S1,SNDSAB+SAB.PD ;SEND IS BY PID
ZERO SNDSAB+SAB.SI ;NOT BY INDEX
;SNDSYS CONTINUED ON NEXT PAGE
;SNDSYS CONTINUED FROM PREVIOUS PAGE
MOVEI S1,SAB.SZ ;SIZE OF SAB
MOVEI S2,SNDSAB ;AND ITS LOCATION
PUSHJ P,C%SEND ;SEND IT OFF
SKIPF ;SKIP IF FAILED !!!
SNDS.2: PUSHJ P,C%BRCV ;DO A WAITING RECEIVE NOW
JUMPF [SETZM QUELOK ;FAILED,,CLEAR IPCF QUEUE LOCK
$RETF ] ;AND RETURN
MOVE S1,RCVMDB+MDB.SI ;GET SPECIAL INDEX WORD
TXNN S1,SI.FLG ;FROM A 'SPECIAL' PID ???
JRST SNDS.3 ;NO,,TRY ANOTHER MESSAGE
LOAD S1,S1,SI.IDX ;GET THE SPECIAL PID INDEX
CAME S1,P2 ;REPLY FROM DESTINATION?
JRST SNDS.3 ;NO, TRY AGAIN
MOVE S1,PACKET+.IPCI0 ;GET CODE WORD
CAME S1,P1 ;DOES IT MATCH WHAT WE SENT?
JRST SNDS.3 ;NO
SETZM QUELOK ;CLEAR THE IPCF QUEUE LOCK
LOAD S1,RCVMDB+MDB.FG,IP.CFE ;DID WE GET ANY ERRORS?
JUMPN S1,.RETF ;IF WE DID, GIVE UP NOW
$RETT ;OTHERWISE, RETURN A GOOD RETURN
SNDS.3: SKIPN S1,IPCQUE ;GET THE IPCF QUEUE ID
PUSHJ P,[PUSHJ P,L%CLST ;NONE,,CREATE A LIST FOR IT
MOVEM S1,IPCQUE ;SAVE THE ID
POPJ P, ] ;AND CONTINUE
PUSHJ P,L%LAST ;POSITION TO THE LAST ENTRY
MOVE S1,IPCQUE ;GET THE ID AGAIN,,LIST MAY BE NULL
MOVX S2,MDB.SZ ;GET THE MDB LENGTH
PUSHJ P,L%CENT ;CREATE AN ENTRY AT THE END
MOVE S1,S2 ;GET THE ENTRY ADDRESS
HRLI S1,RCVMDB ;GET THE SOURCE ADDRESS
BLT S1,MDB.SZ-1(S2) ;COPY THE MDB TO THE IPCF QUEUE
LOAD S1,RCVMDB+MDB.MS,MD.CNT ;GET THE MESSAGE LENGTH
CAXN S1,PAGSIZ ;IS IT A PAGE ???
JRST SNDS.2 ;YES,,LETS TRY AGAIN (PAGE IS SAVED)
PUSH P,S2 ;SAVE THE MDB ADDRESS
PUSHJ P,M%GMEM ;NO,,GET A CHUNK TO SAVE IT IN
EXCH S1,0(P) ;GET MDB ADDRESS,,SAVE PACKET LENGTH
STORE S2,MDB.MS(S1),MD.ADR ;SAVE THE NEW PACKET ADDRESS
POP P,S1 ;RESTORE THE PACKET LENGTH
ADD S1,S2 ;CALC CHUNK END ADDRESS
HRLI S2,PACKET ;GET THE PACKET ADDRESS
BLT S2,-1(S1) ;SAVE THE PACKET AS WELL
SETOM MSGFLG ;INDICATE ANOTHER MSG POSSIBLE !!
JRST SNDS.2 ;AND GET THE NEXT MESSAGE
SUBTTL STAC - Routine to build INFO messages
; STAC IS USED IN THE $TEXT INSTRUCTION TO DEPOSIT CHARACTERS INTO
; THE MESSAGE THAT IS SENT TO SYSTEM-INFO
STAC: HRRZ TF,STACP ;GET THE BYTE POINTER ADDRESS PART
SUBI TF,PACKET ;SUBTRACT OFF START OF PACKET
CAIL TF,SZ.PAK ;STILL INSIDE PACKET?
$RETF ;NO, FORCE A STOP
IDPB S1,STACP ;STORE A BYTE
$RETT ;OTHERWISE, RETURN GOODLY
SUBTTL SIXASC Store sixbit word in S2 as an asciz string
;Accepts S1/ Pointer to destination
; S2/ Sixbit value
SIXASC: $SAVE <P1,P2>
TLC S1,777777 ;FIX DESTINATION POINTER
TLCN S1,777777
HRLI S1,(POINT 7)
MOVE P1,[POINT 6,S2] ;GET POINTER TO THE WORD
MOVEI P2,6 ;STORE SIX CHARACTERS
SIXAS1: ILDB TF,P1 ;STORE THE TEXT
ADDI TF," "
IDPB TF,S1
SOJG P2,SIXAS1
MOVE TF,S1
IDPB P2,TF ;TERMINATE WITH A NULL
$RETT
SUBTTL C%PIDJ Return PID owners job number
;CALL IS: S1/ PID
;
;TRUE RETURN S1/ Job number of PID's owner
TOPS20 <
C%PIDJ: MOVEM S1,MTLBLK+1 ;USE MUTIL TO FIND JOB ASSOCIATED
MOVX S1,.MUFOJ ;WITH THIS PID
MOVEM S1,MTLBLK ;
DMOVE S1,[EXP 3,MTLBLK] ;ARG COUNT AND ADDRESS
MUTIL
$RETF ;CAN'T GET JOB NUMBER OF PID
MOVE S1,MTLBLK+2 ;GET THE JOB NUMBER
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
TOPS10 <
C%PIDJ: MOVX S2,%IPCPM ;GET SYSTEM PID MASK
GETTAB S2, ;FROM MONITOR
$RETF ;CAN'T GET PID MASK
AND S1,S2 ;AND TO GET PID TABLE OFFSET
MOVSS S1 ;REVERSE TO GET GETTAB INDEX
HRRI S1,.GTPID ;AND NOW LOOK INTO PID TABLE
GETTAB S1, ;TO GET THE JOB NUMBER
$RETF ;CAN'T GET JOB NUMBER OF PID
AND S1,S2 ;STRIP ALL BUT JOB NUMBER
JUMPE S1,.RETF ;NO OWNER
$RETT ;RETURN THE JOB
> ;END TOPS10 CONDITIONAL
IPC%L: ;LABEL THE LITERAL POOL
END