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

⟦0fe6764d6⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Initialize_Design_Facilities, seg_0064a8

Derivation

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

with Debug_Tools;
with Error_Reporting;
with Io;
with Program;
with Simple_Status;
with String_Utilities;
procedure Initialize_Design_Facilities is

    package Dt renames Debug_Tools;
    package Ss renames Simple_Status;
    package Su renames String_Utilities;

    Activity : constant String := "!Machine.Release.Current.Activity";
    Caller : constant String := "!Machine.Initialize_Design_Facilities";
    File_Of_Pdls : constant String := "!Machine.Design_Facilities";
    Pdl_File : Io.File_Type;

    procedure Close is
    begin
        Io.Close (Pdl_File);
    exception
        when others =>
            null;
    end Close;

    procedure Start_Pdl (Pdl_Name : String) is

        Uc_Pdl_Name : constant String :=  
           Su.Upper_Case (Su.Strip (Pdl_Name));
        Command_Options : constant String :=
           "Input | Output | Error => !MACHINE.DEVICES.NIL";
        Registration_Procedure : constant String := "REGISTER_PDL";

        Job_Id : Program.Job_Id;
        Status : Program.Condition;

        function Get_Context (From_Command : String) return String is
            Begin_Quote : constant Natural := From_Command'First;
            End_Quote : constant Natural :=  
               Su.Reverse_Locate ('"', From_Command);
        begin
            return From_Command (Natural'Succ (Begin_Quote)  
                                     .. Natural'Pred (End_Quote));
        end Get_Context;

        function Pdl_Subsystem return String is
        begin
            if Uc_Pdl_Name (Uc_Pdl_Name'First) = '!' then
                return Uc_Pdl_Name & ".PDL_DEFINITION";
            else
                return "!TOOLS.DESIGN.RELEASE." &
                          Uc_Pdl_Name & ".PDL_DEFINITION";
            end if;
        end Pdl_Subsystem;

        function Registration_Command return String is
        begin
            return Program.Current (Subsystem => Pdl_Subsystem,
                                    Unit => Registration_Procedure,
                                    Activity => Activity);
        end Registration_Command;

        function Pdl_Invocation return String is
        begin
            return Caller & " (" & Pdl_Subsystem & ')';
        end Pdl_Invocation;

    begin
        if Uc_Pdl_Name'Length = 0 then
            return;
        end if;
        Program.Create_Job (Registration_Command,
                            Context => Get_Context (Registration_Command),
                            Options => Command_Options,
                            Job => Job_Id,  
                            Status => Status);
        if not Program.Started_Successfully (Status) then
            Error_Reporting.Report_Error
               (Caller => Pdl_Invocation,
                Reason => Error_Reporting.Create_Condition_Name
                             ("Unable to Register " & Uc_Pdl_Name,
                              Error_Reporting.Problem),
                Explanation => Ss.Display_Message (Status));
        end if;
    exception
        when Io.Name_Error =>
            Error_Reporting.Report_Error
               (Caller => Caller & ".Start_Pdl",
                Reason => Error_Reporting.Create_Condition_Name
                             ("Invalid_Pdl_Name", Error_Reporting.Problem),
                Explanation => Uc_Pdl_Name & " cannot be found.");
        when others =>
            Error_Reporting.Report_Error
               (Caller => Pdl_Invocation,
                Reason => Error_Reporting.Create_Condition_Name
                             ("Unhandled_Exception", Error_Reporting.Problem),
                Explanation => Dt.Get_Exception_Name (True, True));
    end Start_Pdl;
begin  
    begin
        Io.Open (File => Pdl_File, Mode => Io.In_File, Name => File_Of_Pdls);
    exception
        when Io.Name_Error =>
            -- File does not exist
            return;   end;
    begin
        loop
            Start_Pdl (Io.Get_Line (Pdl_File));
        end loop;
    exception
        when Io.End_Error =>
            Close;
    end;
exception
    when others =>
        Close;
        Error_Reporting.Report_Error
           (Caller => Caller,
            Reason => Error_Reporting.Create_Condition_Name
                         ("UNHANDLED EXCEPTION", Error_Reporting.Problem),
            Explanation => Dt.Get_Exception_Name (True, True));  
end Initialize_Design_Facilities;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=21 rec1=00 rec2=01 rec3=086
        [0x01] rec0=1b rec1=00 rec2=02 rec3=00c
        [0x02] rec0=17 rec1=00 rec2=03 rec3=04a
        [0x03] rec0=18 rec1=00 rec2=04 rec3=002
        [0x04] rec0=12 rec1=00 rec2=05 rec3=000
    tail 0x21701d76e81bfa4cc3e4e 0x42a00088462060003