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

⟦da33d3dfc⟧ Ada Source

    Length: 4096 (0x1000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Callback_Test, seg_021f21

Derivation

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

with Callback;
with System;
with Text_Io;
procedure Callback_Test is

    -- These variables are stored here so that they will be active
    -- when the C routine gets around to using them.
    -- Alternatively these variables could be encapsulated in a package
    -- specification. They should NOT be put into Register_the_subprogram
    -- because they would cease to exist when that subprogram finishes.
    Some_Descriptor : Callback.Function_Descriptor_Type;
    Some_Subprogram_Value : System.Subprogram_Value;

    -- This is the Ada subprogram to be called from C.
    function Ada_Function (A, B, C, D : Integer) return Integer is
    begin
        Text_Io.Put_Line ("      Ada_function was called.");
        Text_Io.Put_Line ("      The parameters are: ");
        Text_Io.Put_Line ("        A=" & Integer'Image (A));
        Text_Io.Put_Line ("        B=" & Integer'Image (B));
        Text_Io.Put_Line ("        C=" & Integer'Image (C));
        Text_Io.Put_Line ("        D=" & Integer'Image (D));
        Text_Io.Put_Line ("      Ada_function returning 27");
        return 27;
    end Ada_Function;

    -- This procedure sets up a subprogram descriptor and passes the
    -- result to a C routine.  The C routine will store this value
    -- in a global variable (known only to C).  At a later point
    -- Call_ada_from_C can be called to execute the Ada subprogram.
    procedure Register_The_Subprogram is
        procedure Register_Subprogram (Descriptor : System.Address);
        pragma Interface (C, Register_Subprogram);
    begin
        Some_Subprogram_Value := Ada_Function'Subprogram_Value;
        Some_Descriptor := Call_Back.Ada_To_C (Some_Subprogram_Value);
        Register_Subprogram (Some_Descriptor'Address);
    end Register_The_Subprogram;

    -- This is a C routine which invokes the Ada subprogram that
    -- was registered by Register_the_subprogram.
    procedure Call_Ada_From_C;
    pragma Interface (C, Call_Ada_From_C);

begin
    Text_Io.Put_Line ("====> Example starts");
    Register_The_Subprogram;
    Text_Io.Put_Line ("  Ada_function has been registered with the C program");
    Text_Io.Put_Line ("  Calling the C routine" &
                      "(which should call Ada_function)...");
    Call_Ada_From_C;  -- Execute Ada_function via a call to C.
    Text_Io.Put_Line ("  ...returned from the C routine");
    Text_Io.Put_Line ("====> Example over");

end Callback_Test;
pragma Main;

    nblk1=3
    nid=0
    hdr6=6
        [0x00] rec0=17 rec1=00 rec2=01 rec3=026
        [0x01] rec0=15 rec1=00 rec2=03 rec3=026
        [0x02] rec0=0e rec1=00 rec2=02 rec3=000
    tail 0x2171dc44883905ea37a7d 0x42a00088462060003