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

Text File | 1988-05-03 | 17.9 KB | 554 lines

--::::::::::
--NETIO.DIS
--::::::::::
-- NETWORK_IO Prologue and Distribution Files
NETIO.DIS
NETIO.PRO
-- NETWORK_IO Package Documentation
NETIO.DOC
-- NETWORK_IO in Compilation Order
NETIO.SPC
NETIO.BOD
--::::::::::
--NETIO.PRO
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : generic package NETWORK_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 standard
----------------:  package SEQUENTIAL_IO, with the same basic
----------------:  operations, applicable to networks.  The
----------------:  idea of SEQUENTIAL_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_IO
----------------:  allows any typed link to be created between
----------------:  two VAX DECnet nodes.
-- Dependent Units : package SYSTEM, STARLET, CONDITION_HANDLING,
--                   IO_EXCEPTIONS, TASKING_SERVICES.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION              AUTHOR     HISTORY
-- 08/31/87     2.0               Allen      Updates
--
--    A number of changes have been made to 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 and OUT_FILE to IN_LINK and OUT_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 package 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--------------------------------
-------
--::::::::::
--NETIO.DOC
--::::::::::


    How to use the NETWORK_IO and NETWORK_MIXED_IO packages.

    These packages provide an interface to DECnet task-to-task
communication.  In each of the packages, in the CREATE procedure,
a full task-specification string is to be used for the NAME parameter.
The network link is abstracted as the limited private data type LINK_TYPE.

    Here are two programs showing the use of the NETWORK_IO
package.  The first program is run on the node called SOURCE, and the
second is placed on a node called TARGET.  At the node TARGET there is
a command procedure called GENERATE.COM which contains the single line
$ run GENERATE.exe .  To get the whole thing going, the PROCESS program
is run on the SOURCE node:  $ RUN PROCESS.

    --| On the node SOURCE.
    with NETWORK_IO, TEXT_IO;
    procedure PROCESS is

      TARGET : constant STRING
        := "TARGET""username password""::""0=GENERATE""";

      type A_RECORD is  -- something to read from the TARGET node
        record
          INT : INTEGER;
          FLT : FLOAT;
        end record;

        --| Instantiate the NETWORK_IO package for the above type.
      package NET_IO is new NETWORK_IO (A_RECORD);
      use NET_IO;

      AREC  : A_RECORD;
      ILINK : NET_IO.LINK_TYPE;   --| Or communication link

      procedure DO_SOMETHING_WITH_THE_DATA (A : in A_RECORD) is
        --| Just print the data out.
        package FLOAT_IO is new TEXT_IO.FLOAT_IO(FLOAT);
        package INT_IO is new TEXT_IO.INTEGER_IO(INTEGER);
      begin
        INT_IO.PUT(A.INT); TEXT_IO.NEW_LINE;
        FLOAT_IO.PUT(A.FLT, FORE => 5, AFT => 5, EXP => 0);
        TEXT_IO.NEW_LINE;
      end;

    begin
      NET_IO.CREATE(ILINK, IN_LINK, NAME => TARGET);
        --| CREATE, not OPEN, the link.
      for I in 1..100 loop
        NET_IO.READ (ILINK, AREC);
        DO_SOMETHING_WITH_THE_DATA (AREC);
      end loop;

      NET_IO.CLOSE(ILINK);
    end PROCESS;



    with NETWORK_IO;
    procedure GENERATE is  -- on node TARGET.

      type A_RECORD is  -- something to read from the TARGET node
        record
          INT : INTEGER;
          FLT : FLOAT;
        end record;

        --| Instantiate the NETWORK_IO package for the above type.
      package NET_IO is new NETWORK_IO (A_RECORD);
      use NET_IO;

      AREC  : A_RECORD;
      ILINK : NET_IO.LINK_TYPE;    --| Our communication link
      I     : INTEGER  := 1;
      F     : FLOAT    := 0.0;

      procedure GENERATE_DATA (A : out A_RECORD) is
      begin
        A.INT := I;
        A.FLT := F;
        I := I + 1;
        F := F + 10.0;
      end;

    begin
      NET_IO.OPEN (ILINK, OUT_LINK);
        --| OPEN, not CREATE the link.
      for I in 1..100 loop
        GENERATE_DATA (AREC);
        NET_IO.WRITE (ILINK, AREC);
      end loop;
      NET_IO.CLOSE(ILINK);
    end GENERATE;


    The package NETWORK_MIXED_IO is very similar, except that it
allows multiple types to be passed along a link.  NETWORK_MIXED_IO is
not generic, but contains two generic procedures, READ and WRITE, which
are instantiated for each type that is to be passed.  NETWORK_MIXED_IO
is probably the more useful of the two packages.
    Here is a program which uses NETWORK_MIXED_IO for network
communication.  Of course, another program, not shown, is to be placed
on the TARGET node. The package NET_TYPES is used by both programs. The
procedure REQUEST is run on the node SOURCE and SUPPLY is on the
node TARGET.  The command procedure SUPPLY.COM is also to be placed on
TARGET and contains the single line "$ run SUPPLY.exe".  The program
SUPPLY should be written corresponding to the protocol defined by
this program.
    (By the way, this brings up the important point: you have to
define your own application protocol for the use of this network stuff.
Rather than re-create a new protocol for each application, it should be
fairly easy to create generic packages and procedures based on NETWORK_IO
and NETWORK_MIXED_IO which implement (re-useably) such common protocols
as the one used here REQUEST/SUPPLY....).


    package NET_TYPES is

        type REQUEST_TYPE is (RTYPE_1, RTYPE_2, RTYPE_3, STOP);

        type TYPE_1 is array (1..40) of INTEGER;

        type TYPE_2 is
          record
        C : CHARACTER;
            Q : BOOLEAN;
            I : INTEGER range 0..127;
          end record;
        for TYPE_2 use
          record
        C at 0 range 0..7;
        Q at 1 range 0..0;
        I at 1 range 1..7;
          end record;
        for TYPE_2'SIZE use 16;

        type TYPE_3 is range 0..31;
        for TYPE_3'SIZE use 5;

    end NET_TYPES;


    --| On node SOURCE
    with NET_TYPES, NETWORK_MIXED_IO, TEXT_IO;
    use NET_TYPES, TEXT_IO;
    procedure REQUEST is

        TARGET : constant STRING :=
        "TARGET""user passwd""::""0=SUPPLY""";

        package NMIO renames NETWORK_MIXED_IO;

        A : NET_TYPES.TYPE_1;
        B : NET_TYPES.TYPE_2;
        C : NET_TYPES.TYPE_3;
        R : NET_TYPES.REQUEST_TYPE;
        L : NMIO.LINK_TYPE;

        procedure REQ_WRITE is
        new NMIO.WRITE (NET_TYPES.REQUEST_TYPE);
        procedure T1_READ is
        new NMIO.READ (NET_TYPES.TYPE_1);
        procedure T2_READ is
        new NMIO.READ (NET_TYPES.TYPE_2);
        procedure T3_READ is
        new NMIO.READ (NET_TYPES.TYPE_3);
        use NMIO;

        function MENU return NET_TYPES.REQUEST_TYPE is
        CH      : CHARACTER;
        begin
        loop
            PUT_LINE("Which type to receive?: ");
            PUT_LINE("A  --  type 1");
            PUT_LINE("B  --  type 2");
            PUT_LINE("C  --  type 3");
            PUT_LINE("Q  --  exit program, close link");
            NEW_LINE; PUT("Which one? : "); GET(CH);
            if CH = 'A' or CH = 'a' then
            return RTYPE_1;
            elsif CH = 'B' or CH = 'b' then
            return RTYPE_2;
            elsif CH = 'C' or CH = 'c' then
            return RTYPE_3;
            elsif CH = 'Q' or CH = 'q' then
            return STOP;
            else
            PUT_LINE ("Bad Choice, reenter");
            end if;
        end loop;
        end MENU;

    begin
        NMIO.CREATE(L, INOUT_LINK, NAME => TARGET);
        --| remember: OPEN will complete the VC link on the other side.
        loop
          R := MENU;
          exit when R = STOP;
          REQ_WRITE (LINK => L, ITEM => R);
          case R is
        when RTYPE_1 => T1_READ(L, A); --| Ideally, a procedure for
        when RTYPE_2 => T2_READ(L, B); --| each type which processes
        when RTYPE_3 => T3_READ(L, C); --| the incoming data would
        when others => null;           --| go after each READ here.
          end case;
        end loop;
        REQ_WRITE(L, STOP);
        NMIO.CLOSE(L);
    end REQUEST;

-----
This pseudocode describes just one possible protocol.  Basically
any protocol is possible.

Source Loop Pseudocode            Target Loop Pseudocode
----------------------            ----------------------

Determine request  (MENU)
Netio.Write (request)            Netio.Read (request)
case (request) is            case (request) is
  when type1 => Netio.Read(type1)      when type1 => Netio.Write(type1)
  when type2 => Netio.Read(type2)      when type2 => Netio.Write(type2)
  ...                      ...
end case                end case
--------------------------------------------------------------------------
--::::::::::
--NETIO.SPC
--::::::::::
with STARLET;
with IO_EXCEPTIONS;
generic
    type MESSAGE_TYPE is private;
package NETWORK_IO is

    type LINK_TYPE is limited private;
    type LINK_MODE is (IN_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.
        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.
        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.

    procedure READ (LINK : in LINK_TYPE;
            ITEM : out MESSAGE_TYPE);

    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_IO;
--::::::::::
--NETIO.BOD
--::::::::::
with    SYSTEM,
    STARLET,
    TASKING_SERVICES,
    CONDITION_HANDLING;
use    SYSTEM,
    STARLET;
package body NETWORK_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;

    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;


    --|
    --| Terminate the logical link, using STARLET.DASSGN.
    --|

    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
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
        IOSB : STARLET.IOSB_TYPE;
        MSIZE : SYSTEM.UNSIGNED_LONGWORD       --| Size of ITEM in bytes
        := ITEM'SIZE/SYSTEM.STORAGE_UNIT;
    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
        STAT : CONDITION_HANDLING.COND_VALUE_TYPE;
        IOSB : STARLET.IOSB_TYPE;
        MSIZE : SYSTEM.UNSIGNED_LONGWORD       --| Size of ITEM in bytes
        := ITEM'SIZE/SYSTEM.STORAGE_UNIT;
    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_IO;