DataMuseum.dk

top - metrics - download

    Length: 4371 (0x1113)
    Types: TextFile
    Names: »B«

└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS 
    └─⟦91c658230⟧ »DATA« 
        └─⟦458657fb6⟧ 
            └─⟦274c33adf⟧ 
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦274c33adf⟧ 
                └─⟦this⟧ 

TextFile

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;