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

⟦faea7c3e1⟧ TextFile

    Length: 13917 (0x365d)
    Types: TextFile
    Names: »B«

Derivation

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦591c5b094⟧ 
                └─⟦this⟧ 

TextFile

with Ada;
with Common;
with Compilation;
with Debug_Tools;
with Directory_Tools;
with Editor;
with Io;
with Library;
with Log;
with Profile;
with Time_Utilities;

with Ada_Parameterization;

procedure Parameterize_Ada_Unit (Unit      : String  := "@'c(Ada)";
                                 Parms     : String  := "";
                                 Repromote : Boolean := False;
                                 Response  : String  := "<PROFILE>") is
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
--                  All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------

    package Naming renames Directory_Tools.Naming;
    package Object renames Directory_Tools.Object;

    Response_Profile : Profile.Response_Profile := Profile.Value (Response);

    Quit : exception;           -- Raised when we want to terminate.

    -- Total_Parms : constant String :=
    --    ""                           -- These all apply for R1000's
    --        & "DEBUG,"
    --
    --        & "R1000,"
    --        & "R1000_SIZE_BUG,"
    --
    --        & "MULTITASK_LOCKING,"
    --
    --        & "ENABLE_DEALLOCATION,"
    --        & "LENGTH_CLAUSES,"
    --        & "RECORD_REP_CLAUSES => FALSE,"
    --
    --        & "BIT0_SIGN_BIT             => TRUE, "
    --        & "BYTE0_SIGN_BYTE           => TRUE, "
    --        & "RECORD_REP_STORAGE_UNIT_8 => TRUE, "
    --        & "POSITIVE_IS_LARGE         => TRUE, "
    --        & "RAW_IS_UNSIGNED           => TRUE, "
    --        & "ROW_MAJOR_ORDER           => TRUE, "
    --
    --        & Parms;

    Temp_File_Name : constant String :=
       "!Machine.Temporary.Parameterize_Ada_Unit_" &
          Time_Utilities.Image (Time_Utilities.Get_Time,
                                Date_Style => Time_Utilities.Ada,
                                Contents   => Time_Utilities.Date_Only) &  
          "_" &  
          Time_Utilities.Image (Time_Utilities.Get_Time,
                                Time_Style => Time_Utilities.Ada,
                                Contents   => Time_Utilities.Time_Only);

    Temp_File : Io.File_Type;

--\f

    function Replace_Old_File (Input  : String;  
                               Output : String) return Boolean is
------------------------------------------------------------------------------
--  Input   - Specifies the name of our temporary file
--  Output  - Specifies the name of our output file.
--
-- We compare the contents of the Output file to the contents of the Input
-- file.  If they are identical then we return False.  If they are different
-- then we return True.
------------------------------------------------------------------------------
        use Io;
        Inp_File : File_Type;
        Out_File : File_Type;
        Inp_Line : String (1 .. 1024);
        Out_Line : String (1 .. 1024);
        Inp_Len  : Natural;
        Out_Len  : Natural;
        Lno      : Positive_Count := 1;
        Pno      : Positive_Count := 1;
        Eof      : Boolean        := False;
        Eop      : Boolean        := False;
        Eol      : Boolean        := False;
        St_I     : Natural;
        St_O     : Natural;
        Fi_I     : Natural;
        Fi_O     : Natural;
    begin

----Open the files for reading.

        Open (Inp_File, In_File, Input);
        Open (Out_File, In_File, Output);

----Read them a line at a time.  If we hit eof on both then they are the same.

        begin
            loop
                if End_Of_File (Inp_File) and then End_Of_File (Out_File) then
                    Close (Inp_File);
                    Close (Out_File);
                    return False;
                end if;

----Read a line.  Strip off leading and trailing blanks.

                Get_Line (Inp_File, Inp_Line, Inp_Len);
                St_I := 1;
                for I in 1 .. Inp_Len loop
                    if Inp_Line (I) = ' ' or else  
                       Inp_Line (I) = Ascii.Ht then
                        St_I := I + 1;
                    else
                        exit;
                    end if;
                end loop;
                Fi_I := Inp_Len;
                for I in reverse St_I .. Inp_Len loop
                    if Inp_Line (I) = ' ' or else  
                       Inp_Line (I) = Ascii.Ht then
                        Fi_I := I - 1;
                    else
                        exit;
                    end if;
                end loop;

----Read a line.  Strip off leading and trailing blanks.

                Get_Line (Out_File, Out_Line, Out_Len);
                St_O := 1;
                for I in 1 .. Out_Len loop
                    if Out_Line (I) = ' ' or else  
                       Out_Line (I) = Ascii.Ht then
                        St_O := I + 1;
                    else
                        exit;
                    end if;
                end loop;
                Fi_O := Out_Len;
                for I in reverse St_O .. Out_Len loop
                    if Out_Line (I) = ' ' or else  
                       Out_Line (I) = Ascii.Ht then
                        Fi_O := I - 1;
                    else
                        exit;
                    end if;
                end loop;

----Are the two stripped lines the same?

                if Page (Inp_File) /= Page (Out_File) or else  
                   Fi_I - St_I /= Fi_O - St_O or else
                   Inp_Line (St_I .. Fi_I) /= Out_Line (St_O .. Fi_O) then
                    exit;
                end if;
            end loop;

----Early eof on one file means they differ.

        exception
            when End_Error =>
                null;
        end;

----The files differ, close them and return.

        Close (Inp_File);
        Close (Out_File);
        return True;

    end Replace_Old_File;

--\f

    procedure Process_Unit (Unit : String) is
------------------------------------------------------------------------------
--  Unit  - Specifies the full path name of an Ada unit that we are to process
--
-- Called to process a specific unit.
------------------------------------------------------------------------------
    begin

----Announce our intentions.

        Log.Put_Line ("Process " & Unit,  
                      Profile.Positive_Msg,  
                      Response_Profile);

----Process the file and turn on/off any parameterizations.

        Ada_Parameterization.Process_File (Unit, Temp_File_Name);
        if Replace_Old_File (Unit, Temp_File_Name) then

----Now reduce the source file to Source.

            Compilation.Demote (Unit        => Unit,
                                Goal        => Compilation.Source,
                                Limit       => "<ALL_WORLDS>",
                                Effort_Only => False,
                                Response    => Response);

----Now parse the temp file and replace the original Ada file.

            declare
                Old_Version : constant String :=
                   Directory_Tools.Naming.Version_Attribute
                      (Directory_Tools.Naming.Unique_Full_Name
                          (Directory_Tools.Naming.Resolution (Unit)));
            begin

                Compilation.Parse  
                   (File_Name      => Temp_File_Name,
                    Directory      => Naming.Prefix (Unit) & ".$",
                    List           => False,
                    Source_Options => "",
                    Response       => Response);

                ----Silly damn Compilation does not RAISE on errors.  Arghhh...
                --  See if the version number changed.

                if Old_Version =
                   Directory_Tools.Naming.Version_Attribute
                      (Directory_Tools.Naming.Unique_Full_Name
                          (Directory_Tools.Naming.Resolution (Unit))) then

                    if Profile.Propagate (Response_Profile) then
                        raise Library.Error;
                    end if;
                end if;
            end;

----Silly R1000 parser bug; it throws away all form-feeds.  Go put them
--  back into the image.

            Editor.Mark.Push (Repeat => 1);
            Common.Edit (Name     => Unit,  
                         In_Place => False,  
                         Visible  => True);

            Editor.Image.Beginning_Of (Offset => 0);
            Editor.Search.Replace_Next (Target      => "<!E" & "OP!>",
                                        Replacement => (1 => Ascii.Ff),
                                        Repeat      => 99999,
                                        Wildcard    => False);
            Ada.Source_Unit;
            Common.Release (Window => "<IMAGE>");
            Editor.Mark.Top;
            Editor.Mark.Delete_Top;
        end if;

    end Process_Unit;

--\f

    function No_Version (Name : String) return String is
------------------------------------------------------------------------------
-- Remove the 'V(xxx) version attribute from a name.
------------------------------------------------------------------------------
    begin

        for I in reverse Name'Range loop
            if Name (I) = ''' and then  
               I <= Name'Last - 4 and then  
               Name (I .. I + 2) = "'V(" then
                for J in I + 3 .. Name'Last loop
                    if Name (J) = ')' then
                        if J = Name'Last then
                            return Name (Name'First .. I - 1);
                        else
                            return Name (Name'First .. I - 1) &
                                      Name (J + 1 .. Name'Last);
                        end if;
                    end if;
                end loop;
            end if;
        end loop;

    end No_Version;

--\f

    procedure Main_Line is
------------------------------------------------------------------------------
-- Called to control the performance of the actual work.  We resolve the
-- possibly wildcarded Ada unit name specification and then we process each
-- of the named units one at a time.
------------------------------------------------------------------------------
        Unit_Iter   : Object.Iterator;
        Unit_Object : Object.Handle;
    begin

----Announce our presence.

        Log.Put_Line ("[Parameterize_Ada_Unit (" & Unit & ")]",
                      Profile.Note_Msg,  
                      Response_Profile);

----See if there are any Units to process.

        Unit_Iter := Naming.Resolution ("[" & Unit & "]'c(ada)");
        if Object.Done (Unit_Iter) then
            Log.Put_Line (Unit & " does not match any existing Ada units.",
                          Profile.Error_Msg,  
                          Response_Profile);
            raise Quit;
        end if;

----Process each Unit.

        loop
            Unit_Object := Object.Value (Unit_Iter);
            declare
                Name : constant String :=
                   No_Version (Naming.Unique_Full_Name (Unit_Object));
            begin
                Process_Unit (Name);
            end;

----Get the next unit.

            Object.Next (Unit_Iter);
            if Object.Done (Unit_Iter) then
                exit;
            end if;

        end loop;

----Now put all units back to Installed.

        if Repromote then
            Compilation.Promote (Unit        => Unit,
                                 Scope       => Compilation.Subunits_Too,
                                 Goal        => Compilation.Installed,
                                 Limit       => "<WORLDS>",
                                 Effort_Only => False,
                                 Response    => Response);
        end if;

----Delete the temp file.

        Compilation.Delete (Unit     => Temp_File_Name,
                            Limit    => "<WORLDS>",
                            Response => Response & " ~:::");

----We are all done.

        Log.Put_Line ("[End Parameterize_Ada_Unit]",  
                      Profile.Note_Msg,  
                      Response_Profile);
        return;

    end Main_Line;

--\f

------------------------------------------------------------------------------
-- Process the Units and catch all exceptions that may fly out.
------------------------------------------------------------------------------

begin

    Ada_Parameterization.Parameter_Definition (Parms);
    Main_Line;

exception

    when Quit | Library.Error =>
        Log.Put_Line ("[End Parameterize_Ada_Unit]",  
                      Profile.Note_Msg,  
                      Response_Profile);
        raise Library.Error;

    when others =>
        Log.Put_Line ("Unexpected exception: " &
                      Debug_Tools.Get_Exception_Name (True, True),
                      Profile.Exception_Msg,  
                      Response_Profile);
        raise;

end Parameterize_Ada_Unit;