Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/netmio.src

Text File | 1988-05-03 | 11.4 KB | 330 lines

--::::::::::
--NETMIO.DIS
--::::::::::
-- NETWORK_MIXED_IO Prologue and Distribution Files
NETMIO.DIS
NETMIO.PRO
-- NETWORK_MIXED_IO Code in Compilation Order
NETMIO.SPC
NETMIO.BOD
--::::::::::
--NETMIO.PRO
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : generic package NETWORK_MIXED_IO
-- Version      : 2.0
-- Author       : Stanley R. Allen
--              : Lockheed Engineering Management Services Company
--              : Computer Systems Engineering Department  MS B08
--              : Houston, TX  77258
--              : [phone]
-- DDN Address  : [e-mail]
-- Copyright    : none
-- Date created : Fri 31 Jul 87
-- Release date : Mon 31 Aug 87
-- Last update  : Mon 31 Aug 87
-- Machine/System Compiled/Run on : VAX 11/785, VAX 8650
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  NETWORK, COMMUNICATION
----------------:
--
-- Abstract     :  This package provides an Ada interface to a
----------------:  communication network.  The model of the network
----------------:  is one that allows tasks on separate nodes to
----------------:  pass messages (message-passing).  The package
----------------:  is designed to be similar to the VAX-supplied
----------------:  package SEQUENTIAL_MIXED_IO, with the same basic
----------------:  operations, applicable to networks.  The
----------------:  idea of SEQUENTIAL_MIXED_IO (just as for the other
----------------:  predefined I/O packages) is machine independent
----------------:  logical operations defined in the spec, and
----------------:  machine dependencies hidden in the private
----------------:  parts and the bodies.  Currently NETWORK_MIXED_IO
----------------:  allows a link two VAX DECnet nodes to be created
----------------:  across which any type can be passed.
-- Dependent Units : package SYSTEM, STARLET, CONDITION_HANDLING,
--                   IO_EXCEPTIONS, TASKING_SERVICES.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION              AUTHOR     HISTORY
-- 08/31/87     2.0               Allen      First Update
--
--    A number of changes have been made since version 1.0:
--
--    1)  The name of the abstraction is no longer FILE_TYPE,
--        but is LINK_TYPE instead.  This just seemed to make
--        more logical sense.  The only change made to the
--        source to reflect this was the text substitution
--        LINK for FILE throughout.  This includes the change
--        from IN_FILE, OUT_FILE, and INOUT_FILE to IN_LINK,
--        OUT_LINK, and INOUT_LINK for MODE_TYPE.  In old
--        programs where you used version 1.0, just make the
--        same global text substitution to upgrade, and
--        recompile.
--
--    2)  The body has been changed to use the VAX's TASK_QIOW
--        instead of STARLET.QIOW.  This means that now the
--        network i/o READ and WRITE operation will not suspend
--        the entire VMS process while waiting for completion,
--        only the individual Ada task.
--
--    3)  The body no longer uses the VAX-specific 'MACHINE_SIZE
--        attribute to determine the size of the message to be sent.
--        Now 'SIZE is used on the object (as opposed to the type)
--        to be sent.
--
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------
-------
--::::::::::
--NETMIO.SPC
--::::::::::
with STARLET;
with IO_EXCEPTIONS;
package NETWORK_MIXED_IO is

    type LINK_TYPE is limited private;
    type LINK_MODE is (IN_LINK, INOUT_LINK, OUT_LINK);

    procedure CREATE(               --| Create a VC link to remote PE.
        LINK : in out LINK_TYPE;    --| LINK: logical name.
        MODE : in LINK_MODE;        --| MODE: IN_LINK, OUT_LINK, INOUT_LINK.
        NAME : in STRING := "";     --| NAME: Physical name of remote PE.
        FORM : in STRING := "");    --| FORM: Special local parameters.

    procedure OPEN (                --| Complete a VC link to remote PE.
        LINK : in out LINK_TYPE;    --| LINK: logical name.
        MODE : in LINK_MODE;        --| MODE: IN_LINK, OUT_LINK, INOUT_LINK.
        NAME : in STRING := "";     --| NAME: Physical name of remote PE.
        FORM : in STRING := "");    --| FORM: Special local parameters.

    procedure CLOSE (LINK : in out LINK_TYPE);  --| Disconnect VC.

    generic
        type MESSAGE_TYPE is private;
    procedure READ (LINK : in LINK_TYPE;
            ITEM : out MESSAGE_TYPE);

    generic
        type MESSAGE_TYPE is private;
    procedure WRITE (LINK : in LINK_TYPE;
             ITEM : in MESSAGE_TYPE);

    STATUS_ERROR : exception renames IO_EXCEPTIONS.STATUS_ERROR;
    MODE_ERROR   : exception renames IO_EXCEPTIONS.MODE_ERROR;
    NAME_ERROR   : exception renames IO_EXCEPTIONS.NAME_ERROR;
    USE_ERROR    : exception renames IO_EXCEPTIONS.USE_ERROR;
    DEVICE_ERROR : exception renames IO_EXCEPTIONS.DEVICE_ERROR;

private

    type LINK_STATUS is (OPEN, CLOSED);
    type LINK_TYPE is
      record
        CHAN : STARLET.CHANNEL_TYPE;
        MODE : LINK_MODE;
        STAT : LINK_STATUS := CLOSED;
      end record;

end NETWORK_MIXED_IO;
--::::::::::
--NETMIO.BOD
--::::::::::
with    SYSTEM,
    STARLET,
    TASKING_SERVICES,
    CONDITION_HANDLING;
use    SYSTEM,
    STARLET;
package body NETWORK_MIXED_IO is

    --|
    --| CREATE creates a link to the remote task specified
    --| in the string NAME.  The system service $ASSIGN is
    --| used to do this.
    --|

    procedure CREATE (
        LINK : in out LINK_TYPE;
        MODE : in LINK_MODE;
        NAME : in STRING := "";
        FORM : in STRING := "")
    is
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
    begin
      if LINK.STAT = OPEN then raise STATUS_ERROR; end if;

      STARLET.ASSIGN (STAT, NAME, LINK.CHAN);

      if not CONDITION_HANDLING.SUCCESS(STAT) then
        case STAT is
        when SS_CONNECFAIL | SS_DEVOFFLINE | SS_INSFMEM | SS_SHUT |
               SS_NOLINKS | SS_PROTOCOL | SS_UNREACHABLE | SS_REJECT |
               SS_REMRSRC | SS_THIRDPARTY | SS_LINKEXIT =>
                raise DEVICE_ERROR;
        when SS_INVLOGIN | SS_IVDEVNAM | SS_NOSUCHNODE |
               SS_NOSUCHUSER | SS_NOSUCHOBJ  =>
                raise NAME_ERROR;
        when SS_NOPRIV |  SS_TOOMUCHDATA =>
                raise USE_ERROR;
        when others => null;
        end case;
      end if;
      LINK.STAT := OPEN;
      LINK.MODE := MODE;
    end CREATE;

    --|
    --| OPEN completes a link to the remote task specified
    --| in the string NAME.  The system service $ASSIGN is
    --| used to do this.
    --|

    procedure OPEN (
        LINK : in out LINK_TYPE;
        MODE : in LINK_MODE;
        NAME : in STRING := "";
        FORM : in STRING := "")
    is
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
    begin
      if LINK.STAT = OPEN then raise STATUS_ERROR; end if;

      STARLET.ASSIGN (STAT, "SYS$NET", LINK.CHAN);

      if not CONDITION_HANDLING.SUCCESS(STAT) then
        case STAT is
        when SS_CONNECFAIL | SS_DEVOFFLINE | SS_INSFMEM | SS_SHUT |
               SS_NOLINKS | SS_PROTOCOL | SS_UNREACHABLE | SS_REJECT |
               SS_REMRSRC | SS_THIRDPARTY | SS_LINKEXIT =>
                raise DEVICE_ERROR;
        when SS_INVLOGIN | SS_IVDEVNAM | SS_NOSUCHNODE |
               SS_NOSUCHUSER | SS_NOSUCHOBJ  =>
                raise NAME_ERROR;
        when SS_NOPRIV |  SS_TOOMUCHDATA =>
                raise USE_ERROR;
        when others => null;
        end case;
      end if;
      LINK.STAT := OPEN;
      LINK.MODE := MODE;
    end OPEN;

    procedure CLOSE (LINK : in out LINK_TYPE) is
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
    begin
      if LINK.STAT = CLOSED then raise STATUS_ERROR; end if;
      STARLET.DASSGN(STAT, LINK.CHAN);
      if not CONDITION_HANDLING.SUCCESS(STAT) then
        raise USE_ERROR; --| USE_ERROR for SS$_NOPRIV and SS$_IVCHAN
      end if;
      LINK.STAT := CLOSED;
    end CLOSE;


    procedure READ (LINK : in LINK_TYPE;
            ITEM : out MESSAGE_TYPE)
    is
        --|
        --| MSIZE is size (in bytes) of the ITEM.
        --|
        MSIZE : SYSTEM.UNSIGNED_LONGWORD
        := ITEM'SIZE/SYSTEM.STORAGE_UNIT;
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
        IOSB : STARLET.IOSB_TYPE;
    begin
        if LINK.STAT = CLOSED then raise STATUS_ERROR; end if;
        if LINK.MODE = OUT_LINK then raise MODE_ERROR; end if;
        TASKING_SERVICES.TASK_QIOW (
        STATUS => STAT,
        CHAN   => LINK.CHAN,
        FUNC   => IO_READVBLK,
        IOSB   => IOSB,
        P1     => SYSTEM.TO_UNSIGNED_LONGWORD (ITEM'ADDRESS),
        P2     => MSIZE);
        if not CONDITION_HANDLING.SUCCESS(STAT) then
          case STAT is
        when SS_DATAOVERUN | SS_INSFMEM | SS_PATHLOST |
             SS_LINKEXIT | SS_PROTOCOL | SS_LINKABORT |
             SS_LINKDISCON | SS_THIRDPARTY =>
            raise DEVICE_ERROR;
        when SS_FILNOTACC =>
            raise USE_ERROR;
        when others => null;
          end case;
        end if;
        if IOSB.STATUS /= SS_NORMAL then
        raise DEVICE_ERROR;
        end if;
    end READ;

    procedure WRITE (LINK : in LINK_TYPE;
             ITEM : in MESSAGE_TYPE)
    is
        --|
        --| MSIZE is size (in bytes) of the ITEM.
        --|
        MSIZE : SYSTEM.UNSIGNED_LONGWORD
        := ITEM'SIZE/SYSTEM.STORAGE_UNIT;
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
        IOSB : STARLET.IOSB_TYPE;
    begin
        if LINK.STAT = CLOSED then raise STATUS_ERROR; end if;
        if LINK.MODE = IN_LINK then raise MODE_ERROR; end if;
        TASKING_SERVICES.TASK_QIOW (
        STATUS => STAT,
        CHAN   => LINK.CHAN,
        FUNC   => IO_WRITEVBLK,
        IOSB   => IOSB,
        P1     => SYSTEM.TO_UNSIGNED_LONGWORD (ITEM'ADDRESS),
        P2     => MSIZE);
        if not CONDITION_HANDLING.SUCCESS(STAT) then
          case STAT is
        when SS_DATAOVERUN | SS_INSFMEM | SS_PATHLOST |
             SS_LINKEXIT | SS_PROTOCOL | SS_LINKABORT |
             SS_LINKDISCON | SS_THIRDPARTY =>
            raise DEVICE_ERROR;
        when SS_FILNOTACC =>
            raise USE_ERROR;
        when others => null;
          end case;
        end if;
        if IOSB.STATUS /= SS_NORMAL then
        raise DEVICE_ERROR;
        end if;
    end WRITE;

end NETWORK_MIXED_IO;