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

⟦b4c242d57⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Subprogram_Implementation, seg_004e7e

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



package Subprogram_Implementation is

-- Low level mechanisms for subprogram variables.  This package provides
-- definitions and operations that, when used in specific stylized calls,
-- will allow user code to implement subprogram types and variables.

    type Subprogram_Type is private;                -- A class of values
                                                    -- based on mode profile
    Null_Subprogram : constant Subprogram_Type;

    type Mode is (In_Mode, Out_Mode, In_Out_Mode, Return_Mode, No_Mode);
    -- Each parameter is of one of these modes.  No_Mode is used internally.

    subtype Offset is Integer range -2 ** 20 .. 2 ** 20 - 1;

    type Mode_Vector is array (Natural range <>) of Mode;
    -- Rules for modes:
    --  1.  No_Mode may not appear
    --  2.  Return_Mode may appear in the last poistion only, if at all.
    --  3.  If Return_Mode appears, Out_Mode and In_Out_Mode must not.

    type Offset_Vector is array (Natural range <>) of Offset;

    function Get (Modes : Mode_Vector; Signature : Long_Integer := 0)
                 return Subprogram_Type;
    -- Must be invoked from within a generic subprogram instantiation whose
    -- only parameter is the subprogram to be returned.  Modes is the
    -- mode profile.  Signature is a number associated with the type.
    -- It is not interpreted in this package but can be interrogated
    -- for use by higher levels.

    --
    -- The subprogram must not be inside a task (either directly or
    -- indirectly).  It must also be at package level scope (lex level 1).

    Missing_Subprogram : exception;
    -- Could not find the subprogram.  Probably because the call was not in
    -- an instantiation with a single subprogram generic parameter.
    Illegal_Modes_Combination       : exception;
    Subprogram_Is_Inside_Task       : exception;
    Subprogram_Not_At_Package_Level : exception;

    procedure Invoke (Modes : Mode_Vector; Offsets : Offset_Vector);
    -- Invoke the subprogram represented by the value in the first position
    -- in Offsets.  The subsequent positions in Offsets represents
    -- the parameters to the subprogram in order and with modes
    -- corresponding to the values in Modes.  If the last element in
    -- Modes is Return_Mode, then the last offset is the offset of a
    -- variable of the return parameter type that is local within the
    -- invoker.
    --
    -- For a function, the last position in Offsets is the offset of a local
    -- in the caller (of Invoke) that will receive the return value.  If
    -- a constrained (or non-discriminated) object is to be returned,
    -- the local is simply a declaration of the object.  If an unconstrained
    -- object is to be returned, the local must be declared as:
    --      Return_Value : constant Return_Type := Make_Return_Value;
    -- where Make_Return_Value is an instantiation of Return_Placeholder,
    -- below.
    --
    -- Offsets'length=Modes'length+1 always.
    -- Only the modes of the first 32 parameters will be checked for
    -- mode conformity.
    --
    -- All objects referenced by Offsets must be declared within the caller.
    -- An offset value cannot reference an object in an enclosing scope.
    --
    -- Unusual restrictions or semantics:
    --  1.  Takes a moderate amount of time to do the call.  In addition
    --      to checking the Modes and Offsets vectors, each parameter
    --      must be loaded on the stack.
    --  2.  Parameters of mode "out" (also "in out") will be copied back
    --      regardless of whether they are passed by reference.
    --  3.  Cannot be used to call generic subprogram instances.  Use
    --      a separate skin.  This is presently not checked and the result
    --      will be undefined (probably a wierd exception).
    --
    Modes_Offsets_Inconsistent : exception;     -- Lengths don't follow rules
    Unelaborated_Subprogram    :
       exception;        -- Subprogram context nonexistent
    Null_Subprogram_Value      : exception;
    Offsets_Illegal            : exception;                -- Outside of frame
    Illegal_Subprogram         : exception;
    -- Offsets first position doesn't reference legal subprogram
    Nonmatching_Subprogram_Parameter_Modes : exception;
    -- Attempt to call a subprogram whose profile does not match Modes

    generic
        type T is private;
    function Return_Placeholder return T;
    -- Unconstrained return variables must be initialized to a call to this
    -- function.  This allows a "constrained" ada object to receive the
    -- "unconstrained" return value from the invoked function.

    function Signature (Sub_Type : Subprogram_Type) return Long_Integer;
    -- return the Signature value associated with the subprogram type.

private
    subtype Parm_Count is Natural range 0 .. 127;

    type Subprogram_Type is
        record
            Val_Word       : Long_Integer := 0;
            Type_Word      : Long_Integer := 0;
            Context        : Long_Integer := 0;
            Modes          : Mode_Vector (1 .. 32);
            In_Parm_Count  : Parm_Count   := 0;
            Out_Parm_Count : Parm_Count   := 0;  -- out and in out
            Signature      : Long_Integer;
        end record;

    Null_Subprogram : constant Subprogram_Type :=
       (0, 0, 0, (1 .. 32 => No_Mode), 0, 0, 0);

end Subprogram_Implementation;

E3 Meta Data

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=17 rec1=00 rec2=01 rec3=056
        [0x01] rec0=15 rec1=00 rec2=02 rec3=05c
        [0x02] rec0=00 rec1=00 rec2=07 rec3=018
        [0x03] rec0=12 rec1=00 rec2=03 rec3=00c
        [0x04] rec0=12 rec1=00 rec2=04 rec3=040
        [0x05] rec0=18 rec1=00 rec2=05 rec3=018
        [0x06] rec0=0d rec1=00 rec2=06 rec3=000
    tail 0x2150094fc81977fdf12bc 0x42a00088462063203