Trailing-Edge
-
PDP-10 Archives
-
BB-JR93N-BB_1990
-
10,7/mon/ipcser.mac
There are 12 other files named ipcser.mac in the archive. Click here to see a list.
TITLE IPCSER -- INTER PROCESS COMMUNICATION FACILITY V374
SUBTTL J. SAUTER/T. WACHS/LSS/CDO/JMF/DPM 26-SEP-89
SEARCH F,S,DEVPRM
$RELOC
$HIGH
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988,1990.
;ALL RIGHTS RESERVED.
.CPYRT<1973,1990>
XP VIPCSR,374 ;VERSION NUMBER FOR GLOB AND MAP
ENTRY IPCSER ;LOAD THIS MODULE IF REQUESTED
IPCSER::
;IPCSER PROVIDES A FACILITY WHICH PERMITS TWO JOBS TO EFFICIENTLY
; EXCHANGE LIMITED AMOUNTS OF DATA. THE MONITOR MAY ALSO PARTICIPATE
; IN THIS EXCHANGE BY MEANS OF "EXEC PSEUDO-PROCESSES".
;DATA STRUCTURES:
;EXECUTIVE PROCESS CONTROL BLOCK
.ORG 0
;NOTE THAT .EPIPC,.EPIPA, .EPIPQ MUST REMAIN IN THIS ORDER
; (SAME ORDER AS .PDIPC, .PDIPA, .PDIPQ, .PDIPL, .PDPID, .PDIPI, .PDIPN)
.EPIPC:! BLOCK 1 ;LH=POINTER TO OLDEST PACKET
;18-26 = PACKETS SENT & NOT RECEIVED
;27-35 = PACKETS WAITING TO BE REC.
.EPIPA:! BLOCK 1 ;LH = COUNT OF SENDS SINCE LOGIN
;RH = COUNT OF RECEIVES SINCE LOGIN
.EPIPQ:! BLOCK 1 ;FLAGS AND QUOTAS
IP.DSB==(1B0) ;RECEIVER IS DISABLED
IP.HBS==(1B1) ;QUOTAS HAVE BEEN SET
IP.DPR==(1B2) ;AT LEAST 1 PID FOR JOB IS TO BE DROPPED ON RESET
IP.DPL==(1B3) ;AT LEAST 1 PID TO BE DROPPED ON LOGOUT
IP.LOK==(1B4) ;QUEUE IS INTERLOCKED
;9-17 = PID QUOTA
;18-26 = SEND QUOTA
;27-35 = RECEIVE QUOTA
IP.SBT==1000 ;1ST BIT IN SEND QUOTA/COUNT BYTE
IP.CTX==:IP.HBS+IP.DPL+777 ;FLAGS TO PRESERVE ON CONTEXT CHANGES (SEE CTXSER)
.EPIPL:! BLOCK 1 ;IPCF QUEUE INTERLOCK WORD
;LH = JCH WHOSE QUEUE IS INTERLOCKED
;RH = JCH WHO INTERLOCKED OUR QUEUE
.EPPID:! BLOCK 1 ;PID FOR PID SPECIFIC RECEIVES
.EPIPI:! BLOCK 1 ;PID OF THIS JOB'S SYS:INFO
.EPIPN:! BLOCK 1 ;LH=POINTER TO LAST IN QUEUE
.EPQSN:! BLOCK 1 ;SEQUENCE NUMBERS
.EPEPA:! BLOCK 1 ;EXEC PSEUDO-PROCESS PACKET ADDRESS
.EPADR:!BLOCK 1 ;PUSHJ @ HERE WHEN A PACKET ARRIVES
; FOR THIS PROCESS.
.ORG
;DEFINITION OF PACKET DESCRIPTOR BLOCK
.ORG 0
.IPCFL::!BLOCK 1 ;LINK AND FLAGS
IP.CFB==(1B0) ;UUO BLOCK: DONT BLOCK READ UUO
IP.IAS==(1B1) ;UUO BLOCK: INDIRECT ADDRESS FOR SENDER'S PID
IP.IAR==(1B2) ;UUO BLOCK: INDIRECT ADDRESS FOR RECEIVER'S PID
;IN PACKET, LH = POINTER TO NEXT
IP.LPC==(1B3) ;UUO BLOCK: "LAST PHONE CALL" - SEND EVEN THO QUOTA
; IS OVERDRAWN (ONLY ALLOWS OVERDRAW OF 1)
IP.TTL==(1B4) ;UUO BLOCK-TRUNCATE PACKET IF TOO LONG
IP.LPK==(1B5) ;PACKET IS LONGER THAN MAX SYSTEM SIZE (PRIVID)
IP.RFP==(1B6) ;RECEIVE FOR A PARTICULAR PID
IP.SIP==1B18 ;SENDER IS PRIVILEGED
IP.CFV==1B19 ;VM PAGE MODE
IP.CFZ==1B20 ;DATA LENGTH=0
IP.AKR==1B21 ;SENDER REQUESTS ACKNOWLEGEMENT FROM RECEIVER
IP.CFE==77B29 ;(UNPRIV) ERROR RETURN
IP.CFM==77B35 ;SPECIAL MESSAGE FIELD (SENDER CODE+FLAGS)
IP.CMN==7B35 ;JUST THE FLAGS FROM THE SPECIAL MESSAGE FIELD
.IPCMN==1 ;MESSAGE 1: MESSAGE WAS UNDELIVERABLE
.IPCFS::!BLOCK 1 ;SENDER'S PID
.IPCFR::!BLOCK 1 ;RECEIVER'S PID
.IPCFP::! ;LH = LENGTH OF PACKET'S DATA
;IN UUO BLOCK, RH=USER'S PACKET BUFFER
.IPCFI::!BLOCK 1 ;IN PACKET, THE FOLLOWING FIELDS APPLY:
IP.DSK==:1B0 ;DISK ADDRESS
IP.FRE==1B1 ;**FREE**
IP.LEN==1777B12 ;LENGTH OF DATA (PACKET ONLY!)
IP.SLN==:^D10 ;SIZE OF LENGTH FIELD
IP.PLN==:^D12 ;POSITION
IP.OIQ==PM.OIQ
IP.SSP==PM.SSP
IP.ADR==PM.ADR ;ADDRESS
IP.NAD==PM.NAD ;NOT ADDRESS
IP.SAD==PM.SAD ;SIZE OF ADDRESS FIELD
.IPCFM::!BLOCK 0 ;MINIMUM LENGTH OF DESCRIPTOR BLOCK
.IPCFU::!BLOCK 1 ;SENDER'S PPN. FILLED IN BY MONITOR ON SEND
;UUO NEVER FILLED IN BY USER.
.IPCFC::!BLOCK 1 ;SENDER'S CAPABILITIES WORD. FILLED IN SAME
;FASHION AS .IPCFU.
IP.JAC==(1B0) ;SENDER HAS JACCT ON
IP.JLG==(1B1) ;SENDER IS LOGGED-IN
IP.SXO==(1B2) ;SENDER IS EXECUTE-ONLY
IP.POK==(1B3) ;SENDER CAN POKE THE MONITOR
IP.IPC==(1B4) ;SEND HAS IPCF PRIVS
;BITS 18:26 = CTX # OF SENDER
;BITS 27:35 = JOB # OF SENDER
.IPCFD::!BLOCK 0 ;IN PACKET ONLY, START OF DATA.
.ORG
; IPCFM. DEFINITIONS
;FLAGS WORD
IP.CMP==(1B0) ;PRIVILEGED PACKET
IP.CMI==(1B1) ;INIDIRECT SENDER ADDRESS
IP.CMD==(7B17) ;DESTINATION SPECIAL PROCESS NUMBER (1=IPCC,2=INFO,3=LOCAL-INFO)
IP.CML==0,,-1 ;LENGTH OF BLOCK
IP.CMX==<(-1B17)>-<IP.CMD!IP.CMI!IP.CMP> ;RESERVED (FREE) BITS
; COMMONLY-USED BYTE POINTERS
TRNPTR: POINT 9,.IPCFC(P1),35
TRNPT2: POINT 9,.IPCFC(P2),35
PKLNP2: POINT IP.SLN,.IPCFI(P2),IP.PLN
PKLNP1: POINT IP.SLN,.IPCFI(P1),IP.PLN
PKLNT1: POINT IP.SLN,.IPCFI(T1),IP.PLN
PKLNT2::POINT IP.SLN,.IPCFI(T2),IP.PLN
PKADT1: POINT IP.SAD,.IPCFI(T1),^L<IP.ADR>+IP.SAD-1
PKADP1: POINT IP.SAD,.IPCFI(P1),^L<IP.ADR>+IP.SAD-1
PQTAPT: POINT 9,.EPIPQ(W),17
RCCNT: POINT 9,.EPIPC(W),35
RCQTA: POINT 9,.EPIPQ(W),35
RTNERR: POINT 6,.IPCFL(P1),29
RTNER2: POINT 6,.IPCFL(P2),29
DESTP4: POINT 3,P4,17 ;DESTINATION CODE IN IPCFM PROCESSING
; SPOOLED PARAMETER BLOCK DEFINITIONS
SPBPCP==0 ;NUMBER OF COPIES
SPBPFM==1 ;FORMS NAME
SPBPLM==2 ;LIMIT
SPBPSF==3 ;SPOOLING FLAGS
SPBPDA==4 ;DEVICE ATTRIBUTES
SPBPND==5 ;NODE
SPBPAF==6 ;AFTER PARAMETER
SPBNM1==7 ;SIXBIT USER NAME (WORD 1)
SPBNM2==10 ;SIXBIT USER NAME (WORD 2)
SPBACT==:11 ;START OF ACCOUNT STRING
MAXACS==:^D8 ;MAXIMUM LENGTH OF ACCOUNT STRING
;MUST MATCH ONE IN COMMON
SPBMAX==:SPBACT+MAXACS ;TOTAL LENGTH OF SPB
;DESCRIPTION OF SPOOL, LOGIN AND LOGOUT MESSAGES
; ALL MESSAGES FROM IPCC TO QUASAR HAVE A TWO WORD HEADER AS
; DESCRIBED BELOW. THE LOGOUT MESSAGE CONSISTS SOLELY OF THESE
; TWO WORDS, AND THE SPOOL MESSAGE HAS FILE INFORMATION APPENDED,
; THE LOGIN MESSAGE HAS JOB INFORMATION APPENDED.
.ORG 0 ;START AT 0
GALMSG:!BLOCK 1 ;MESSAGE HEADER
; XWD LENGTH,,FUNCTION
GALSTS:!BLOCK 1 ;STATUS WORD
GALBSN==177B8 ;BATCH STREAM NUMBER (IF GALBAT)
GALJOB==777B17 ;BITS 0-17 IS JOB NUMBER
GALLOC==777000 ; 18-26 IS LOCATION
GALFLG==777 ; 27-35 ARE FLAGS
GALBAT==1B27 ;BATCH JOB
GALDFR==1B28 ;DEFERRED SPOOLING
GALBSS==1B29 ;BATCH STREAM NUMBER SET
LGMSIZ==.-GALMSG ;SIZE OF LOGOUT MESSAGE
SCMSIZ==.-GALMSG ;SIZE OF SCHEDULE BITS CHANGE MESSAGE
SPMUSR:!BLOCK 2 ;USER NAME IN 6BIT
SPMIDV:!BLOCK 1 ;INITED DEVICE
SPMSTR:!BLOCK 1 ;STRUCTURE NAME
SPMFIL:!BLOCK 1 ;FILENAME
SPMEFN:!BLOCK 1 ;ENTER'ED FILE NAME (RIBSPL, DEVSPN)
SPMFSZ:!BLOCK 1 ;FILE SIZE IN BLOCKS
SPMEXT:!BLOCK 1 ;SPOOLED FILE EXTENSION
SPMPRM:!BLOCK SPBMAX ;SPACE FOR SPOOLING OPTION BLOCK
SPMSIZ==.-GALMSG ;SIZE OF SPOOL MESSAGE
.ORG
.ORG GALSTS+1
LOMUSR:!BLOCK 2 ;USER NAME IN 6BIT
LOMCTL:!BLOCK 1 ;CONTROLLERS JOB NUMBER
LOMTTY:!BLOCK 1 ;TTY
LOMSIZ==.-GALMSG
.ORG
;ERROR CODES:
IPCAC%==1 ;ADDRESS CHECK (UUO BLOCK OR PACKET BUFFER)
IPCNL%==2 ;NOT LONG ENOUGH (UUO BLOCK)
IPCNP%==3 ;NO PACKET IN LIST (READ UNBLOCKED)
IPCIU%==4 ;(PAGE) IN USE (PART OF VIRTUAL FEATURE)(PAGE IS LOCKED)
IPCTL%==5 ;(PACKET) TOO LONG (FOR USER'S BUFFER)
IPCDU%==6 ;DESTINATION UNKNOWN (SEND)
IPCDD%==7 ;DESTINATION DISABLED (SEND)
IPCRS%==10 ;(NO) ROOM (IN) SENDER'S (QUOTA)
IPCRR%==11 ;(NO) ROOM (IN) RECEIVER'S (QUOTA)
IPCRY%==12 ;(NO) ROOM (IN) SYSTEM (STORAGE)
IPCUP%==:13 ;UNKNOWN PAGE (SEND) EXISTING PAGE (REC)
IPCIS%==14 ;INVALID SEND ADDRESS
IPCPI%==15 ;PRIVILEGES INSUFFICIENT
IPCUF%==16 ;UNKNOWN FUNCTION
IPCBJ%==17 ;BAD JOB NUMBER
IPCPF%==20 ;PIDTAB FULL
IPCPR%==21 ;PAGED PACKET REQUESTED, REGULAR PACKET IN QUEUE OR VICE VERSA(VM)
IPCIE%==:22 ;PAGING IO ERROR (VM)
IPCBI%==23 ;BAD INDEX SPECIFIED FOR SYSTEM PID TABLE
IPCUI%==24 ;UNDEFINED ID IN SYSTEM PID TABLE
IPCRU%==25 ;RECEIVER UNKNOWN
IPCRP%==:26 ;NO PHYSICAL ROOM (FOR A MAP, EG.)
IPCRV%==:27 ;NO VIRTUAL ROOM
IPCCF%==71 ;[SYSTEM]IPCC REQUEST BY [SYSTEM]INFO FAILED
IPCQP%==73 ;PID QUOTA EXCEEDED
;SUBROUTINE TO VALIDATE ARGUMENTS AND FETCH THEM INTO P1-P4.
; SKIP RETURN ON OK, LEAVES ADDR OF ARG IN M.
VALARG: HLRZ T2,T1 ;GET USER'S AC LEFT HALF
CAIGE T2,.IPCFM ;LONG ENOUGH?
JRST ERRNL ;NO.
MOVE P4,T1 ;YES, COPY USER'S AC
HRRI M,.IPCFL(P4) ;FIRST LOCATION OF BLOCK
PUSHJ P,GETWRD## ;FETCH .IPCFL
JRST ERRAC ;ADDRESS CHECK
MOVE P1,T1 ;PUT .IPCFL IN P1
PUSHJ P,GETWR1## ;FETCH SENDER'S PID
JRST ERRAC ;ADDRESS CHECK
TLNN P1,IP.IAS ;IS SENDER'S PID INDIRECTED?
JRST VALAR1 ;NO.
HRR M,T1 ;YES, GET ADDRESS
TLNN T1,-1 ;LH = 0?
PUSHJ P,GETWRD## ;YES, FETCH THAT WORD.
JRST ERRAC ;ADDRESS CHECK
VALAR1: PUSHJ P,CTXJCH## ;CONVERT POSSIBLE JOB # TO JOB/CONTEXT HANDLE
JFCL ;MUST HAVE BEEN A PID
MOVE P2,T1 ;PUT .IPCFS IN P2
HRRI M,.IPCFR(P4) ;THIRD LOCATION OF BLOCK
PUSHJ P,GETWRD## ;FETCH RECEIVER'S PID
JRST ERRAC ;ADDRESS CHECK
TLNN P1,IP.IAR ;IS RECEIVER'S PID INDIRECTED?
JRST VALAR2 ;NO.
HRR M,T1 ;YES, PUT ADDRESS IN M
TLNN T1,-1 ;IS LH = 0?
PUSHJ P,GETWRD## ;YES, GET THE WORD.
JRST ERRAC ;ADDRESS CHECK
VALAR2: PUSHJ P,CTXJCH## ;CONVERT POSSIBLE JOB # TO JOB/CONTEXT HANDLE
JFCL ;MUST HAVE BEEN A PID
MOVE P3,T1 ;GET RECEIVER PID
HRRI M,.IPCFP(P4) ;FOURTH LOCATION OF BLOCK
PUSHJ P,GETWRD## ;FETCH PACKET DESCRIPTOR
JRST ERRAC ;ADDRESS CHECK
HRRI M,.IPCFL(P4) ;POINT BACK TO FRONT OF BLOCK
MOVE P4,T1 ;PUT .IPCFP IN P4
TRNN P1,IP.CFV ;ASKING FOR A PAGE?
JRST VALAR3 ;NO
HLRZ T1,P4 ;YES, EXACTLY 1 PAGE?
TLNE P1,IP.TTL ;TRUNCATE IF TOO LONG?
JUMPE T1,VALAR3 ;YES, LENGTH =0 IS OK
CAIE T1,PAGSIZ
JRST ERRTL ;CANT DO MORE THAN 1 PAGE AT A TIME
HRRZS P4 ;OK, SET LENGTH OF DATA TO 0 (NO DATA WDS IN PACKET)
MOVE T3,J ;COPY JOB/CONTEXT HANDLE
ANDI T3,JOBMSK## ;KEEP ONLY THE JOB NUMBER
MOVSI T1,LOKSEG ;LOCKED BITS
TDNN T1,JBTSTS##(T3) ;LOW SEG LOCKED
TDNE T1,JBTSGN##(T3) ;OR HIGH SEG LOCKED
PJRST ERRIU ;YES, GIVE ERROR
HRLI P4,-1
HRRZI T1,(P4) ;GET PAGE #
PUSHJ P,LGLPG## ;LEGAL?
JRST ERRAC ;NO, ADDRESS CHECK.
JRST VALAR4
VALAR3: HRRZ T1,P4 ;START ADR
PUSHJ P,CHKADR ;CHECK IT
PJRST ERRAC
HLRE T2,P4
JUMPLE T2,[JUMPE T2,VALAR4 ;OK IF NO DATA WORDS
JRST ERRNL]
ADDI T1,-1(T2) ;TOP ADR
PUSHJ P,CHKADR ;CHECK
PJRST ERRAC
VALAR4: MOVE J,.CPJOB## ;GET OUR JOB NUMBER
MOVSI T1,JP.IPC ;NO PRIV BIT DEFINED
TRNN P1,-1-IP.CFE-IP.CFV-IP.AKR ;PRIV'D FUNCTION?
TRNA ;NO, DON'T NEED TO CHECK
PUSHJ P,PRVBIT## ;YES, GOT PRIVS?
AOSA (P) ;EVERYTHING OK
JRST ERRPI ;NO PRIVS FOR PRIV'D FUNCTION
MOVE T1,J ;GET OUR JOB NUMBER
PUSHJ P,CTXIPC## ;AND OUR IPCF DATA BLOCK ADDRESS
STOPCD .,STOP,NIJ, ;++ NO IPCF DATA BASE FOR JOB/CONTEXT
POPJ P, ;RETURN
;SUBROUTINE TO ADDRESS CHECK
CHKADR: PUSH P,T1
PUSH P,M ;SAVE M
HRR M,T1
PUSHJ P,GETWRD##
SOS -2(P)
POP P,M
PJRST TPOPJ1##
;SUBROUTINE TO LOAD J AND W BASED ON PID IN T1.
;RETURNS CPOPJ ON ERROR, ERROR CODE IN T1
;RETURNS CPOPJ1 IF OK
VALPID: JUMPE T1,VALPD4 ;ZERO PID IS INVALID
TLNN T1,-1 ;REAL PID, JOB # OR JOB/CONTEXT HANDLE?
JUMPG T1,VALPD1 ;JOB NO OR JCH
MOVE T2,T1 ;COPY OF PID
AND T2,%IPCPM## ;MASK TO INDEX
CAMGE T2,%IPCMP## ;IN RANGE?
SKIPN T2,PIDTAB##(T2) ;YES, PICK UP ENTRY.
JRST VALPD4 ;NO ENTRY HERE
MOVE T3,T2 ;SAVE IT FOR LATER
XOR T2,T1 ;CLEAR BITS IN COMMON
TDZ T2,%IPCPM## ;CLEAR UNWANTED BITS
JUMPN T2,VALPD4 ;SEQ # ARE THE SAME IF 0
ANDI T3,JCHMSK## ;KEEP ONLY JOB/CONTEXT HANDLE
SKIPA J,T3 ;SET J
VALPD1: MOVE J,T1
JUMPE J,VALPD3 ;EXECUTIVE PROCESS
MOVE T1,J ;GET JOB/CONTEXT HANDLE
PUSHJ P,CTXIPC## ;POINT TO IPCF DATA BLOCK
JRST VALPD4 ;NONE - PID IS BAD
VALPD2: AOS (P) ;GIVE GOOD RETURN
PJRST SETIPQ ;SET/GET QUOTA WORD
VALPD3: HLRZ W,T1 ;GET EXEC PROCESS PID NUMBER
MOVE W,EXPROC##-1(W) ;GET CONTROL BLOCK ADDRESS
; HRLS W ;SAVE LOC OF EXEC CTL BLOCK
JRST VALPD2
;HERE ON ERROR
VALPD4: MOVEI T1,IPCIS% ;ERROR CODE
POPJ P,
;ERROR ROUTINES. THESE LOAD IPCXX% INTO T1 FOR EACH ERRXX.
; ERROR ROUTINES ARE CALLED VIA PUSHJ, BUT THEY NEVER RETURN.
;THE POSITION RELATIVE TO ERRAC DEFINES THE ERROR VALUE.
ERCODE ERRAC,IPCAC% ;(1) ADDRESS CHECK
ERCODE ERRNL,IPCNL% ;(2) NOT LONG ENOUGH
ERCODE ERRNP,IPCNP% ;(3) NO PACKET IN QUEUE
ERCODE ERRIU,IPCIU% ;(4) PAGE IN USE (VIRTUAL FEATURE)
ERCODE ERRTL,IPCTL% ;(5) PACKET TOO LONG
ERCODE ERRDU,IPCDU% ;(6) DESTINATION UNKNOWN
ERCODE ERRDD,IPCDD% ;(7) DESTINATION DISABLED
ERCODE ERRRS,IPCRS% ;(10) NO ROOM IN SENDER'S QUOTA
ERCODE ERRRR,IPCRR% ;(11) NO ROOM IN RECEIVER'S QUOTA
ERCODE ERRRY,IPCRY% ;(12) NO ROOM IN SYSTEM FOR PACKET
ERCODE ERRUP,IPCUP% ;(13) UNKNOWN PAGE (SEND) OR ALREADY EXISTING (REC)
ERCODE ERRIS,IPCIS% ;(14) INVALID SENDER'S ADDRESS
ERCODE ERRPI,IPCPI% ;(15) INSUFFICIENT PRIVILEGES
ERCODE ERRUF,IPCUF% ;(16) - UNKNOWN FUNCTION
ERCODE ERRBJ,IPCBJ% ;(17) - BAD JOB NUMBER
ERCODE ERRPF,IPCPF% ;(20) - PIDTAB FULL
ERCODE ERRPR,IPCPR% ;(21) - PAGE REQUESTED, NOT-A-PAGE IN QUEUE
ERCODE ERRIE,IPCIE% ;(22) - PAGING IO ERROR
ERCODE ERRBI,IPCBI% ;(23) - BAD INDEX FOR .GTSID
ERCODE ERRUI,IPCUI% ;(24) - UNDEFINED ID REQUESTED
ERCODE ERRRU,IPCRU% ;(25) - RECEIVER UNKNOWN OR DOES NOT BELONG TO JOB
SUBTTL IPCFR - RECEIVE UUO
UIPCFR::PUSHJ P,SAVE4## ;SAVE P1-P4
PUSH P,T1 ;SAVE USER ARG ON THE STACK
PUSHJ P,VALARG ;LOAD ARGS
JRST [POP P,(P) ;BRING STACK INTO PHASE
POPJ P,] ;AND RETURN
TLNN P1,IP.RFP ;RECEIVE FOR PARTICULAR PID?
JRST IPFR1 ;NO
MOVE T1,P3 ;YES, MAKE SURE PID IS OK
PUSHJ P,VALPID
TRNA ;NO
CAME J,.CPJCH## ;PID DESTINED FOR US?
JRST [POP P,(P) ;BAD PID OR DOESNT BELONG TO JOB
JRST ERRRU]
JRST IPFR0
IPFR1: MOVE T1,J ;GET JOB NUMBER
PUSHJ P,CTXIPC## ;RETURN CURRENT IPCF DATA BASE
JRST [POP P,(P)
JRST ERRRU]
IPFR0: SETZM .EPPID(W) ;NOT WAITING FOR A PARTICULAR PID
POP P,T4 ;RESTORE T1 INTO T4
HLRZS T4 ;JUST NEED THE LENGTH
IPFR2: PUSH P,J ;SAVE J
IPFR2A: MOVE J,.CPJOB ;LOCK OUR QUEUE
PUSHJ P,IPCLOK
HLRZ P2,.EPIPC(W) ;POINTER TO OLDEST PACKET
IPFR3: JUMPE P2,IPFR14 ;NONE.
TLNE P1,IP.RFP ;RECEIVE FOR A PID?
CAMN P3,.IPCFR(P2) ;YES, IS THIS A MATCH
JRST IPFR4 ;WE HAVE A PACKET
HLRZ P2,.IPCFL(P2) ;NO MATCH, TRY NEXT PACKET IN QUEUE
JRST IPFR3
IPFR4: HRRZ T1,.IPCFL(P2) ;GET FLAG WORD
TRNE T1,IP.CFV ;PAGED PACKET?
TRZE P1,IP.CFV ;MUST HAVE REQUESTED A PAGE
TRNE P1,IP.CFV ;ERR IF REQUESTED A PAGE
JRST [POP P,J ;RESTORE J
PUSHJ P,IPCULK ;UNLOCK
JRST ERRPR ] ;WRONG MODE
MOVE P3,T1
TRNN P1,IP.SIP ;IS CALLER PRIV AND ASKING FOR PRIVS?
TRZ T1,IP.SIP ;NO, HE DOESNT CARE IF PACKET PRIV
HLRZ T2,P4 ;SPACE PROVIDED
LDB T3,PKLNP2 ;LENGTH OF PACKET
TLNE P3,IP.CFV ;PAGE?
SETO T3, ;BY NEGATIVE LENGTH
SUB T3,T2
SKIPG T3 ;LONG ENOUGH?
TLZA P1,IP.TTL ;YES, CLEAR TTL BIT
TLO T1,IP.TTL ;NO, SET TTL IN UUO BLOCK
PUSHJ P,PUTWRD## ;STORE IN USER'S ARG BLOCK
JRST IPFR17 ;ADDRESS CHECK
MOVE T1,.IPCFS(P2) ;GET SENDER'S PID
PUSHJ P,PUTWR1## ;STORE SENDER'S PID
JRST IPFR17 ;ADDRESS CHECK
MOVE T1,.IPCFR(P2) ;RECEIVER'S PID
PUSHJ P,PUTWR1## ;STORE RECEIVER'S PID
JRST IPFR17 ;ADDRESS CHECK
TLNN P1,IP.TTL ;TRUNCATE IF TOO LONG?
JUMPG T3,[POP P,J ;PHASE STACK
PUSHJ P,IPCULK
JRST ERRTL];ERROR IF TOO LONG
;COME HERE TO COPY PACKET TO USER'S CORE.
LDB T1,PKLNP2
MOVSI T1,(T1) ;GET LENGTH
HRR T1,P4 ;HDR
TRNE P3,IP.CFV
HRLI T1,PAGSIZ ;WHOLE PAGE
TLNE P1,IP.TTL ;PACKET TOO LONG?
HLL T1,P4 ;YES, TELL TRUNCATED LENGTH
PUSHJ P,PUTWR1## ;TELL USER THE LENGTH
JRST IPFR17
SUBI T4,.IPCFU ;SEE IF HE WANTS SENDER PPN
JUMPLE T4,IPFR4D ;NO
MOVE T1,.IPCFU(P2) ;GET SENDER'S PPN
PUSHJ P,PUTWR1## ;YES, GIVE IT TO HIM
JRST IPFR17
SOJLE T4,IPFR4D ;WANT .IPCFC?
MOVE T1,.IPCFC(P2) ;GET CAPABILITIES WORD
PUSHJ P,PUTWR1## ;YES, GIVE IT TO HIM
JRST IPFR17
IPFR4D: LDB T1,PKLNP2 ;GET LENGTH OF PACKET
TRNN P3,IP.CFV ;PAGE?
TLNE P1,IP.TTL ;TOO LONG?
HLRE T1,P4 ;YES, JUST FILL HIS BLOCK
JUMPLE T1,IPFR6 ;NOTHING TO STORE IF 0 WDS IN PACKET
HRRI M,-1(P4) ;USER'S ADDRESS
MOVN T2,T1 ;FORM AOBJN WORD
HRLZS T2
HRR T2,P2 ;ADR OF PACKET
IPFR5: MOVE T1,.IPCFD(T2) ;FETCH DATA FROM EXEC
PUSHJ P,PUTWR1## ;STORE IN USER'S AC
JRST IPFR17
AOBJN T2,IPFR5 ;COPY WHOLE PACKET
IPFR6: POP P,J ;GET BACK JOB/CONTEXT HANDLE
TRNN P3,IP.CFV ;WHOLE PAGE?
JRST IPFR7 ;NO
TLNE P1,IP.TTL ;TOO LONG?
JRST [IFN FTMP,<
PUSHJ P,UPMM##
>
MOVE T2,.IPCFI(P2)
TLZ T2,(IP.NAD^!<IP.DSK!IP.OIQ!IP.SSP>)
PUSH P,W
SKIPE T2 ;FORGET IT IF IO ERROR
PUSHJ P,IPCDEL##
POP P,W
IFN FTMP,<
PUSHJ P,DWNMM##
>
JRST IPFR7 ]
HRRZ T1,P4 ;NO, GET VIRTUAL PAGE NO
IPFR6A:
IFN FTMP,<
PUSHJ P,UPMM##
>
MOVE T2,.IPCFI(P2) ;DSK OR CORE ADDR
TLZ T2,(IP.NAD^!<IP.DSK!IP.OIQ!IP.SSP>)
JUMPE T2,[IFN FTMP,<
PUSHJ P,DWNMM##
>
PUSHJ P,IPCULK
JRST ERRIE ]
PUSH P,J ;SAVE JOB/CONTEXT HANDLE
ANDI J,JOBMSK## ;THE REST OF THE WORLD DOESN'T KNOW ABOUT CTX
PUSH P,W ;SAVE FROM DESTRUCTION BY VMSER
TLNN T2,(IP.DSK) ;IF THIS IS NOT A DISK ADDRESS
JRST IPFR6C ;THEN IPCINS WILL TAKE CARE OF IT
PUSH P,T2 ;SAVE T2
TLZ T2,(PM.NAD) ;CLEAR BITS
PUSHJ P,ONIPQ## ;IS IT ON THE "IP" QUEUE?
JRST IPFR6B ;NO
SSX T4,MS.MEM ;PAGTAB SECTION
DPB J,[POINT PT.SJB,PAGTAB(T4),<^L<PT.JOB>+PT.SJB-1>]
MOVEI T2,PIOWQ## ;PUT JOB IN PAGING I/O WAIT
DPB T2,PJBSTS##
IFN FTMP,<
PUSHJ P,DWNMM## ;GIVE UP THE MM
>
PUSHJ P,WSCHED## ;WAIT
POP P,(P) ;CLEAR STACK
POP P,W ;RESTORE W & J
POP P,J
JRST IPFR6A ;LOOK AGAIN
IPFR6B: POP P,T2 ;RESTORE ENTRY
IPFR6C: S0PSHJ IPCINS## ;PUT PAGE INTO THIS MAP
TDZA T2,T2 ;LOST
SETO T2, ;WON
IFN FTMP,<
PUSHJ P,DWNMM##
>
POP P,W ;RESTORE W
POP P,J ;RESTORE J
JUMPN T2,IPFR7 ;GO IF WON
PUSHJ P,IPCULK
JUMPL M,CPOPJ## ;DONE IF COMMAND (?)
JRST STOTAC## ;RETURN CODE TO USER
;COME HERE TO DECREMENT RECEIVER'S AND SENDER'S COUNTERS,
; FREE EXEC COPY OF PACKET, ETC. NO ERROR EXITS ARE
; PERMITTED BEYOND THIS POINT SINCE EXEC INFORMATION IS
; ALTERED.
IPFR7: XMOVEI T2,.EPIPC-.IPCFL(W) ;PRESET PREDECESSOR
IPFR8: HLRZ T3,.IPCFL(T2)
CAIN T3,(P2) ;THIS PACKET LINK TO OURS?
JRST IPFR9 ;YES
MOVE T2,T3 ;NO, TEST NEXT
JRST IPFR8
IPFR9: SYSPIF
HLRZ T1,.IPCFL(P2) ;POINTER TO NEXT PACKET
HRLM T1,.IPCFL(T2) ;LINK PREDECESSOR TO NEXT
SKIPN T1 ;END OF QUEUE?
HRRM T2,.EPIPN(W) ;YES, PRED IS NEW END
SYSPIN
IPFR10: JUMPE T1,IPFR12
MOVE T2,.IPCFR(P2) ;RECEIVER PID
TLNE P1,IP.RFP ;RECEIVE FOR A PID?
CAMN T2,.IPCFR(T1) ;YES, IS THIS PACKET A MATCH?
JRST IPFR11 ;THIS IS NEXT PACKET
HLRZ T1,.IPCFL(T1) ;NO MATCH, TRY NEXT
JRST IPFR10
IPFR11: MOVE T2,T1 ;COPY USEABLE ADDRESS
LDB T1,PKLNT2 ;GET LENGTH OF NEXT PACKET
MOVSI T1,(T1) ;WHERE IT SHOULD BE
HRR T1,.IPCFL(T2) ;FLAGS FOR NEXT PACKET
TRNE T1,IP.CFV ;PAGE?
HRLI T1,PAGSIZ ;YES, SET LENGTH
IPFR12: PUSHJ P,IPCULK
PUSHJ P,STOTAC## ;RETURN INFO ABOUT NEXT PACKET IN AC
SOS .EPIPC(W) ;DEC COUNT OF PACKETS WAITING
AOS T1,.EPIPA(W) ;INCR RECEIVE COUNT
TRNN T1,-1
SOS .EPIPA(W) ;OVERFLOW, COUNT IT DOWN AGAIN
;NOW MOVE TO THE SENDER'S ENVIRONMENT TO DECREMENT THE
; COUNT OF HIS UNRECEIVED SENDS. SENDER'S PID HAS BEEN
; KEPT IN P1 FROM WAY BACK.
MOVE T2,.IPCFS(P2) ;IS SENDER A SYSTEM PROCESS?
AND T2,%IPCPM##
CAIGE T2,%IPCNS##
TDZA T2,T2 ;YES, DON'T USE .IPCFC
LDB T2,TRNPT2 ;IF TURNED-AROUND MSG THE PID
SKIPN T1,T2 ; MAY HAVE BEEN DESTROYED,
MOVE T1,.IPCFS(P2) ;SO GET W FROM PID
PUSH P,J ;SAVE J
PUSHJ P,VALPID ;SET UP J & W
JRST IPFR13 ;NO GOOD, SENDER MUST BE GONE.
PUSHJ P,DECSNX ;DECREMENT PACKETS SENT BUT NOT RECEIVED
IPFR13: LDB T1,PKLNP2 ;GET LENGTH
CAIL T1,PAGSIZ ;PAGE?
SETZ T1, ;YES, NO DATA WORDS
ADDI T1,.IPCFD ;PLUS OVERHEAD WORDS
HRRZ T2,P2 ;ADDRESS
PUSHJ P,GIVWDS## ;FREE THE PACKET SPACE
SOSL %CNIIP## ;DEC COUNT OF PACKETS OUTSTANDING
PJRST JPOPJ1##
STOPCD .+1,DEBUG,PCN, ;++PACKET COUNT NEGATIVE
SETZM %CNIIP## ;CONTINUED - ZERO COUNT SO WONT STOP AGAIN
PJRST JPOPJ1## ;RESTORE J AND SKIP-RETURN
;COME HERE IF THERE IS NO PACKET IN THE USER'S LIST.
IPFR14: JUMPGE P1,IPFR15
PUSHJ P,IPCULK ;UNLOCK
POP P,J
JRST ERRNP ;BIT 0 = DONT BLOCK
IPFR15: TLNE P1,IP.RFP ;IF A PARTICULAR PID
MOVEM P3,.EPPID(W) ;TELL WORD WE WANT ONLY THIS
PUSH P,W ;SAVE IPCF DATA BLOCK ADDRESS
PUSHJ P,FNDPDS## ;AND POINT W AT PDB
MOVSI T1,IPCACE## ;FLAG HIBERNATING FOR IPCF
IORB T1,JBTRTD##(J)
MOVEI T1,SLPQ## ;PUT JOB IN SLEEP QUEUE
DPB T1,PJBSTS##
PUSHJ P,IPCULK ;UNLOCK
PUSHJ P,CLRIPT## ;ZAP IN-CORE PROTECT SO JOB CAN BE SWAPPED
PUSHJ P,WSCHED## ;WAIT FOR AWAKENING
MOVE T1,(P) ;GET POINTER TO IPCF DATA BLOCK
SETZM .EPPID(T1) ;NO LONGER RECEIVING FROM A SPECIFIC PID
XCT NOPISK## ;IF USER IS USING PSI
SKIPN @JBTPIA##(J) ;SKIP IF PENDING COUNT IS UP
JRST [POP P,W ;RESTORE W
JRST IPFR2A] ;NO PENDING INTERRUPTS, TRY AGAIN
POP P,W ;RESTORE W
POP P,J ;RESTORE J
SOS .JDAT+JOBPD1##+1 ;FORCE UUO TO RESTART
POPJ P, ;AFTER INTERRUPT IS GRANTED
;HERE ON ADDRESS CHECK DURING RECEIVE. FIX STACK, UNLOCK, AND RETURN ERROR
IPFR17: POP P,J
PUSHJ P,IPCULK
PJRST ERRAC
SUBTTL IPCFS - SEND UUO
UIPCFS::PUSHJ P,SAVE4## ;SAVE P1-P4
PUSHJ P,VALARG ;LOAD ARGS
POPJ P, ;WRONG
MOVE T1,J ;GET JOB NUMBER
PUSHJ P,CTXIPC## ;FIND IPCF DATA BASE
POPJ P, ;NO SUCH JOB OR CONTEXT
PUSHJ P,SETIPQ ;SET/GET QUOTA WORD
LDB T1,[POINT 9,T2,26] ;SEND QUOTA
LDB T2,[POINT 9,.EPIPC(W),26] ;SEND COUNT
MOVEI T3,1 ;ASSUME ONE LAST CALL
TRNE P1,IP.SIP ;PRIVS?
MOVEI T3,777 ;YES, LOTS OF CALLS
TLNE P1,IP.LPC ;LAST PHONE CALL?
ADD T1,T3 ;YES, BUMP THE QUOTA
CAILE T1,777 ;OVERFLOW?
MOVEI T1,777 ;YES, NOBODY IS ALLOWED TO OVERFLOW
CAMG T1,T2 ;QUOTA DEPLETED?
JRST ERRRS ;YES, DON'T SEND
JUMPN P3,IPCS1 ;IF REC'R FIELD IS 0,
SKIPN P3,.EPIPI(W) ; SEND MSG TO [SYSTEM]INFO FOR THIS JOB
MOVE P3,%SIINF## ; (LOCAL OR GLOBAL)
JUMPE P3,ERRDU ;DESTINATION UNKNOWN IF NO [SYSTEM]INFO
;COME HERE TO VALIDATE SENDER'S PID
IPCS1: JUMPN P2,IPCS4 ;"SENDER'S PID" SPECIFIED?
MOVN T1,%IPCMP## ;NO, FIND A DEFAULT PID
HRLZS T1
SKIPN T2,PIDTAB##(T1) ;SEARCH FOR A VALID PIDTAB ENTRY
IPCS2: AOBJN T1,.-1
JUMPGE T1,IPCS3 ;DONE, NO PIDS FOR THIS JOB
ANDI T2,JCHMSK## ;ISOLATE JCH
CAME T2,J ;THIS JCH?
JRST IPCS2 ;NO.
MOVE P2,PIDTAB##(T1) ;PUT ENTRY IN P2
TRZ P2,JOBMSK## ;REMOVE JOB NUMBER
TROA P2,(T1) ;INCLUDE PID INDEX
IPCS3: MOVE P2,J ;NO PIDS, USE JOB NUMBER
IPCS4: PUSH P,J ;SAVE J
MOVE T1,P2 ;GET SENDER'S PID
PUSHJ P,VALPID ;CHECK OUT SENDER
JRST [TRNE P1,IP.SIP ;PRIV'D?
JRST IPCS5 ;YES, OK (TURNING AROUND A MSG CAUSE REC'R DIED)
POP P,J ;NO - INVALID SENDER
JRST ERRIS]
JUMPE J,[POP P,J ;CANT SEND "FROM" AN EXEC PROCESS
JRST ERRIS]
SUB J,(P) ;PID IS LEGAL, IS IT HIS?
TRNN P1,IP.SIP ;IF SENDER ISN'T PRIV'D,
JUMPN J,[POP P,J
PJRST ERRIS] ; SEND MUST BE FROM HIS JOB
;COME HERE TO VALIDATE RECEIVER
IPCS5: MOVE T1,P3 ;PUT PID INTO T1
IFN FTMP,<
PUSHJ P,UPMM## ;LOCK FOR PDB
>
PUSHJ P,VALPID ;SET UP J AND W
JRST [POP P,J ;RESTORE J
IFN FTMP,<
PUSHJ P,DWNMM## ;FAILED
>
JRST ERRDU] ;DESTINATION UNKNOWN
;COME HERE TO CHECK THAT THE RECEIVER'S QUOTA IS NOT
; EXHAUSTED AND THAT THE RECEIVER IS NOT DISABLED.
LDB T1,RCCNT ;RECEIVE COUNT
LDB T2,RCQTA ;RECEIVE QUOTA
CAMN P3,.EPPID(W) ;ID REC'R BLOCKED FOR THIS PID
AOS T2 ;LET HIM GO 1 OVER QUOTA
EXCH J,(P) ;RESTORE SENDER, SAVE RECEIVER
CAML T1,T2 ;QUOTA EXHAUSTED?
JRST [POP P,J
IFN FTMP,<
PUSHJ P,DWNMM##
>
JRST ERRRR ]
SKIPGE .EPIPQ(W) ;NO, IS RECEIVER DISABLED?
JRST [POP P,J
IFN FTMP,<
PUSHJ P,DWNMM##
>
JRST ERRDD ]
HLRE T2,P4 ;GET DATA LENGTH
CAMG T2,%CNIPL## ;TOO LONG?
JRST IPCS5B ;NO
TLNN P1,IP.LPK ;TRYING TO SEND A LONG MESSAGE?
JRST IPCS5A ;PACKET TOO LONG
PUSHJ P,[PUSHJ P,SAVJW##
ANDI J,JOBMSK##
MOVSI T1,JP.IPC ;ONLY ALLOWD IF IPCF PRIVS
PJRST PRVBIT##] ;PRIV'ED?
JRST IPCS6 ;YES, PROCEED
IPCS5A:
IFN FTMP,< PUSHJ P,DWNMM##>
POP P,J ;FIX STACK
JRST ERRTL ;PACKET TOO LONG
IPCS5B: JUMPG T2,IPCS6
TRNN P1,IP.CFV
TROA P1,IP.CFZ
SETZ T2,
IPCS6: ADDM T2,%IPTWT## ;COUNT TOTAL NUMBER OF WORDS XFERRED
ADDI T2,.IPCFD ;NO, GET ROOM TO HOLD BLOCK
PUSHJ P,GETWDS## ;IN EXEC CORE
JRST [POP P,J
IFN FTMP,<
PUSHJ P,DWNMM##
>
JRST ERRRY ]
TRNE P1,70 ;SENDER FIELD 0?
JRST IPCS7
CAMN P2,%SIINF## ;YES, SENDER =[SYSTEM]INFO?
TRO P1,20 ;YES
CAMN P2,.EPIPI(W) ;SENDER=LOCAL[SYSTEM]INFO?
TRO P1,30 ;YES
IPCS7: HRRZM P1,.IPCFL(T1) ;STORE FLAGS (LH=INTERNAL POINTER)
MOVEM P2,.IPCFS(T1) ;STORE SENDER'S PID (FUDGED)
MOVEM P3,.IPCFR(T1) ;STORE RECEIVER'S PID
SETZM .IPCFI(T1) ;CLEAR WORD FOR LATER
HLRE T3,P4 ;SIZE
SKIPGE T3 ;LONG?
MOVEI T3,PAGSIZ ;YES
DPB T3,PKLNT1 ;STORE LENGTH
IFN FTMP,<
PUSHJ P,DWNMM## ;DON'T CARE ABOUT PDB ANY MORE
>
PUSH P,J ;SAVE SENDER INFO
PUSH P,W
EXCH T1,P2 ;GET FUDGED SENDERS PID
PUSHJ P,VALPID ;AND FIND ITS JOB
MOVE J,-1(P) ;USE CURRENT J IF NOT HERE
MOVE T1,P2 ;RESTORE T1
POP P,W ;AND W
MOVE T3,J ;GET FUDGED SENDER'S JOB/CONTEXT HANDLE
ANDI T3,JOBMSK## ;REDUCE TO A JOB NUMBER
MOVE T3,JBTPPN##(T3) ;GET FUDGED SENDER PPN
MOVEM T3,.IPCFU(T1) ;SAVE IT
PUSHJ P,IPCSCA ;STORE CAPABILITIES
POP P,J ;AND RESTORE REAL SENDERS J
HRRI M,-1(P4) ;POINTER TO BLOCK IN USER CORE
MOVE P3,T1 ;COPY ADDR OF CORE BLOCK
HLLZ P2,P4 ;FORM AOBJN WORD
JUMPLE P2,IPCS9 ;DONT STORE DATA IF LENGTH=0
HLRZ T3,P2 ;GET TOTAL WORDS IN RH OF AN AC
MOVNS P2
HRR P2,T1
PUSH P,J ;SAVE SENDER'S JCH
MOVE J,.CPJOB## ;GETWRD WANTS A REAL JOB NUMBER
IPCS8: PUSHJ P,GETWD1## ;GET WORD FROM USER CORE
MOVEM T1,.IPCFD(P2) ;STORE DATA WORD
AOBJN P2,IPCS8 ;COPY WHOLE BLOCK
POP P,J ;RESTORE SENDER'S JCH
;COME HERE WITH P3 POINTING TO A BLOCK IN EXEC CORE
; CONTAINING THE UUO ARGS AND THE DATA. MOVE TO RECEIVER'S
; ENVIRONMENT AND PUT THE PACKET ON HIS LIST.
IPCS9:
TRNE P1,IP.CFV ;PAGE MODE?
JRST IPCS9C ;YES
POP P,J ;RECEIVER'S JCH
PUSHJ P,IPCLOK ;LOCK QUEUE
IFN FTMP,<
PUSHJ P,UPMM## ;GUARD PDB GOING AWAY AGAIN
>
MOVE T1,.IPCFR(P3) ;MAKE SURE IT'S STILL THERE
PUSHJ P,VALPID
IPCS9A: SKIPA T1,P4 ;RECEIVER WENT AWAY
JRST IPCS13 ;PUT PACKET ON QUEUE
IFN FTMP,<
PUSHJ P,DWNMM##
>
HLRES T1 ;SWAP HALVES
ADDI T1,.IPCFD
MOVEI T2,(P3) ;ADDRESS
PUSHJ P,GIVWDS## ;RETURN THE SPACE
JRST ERRDU
IPCS9C:
HRRZ T1,P4 ;PAGE - GET ITS VIRTUAL PAGE NUMBER
MOVEM W,(P) ;SAVE FROM DESTRUCTION
PUSH P,J ;SAVE JOB/CONTEXT HANDLE
ANDI J,JOBMSK## ;STRIP OFF CTX # SO VMSER DOESN'T GET UPSET
S0PSHJ IPCRMV## ;REMOVE FROM SENDERS MAP
JRST [IFN FTMP,<PUSHJ P,DWNMM##>
POP P,J ;RESTORE J
POP P,W ;RESTORE W
HRRZ T2,P3 ;ERROR - GET ADR OF 4-WD BLOCK
MOVEI T1,.IPCFD ;LENGTH OF BLOCK
PUSHJ P,GIVWDS## ;RETURN THE SPACE
JRST ERRUP] ;AND ERROR RETURN
POP P,J ;RESTORE J
POP P,W ;RESTORE W
AOS %IPTPT## ;COUNT A PAGE TRANSFERRED
MOVE P2,T2 ;SAVE CORE ADR
MOVE T1,.IPCFR(P3) ;RECEIVER
PUSHJ P,VALPID ;SET UP J AND W
JRST IPS11A ;SHOULD NEVER HAPPEN
JUMPL P2,IPCS12 ;PAGE ON DSK? GO IF YES
MOVE T2,J ;COPY JOB/CONTEXT HANDLE
ANDI T2,JOBMSK## ;REDUCE TO A JOB NUMBER
SKIPGE T1,JBTSTS##(T2) ;JOB RUNNING?
TLNE T1,SWP ; AND IN CORE?
JRST IPCS11 ;NO, PAGE THE PAGE OUT
IFN FTLOCK,<
SKIPN T1,LOCK## ;ALWAYS PAGE IT IF SOMEONE IS LOCKING
>
HLRZ T1,.EPIPC(W) ;YES
JUMPN T1,IPCS11 ;PAGE OUT PACKET IF WONT BE FIRST ON Q
SKIPE T1,.EPPID(W) ;IF JOB IS BLOCKED WAITING FOR
CAME T1,.IPCFR(P3) ; A PARTICULAR PID
JUMPN T1,IPCS11 ;PAGE OUT IF NOT RIGHT SENDER
MOVSI T1,IPCACE## ;1ST IN QUEUE, IS REC'R HIBERING FOR IPC?
TDNE T1,JBTRTD##(T2)
JRST IPCS10 ;YES, DONT PAGE OUT THE PAGE
HRROI T1,C$IPC ;NO, IS HE PSI'ING FOR IPC?
PUSHJ P,PSITST##
JRST IPCS11 ;NOT ENABLED, PAGE OUT THE PAGE
;ENABLED OR HIBERING FOR THE PAGE, SEE IF ROOM IN CORE
IPCS10: MOVE T1,MAXMAX## ;TOTAL USER CORE ON SYSTEM
SUB T1,CORMAX## ;MAX SIZE A JOB CAN BECOME
LSH T1,W2PLSH ;NUMBER OF PAGES AVAILABLE FOR IPCF
MOVE T2,%CNPIC## ;NUMBER OF PAGES IN USE BY IPCF
ADDI T2,1 ;NUMBER WHICH WILL BE IN USE
CAMLE T2,T1 ;ENOUGH ROOM?
JRST IPCS11 ;NO, PAGE OUT THE PAGE
AOS %CNPIC## ;IPCF PAGES IN CORE
JRST IPCS12 ;LEAVE THE PAGE IN CORE
IPCS11:
MOVE J,.CPJOB## ;RESTORE J
MOVE T2,P2
S0PSHJ IPCPAG## ;PAGE OUT THE PAGE
MOVEI T2,0 ;PAGING I/O ERROR
MOVE P2,T2
MOVE T1,.IPCFR(P3) ;RECEIVER'S PID
PUSHJ P,VALPID
SKIPA J,.CPJCH## ;OOPS, POINT J BACK TO US
JRST IPCS12 ;ALL IS WELL
IPS11A:
PUSHJ P,IPCULK
MOVEI T2,(P3) ;DEALLOCATE PACKET
MOVEI T1,.IPCFD ;..
PUSHJ P,GIVWDS## ;SINCE WON'T BE SENDING
SKIPN T2,P2 ;GET PAGE BACK
JRST [IFN FTMP,<PUSHJ P,DWNMM##>
JRST ERRIE] ;PAGING I/O ERROR
MOVEI T1,(P4) ;WHERE TO PUT IT
PUSH P,J ;SAVE J
ANDI J,JOBMSK## ;REDUCE TO A JOB #
PUSH P,W ;SAVE W
S0PSHJ IPCINS## ;PUT IT BACK
JRST [IFN FTMP,<
PUSHJ P,DWNMM## ;RECEIVER IS GONE
>
POP P,W ;RESTORE W
POP P,J ;RESTORE J
JRST ERRIE] ;PAGING I/O ERROR
IFN FTMP,<
PUSHJ P,DWNMM## ;RECEIVER IS GONE
>
POP P,W ;RESTORE W
POP P,J ;RESTORE J
JRST ERRDU ;RECEIVER WENT AWAY
IPCS12: IORM P2,.IPCFI(P3) ;SAVE DSK ADR IN PACKET
IPCS13: SYSPIF
SKIPN T2,.EPIPN(W) ;PICK UP END OF QUEUE
XMOVEI T2,.EPIPC-.IPCFL(W) ;EMPTY QUEUE
HRLM P3,.IPCFL(T2) ;SAVE THIS PACKET ON END OF QUEUE
HRRM P3,.EPIPN(W) ;SET UP PNTR TO NEW END-OF-QUEUE
AOS %CNIIP## ;INCREMENT OUTSTANDING PACKETS
AOS .EPIPC(W) ;INC COUNT
SYSPIN
IFN FTMP,<PUSHJ P,DWNMM##> ;DONE
;COME HERE AFTER THE PACKET IS ON THE RECEIVER'S LIST.
MOVE T1,.IPCFS(P3) ;SENDER (MIGHT NOT BE SAME J)
PUSHJ P,VALPID ;SET UP (PRIV'D JOB CAN SEND FROM ANOTHER JOB)
PJRST IPCS14 ;BAD - TURNING AROUND MSG TO A DROPPED PID
MOVEI T1,IP.SBT ;INCREMENT SEND COUNT
ADDM T1,.EPIPC(W)
HLRZ T1,.EPIPA(W) ;COUNT OF SEND UUOS
ADDI T1,1
TRNE T1,-1 ;OVERFLOW?
HRLM T1,.EPIPA(W) ;NO, STORE INCREMENTED COUNT
IPCS14: AOS %CNIPS## ;INCREMENT SENT PACKETS
;COME HERE TO AWAKEN A USER JOB OR PUSHJ TO AN EXEC PROCESS
; THAT HAS JUST HAD A PACKET ARRIVE ON ITS LIST.
PUSHJ P,IPCULK ;UNLOCK RECEIVER'S QUEUE
MOVE T1,.IPCFR(P3) ;RECEIVER'S PID
PUSHJ P,VALPID ;SET UP J AND W
JRST CPOPJ1## ;SHOULD NEVER HAPPEN
JUMPE J,EXECPR ;SPECIAL HANDLING FOR EXEC PROCESS
PUSHJ P,WAKEUP
JRST CPOPJ1## ;AND GIVE SKIP RETURN
;SUBROUTINE TO STORE CAPABILITIES OF THE SENDER
;CALLING SEQUENCE:
; MOVEI T1,ADDRESS OF THE PACKET HEADER
; MOVE J,JOB NUMBER OF THE SENDER
; PUSHJ P,IPCSCA
;ALWAYS RETURN CPOPJ
IPCSCA: PUSH P,T1 ;SAVE PACKET HEADER ADDRESS
MOVE T1,J ;COPY JOB/CONTEXT HANDLE
ANDI T1,JOBMSK## ;REDUCE TO A JOB NUMBER
MOVE T4,J ;CLEAR CAPABILITIES
MOVE T3,JBTSTS##(T1) ;GET JBTSTS
TLNE T3,JACCT ;SENDER HAS JACCT?
TLO T4,IP.JAC ;YES
TLNE T3,JLOG ;SENDER HAS JLOG?
TLO T4,IP.JLG ;YES
TRNE T3,JS.XO ;IS SENDER XCT ONLY?
TLO T4,IP.SXO ;YUP!
MOVE T3,JBTPRV##(T1) ;GET JBTPRV WORD
TLNE T3,JP.POK ;CAN SENDER POKE MONITOR?
TLO T4,IP.POK ;YES,
TLNE T3,JP.IPC ;DOES HE HAVE IPCF PRIVS?
TLO T4,IP.IPC ;YES
MOVSI T3,(UP.IYB) ;IN YOUR BEHALF?
TDNE T3,.USBTS ;TEST
TLZ T4,IP.JAC ;AS IF NOT PRIVED
POP P,T1 ;GET PACKET HEADER BACK
MOVEM T4,.IPCFC(T1) ;AND STORE SENDER'S CAPABILITIES
POPJ P, ;RETURN
;COME HERE IF EXEC PROCESS.
EXECPR: HRRZ T1,W ;NON-OFFSET LOC OF EXEC CTL BLOCK
PUSHJ P,@.EPADR(T1) ;CALL THE PACKET HANDLER
JRST CPOPJ1## ;GIVE SKIP-RETURN
WAKEUP: SIGNAL C$IPC ;SIGNAL MESSAGE AVAILABLE
JFCL
MOVE T1,J ;WHERE CTXSER EXPECTS IT
PUSHJ P,CTXWAK## ;WAKE JOB IN CASE PSISER COULDN'T
POPJ P, ;RETURN NON-SKIP
POPJ P, ;IF FAIL OR SUCCEED
;SUBROUTINE TO SET UP STATUS WORD FOR INTERRUPT
STRSIG::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVJW## ;SAVE J AND W
MOVE T1,J ;GET JOB/CONTEXT HANDLE
PUSHJ P,CTXIPC## ;FIND THE IPCF DATA BASE
POPJ P, ;NO SUCH JOB OR CONTEXT
MOVEI T2,0 ;IN CASE NO PACKETS
HLRZ T1,.EPIPC(W) ;LOC OF 1ST PACKET
JUMPE T1,CPOPJ## ;RETURN T2 = 0 IF NONE
LDB T2,PKLNT1 ;GET LENGTH OF TOP PACKET
MOVSI T2,(T2) ;TO LEFT HALF
HRR T2,.IPCFL(T1) ;FLAGS
TRNE T2,IP.CFV ;PAGE?
HRLI T2,PAGSIZ ;YES, LENGTH = 1 PAGE
POPJ P, ; AND RETURN
SUBTTL IPCFQ - QUERY UUO
UIPCFQ::PUSHJ P,SAVE1##
HRR M,T1 ;ADDRESS OF UUO BLOCK
HLRZ T4,T1 ;SAVE COUNT
PUSHJ P,GETWRD## ;GET WORD 0
JRST ERRAC
MOVE P1,T1 ;SAVE PRIV BIT
MOVE T1,J ;GET JOB NUMBER
PUSHJ P,CTXIPC## ;FIND IPCF DATA BASE
JRST ERRBJ ;NO SUCH JOB OR CONTEXT
PUSHJ P,IPCLOK ;LOCK OUR QUEUE
HLRZ T2,.EPIPC(W) ;IS THERE A PACKET?
JUMPN T2,IPCFQ0 ;CONTINUE
PUSHJ P,IPCULK ;UNLOCK
PJRST ERRNP ;RETURN FOR NONE
IPCFQ0: MOVE J,.CPJOB## ;GETWRD/PUTWRD LIKES REAL JOB NUMBERS
TLNN P1,IP.RFP ;WANT SPECIFIC PID?
JRST IPCFQ4 ;NO
ADDI M,2
PUSHJ P,GETWRD## ;YES, GET THE PID
JRST IPCFQ5
TLNN P1,IP.IAR ;IS RECEIVER'S PID INDIRECTED?
JRST IPCFQ7 ;NO
MOVE T3,M ;PRESERVE M
HRR M,T1 ;PUT PID ADDRESS IN M
PUSHJ P,GETWRD## ;GET THE PID
JRST IPCFQ5 ;ADDRESS CHECK
MOVE M,T3 ;RESTORE M
IPCFQ7: SUBI M,2
IPCFQ1: CAMN T1,.IPCFR(T2) ;THIS PACKET FROM THAT PID?
JRST IPCFQ4 ;YES, INFORM HIM
HLRZ T2,.IPCFL(T2) ;NO, TRY NEXT
JUMPN T2,IPCFQ1
PUSHJ P,IPCULK ;UNLOCK QUEUE
JRST ERRNP
IPCFQ4: HRRZ T1,.IPCFL(T2) ;YES, PASS INFO TO CALLER
TRNN P1,IP.SIP ;IS HE PRIV?
TRZ T1,IP.SIP ;NO, SUPPRESS PRIV BIT IN PACKET
PUSHJ P,PUTWRD## ;STORE .IPCFL
JRST IPCFQ5 ;ADDRESS CHECK.
MOVE T1,.IPCFS(T2) ;SENDER'S PID
PUSHJ P,PUTWR1## ;STORE SENDER'S PID
JRST IPCFQ5
MOVE T1,.IPCFR(T2) ;RECEIVER'S PID
PUSHJ P,PUTWR1## ;STORE RECEIVER'S PID
JRST IPCFQ5 ;ADDRESS CHECK
MOVE T3,.IPCFL(T2) ;FLAGS
LDB P1,PKLNT2 ;LENGTH
TRNE T3,IP.CFV ;PAGE?
MOVEI P1,PAGSIZ ;YES, THEN LENGTH= 1 PAGE
LDB T1,RCCNT ;COUNT
HRLI T1,(P1)
PUSHJ P,PUTWR1## ;STORE IN USER'S CORE
JRST IPCFQ5 ;ADDRESS CHECK
MOVE T1,.IPCFU(T2) ;GET SENDERS PPN
CAIG T4,.IPCFU ;DID HE ASK FOR IT?
PJRST IPCFQ6 ;NO, JUST RETURN
PUSHJ P,PUTWR1## ;YES, GIVE IT TO HIM
JRST IPCFQ5
MOVE T1,.IPCFC(T2) ;GET SENDERS PRIVS
CAIG T4,.IPCFC ;DID HE ASK FOR THEM?
PJRST IPCFQ6 ;NO, RETURN
PUSHJ P,PUTWR1## ;YES, GIVE THEM TO HIM
IPCFQ5: SKIPA T4,[ERRAC] ;FAILED
IPCFQ6: MOVEI T4,CPOPJ1## ;GOOD RETURN
PUSHJ P,IPCULK
JRST (T4)
SUBTTL IPCFM - MISC. FUNCTION UUO
;DEFINE THE EXTENDED ERROR CODES USED
ERCODX ERRACX,IPCAC% ;ADDRESS CHECK ERROR
ERCODX ERRUFX,IPCUF% ;UNKNOWN FUNCTION
ERCODX ERRRYX,IPCRY% ;NO ROOM ERROR
ERCODX ERRDUX,IPCDU% ;DESTINATION UNKNOWN
ERCODX ERRISX,IPCIS% ;INVALID SENDER
ERCODX ERRPIX,IPCPI% ;PRIVILEGES INSUFFICIENT
ERCODX ERRTLX,IPCTL% ;TOO LONG A PACKET/BUFFER
ERCODX ERRNLX,IPCNL% ;PACKET/BUFFER NOT LONG ENOUGH
UIPCFM::PUSHJ P,SAVE4## ;PRESERVE OUR REGISTERS
PUSHJ P,SAVJW## ;DITTO
IFN FTXMON,PUSHJ P,SSPCS## ;SAVE PCS IN CASE WE CHANGE IT
PUSHJ P,SXPCS## ;SETUP NEW PCS FOR EXTENDED ARGUMENTS
JRST ERRAC ;ADDRESS CHECK
MOVE M,T1 ;FOR ADDRESSING
PUSHJ P,GETEWD## ;GET FLAGS WORD
JRST ERRACX ;ADDRESS CHECK
TLNE T1,IP.CMX ;CHECK IF UNDEFINED FLAGS ARE ON
JRST ERRUFX ;YES, UNKNOWN FUNCTION
MOVE P4,T1 ;NO, SAVE FLAGS+LENGTH
HRRES T1 ;ISOLATE LENGTH
CAIL T1,2 ;TOO FEW ARGUMENTS?
CAILE T1,3 ;OR MORE THAN DEFINED?
JRST ERRUFX ;YES, UNKNOWN FUNCTION
MOVE P3,T1 ;NO, SAVE LENGTH
MOVSI T1,JP.IPC ;PRIV BIT TO TEST
TLNE P4,IP.CMP ;WANT TO SEND A PRIV'ED PACKET?
PUSHJ P,PRVBIT## ;YES, CHECK
CAIA ;PRIV'ED OR NONE NEEDED
TLZ P4,IP.CMP ;NO PRIVS--CLEAR FLAG
LDB T1,DESTP4 ;GET DESTINATION CODE
CAILE T1,3 ;ONE OF THOSE WE CAN TALK TO?
JRST ERRDUX ;NO, DESTINATION UNKNOWN
PUSHJ P,GETEW1## ;GET PACKET ADDRESS
JRST ERRACX ;ADDRESS CHECK
MOVE P1,T1 ;STORE ADDRESS OF PSEUDO-PACKET
SETZ T1, ;START BY ASSUMING ZERO
CAIGE P3,3 ;USER SPECIFY AN IYB WORD?
JRST IPCFM1 ;NO, USE ZERO
PUSHJ P,GETEW1## ;YES, FETCH IT
JRST ERRACX ;ADDRESS CHECK IF CAN'T
TLZN P4,IP.CMI ;INDIRECTING IT?
JRST IPCFM1 ;NO, USE THIS VALUE
IFN FTXMON,XSFM T2 ;YES, SAVE CURRENT PCS
PUSHJ P,SXPCS## ;CHANGE FOR THIS ARGUMENT
JRST ERRACX ;ADDRESS CHECK
MOVE M,T1 ;FOR FETCHING
PUSHJ P,GETEWD## ;GET PID TO FETCH
JRST ERRACX ;ADDRESS CHECK
IFN FTXMON,<
EXCH T1,T2 ;SAVE AND GET OLD PCS
PUSHJ P,STPCS## ;MAKE SURE PCS IS RIGHT
MOVE T1,T2 ;GET PID IN T1
> ;END OF IFN FTXMON
IPCFM1: SKIPN T1 ;WAS ONE GIVEN?
MOVE T1,.CPJCH## ;NO, SPECIFY THE USER
MOVE P2,T1 ;SAVE THE IN-YOUR-BEHALF PID
PUSHJ P,VALPID ;IS IT VALID AT ALL?
JRST ERRISX ;NO, INVALID SENDER
JUMPE J,ERRPIX ;NOT ALLOWED ON BEHALF OF EXEC PROCESS
JUMPL P4,IPCFM2 ;DON'T TEST PRIVS TWICE
.CREF IP.CMP ; (SHOW BIT TESTED)
MOVE T2,J ;COPY JCH OF PID
MOVE J,.CPJOB## ;FOR PRIV TEST
MOVSI T1,JP.IPC ;PRIV BIT NEEDED
CAME T2,.CPJCH## ;IF USER'S OWN JCH,
PUSHJ P,PRVBIT## ;OR HAS PRIVS,
CAIA ;PRIV'ED OR NONE NEEDED
JRST ERRPIX ;PRIVILEGES INSUFFICIENT
MOVE J,T2 ;RESTORE JCH
IPCFM2: MOVE T1,P1 ;COPY PSEUDO-PACKET ADDRESS
PUSHJ P,SXPCS## ;SETUP PCS FOR FETCHING
JRST ERRACX ;ADDRESS CHECK IF CAN'T
MOVE M,P1 ;FOR FETCHING
PUSHJ P,GETEWD## ;GET WORD CONTAINING LENGTH
JRST ERRACX ;ADDRESS CHECK
HLRZ T2,T1 ;ISOLATE LENGTH
CAILE T2,776 ;IN POSSIBLE RANGE?
JRST ERRTLX ;NO, PACKET TOO LONG
JUMPE T2,ERRNLX ;ZERO IS NOT LONG ENOUGH
MOVE P3,T2 ;PRESERVE BUFFER LENGTH
MOVE T1,M ;GET SOURCE POINTER
PUSHJ P,ARNGE## ;RANGE-CHECK THE ARGUMENTS
TRN ;NON-EXISTANT AND ILLEGAL FOR I/O ARE BOTH BAD
JRST ERRACX ;ADDRESS CHECK
LDB T2,DESTP4 ;GET DESTINATION CODE
CAIE T2,1 ;IPCC?
JRST IPCFM3 ;NO, GO TEST FOR INFO
MOVEI T2,.IPCFD(P3) ;YES, GET TOTAL EXEC PACKET LENGTH
PUSHJ P,GETWDS## ;ALLOCATE THE PACKET
JRST ERRRYX ;NO SPACE IN EXEC FOR PACKET
MOVEM J,.IPCFC(T1) ;SAVE EFFECTIVE SENDER'S ID
MOVEI T3,.IPCFD(T1) ;DESTINATION OF BLT
JRST IPCFM4 ;JOIN COMMON CODE
IPCFM3: CAILE P3,776-6 ;CHECK LENGTH AGAINST GALAXY AND INFO OVERHEAD
JRST ERRTLX ;TOO LONG FOR INFO
CAIE T2,2 ;[SYSTEM]INFO?
MOVEI M,.EPIPI(W) ;NO, GET [LOCAL]INFO
CAIN T2,0 ;IF DEFAULT INFO
SKIPE (M) ;AND NO [LOCAL]INFO
CAIN T2,2 ;OR IF [SYSTEM]INFO
MOVEI M,%SIINF## ;GET [SYSTEM]INFO'S PID
SKIPN (M) ;IS INFO RUNNING?
JRST ERRDUX ;NO, DESTINATION UNKNOWN
MOVEI T2,6(P3) ;GET SIZE NEEDED FOR GOPHER MESSAGE
PUSHJ P,GTFWDC## ;OBTAIN SOME FREE SPACE
JRST ERRRYX ;NO SPACE IN EXEC FOR PACKET
MOVEI T3,6(T1) ;DESTINATION OF BLT
;JOIN COMMON CODE
IPCFM4: MOVE T4,P2 ;COPY USER'S SENDER ID
MOVE P2,T1 ;COPY PACKET ADDRESS
XSFM T2 ;GET PCS
HRLZS T2 ;WHERE IT BELONGS
HRR T2,P1 ;USER SOURCE OF PACKET
MOVEI T1,(P3) ;GET LENGTH
MOVE P1,T2 ;KEEP A COPY OF THE GLOBAL ADDRESS
XBLTUX T1 ;COPY INTO EXEC PACKET
LDB T1,DESTP4 ;GET DESTINATION CODE AGAIN
CAIE T1,1 ;IS IT FOR [SYSTEM]IPCC?
JRST IPCFM5 ;NO, GO HANDLE GOPHER-TO-INFO
MOVS M,.USMUO ;RESTORE UUO AC NOW THAT FETCHING DONE
SETZM .IPCFI(P2) ;CLEAR DISK FLAG (NOT PAGED PACKET)
DPB P3,PKLNP2 ;STORE DATA LENGTH
MOVEM T4,.IPCFS(P2) ;STORE SENDER'S ID
SETZM .IPCFL(P2) ;CLEAR LINK AND FLAGS
MOVE T1,PIDTAB## ;GET PID OF [SYSTEM]IPCC
MOVEM T1,.IPCFR(P2) ;SET AS RECEIVER
MOVEI T1,IP.SIP ;SENDER IS PRIVILEGED
TLNE P4,IP.CMP ;WANT TO INVOKE PRIVS?
MOVEM T1,.IPCFL(P2) ;YES, SET THE FLAG
PUSH P,P1 ;SAVE USER'S PACKET ADDRESS
MOVE P1,P2 ;MOVE PACKET FOR [SYSTEM]IPCC
PUSHJ P,IPCFPD ;DISPATCH [SYSTEM]IPCC FUNCTION
SKIPA P2,T1 ;PRESERVE ERROR CODE
SETZ P2, ;OR LACK OF ONE
LDB T1,PKLNP1 ;GET PACKET LENGTH
MOVEI T2,.IPCFD(P1) ;EXEC DATA SOURCE
POP P,T3 ;USER DATA DESTINATION
XBLTXU T1 ;COPY BACK TO USER
LDB T1,PKLNP1 ;GET LENGTH AGAIN
ADDI T1,.IPCFD ;ACCOUNT FOR OVERHEAD
MOVEI T2,(P1) ;PACKET ADDRESS
PUSHJ P,GIVWDS## ;RETURN FREECORE
SKIPE T1,P2 ;SEE IF ERROR CODE GIVEN
JRST STOTAC## ;YES, PROPAGATE ERROR TO USER
JRST CPOPJ1## ;ALSO SUCCESSES
;HERE FOR GOPHER SENDS TO INFO
IPCFM5: HRRZ T1,6(P2) ;GET USER'S FUNCTION
HRLI T1,1(P3) ;AND LENGTH OF THIS SUB-BLOCK
MOVEM T1,5(P2) ;STORE IT WHERE INFO EXPECTS IT
MOVEM T4,6(P2) ;PUT IYB WORD HERE FOR INFO
MOVSI T1,6(P3) ;GET LENGTH OF OUR PACKET
HRRI T1,.IPCIG ;AND OUR FUNCTION
MOVEM T1,QUELNH(P2) ;PUT LENGTH,,GALAXY FUNCTION IN GALAXY HEADER
MOVSI T1,(1B0) ;REQUEST AN ACK
MOVEM T1,QUEFLG(P2) ;IN GALAXY MESSAGE
MOVE T1,.CPJCH## ;WHAT JOB IS DOING THIS
HRL T1,%CNIPS## ;SEQUENCE NUMBER
MOVEM T1,QUEJOB(P2) ;SAVE AS ACK CODE
SETZM QUEMBZ(P2) ;NO USE FOR .OFLAGS
MOVEI T1,1 ;OUR TOTAL ARG COUNT
MOVEM T1,QUEARC(P2) ;SET IN GALACTIC HEADER
MOVE T1,T4 ;GET IYB VALUE AGAIN
PUSHJ P,VALPID ;OBTAIN ITS JCH
MOVE J,.CPJCH## ;ASSUME IT'S OURS IF IT WENT AWAY
MOVE T4,J ;COPY
ANDI T4,JOBMSK## ;KEEP ONLY JOB PORTION
MOVE T4,JBTPPN##(T4) ;GET PPN OF ASSOCIATED JOB
MOVE J,.CPJOB## ;GET OUR JOB BACK AGAIN
PUSHJ P,FNDPDS## ;AND OUR PDB
HLRZ T1,QUEJOB(P2) ;GET THE SEQUENCE NUMBER WE USED
HRRM T1,.PDQSN##(W) ;SAVE FOR RESPONSE VALIDATION
MOVE T3,%SIGFR## ;GET PID OF [SYSTEM]GOPHER
MOVE T2,P2 ;COPY PACKET ADDRESS
HRLI T2,6(P3) ;SET XWD LENGTH,ADDRESS
MOVE T1,M ;COPY PID ADDRESS
MOVS M,.USMUO ;NOW RESTORE UUO AC FOR ERROR RETURNS
HRLI T1,40 ;FROM [SYSTEM]GOPHER
TLNE P4,IP.CMP ;PRIV'ED PACKET DESIRED?
TLO T1,IP.SIP ;YES, LIGHT PRIV BIT
PUSHJ P,SENDSP ;SEND FROM GOPHER TO INFO, AND BACK AGAIN
JRST [MOVEI T1,IPCCF% ;IPCC REQUEST FROM INFO FAILURE
PJRST STOTAC] ;RETURN THIS ERROR
HLRZ P2,.PDEPA##(W) ;BY NOW WE HAVE OUR OWN PDB IN W
LDB T1,RTNER2 ;GET ERROR CODE RETURNED (IF ANY)
SKIPN T1 ;IF NONE,
AOS (P) ;THEN WILL EVENTUALLY SKIP RETURN
SKIPE T1 ;ELSE,
PUSHJ P,STOTAC## ;SET THE ERROR CODE TO RETURN
HLRZ T1,.IPCFD+5(P2) ;GET LENGTH RETURNED BY INFO
CAILE T1,(P3) ;WILL DATA FIT IN USER'S BUFFER?
MOVEI T1,(P3) ;NO, ONLY COPY AS MUCH AS WILL FIT
SUBI T1,1 ;WE DON'T TRANSFER THE FUNCTION WORD
AOS T3,P1 ;GET USER DESTINATION ADDRESS
MOVEI T2,.IPCFD+6(P2) ;AND MONITOR SOURCE ADDRESS
XBLTXU T1 ;COPY ANSWER FOR THE USER
LDB T1,PKLNP2 ;GET LENGTH OF PACKET
ADDI T1,.IPCFD ;ACCOUNT FOR OVERHEAD WORDS
MOVE T2,P2 ;COPY ADDRESS
PJRST GIVWDS## ;GIVE BACK EXEC CORE AND RETURN FROM UUO
SUBTTL [SYSTEM]IPCF - THE EXEC PROCESS
IPCFPR::PUSHJ P,SAVE3##
IFN FTMP,<
PUSHJ P,ONCPU0## ;ONLY ONE CPU AT A TIME
>
IPCF1: TLO M,FLMCOM ;SET SO ERR WONT CALL STOTAC
PUSHJ P,GETPAK ;GET OLDEST PACKET
POPJ P, ;NONE, EXIT.
HRRZ P1,T1 ;PACKET ADDRESS
MOVE T1,.IPCFL(P1) ;GET FLAGS
TRNE T1,1 ;TURNED-AROUND MSG?
JRST IPCF3 ;YES, JOB MUST HAVE LOGGED OUT
PUSHJ P,IPCFPD ;DISPATCH THE FUNCTION
JFCL ;ERROR ALREADY STORED IN PACKET HEADER
PUSHJ P,DECSSW ;DECREMENT SENDER'S COUNTS
;IN ORDER FOR THE JOB TO RECEIVE THE MSG IT MUST BE ENABLED
;ANSWER WILL THUS ENABLE THE JOB. IN ORDER TO PREVENT THIS
;BIT 0 OF P1 MUST BE LIT BY THE SUBROUTINE (DISABLE FUNCTION)
PUSHJ P,ANSWER ;TURN PACKET AROUND TO USER
JRST IPCF1 ;AND CHECK FOR ANOTHER.
IPCF3: PUSHJ P,NXTPAK ;MAKE NEXT PACKET THE OLDEST
SOS .EPIPC(W) ;FIX UP THE COUNTS
PUSH P,W
LDB T1,TRNPTR ;SENDER JOB NO
PUSHJ P,VALPID ;SET W
JRST IPCF4 ;OOPS, HE REALLY IS GONE
PUSHJ P,DECSNX ;DECREMENT PACKETS SENT BUT NOT RECEIVED
IPCF4: POP P,W
PUSHJ P,REMPAK ;GET RID OF THIS PACKET
JRST IPCF1 ;AND GO LOOK AT NEXT PACKET
;HERE TO DISPATCH [SYSTEM]IPCC FUNCTIONS
IPCFPD: HRRE T4,.IPCFD(P1) ;PICK UP CODE (WORD 0)
CAML T4,[IPCFCF] ;A CUSTOMER DEFINED FUNCTION?
CAILE T4,IPCFM ;VALID?
SKIPA T4,BADCOD ;NO, SET FOR ERROR
MOVE T4,BADCOD(T4) ;YES, GET DISPATCH ADR
MOVE T1,.IPCFS(P1) ;SENDER
LDB T2,PKLNP1 ;LENGTH
MOVE T3,.IPCFL(P1) ;FLAGS
PUSH P,W ;PRESERVE W
TRNE T3,IP.CFV ;PAGE?
JRST MODERR ;MODE ERROR (IPCC ONLY TAKES PACKETS)
TRNN T3,IP.SIP ;JOB HAVE PRIV'S?
JUMPL T4,PRVERR ;NO, ERROR IF FUNCTION REQUIRES PRIVS
LDB P2,[POINT 3,T4,17] ;GET NEEDED LENGTH OF UUO BLOCK
CAIGE T2,(P2) ;UUO BLOCK LONG ENOUGH?
JRST SHRTER ;NO, ERROR
HRRZS T4 ;CLEAR USED-UP JUNK
PUSHJ P,(T4) ;DISPATCH
JRST IPFD2 ;STORE ERROR IN HEADER
JRST WPOPJ1## ;RESTORE W AND RETURN SUCCESS
;DISPATCH ERRORS -
MODERR: MOVEI T1,IPCPR%
JRST IPFD2 ;SET BAD ERROR CODE
SHRTER: SKIPA T1,[IPCNL%] ;UUO BLOCK NOT LONG ENOUGH
PRVERR: MOVEI T1,IPCPI% ;PRIV'S INSUFFICIENT
IPFD2: DPB T1,RTNERR ;BAD - STORE ERROR CODE IN FLAG WORD
JRST WPOPJ## ;RESTORE W AND RETURN ERROR
;SUBROUTINE TO GET POINTER TO PACKET INTO T1.
GETPAK: HLRZ T1,.EPIPC(W) ;POINTER OR ZERO
JUMPE T1,CPOPJ## ;NONE.
JRST CPOPJ1## ;HAVE ONE - SKIP RETURN
;SUBROUTINE TO DECREMENT COUNT OF PACKETS SENT BUT NOT RECEIVED
DECSND: MOVE T1,.IPCFS(P1) ;SENDERS PID
PUSHJ P,VALPID ;GET W
POPJ P, ;SHOULDN'T HAPPEN
DECSNX: MOVNI T1,IP.SBT ;BYTE-ALIGNED MINUS ONE
MOVE T2,.EPIPC(W) ;OUTSTANDING SEND COUNT, ETC.
TRNE T2,777000 ;COUNT NON-ZERO?
ADDM T1,.EPIPC(W) ;DECREMENT
POPJ P, ;RETURN
DECSSW: PUSH P,W
PUSHJ P,DECSND
JRST WPOPJ##
;SUBROUTINE TO MAKE NEXT PACKET THE OLDEST
NXTPAK: SYSPIF
HLRZ T1,.IPCFL(P1) ;NEXT PACKET
HRLM T1,.EPIPC(W) ; IS NOW THE OLDEST
SKIPN T1 ;EMPTY QUEUE?
SETZM .EPIPN(W) ;YES, CLEAR END POINTER
JRST ONPOPJ## ; AND RETURN
;DISPATCH TABLE FOR [SYSTEM]IPCF
;EACH SUBROUTINE IS CALLED WITH P1 POINTING TO THE PACKET
; IN EXEC STORAGE
;P2-P4 ARE AVAILABLE FOR USE
;T1=PID OF SENDER T2=LENGTH OF DATA T3=FLAGS
;W AND J ARE SET UP FOR RECEIVER, BUT MAY BE CHANGED
IPCFTL: ;ADD CUSTOMER DEFINED FUNCTIONS HERE
BADCOD: EXP ERRUF ;(BAD CODE) - UNKNOWN FNCTN
IPCFTB: XWD 000000,ENABL ;(01) ENABLE
XWD 000000,DISAB ;(02) DISABLE
XWD 000003,WHOIS ;(03) TELL PID OF [SYSTEM]INFO
XWD 400003,MKINFO ;(04) MAKE [SYSTEM]INFO
XWD 000002,DESTRY ;(05) DESTROY A PID
XWD 000003,CREATE ;(06) CREATE A PID
XWD 400003,QUOTA ;(07) SET QUOTA
XWD 400003,OWNER ;(10) CHANGE OWNERSHIP OF A PID
XWD 000003,JOBNO ;(11) FIND JOB NUBER FOR A PID
XWD 000004,RDPIDS ;(12) FIND PID(S) FOR A JOB
XWD 000003,RDQTA ;(13) FIND QUOTA FOR A JOB
XWD 400002,CPOPJ1## ;(14) WAKE UP JOB HIB'ING FROM RESET
IPCFRF: EXP ERRUF ;(15) SENT BY IPCF ON RESET
XWD 400003,SPQTA ;(16) SET PID QUOTA
XWD 000003,RPQTA ;(17) READ PID QUOTA
EXP ERRUF ;(20)
EXP ERRUF ;(21)
EXP ERRUF ;(22)
XWD 000003,SIDFND ;(23) FIND IN SYSTEM PID TABLE
XWD 400003,SIDSET ;(24) SET SYSTEM PID TABLE
XWD 000003,SIDRD ;(25) READ SYSTEM PID TABLE
IPCFSM: EXP ERRUF ;(26) SPOOL MSG SENT "TO" QUASAR
IPCFLM: EXP ERRUF ;(27) LOGOUT MESSAGE SENT "TO" QUASAR
IPCFTM: EXP ERRUF ;(30) TAPE LABELING MESSAGE
IPCFUO: EXP ERRUF ;(31) MOUNTABLE UNIT ON-LINE
IPCFON: EXP ERRUF ;(32) LOGON MESSAGE SENT "TO" QUASAR
EXP ERRUF ;(33) ACCOUNTING MESSAGES
IPCFDE: EXP ERRUF ;(34) MDA CONTROLLED DEVICE DEASSIGNED OR RELEASED
IPCFME: EXP ERRUF ;(35) MOS MEMORY ERROR TO TGHA
IPCFCS: EXP ERRUF ;(36) CSHIFT MESSAGE TO ACTDAE (OBSOLETE)
IPCFRL: EXP ERRUF ;(37) RESET OF T/S JOB WITH LOCKED STR. TO MDA
IPCFGM: EXP ERRUF ;(40) QUEUE. UUO FUNCTION TO A GALAXY COMPONENT
IPCFSC: EXP ERRUF ;(41) SEARCH LIST CHANGE TO MDA
IPCFAT: EXP ERRUF ;(42) PRIMARY PORT ATTACH (TO MDA)
IPCFDT: EXP ERRUF ;(43) PRIMARY PORT DETACH (TO MDA)
IPCFXC: EXP ERRUF ;(44) DISK UNIT EXCHANGE (TO MDA)
IPCFRM: EXP ERRUF ;(45) STRUCTURE REMOVAL (TO MDA)
IPCFMT: EXP ERRUF ;(46) MAGTAPE UNIT ACCESSIBLE (TO MDA)
IPCFST: EXP ERRUF ;(47) STRUCTURE MOUNT (TO MDA)
INFMSG: EXP ERRUF ;(50) [SYSTEM]INFO REQUEST VIA GOPHER
IPCSCM: EXP ERRUF ;(51) SCHEDULE BITS CHANGE MSG "TO" QUASAR
.IPCTL==:IPCFTM-IPCFTB+1
.IPCUO==IPCFUO-IPCFTB+1
.IPCDE==:IPCFDE-IPCFTB+1
.IPCME==:IPCFME-IPCFTB+1
.IPCRL==:IPCFRL-IPCFTB+1 ;MESSAGE # FOR MDA RESET
.IPCGM==:IPCFGM-IPCFTB+1
.IPCSC==:IPCFSC-IPCFTB+1
.IPCAT==IPCFAT-IPCFTB+1
.IPCDT==IPCFDT-IPCFTB+1
.IPCXC==IPCFXC-IPCFTB+1
.IPCRM==IPCFRM-IPCFTB+1
.IPCMT==IPCFMT-IPCFTB+1
.IPCST==IPCFST-IPCFTB+1
.IPCIG==INFMSG-IPCFTB+1
IPCFM==.-IPCFTB ;LENGTH OF TABLE
IPCFCF==IPCFTL-BADCOD ;MOST NEGATIVE CUSTOMER FUNCTION
;SUBROUTINE TO GIVE ANSWER TO AN EXEC CALL
ANSWER: MOVEI T2,1
REPEAT 0,< ;NOT NEEDED TILL OTHER EXEC PROCESSES EXIST
CAMN T1,PIDTAB## ;SENDER = [SYSTEM]IPCF?
>
;ENTER HERE TO INDICATE MESSAGE SENT BY OTHER THAN IPCC (SENDER'S CODE IN T2)
ANSWE1: MOVE T1,.IPCFR(P1) ;SWITCH SENDER & RECEIVER
DPB T2,[POINT 3,.IPCFL(P1),32] ;TELL REC'R THAT MSG IS FROM IPCF
EXCH T1,.IPCFS(P1)
MOVEM T1,.IPCFR(P1)
MOVE T1,.IPCFL(P1) ;IF A WHOLE PAGE PASSED,
TRNE T1,IP.CFV ; DON'T CLEAR ITS ADDRESS
JRST ANSWE2
MOVSI T1,(IP.NAD) ;CLEAR ADDRESS
ANDM T1,.IPCFI(P1)
ANSWE2: PUSHJ P,NXTPAK ;MAKE PACKET THE OLDEST
SETZM .IPCFC(P1) ;CLEAR FLAG WRDS ON SEND FROM
SETZM .IPCFU(P1) ; AN EXEC PROCESS
PUSHJ P,SNDMSG ;RETURN PACKET TO SENDER OF ORIGINAL MSG
PUSHJ P,REMPAK ;COULDNT DO IT - REMOVE THE PACKET
SOS .EPIPC(W)
AOS T1,.EPIPA(W) ;COUNT OF RECEIVES SINCE LOGIN
TRNN T1,-1 ;OVERFLOW?
SOS .EPIPA(W) ;YES, SET IT BACK
POPJ P, ;AND RETURN TO CALLER
;SUBROUTINE TO REMOVE THE OLDEST PACKET.
REMPAK::SE1ENT ;ENTER SECTION 1
HRRZ T2,P1 ;ADR OF PACKET TO REMOVE
SOS %CNIIP## ;DEC COUNT OF OUTSTANDING PACKETS
LDB T1,PKLNT2 ;LENGTH OF DATA
IFN FTMP,<
PUSHJ P,UPMM## ;NEED MM IN CASE PAGE
>
PUSH P,.IPCFI(P1) ;SAVE POSSIBLE PAGE #+BITS
MOVEI T3,IP.CFV ;PAGED PACKET?
TDNE T3,.IPCFL(P1) ;?
TDZA T1,T1 ;YES, NO DATA
SETZM (P) ;IF PACKET, NO PAGE TO RETURN
ADDI T1,.IPCFD ;PLUS OVERHEAD
PUSHJ P,GIVWDS## ;RETURN THE PACKET (OR HEADER)
POP P,T2 ;RESTORE ADDRESS OR NOTHING
IFN FTMP,<
JUMPE T2,DWNMM## ;RETURN THE MM
>
IFE FTMP,<
JUMPE T2,CPOPJ## ;NOTHING TO RETURN IF PAGING I/O ERROR
>
PUSH P,W ;SAVE W
PUSHJ P,IPCDEL## ;DELETE PAGE
IFN FTMP,<
PUSHJ P,DWNMM##
>
JRST WPOPJ## ;RESTORE W AND RETURN
;SUBROUTINE TO SEND A PACKET. ADDRESS OF UUO ARGS AND PACKET
; DATA IN P1. SOURCE MUST BE AN EXEC PROCESS, TARGET
; MAY BE EITHER EXEC OR USER. TARGET MUST BE USER
; IF AT INTERRUPT LEVEL. SKIP RETURN ON OK,
; NON-SKIP RETURN HAS T1=ERROR CODE.
SNDMSG: PUSHJ P,SAVE3## ;SAVE P2 AND 3
MOVE P2,J ;SAVE J
MOVE P3,W ;SAVE W
MOVE T1,.IPCFR(P1) ;CHECK RECEIVER
PUSHJ P,VALPID ;SET UP J AND W
JRST SNDERR ;DESTINATION UNKNOWN
MOVSI T1,IP.DSB ;SET TO ENABLE RECEIVER
TLNN P1,400000 ;UNLESS BIT 0 ON IN P1
ANDCAM T1,.EPIPQ(W) ;HE IS NOW ENABLED
LDB T1,RCQTA ;RECEIVE QUOTA
LDB T2,RCCNT ;RECEIVE COUNT
CAMG T1,T2 ;ROOM LEFT?
JRST SNDERR
AOS .EPIPC(W) ;INCR COUNT OF REC'D MSGS
;COME HERE TO PUT THE MESSAGE ON THE RECEIVER'S LIST
SYSPIF ;NO INTERRUPT HERE
SKIPN T2,.EPIPN(W) ;END OF QUEUE
XMOVEI T2,.EPIPC-.IPCFL(W) ;EMPTY
HRRM P1,.EPIPN(W) ;NEW END OF QUEUE
HRLM P1,.IPCFL(T2) ;SAVE THIS PACKET ON END OF QUEUE
HRRZS .IPCFL(P1) ;ZERO LINK OF THE PACKET
SYSPIN ;ALLOW INTERRUPTS AGAIN
;COME HERE AFTER PUTTING PACKET ON LIST. UPDATE COUNTERS.
PUSH P,W ;NEEDED LATER IF EXEC PROCESS
PUSH P,J ;SAVE FROM DESTRUCTION
MOVE T1,.IPCFS(P1) ;GET SENDER'S PID
PUSHJ P,VALPID ;SET UP W
JFCL ;CAN'T FAIL 'CAUSE ALREADY VERIFIED
POP P,J ;RESTORE J
HRRZ T1,.EPIPC(W) ;INCREMENT COUNT OF MSGS SENT
ADDI T1,IP.SBT
MOVEI T2,IP.SBT
TLNN T1,-1
ADDM T2,.EPIPC(W) ;MUST USE ADDM TO AVOID SMP RACE
HLRZ T1,.EPIPA(W) ;COUNT OF SENDS
ADDI T1,1 ;INCREMENT IT
TRNE T1,-1 ;OVERFLOW?
HRLM T1,.EPIPA(W) ;NO, STORE INCREMENTED COUNT
POP P,W ;RESTORE POSSIBLE EXEC PROCESS BLOCK
JUMPN J,SND3 ;IS DEST A USER JOB?
PUSHJ P,@.EPADR(W) ;NO, GO RUN EXEC PROCESS.
JRST SND4 ;RETURN TO MAIN LINE.
;COME HERE TO AWAKEN A USER'S JOB.
SND3: PUSHJ P,WAKEUP
SND4: AOS %CNIPS## ;INC TOTAL PACKETS SENT
AOS (P) ;SKIP RETURN
JRST SNDER1 ;RESTORE AC'S
;HERE ON A SEND ERROR
SNDERR: HRRZ T1,.IPCFD(P1) ;CODE
CAIE T1,6 ;CREATE A PID?
JRST SNDER1 ;NO
MOVE T2,.IPCFL(P1) ;FLAGS WORD
TRNE T2,IP.CFE ;IF NO ERROR ON CREATING THE PID,
JRST SNDER1
MOVE T1,.IPCFD+2(P1) ;GET RID OF IT
AND T1,%IPCPM## ;INDEX INTO TABLE
SETZM PIDTAB##(T1)
SOS %IPCNP## ;DECR CURRENT # OF PIDS
SNDER1: MOVE W,P3 ;RESTORE W
MOVE J,P2 ;RESTORE J
POPJ P,0 ;RETURN
;ENABLE THE OWNER OF THE PID IN WORD 1, OR THE SENDER IF WORD
; 1 IS NOT PROVIDED. USE OF WORD 1 IS A PRIV. FUNCTION.
ENABL: CAIGE T2,2 ;WORD 1 SUPPLIED?
JRST CPOPJ1## ;NO, SENDER IS AUTOMATICALLY ENABLED
TRNN T3,IP.SIP ;NO, PRIV'D?
PJRST ERRPI ;NO, ERROR
MOVE T1,.IPCFD+1(P1) ;YES, GET PID SUPPLIED
ENABL1: PUSHJ P,VALPID ;SET UP J AND W.
POPJ P, ;BAD PID, FLUSH
MOVSI T1,IP.DSB ;CLEAR JOB'S DISABLE BIT
ANDCAM T1,.EPIPQ(W)
JRST CPOPJ1## ;AND GOOD RETURN
;DISABLE THE OWNER OF THE PID IN WORD 1, OR SENDER IF NO WORD 1.
; USE OF WORD 1 IS A PRIV. FUNCTION.
DISAB: TRNE T3,IP.SIP ;PRIV'D?
CAIGE T2,2 ;YES, WORD 1 SUPPLIED?
TLOA P1,400000 ;NO, USE SENDER (ALREADY IN T1), DONT ENABLE HIM
MOVE T1,.IPCFD+1(P1) ;YES, GET PID SUPPLIED
CAIL T2,2 ;TRYING TO DISABLE ANOTHER JOB?
JUMPL P1,ERRPI ;YES, ERR IF NOT PRIV'D
PUSHJ P,VALPID ;SET UP J AND W
POPJ P, ;WRONG, FLUSH
JUMPE J,ERRPI ;DON'T ALLOW DISABLING AN EXEC PSEUDO PROCESS
MOVSI T1,IP.DSB ;SET JOB'S DISABLE BIT
IORM T1,.EPIPQ(W)
JRST CPOPJ1## ;GOOD RETURN
;MAKE A [SYSTEM]INFO. ARG IS NOT CHECKED SINCE IT MAY BE
; DELIBERATELY INVALID (I.E., 0) TO TERMINATE A LOCAL
; [SYSTEM]INFO OR TO INDICATE THAT THE REAL [SYSTEM]INFO IS LOGGING
; OUT.
MKINFO: SKIPN T1,.IPCFD+2(P1) ;USER OR SYS?
JRST MKINF2 ;SYS.
PUSHJ P,VALPID ;SET UP J AND W FOR TARGET
POPJ P, ;NONE SUCH, FLUSH
JUMPE J,CPOPJ## ;NOT VALID FOR EXEC PROCESSES
SKIPN %SIINF## ;IF NO GLOBAL OR LOCAL [SYSTEM]INFO
SKIPE .EPIPI(W) ; IS RUNNING THEN MAKING A LOCAL IS OK
SKIPA T1,.IPCFS(P1) ;IF SENDER CHECKS OUT
JRST MKINF1 ;NONE RUNNING NOW - OK
CAME T1,%SIINF## ;IS SENDER GLOBAL [SYSTEM]INFO?
CAMN T1,.EPIPI(W) ; OR LOCAL [SYSTEM]INFO?
MKINF1: SKIPA T2,.IPCFD+1(P1) ;YES, GET PID TO BECOME THE LOCAL [SYSTEM]INFO
JRST ERRPI ;NO, ERROR RETURN
MOVEM T2,.EPIPI(W) ;STORE WITHOUT CHECKING
JRST CPOPJ1## ;GOOD RETURN
;COME HERE TO MAKE SYSTEM'S [SYSTEM]INFO
MKINF2: MOVE T1,.IPCFD+1(P1) ;THE PID
MOVEM T1,.IPCFD+2(P1) ;MOVE IT OVER
MOVEI T1,1 ;SYSID INDEX
MOVEM T1,.IPCFD+1(P1) ;INTO BLOCK
PJRST SIDSET ;USE COMMON CODE
;SEND MESSAGE IDENTIFYING [SYSTEM]INFO
WHOIS: SKIPN T1,.IPCFD+1(P1) ;YES, GET JOB NO WHOSE INFO IS WANTED
MOVE T1,.IPCFS(P1) ;NO, TELL HIM HIS OWN [SYSTEM]INFO
PUSHJ P,VALPID ;LOAD J AND W
POPJ P, ;BAD PACKET
SKIPE J ;EXEC PROCESS HAS NO PDB
SKIPN T2,.EPIPI(W) ;PID OF [SYSTEM]INFO
MOVE T2,%SIINF## ;EXEC OR NO LOCAL SPECIFIED
MOVEM T2,.IPCFD+2(P1) ;THE ONE WORD OF DATA
JRST CPOPJ1## ;GOOD RETURN
;CREATE A PID. WORD 1 HAS JOB NUMBER, BIT 0=1 IF DROP PID ON RESET
CREATE: PUSHJ P,SAVJW## ;SAVE J AND W
MOVE T1,.IPCFD+1(P1) ;USER ARG
TLZ T1,400000 ;REMOTE TYPE FLAG
JUMPE T1,ERRBJ
TLNE T1,377777 ;ONLY SIGN BIT IS GOOD
JRST ERRBJ ;BAD ARGS
PUSHJ P,CTXIPC## ;POINT TO IPCF DATA BASE
JRST ERRBJ ;NO SUCH JOB OR CONTEXT
HRRM J,.IPCFD+1(P1) ;UPDATE CONTEXT NUMBER (MAYBE 0 WAS GIVEN)
TRNE T3,IP.SIP ;PRIVILEGED PACKET?
JRST CREAT3 ;YES, DON'T CHECK PID QUOTA
HRRZ T3,.IPCFC(P1) ;NO, GET SENDER'S JCH
CAME T3,J ;ATTEMPTING TO AFFECT SOMEONE ELSE?
JRST ERRPI ;YES, GIVE PRIVILEGE ERROR
LDB T3,PQTAPT ;NO, GET PID QUOTA
JUMPE T3,CREAT2 ;QUOTA EXCEEDED
MOVSI T3,IP.DPL!IP.DPR;NO, GET PID-DEFINED FLAGS
TDNN T3,.EPIPQ(W) ;ANY PIDS DEFINED FOR THIS JOB?
JRST CREAT3 ;NO, IT FITS IN THE QUOTA THEN
CAML T3,%IPCMP## ;QUOTA MORE THAN POSSIBLE NUMBER OF PIDS?
JRST CREAT3 ;YES, CAN'T BE EXCEEDING QUOTA
MOVN P2,%IPCMP## ;SET AOBJN WORD TO SCAN TABLE
HRLZS P2
SETZ T1, ;CLEAR COUNT OF PIDS FOR THIS JCH
SKIPN T2,PIDTAB##(P2) ;FIND A SLOT IN USE
CREAT1: AOBJN P2,.-1 ;LOOP OVER ENTIRE TABLE
JUMPGE P2,CREAT3 ;WITHIN QUOTA
CAIE J,(T2) ;FOR THE SAME JCH?
JRST CREAT1 ;NO, KEEP LOOKING
ADDI T1,1 ;YES, COUNT ANOTHER IN USE
CAIGE T1,(T3) ;EXCEEDING QUOTA?
JRST CREAT1 ;NOT YET, KEEP LOOKING
CREAT2: MOVEI T1,IPCQP% ;YES, PID QUOTA EXCEEDED ERROR
POPJ P, ;RETURN FAILURE TO CALLER
CREAT3: MOVN P2,%IPCMP## ;SET AOBJN WORD TO SCAN TABLE
HRLZS P2
SKIPE PIDTAB##(P2) ;FIND AN EMPTY SLOT
AOBJN P2,.-1
JUMPGE P2,ERRPF ;ERROR IF TABLE FULL
AOS T2,%IPCTP## ;TOTAL # OF PIDS SINCE RELOAD
HRLZS T2 ;LH=UNIQ #, RH=JOB/CONTEXT HANDLE
IOR T2,.IPCFD+1(P1) ;ADD JOB NO, (BIT 0 IF DROP ON RESET)
MOVEM T2,PIDTAB##(P2)
TRZ T2,JOBMSK## ;REMOVE JOB NUMBER
IORI T2,(P2) ;INSERT INDEX INTO TABLE FOR PID AS TOLD
MOVEM T2,.IPCFD+2(P1) ; TO USER ("PUBLIC" PID)
MOVSI T3,IP.DPR
SKIPL T2 ;DROP PID ON RESET?
MOVSI T3,IP.DPL ;NO, DROP ON LOGOUT
IORM T3,.EPIPQ(W) ;REMEMBER THAT FACT
AOS %IPCNP## ;INCR CURRENT # OF PIDS
JRST CPOPJ1## ;AND GOOD RETURN
;FIND JOB NUMBER ASSOCIATED WITH A PID
JOBNO: MOVE T1,.IPCFD+1(P1) ;PID
PUSHJ P,VALPID ;LEGAL?
PJRST ERRBJ ;NO
MOVEM J,.IPCFD+2(P1) ;YES, RETURN JOB NO TO CALLER
JRST CPOPJ1## ;AND TAKE GOOD RETURN
;TELL QUOTA FOR A JOB
RDQTA: MOVE T1,.IPCFD+1(P1) ;JOB NUMBER (OR SOME PID FOR JOB)
PUSHJ P,VALPID ;LEGAL?
PJRST ERRBJ ;NO
MOVE T1,.EPIPQ(W) ;YES, GET QUOTA
HRRZM T1,.IPCFD+2(P1) ;SAVE IN PACKET
JRST CPOPJ1## ;AND GOOD RETURN
;SET QUOTA FOR PID IN WORD 2.
QUOTA: MOVE T1,.IPCFD+1(P1) ;PICK UP JOB NUMBER
PUSHJ P,VALPID ;SET UP J + W
PJRST ERRBJ ;ERROR, FLUSH
MOVE T2,.IPCFD+2(P1) ;GET QUOTA WORD
HRRM T2,.EPIPQ(W) ;STORE AS NEW QUOTA
JRST CPOPJ1## ;GOOD RETURN
;READ PID QUOTA FOR PID IN WORD 2
RPQTA: MOVE T1,.IPCFD+1(P1) ;PICK UP JCH
PUSHJ P,VALPID ;SET UP J & W
JRST ERRBJ ;ERROR, FLUSH
LDB T2,PQTAPT ;GET PID QUOTA
MOVEM T2,.IPCFD+2(P1) ;STORE IN ANSWER
JRST CPOPJ1## ;GOOD RETURN
;SET PID QUOTA FOR PID IN WORD 2
SPQTA: MOVE T1,.IPCFD+1(P1) ;PICK UP JCH
PUSHJ P,VALPID ;SET UP J & W
JRST ERRBJ ;ERROR, FLUSH
MOVE T2,.IPCFD+2(P1) ;GET QUOTA WORD
DPB T2,PQTAPT ;STORE IT
JRST CPOPJ1## ;GOOD RETURN
;TELL PID(S) ASSOCIATED WITH A JOB
RDPIDS: MOVEI P2,-2(T2) ;NUMBER OF VALUES TO RETURN
SKIPLE T1,.IPCFD+1(P1) ;DESIRED JOB NUMBER
PUSHJ P,CTXIPC## ;MAKE SURE IT HAS IPCF DATA
JRST ERRBJ ;BAD JOB NUMBER
SKIPN T1,.IPCFD+2(P1) ;STARTING PID
JRST RDPID1 ;START AT BEGINNING OF TABLE
PUSHJ P,VALPID ;CHECK IT OUT
PJRST ERRDU ;CANT START AT AN ILLEGAL PID
MOVE T1,.IPCFD+2(P1) ;OK, GET PID AGAIN
AND T1,%IPCPM## ;GET START INDEX INTO TABLE
RDPID1: MOVE T2,.IPCFD+1(P1) ;RETRIEVE DESIRED JOB/JCH
MOVNS P2
HRLZS P2 ;SET AN AOBJN WORD FOR STORING VALUES
HRR P2,P1
MOVN T3,%IPCMP## ;MAKE AN AOBJN WORD
HRLZS T3 ; FOR SCANNING PIDTAB
ADDI T1,1
HRLS T1
ADD T1,T3
RDPID2: SKIPN T3,PIDTAB##(T1) ;GET A PID
JRST RDPID3 ;LOOK FOR NEXT
TRNN T2,CTXMSK## ;MATCHING ON A JCH?
TRZ T3,CTXMSK## ;NO, CLEAR SO MATCH ONLY ON JOB NUMBER
ANDI T3,JCHMSK## ;JOB NUMBER OR JCH
CAIE T3,(T2) ;MATCH TARGET?
JRST RDPID3 ;NO
MOVE T3,PIDTAB##(T1) ;YES, GET FULL PID AGAIN
TRZ T3,JOBMSK## ;REMOVE JOB NO
IORI T3,(T1) ;ADD INDEX
MOVEM T3,.IPCFD+2(P2) ;SAVE IN PACKET
AOBJP P2,CPOPJ1## ;DONE IF NO MORE ROOM
RDPID3: AOBJN T1,RDPID2 ;SCAN WHOLE TABLE
SETZM .IPCFD+2(P2) ;TERMINATE WITH A 0
JRST CPOPJ1## ;AND TAKE GOOD RETURN
;DESTROY A PID.
DESTRY: MOVE T1,.IPCFD+1(P1) ;PID BEING DESTROYED
PUSHJ P,CHKSID ;SEE IF A SYSTEM PID
PJRST ERRPI ;YES, CAN'T DO THAT
PUSHJ P,VALPID ;VALIDATE IT
PJRST ERRBJ ;NO GOOD, FLUSH
MOVE P3,W ;OLD PDB LOC IN P3
MOVE P4,J ;OLD JCH
MOVE P2,.IPCFD+1(P1) ;PID
MOVE T1,.IPCFS(P1) ;SENDER
PUSHJ P,VALPID ;SET UP W
POPJ P, ;NO GOOD (SHOULD NEVER HAPPEN)
MOVE T1,.IPCFL(P1) ;GET FLAGS AGAIN
TRNN T1,IP.SIP ;PRIVILEGED JOB?
CAMN P4,J ;OR DOING IT TO HIS OWN PID?
TRNA ;YES, IT'S OK
JRST ERRPI ;NO, INSUFFICIENT PRIVILEGES
CAMN P2,.IPCFS(P1) ;SENDER DESTROYING HIS OWN PID?
MOVEM J,.IPCFS(P1) ;YES, SEND ANSWER BACK TO THE JOB NO.
MOVE T2,P2
AND T2,%IPCPM## ;MASK TO INDEX
SETZM PIDTAB##(T2)
PUSHJ P,CHANGE ;PUT ANY MSGS FOR PID INTO SENDER'S QUEUE
SOS %IPCNP## ;DECREMENT COUNT OF CURRENT PID'S
MOVE J,HIGHJB## ;DO ALL JOBS
DSTRY1: PUSHJ P,FNDPDB## ;SET UP W
JRST DSTRY2 ;NO JOB
CAMN P2,.EPIPI(W) ;DESTROY LOCAL INFO FOR THIS JOB?
SETZM .EPIPI(W) ;CLEAR IT!
DSTRY2: SOJG J,DSTRY1 ;LOOP FOR ALL JOBS.
JRST CPOPJ1## ;AND GOOD RETURN
;CHANGE THE OWNERSHIP OF A PID. WORD 1 HAS THE PID, WORD 2 THE NEW
; JOB NUMBER.
OWNER: MOVE T1,.IPCFD+1(P1) ;PID TO CHANGE
PUSHJ P,CHKSID ;SEE IF A SYSTEM PID
PJRST ERRPI ;YES, CAN'T DO THAT
PUSHJ P,VALPID ;SET UP J + W
PJRST ERRDU ;BAD PID
MOVE T2,.IPCFD+1(P1) ;GET PID BEING CHANGED
CAMN T2,.IPCFS(P1) ;GIVING SELF AWAY?
MOVEM J,.IPCFS(P1) ;YES, SEND BACK TO JOB
JUMPE J,ERRDU ;CANNOT CHANGE OWNERSHIP OF EXEC PROC.
MOVE P3,W ;SOURCE PDB
SKIPG T1,.IPCFD+2(P1)
PJRST ERRBJ ;BAD JOB NUMBER
PUSHJ P,CTXIPC## ;FIND IPCF DATA BLOCK
PJRST ERRBJ ;NO SUCH JOB OR CONTEXT
MOVE P2,.IPCFD+1(P1) ;PID TO CHANGE IN P2
PUSHJ P,CHANGE ;CHANGE THE OWNERSHIP OF THE PID
MOVE T1,P2 ;GET OLD PID
AND T1,%IPCPM## ;MASK TO INDEX
MOVE T2,PIDTAB##(T1) ;GET OLD PID
TRZ T2,JCHMSK## ;REMOVE OLD JOB INFO
IORI T2,(J) ;INCLUDE NEW JOB INFO
MOVEM T2,PIDTAB##(T1) ;STORE BACK IN PID TABLE
JRST CPOPJ1## ;AND GOOD RETURN
;SUBROUTINE TO CHANGE THE OWNERSHIP OF A PID
;ENTER W=PDB OF NEW OWNER P2=PID TO CHANGE P3=PDB OF OLD OWNER
CHANGE: XMOVEI T2,.EPIPC-.IPCFL(P3) ;WHERE TO UNQUEUE FROM
CHNGE3: HLRZ T3,.IPCFL(T2) ;NEXT ITEM FROM QUEUE
JUMPE T3,CPOPJ## ;DONE IF 0
CAME P2,.IPCFR(T3) ;FOR THE PID BEING CHANGED?
JRST CHNGE4 ;NO
CAMN W,P3 ;CHANGING OWNERSHIP TO SAME JOB NO?
MOVEM J,.IPCFR(T3) ;YES, MAKE REC'R BE THE JOB ITSELF
; (OTHERWISE A LOOP MAY RESULT)
SYSPIF
SKIPN T1,.EPIPN(W) ;END OF QUEUE
XMOVEI T1,.EPIPC-.IPCFL(W) ;EMPTY
HRLM T3,.IPCFL(T1) ;YES, PUT ON NEW QUEUE
HLLZ T4,.IPCFL(T3) ;QUEUE POINTER OF THIS PACKET
HLLM T4,.IPCFL(T2) ;REMOVE FROM OLD QUEUE
HRRZS .IPCFL(T3) ;LAST ENTRY ON NEW QUEUE
HRRM T3,.EPIPN(W) ;END OF NEW QUEUE
SKIPN T4 ;IF END OF OLD QUEUE
HRRM T2,.EPIPN(P3) ; MAKE PRED THE END
SYSPIN
PUSH P,T2
PUSHJ P,WAKEUP ;PSI OR UNHIBER NEW RECEIVER
POP P,T2
SOS .EPIPC(P3) ;UPDATE COUNTS FOR OLD AND NEW OWNERS
AOSA .EPIPC(W)
CHNGE4: MOVE T2,T3 ;STEP TO NEXT ENTRY IN (OLD) QUEUE
JRST CHNGE3 ;AND TEST IT
;FUNCTION 23: FIND IN SYSTEM PID TABLE
SIDFND: MOVE T1,.IPCFD+1(P1) ;THE PID REQUESTED
PUSHJ P,CHKSID ;SEE IF A SYSTEM PID
TRNA ;YES, SKIP ON
JRST ERRUI ;NO, UNDEFINED ID REQUESTED ERROR
SUBI T2,<.GTSID##-.GTCSD##> ;OFFSET TO REAL TABLE INDEX
MOVEM T2,.IPCFD+2(P1) ;STORE AS ANSWER
JRST CPOPJ1## ;RETURN GOODNESS
;FUNCTION 24: SET SYSTEM PID TABLE
SIDSET: PUSHJ P,CHKIDX ;GET INDEX AND CHECK IT
JRST ERRBI ;BAD INDEX
JUMPE T2,ERRBI ;DON'T LET HIM SET IPCC
SETZ J, ;IN CASE CLEARING THE TABLE
SKIPN T1,.IPCFD+2(P1) ;GET PID FROM USER
JRST SETST1 ;ZERO MEANS CLEAR THE ENTRY
PUSHJ P,VALPID ;VALIDATE THE PID
POPJ P, ;RETURN ERROR CODE
MOVE T2,.IPCFD+1(P1) ;GET INDEX BACK
MOVE T1,.IPCFD+2(P1) ;GET THE PID
SETST1: MOVE T4,J ;COPY JCH OR ZERO
ANDI T4,JOBMSK## ;MAKE A JOB NUMBER FOR COMPARISONS
MOVE T3,SIDJOB##(T2) ;CHECK OWNER
CAME T3,T4 ;AGAINST CALLER
JUMPN T3,ERRPI ;ERROR IF NOT OWNER OF TABLE ENTRY
MOVEM T1,.GTSID##(T2) ;STORE IT
MOVEM T4,SIDJOB##(T2) ;AND IN JOB NUMBER TABLE
CAIN T2,1 ;[SYSTEM]INFO
MOVEM T1,%CNIPI## ;YES, UPDATE OLD GETTAB
MOVSI T2,IP.DPL ;GET DROP-ON-LOGOUT BIT
CAME T1,T4 ;CHECK FOR JUST JOB OR JCH
CAMN T1,J ;USING JOB NUMBER AS PID?
IORM T2,.EPIPQ(W) ;YES, LIGHT IT FOR THIS JOB
JRST CPOPJ1## ;AND RETURN SUCCESS
;FUNCTION 25: READ SYSTEM PID TABLE
SIDRD: PUSHJ P,CHKIDX ;GET INDEX AND CHECK IT
JRST ERRBI ;BAD INDEX
MOVE T1,.GTSID##(T2) ;GET THE PID
MOVEM T1,.IPCFD+2(P1) ;GIVE IT TO THE USER
JRST CPOPJ1## ;AND RETURN SUCCESSFUL
;CHKIDX -- ROUTINE TO VALIDATE INDEX AND RETURN IT IN T2.
; SKIP IF OK, NON-SKIP IF NO GOOD.
CHKIDX: HRREI T1,.GTCSD##-.GTSID## ;GET MINIMUM INDEX
MOVEI T3,SDTBLN## ; AND MAXIMUM
MOVE T2,.IPCFD+1(P1) ;GET INDEX REQUESTED
CAML T2,T1 ;TOO LOW
CAMLE T2,T3 ; OR TOO HIGH
POPJ P, ;YES
JRST CPOPJ1## ;NO, IN RANGE
;HERE FROM UUOCON ON A LOGOUT UUO
IPCLGO::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVJW## ;SAVE J AND W
PUSHJ P,SAVE2## ;SAVE P1
SETZ P1, ;MATCH ON ALL PIDS OWNED BY JOB
MOVSI T1,IP.DPL ;LOAD UP THE LOGOUT FLAG
PUSHJ P,IPCFR1 ;SEND MSG TO INFO, DROP PIDS ETC.
PJRST QSRLGO ;SEND LOGOUT MESSAGE TO QUASAR
;HERE FROM CTXSER ON POPPING A CONTEXT
IPCPOP::PUSHJ P,SAVE2## ;SAVE OUR P ACS
MOVEI P1,2 ;DOING A POP
MOVSI T1,IP.DPL ;SET UP CONDITION FOR TEST
JRST IPCFR1 ;JOIN COMMON CODE FOR LOGOUT/POP/RESET
;HERE FROM UUOCON ON A RESET UUO. SEND A MESSAGE TO INFO AND
; DESTROY THE APPROPRIATE PIDS.
IPCFRC::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVE2## ;SAVE P1
MOVEI P1,1 ;DOING A RESET
MOVSI T1,IP.DPR ;SET UP CONDITION FOR TEST
;COMMON CODE FOR RESET, POP, AND LOGOUT STARTS HERE
IPCFR1: PUSHJ P,SAVJW## ;SAVE FROM DESTRUCTION
PUSH P,T1 ;SAVE IP.DP? BIT
MOVE T1,J ;GET JOB IN QUESTION
PUSHJ P,CTXIPC## ;RETURN IPCF DATA BLOCK ADDRESS
JRST TPOPJ## ;BAD JOB OR CONTEXT NUMBER??
MOVE T1,J ;COPY UPDATED JOB/CONTEXT HANDLE
EXCH T1,(P) ;GET IP.DP? BACK
PUSHJ P,TURNQ ;TURN ANY MSGS AROUND FOR THIS JOB
TDNN T1,.EPIPQ(W) ;IF CONDITIONS AREN'T MET
JRST TPOPJ## ;DON'T SEND A MESSAGE TO ANYBODY
ANDCAM T1,.EPIPQ(W) ;AND SAY "NO MORE"
POP P,J ;GET JOB/CONTEXT HANDLE BACK
SKIPN P1 ;DROP PID ON LOGOUT?
ANDI J,JOBMSK## ;YES--KEEP ONLY THE JOB NUMBER
MOVEI T2,2 ;2 WORD MESSAGE TO INFO
PUSHJ P,GTFWDC## ;GET SPACE FOR MESSAGE
TDZA T4,T4 ;ISN'T ANY
MOVE T4,T1 ;REMEMBER WHERE IT IS
JUMPE T4,IPCLG0 ;WAS THERE ANY
MOVEI T2,IPCFRF-IPCFTB+1 ;CODE FOR RESET/LOGOUT
MOVEM T2,0(T4) ;SAVE IT
HRR P2,J ;GET FLAG,,JOB
MOVEM P2,1(T4) ;STORE
IPCLG0: MOVN P2,%IPCMP## ;SET AN AOBJN WORD FOR LOOKING
HRLZS P2 ; AT ALL OF PIDTAB
IPCLG1: MOVE T2,PIDTAB##(P2) ;GET PIDTAB ENTRY
JUMPE P1,IPCLG4 ;JUMP IF LOGGING OUT
CAIN P1,2 ;POPPING A CONTEXT?
JRST IPCLG5 ;YES, DROP BY JCH
TLNN T2,(1B0) ;DROP THIS PID?
JRST IPCLG2 ;NO--KEEP LOOKING
SKIPA T1,T2 ;COPY PID
IPCLG4: ANDI T2,JOBMSK## ;KEEP ONLY JOB NUMBER IF LOGGING OUT
IPCLG5: ANDI T2,JCHMSK## ;JOB/CONTEXT NUMBER
CAIE T2,(J) ;FOR THIS ONE?
JRST IPCLG2 ;NO
MOVE T1,PIDTAB(P2) ;COPY PID
SETZM PIDTAB##(P2) ;AND CLEAR PIDTAB ENTRY
SOS %IPCNP## ;1 LESS PID CURRENTLY ACTIVE
TRZ T1,JOBMSK## ;REMOVE JOB NUMBER
IORI T1,0(P2) ;INSERT PIDTAB INDEX
HRREI T2,.GTCSD##-.GTSID##
IPCLG3: CAMN T1,.GTSID##(T2) ;THIS IT
JRST [SETZM .GTSID##(T2) ;YES, CLEAR ENTRY
SETZM SIDJOB##(T2) ;AND THE JOB NUMBER
JRST .+1] ;RETURN A LINE
CAIGE T2,SDTBLN##
AOJA T2,IPCLG3
MOVE T2,%SIINF## ;INFO'S PID
MOVEM T2,%CNIPI## ;KEEP THE GETTAB STRAIGHT
IPCLG2: AOBJN P2,IPCLG1 ;DO FOR ALL ENTRIES IN PIDTAB
JUMPE T4,CPOPJ##
MOVEI T1,%SIINF## ;LOCATION OF INFO'S PID
SKIPE .EPIPI(W) ;PRIVATE INFO?
MOVEI T1,.EPIPI(W) ;YES, USE IT
HRLI T4,2 ;INSERT SIZE
PJRST SNDFFC ;SEND IT AND RETURN
;SUBROUTINE TO TURN MESSAGES AROUND FOR A JOB ON RESET/LOGOUT
;CALL WITH T1=IP.DPR OR IP.DPL IN T1
;IF IP.DPR, TURNS AROUND ONLY THOSE MESSAGES FOR PIDS TO BE DROPPED ON RESET
;IF IP.DPL, TURNS AROUND ALL MESSAGES
;PRESERVES T1
TURNQ: PUSHJ P,SAVE4## ;SAVE P1-P4
PUSH P,J ;SAVE J
MOVE P3,J
PUSH P,T1
XMOVEI P2,.EPIPC-.IPCFL(W) ;PRESET PREDECESSOR
TLNN T1,IP.DPR
TLO P2,-1 ;P2 NEGATIVE IF LOGOUT
PUSHJ P,IPCLOK ;LOCK OUR QUEUE
PUSH P,.EPIPL(W) ;WE'RE GOING TO FORGET WE OWN OUR OWN FOR A WHILE
HRRZS .EPIPL(W) ;SAY WE DON'T OWN ANYTHING FOR NOW
TURNQ0: HLRZ P1,.IPCFL(P2) ;GET NEXT ENTRY IN QUEUE FOR JOB
TURNQ1: JUMPE P1,TURNQ7 ;DONE IF 0
SKIPL T1,.IPCFR(P1) ;IF REC'R IS TO BE DROPPED ON LOGOUT,
JUMPGE P2,TURNQ6 ; STEP TO NEXT PACKET IF THIS IS RESET
AOS T2,.IPCFL(P1) ;SET BIT 35 (UNDELIVERABLE) IN PACKET HEADER
MOVE P4,W ;SAVE PDB OF JOB DOING TURNING
TRNE T2,2 ;ALREADY BEEN THIS WAY?
JRST TURNQ4 ;YES, MAKE THE PACKET GO AWAY
EXCH T1,.IPCFS(P1)
MOVEM T1,.IPCFR(P1)
PUSHJ P,VALPID ;SET W FOR REC'R (ORIGINAL SENDER)
JRST TURNQ4 ;HE'S GONE TOO - REMOVE THE PACKET
CAME J,.CPJCH ;DON'T TRY TO GET OUR OWN AGAIN
PUSHJ P,IPCLOK ;LOCK HIS QUEUE (FORGETTING WE OWN OURS FOR NOW)
SKIPE J ;PRESERVE ORIGINATING JCH FOR GOPHER
DPB P3,TRNPTR ;SAVE JOB NUMBER FOR TURN-AROUND RCV.
PUSHJ P,DECSNX ;DECREMENT PACKETS SENT BUT NOT RECEIVED
AOS .EPIPC(W) ;INCREMENT RECV COUNT
EXCH W,P4 ;RESTORE W OF LOGGING-OUT JOB
MOVEI T2,777 ;ADJUST COUNT OF OLD JOB
ADDM T2,.EPIPC(W)
SYSPIF
SKIPN T1,.EPIPN(P4)
XMOVEI T1,.EPIPC-.IPCFL(P4)
HRRM P1,.EPIPN(P4)
HRLM P1,.IPCFL(T1) ;STICK THIS PACKET ON END OF QUEUE
MOVE T1,.IPCFL(P1) ;LINK TO NEXT IN OLD JOB'S QUEUE
HRRZS .IPCFL(P1) ;THIS IS END IN FORMER SENDER'S QUEUE
HLRZ P1,T1 ;POINT P1 TO NEXT IN OLD QUEUE
HRLM P1,.IPCFL(P2) ;LINK NEXT TO PREDECESSOR IN OLD Q
SKIPN P1
HRRM P2,.EPIPN(W)
SYSPIN
CAME J,.CPJCH ;DON'T UNLOCK OURSELVES
PUSHJ P,IPCULK ;UNLOCK
JUMPN J,[PUSHJ P,WAKEUP ;WAKE UP ORIGINAL SENDER
JRST TURNQ1] ;GO TURN AROUND NEXT MSG
EXCH W,P4
HRRZ T1,W ;LOC OF EXEC PID
PUSHJ P,@.EPADR(T1) ;CALL THE EXEC PROCESS
MOVE W,P4
JRST TURNQ1 ;GO TURN AROUND NEXT MSG IN QUEUE
;HERE IF MSG COULDN'T BE TURNED AROUND
TURNQ4: LDB T1,TRNPTR ;GET JOB NUMBER
PUSHJ P,VALPID ;VALIDATE IT
JRST TURNQ5
PUSHJ P,DECSNX ;DECREMENT PACKETS SENT BUT NOT RECEIVED
TURNQ5: MOVE W,P4 ;RESTORE PDB OF JOB DOING TURNING
SYSPIF
HLRZ T1,.IPCFL(P1) ;LINK TO NEXT PACKET
HRLM T1,.IPCFL(P2) ;MAKE NEXT IN QUEUE
SKIPN T1
HRRM P2,.EPIPN(W)
SOS .EPIPC(W) ;DECREMENT USER'S RECEIVE COUNT.
SYSPIN
PUSHJ P,REMPAK ;REURN THIS PACKET TO FREE CORE
JRST TURNQ0 ;AND TRY NEXT PACKET
;HERE IF PACKET IS FOR A PID TO BE DROPPED ON LOGOUT, THIS IS RESET
TURNQ6: HRR P2,P1 ;SAVE POINTER TO LAST ON OLD QUEUE
JRST TURNQ0 ;GO PROCESS NEXT QUEUE ENTRY
;HERE WHEN DONE
TURNQ7: MOVE T1,-2(P)
PUSHJ P,CTXIPC## ;SET J,W
MOVEI W,-.EPIPL(P) ;?
POP P,.EPIPL(W)
MOVE T2,-2(P) ;GET IP.DP? BIT AGAIN
MOVSI T1,IP.DSB ;SET JOB'S DISABLE BIT
TLNE T2,IP.DPL ;IF REALLY GOING AWAY
IORM T1,.EPIPQ(W) ; (YES)
PUSHJ P,IPCULK ;AND RETURN OUR LOCK
POP P,T1 ;RESET T1
PJRST JPOPJ## ;AND RETURN TO CALLER
SUBTTL IPCC INTERFACE FOR BATCH AND SPOOLING
;HERE ON THE CLOSE OF A SPOOLED FILE FROM FILUUO. CALLED WITH F
; CONTAINING THE ADDRESS OF THE SPOOLED DDB.
QSRSPL::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVT## ;SAVE T1 - T4
PUSH P,J ;SAVE J
LDB J,PJOBN## ;LOAD UP J
MOVSI T1,SPMSIZ ;MESSAGE SIZE
HRRI T1,IPCFSM-IPCFTB+1 ;SPOOL FUNCTION
PUSHJ P,FNDPDS## ;SETUP W
PUSHJ P,SETQSR ;SETUP THE PACKET
SKIPE T3,DEVSPM##(F) ;GET ADDR OF SPOOLED PARAMETER BLOCK
SKIPN T1,SPBNM1(T3) ;HAVE A USER NAME?
SKIPA T1,.PDNM1##(W) ;GET NAME FROM USER BLOCK
SKIPA T2,SPBNM2(T3) ;SECOND HALF
MOVE T2,.PDNM2##(W) ;GET SECOND HALF
DMOVEM T1,SPMUSR(T4) ;STORE IT
MOVE T1,DEVNAM(F) ;GET INITED DEVICE
MOVEM T1,SPMIDV(T4) ;AND SAVE IT
HLRZ T1,DEVUNI##(F) ;GET ADR OF UDB
HRRZ T1,UNISTR(T1) ;GET ADR OF SDB
MOVE T1,STRNAM##(T1) ;GET STRUCTURE NAME
MOVEM T1,SPMSTR(T4) ;STORE IT
MOVE T1,DEVFIL(F) ;GET FILENAME
MOVEM T1,SPMFIL(T4) ;STORE IT
HLLZ T1,DEVEXT(F) ;GET EXTENSION
HLLM T1,SPMEXT(T4) ;STORE IT
SKIPN T1,DEVSPN##(F) ;GET ENTER'ED NAME IF SETUP
MOVE T1,JBTNAM##(J) ;USE PROG NAME IF 0.
MOVEM T1,SPMEFN(T4) ;AND SAVE IT
MOVE T1,DEVACC##(F) ;GET ADDRESS OF ACCESS TABLE
MOVE T1,ACCWRT##(T1) ;GET BLOCKS WRITTEN
MOVEM T1,SPMFSZ(T4) ;AND SAVE FILE SIZE
HRLZ T1,DEVSPM##(F) ;GET ADDRESS OF SPOOLING OPTION BLOCK
JUMPE T1,QSRSP1 ;IF NO PARAMETER BLOCK
HRRI T1,SPMPRM(T4) ;WHERE TO COPY BLOCK TO
JRST QSRSP2 ;AND SEND IT ALL
QSRSP1: HRLI T1,SPMPRM(T4) ;PREPARE TO CLEAR BLOCK
HRRI T1,SPMPRM+1(T4) ;...
SETZM SPMPRM(T4) ;CLEAR FIRST WORD
QSRSP2: BLT T1,SPMPRM+SPBMAX-1(T4) ;CLEAR OR MOVE ALL PARMS
SKIPE DEVUPP##(F) ;IN-YOUR-BEHALF ENTER DONE?
JRST QSRSP3 ;YES--ACCT STRING ALREADY SETUP
MOVSI T1,.PDACS##(W) ;WILL USE ACCT STRING FROM PDB
HRRI T1,SPMPRM+SPBACT(T4) ;SET UP BLT
BLT T1,SPMPRM+SPBMAX-1(T4) ;COPY ACCT STRING
QSRSP3: MOVEI T1,%SIQSR## ;SEND TO QUASAR
PUSH P,T4 ;SAVE MESSAGE ADDRESS
SKIPN T2,DEVUPP##(F) ;GET IN-YOUR-BEHALF PPN
MOVE T2,JBTPPN##(J) ;ISN'T ONE SO USE OUR PPN INSTEAD
EXCH T2,T4 ;SENDS0 WANTS PPN IN T4, AND
PUSHJ P,SENDS0 ; T2 POINTING TO MESSAGE
JFCL ;IGNORE PROBLEMS
POP P,T2 ;GET BACK MESSAGE ADDRESS
HLRZ T1,(T2) ;LENGTH IN T1
HRRZS T2 ;JUST ADDRESS
PUSHJ P,GVFWDS## ;RETURN THE FREECORE
JRST JPOPJ##
SUBTTL QUEUE. UUO - UUO TO SEND A MESSAGE TO A GALAXY COMPONENT
;UUO TO SEND A MESSAGE TO A GALAXY COMPONENT AND OPTIONALLY WAIT FOR A RESPONSE
;CALLING SEQUENCE:
; MOVE AC,[LENGTH,,ADDRESS]
; QUEUE. AC,
; ERROR RETURN
; NORMAL RETURN
;ERROR RETURNS FROM THE QUEUE. UUO
QUIAL%==1
QUILF%==2
QUNFS%==3
QUADC%==4
QUCNR%==5
QUFER%==6
QUSOC%==7
QUNPV%==10
QUTMO%==11
ERCODE QUEIAL,QUIAL% ;ILLEGAL ARGUMENT LIST
ERCODE QUEILF,QUILF% ;ILLEGAL FUNCTION
ERCODE QUENFS,QUNFS% ;NO MONITOR FREE CORE
ERCODE QUEADC,QUADC% ;ADDRESS CHECK
ERCODE QUECNR,QUCNR% ;COMPONENT NOT RUNNING - NO SYSTEM PID
ERCODE QUEFER,QUFER% ;FATAL ERROR RETURNED FROM COMPONENT
ERCODE QUESOC,QUSOC% ;SOMEONE IS CONFUSED (INVALID MESSAGE FROM COMPONENT)
ERCODE QUENPV,QUNPV% ;ASKING FOR PRIVS BUT ISN'T PRIVILEGED
ERCODE QUETMO,QUTMO% ;TIMEOUT LIMIT EXPIRED
GLXINF::PUSHJ P,SAVE4##
FRAME GLXPID ;DESTINATION PID TO USE (.QUPID)
HLRZ P1,T1 ;GET UUO BLOCK LENGTH
CAIGE P1,3 ;MUST BE AT LEAST ONE REAL ARGUMENT
JRST QUEIAL ;ILLEGAL ARGUMENTS
HRRI M,(T1) ;POINT TO FLAG WORD
PUSHJ P,GETWRD## ;GET IT
JRST QUEADC ;ADDRESS CHECK
TLNE T1,<(QU.LFB^!QU.FLG)>;ANY UNDEFINED FLAG BITS ON?
JRST QUEIAL ;YES, ILLEGAL ARGUMENT LIST
TLNN T1,(QU.HLN) ;HEADER LENGTH GIVEN?
TLO T1,3 ;NO, USE DEFAULT
LDB P2,[POINT 6,T1,17] ;GET HEADER LENGTH
CAIG P2,5 ;IF OUT OF RANGE,
CAIGE P1,2(P2) ;OR NOT AT LEAST TWO REAL ARGS,
JRST QUEIAL ;IS ILLEGAL ARGUMENT LIST
TLNE T1,(QU.PRP) ;PRIVILEGED ASKING FOR PRIVILEGES?
PUSHJ P,PRVJC## ;YES, THEN MUST BE PRIVILEGED
SKIPA U,T1 ;PRIV'D OR NOT ASKING FOR THEM
JRST QUENPV ;NOT PRIV'D
HRRES T1 ;GET FUNCTION CODE
JUMPE T1,QUEILF ;ZERO IS ILLEGAL
CAML T1,[.GTQFC##-.GTQFT##] ;CUSTOMER FUNCTION?
CAILE T1,QUTBLN## ;DEC FUNCTION?
JRST QUEILF ;NO TO EITHER
;VALIDATE AND SAVE NODE NAME HERE
SETZ W, ;IN CASE NOT PRESENT
CAIGE P2,2 ;NODE ARGUMENT GIVEN?
JRST GLXI99 ;NO, SKIP IT
PUSHJ P,GETWR1## ;GET NODE NUMBER OR NAME
JRST QUEADC ;ADDRESS CHECK
IFN FTNET,<
SKIPN T2,T1 ;COPY NODE NUMBER/NAME
MOVE T1,JBTLOC## ;AND LOCAL STATION
CAMN T2,[-1] ;WANT LOCATED STATION?
MOVE T1,JBTLOC##(J) ;YES
PUSHJ P,[NETDBJ ;VALIDATE (COULD BE A NAME)
JRST NODE.S##]
SKIPA W,T1 ;MAYBE AN OFFLINE NODE
JRST [HLRZ W,NDBSNM##(W) ;POINT TO NDB FOR STATION
MOVE W,(W) ;TRANSLATE STATION NUMBER TO NAME
JRST .+1] ;AND CONTINUE
> ;END FTNET
GLXI99: S0PSHJ INWAT## ;WAIT FOR INPUT TO STOP
;GET LENGTH,,ADDRESS OF RESPONSE BUFFER AND MAKE SURE ITS IN CORE
CAIGE P2,3 ;RESPONSE BUFFER PRESENT?
JRST [JUMPL U,QUEIAL ;NO, BUT REQUESTED
SETZ P4, ;NO, REMEMBER THAT
JRST GLXI98] ;AND SKIP THE FETCH
PUSHJ P,GETWR1## ;GET RESPONSE BUFFER POINTER
JRST QUEADC ;ADDRESS CHECK
MOVE P4,T1 ;SAVE FOR LATER
JUMPGE U,GLXI98 ;SKIP RSP BFR ADDR CHECK IF NO RESPONSE WANTED
HLRZ T2,T1 ;GET LENGTH IN T2
HRLI T1,(IFIW) ;ADDRESS IN T1
PUSHJ P,ARNGE## ;RANGE CHECK
JRST QUEADC ;ADDRESS CHECK
JFCL ;OK IF NOT I/O LEGAL
GLXI98: CAIGE P2,4 ;TIMEOUT VALUE PRESENT?
JRST GLXI97 ;NO, DON'T FETCH IT
PUSHJ P,GETWR1## ;YES, GET IT
JRST QUEADC ;ADDRESS CHECK
TDNE T1,[^-QU.TIM] ;ANY RESERVED BITS ON?
JRST QUEIAL ;YES, ERROR
HRL P1,T1 ;SAVE TIMEOUT VALUE
CAIGE P2,5 ;DESTINATION PID PRESENT?
JRST GLXI97 ;NO, DON'T FETCH IT
PUSHJ P,GETWR1## ;YES, GET IT
JRST QUEADC ;ADDRESS CHECK
JUMPN T1,GLXI96 ;GO WITH IT IF WE HAVE IT
GLXI97: HRRE T1,U ;NO, GET FUNCTION AGAIN
HRRZ T1,.GTQFT##(T1) ;GET ADDRESS OF ASSOCIATED PID
JUMPE T1,QUEILF ;ILLEGAL FUNCTION IF NO MATCHING PID
SKIPN T1,(T1) ;DOES IT EXIST?
JRST QUECNR ;COMPONENT NOT RUNNING
GLXI96: MOVEM T1,GLXPID ;SAVE THE DESTINATION PID
;HERE TO SCAN THE ARGUMENT LIST MAKING SURE ITS IN CORE AND DETERMINING
; THE NUMBER OF WORDS OF CORE NECESSARY FOR BUILDING THE GALAXY MESSAGE
GLXIN0: MOVNS P2 ;-VE HEADER LENGTH
ADDI P2,(P1) ;COUNT OF ARGUMENT WORDS
MOVEI P3,QUESDL ;5 WORD GALAXY HEADER, 2 WORD FUNCTION BLOCK
; 2 WORDS FOR OPR, 3 WORDS FOR USER'S NAME,
; ACTSTL + 1 FOR ACCOUNT STRING
GLXIN1: PUSHJ P,NXTARG
JRST GLXIN2
LDB T2,[POINT 9,T1,17] ;LENGTH OF THE ARGUMENT
ADDI P3,1(T2) ;LENGTH OF DATA BLOCK + 1 FOR HEADER WORD
JRST GLXIN1 ;LOOP BACK
;HERE TO ALLOCATE THE CORE TO BUILD THE MESSAGE
GLXIN2: MOVE T2,P3
CAIG T2,PAGSIZ-2
PUSHJ P,GTFWDC##
JRST QUENFS
;HERE TO BUILD GALAXY HEADER BLOCK, NODE, AND ACCOUNT STRING BLOCKS
HRL P3,T1 ;SAVE ADDRESS OF THE FREE CORE
HRLZ T2,P3
HRRI T2,.IPCGM ;FUNCTION IS GALAXY MESSAGE
MOVEM T2,QUELNH(T1) ;LENGTH OF THE ENTIRE BLOCK,,GALAXY FUNCTION
HRRZ T2,U ;FUNCTION
TLNN U,(QU.PRP) ;IF NOT PRIV'ED
TLZ U,(QU.NBR) ;CAN'T FLOOD THE GALAXY WITH MESSAGES
TLNN U,(QU.NBR) ;ASKING NOT TO BLOCK?
CAIA ;NO, BLOCK
CAIE T2,%QWTO##-.GTQFT## ;WTO IS THE ONLY NON-BLOCKING FUNCTION NOW
CAIN T2,%QWTOR##-.GTQFT## ;WTOR?, IF SO DON'T ASK FOR AN ACK
TDZA T2,T2 ;YES, DON'T REQUEST AN ACK
MOVSI T2,(1B0) ;NO, REQUEST AN ACK
MOVEM T2,QUEFLG(T1)
HRLZ T2,%CNIPS## ;SEQUENCE NUMBER
HRR T2,J ;JOB NUMBER OF REQUESTOR
MOVEM T2,QUEJOB(T1) ;STORE FOR ACKNOLEGMENT
HLRZM P1,QUEMBZ(T1) ;SAVE TIMEOUT VALUE FOR A WHILE
MOVEI T2,QUEIGL ;SET INITIAL ARGUMENT COUNT TO
MOVEM T2,QUEARC(T1) ; THE NUMBER OF INTERNAL BLOCKS GENERATED
MOVE T2,[QUEFCL,,.WTUFC] ;FUNCTION BLOCK
MOVEM T2,QUEFCH(T1) ;STORE THAT
HRREM U,QUEFCN(T1) ;USER SUPPLIED FUNCTION CODE
MOVE T2,[QUEONL,,.WTDES] ;OPERATOR BLOCK
MOVEM T2,QUEONH(T1)
MOVEM W,QUEONN(T1) ;OPERATOR NODE NAME
PUSHJ P,FNDPDS## ;FIND THE PDB
HLRZ T2,QUEJOB(T1)
HRRM T2,.PDQSN##(W)
MOVE T2,[QUEUNL,,.WTNAM]
MOVEM T2,QUEUNH(T1)
MOVE T2,.PDNM1##(W)
MOVE T3,.PDNM2##(W)
DMOVEM T2,QUEUSN(T1)
MOVE T2,[QUEACL,,.WTACT]
MOVEM T2,QUEACH(T1) ;ACCOUNT STRING BLOCK
MOVEI T2,ACTSTL##
JUMPE T2,GLXIN3
MOVSI T2,.PDACS##(W) ;ADDRESS OF THE ACCOUNT STRING
HRRI T2,QUEACS(T1) ;WHERE TO STORE IT IN THE MESSAGE
BLT T2,QUEACS+ACTSTL-1(T1) ;COPY THE ACCOUNT STRING
;HERE TO COPY THE USERS ARGUMENT LIST TO THE GALAXY MESSAGE
GLXIN3: PUSHJ P,GETTAC## ;GET BACK THE POINTER TO USERS ARGUMENT LIST
HRRI M,-1(T1) ;ADDRESS - 1 OF FIRST WORD
LDB P2,[POINT 6,U,17] ;GET HEADER LENGTH
ADDI M,(P2) ;ADDRESS -1 OF FIRST ARGUMENT WORD
MOVNS P2 ;-VE NUMBER OF HEADER WORDS
ADDI P2,(P1) ;NUMBER OF ARGUMENT WORDS
HLRZ T1,P3 ;GET MESSAGE ADDRESS
MOVEI P1,QUESDL(T1) ;WHERE TO STORE ARGUMENTS
GLXIN4: PUSHJ P,NXTARG ;NEXT ARGUMENT
JRST GLXIN7 ;PROCESSED ALL ARGUMENTS
HLRZ T3,P3 ;GET MESSAGE ADDRESS
AOS QUEARC(T3) ;COUNT THE BLOCK ABOUT TO BE ADDED
LDB T3,[POINT 9,T1,17] ;LENGTH OF THE DATA BLOCK
HRRZ T4,T1 ;FUNCTION
HRLI T4,1(T3) ;LENGTH,,FUNCTION
MOVEM T4,(P1) ;STORE THAT
AOS P1 ;WHERE TO STORE DATA
GLXIN5: EXCTUX <MOVE T4,@T2> ;GET DATA
MOVEM T4,(P1) ;STORE DATA IN THE MESSAGE
SKIPL T1 ;IMMEDIATE ARGUMENT?
AOJA T2,GLXIN6 ;NO--ADVANCE TO NEXT WORD OF DATA
HRRI T2,1(T2) ;IMMEDIATE ARGS CAN'T CROSS SECTION BOUNDRIES
GLXIN6: SOSLE T3 ;MOVED ALL DATA ITEMS?
AOJA P1,GLXIN5 ;NO, GET THE NEXT ONE
AOJA P1,GLXIN4 ;GET NEXT ARGUMENT
;HERE TO SEND THE MESSAGE TO THE APPROPRIATE GALAXY COMPONENT
GLXIN7: MOVEI T1,GLXPID ;ADDRESS OF DESTINATON PID
HRLI T1,40 ;FROM [SYSTEM] GOPHER
MOVS T2,P3 ;LENGTH,,ADDRESS OF MESSAGE
PUSH P,T2
MOVE T3,%SIGFR##
MOVE T4,JBTPPN##(J)
SSXE T2,0 ;EXTENDED ADDRESSING HACK
MOVE P2,QUEMBZ(T2) ;GET TIMEOUT LENGTH
SETZM QUEMBZ(T2) ;MUST BE ZERO FOR GALAXY
TLNE U,(QU.NBR) ;WANT NON-BLOCKING?
JRST [
IFN FTXMON,<
MOVE T2,(P) ;RECOVER XWD
>
PUSHJ P,SENDS0 ;YES, SEND AND DON'T WAIT FOR A RESPONSE
JRST [PUSHJ P,QUECNR
JRST SNDFFR]
AOS -1(P)
JRST SNDFFR]
MOVE T2,QUEJOB(T2) ;GET SEQUENCE NUMBER IN LH
HRR T2,P2 ;AND TIMEOUT LIMIT
PUSHJ P,GFRTMO ;SET UP A TIMEOUT CLOCK REQUEST
POP P,T2 ;GET PACKET POINTER BACK FROM STACK
PUSHJ P,SENDSP
JRST QUECNR
;HERE TO GIVE THE USER THE RESPONSE IF HE WANTS ONE
HLRZ T2,.PDEPA##(W) ;** IT'S OK TO USE .PDEPA HERE
JUMPE T2,QUETMO ;TIMEOUT FAILURE
PUSHJ P,GFRCLN ;CLEANUP AFTER QUEUE. UUO TIMEOUT
MOVE T1,.IPCFD+1(T2)
TLNE T1,100000
JRST [PUSHJ P,QUEFER
JRST .+2] ;ERROR RETURN BUT GIVE USER RESPONSE
AOS (P)
SKIPL U ;USER WANT A RESPONSE?
JRST GLXI12 ;NO, TOSS THE ACK OR RESPONSE
TLNE T1,200000 ;ACK OR RESPONSE?
JRST [SETZB P2,P3 ;ACK, SO INDICATE ZERO LENGTH RESPONSE
JRST GLXI10]
HRRZ T1,.IPCFD+4(T2)
MOVEI T2,.IPCFD+5(T2)
GLXIN8: HRRZ T3,(T2)
CAIN T3,.CMTXT
JRST GLXIN9
HLRZ T3,(T2)
ADD T2,T3
SOJG T1,GLXIN8
PUSHJ P,QUESOC
JRST GLXI12
GLXIN9: MOVEI P1,1(T2) ;ADDRESS OF ACTUAL RESPONSE
HLRZ P2,(T2) ;TOTAL LENGTH OF RETURNED RESPONSE
SUBI P2,1 ;OFFSET FOR GALAXY BLOCK HEADER
HLRZ P3,P4
GLXI10: MOVE T1,P2 ;LENGTH OF THE RESPONSE
CAMLE P2,P3
TRO T1,WT.RWT
TRO T1,WT.RBR ;INDICATE RESPONSE BLOCK
PUSHJ P,STOTAC## ;STORE RESPONSE LENGTH PLUS POSSIBLE TRUNCATED BIT
JUMPE P2,GLXI12
HRRI M,-1(P4)
GLXI11: MOVE T1,(P1)
PUSHJ P,PUTWD1##
AOS P1
SOSLE P2
SOJG P3,GLXI11
GLXI12: HLRZ T2,.PDEPA##(W)
LDB T1,PKLNT2
ADDI T1,.IPCFD
PJRST GIVWDS##
;RETURNS T1 = ARGUMENT <I>B0+<LENGTH>B17+<TYPE>B35, T2 = ADDRESS OF DATA
; UNDEFINED BITS MUST BE ZERO
NXTARG: SOJL P2,CPOPJ## ;COUNT WORD PAIRS
PUSHJ P,GETWR1## ;GET .QUARG WORD (IMMEDIATE/LENGTH/TYPE)
JRST NXTAD1 ;QUEADC, BUT POP STACK BY ONE.
TLNN T1,777 ;WORD COUNT SPECIFIED?
TLO T1,1 ;NO--DEFAULT TO ONE
HLRZ T2,T1 ;NUMBER OF WORDS OF ARGUMENT IS IN LEFT HALF
ANDI T2,777 ;STRIP OFF ANY FLAGS THERE MIGHT BE
TLNN T1,377000 ;ANY ILLEGAL BITS TURNED ON?
CAIGE T2,1 ;REASONABLE LENGTH?
JRST NXTIAL ;ILLEGAL ARGUMENT
PUSH P,T1 ;SAVE ON STACK
HRRI M,1(M) ;ADVANCE UUO POINTER (DON'T CROSS SECTIONS)
MOVE T1,M ;GET .QUARV WORD (ADDRESS)
TLZ T1,-1-MXSECN ;STRIP OFF ALL BUT SECTION,,ADDRESS
SKIPL (P) ;IMMEDIATE ARGUMENT?
JRST NXTAR1 ;NO
HRLI T1,(IFIW) ;ALWAYS USE LOCAL ADDRESS
JRST NXTAR2 ;ONLY NEED TO DO ADDRESS CHECKING
NXTAR1: PUSHJ P,EACALC## ;DO EA CALC (T1 GETS NEW ADDR, T2 IS SAVED)
JRST NXTAD2 ;ILLEGAL ADDRESS REFERENCE
NXTAR2: PUSHJ P,ARNGE## ;RANGE CHECK
JRST NXTAD2 ;ADDRESS CHECK
JFCL ;OK IF NOT I/O LEGAL
SKIPL (P) ;IMMEDIATE ARGUMENT?
MOVEI T2,1 ;NO--TWO WORD PAIRS
SUBI P2,(T2) ;ACCOUNT FOR ARGS IN UUO BLOCK
ADD T2,M ;POINT PAST CURRENT ARGUMENT
HRRI M,-1(T2) ;DON'T CROSS SECTION BOUNDRIES
MOVE T2,T1 ;T2 GETS ADDRESS
JRST TPOPJ1## ;RETURN WITH WORD COUNT/FUNCTION IN T1
NXTIAL: POP P,(P) ;POP CALL TO NXTARG
PJRST QUEIAL ; AND GIVE "ILLEGAL ARGUMENT" ERROR
NXTAD2: POP P,(P) ;POP CALL TO NXTARG
NXTAD1: POP P,(P) ; POP AN AC
PJRST QUEADC ; AND GIVE "ADDRESS CHECK" ERROR
;HERE ON LOGOUT UUO. LOGOUT MESSAGE IS SENT TO QUASAR IF %SIQSR
; CONTAINS A VALID PID.
QSRLGO: PUSHJ P,SETLMG ;SETUP THE MESSAGE
PUSH P,T4 ;SAVE MESSAGE ADDRESS
MOVEI T1,%SIOPR## ;PID OF [SYSTEM]OPERATOR-CONTROLLER
MOVE T2,(P) ;POINT TO PACKET
PUSHJ P,SENDSI ;SEND IT OFF
JFCL ;IGNORE ERRORS
MOVEI T1,%SIQSR## ;PID OF [SYSTEM]QUASAR
MOVE T2,(P) ;POINT TO PACKET
PUSHJ P,SENDSI ;SEND MESSAGE
JFCL ;IGNORE ERRORS
MOVE T1,JBTPRG##(J) ;GET PROGRAM NAME
MOVE T2,JBTSTS##(J) ;AND ITS STATUS BITS
TLNE T2,JLOG ;IGNORE LOGIN IF NEVER GOT LOGGED IN
CAME T1,LGINAM## ;RUNNING LOGIN?
CAMN T1,LGONAM## ; OR LOGOUT?
TRNA ;YES--PROCEED
PJRST SNDFFR ;NO--RELEASE CORE AND RETURN
CAMN J,ACTJOB## ;IS IT THE ACCOUNTING DAEMON?
PJRST SNDFFR ;YES--RELEASE CORE AND RETURN
MOVE T1,[40,,%SIACT##]
MOVE T2,(P) ;GET PACKET
MOVE T3,%SIGFR##
MOVE T4,JBTPPN##(J)
PUSHJ P,SENDSP ;SEND TO ACTDAE, WAIT FOR RESPONSE
JRST SNDFFR
HLRZ T2,.PDEPA(W)
LDB T1,PKLNT2
ADDI T1,.IPCFD
SKIPE T2
PUSHJ P,GIVWDS##
JRST SNDFFR
;HERE ON LOGIN UUO TO SEND MESSAGE TO QUASAR
QSRLGI::SE1ENT ;ENTER SECTION 1
MOVSI T1,LOMSIZ ;SIZE OF MESSAGE
HRRI T1,IPCFON-IPCFTB+1 ;CODE
PUSHJ P,SETQSR ;SETUP THE MESSAGE
DMOVE T1,.PDNM1##(W) ;GET USER NAME
DMOVEM T1,LOMUSR(T4) ;STORE
PUSH P,F
PUSH P,T4
MOVE F,TTYTAB##(J)
PUSHJ P,CTLJBD##
POP P,T4
MOVEM T1,LOMCTL(T4)
MOVE T1,DEVNAM(F)
MOVEM T1,LOMTTY(T4)
POP P,F
SNDQSR: MOVEI T1,%SIQSR##
PJRST SNDFFC ;AND SEND MESSAGE TO QUASAR
;SNDSCM -- ROUTINE TO SEND A SCHEDULE BITS CHANGE MSG TO QUASAR.
; NO ARGS
SNDSCM::SE1ENT ;ENTER SECTION 1
MOVEI T2,SCMSIZ ;GET NUMBER OF WORDS NEEDED
PUSHJ P,GETWDS##
POPJ P, ;FAILED
MOVE T2,[XWD SCMSIZ,IPCSCM-IPCFTB+1]
MOVEM T2,(T1) ;STORE LEN,,FUNCTION CODE
HRLI T1,SCMSIZ ;SETUP LEN,,MSG ADDR FOR SNDMDX
PUSH P,T1
MOVEI T1,%SIQSR## ;GET QUASAR'S PID ADDRESS
PJRST SNDMDX ;SEND THE MESSAGE
;SETQSR -- ROUTINE TO SETUP A PACKET TO SEND TO QUASAR. CALL
; WITH T1 CONTAINING SIZE,,CODE, RETURN QSRMSG BLOCK
; WITH GALMSG AND GALSTS ALL SETUP.
;RETURNS T4=LEN,,ADDR OF MESSAGE
SETLMG: MOVSI T1,LGMSIZ ;SIZE OF MESSAGE
HRRI T1,IPCFLM-IPCFTB+1 ;CODE
; PJRST SETQSR ;SETUP THE MESSAGE
SETQSR: PUSHJ P,SAVJW## ;SAVE J AND W
ANDI J,JOBMSK## ;KEEP ONLY JOB NUMBER
PUSHJ P,FNDPDS## ;POINT W AT THE PDB
PUSH P,T1
HLRZ T2,T1
PUSHJ P,GFWDCD##
STOPCD .,JOB,NCM, ;++NO CORE FOR MESSAGE
MOVE T4,T1
POP P,GALMSG(T4)
; HLL T4,GALMSG(T4)
HRLZ T1,J ;GET JOB,,0
LDB T2,PDYBSN## ;GET BATCH STREAM NUMBER
LSH T2,^D27 ;SHIFT OVER
IOR T1,T2 ; OR IT IN
MOVSI T2,(JB.BSS) ;GET BATCH STREAM SET BIT
TDNE T2,.PDOBI##(W) ;IS IT ON?
TRO T1,GALBSS ;YES-TELL QUASAR
IFN FTNET,<
HRRZ T2,JBTLOC##(J) ;GET HIS LOCATION
LSH T2,^D9 ;SHIFT OVER 9 BITS
IOR T1,T2 ;OR IT IN
> ;END IFN FTNET
MOVSI T2,(JB.LBT) ;GET BATCH BIT
TDNE T2,JBTLIM##(J) ;IS HE A BATCH JOB?
TRO T1,GALBAT ;YES, SET THE FLAG
MOVEI T2,JB.DFR ;GET DEFERED BIT
TDNE T2,JBTSPL##(J) ;TEST IT
TRO T1,GALDFR ;ITS ON
MOVEM T1,GALSTS(T4) ;AND STORE 2ND DATA WORD
HLL T4,GALMSG(T4) ;COPY LENGTH
TLO T4,(IFIW) ;LIGHT CROCKY BIT
POPJ P, ;AND RETURN
IFN FTMDA,<
;SUBROUTINE TO SEND THE CONTENTS OF T1 AND T2 TO [SYSTEM]MDC
;CALLING SEQUENCE: (MAY BE CALLED AT INTERRUPT LEVEL)
; MOVE T1,UNIT NAME
; MOVEI T2,DEVICE TYPE
; PUSHJ P,SNDMDC
;RETURNS CPOPJ IF THE MESSAGE COULDN'T BE SENT, CPOPJ1 IF OK
LEN.UO==3 ;LENGTH OF MSG
SNDMDC::SE1ENT ;ENTER SECTION 1
PUSH P,T1 ;SAVE ARGUMENTS
PUSH P,T2
MOVEI T2,LEN.UO ;GET THREE WORDS OF FREE STORAGE
PUSHJ P,GETWDS##
JRST [POP P,T2 ;FAIL
JRST TPOPJ##]
MOVE T2,[XWD LEN.UO,.IPCUO]
MOVEM T2,(T1)
POP P,T2 ;DEVICE TYPE
MOVEM T2,2(T1)
POP P,1(T1) ;UNIT NAME
HRLI T1,LEN.UO ;LENGTH OF BLOCK
PUSH P,T1 ;SAVE LEN,,ADDR
MOVEI T1,%SIDOL## ;ASSUME DISK
CAIE T2,.TYDSK ;TRUE?
MOVEI T1,%SITOL## ;NO, SEND IT TO PULSAR
>
;HERE WITH ADDR OF RECVR PID IN T1
;LEN,,MSG ADDRS IN 0(P)
;ALWAYS RETURNS
;LEN WORDS AT ADDR
SNDMDX::MOVE T2,(P) ;GET ADDR OF MESSAGE AGAIN
PUSH P,J ;SAVE J
PUSH P,W ;SAVE W
SETZB J,T4 ;JOB NUMBER AND PPN OF SENDER ARE ZERO
PUSHJ P,SENDS0 ;SEND THE MESSAGE
SOS -3(P) ;FAILED
POP P,W ;RESTORE W
POP P,J ;RESTORE J
POP P,T2 ;AND FREE CORE ADDRESS
HLRZ T1,T2 ;GET # OF WORDS TO RETURN
HRRZS T2 ;CLEAR LH OF GIVWDS
AOS (P) ;SKIP RETURN IF SUCCESSFUL
PJRST GIVWDS## ;RETURN FREE CORE
IFN FTMDA,<
;ROUTINE TO SEND A MESSAGE TO MDA WHEN A CONTROLLED DEVICE
; HAS BEEN REASSIGNED
;CALL: F-DDB ADDRESS
; J-JOB NUMBER
;RETURNS-CPOPJ IF MESSAGE NOT SENT
; CPOPJ1 IF OK
LEN.DE==4 ;MINIMUM LENGTH OF DEASSIGN MESSAGE
SNDFIN::TDZA T1,T1 ;NO FLAG FOR DEASSIGN
SNDVSS::MOVSI T1,400000 ;GET FLAG INDICATING VOL SWITCH
MOVEI T2,LEN.DE ;ASSUME UNINTERESTING DEVICE
MOVEI T3,0 ;AND NO DATA
LDB T4,PDVTYP## ;GET DEVICE TYPE
CAIE T4,.TYDTA ;DECTAPE?
JRST SNDFI1 ;NO
MOVEI T2,LEN.DE+2 ;STANDARD LENGTH PLUS DATA WORDS
MOVEI T3,DTXWRD##(F) ;POINT TO START OF DTA DATA
HRLI T3,-2 ;TWO WORDS
JRST SNDFI2 ;JOIN COMMON CODE
SNDFI1: CAIE T4,.TYMTA ;MAGTAPE?
JRST SNDFI2 ;NO
MOVEI T2,LEN.DE+6 ;STANDARD LENGTH PLUS DATA WORDS
MOVE T3,TDVUDB##(F) ;UDB ADDRESS
MOVEI T3,TUBCRD##(T3) ;POINT TO START OF UDB DATA QUASAR NEEDS
HRLI T3,-6 ;SIX WORDS LONG
SNDFI2: PUSH P,T2 ;SAVE LENGTH
PUSH P,T3 ;SAVE AOBJN POINTER
HLL T4,T1 ;GET FLAG SO MDA KNOWS WHAT TO DO WITH STATS
PUSH P,T4 ;SAVE FLAG,,DEVICE TYPE
PUSHJ P,GETWDS## ;GET CORE
JRST [POP P,T4
POP P,T3
JRST T2POPJ##]
LDB T2,PJOBN## ;GET JOB NUMBER
MOVEM T2,3(T1) ;SAVE IT
POP P,2(T1) ;DEVICE TYPE
MOVE T2,DEVNAM(F) ;GET DEVICE NAME
MOVEM T2,1(T1) ;SAVE IT
POP P,T3 ;GET AOBJN POINTER
POP P,T2 ;GET MESSAGE LENGTH
HRLZS T2 ;LH=LENGTH
HRRI T2,.IPCDE ;RH=IPCF FUNCTION
MOVEM T2,0(T1) ;MESSAGE CODE
JUMPGE T3,SNDFI4 ;JUMP IF NO DATA TO STORE
MOVE T4,T1 ;COPY MESSAGE ADDRESS
SNDFI3: MOVE T2,(T3) ;GET A WORD
MOVEM T2,4(T4) ;PUT A WORD
ADDI T4,1 ;POINT TO NEXT LOC
AOBJN T3,SNDFI3 ;LOOP
SNDFI4: HLL T1,(T1) ;GET LENGTH FROM MESSAGE
;HERE WITH LEN,,ADRS OF MESSAGE IN T1
;TO SEND MESSAGE TO MDA, AND RETURN FREE
;CORE USED BY THE MESSAGE
SNDF.1: SE1ENT ;ENTER SECTION 1
PUSH P,T1 ;SAVE SO WE CAN RETURN IT
MOVEI T1,%SIMDA## ;WHO TO SEND TO
PJRST SNDMDX ;SEND IT OFF, RETURN THE CORE
>;END IFN FTMDA
;HERE WHEN A T/S JOB WHICH OWNS LOCKED FILE
;STRUCTURES DOES A RESET. MDA WILL GET MESSAGE
;WITH RESET'S JOB NUMBER.
;CALL - J - JOB #
;RETURNS-
; POPJ - NO MDA
; CPOPJ1 - SENT
IFN FTMDA,<
LEN.RS==2 ;LENGTH OF RESET MESSAGE
SNDMDR::MOVEI T2,LEN.RS ;GET MESSAGE LENGTH
PUSHJ P,GETWDS## ;GET THAT MUCH SPACE
POPJ P, ;CAN'T, GIVE UP
MOVE T2,[XWD LEN.RS,.IPCRL] ;HEADER WORD
MOVEM T2,0(T1) ;MARK THE MESSAGE
MOVEM J,1(T1) ;SAY WHO'S RESETTING
HRLI T1,LEN.RS ;COUNT THE FREE SPACE
PJRST SNDF.1 ;SEND IT OFF!
> ;END IFN FTMDA
IFN FTMDA,<
;HERE WHEN A JOB CHANGES ITS SEARCH LIST
;MDA WILL GET A COPY OF THE NEW LIST
;CALL -
; T1, ADDR OF MESSAGE (IN FREE CORE)
; T2, LEN OF MESSAGE SPACE
;RETURNS
; POPJ NO MDA
; CPOPJ1 SENT
;NOTE: THE SPACE OCCUPIED BY THE MESSAGE IS ALWAYS RETURNED
SNDMDN::HRLI T1,(T2) ;COUNT THE BLOCK
PJRST SNDF.1 ;SEND IT
>;END IFN FTMDA
IFN FTMDA,<
LEN.AT==4 ;LENGTH OF ATTACH MSG
LEN.DT==4 ;LENGTH OF DETACH MSG
;ATTMPA - NOTIFY MDA OF PORT ATTACHMENT
;CALL: MOVE T1, PRIMARY PORT NAME
; MOVE T2, SECONDARY PORT NAME
; MOVE U, UDB JUST ATTACHED
; PUSHJ P,ATTMPA
; <RETURN>
ATTMPA::SKIPE DINITF## ;SYSTEM INITIALIZATION?
POPJ P, ;NO ONE TO INFORM
PUSH P,T1 ;SAVE PRIMARY PORT NAME
PUSH P,T2 ;SAVE SECONDARY PORT NAME
MOVEI T2,LEN.AT ;LENGTH OF ATT/DET MSG
PUSHJ P,GETWDS## ;GET SOME SPACE
JRST [POP P,T2
JRST TPOPJ##]
MOVE T2,[XWD LEN.AT,.IPCAT] ;LEN,,MSG TYPE
MOVEM T2,0(T1) ;MARK THE HEADER
MOVE T2,UDBNAM(U) ;GET ATTACHED PORT NAME
MOVEM T2,1(T1) ;PUT IN MESSAGE
POP P,3(T1) ;STORE SECONDARY PORT NAME
POP P,2(T1) ;STORE PRIMARY PORT NAME
HRLI T1,LEN.AT ;COUNT THE BLOCK
ATTMP1: PUSHJ P,SNDF.1 ;SEND IT OFF
JFCL ;CAN'T? OH WELL
POPJ P,
;DETMPA - NOTIFY MDA OF PORT DETACH
; U/ UDB JUST DETACHED
; T1/SIXBIT NEW PRIMARY UNIT (PERHAPS 0)
; RETURN CPOPJ ALWAYS
DETMPA::PUSH P,T1 ;SAVE NEW PRIMARY
MOVEI T2,LEN.DT ;LENGTH OF MSG
PUSHJ P,GETWDS## ;GET A MESSAGE BLOCK
JRST TPOPJ## ;OH WELL
MOVE T2,[XWD LEN.DT,.IPCDT] ;LEN,,MSG TYPE
MOVEM T2,0(T1) ;MARK HEADER
MOVE T2,UDBNAM(U) ;DETACHED UNIT NAME
MOVEM T2,1(T1) ;THAT'S 1ST ITEM
POP P,2(T1) ;NEW PRIMARY OR ZERO
SETZM 3(T1) ;NO SECONDARY PORT NOW
HRLI T1,LEN.DT ;COUNT THE MSG
PJRST ATTMP1 ;SEND IT
;XCHMPA - NOTIFY MDA OF DISK UNIT EXCHANGE
; P1 / FIRST UDB ADDRESS
; U / SECOND UDB ADDRESS
; RETURN CPOPJ ALWAYS
LEN.XC==3
XCHMPA::MOVEI T2,LEN.XC ;GET MSG LENGTH
PUSHJ P,GETWDS## ;GET SOME CORE
POPJ P, ;CANT
MOVE T2,[LEN.XC,,.IPCXC] ;LEN,,MSG TYPE
MOVEM T2,0(T1) ;STORE IT
MOVE T2,UDBNAM(P1) ;GET FIRST UNIT NAME
MOVEM T2,1(T1) ;STORE IT
MOVE T2,UDBNAM(U) ;GET SECOND UNIT NAME
MOVEM T2,2(T1) ;STORE IT
HRLI T1,LEN.XC ;COUNT THE MSG
PJRST ATTMP1 ;SEND MSG AND RETURN
;REMMPA - NOTIFY MDA OF A STRUCTURE REMOVAL
; F / STR D.B.
; RETURN CPOPJ ALWAYS
LEN.RM==2
REMMPA::MOVEI T2,LEN.RM ;GET MSG LENGTH
PUSHJ P,GETWDS## ;GET SOME CORE
POPJ P, ;CAN'T
MOVE T2,[LEN.RM,,.IPCRM] ;LEN,,MSGTYPE
MOVEM T2,0(T1) ;STORE IT
MOVE T2,STRNAM##(F) ;GET STR NAME
MOVEM T2,1(T1) ;STORE IT
HRLI T1,LEN.RM ;COUNT THE MSG
PJRST ATTMP1 ;SEND MSG AND RETURN
;STRMPA - NOTIFY MDA OF A STRUCTURE MOUNT
; F / STR D.B.
; RETURN CPOPJ ALWAYS
STRMPA::PUSHJ P,SAVE1## ;NEED A PRESERVED AC
MOVEI P1,1+1+1 ;NEED ONE OVERHEAD WORD + 1 FOR STR NAME + 1 FOR UNIT
HLRZ T1,STRUNI##(F) ;PICK UP FIRST UNIT IN STR
STRMP1: HLRZ T1,UNISTR(T1) ;FIND NEXT UNIT
SKIPE T1 ;END OF CHAIN?
AOJA P1,STRMP1 ;NOT YET
MOVE T2,P1 ;GET NUMBER OF WORDS NEEDED
PUSHJ P,GETWDS## ;GET SOME CORE
POPJ P, ;CAN'T
MOVEI T3,.IPCST ;FUNCTION CODE
HRLI T3,(P1) ;LENGTH
MOVEM T3,0(T1) ;STORE IT
MOVE T3,STRNAM##(F) ;GET STR NAME
MOVEM T3,1(T1) ;STORE IT
MOVSI P1,(P1) ;SAVE [LENGTH,,MESSAGE ADDRESS]
HRR P1,T1
HLRZ T3,STRUNI##(F) ;GET FIRST UDB ADDR
STRMP2: MOVE T2,UDBNAM(T3) ;GET UNIT NAME
MOVEM T2,2(T1) ;SAVE
HLRZ T3,UNISTR(T3) ;GET LINK TO NEXT UDB
SKIPE T3 ;END OF CHAIN?
AOJA T1,STRMP2 ;NOT YET
MOVE T1,P1 ;GET MESSAGE ADDRESS BACK
PJRST ATTMP1 ;SEND IT AND RETURN
>;IFN FTMDA
IFN FTMDA,<
;MTAMPA- NOTIFY MDA OF A NEW MAGTAP UNIT BEING ACCESSIBLE
; F/ MAGTAPE DDB ADDRESS
; RETURN CPOPJ ALWAYS
LEN.MT==2
MTAMPA::MOVEI T2,LEN.MT ;GET MSG LENGTH
PUSHJ P,GETWDS## ;GET CORE
POPJ P, ;CANT
MOVE T2,[LEN.MT,,.IPCMT] ;LEN,,TYPE
MOVEM T2,0(T1) ;SAVE IT
MOVE T2,DEVNAM(F) ;GET DRIVE NAME
MOVEM T2,1(T1) ;SAVE IT
HRLI T1,LEN.MT ;SET LENGTH
PJRST ATTMP1 ;SEND MSG AND RETURN
>;END IFN FTMDA
;COROUTINE TO SEND A MESSAGE TO THE OPERATOR
;CALLING SEQUENCE:
; MOVE T1,OPM.XX FLAGS
; PUSHJ P,OPRMSG
; NO CORE OR BAD FLAGS
; PROCEED, T1 AND U CLOBBERED
;U MUST BE PRESERVED
;CORETURN IS WHEN THE MESSAGE IS SENT TO ORION OR THE OPR/CTY TTYS
;
;OPRMSQ CAN BE CALLED TO KEEP ANYTHING FROM HAPPENING AFTER ALL
;OPRHDR CAN BE CALLED (ONCE) TO MAKE A .WTTYP BLOCK FOR THE MESSAGE
OPM.XX==OPM.SO!OPM.OT!OPM.CT ;VALID FLAGS MASK
OPRMSG::TRNE T1,OPM.XX ;MUST LIGHT SOMETHING
TDNE T1,[^-OPM.XX] ;AND NOTHING INVALID
POPJ P, ;PUNT
CAIN T1,OPM.SO ;ORION ONLY?
SKIPE %SIOPR## ;AND NO ORION?
TRNA ;NO OR NO--PROCEED
POPJ P, ;YES--PUNT IT
MOVS U,T1 ;SAVE THE FLAGS
PUSHJ P,[PUSHJ P,SAVT## ;PRESERVE ACS
MOVEI T2,^D510+.IPCFD ;GET MAX. PACKET SIZE
PUSHJ P,GETWDS## ;GRAB SOME CORE
POPJ P, ;PUNT
HRRI U,(T1) ;PRESERVE THE ADDRESS OF THE BLOCK
RETSKP] ;SUCCEED
POPJ P, ;PROPAGATE FAILURE
TLO U,(1B0) ;MAKE AN IFIW FOR OUR USE
SETOM .IPCFD+QUEARC(U) ;FLAG FOR .WTTYP BLOCK
MOVEI T1,^D502*5-1 ;MAX. COUNT OF CHARACTERS
MOVEM T1,1(U) ;STORE LIMIT
MOVEI T1,.IPCFD+10(U) ;START OF INITIAL DATA
MOVEM T1,(U) ;SAVE FOR LATER
HRLI T1,(POINT 7) ;MAKE A BYTE POINTER
MOVEM T1,2(U) ;SAVE FOR STORAGE
MOVE T1,[2,,.WTUFC] ;FUNCTION WORD
MOVEM T1,.IPCFD+5(U) ;SET FOR ORION
MOVEI T1,%QWTO##-.GTQFT## ;FUNCTION IS WTO
MOVEM T1,.IPCFD+6(U) ;SET FOR ORION
MOVEI T1,OPRTYO ;POINT TO OUR OUTPUT ROUTINE
EXCH T1,.CPTOA## ;UPDATE SYSTEM'S
EXCH T1,(P) ;PRESERVE FOR LATER
PUSHJ P,1(T1) ;GIVE SKIP "RETURN" TO CALLER
TRNA ;PROPAGATE NON-SKIPNESS
AOS -1(P) ;AS WELL AS SKIPNESS
POP P,.CPTOA## ;RESTORE THE TYPEOUT ADDRESS
SE1ENT ;ENTER SECTION ONE
PUSHJ P,SAVT## ;PRESERVE ALL ACS
PUSHJ P,SAVE4## ;THAT WE WANT TO USE
SKIPGE (U) ;IF ABORT WAS REQUESTED,
PJRST OPRABT ;DO SO
SETZ T1, ;GET A NUL
IDPB T1,2(U) ;MAKE OUR STRING ASCIZ
HRRZ T1,2(U) ;GET ENDING ADDRESS
MOVE T2,(U) ;AND STARTING ADDRESS
MOVEI T3,.WTTXT ;AND TYPE OF BLOCK
MOVEM T3,-1(T2) ;SETUP BLOCK TYPE
SUBI T1,-2(T2) ;GET TOTAL BLOCK LENGTH
HRLM T1,-1(T2) ;SET IN BLOCK HEADER
MOVEI T1,3 ;AMOUNT BY WHICH TO ADJUST .OARGC
ADDM T1,.IPCFD+QUEARC(U) ;ACCOUNT FOR -1 ORIGIN, .WTTXT, & .WTUFC
MOVSI T1,(WT.SJI) ;SUPPRESS JOB INFORMATION
MOVEM T1,.IPCFD+QUEMBZ(U) ;SETUP .OFLAG
SETZM .IPCFD+QUEFLG(U) ;WE WANT NO ACK
HRLZ T1,%CNIPS## ;GET AN ACK CODE
MOVEM T1,.IPCFD+QUEJOB(U) ;SETUP FOR GALAXY
MOVSI T1,IP.JAC ;THIS JOB HAS GODLY PRIVS
MOVEM T1,.IPCFC(U) ;A WHITE LIE FOR ORION
MOVE T1,FFAPPN## ;THE GODLY PPN
MOVEM T1,.IPCFU(U) ;SAVE AS OURS IN HEADER
AOS T1,2(U) ;GET NEXT AVAILABLE ADDRESS
SUBI T1,.IPCFD(U) ;MAKE PACKET LENGTH IN RH
SETZM .IPCFI(U) ;CLEAR OTHER JUNK IN WORD
MOVEI T2,40 ;GET SYSTEM PROCESS CODE
MOVEM T2,.IPCFL(U) ;FLAG ITS FROM THE GOPHER
MOVEI P1,(U) ;GET PACKET ADDRESS IN BETTER AC
DPB T1,PKLNP1 ;SAVE LENGTH IN HEADER
HRLI T1,.IPCGM ;FUNCTION IS GALAXY MESSAGE
MOVSM T1,.IPCFD+QUELNH(P1) ;SET FOR ORION
MOVEI T2,.IPCFD(T1) ;GET LENGTH OF CORE BLOCK
TRZE T2,3 ;IF NOT EVEN MULTIPLE OF FOUR,
ADDI T2,4 ;ROUND UP
MOVEI T1,^D510+.IPCFD ;GET ORIGINAL LENGTH
SUB T1,T2 ;HOW MANY JUNK WORDS ARE AT THE END
ADD T2,P1 ;AND WHERE THEY START
SKIPLE T1 ;IF ANYTHING TO RETURN,
PUSHJ P,GIVWDS## ;TRIM THE PACKET
AOS %CNIIP## ;COUNT UP THE OUSTANDING PACKET
TLNN U,OPM.SO ;SUPPOSED TO SEND TO ORION?
JRST OPRMST ;NO--GO CHECK FOR TERMINALS
PUSHJ P,SAVJW## ;YES--PRESERVE YET MORE ACS
MOVE T1,%SIGFR## ;GET OUR PID
MOVEM T1,.IPCFS(P1) ;SET AS SENDER
PUSHJ P,VALPID ;SETUP J & W FOR US
JFCL ;CAN'T FAIL
SKIPN T1,%SIOPR## ;ORION'S PID
JRST OPRMST ;OOPS--GO TRY TERMINALS
MOVEM T1,.IPCFR(P1) ;SET AS RECEIVER
HLRZ T1,.IPCFD+QUELNH(P1) ;GET PACKET LENGTH AGAIN
ADDM T1,%IPTWT## ;ACCOUNT FOR WORDS TRANSFERRED
PUSHJ P,SNDMSG ;AND TRY IT
JRST OPRMST ;NO GO--TRY FOR TERMINALS
POPJ P, ;ALL DONE IF WE SENT IT TO ORION
OPRMST: TLNN U,OPM.OT!OPM.CT ;WANT TO TALK TO ANY TERMINALS?
PJRST REMPAK ;NO--GIVE BACK THE CORE AND RETURN
MOVEI P2,.IPCFD+10(P1) ;ADDRESS OF FIRST STRING
HLRZ P3,-1(P2) ;OFFSET TO NEXT
ADD P3,P2 ;POINT TO IT
MOVE P4,.IPCFD+QUEARC(P1) ;GET ARG COUNT
SUBI P4,2 ;OFFSET FOR .WTTXT & .WTUFC
HLL P2,U ;COPY THE BITS
TLNN P2,OPM.CT ;IF DON'T WANT THE CTY,
JRST OPRMSO ;GO TYPE ON OPR
HRRZ U,BOOTCT## ;GET TTY NUMBER OF THE CTY
MOVE U,LINTAB##(U) ;AND THEN ITS LDB ADDRESS
PUSHJ P,OPRMSU ;TYPE THE MESSAGE THERE
TLNE P2,OPM.OT ;IF DON'T WANT OPR, OR
CAMN U,OPRLDB## ;IF OPR IS THE CTY,
PJRST REMPAK ;THEN CLEAN UP AND RETURN
OPRMSO: MOVE U,OPRLDB## ;GET OPR'S LDB
PUSHJ P,OPRMSU ;TYPE THE MESSAGE THERE
PJRST REMPAK ;GIVE BACK CORE AND RETURN
OPRMSU: PUSHJ P,PCRLF## ;START ON A NEW LINE
PUSHJ P,INLMES## ;WAKE UP THE OPERATOR
BYTE (7) 7,"%",7,"%",0
PUSHJ P,PR3SPC## ;SPACE OVER
PUSHJ P,DATIME## ;TIMESTAMP IT
PUSHJ P,PR3SPC## ;SPACE SOME MORE
MOVEI T1,(P2) ;POINT TO FIRST TEXT BLOCK
PUSHJ P,CONMES## ;TYPE IT
PUSHJ P,PCRLF## ;END THE LINE
JUMPE P4,CPOPJ## ;DONE IF NO SECOND BLOCK
PUSHJ P,PR3SPC## ;SPACE SOME MORE
MOVEI T1,(P3) ;POINT TO SECOND BLOCK
PUSHJ P,CONMES## ;TYPE IT
PJRST PCRLF## ;END THE LINE AND WE'RE DONE
;HERE TO GIVE BACK THE ENTIRE CORE BLOCK QUIETLY
OPRABT: MOVEI T1,.IPCFD+^D510 ;LENGTH WE ALLOCATED
MOVEI T2,(U) ;WHERE IT IS
PJRST GIVWDS## ;AS ADVERTISED
;HERE TO FLAG THE DESIRE TO ABORT THE MESSAGE
OPRMSQ::SETOM (U) ;FLAG TO ABORT ON CORETURN
POPJ P, ;DONE
;HERE TO DO THE TYPEOUT INTO OUR PACKET
OPRTYO: SKIPL (U) ;IGNORE IF ABORTING
SOSGE 1(U) ;ONLY IF STILL HAVE ROOM
POPJ P, ;PUNT
IDPB T3,2(U) ;STORE THE CHARACTER
POPJ P, ;DONE WITH THIS CALL
;HERE TO MODIFY THE HEADER TO INCLUDE A .WTTYP BLOCK
OPRHDR::SKIPL (U) ;IGNORE IF ABORTING
AOSE .IPCFD+QUEARC(U) ;ONLY DO THIS ONCE
PJRST OPRMSQ ;OTHERWISE ABORT IT
SETZ T1, ;GET A NUL
IDPB T1,2(U) ;MAKE THIS ASCIZ
HRRZ T1,2(U) ;LAST ADDRESS WE USED
HRRZ T2,(U) ;FIRST ADDRESS WE USED
SUBI T1,-2(T2) ;MAKE TOTAL LENGTH OF THIS ARG BLOCK
HRLI T1,.WTTYP ;THIS IS A HEADER
MOVSM T1,-1(T2) ;STORE IN THE BLOCK
HRRZ T1,2(U) ;GET LAST ADDRESS AGAIN
ADDI T1,2 ;OFFSET TO FIRST NEW STORAGE
MOVEM T1,(U) ;SAVE FOR LATER
MOVE T2,T1 ;COPY
HRLI T2,(POINT 7) ;MAKE A STORAGE POINTER
MOVEM T2,2(U) ;SAVE FOR OPRTYO
SUBI T1,.IPCFD+^D510(U) ;GET -VE WORDS OF REMAINING STORAGE
IMULI T1,5 ;ACCOUNT FOR CHARACTERS PER WORD
SETCA T1, ;MAKE +VE & ACCOUNT FOR TRAILING NUL
CAIGE T1,^D80 ;IF THE HEADER WAS TOO LONG,
PJRST OPRMSQ ;ABORT IT
MOVEM T1,1(U) ;OK--STORE THE NEW LIMIT
POPJ P, ;AND RETURN
;SUBROUTINE TO SEND A PACKET TO A PID AND WAIT FOR A RESPONSE
; FROM THE RECEIVER
;CALLING SEQUENCE:
; MOVE T1,["SENT BY",,%SIDXXX]
; OR MOVE T1,RECEIVER'S PID
; MOVE T2,[LENGTH,,ADDRESS]
; MOVE T3,SENDER'S PID
; MOVE T4,SENDER'S PPN
; PUSHJ P,SENDSP ;IF SENDING TO A SPECIAL SYSTEM PROCESS
; OR PUSHJ P,SENDAP ;IF SENDING TO AN ARBITRARY PID
;RETURNS CPOPJ IF THE MESSAGE COULLD NOT BE DELIVERED
; RETURNS CPOPJ1 IF THE MESSAGE WAS SUCCESSFULLLY SENT AND A REPLY
; HAS BEEN RECEIVED. THE POINTER TO THE PACKET RECEIVED IS IN .EPEPA.
; IF THE SIGN BIT OF T2 IS LIT, IT IS THE CALLLER'S RESPONSIBILLITY
; TO RETURN THE PACKET TO MONITOR FREE CORE AFTER PROCESSING ITS CONTENTS
SENDAP::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVE4##
PUSH P,T2 ;SAVE POINTER
MOVE P4,T3
MOVE P3,T1
MOVE P2,T2
PUSHJ P,VALPID
JRST SENDP3
AND P3,%IPCPM##
ADDI P3,PIDTAB## ;ADDRESS OF THE PID IN PIDTAB
PUSH P,J
PUSH P,W
MOVE J,.CPJOB##
PUSHJ P,SENDS1
JRST SENDP2
JRST SENDP1
SENDSP::SE1ENT ;ENTER SECTION 1
PUSH P,T2
PUSH P,J
PUSH P,W
MOVE J,.CPJOB##
PUSHJ P,SENDS0
JRST SENDP2
SENDP1: SKIPL T2,-2(P) ;ARE WE SUPPOSED TO RETURN THE CORE?
PUSHJ P,SNDFFD ;YES, DO SO
SETOM -2(P) ;DON'T RETURN IT TWICE
MOVE J,.CPJOB##
PUSHJ P,FNDPDS## ;POINT W AT THE PDB
MOVEI T1,EV.IPC
PUSHJ P,ESLEEP##
MOVE T1,.PDEPA##(W)
TRNE T1,-1 ;IF RH IS ZERO, WE'RE NOT STILL WAITING
TLNN T1,-1 ;IF BOTH RH & LH NON-ZERO, WE ARE
TRNA ;OK (NOTE--MUST NOT BE TALKING TO [SYSTEM]IPCC)
JRST SENDP1 ;SPURIOUS EWAKE--WAIT SOME MORE
TRNN T1,-1 ;GIVE FAILURE RETURN IF RETURNED PACKET
AOSA -3(P) ;NO--SUCCEED AND KEEP PACKET ADDRESS
SETZM .PDEPA##(W) ;RETURNED PACKET--DON'T LEAVE CONFUSING JUNK
SENDP2: POP P,W
POP P,J
SENDP3: SKIPL (P) ;ARE WE SUPPOSED TO RETURN THE CORE?
PJRST SNDFFR ;YES, DO SO
POP P,(P) ;NO, TRIM STACK
POPJ P, ;AND RETURN
;HERE ON RECEIPT OF A MESSAGE SENT TO THE EXEC PSUEDO-PROCESS
; [SYSTEM]GOPHER IF THE INTENDED RECEIVING PROCESS IS BLOCKED WAITING
; FOR A RESPONSE, STORE THE ADDRESS OF THE PACKET IN THE RECEIVER'S
; PDB AND WAKEUP THE RECEIVER. OTHERWISE, RETURN THE PACKET AS
; UNDELIVERABLE.
IPCSPR::PUSHJ P,SAVE1##
IFN FTMP,<
PUSHJ P,ONCPU0## ;ONLY ONE CPU AT A TIME
>
IPCSP1: PUSHJ P,GETPAK
POPJ P,
HRRZ P1,T1
HRRZ T1,.IPCFL(P1) ;GET THE FLAGS
TRNN T1,IP.CMN ;IS THIS A TURNED-AROUND PACKET?
JRST IPCSP7 ;NO--GO EXAMINE NORMALLY
PUSH P,W ;MAYBE--SAVE GOPHER'S DATA BLOCK
HRRZ T1,.IPCFC(P1) ;GET ORIGINATING JOB/CONTEXT HANDLE
PUSHJ P,CTXIPC## ;SETUP J AND W
JRST IPCSP5 ;CAN'T--JUST PITCH THIS ONE
MOVE T1,W ;GOT IT--COPY TARGET USER'S IPCF BLOCK ADDRESS
POP P,W ;RESTORE GOPHER'S
IFN FTFDAE,<
HRRZ T2,.IPCFD(P1) ;GET THE FUNCTION CODE
CAILE T2,.FDPOP ;IS IT IN THE (LOW) RANGE OF FILE DAEMON CODES?
JRST IPCSP8 ;NO--GO HANDLE GALATICALLY
HLRZ T2,.EPQSN(T1) ;YES--GET THE WAITING SEQUENCE NUMBER
XOR T2,.IPCFD+3(P1) ;COMPARE WITH WHAT FILSER STORED
TRNE T2,-1 ;IF NOT THE SAME,
JRST IPCSP2 ;JUST GET RID OF IT
JRST IPCSP3 ;IT VALIDATED--GO TRY TO WAKE THE USER
> ;END IFN FTFDAE
IPCSP8: HRLZ T2,.EPQSN(T1) ;GET THE ACK ID THE USER NEEDS
HRRI T2,(J) ;INCLUDE THE JCH
MOVE T3,.IPCFD+QUEJOB(P1) ;GET THE GALACTIC ACK ID
TRNN T3,CTXMSK## ;IF JUST A JOB NUMBER IN MESSAGE,
TRZ T2,CTXMSK## ;DON'T USE CONTEXT NUMBER IN THE COMPARISON
CAME T2,T3 ;DOES THE ACK ID MATCH THE GALACTIC HEADER?
JRST IPCSP2 ;NO--PITCH THIS MESSAGE
JRST IPCSP3 ;YES--GO TRY TO WAKE THE USER
IPCSP7: HRRZ T1,.IPCFD(P1)
CAIE T1,.WTORR ;WTOR RESPONSE?
CAIN T1,.OMACK ;OR AN ACK?
JRST [PUSH P,W ;YES, SAVE CURRENT
HRRZ T1,.IPCFD+2(P1) ;GET JOB/CONTEXT HANDLE
PUSHJ P,CTXIPC## ;SET UP J AND W
JRST IPCSP5 ;CAN'T
MOVE T1,W ;COPY
POP P,W ;RESTORE ORIGINAL
HLRZ T2,.IPCFD+2(P1) ;GET SEQUENCE NUMBER
HRRZ T3,.EPQSN(T1) ; AND VALUE AT SEND
CAME T2,T3 ;ONE WE'RE WAITING FOR
JRST IPCSP2 ;NO, PITCH IT
JRST IPCSP3] ;NOW PROCESS IT
IFN FTFDAE,< ;VALIDATE FILDAE SEQUENCE NUMBERS
MOVE T2,.IPCFS(P1) ;FIND OUT WHO SENT THIS MESSAGE
CAME T2,%SIFDA##
JRST IPCSP4 ;NOT THE FILE DAEMON? CONTINUE ONWARD
PUSH P,W ;SAVE CURRENT
HRRZ T1,.IPCFD(P1) ;GET JOB/CONTEXT HANDLE FROM MESSAGE
PUSHJ P,CTXIPC## ;SET UP J AND W
JRST IPCSP5 ;HE MUST HAVE LOGGED OUT
MOVE T1,W ;GET NEW
POP P,W ;RESTORE ORIGINAL
HLRZ T2,.IPCFD(P1) ;GET THE SEQUENCE NUMBER FROM FILDAE
JUMPE T2,IPCSP4 ;ZERO? MUST BE OLD VERSION OF FILDAE
HLRZ T3,.EPQSN(T1) ;GET THE NUMBER WE SAVED BEFORE
CAME T2,T3 ;DO THEY MATCH?
JRST IPCSP2 ;NO, BIT-BUCKET THIS MESSAGE
IPCSP4:
> ;END IFN FTFDAE
PUSH P,W ;SAVE CURRENT
HRRZ T1,.IPCFD(P1) ;GET JOB/CONTEXT HANDLE FROM MESSAGE
PUSHJ P,CTXIPC## ;SET UP J AND W
JRST IPCSP5
MOVE T1,W ;GET NEW
POP P,W ;RESTORE ORIGINAL
IPCSP3: PUSH P,T1 ;SAVE IPC BLOCK
MOVE T1,J ;COPY TARGET JCH
PUSHJ P,CTXSTS## ;GET JBTSTS & JBTST2
JRST IPCSP6 ;ABORT
LDB T3,[POINT ESLPSZ,T2,ESLPBP] ;GET EVENT WAIT REASON
POP P,T1 ;RESTORE IPC BLOCK
MOVE T2,.IPCFS(P1) ;GET SENDER'S ID
CAMN T2,.EPEPA(T1) ;SENDER MATCH?
CAIE T3,EV.IPC ;AND EW WAS FOR IPCF?
JRST IPCSP2 ;NO, PITCH IT
HRRZ T2,.IPCFL(P1) ;GET THE FLAGS AGAIN
ANDI T2,IP.CMN ;ISOLATE THE TURN-AROUND FIELD
SKIPN T2 ;IF NOT TURNED AROUND,
HRLZ T2,P1 ;THEN USE PACKET-ADDR,,0
MOVEM T2,.EPEPA(T1) ;SAVE OUR RETURN VALUE
SOS .EPIPC(W) ;WE GOT RID OF THE MESSAGE
PUSHJ P,NXTPAK ;MAKE SURE WE DID (PRESERVES T2)
CAIE T2,1 ;IF NOT A RETURNED PACKET,
SOSA %CNIIP## ;THEN JUST COUNT DOWN THE NUMBER OF PACKETS
PUSHJ P,REMPAK ;ELSE GET RID OF IT ENTIRELY RIGHT NOW
MOVE T1,J ;COPY TARGET JCH
PUSHJ P,CTXEWK## ;EWAKE TARGET
JFCL ;(SHOULD SKIP)
PUSHJ P,DECSSW ;CLEAR THE COUNTS (RESPECTING W)
JRST IPCSP1 ;LOOP FOR ALL GOPHER MESSAGES
IPCSP6: MOVEM W,(P) ;MAKE SURE TO RESTORE THE RIGHT IPC BLOCK
IPCSP5: POP P,W ;RESTORE IPC BLOCK
IPCSP2: MOVEI T1,IPCDU% ;DESTINATION UNKNOWN ERROR
DPB T1,RTNERR ;RETURN TO ERRANT SENDER
PUSHJ P,DECSSW ;FIX THE COUNTS
MOVEI T2,4 ;FROM [SYSTEM]GOPHER
PUSHJ P,ANSWE1 ;RESPOND
JRST IPCSP1 ;LOOP OVER QUEUE OF GOPHER MESSAGES
SUBTTL TIMEOUT LOGIC FOR [SYSTEM] GOPHER
;GFRTMO -- ROUTINE TO SET UP A TIME LIMIT FOR A GOPHER RESPONSE
;
;CALL:
; MOVE T2,[QUEUE-SEQUENCE-NUMBER,,TIME-LIMIT-IN-SECONDS]
; PUSHJ P,GFRTMO
;
; RETURN HERE ALWAYS
;
;PRESERVES T1-T4
;
;RETURNS FREECORE ADDRESS USED IN P2
GFRTMO: TRNN T2,-1 ;ANYTHING TO DO?
POPJ P, ;NO, GET OUT
PUSHJ P,SAVT## ;YES, SAVE SOME REGISTERS
SETZ P2, ;NO ADDRESS YET
PUSH P,T2 ;AND THE TIMER VALUE
MOVEI T2,1 ;NEED A WORD
PUSHJ P,GETPKT ;GET SOME CORE
JRST T2POPJ## ;SHOULD NEVER GET HERE
HRRZ T2,(P) ;RESTORE TIME VALUE
IMUL T2,TICSEC## ;CONVERT TO JIFFIES
TLNE T2,-1 ;EXCEED CLOCK SIZE?
MOVEI T2,-1 ;YES, USE MAXIMUM
HRLI T2,GFRABT ;ROUTINE TO CALL AT EXPIRATION
POP P,T3 ;RESTORE SEQUENCE NUMBER
HRR T3,.CPJCH## ;JCH TO AWAKEN
MOVEM T3,(T1) ;SAVE FOR GFRABT
SYSPIF ;INTERLOCK QUEUE
IDPB T2,CLOCK## ;STUFF ROUTINE,,TIME
IDPB T1,CLOCK## ;AND DATA
SETOM CLKNEW## ;THERE'S A NEW REQUEST
SYSPIN ;ALLOW OTHERS AGAIN
MOVE P2,T1 ;SAVE BLOCK POINTER
POPJ P, ;RETURN
;GFRCLN -- CLEAN UP UNEXPIRED GOPHER TIMER
;
;CALL:
; P2/ AS RETURNED BY GFRTMO
;
;RETURNS +1 ALWAYS
GFRCLN: TRNN P2,-1 ;ANYTHING TO DO?
POPJ P, ;NO
PUSHJ P,SAVT## ;MAYBE, SAVE SOME ACS
MOVE T1,P2 ;COPY DATA VALUE
MOVE T2,[GFRABT,,1] ;ROUTINE,,NEW TIMER
PUSHJ P,CLKCHG## ;EXPIRE SOON
POPJ P, ;OK IF NONE
POPJ P, ;DONE
;GFRABT -- ABORT A TIMED GOPHER REQUEST
;
;CALL:
; MOVEI T1,ADDRESS OF WORD SAVED BY GFRTMO
; PUSHJ P,GFRABT
;
; RETURN HERE ALWAYS
;
;CLOBBERS T1-T4, J & W.
GFRABT: SE1ENT ;IPCSER RUNS IN SECTION ONE
PUSH P,(T1) ;SAVE DATA WORD
SETZM (T1) ;CLEAR OUT STALE DATA
MOVEI T2,1 ;LENGTH
EXCH T2,T1 ;GIVWDS & GETWDS DISAGREE ON ARGUMENT ORDER
PUSHJ P,GIVWDS## ;RETURN THE CORE BLOCK
HRRZ T1,(P) ;GET TARGET JCH
PUSHJ P,CTXIPC## ;SETUP FOR IPCF DATA MUNGING
JRST TPOPJ## ;GIVE UP IF CAN'T
HRRZ T1,.EPQSN(W) ;GET QUEUE-UUO SEQUENCE NUMBER
HLRZ T2,(P) ;AND OLD VALUE
CAME T2,T1 ;MATCH?
JRST TPOPJ## ;NO, DON'T TOUCH THE USER
MOVE T1,.EPEPA(W) ;GET PID WHO CAN ANSWER
TRNE T1,-1 ;IF STILL THERE,
CAMN T1,%SIFDA## ;AND REALLY FOR A QUEUE. UUO,
JRST TPOPJ## ;(NO, DON'T TRASH CORE)
SETZM .EPEPA(W) ;STILL WAITING, ZAP PID WORD FOR GOPHER CHECK
HRRZ T1,(P) ;GET JCH
PUSHJ P,CTXEWK## ;BREAK IT OUT OF EVENT WAIT
JFCL ;IT WENT AWAY?
JRST TPOPJ## ;RETURN TO CLOCK1
SUBTTL MONITOR INTERFACE ROUTINES
;SENDSI -- ROUTINE TO SEND A MESSAGE TO ANY SPECIAL SYSTEM PROCESS
;
;CALL:
; MOVEI T1,%SIXXX
; HRLI T1,"SENT BY [SYSTEM]?", 0 IF IPCC
; MOVE T2,[XWD LEN,ADR]
; MOVE T3,SYSTEM PID, IGNORED IF IPCC
; PUSHJ P,SENDSI
;
; ALWAYS RETURN HERE
;
;USES T1-T4
;
;NOTE: THE BLOCK SPECIFIED BY THE CALLER BELONGS "TO THE CALLER".
; IT IS COPIED AND RETURNED TO THE CALLER INTACT. SPECIFICALLY,
; IF THE CALLER GOT THE BLOCK FROM THE SYSTEM FREE SPACE, "HE"
; MUST RETURN IT.
;
SNDFFC::SE1ENT ;ENTER SECTION 1
PUSH P,T4
MOVE T2,T4
PUSHJ P,SENDSI
JFCL
SNDFFR: POP P,T2
SNDFFD: TLZ T2,(IFIW) ;CLEAR CROCKY BIT
HLRZ T1,T2
HRRZS T2
PJRST GVFWDS##
SENDSI::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVJW## ;SAVE J AND W
MOVE T4,JBTPPN##(J) ;SENDER'S PPN
;ENTER HERE WITH (T4) = SENDER'S PPN
SENDS0: TLZ T2,(IFIW) ;CLEAR CROCKY BIT
PUSH P,T1
HRRZS T1
SKIPN 0(T1)
JRST TPOPJ##
POP P,T1
PUSHJ P,SAVE4## ;SAVE P1-P4
MOVE P4,T3
MOVE P3,T1 ;SAVE T1
MOVE P2,T2 ; AND T2
MOVE P1,T4
TLNE P3,-1
JRST SENDS1
HRLI P3,10
MOVE P4,PIDTAB##
;FALL INTO SENDS1
SENDS1: HLRZ T2,P2 ;GET LENGTH
ADDI T2,.IPCFD ;ADD HEADER
PUSHJ P,GETPKT ;GET FREE SPACE
POPJ P,
MOVEM P1,.IPCFU(T1)
HLRZM P3,.IPCFL(T1)
MOVEM P4,.IPCFS(T1)
HRL P1,P2 ;GET SOURCE,,0
HRRI P1,.IPCFD(T1) ;GET SOURCE,,DEST
HLRZ P4,P2 ;GET LEN
MOVSI T2,IP.LPK ;GET "LARGE PACKET"
CAMLE P4,%CNIPL## ;IS IT LARGE?
IORM T2,.IPCFL(T1) ;YES, SET IT
ADDI P4,.IPCFD-1(T1) ;GET END OF MSG
BLT P1,(P4) ;MOVE THE MSG OVER
HRRZ T2,P3 ;ISOLATE ADDRESS
MOVE T2,(T2) ;GET RECEIVER'S PID
MOVEM T2,.IPCFR(T1) ;SAVE IT
MOVE P1,T1 ;COPY PACKET ADDRESS FOR SAFE KEEPING
MOVE T1,J ;GET JOB/CONTEXT HANDLE
PUSHJ P,CTXIPC## ;SENDER'S IPCF DATA BLOCK ADDR
PUSHJ P,S..NIJ ;LOOSE
MOVE T1,P1 ;RESTORE FOR IPCSCA
MOVEM T2,.EPEPA(W) ;STORE THE PID OF WHO CAN ANSWER
SETZM .IPCFI(T1) ;ZERO REST OF WORD
HLRE T3,P2 ;LENGTH
SKIPGE T3
MOVEI T3,PAGSIZ ;IF FULL PAGE
DPB T3,PKLNT1 ;AND STORE LENGTH
PUSHJ P,IPCSCA ;SET CAPABILITIES OF THE JOB PACKET IS BEING SENT FOR
AOS %CNIIP## ;ONE MORE IN
PUSHJ P,SNDMSG ;SEND IT
JRST SENDS2 ;LOSE!
JRST CPOPJ1##
SENDS2: HLRZ T1,P2 ;GET MSG LENGTH
ADDI T1,.IPCFD ;ADD HDR SIZE
HRRZ T2,P1 ;GET ADR
SOS %CNIIP## ;1 LESS MESSAGE
PJRST GIVWDS## ;RETURN SPACE AND RETURN
;GETPKT -- GET A PACKET OF FREE CORE. CALL WITH T2 CONTAINING
; NUMBER OF WORDS NEEDED. RETURNS WITH ADDRESS OF PACKET
; IN T1. GETPKT "WAITS" IF NO FREE SPACE IS AVAILABLE. ALWAYS
; RETURNS CPOPJ.
GETPKT: PUSH P,T2
GETPK0: PUSHJ P,GETWDS## ;GET THE FREE SPACE
JRST GETPK1 ;LOSE, WAIT
JRST T2POJ1## ;WIN!!
GETPK1: JUMPE J,T2POPJ## ;LOSE IF AT INTERRUPT LEVEL
PUSH P,J
ANDI J,JOBMSK##
PUSH P,W
PUSHJ P,FNDPDS## ;POINT W AT THE PDB
MOVEI T1,1 ;ONE SECOND
PUSHJ P,SLEEPF## ;SLEEP
POP P,W
POP P,J
MOVE T2,(P)
JRST GETPK0 ;AND TRY AGAIN
;CHKSID -- CHECK IF PID IS ONE OF THE "FRIENDS OF THE MONITOR"
;CALLED WITH T1=THE PID
;RETURNS WITH T2=OFFSET FROM .GTCSD
;RETURNS CPOPJ IF TRUE, CPOPJ1 OTHERWISE
CHKSID: MOVEI T2,SDTBLN##+<.GTSID##-.GTCSD##> ;NUMBER OF PIDS
CHKS.1: CAMN T1,.GTCSD##(T2) ;THIS IT
POPJ P, ;YES, RETURN
SOJGE T2,CHKS.1 ;NO, TRY THE NEXT
JRST CPOPJ1## ;NOT A SYSTEM PID
SUBTTL LOCK UUO INTERFACE
IFN FTLOCK,<
;SUBROUTINE TO FIND AN INCORE IPCF PAGE IN SOME JOB'S IPCF QUEUE
;CALL WITH T2=PHYSICAL PAGE NUMBER, U=DISK ADDRESS TO REPLACE IT WITH
;RETURNS CPOPJ IF NOT FOUND, RETURNS CPOPJ1 IF FOUND, DISK ADDRESS STORED
LOKIPC::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVJW## ;SAVE J AND W
MOVE J,HIGHJB## ;SCAN ALL JOBS
LOKIP1: MOVE T1,J ;COPY JOB NUMBER
TLO T1,400000 ;STEP THROUGH CONTEXT BLOCKS
PUSHJ P,CTXIPC## ;FIND THIS JCH'S IPCF DATA BASE
JRST LOKIP4 ;NO PAGES IN ITS QUEUE IF NO PDB
XMOVEI T1,.EPIPC-.IPCFL(W) ;SET PREDESESSOR
LOKIP2: HLRZ T1,.IPCFL(T1) ;NEXT ENTRY IN THE QUEUE
JUMPE T1,LOKIP3 ;GO IF THE LAST
MOVE T3,.IPCFI(T1) ;ADDRESS OF PAGE IF IT IS ONE
TLZ T3,(IP.NAD^!IP.DSK) ;CLEAR ALL BUT ADDRESS AND DISK BIT
CAME T2,T3 ;SAME PHYSICAL PAGE?
JRST LOKIP2 ;NO, LOOK ON
DPB U,PKADT1 ;STORE DISK ADDRESS WHERE IT WILL
; BE ON THE SWAPPING SPACE
JRST CPOPJ1## ;FOUND RETURN
LOKIP3: TRNE J,CTXMSK## ;CTXSER LOADED?
JRST LOKIP1 ;YES--GO DO IT FOR NEXT CONTEXT
LOKIP4: ANDI J,JOBMSK## ;REDUCE TO A JOB NUMBER
SOJG J,LOKIP1 ;LOOK AT THE NEXT JOB'S QUEUE
POPJ P, ;PAGE NOT IN ANY QUEUE
>
SUBTTL IPCF QUEUE INTERLOCK
;ROUTINE TO LOCK THE JOB'S IPCF QUEUE
;REQUIRES J SET UP.
IPCLOK::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVJW## ;SAVE J AND W
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVE T1,J ;TARGET JCH
IPLOK1:
PUSH P,T1 ;SAVE T1
ANDI T1,JOBMSK## ;JOB ONLY
PUSHJ P,UPCX## ;GET THE CX RESOURCE
POP P,T1 ;RESTORE FULL JCH
PUSHJ P,CTXIPC## ;SET UP J AND W
JRST IPLOK4 ;NO SUCH JOB OR CONTEXT
SKIPN J ;NULL JOB (EXEC PROCESS)?
TRO J,CTXMSK## ;GIVE IT A CONTEXT NUMBER JUST FOR THIS
IPLOK2: MOVE T1,.CPJCH## ;GET OUR JCH
MOVEI T2,-1 ;MASK FOR TARGET JCH
SYSPIF ;AVOID RACES
TDNE T2,.EPIPL(W) ;SOMEONE ALREADY OWN THIS GUY'S INTERLOCK?
JRST IPLOK5 ;YES--MUST WAIT
HRRM T1,.EPIPL(W) ;ELSE SET OUR JCH AS HIS OWNER
MOVE T1,.CPJOB
HLLZS JBTIPC##(T1) ;CLEAR WE MIGHT HAVE BEEN WAITING
PUSHJ P,FPDBT1## ;GET PDB
JRST [HLLZS .EPIPL(W) ;DON'T OWN IT AFTER ALL
JRST IPLOK4 ] ;??
HRLM J,.PDIPL##(T1) ;SAVE WHOSE JCH WE OWN
SYSPIN ;TURN PI SYSTEM ON AGAIN
IPLOK4:
PUSHJ P,DWNCX## ;GIVE UP CX ON JOB
JRST TTPOPJ## ;RESTORE T1, T2, AND RETURN
IPLOK5: SYSPIN
MOVEI T2,IPQ## ;PUT JOB IN
EXCH T1,J ;.CPJCH-->J,TARGET TO T1
ANDI J,JOBMSK## ;JOB ONLY
DPB T2,PJBSTS## ;IN IP INTERLOCK WAIT
HRRM T1,JBTIPC##(J) ;SAVE THE JCH WE WANT
PUSHJ P,DWNCX## ;GIVE UP THAT JOB'S CX
POP P,T2
POP P,T1
PJRST WSCHED## ;WAIT
; HERE TO UNLOCK AN IPCF QUEUE
IPCULK::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVJW## ;SAVE J AND W
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
HRRZ T1,.CPJOB## ;GET OUR JOB NUMBER
;WE ARE NOT GETTING THE CX FOR OUR OWN PDB HERE SINCE AT UUO LEVEL
;IF IT EVER BECOMES NECESSARY TO DO SO, MUST BE SURE CALLERS OF THIS ROUTINE
;DON'T ALREADY HAVE A CX
PUSHJ P,FPDBT1## ;GET OUR PDB ADDR
JRST TTPOPJ## ;??
MOVE T2,T1 ;COPY
MOVSI T1,-1 ;INTERLOCKED JOB MASK
AND T1,.PDIPL##(T2) ;TRANSFER JCH TO T1
ANDCAM T1,.PDIPL##(T2) ;CLEAR THAT WE OWN A THIS JCH'S INTERLOCK
HLRZS T1 ;MAKE IT A REAL JOB/CONTEXT HANDLE
PUSH P,F ;SAVE F
JUMPE T1,IPCUL4 ;HMMM....
PUSHJ P,[MOVE F,T1
ANDI T1,JOBMSK## ;UPCX AND FRIENDS ONLY NEED JOB
PUSHJ P,CXOWN## ;OWN THE CX?
PUSHJ P,GGVCX## ;NO, GET IT
MOVE T1,F ;GET JOB #
PUSHJ P,CTXIPC## ;SET UP J AND W FOR TARGET JCH
POPJ P, ;IT WENT AWAY?
HLLZS .EPIPL(W) ;CLEAR OUR JOB NUMBER
POPJ P, ] ;RETURN
IPCUL4: SETZ F,
PUSHJ P,[PUSH P,T1 ;SAVE T1 (SRFREE ALREADY HAD)
PUSH P,J ;SAVE J (SRFREE ALREADY HAD)
MOVE J,.CPJOB
PJRST SRFRIP##]
POP P,F
JRST TTPOPJ## ;RESTORE T1, T2 AND RETURN
;HERE SO SCHEDULAR CAN CHECK TO SEE IF WE OWN AN IPCF RESOURCE
;SKIP RETURN IF DO, NON-SKIP IF DON'T
OWNIP:: PUSH P,T1 ;SAVE T1
MOVEI T1,(J) ;CURRENT JOB
PUSHJ P,GETCX## ;TRY TO GET OUR OWN CX RESOURCE
JRST .-1 ;HOPE WE DON'T KAF
PUSHJ P,FPDBT1## ;FIND PDB
JRST TSTIP1
HLRZ T1,.PDIPL##(T1) ;INTERLOCK WORD
SKIPE T1 ;OWN ANYONE'S?
AOS -1(P) ;YES
TSTIP1: PUSHJ P,GIVCX## ;RETURN CX
JRST TPOPJ## ;DO OWN SOMEONES
;HERE FOR UNWIND CODE IN SCHED1. RETURNS IN T3 THE JOB # OF THE JOB WHO OWNS
;THE IPCF INTERLOCK WHICH THE JOB IN J DESIRES
UNWIPC::SE1ENT ;ENTER SECTION 1
HRRZ T3,JBTIPC##(J) ;GET THE JCH HE WANTS
JUMPE T3,CPOPJ## ;
PUSHJ P,SAVJW## ;SAVE J,W
PUSH P,T1 ;AND T1
MOVE J,T3 ;DESIRED JCH
ANDI J,JOBMSK##
PUSHJ P,GETCX## ;CAN WE GET HIS?
JRST NIPUNW ;FLAG CAN'T TELL WHO OWNS IP
MOVE T1,T3 ;DESIRED JCH
PUSHJ P,CTXIPC## ;CALL CTXSER
JRST NIPOWN ;FLAG IP UNOWNED
HRRZ T3,.EPIPL(W) ;GET THE OWNER JCH
ANDI T3,JOBMSK##
PUSHJ P,GIVCX## ;RETURN CX
JRST TPOPJ##
NIPOWN: TDZA T3,T3 ;NO OWNER
NIPUNW: SETO T3, ;CAN'T UNWIND SINCE CAN'T FIND WHO OWNS IP
PUSHJ P,GIVCX##
JRST TPOPJ##
;HERE FROM SCHEDULAR TO GIVE JOB IN J THE IPCF RESOURCE HE WANTS
;SKIP RETURN IF GOT IT, ELSE NON-SKIP
SCDIP:: SE1ENT ;ENTER SECTION 1
HRRZ T3,JBTIPC##(J) ;GET THE JCH HE WANTS
JUMPE T3,CPOPJ## ;
PUSHJ P,SAVJW## ;SAVE J,W
MOVEI J,(T3) ;GET JOB # FOR THIS JCH
ANDI J,JOBMSK##
PUSHJ P,GETCX## ;SEE IF CAN GET CX
POPJ P, ;LOSE IF CAN'T GET IT
PUSH P,T1 ;AND T1
MOVE T1,T3 ;DESIRED JCH
PUSHJ P,CTXIPC## ;CALL CTXSER
JRST SCDIP1 ;WAKE JOB ANYWAY
PUSH P,T2 ;CTXSER USES T2
SYSPIF
HRRZ T3,.EPIPL(W) ;GET THE OWNER JCH
JUMPN T3,[SYSPIN ;OH WELL, SOMEONE ELSE SNUCK IN
PUSHJ P,GIVCX##
JRST TTPOPJ##]
HRRZ T1,-4(P) ;GET OUR JCH
PUSHJ P,CTXJCH##
HRRZ T1,-4(P) ;HUH?
HRRM T1,.EPIPL(W) ;WE OWN IT
ANDI T1,JOBMSK
HLLZS JBTIPC##(T1) ;CLEAR OUR WAITING
PUSHJ P,FPDBT1## ;GET PDB
CAIA ;HUH?
HRLM J,.PDIPL(T1) ;SET OUR OWNING
SYSPIN
POP P,T2
SCDIP1: PUSHJ P,GIVCX##
JRST TPOPJ1##
SUBTTL MIGRATION
;SUBROUTINE TO FIND SWAPPED-OUT IPCF PAGES ON A UNIT BEING REMOVED FROM THE ASL
;RETURNS CPOPJ1 IF A PAGE IS FOUND, T4 = DISK ADDRESS OF PAGE,
; T1 = THE ADDRESS IN THE IPCF PACKET CONTAINING THE DISK ADDRESS
; CPOPJ IF NO MORE IPCF PAGES ON THE UNIT BEING REMOVED
FNDIPC::SKIPA J,HIGHJB## ;SCAN ALL JOBS
FNDIP0::MOVM J,MIGRAT## ;START WITH JOB WE LEFT OFF WITH
SE1ENT ;ENTER SECTION 1
PUSH P,J ;SAVE IT
FNDIP1: MOVE T1,(P) ;NEXT
TLO T1,(1B0) ;SET STEP FLAG FOR CTXSER
PUSHJ P,CTXIPC## ;SAVE IT
JRST FNDIP4 ;NO PAGES IN ITS QUEUE IF NO PDB
PUSHJ P,IPCLOK
MOVEM J,(P) ;SAVE LAST CONTEXT
ANDI J,JOBMSK ;KEEP JUST JOB # FOR COMPARISON
MOVN T1,MIGRAT## ;GET CURRENT MIGRATE IPCF JOB
CAILE T1,(J) ;IF NEW JOB LESS THAN OLD JOB THEN
MOVNM J,MIGRAT## ;FLAG LOOKING AT THIS JOB
XMOVEI T1,.EPIPC-.IPCFL(W) ;SET PREDESESSOR
FNDIP2: HLRZ T1,.IPCFL(T1) ;NEXT ENTRY IN THE QUEUE
JUMPE T1,FNDIP3 ;GO IF THE LAST
SKIPL T4,.IPCFI(T1) ;DISK ADDRESS?
JRST FNDIP2 ;NO, LOOK ON
TLZ T4,(IP.NAD) ;DON'T CONFUSE VMSER WITH BAD MAP CONTENTS
PUSHJ P,TSTUN## ;ON THE UNIT BEING REMOVED FROM THE ASL?
JRST [LDB T4,PKADT1 ;GET DISK ADDRESS
MOVEI T1,.IPCFI(T1) ;WHERE TO STORE NEW DSK ADDR WHEN MIGRATED
POP P,(P) ;FIX STACK
JRST CPOPJ1##] ;GIVE PAGE FOUND RETURN
JRST FNDIP2
FNDIP3: PUSHJ P,IPCULK
JRST FNDIP1 ;LOOK AT NEXT CONTEXT
FNDIP4: SOJLE J,TPOPJ## ;FIX STACK AND RETURN
MOVEM J,(P)
JRST FNDIP1 ;CHECK NEXT JOB
;ROUTINE CALLED ON IPCF SEND FROM VMSER (IPCRMV) TO GET INTERLOCK
;FOR RECEIVING JOB AND WAIT UNTIL SAFE WRT SWAP MIGRATION.
;CALL WITH P3=ADDRESS OF PACKET, T1=PAGE NUMBER
;ALL ACS PRESERVED
IPMCHK::SE1ENT ;ENTER SECTION 1
PUSHJ P,SAVT## ;BE SAFE NOW
PUSH P,J
PUSH P,W ;SAVE J,W
MOVE T1,.IPCFR(P3) ;RECEIVER
PUSHJ P,VALPID
JRST IPCSOK ;SHOULDN'T HAPPEN
IPMCK1: MOVE T1,-3(P) ;RESTORE PAGE NUMBER
PUSHJ P,IPCLOK ;LOCK RECIEVER'S IPCF QUEUE
PUSHJ P,GTPME## ;GET PAGE MAP SLOT
MOVE T3,T2 ;SAVE MAP CONTENTS
PUSHJ P,TSWST## ;IS IT IN THE WORKING SET?
SKIPA T4,T3 ;NO, CHECK MORE
JRST IPCWS ;SEE IF SHOULD WAIT FOR FILFND
PUSHJ P,TSTUN## ;IS IT ON THE BAD UNIT?
CAIA ;YES, MUST WAIT
JRST IPCSOK ;NO, CAN JUST RETURN WITH INTERLOCK
MOVN T1,MIGRAT## ;SEE IF ANYTHING BEING MIGRATED
JUMPE T1,IPCSOK ;"0" IS A SPECIAL CASE
CAILE T1,(J) ;HAS THE IPCF STUFF ALREADY PASSED US?
JRST IPCSOK ;NO, RETURN
IPCSWT: PUSHJ P,IPCULK ;UNLOCK QUEUE
PUSHJ P,IPMWAT## ;YES, MUST WAIT ON PAGE
JRST IPMCK1 ;GET INTERLOCK AND TRY AGAIN
IPCWS: SKIPGE MIGRAT## ;IS FILFND WAITING FOR PAGING QUEUES TO CLEAR?
JRST IPCSWT ;YES, DON'T CLUTTER THEM UP
IPCSOK: POP P,W ;RESTORE OLD J,W
POP P,J
POPJ P,
;SUBROUTINE TO SET IPCF QUOTA IF NOT SET. USES T2. W POINTS TO IPCF BLOCK
;TO SET QUOTA IN
;NOTE THAT THIS CAN BE DONE FASTER WITH MOVE/MOVEM OF .EPIPQ, THAT
;IS A RACE WITH THE CLEARING OF THE JOB IN .EPIPQ IN ROUTINE IPCULK
;RETURNS WITH .EPIPQ(W) IN T2
SETIPQ: MOVE T2,.EPIPQ(W) ;GET QUOTA WORD
TLNE T2,IP.HBS ;BEEN SET?
POPJ P, ;YES, DO NOTHING
HRLOI T2,IP.HBS!777 ;SAVE ALL LH BITS EXCEPT QUOTA
ANDCAM T2,.EPIPQ(W) ;CLEARING ANY QUOTA THERE
MOVE T2,%CNIPQ## ;VALUE + 'SET' BIT
TSO T2,%CNIPD## ;ADD IN PID QUOTA DEFAULT
IORB T2,.EPIPQ(W) ;SET DEFAULTS
POPJ P,
LIT
IPCEND: END