DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦bfb447ec4⟧ TextFile

    Length: 3209 (0xc89)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;