!TITLE Message Passing Procedures
! System components communicate by passing messages to each other.
! This chapter describes the procedures which support this.
!<DOUT
externalroutine DOUT(record (PARMF)name P)
!
! This is equivalent to DPON3("",P,0,0,7), causing the message P to be
! dispatched and the calling process to be suspended until a reply
! on the process's "sync2" service number is available, it is then
! received into the record P.
!>
INTEGER J
J = IN2(256 + 57)
-> OUT UNLESS J = 0
!
J = 93
-> OUT UNLESS DTRYING << 13 < 0
!
J = 45
-> OUT IF VAL(ADDR(P), 32, 1, D CALLERS PSR) = NO
!
J = 0
DOUTI(P)
OUT:
WRSN("DOUT ERROR", J) UNLESS J = 0
J = OUT(J, "")
END ; ! DOUT
!
!-----------------------------------------------------------------------
!
ROUTINE BELCH(RECORD (PARMF)NAME P, STRING (15)PREF)
INTEGER I, J, CH, PREV
PREC(PREF . " ", P, 1)
J = ADDR(P_P1)
PREV = -1
CYCLE I = J,1,J+23
CH = BYTEINTEGER(I)
CH = ' ' UNLESS 32 < CH < 127
PRINTSYMBOL(CH) UNLESS CH=' '=PREV
PREV = CH
REPEAT
NEWLINE
END ; ! BELCH
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE DPOFFI(RECORD (PARMF)NAME P)
RECORD (PARMF)NAME Q
LOUTP STATE="DPOFF"
Q == RECORD(OUTPAD); !ADDRESS OF OUT RECORD
Q_DEST = 0; !SET DEST TO ZERO
*OUT_5; !CALL TO WAIT FOR NEXT MSG
MONITOR IF Q_DEST < 0; !BAD PARAMS
P = Q; !COPY MESSAGE POFF"D TO USER AREA
BELCH(P,"POFF") UNLESS DIRMON = 0
LOUTP STATE="DPOFF exit"
END ; ! DPOFFI
!
!-----------------------------------------------------------------------
!
ROUTINE DPOFF2(RECORD (PARMF)NAME P, INTEGER SAVEID)
! FOR A SYNC2 MSG TYPE
RECORD (PARMF)NAME Q
LOUTP STATE = "DPOFF2"
Q == RECORD(OUTPAD)
Q_DEST = 0
OUT:
*OUT_7
P = Q
MONITOR IF P_DEST < 0
!
UNLESS P_DEST & X'FFFF' = SAVEID START
BELCH(P, "NREQ")
Q_DEST = 0
-> OUT
FINISH
BELCH(P, "POFF2") UNLESS DIRMON = 0
LOUTP STATE = "DPOFF2 exit"
END ; ! DPOFF2
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE DPONI(RECORD (PARMF)NAME P)
RECORD (PARMF)NAME Q
LOUTP=P
LOUTP STATE = "DPON"
BELCH(P, "PON") UNLESS DIRMON = 0
Q == RECORD(OUTPAD); !MAP REQUEST BLOCK FORMAT
Q = P; !COPY PARAMETERS TO "OUT" REQUEST AREA
*OUT_6; !CALL PON SERVICE
MONITOR IF Q_DEST < 0; !FAILURE?
LOUTP STATE="DPON exit"
END ;! DPONI
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE DOUTI(RECORD (PARMF)NAME P)
RECORD (PARMF)NAME Q
INTEGER SAVID
INTEGER SERV
SERV = P_DEST >> 16
SRCE ID=(SRCE ID + 1) & X'FFFF'
SAVID=SRCE ID
P_SRCE=(P_SRCE&X'FFFF0000') ! SAVID
BELCH(P, "OUTin") UNLESS DIRMON = 0
LOUTP=P
LOUTP STATE="DOUT"
Q == RECORD(OUTPAD); !MAP REQUEST BLOCK FORMAT
Q = P; !COPY PARAMETERS TO "OUT" REQUEST AREA
DOUT AGAIN:
*OUT_7; !CALL OUT SERVICE
P = Q; !COPY RETURNED PARAMETERS
MONITOR IF P_DEST < 0; !FAILURE
IF P_DEST&X'FFFF'#SAVID START
BELCH(P, "NREQ") UNLESS SERV = 7; ! SEMA!
Q_DEST=0; ! POFF
-> DOUT AGAIN
FINISH
BELCH(P, "OUTout") UNLESS DIRMON = 0
LOUTP STATE="DOUT exit"
END ; ! DOUTI
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE DOUT11I(RECORD (PARMF)NAME P)
RECORD (PARMF)NAME Q
BELCH(P, "OUT11in") UNLESS DIRMON = 0
LOUTP=P
LOUTP STATE="DOUT11"
Q == RECORD(OUTPAD)
Q = P
*OUT_11
P = Q
MONITOR IF P_DEST < 0
BELCH(P, "OUT11out") UNLESS DIRMON = 0
LOUTP STATE="DOUT11 exit"
END ; ! DOUT11I
!
!-----------------------------------------------------------------------
!
EXTERNALINTEGERFN DPON3I(STRING (6)USER, RECORD (PARMF)NAME P, C
INTEGER INVOC, MSGTYPE, OUTNO)
RECORD (PARMF)NAME Q
LONGLONGREAL LLR
INTEGER LRAD,J,CH,RELAY,SAVID
SWITCH OUTSW(4:10)
UNLESS DIRMON = 0 START
IF P_DEST>>16=X'FFFF' THEN PRINTSTRING("!".USER."!")
BELCH(P, "PON3")
FINISH
!
LOUTP=P
LOUTP STATE="DPON3 ".TOSTRING(OUTNO+'0')." ".USER
!
Q==RECORD(OUTPAD)
Q=P
RELAY=0
IF Q_DEST>>16=X'FFFF' START ; ! set up the long long real : USER+INVOC+MSGTYPE
RELAY=1
LRAD=ADDR(LLR)
CYCLE J=0,1,15
IF J<=6 THEN CH=BYTEINTEGER(ADDR(USER)+J) ELSE CH=0
IF J=7 THEN CH=INVOC
! FOR SYNC1 MSGS, RH END OF ACC TO BE 1
! SYNC2 2
! ASYNC 3
CH=MSGTYPE IF J=15
BYTEINTEGER(LRAD+J)<-CH
REPEAT
FINISH
!
J = 0
OUTNO=4 UNLESS 5<=OUTNO<=10
-> OUTSW(OUTNO)
!
OUTSW(4): Q_DEST=-1; -> R1
OUTSW(5): IF RELAY#0 START ; *LSQ_LLR; FINISH ; *OUT_5; -> R0
OUTSW(6): IF RELAY#0 START ; *LSQ_LLR; FINISH ; *OUT_6; -> R0
OUTSW(7):
SRCE ID=(SRCE ID + 1)&X'FFFF'
SAVID=SRCE ID
Q_SRCE=(Q_SRCE&X'FFFF0000') ! SAVID
IF RELAY#0 START ; *LSQ_LLR; FINISH
OUT AGAIN:
*OUT_7
IF Q_DEST#0 AND Q_DEST&X'FFFF'#SAVID START
P=Q
DDUMP(ADDR(P),ADDR(P)+32,-1,-1)
Q_DEST=0; ! POFF
-> OUT AGAIN
FINISH
-> R0
OUTSW(8): IF RELAY#0 START ; *LSQ_LLR; FINISH ; *OUT_8; -> R0
OUTSW(9): IF RELAY#0 START ; *LSQ_LLR; FINISH ; *OUT_9; -> R0
OUTSW(10): IF RELAY#0 START ; *LSQ_LLR; FINISH ; *OUT_10
R0:
IF RELAY#0=Q_DEST THEN J=61; ! PROCESS NOT PRESENT
R1:
P=Q
LOUTP STATE="DPON3 exit"
RESULT = J
END ; ! DPON3I
!
!-----------------------------------------------------------------------
!
!<DOUT11
externalroutine DOUT11(record (PARMF)name P)
!
! This invokes the Supervisor "OUT" no. 11, which causes the message
! P to be dispatched and the calling process's pages to remain in
! main store until a reply is available (not one of the sync1,
! sync2 or async replies referred to above, but one having the DEST
! field equal to the SRCE field of the outgoing message, the Local
! Controller having set the left-hand half of SRCE). The reply is
! received in the record P.
! This "OUT" number should be invoked only when it is certain that
! a reply will be received, and in a very short time (e.g. the
! duration of a single magnetic tape transfer).
!>
INTEGER J
!
J = IN2(256 + 58)
-> OUT UNLESS J = 0
!
J = 93
-> OUT UNLESS DTRYING << 13 < 0
!
J = 45
-> OUT IF VAL(ADDR(P), 32, 1, D CALLERS PSR) = NO
!
J = 0
DOUT11I(P)
OUT:
WRSN("OUT11 ERROR", J) UNLESS J = 0
J = OUT(J, "")
END ; ! DOUT11
!
!-----------------------------------------------------------------------
!
!<DOUT18
externalroutine DOUT18(record (PARMF)name P)
!
! This invokes the Supervisor "OUT" no. 18, which causes the message
! P to be dispatched with the following side effects:
! 1. The local virtual store described by P_P5 and P_P6 (P5 = number
! of bytes, not exceeding (2**24)-1, P6 = address of start of
! area) is held in main store until a reply is available
! corresponding to the dispatched message.
! 2. Director places the caller's ACR value in bits 4-7 of P_P5 before
! executing the OUT instruction.
! 3. The Local Controller replaces the contents of P5 and P6 with the
! Local Segment Table base and limit for the process, and the ACR
! value, as required for the first two words of a GPC request
! block.
! 4. The caller may in addition set bit 0 of P_P5, in this case the
! Local Controller marks the page table entry (or entries)
! describing the store area as "written-to", thus ensuring that
! the pages are returned to disc when the process is removed from
! store, if required. (The GPC does not so mark page table
! entries into which it transfers data, for example.)
!
! On return from this routine, the caller should check that P_DEST is
! not -1, which indicates either a failure to "lock down" the
! specified area of store or a condition preventing dispatch of the
! message.
!>
! ROUTINE TO "OUT" A MESSAGE USING THE DIRECTOR "OUT" FACILITY
! OUT 18 IS USED. THE PROCESS IS SUSPENDED IN STORE
! UNTIL A REPLY IS RECEIVED ON SERVICE XC0+PROCESS NUMBER
RECORD (PARMF)NAME Q
INTEGER ADR,LEN,DUM,K,TIMES,EPAGE BYTES, J
J = IN2(256 + 59)
-> OUT UNLESS J = 0
!
J = 93
-> OUT UNLESS DTRYING << 13 < 0
!
ADR=P_P6
LEN=P_P5<<1>>1; ! WITHOUT TOP BIT,WHICH MAY BE USED TO
! INDICATE THAT "WRITTEN-TO" BITS ARE TO BE SET FOR THE PAGES
! BY THE SUPERVISOR
!
J = 45
-> OUT UNLESS VAL(ADR, LEN, 1, D CALLERS PSR) = YES
!
J = 0
! PLACE CALLER'S ACR INTO LEN WORD IN THE RECORD
P_P5=P_P5 ! (DCALLERS ACR<<24)
TIMES=0
EPAGE BYTES=EPAGE SIZE<<10
LOUTP=P
LOUTP STATE="DOUT 18"
BELCH(P, "OUT18in") UNLESS DIRMON = 0
Q == RECORD(OUTPAD); !MAP REQUEST BLOCK FORMAT
UNTIL TIMES>4 OR Q_DEST#-1 CYCLE
! NOW REFERENCE ALL THE PAGES
K=ADR & (¬(EPAGE BYTES - 1))
WHILE K<ADR+LEN CYCLE
DUM=BYTEINTEGER(K)
K=K+EPAGE BYTES
REPEAT
Q = P; !COPY PARAMETERS TO "OUT" REQUEST AREA
*OUT_18; !CALL OUT SERVICE
TIMES=TIMES+1
REPEAT
P = Q; !COPY RETURNED PARAMETERS
BELCH(P, "OUT18out") UNLESS DIRMON = 0
LOUTP STATE="DOUT 18 exit"
OUT:
WRSN("DOUT18 ERROR", J) AND P_DEST = -1 UNLESS J = 0
J = OUT(J, "")
END ; ! DOUT18
!
!-----------------------------------------------------------------------
!
!<DPOFF
externalroutine DPOFF(record (PARMF)name P)
!
! This is equivalent to DPON3("",P,0,0,5) with P_DEST set to zero. "No
! message is generated and the calling process is suspended until a
! message on the process's "sync1" service number is available, it is
! then received into the record P.
!
! It is not privileged since SS uses it for processes started
! from the OPER (D/START)
!>
! SUSPEND THE PROCESS TILL A MESSAGE ARRIVES
! OUT 5 IS USED WITH P_DEST>>16 ZERO.
INTEGER J
J = 45
-> OUT UNLESS VAL(ADDR(P), 32, 1, DCALLERSPSR) = YES
!
DPOFFI(P)
J = 0
OUT:
WRSN("DPOFF ERROR", J) UNLESS J = 0
END ; ! DPOFF
!
!-----------------------------------------------------------------------
!
!<DPON
externalroutine DPON(record (PARMF)name P)
!
! This is equivalent to DPON3("",P,0,0,6), causing the message P to be
! dispatched and allowing the calling process to continue processing.
!>
INTEGER J
J = IN2(63)
-> OUT UNLESS J = 0
!
J = 93
-> OUT UNLESS DTRYING << 13 < 0
!
J = 45
-> OUT IF VAL(ADDR(P), 32, 0, 0) = NO
!
J = 0
DPONI(P)
OUT:
WRSN("DPON ERROR", J) UNLESS J = 0
J = OUT(J, "")
END ; ! DPON
EXTERNALINTEGERFN DPON2(STRING (6)USER, RECORD (PARMF)NAME P,
INTEGER MSGTYPE, OUTNO)
INTEGER J
J = IN2(256+64)
-> OUT UNLESS J = 0
J = DPON3(USER, P, 0, MSGTYPE, OUTNO)
OUT:
RESULT = OUT(J, "")
END
!
!
!
!
!-----------------------------------------------------------------------
!
!<DPON3
externalintegerfn DPON3(string (6)USER, record (PARMF)name P,
integer INVOC, MSGTYPE, OUTNO)
!
! This function is used to pass System messages, as referred to in
! Ref. 10.
!
! Definitions:
!
! "PON" means send a message
!
! "POFF" means take next message, or if none available
! suspend until one is available
!
! "TOFF" means take next message if one available, otherwise
! set P_DEST=0 and continue execution
!
! "sync1", "sync2" and "async" service numbers, mean the "N2",
! "N3" and "N4" service numbers referred to in Ref. 10.
!
! No checking is performed by Director on the parameters passed to
! this procedure.
! USER is the 6-character username of a paged process to which
! the record P is to be sent. (Relevant only when the left-
! hand half of P_DEST=X'FFFF', see Ref. 10.)
!
! P is a record containing the 32-byte System message to be
! dispatched. (The right-hand halves of DEST and SRCE are
! unchanged during the process of dispatching the message,
! the left-hand half of SRCE, and also of DEST when the left-
! hand half of DEST=X'FFFF', are set by the Local Controller)
!
! INVOC is the invocation number of the paged process to which the
! record P is to be sent. (Relevant only when the left-hand
! half of P_DEST=X'FFFF', see Ref. 10).
!
! MSGTYPE should be set to 1, 2 or 3 to indicate that the message
! generated is of the sync1, sync2 or async (i.e. N2, N3 or
! N4) type respectively. (Relevant only when the LH half of
! P_DEST=X'FFFF').
!
! OUTNO is the "OUT" number which is to be used, valid numbers
! being 5, 6, 7, 8, 9 or 10 (see Ref. 10).
! The result of the function is always zero, except when the left hand
! half of P_DEST=X'FFFF', when it is 61 if there is currently no process
! owned by the given username, the message has not then been dispatched.
! P_DEST may be set on return to indicate error conditions, as described
! in Ref. 10.
!>
INTEGER J
!
J = IN2(256 + 65)
-> OUT UNLESS J = 0
!
J = 93
-> OUT UNLESS DTRYING << 13 < 0
!
J = 11
-> OUT IF P_DEST>>16=X'FFFF' AND UNOK(USER) # 0
!
J = 45
-> OUT IF VAL(ADDR(P), 32, 1, D CALLERS PSR) = NO
!
J = DPON3I(USER, P, INVOC, MSGTYPE, OUTNO)
OUT:
RESULT = OUT(J, "S")
END ; ! DPON3
!
!-----------------------------------------------------------------------
!
!<DTOFF
externalroutine DTOFF(record (PARMF)name P)
!
! This is equivalent to DPON2 ("",P,0,6) with P_DEST=0. No message is
! generated and the calling process always continues to execute. If
! no message on the process's "sync1" service number was available,
! P_DEST will still be zero, otherwise P contains the received
! message.
!>
! TEST FOR ANY MESSAGES QUEUING WITHOUT SUSPENDING PROCESS.
! OUT 6 IS USED WITH P_DEST>>16 SET TO ZERO.
RECORD (PARMF)NAME Q
INTEGER J
J = IN2(82)
-> OUT UNLESS J = 0
!
J = 45
-> OUT UNLESS VAL(ADDR(P), 32, 1, DCALLERSPSR) = YES
!
LOUTP STATE="DTOFF"
Q == RECORD(OUTPAD)
Q_DEST = 0
*OUT_6; !ANY MESSAGES?
MONITOR IF Q_DEST < 0; !FAILURE?
P = Q
BELCH(P, "TOFF") UNLESS DIRMON = 0
LOUTP STATE="DTOFF exit"
J = 0
OUT:
WRSN("DTOFF ERROR", J) UNLESS J = 0
J = OUT(J, "")
END ; ! DTOFF
!
!-------------------end-of-included-text---------------------------------
!