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

⟦e71dafecb⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Events, seg_0258ef

Derivation

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

with Ada_C;
with System;
with Text_Io;

package body Events is

    function Action_C (Lf : Integer;
                       Fctn : System.Address;
                       Field : System.Address;
                       Value : System.Address) return System.Address;
    pragma Interface (C, Action_C);
    pragma Interface_Information (Action_C, ".action");

    function Empty_C return Integer;
    pragma Interface (C, Empty_C);
    pragma Interface_Information (Empty_C, ".empty");

    function Get_Lf_C return Integer;
    pragma Interface (C, Get_Lf_C);
    pragma Interface_Information (Get_Lf_C, ".get_lf");

    function Get_Type_C return System.Address;
    pragma Interface (C, Get_Type_C);
    pragma Interface_Information (Get_Type_C, ".get_type");

    function Get_Field_C return System.Address;
    pragma Interface (C, Get_Field_C);
    pragma Interface_Information (Get_Field_C, ".get_field");

    function Get_Value_C return System.Address;
    pragma Interface (C, Get_Value_C);
    pragma Interface_Information (Get_Value_C, ".get_value");

    procedure Next_C;
    pragma Interface (C, Next_C);
    pragma Interface_Information (Next_C, ".next");

    function Get_Lf return Local_Frames.Local_Frame is
    begin
        return Get_Lf_C;
    end Get_Lf;

    function Get_Type return String is
    begin
        return Ada_C.String_C_To_Ada (Get_Type_C);
    end Get_Type;

    function Get_Field return String is  
    begin
        return Ada_C.String_C_To_Ada (Get_Field_C);
    end Get_Field;

    function Get_Value return String is  
    begin
        return Ada_C.String_C_To_Ada (Get_Value_C);
    end Get_Value;

    procedure Next is  
    begin
        Next_C;
    end Next;

    function Action (Lf : Local_Frames.Local_Frame;
                     Fctn : String;
                     Field : String;
                     Value : String) return String is  
        C_Fctn : constant String := Fctn & Ascii.Nul;
        C_Field : constant String := Field & Ascii.Nul;
        C_Value : constant String := Value & Ascii.Nul;
    begin
        return Ada_C.String_C_To_Ada (Action_C
                                         (Lf, C_Fctn (C_Fctn'First)'Address,
                                          C_Field (C_Field'First)'Address,
                                          C_Value (C_Value'First)'Address));
    end Action;

    procedure Action (Lf : Local_Frames.Local_Frame;
                      Fctn : String;
                      Field : String;
                      Value : String) is  
        C_Fctn : constant String := Fctn & Ascii.Nul;
        C_Field : constant String := Field & Ascii.Nul;
        C_Value : constant String := Value & Ascii.Nul;
        S : constant String := Ada_C.String_C_To_Ada
                                  (Action_C (Lf, C_Fctn (C_Fctn'First)'Address,
                                             C_Field (C_Field'First)'Address,
                                             C_Value (C_Value'First)'Address));
    begin
        null;
    end Action;

    function Empty return Boolean is
    begin
        if Empty_C = 1 then
            return True;
        else
            return False;
        end if;
    end Empty;
end Events;

    nblk1=5
    nid=4
    hdr6=8
        [0x00] rec0=1f rec1=00 rec2=01 rec3=05a
        [0x01] rec0=25 rec1=00 rec2=05 rec3=012
        [0x02] rec0=13 rec1=00 rec2=02 rec3=062
        [0x03] rec0=0f rec1=00 rec2=03 rec3=000
        [0x04] rec0=0c rec1=00 rec2=03 rec3=000
    tail 0x2151fb92a83a34d1108e0 0x42a00088462060003
Free Block Chain:
  0x4: 0000  00 00 03 f9 80 1d 6c 64 2c 20 43 5f 56 61 6c 75  ┆      ld, C_Valu┆