DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦d794912ee⟧ Ada Source

    Length: 18432 (0x4800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Interchange, pragma Module_Name 4 2514, pragma Subsystem Network, seg_0284e5

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Byte_Defs;
with Calendar;
with Interchange_Defs;

package Interchange is

    -- This package defines a collection of types for data interchange.
    -- Each type has some local representation, which is dependent on
    -- the characteristics of the local architecture/compiler; and also
    -- an interchange representation (a canonical byte sequence), which
    -- is machine-independent.  This package provides operations for
    -- converting between the local and interchange representations.

    -- The types provided are similar to types in the Ada predefined
    -- language environment, i.e. packages STANDARD and CALENDAR.

    -- The conversion operations are generic on a procedural byte
    -- stream, so that they may be used on a variety of interchange
    -- media, e.g. communication channels, tapes, and disks.

    -- The algorithms for conversion to and from the interchange form
    -- are extensible to any Ada type except access values and task
    -- types.  The rules for forming new type conversion algorithms
    -- are given below.

    -- The interchange representation does not carry type information,
    -- i.e. the types of the interchanged data must be known a priori
    -- in order to convert them back to the local representation.

    -- The interchange representation mostly follows the rules of
    -- Courier, the Xerox System Integration Standard for a remote
    -- procedure call protocol.  In particular, all interchange
    -- values are a multiple of two bytes (16 bits) in length.

    pragma Subsystem (Network, Private_Part => Closed);
    pragma Module_Name (4, 2514);


    Constraint_Error : exception;

    -- Raised when an interchange conversion procedure encounters
    -- an out-of-range value.


    subtype Byte        is Byte_Defs.Byte;
    subtype Byte_String is Byte_Defs.Byte_String;


    type    Short_Integer  is range -(2 ** 14) - (2 ** 14) ..
                                       (2 ** 14) + ((2 ** 14) - 1);
    subtype Short_Natural  is Short_Integer range 0 .. Short_Integer'Last;
    subtype Short_Positive is Short_Integer range 1 .. Short_Integer'Last;


    type    Integer  is new Interchange_Defs.Longest_Integer
                               range -(2 ** 30) - (2 ** 30) ..
                                        (2 ** 30) + ((2 ** 30) - 1);
    subtype Natural  is Integer range 0 .. Integer'Last;
    subtype Positive is Integer range 1 .. Integer'Last;


    type    Long_Integer  is new Interchange_Defs.Longest_Integer;
    subtype Long_Natural  is Long_Integer range 0 .. Long_Integer'Last;
    subtype Long_Positive is Long_Integer range 1 .. Long_Integer'Last;

    -- The range of long_integer is machine-dependent.  Each
    -- implementation should choose the largest possible range.
    -- The interchange form (which is machine-independent),
    -- can express values up to +- 2 ** (2 ** 16 - 1) - 1.


    type Float is new Interchange_Defs.Float;

    type Long_Float is new Interchange_Defs.Long_Float;


    subtype Nanosecond_Count is Interchange.Natural range 0 .. 10 ** 9 - 1;

    type Duration is
        record
            Seconds     : Interchange.Integer;
            Nanoseconds : Interchange.Nanosecond_Count;
        end record;

    function Convert (X : Standard.Duration) return Interchange.Duration;

    function Convert (X : Interchange.Duration) return Standard.Duration;


    subtype Year_Number  is Interchange.Short_Integer;
    subtype Month_Number is Interchange.Short_Integer range 1 .. 12;
    subtype Day_Number   is Interchange.Short_Integer range 1 .. 31;
    subtype Day_Duration is Interchange.Duration;

    type Time is
        record
            Year    : Year_Number;
            Month   : Month_Number;
            Day     : Day_Number;
            Seconds : Day_Duration;
        end record;

    function Convert (X : Calendar.Time) return Interchange.Time;

    function Convert (X : Interchange.Time) return Calendar.Time;


    generic
        type Stream_Id is limited private;

        -- Identifies an interchange medium.

        with procedure Put (Into : Stream_Id; Data : Byte_String) is <>;

        -- Put the given DATA into the given stream.

        with procedure Get (From : Stream_Id; Data : out Byte_String) is <>;

        -- Get the first DATA'LENGTH bytes from the given stream.

        -- The interchange medium must not lose bytes, and must
        -- preserve byte ordering.  Also, it must fragment and
        -- reassemble.  That is, the sequence of calls:
        --
        --     PUT (STREAM, DATA (1 .. N));
        --     PUT (STREAM, DATA (N + 1 .. LAST));
        --
        -- must have the same effect as the single call
        --
        --     PUT (STREAM, DATA (1 .. LAST));
        --
        -- for all values of N in the range 1 .. LAST.
        -- Similarly, the sequence of calls
        --
        --     GET (STREAM, DATA (1 .. N));
        --     GET (STREAM, DATA (N + 1 .. LAST));
        --
        -- must have the same effect as the single call
        --
        --     GET (STREAM, DATA (1 .. LAST));
        --
        -- for all values of N in the range 1 .. LAST.

        -- Note that a STREAM_ID is passed as an 'in' parameter.
        -- This simplifies the interchange of unconstrained types
        -- (since they can be returned as the value of a function),
        -- but may require the instantiator to invent a level of
        -- indirection.


    package Operations is

        -- Given a facility for interchanging bytes, this package
        -- provides a facility for interchanging values of other
        -- types.  For each type, PUT and GET operations are
        -- defined: PUT converts any value to a sequence of
        -- bytes, and GET reconstructs the original value.

        -- Exceptions raised by the primitive operations are
        -- propagated to the caller of the derived operations.


        -- A short_integer is represented in 16-bit two's complement,
        -- split into two bytes, most significant byte first.

        procedure Put (Into : Stream_Id; Data : Interchange.Short_Integer);
        procedure Get (From : Stream_Id; Data : out Interchange.Short_Integer);


        -- An integer is represented in 32-bit two's complement,
        -- split into four bytes, most significant byte first.

        procedure Put (Into : Stream_Id; Data : Interchange.Integer);
        procedure Get (From : Stream_Id; Data : out Interchange.Integer);


        -- A long_integer is represented in arbitrary - precision two's
        -- complement, that is, the two's complement representation,
        -- split into as many bytes as needed, represented as a Byte_String,
        -- most significant byte first.  See the Put & Get routines for
        -- Byte_Strings, below.

        -- GET may raise CONSTRAINT_ERROR if the local implementation
        -- of long_integer cannot represent a gotten value.

        procedure Put (Into : Stream_Id; Data : Interchange.Long_Integer);
        procedure Get (From : Stream_Id; Data : out Interchange.Long_Integer);


        -- Floating point types are represented in IEEE format.
        -- A Float (single-precision) occupies 4 bytes, and
        -- a Long_Float (double-precision) occupies 8 bytes.
        -- The sign bit goes in the MSB of the first byte, followed by
        -- the exponent, followed by the fraction, with the LSB of the
        -- fraction going in the LSB of the last byte.

        procedure Put (Into : Stream_Id; Data : Interchange.Float);
        procedure Get (From : Stream_Id; Data : out Interchange.Float);

        procedure Put (Into : Stream_Id; Data : Interchange.Long_Float);
        procedure Get (From : Stream_Id; Data : out Interchange.Long_Float);


        -- The types for time are represented using the rules
        -- for records, described below.

        procedure Put (Into : Stream_Id; Data : Interchange.Time);
        procedure Get (From : Stream_Id; Data : out Interchange.Time);

        procedure Put (Into : Stream_Id; Data : Interchange.Duration);
        procedure Get (From : Stream_Id; Data : out Interchange.Duration);


        -- A Boolean is represented by the value 0 for false and
        -- 1 for true, converted to an interchange.short_natural.

        procedure Put (Into : Stream_Id; Data : Standard.Boolean);
        procedure Get (From : Stream_Id; Data : out Standard.Boolean);


        -- A Byte is represented by its 'pos, converted to an
        -- interchange.short_natural (or, if you like, padded
        -- on the left with a 0 byte).

        procedure Put (Into : Stream_Id; Data : Byte);
        procedure Get (From : Stream_Id; Data : out Byte);


        -- A CHARACTER is represented like a byte.

        procedure Put (Into : Stream_Id; Data : Standard.Character);
        procedure Get (From : Stream_Id; Data : out Standard.Character);


        -- The GET operation for an unconstrained type is a function,
        -- rather than a procedure.  This is because Ada rules don't
        -- allow the caller of GET to declare an unconstrained
        -- variable of the type.  Casting GET as a function allows
        -- the caller to declare a constant of the type, and
        -- initialize it with the value of the GET function, e.g.:
        --
        -- declare
        --     S : constant STRING := GET_STRING (STREAM);
        -- begin
        --     ...


        -- A STRING is represented by its 'LENGTH, followed by the
        -- 'POS of each of its elements (in ascending index order),
        -- followed by a 0 byte if required to pad the whole thing to
        -- an even number of bytes.  The 'LENGTH is represented as a
        -- INTERCHANGE.NATURAL.  Each element is represented as one
        -- byte.  This representation loses the 'FIRST of the STRING,
        -- much as does slice assignment.

        procedure Put_String (Into : Stream_Id; Data : Standard.String);
        function  Get_String (From : Stream_Id) return Standard.String;


        -- A Byte_String is represented like a String.

        procedure Put_Byte_String (Into : Stream_Id; Data : Byte_String);
        function  Get_Byte_String (From : Stream_Id) return Byte_String;


        -- Interchange forms for other types may be defined using the
        -- following rules.  In some cases, the rules are implemented
        -- by generics.

        -- A record type is represented by the sequence of its fields,
        -- in the order of their declaration.  In discriminated records,
        -- fields which are inaccessible are omitted.

        -- A discrete type (integer subtype or enumeration type)
        -- is represented by its 'POS, converted to a short_integer.

        generic
            type Discrete_Type is (<>);

        package Discrete is

            procedure Put (Into : Stream_Id; Data : Discrete_Type);

            procedure Get (From : Stream_Id; Data : out Discrete_Type);

        end Discrete;


        -- A vector (one-dimensional array) is represented by its
        -- 'LENGTH, followed by its elements in index order.  The
        -- 'LENGTH is represented as an Interchange.Natural.  This
        -- representation loses information about the 'FIRST of the
        -- vector, much like slice assignment.

        generic
            type Element_Type is private;

            with procedure Put (Into : Stream_Id; Data : Element_Type) is <>;
            with procedure Get (From :     Stream_Id;
                                Data : out Element_Type)               is <>;

            type Index_Type is (<>);
            with procedure Put (Into : Stream_Id; Data : Index_Type)     is <>;
            with procedure Get (From : Stream_Id; Data : out Index_Type) is <>;

            type Vector_Type is array (Index_Type range <>) of Element_Type;
        package Vector is

            procedure Put (Into : Stream_Id; Data : Vector_Type);

            function Get (From : Stream_Id) return Vector_Type;

        end Vector;

    end Operations;

end Interchange;

E3 Meta Data

    nblk1=11
    nid=f
    hdr6=20
        [0x00] rec0=17 rec1=00 rec2=01 rec3=084
        [0x01] rec0=1c rec1=00 rec2=02 rec3=01e
        [0x02] rec0=00 rec1=00 rec2=10 rec3=012
        [0x03] rec0=16 rec1=00 rec2=11 rec3=014
        [0x04] rec0=1f rec1=00 rec2=03 rec3=044
        [0x05] rec0=02 rec1=00 rec2=04 rec3=008
        [0x06] rec0=1c rec1=00 rec2=05 rec3=054
        [0x07] rec0=1a rec1=00 rec2=06 rec3=048
        [0x08] rec0=16 rec1=00 rec2=07 rec3=036
        [0x09] rec0=17 rec1=00 rec2=08 rec3=004
        [0x0a] rec0=19 rec1=00 rec2=09 rec3=034
        [0x0b] rec0=17 rec1=00 rec2=0a rec3=006
        [0x0c] rec0=17 rec1=00 rec2=0b rec3=018
        [0x0d] rec0=00 rec1=00 rec2=0e rec3=004
        [0x0e] rec0=1c rec1=00 rec2=0c rec3=03e
        [0x0f] rec0=0f rec1=00 rec2=0d rec3=000
        [0x10] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21520fd1883c17467c7d0 0x42a00088462065003
Free Block Chain:
  0xf: 0000  00 00 00 06 80 03 20 20 20 03 00 01 00 01 00 0c  ┆                ┆