⟦6e3e8e4cb⟧

TextFile

procedure Initialize;with Activity;
with Debug_Tools;
with Error_Reporting;
with Io;
with Log;
with Profile;
with Library;
with Program;
with Operator;
with Link_Tools;
with Compilation;

procedure Initialize is
begin
    Io.Set_Output ("!Machine.Error_Logs.Machine_Initialize");
    Io.Set_Error (Io.Current_Output);
    Activity.Set ("!Machine.Release.Current.Activity");

    Operator.Enable_Privileges;

    if not Operator.Privileged_Mode then
        Log.Put_Line ("Could not enable privileges.",
                      Kind => Profile.Error_Msg);
    end if;

    Library.Context ("!Machine.Error_Logs");

    Program.Run ("""!Machine"".Initialize_Housekeeping;");
    Program.Run ("""!Machine"".Initialize_Daemons;");
    Program.Run ("""!Machine"".Initialize_Network;");

    if Link_Tools.Has ("Install_Subsystems", "?",
                       Link_Tools.External, "!Machine") then
        begin
            Program.Run
               ("""!Machine'L.Install_Subsystems$"".Install_Subsystems;");
        exception
            when others =>
                null;
        end;
    end if;

    Library.Context ("!Machine.Error_Logs");

    Program.Run ("""!Commands"".Gateway_Class.Boot_Time_Initialization");
    Program.Run ("""!Machine"".Initialize_Terminals;");
    Program.Run ("""!Machine"".Initialize_Servers;");
    Program.Run ("""!Machine"".Initialize_Print_Spooler;");
    Program.Run ("""!Machine"".Initialize_Site;");
    Program.Run ("""!Machine"".Initialize_Mail;");
    Program.Run ("""!Machine"".Initialize_Cross_Compilers;");
    Program.Run ("""!Machine"".Initialize_Design_Facilities;");

    Io.Reset_Output;
exception
    when others =>
        Error_Reporting.Report_Error
           (Caller      => "!Machine.Initialize",
            Reason      => Error_Reporting.Create_Condition_Name
                              ("Unhandled_Exception", Error_Reporting.Fatal),
            Explanation => Debug_Tools.Get_Exception_Name (True, True));
end Initialize;procedure Initialize_Cross_Compilers;with Debug_Tools;
with Error_Reporting;
with Io;
with Program;
with Simple_Status;
with String_Utilities;
with System_Utilities;

procedure Initialize_Cross_Compilers is

    File_Name : constant String := "!Machine.Cross_Compilers";
    File : Io.File_Type;

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

    function Get_First_Token (From : String) return String is
    begin
        for Index in From'Range loop
            if From (Index) = ' ' then
                return From (From'First .. Index - 1);
            end if;
        end loop;
        return From;
    end Get_First_Token;

    function Get_Remainder (From : String) return String is
    begin
        for Index in From'Range loop
            if From (Index) = ' ' then
                return From (Index + 1 .. From'Last);
            end if;
        end loop;
        return "";
    end Get_Remainder;

    procedure Start_Compiler (Target_Entry : String) is  
        Target_Name : constant String := Get_First_Token (Target_Entry);
        Params : constant String := Get_Remainder (Target_Entry);

        Caller : constant String :=
           "!Machine.Initialize_Cross_Compilers." & Target_Name;

        Context : constant String := "!Targets.Implementation.";
        Routine : constant String := "Start_Compiler";  
        Activity : constant String := "!Machine.Release.Current.Activity";
        Job_Id : Program.Job_Id;
        Status : Program.Condition;

        procedure Await_Elaboration is
        begin  
            if not Program.Started_Successfully (Status) then
                Error_Reporting.Report_Error
                   (Caller => Caller,
                    Reason => Error_Reporting.Create_Condition_Name
                                 ("Unable to start compiler",
                                  Error_Reporting.Problem),
                    Explanation => Simple_Status.Display_Message (Status));
            end if;

            for I in 1 .. 100 loop
                begin
                    declare
                        Name : constant String :=
                           System_Utilities.Job_Name (Job_Id);
                    begin  
                        if Name'First =
                           String_Utilities.Locate (Fragment => Target_Name,
                                                    Within => Name,
                                                    Ignore_Case => True) then
                            return;
                        end if;
                        delay 5.0;
                    end;
                exception
                    when others =>
                        Error_Reporting.Report_Error
                           (Caller => Caller,
                            Reason => Error_Reporting.Create_Condition_Name
                                         ("Cannot get compiler job name",
                                          Error_Reporting.Problem),
                            Explanation =>
                               Debug_Tools.Get_Exception_Name (True, True));
                        return;
                end;
            end loop;

            Error_Reporting.Report_Error
               (Caller => Caller,
                Reason => Error_Reporting.Create_Condition_Name
                             ("Compiler has not changed its name",
                              Error_Reporting.Problem),
                Explanation => "");
        end Await_Elaboration;
    begin
        if String_Utilities.Locate ("Motorola_68k", Target_Name) /= 0 then
            -- with Common, Control, Stream, the Start_Compiler procedure
            -- does not return until all components are started.
            Program.Run (Program.Current (Subsystem => Context & Target_Name,
                                          Unit => Routine,
                                          Parameters => Params,
                                          Activity => Activity));  
        else
            Program.Create_Job
               (Program.Current (Subsystem => Context & Target_Name,
                                 Unit => Routine,
                                 Activity => Activity),  
                Job_Id,  
                Status);
            Await_Elaboration;
        end if;
    exception
        when others =>
            Error_Reporting.Report_Error
               (Caller => Caller,
                Reason => Error_Reporting.Create_Condition_Name
                             ("Unhandled_Exception", Error_Reporting.Problem),
                Explanation => Debug_Tools.Get_Exception_Name (True, True));
    end Start_Compiler;
begin  
    begin
        Io.Open (File => File, Mode => Io.In_File, Name => File_Name);
    exception
        when Io.Name_Error =>
            -- file does not exist
            return;
    end;

    begin
        loop
            Start_Compiler (String_Utilities.Strip_Leading
                               (Filler => ' ', From => Io.Get_Line (File)));
        end loop;
    exception
        when Io.End_Error =>
            Close;
    end;
exception
    when others =>
        Close;
        raise;
end Initialize_Cross_Compilers;procedure Initialize_Daemons;with Io;
with Daemon;
with Program;
with Error_Reporting;
with Debug_Tools;
with Disk_Daemon;
with Time_Utilities;
use Time_Utilities;

procedure Initialize_Daemons is

    function "=" (L, R : Disk_Daemon.Threshold_Kinds) return Boolean
        renames Disk_Daemon."=";

    subtype Volume_Number is Disk_Daemon.Volume_Number;
    subtype Bytes         is Natural;
    Kbyte : constant Bytes := 1024;
    Mbyte : constant Bytes := 1024 * 1024;
    subtype Threshold       is Disk_Daemon.Percentage; -- eg, 10 means 10%
    subtype Threshold_Kinds is Disk_Daemon.Threshold_Kinds;
    type    Threshold_Array is array (Threshold_Kinds) of Threshold;

    function Min (Volume : Volume_Number) return Bytes is
    begin
        if Volume = 1 then
            return (10 + 25) * Mbyte;
        else
            return 10 * Mbyte;
        end if;

        -- A Suspend threshold corresponding to 1 block is clearly worthless,
        -- regardless of the size of the disk. Thus, you would expect there
        -- to be some minimum absolute number of disk blocks to be included in
        -- the suspend threshold. Assuming you recover from hitting the
        -- suspend threshold by rebooting and elaborating just DDC, the
        -- minimum needs to be higher than 10 Mbytes. You need to account for
        -- swap space for the environment on volume 1.
    end Min;

    function New_Garbage (Consumed : Bytes) return Bytes is
    begin
        return (2 * Consumed) / 100; -- 2% of Consumed

        -- GC has some tables whose size is a linear function of capacity. GC
        -- produces new garbage while it is collecting the old garbage. The
        -- amount of the new garbage is a linear function of capacity. We
        -- assume that GC will produce 2% new garbage for the garbage that it
        -- reclaims.

    end New_Garbage;

    function Suspend (Volume   : Volume_Number;  
                      Capacity : Bytes) return Bytes is

        Fixed    : constant Bytes := Min (Volume);
        Variable : constant Bytes := 2 * New_Garbage (Capacity);
    begin
        return Fixed + Variable;

        -- Assuming all of Capacity is garbage is clearly pessimistic.  We
        -- leave twice as much space as should be required because (1) failure
        -- to leave enough space results in a restore from backup, and (2) the
        -- procedure for recovering from hitting Suspend is very unfriendly
        -- causing people to end up trying it 2 or 3 times, each wasted
        -- attempt producing more garbage.
    end Suspend;

    function Get_Threshold (Kind     : Threshold_Kinds;
                            Volume   : Volume_Number;
                            Capacity : Bytes) return Bytes is
    begin
        if Kind = Disk_Daemon.Suspend_System then
            return Suspend (Volume, Capacity);
        else
            declare
                Next_Kind   : constant Threshold_Kinds :=
                   Threshold_Kinds'Succ (Kind);
                Next_Amount : constant Bytes :=
                   Get_Threshold (Next_Kind, Volume, Capacity);
                Headroom    : constant Bytes := Capacity - Next_Amount;
            begin
                return Next_Amount + New_Garbage (Headroom);

                -- We assume that the headroom is ALL garbage when GC starts,
                -- which is clearly pessimistic.  The formula leaves enough
                -- space for a complete GC cycle started AFTER the threshold
                -- is reached.
            end;
        end if;
    end Get_Threshold;

    function To_Percent (Value    : Bytes;  
                         Capacity : Bytes) return Threshold is
    begin
        return Threshold ((Value * 100) / Capacity);
    end To_Percent;

    procedure Set (Volume   : Volume_Number;  
                   Capacity : Bytes) is

        Thresholds     : Threshold_Array;
        Next_Threshold : Threshold := 0;
    begin
        -- Compute theoretical Thresholds

        for K in Thresholds'Range loop
            Thresholds (K) :=
               To_Percent (Get_Threshold (K, Volume, Capacity), Capacity);
        end loop;

        -- Adjust for at least a 1% difference between thresholds

        for K in reverse Thresholds'Range loop
            if Next_Threshold >= Thresholds (K) then
                Thresholds (K) := Next_Threshold + 1;
            end if;

            Next_Threshold := Thresholds (K);
        end loop;

        -- Preset thresholds to known, legal values

        for K in reverse Thresholds'Range loop
            Disk_Daemon.Set_Threshold
               (Volume, K, 1 + Threshold_Kinds'Pos (Threshold_Kinds'Last) -
                              Threshold_Kinds'Pos (K));
        end loop;

        for K in Thresholds'Range loop
            Disk_Daemon.Set_Threshold (Volume, K, Thresholds (K));
        end loop;
    end Set;
begin
    -- Set Disk Daemon thresholds based on disk capacities

    for Vol in 1 .. 4 loop
        if Disk_Daemon.Exists (Vol) then
            Set (Vol, Disk_Daemon.Capacity (Vol) * Kbyte);
        end if;
    end loop;

    -- Snapshot parameters
    Daemon.Snapshot_Warning_Message (20.0);
    Daemon.Snapshot_Start_Message (False);
    Daemon.Schedule ("Snapshot", 30 * Minute, 15 * Minute);

    -- note that daemons are scheduled by default

    Daemon.Set_Access_List_Compaction;

    begin
        Program.Run_Job
           (S        => Program.Current  
                           (Subsystem  => "!Commands.System_Maintenance",
                            Unit       => "Smooth_Snapshots",
                            Parameters => "",
                            Activity   => "!Machine.Release.Current.Activity"),
            Debug    => False,
            Context  => "$",
            After    => 0.0,
            Options  => "Name => (Smooth Snapshots)",
            Response => "<PROFILE>");  
    exception
        when others =>
            Error_Reporting.Report_Error
               (Caller => "!Machine.Initialize_Daemons.Smooth_Snapshots",
                Reason => Error_Reporting.Create_Condition_Name
                             ("Unhandled_Exception", Error_Reporting.Problem),
                Explanation => Debug_Tools.Get_Exception_Name (True, True));
    end;
end Initialize_Daemons;procedure Initialize_Design_Facilities;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;procedure Initialize_Housekeeping;with Library;
with Scheduler;
with Access_List;

procedure Initialize_Housekeeping is
begin
    Library.Destroy (Existing  => "!Machine.Temporary??",
                     Threshold => Natural'Last,
                     Limit     => "<All_Worlds>",
                     Response  => "<Errors>");
    Library.Create_World
       ("!Machine.Temporary", Model => "", Response => "<Errors>");
    Library.Set_Retention_Count
       ("!Machine.Temporary", 0, Response => "<Errors>");
    Access_List.Set ("Network_Public => Rwcd", "!Machine.Temporary",
                     Response => "<Errors>");
    Access_List.Set_Default ("Network_Public => Rwcd", "!Machine.Temporary",
                             Response => "<Errors>");  
    Library.Compact_Library ("!Machine.Error_Logs");
    Library.Compact_Library ("!Machine.Queues.??'C(World)");

    Scheduler.Set ("Background_Streams", 3);
    Scheduler.Set ("Stream_Time 1", 2);
    Scheduler.Set ("Stream_Time 2", 58);
    Scheduler.Set ("Stream_Jobs 1", 3);
    Scheduler.Set ("Foreground_Time_Limit", 300);
    Scheduler.Set ("Max_Detached_Wsl", 5000);
    Scheduler.Set ("Max_Attached_Wsl", 4000);
    Scheduler.Set ("Min_Ce_Wsl", 150);
    Scheduler.Set ("Max_Ce_Wsl", 500);
    Scheduler.Set ("Min_Oe_Wsl", 75);
    Scheduler.Set ("Max_Oe_Wsl", 750);
    Scheduler.Set ("Min_Server_Wsl", 75);
    Scheduler.Set ("Disk_Scheduling", 0);
end Initialize_Housekeeping;procedure Initialize_Mail;with Program;
with Debug_Tools;
with Error_Reporting;
procedure Initialize_Mail is
begin
    Program.Run ("""!Machine.Transfer"".Initialize");
    Program.Run ("""!Machine.Transfer.Distribute"".Initialize");
exception
    when others =>
        Error_Reporting.Report_Error
           (Caller      => "!Machine.Initialize_Mail",
            Reason      => Error_Reporting.Create_Condition_Name
                              ("Unhandled_Exception", Error_Reporting.Problem),
            Explanation => Debug_Tools.Get_Exception_Name (True, True));
end Initialize_Mail;procedure Initialize_Network;with Debug_Tools;
with Error_Reporting;
with Ftp_Server;
with Program;
with Tcp_Ip_Boot;
with Network_Product;
with Ftp_Product;
with Rpc_Product;

procedure Initialize_Network is
begin
    if Network_Product.Is_Installed ("TCP/IP") then
        begin
            Tcp_Ip_Boot (Exos_Prefix => "!Tools.Networking.");
        exception
            when others =>
                Error_Reporting.Report_Error
                   (Caller      => "!Machine.Initialize_Network.TCP_IP_Boot",
                    Reason      => Error_Reporting.Create_Condition_Name
                                      ("Unhandled_Exception",
                                       Error_Reporting.Problem),
                    Explanation => Debug_Tools.Get_Exception_Name (True, True));
        end;
    end if;

    if Ftp_Product.Is_Installed then
        begin
            delay 15.0;
            Ftp_Server.Start;
        exception
            when others =>
                Error_Reporting.Report_Error
                   (Caller      => "!Machine.Initialize_Network.FTP",
                    Reason      => Error_Reporting.Create_Condition_Name
                                      ("Unhandled_Exception",
                                       Error_Reporting.Problem),
                    Explanation => Debug_Tools.Get_Exception_Name (True, True));
        end;
    end if;

    if Rpc_Product.Is_Installed then
        begin
            delay 15.0;
            Program.Run_Job
               ("""!Commands"".Archive.Server",
                Context => "!Machine.Error_Logs",
                Options => "Output => !Machine.Error_Logs.Archive_Server_Log," &
                              "Name => (Archive Server), " &
                              "User=NETWORK_PUBLIC, Password=()");
        exception
            when others =>
                Error_Reporting.Report_Error
                   (Caller      => "!Machine.Initialize_Network.Archive",
                    Reason      => Error_Reporting.Create_Condition_Name
                                      ("Unhandled_Exception",
                                       Error_Reporting.Problem),
                    Explanation => Debug_Tools.Get_Exception_Name (True, True));
        end;
    end if;
end Initialize_Network;procedure Initialize_Print_Spooler;with Queue;

procedure Initialize_Print_Spooler is
begin
    Queue.Restart_Print_Spooler;
end Initialize_Print_Spooler;procedure Initialize_Servers;with Debug_Tools;
with Error_Reporting;
with Program;
procedure Initialize_Servers is
begin
    delay 15.0;

    begin
        Program.Run_Job (Program.Current
                            ("!Tools.CI", "CI.Login",
                             Activity => "!Machine.Release.Current.Activity"),
                         Options => "Name => (Console Command Interpreter)",
                         Context => "!Machine.Error_Logs");
    exception
        when others =>
            Error_Reporting.Report_Error
               (Caller => "!Machine.Initialize_Servers.Ci",
                Reason => Error_Reporting.Create_Condition_Name
                             ("Unhandled_Exception", Error_Reporting.Problem),
                Explanation => Debug_Tools.Get_Exception_Name (True, True));
    end;
end Initialize_Servers;procedure Initialize_Terminals;with Operator;
with Telnet_Product;
with Terminal;
procedure Initialize_Terminals is
begin
    Terminal.Set_Logoff_On_Disconnect (Line => 16, Enabled => False);

    -- for I in 17 .. 20 loop
    --    Operator.Enable_Terminal (I);
    --    Terminal.Set_Disconnect_On_Logoff (Line => I, Enabled => false);
    -- end loop;

    if Telnet_Product.Is_Installed then
        for I in 240 .. 244 loop
--        for I in 240 .. 240 loop
            Terminal.Set_Disconnect_On_Logoff (Line => I, Enabled => True);
            Terminal.Set_Logoff_On_Disconnect (Line => I, Enabled => False);
            Operator.Enable_Terminal (I);
        end loop;
    end if;

end Initialize_Terminals
DataMuseum.dk

Rational R1000/400

⟦6e3e8e4cb⟧ TextFile

Derivation

TextFile
