!TITLE A General Interface to Director Facilities
!<DPROCEDURE
externalintegerfn  DPROCEDURE(integer  ACT, ADR)
!
! This procedure provides a general interface to Director to allow
! new facilities to be tested easily
!
! ACT is an activity number and ADR the address of a record
!
! ACT = 1
!        Returns Directors 'proclist'.  In this case, ADR is the
!        address of a record of format:
!           %integername N, %integer A
!        the proclist entries are returned to address A onwards and
!        the number of entries is returned in N.  Currently each
!        proclist entry is 56 bytes long, but is liable to change.
!
! ACT = 2
!        Allows the caller to 'fork' another invocation of his own process.
!        ADR is the address of a record of format:
!           %integer INVOC, %string(31)PARAM
!        The new invocation number is returned in INVOC and PARAM
!        is placed in the UINF record of the new invocation as
!        UINF_SPOOLRFILE.  The caller should disable the IO streams
!        before calling this procedure.  Director disconnects the
!        streams and reconnects them subsequently to the new
!        invocation.
! ACT = 3
!        Sends a message to another invocation of your own process.
!        ADR is the address of a record of format:
!           %record(PARMF) P, %integer INVOC, MSGTYPE, OUTNO)
!>
INTEGER  J, CUR, A, SEG, GAP, SIZE, L, FINDAD
!
STRING (127)W
STRING (6)UNA
STRING (11)INA
STRING (18)INDEX, S11
STRING (18)FILENAME
RECORD (LOGFHDF)NAME  LH
RECORD (PROCDATF)NAME  PROCDAT
!
RECORDFORMAT  R1F(INTEGER  N, A)
RECORD (R1F)NAME  R1
!
RECORDFORMAT  R2F(INTEGER  INVOC, STRING (31)PARAM)
RECORD (R2F)NAME  R2
!
RECORDFORMAT  R3F(RECORD (PARMF)P, INTEGER  INVOC, MSGTYPE, OUTNO)
RECORD (R3F)NAME  R3
!
RECORDFORMAT  R4F(STRING (31)FILEINDEX, STRING (127)NODE, INTEGER  FSYS)
RECORD (R4F)NAME  R4
!
CONSTRECORD (UINFF)NAME  UINF = 9 << 18
CONSTINTEGER  TOPACT = 4
SWITCH  SW(1 : TOPACT)
      J = IN2(44)
      -> OUT UNLESS  J = 0
!
      J = 8
      -> SW(ACT) IF  1 <= ACT <= TOPACT
!
      -> OUT
SW(1):          ! Return Director's proclist
      SIZE = SIZEOF(PROCDAT)
      R1 == RECORD(ADR)
      R1_N = 0
      A = R1_A
!
      FILENAME = "VOLUMS.#LOGMAP"
      SEG = 0
      GAP = 0
      J = DCONNECTI(FILENAME, -1, WRSH, 0, SEG, GAP)
      -> OUT UNLESS  J = 0 OR  J = 34
!
      LH == RECORD(SEG<<18 + X'10000')
      CUR = LH_BACKHD
      WHILE  CUR # ENDLIST CYCLE 
         PROCDAT == RECORD(A)
         PROCDAT = LH_PROCLIST(CUR)
         R1_N = R1_N + 1
         A = A + SIZE
         CUR = LH_PROCLIST(CUR)_BLNK
      REPEAT 
      J = DDISCONNECTI(FILENAME, -1, 0) IF  J = 0
      -> OUT
SW(2):
      R2 == RECORD(ADR)
      J = STARTP(UINF_USER, R2_PARAM, UINF_ITADDR, R2_INVOC,
               UINF_FSYS, UINF_STARTCNSL, 5, UINF_STREAMID, UINF_DIRVSN,0)
      -> OUT
SW(3):
      R3 == RECORD(ADR)
      -> OUT UNLESS  1 <= R3_MSGTYPE <= 3
      -> OUT UNLESS  5 <= R3_OUTNO <= 10
      R3_P_DEST = X'FFFF0009'
      R3_P_P1 = (UINF_ISUFF<<24) ! (R3_P_P1<<8>>8)
      J = DPON3I(PROCUSER, R3_P, R3_INVOC, R3_MSGTYPE, R3_OUTNO)
      -> OUT
SW(4):        ! Dselectnode
! The node name is checked for good syntax but not existence
      R4 == RECORD(ADR)
      L = LENGTH(R4_NODE)
      R4_NODE = R4_NODE . NSEP UNLESS  L > 0 AND  CHARNO(R4_NODE, L) = NSEPCH
!
      IF  R4_NODE -> W . (".") . R4_NODE C   {allow NODE to specify the whole thing}
      THEN  W = R4_FILEINDEX . W C 
      ELSE  W = R4_FILEINDEX
!
      J = UIO(W, UNA, INA, INDEX)
      -> OUT UNLESS  J = 0
!
      J = FINDA(INDEX, R4_FSYS, FINDAD, 2); ! just to get fsys
      -> OUT UNLESS  J = 0
!
      IF  LENGTH(R4_NODE) > 1 START 
         W = R4_NODE
         CYCLE 
            W -> S11 . (NSEP) . W
            J = S11OK(S11)
            -> OUT UNLESS  J = 0
            EXIT  IF  W = ""
         REPEAT 
      FINISH 
!
      SELECTED INDEX = INDEX
      SELECTED NODE = R4_NODE
      SELECTED FSYS = R4_FSYS
      J = 0
      -> OUT
OUT:
      RESULT  = OUT(J, "")
END ; ! DPROCEDURE
!
!-----------------------------------------------------------------------
!