Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/diups2.b36
There are 4 other files named diups2.b36 in the archive. Click here to see a list.
%TITLE 'DIU Sender (slave and user job) IPCF routines'

MODULE DIUPS2 (IDENT = '253',
               LANGUAGE(BLISS36),
               ENTRY(ip_init,           ! Initialize IPCF stuff
                     ip_check,          ! Check to see if there is a master
                     ip_enter,          ! Enter a request in the queue
                     ip_delete,         ! Delete a request from the queue
                     ip_find,           ! Find a request or requests
                     ip_modify,         ! Modify a request
                     ip_status,         ! Report status of a transfer
                     ip_connect_me      ! Request connect to correct directory
                     )
               )=
BEGIN
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY: DIU-20 (Data Interchange Utility for TOPS-20)
!
! ABSTRACT:  This module provides the Interprocess communication facilities 
!            required by DIU User Jobs and DIU Slave Jobs for communication 
!            with the DIU Controlling Job.
!
! ENVIRONMENT:  TOPS-20 V6.1    XPORT
!               BLISS-36 V4     RMS V3.1
!
! AUTHOR: Larry Campbell                      CREATION DATE: March 21, 1982
%SBTTL 'Revision History'
! HISTORY:
!
!  253  Change IPCF20 library to DIUIP2.
!       Gregory A. Scott 1-Jul-86
!
!  252	Remove library of CONDIT.
!	Sandy Clemens  1-Jul-86
!
!  215  Delete routine IP_LIST, work is done in SHOQUE now.
!       Gregory A. Scott 3-Jun-86
!
!  174  Remove library TOPS20, use library MONSYM instead.
!       Gregory A. Scott 20-May-86
!
!  165  Remove qlist_indent macro since it is not used.  Use page 277 for slave
!       job IPCF pages to avoid interrupt/non-interrupt race problem with doing
!       commands from spooler job.
!       Gregory A. Scott 16-May-86
!
!  164  Call new routine SHOQUE rather than D$SHRQ from ip_list.
!       Gregory A. Scott 16-May-86
!
!  146  Errors returned from IP_TALK weren't getting signalled properly.
!       Gregory A. Scott 7-May-86
!
!  140  Add routine IP_CHECK which checks to see if there is a spooler.
!       Gregory A. Scott 4-May-86
!
!  135  Routine  IP_CONNECT_ME  now  puts  the  message  saying  that  we  have
!       connected somewhere in the log file itself,  rather  than  having other
!       routines do it.            
!       Gregory A. Scott 1-May-86
!
!  134  Previous edit made SHOW QUEUE with nothing in the queue signal an error
!       (from IP_FIND) so that you would get %DIU event 53: The queue is  empty
!       rather than [The queue is empty].
!       Gregory A. Scott 30-Mar-86
!
!  133  Add routine IP_TALK which sends a message  to  the spooler  and gets  a
!       response back.  It also sets the send/recieve quotas to +INF if we  are
!       the spooler.
!       Gregory A. Scott 29-Apr-86
!
!  126  Get a new  master PID from  the name  each time incase  the spooler  is
!       shutdown.
!       Gregory A. Scott 26-Apr-86
!
!  123  Zero the rcvpid in IP_INIT.
!       Gregory A. Scott 23-Apr-86
!
!  121  Remove historical code commented out by RDF who also probably moved all
!       of the comments to AFTER the code that it applies to.
!       Gregory A. Scott 19-Apr-86
!
!       V01-000 RDF0001         Rick Fricchione               10-Aug-1984
!               Convert from FTSIPS. Modify to use new request block 
!               and new routines.  Clean up code, and comment.
!
!       V00-00  AWN0001         Andy Nourse                   -no-date-
!               Allow multiple /NOTIFY options to be displayed by SHOW 
!               QUEUE. Put in ENTRY points.
!--
%SBTTL 'Libraries'

LIBRARY 'BLI:XPORT';                    ! XPORT package
LIBRARY 'DIU';                          ! DIU data structures
LIBRARY 'MONSYM';                       ! TOPS-20 monitor symbols
LIBRARY 'DIUIP2';                       ! IPCF macros
%SBTTL 'Forward Routine'

FORWARD ROUTINE
    ip_init : NOVALUE,                  ! Initialize IPCF stuff
    ip_check,                           ! Check if there is (yet) a spooler
    ip_talk,                            ! Talk to the spooler
    ip_enter,                           ! Enter a request in the queue
    ip_delete,                          ! Delete a request from the queue
    ip_find,                            ! Find a request or requests
    ip_modify,                          ! Modify a request
    ip_status,                          ! Report status of a transfer
    ip_connect_me;                      ! request connect to correct directory
%SBTTL 'Static Storage'

BIND ip_page = %O'277000' : BLOCK [512] FIELD (DIUQ$$MESSAGE_FIELDS);

OWN
    %IF %SWITCHES(DEBUG)
        %THEN my_name : $STR_DESCRIPTOR (STRING = '[SYSTEM]DIUDEB'),
        %ELSE my_name : $STR_DESCRIPTOR (STRING = '[SYSTEM]DIU'),
    %FI
    master_PID,                         ! PID to send to the spooler 
    slave_PID;                          ! PID to send from the slave

EXTERNAL
    mst_flag,                           ! 1 if we are (yet) the spooler
    rcvpid,                             ! PID to recieve spooler stuff on
    tty : $XPO_IOB ();                  ! IOB for terminal
%SBTTL 'External Routines'

EXTERNAL ROUTINE
    ip$get_pid,                         ! Get the PID of a process
    ip$quota : NOVALUE,                 ! Set the send/recieve quotas
    ip$send,                            ! Send an IPCF message
    ip$receive,                         ! Receive an IPCF message
    ip$delete_PID : NOVALUE,            ! Delete a PID
    s$jobno,                            ! Get our job number
    s$time,                             ! Return current date/time
    s$dtstr : NOVALUE,                  ! Convert date/time to string
    SHOQUE : NOVALUE,                   ! Display queue entries
    q$copy_req_block : NOVALUE,         ! Copy a request block
    q$release_chain : NOVALUE,          ! Release chain of request blocks
    q$valid_req_block;                  ! Validate a request block
%SBTTL 'Routine IP_INIT'

GLOBAL ROUTINE ip_init : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       Initialize the IPCF interface.
!
! FORMAL PARAMETERS
!
!       None
!
! IMPLICIT OUTPUTS
!
!       master_PID, slave_PID, rcvPID: zeroed
!--

rcvpid = 0;                             ! No recieve pid
master_PID = 0;                         ! No spooler pid
slave_PID = 0;                          ! No slave   pid

END;                                ! End of ip_init
%SBTTL 'Routine IP_CHECK'

GLOBAL ROUTINE ip_check =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       Check to see if there is (yet) a spooler job around.  Used in DIUC20 to
!       see if certain spooler command can typed because you are not (yet)  the
!       spooler.
!
! ROUTINE VALUE:
!
!       TRUE: there is a spooler out there somewhere, he may be you.
!       FALSE: there is not (yet) a spooler
!
!--
LOCAL s_pid;                            ! Temporary pid for our use

IF .mst_flag THEN RETURN TRUE;          ! If we are the spooler, return now

s_pid = 0;                              ! Make sure this is zeroed

IF ((IP$GET_PID(my_name,s_pid)) NEQ 0)  ! Is the spooler pid name assigned?
THEN BEGIN                              ! Yes
     IP$DELETE_PID(.s_pid);             ! Delete the pid we just got
     RETURN TRUE;                       ! There is a spooler out there
     END;

IF .s_pid NEQ 0                         ! Toss any pid we got
THEN IP$DELETE_PID(.s_pid);

RETURN FALSE;                           ! There is not (yet) a spooler

END;
%SBTTL 'Routine IP_TALK'

ROUTINE ip_talk =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       Send a page via IPCF to the spooler, get a response.  A new spooler job
!       pid and a new slave job pid is acquired each time through here.  A  new
!       slave pid is acquired to  insure we will bet  only one response to  our
!       messages, and a new master pid  is acquired to insure that the  spooler
!       job is (yet) started.
!
! IMPLICIT INPUTS
!
!       ip_page: filled with a page of data to send to the spooler
!
! IMPLICIT OUTPUTS
!
!       ip_page: filled with return (ack) message
!
! ROUTINE VALUE:
!
!       DIU$_NORMAL         - successful completion
!       DIU$_QUEUE_EMPTY    - the queue is empty
!       DIU$_NO_MASTER      - DIU master job not running
!       DIU$_NO_SEND        - can't send IPCF to master
!       DIU$_NO_RECEIVE     - can't receive IPCF from master
!
!--
LOCAL
    pdb : $$PDB_DECL,
    retcode;

! Flush PID so rcv queue is empty

IF .slave_pid NEQ 0 THEN IP$DELETE_PID(.slave_pid);
slave_pid = 0;

! Get a new master_PID each time to insure that the spooler is still there

IF (master_PID = IP$GET_PID (my_name, slave_PID)) EQL 0
THEN SIGNAL(DIU$_NO_MASTER);

! Set quotas to +inf if we are (yet) the spooler

IF .mst_flag THEN IP$QUOTA(.slave_pid, %O'777', %O'777');

! Send the message, page mode

IF NOT (retcode = IP$SEND (.master_PID, slave_PID, ip_page, 512))
THEN SIGNAL(DIU$_NO_SEND, .retcode<lh>);

! Try and receieve the response

pdb[PDB$$H_MESSAGE_ADDRESS] = ip_page;
pdb[PDB$$H_MESSAGE_LENGTH] = 512;
IF NOT (retcode = IP$RECEIVE (slave_PID, pdb,
                              %FIELDEXPAND (PDB$$H_MESSAGE_ADDRESS, 0) + 1))
THEN SIGNAL(DIU$_NO_RECEIVE, .retcode<lh>);

! Got a message, check code returned

IF .ip_page[DIUQ$B_FUNCTION] NEQ DIUQ$K_ACK
THEN RETURN(.ip_page[DIUQ$G_COMP_CODE]);

RETURN(DIU$_NORMAL)                     ! return OK

END;
%SBTTL 'Routine IP_ENTER'

GLOBAL ROUTINE ip_enter (p_req_block) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!   Enter a request in the queue.
!
! FORMAL PARAMETERS
!
!   p_req_block         - pointer to the request block
!
! IMPLICIT INPUTS
!
!   NONE
!
! IMPLICIT OUTPUTS
!
!   The request block is updated with the request ID number assigned.
!
! ROUTINE VALUE 
!
!   DIU$_NORMAL         - successful completion
!   DIU$_NO_MASTER      - DIU master job not running
!   DIU$_NO_SEND        - can't send IPCF to master
!   DIU$_NO_RECEIVE     - can't receive IPCF from master
!
!--
BIND
    req_block = .p_req_block : $DIU_BLOCK;

LOCAL
    retcode;

! Make some cursory validity checks on the request block

IF NOT (retcode = Q$VALID_REQ_BLOCK(req_block))
THEN RETURN (SIGNAL(.retcode));

! Set up the enter message.

Q$COPY_REQ_BLOCK(req_block,ip_page[DIUQ$Z_REQ_BLOCK]);
ip_page[DIUQ$H_LENGTH] = 512;
ip_page[DIUQ$B_FUNCTION] = DIUQ$K_ENTER;

! Send the message and get a response

IF NOT (retcode = IP_TALK())
THEN RETURN(.retcode);

! Copy the request block returned to the caller

Q$COPY_REQ_BLOCK(ip_page[DIUQ$Z_REQ_BLOCK], req_block);

RETURN(DIU$_NORMAL)                     ! return OK

END;                                    ! End of ip_enter
%SBTTL 'Routine IP_DELETE'

GLOBAL ROUTINE ip_delete (req_ID) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!   Delete a request from the queue.
!
! FORMAL PARAMETERS
!
!   req_ID              - the request ID of the request to be deleted
!
! IMPLICIT INPUTS
!
!   None
!
! IMPLICIT OUTPUTS
!
!   None
!
! ROUTINE VALUE 
!
!   DIU$_NORMAL         - completed OK
!   DIU$_NO_MASTER      - no master DIU running
!   DIU$_NO_SEND        - can't send to master DIU
!   DIU$_NO_RECEIVE     - can't read master's response
!    or any failure code returned by the master
!--

LOCAL retcode,
      pdb : $$PDB_DECL;

! Can't delete 1 or 0

IF .req_ID LSS 2 
THEN RETURN(DIU$_INVALID_REQUEST);

! Set up the delete message

ip_page[DIUQ$G_REQ_ID] = .req_ID;
ip_page[DIUQ$H_LENGTH] = 512;
ip_page[DIUQ$B_FUNCTION] = DIUQ$K_DELETE;

! Send the message and get a response

retcode = IP_TALK();

RETURN(.retcode)

END;                                ! End of ip_delete
%SBTTL 'Routine IP_FIND'

GLOBAL ROUTINE ip_find (p_req_block, chain_returned) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!   Find a request or requests that match a given request.
!
! FORMAL PARAMETERS
!
!   p_req_block         - pointer to request block
!   chain_returned      - cell to receive address of chain of blocks returned
!
! IMPLICIT INPUTS
!
!   None
!
! IMPLICIT OUTPUTS
!
!   Dynamic memory is allocated to hold a chain of requests returned,
!   and the address of the chain is returned to the caller.
!
! ROUTINE VALUE
!
!   DIU$_NORMAL         - successful completion
!   DIU$_NO_MASTER      - no master DIU running
!   DIU$_NO_SEND        - can't send IPCF to master
!   DIU$_NO_RECEIVE     - can't read reply from master
!   DIU$_NO_MEMORY      - insufficient dynamic memory
!    or any error code returned from master
!--

BIND
    req_block = .p_req_block : $DIU_BLOCK;

LOCAL
    message_count,
    chain_head,
    this_block,
    prev_block,
    last_sequence_number,
    retcode,
    pdb : $$PDB_DECL;

! Set up the message.

Q$COPY_REQ_BLOCK(req_block, ip_page[DIUQ$Z_REQ_BLOCK]);
ip_page[DIUQ$H_LENGTH] = 512;
ip_page[DIUQ$B_FUNCTION] = DIUQ$K_FIND;

! Send the message and get a response

IF NOT (retcode = IP_TALK())
THEN RETURN(.retcode);

! Got a response.  Save it and get some more if possible.

last_sequence_number = 0;
chain_head = 0;
prev_block = chain_head;
WHILE 1 DO
    BEGIN
      IF NOT $XPO_GET_MEM(UNITS=DIU$K_LEN+%UPVAL,RESULT=this_block)
        THEN BEGIN
               Q$RELEASE_CHAIN(.chain_head);
               SIGNAL (DIU$_NO_MEMORY);
             END;
      ! Get memory to allocate this block

      IF .ip_page[DIUQ$H_SEQUENCE_NUMBER] NEQ .last_sequence_number + 1
         THEN SIGNAL (DIU$_MISSED_MESSAGE);
      ! Messages out of sequence

      last_sequence_number = .ip_page[DIUQ$H_SEQUENCE_NUMBER];
      ! No, update it

      (.prev_block) = .this_block;
      (.this_block) = 0;
      ! Link this block to the next block, advance to next block

      Q$COPY_REQ_BLOCK(ip_page[DIUQ$Z_REQ_BLOCK],.this_block+1);
      ! Copy request block returned to block we just got in heap

      IF .ip_page[DIUQ$G_COMP_CODE] NEQ DIU$_MORE THEN EXITLOOP;
      ! If no more messages, quit

      pdb[PDB$$H_MESSAGE_ADDRESS] = ip_page;
      pdb[PDB$$H_MESSAGE_LENGTH] = 512;
      IF NOT (retcode = IP$RECEIVE(slave_PID, pdb,
                                  %FIELDEXPAND(PDB$$H_MESSAGE_ADDRESS,0)+1))
      THEN SIGNAL(DIU$_NO_RECEIVE, .retcode<lh>);
      ! Did we get an ack for this

      prev_block = .this_block;        
      
    END; %(while)%

    (.chain_returned) = .chain_head;
    ! Update the callers argument

RETURN (DIU$_NORMAL);

END;                                ! End of ip_find
%SBTTL 'Routine IP_MODIFY'

GLOBAL ROUTINE ip_modify (req_ID, item_code, new_value) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!   Modify a request in the queue.
!
! FORMAL PARAMETERS
!
!   req_ID              - request ID of request to hack
!   item_code           - code indicating which parameter to change
!   new_value           - new value of parameter.  In the case of
!                         DIUQ$K_LOG_FILESPEC, this is the address of
!                         a descriptor for the new filespec.
!
! IMPLICIT INPUTS
!
!   NONE
!
! IMPLICIT OUTPUTS
!
!   NONE
!
! ROUTINE VALUE
!
!   DIU$_NORMAL         - successful completion
!   DIU$_NO_MASTER      - no master DIU running
!   DIU$_NO_SEND        - can't send IPCF to master
!   DIU$_NO_RECEIVE     - can't read reply from master
!   DIU$_NO_MEMORY      - insufficient dynamic memory
!    or any error code returned from master
!--

LOCAL
        retcode,
        pdb : $$PDB_DECL;

! Set up the modify message.

ip_page[DIUQ$G_REQ_ID] = .req_ID;
ip_page[DIUQ$B_FUNCTION] = DIUQ$K_MODIFY;
ip_page[DIUQ$B_ITEM_CODE] = .item_code;

! When modifying the log file, copy it, otherwise just set the value 

IF .item_code EQL DIUQ$K_LOG_FILESPEC
   THEN BEGIN
        MAP new_value : REF $STR_DESCRIPTOR();
        CH$MOVE(.new_value[STR$H_LENGTH],
                .new_value[STR$A_POINTER],
                CH$PTR(ip_page[DIUQ$T_STATUS_TEXT]));
        ip_page[DIUQ$H_STATUS_TEXT] = .new_value[STR$H_LENGTH];
        END
   ELSE ip_page[DIUQ$G_NEW_VALUE] = .new_value;

! Send the message and get a response

IF NOT (retcode = IP_TALK())
THEN SIGNAL(.retcode);

RETURN (.retcode)

END;                                ! End of ip_modify
%SBTTL 'Routine IP_STATUS'

GLOBAL ROUTINE ip_status (datum, datum2, p_descr) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Send a status message to the master DIU.  This is used by slave
!   jobs to report their status in completing a transfer.
!
! FORMAL PARAMETERS:
!   datum               - arbitrary data item to pass, usually condition code
!   datum2              - additional data, frequently a block count
!   p_descr             - pointer to descriptor for additional text
!
! IMPLICIT INPUTS:
!   job_index           - global in module DIU -- our job handle
!   s$jobno is called because we need to stuff our job number
!   into the message.
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   DIU$_NORMAL         - successful completion
!   DIU$_NO_MASTER      - no master DIU running
!   DIU$_NO_SEND        - can't send IPCF to master
!   DIU$_NO_MEMORY      - insufficient dynamic memory
!    or any error code returned from master
!
! SIDE EFFECTS:
!   NONE
!
!--
EXTERNAL
        job_index;

BIND
        descr = .p_descr : $STR_DESCRIPTOR ();

LOCAL
        retcode,
        pdb : $$PDB_DECL;
 
! Set up the status message.

ip_page[DIUQ$H_LENGTH] = 512;
ip_page[DIUQ$B_FUNCTION] = DIUQ$K_STATUS;
ip_page[DIUQ$G_COMP_CODE] = .datum;
ip_page[DIUQ$G_2ND_CODE] = .datum2;
ip_page[DIUQ$H_SENDER_JOB] = s$jobno ();
ip_page[DIUQ$G_JOB_HANDLE] = .job_index;
ip_page[DIUQ$H_STATUS_TEXT] = .descr[STR$H_LENGTH];
 
! Move optional text

CH$MOVE (MAX(.descr[STR$H_LENGTH], 255),
             .descr[STR$A_POINTER],
             CH$PTR(ip_page[DIUQ$T_STATUS_TEXT]));
 
! Get a new master_PID each time to insure that the spooler is still there

IF (master_PID = IP$GET_PID (my_name, slave_PID)) EQL 0
THEN SIGNAL(DIU$_NO_MASTER);

! Send the message to the master job

IF NOT (retcode = IP$SEND (.master_pid, slave_pid, ip_page, 512))
THEN SIGNAL(DIU$_NO_SEND, .retcode<lh>);

RETURN (DIU$_NORMAL)

END;                                ! End of ip_status
%SBTTL 'Routine IP_CONNECT_ME'

GLOBAL ROUTINE ip_connect_me (dir_num, p_dir_descr) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!   Connect me (a slave job) to the directory in which I should be executing.
!
! FORMAL PARAMETERS:
!   dir_num             - target directory number
!
! IMPLICIT INPUTS:
!   job_index           - global in module DIU -- our JOBSTATUS handle
!   p_dir_descr         - pointer to descriptor for directory name string
!                         Used for error messages only
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--

BIND dir_descr = .p_dir_descr : $STR_DESCRIPTOR ();

EXTERNAL job_index;

LOCAL retcode,
      pdb : $$PDB_DECL;

! Set up the connect message.

ip_page[DIUQ$H_LENGTH] = 512;
ip_page[DIUQ$B_FUNCTION] = DIUQ$K_CONNECT_ME;
ip_page[DIUQ$G_COMP_CODE] = .dir_num;
ip_page[DIUQ$G_2ND_CODE] = 0;
ip_page[DIUQ$H_SENDER_JOB] = s$jobno ();
ip_page[DIUQ$G_JOB_HANDLE] = .job_index;

! Flush PID so rcv queue is empty

ip$delete_PID (.slave_pid);
slave_PID = 0;

! Get a new master_PID each time to insure that the spooler is still there

IF (master_PID = IP$GET_PID (my_name, slave_PID)) EQL 0
THEN SIGNAL(DIU$_NO_MASTER);

! Send the message to the master job

IF NOT (retcode = IP$SEND (.master_pid, slave_pid, ip_page, 512))
THEN SIGNAL(DIU$_NO_SEND, .retcode<lh>);

! Now try to receive acknowledgement

pdb[PDB$$H_MESSAGE_ADDRESS] = ip_page;
pdb[PDB$$H_MESSAGE_LENGTH] = 512;
IF NOT (retcode = ip$receive (slave_PID, pdb,
                                 %FIELDEXPAND (PDB$$H_MESSAGE_ADDRESS, 0) + 1))
THEN SIGNAL(DIU$_NO_RECEIVE, .retcode<lh>);

! Got a message.  Check code returned.

IF .ip_page[DIUQ$B_FUNCTION] NEQ DIUQ$K_ACK
THEN RETURN (SIGNAL(DIU$_NO_CONNECT,
                    .ip_page[DIUQ$G_COMP_CODE],
                    0, 
                    dir_descr))
ELSE SIGNAL(DIU$_CONNECTED_TO,0,0,dir_descr);

RETURN (DIU$_NORMAL)
END;                                    ! End of ip_connect_me
END
ELUDOM