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: ┃ A T

⟦1a81f251a⟧ TextFile

    Length: 17569 (0x44a1)
    Types: TextFile
    Names: »ADA_PARAM_UNIX_BODY«

Derivation

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

TextFile

-- NOTE: This file does not compile on an R1000 and it cannot use the
--       conditional compilation facility on the workstation; because it *is*
--       the conditional compilation facility on the workstation.

--/ if TeleGen2 and then Unix then

with File_Ops;                  -- Unix file operations
with Process_Control;           -- Unix process control; exit(n);
with Unix_Types;                -- Unix types

--/ end if;

with System;
with Text_Io;

with Ada_Parameterization;
use Ada_Parameterization;
with Error_Report;
use Error_Report;

with Arithmetic;
use Arithmetic;
with Vstring_Assign;
use Vstring_Assign;
with Vstring_Heap;
use Vstring_Heap;
with Vstring_Query;
use Vstring_Query;
with Vstring_Type;
use Vstring_Type;

------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
-- ****************************************************************************
-- * Date      - /Name/ Comment
-- *
-- * 27-NOV-90 - /GEB/ Add the Normalize option to Process_File.
-- ****************************************************************************

procedure Ada_Param_Unix is
------------------------------------------------------------------------------
-- Command line arguments:
--
--  -f <name>   - File        - Specifies an input file name
--  -n          - Normalize   - Special switch for use with the "patch" program.
--                              All "--//" strings are removed from the source.
--  -x          - Extension   - Indicates that the input file's extension is
--                              to be make all lowercase on output.
--  -p <string> - Parms       - Specifies additional/different parameter
--                              values to use,
--                               eg. "Foo,Bar=>False,Gorp=>Foo|Bar"
--
-- Used to run some Ada unit through the parameterizer.  We run through the
-- unit looking for --/if statements and we (un)comment(out) anything that
-- isn't "true" according to the default parameter settings (as modified by
-- the -p settings, if any).
--
-- Processing steps:
--
--   1) Read the file looking for structured comments.  Produce a temporary
--      output file called ada.param.tmp.
--   2) Pick an output filename.  If -x was not given then the output filename
--      is the same as the input filename.  If -x was given then the output
--      filename is the same as the input filename except that all letters
--      in the extension will be make lowercase.
--   3) If a file with the output filename already exists then compare it
--      to the temporary output file.  If they are identical then delete
--      the temporary file and exit successfully.
--   4) Copy the temporary file to the output filename and then delete the
--      temporary file.
------------------------------------------------------------------------------

--/ if TeleGen2 and then Unix then

    function Get_Argv (Position    : Integer;
                       Arg_Ptr     : System.Address;
                       Arg_Max_Len : Integer) return S_Long;
    pragma Interface (C, Get_Argv);
    pragma Linkname (Get_Argv, "Get_ArgV");

    function Get_Argc return Integer;
    pragma Interface (C, Get_Argc);
    pragma Linkname (Get_Argc, "Get_ArgC");

--/ end if;

    Input     : Vstring;
    Output    : Vstring;
    Extension : Boolean := False;
    Normalize : Boolean := False;
    Parms     : Vstring := New_Vstring (1024);

    Argc    : Integer;
    Argvi   : Integer;
    Argv    : E_String (1 .. 1024);
    Argvlen : S_Long;

--\f

    procedure Usage (Result : Integer) is
        use Text_Io;
    begin

        Put_Line ("Usage: ada-parm [-x] [-n] [-p <parms>] filename");
        Put_Line ("  -help       - produces this printout");
        Put_Line ("  -i <input>  - input filename");
        Put_Line ("  -n          - remove all --//'s regardless");
        Put_Line ("  -x          - lowercase file extension upon output");
        Put_Line ("  -p <parms>  - specify extra/different parameter values");
--/ if TeleGen2 and then Unix then
        Process_Control.Exit_Execution (Unix_Types.Integer_32 (Result));
--/ end if;

    end Usage;

--\f

    procedure Replace_Old_File (Input : String; Output : String) 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 simply delete the Input file.  If
-- they are different then we overwrite the Output with the Input and then
-- delete the Input.
------------------------------------------------------------------------------
        use Text_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

----Read the two files.  See if they compare.  If they do then simply delete
--  the Input temporary file.  The Output file may or may not exist yet.
--  Non-existence is the same as being different.

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

            begin
                loop
                    if End_Of_File (Inp_File) and then
                       End_Of_File (Out_File) then
                        Close (Inp_File);
                        Close (Out_File);
--/ if TeleGen2 and then Unix then
                        File_Ops.Unlink (Input);
--/ end if;
                        return;
                    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;
            exception
                when End_Error =>
                    null;
            end;

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

        exception
            when Name_Error =>
                null;
        end;

----Copy the Input file to the Output.  Then delete the Input.

--/ if TeleGen2 and then Unix then
        File_Ops.Unlink (Output);  -- This shouldn't be necessary but TeleSoft
                                   -- seems to have a bug.
--/ end if;
        begin
            Open (Out_File, Text_Io.Out_File, Output);
        exception
            when others =>
                begin
                    Create (Out_File, Text_Io.Out_File, Output);
                exception
                    when others =>
                        Put_Line ("Can't create output file " & Output);
                        raise;
                end;
        end;

        begin
            loop

----Try to fit a line into the space available.

                if Eof then
                    if Inp_Len > 0 then
                        New_Line (Out_File);  -- End file with a Lf.
                    end if;
                    exit;
                end if;
                Get_Line (Inp_File, Inp_Line, Inp_Len);
                Eof := End_Of_File (Inp_File);
                Eop := Eof or else Pno /= Page (Inp_File);
                Eol := Eop or else Inp_Len < Inp_Line'Length or else
                          Lno /= Text_Io.Line (Inp_File);

----If we only got part of a line then put out that part.  If we got a Ff then
--  append that and add a newline.

                if Eol then
                    if Eop and not Eof then
                        Put (Out_File, Inp_Line (1 .. Inp_Len) & Ascii.Ff);
                        Pno := Page (Inp_File);
                    else
                        Put_Line (Out_File, Inp_Line (1 .. Inp_Len));
                    end if;
                    Lno := Text_Io.Line (Inp_File);
                else
                    Put (Out_File, Inp_Line (1 .. Inp_Len));
                end if;
            end loop;
        exception
            when End_Error =>
                null;
        end;

        Close (Inp_File);
        Close (Out_File);
--/ if TeleGen2 and then Unix then
        File_Ops.Unlink (Input);
--/ end if;

    end Replace_Old_File;

--\f

begin

----Default parameter values for TeleGen2 on SunOS on a Sun-3.

--/ if TeleGen2 and then Unix then

    Argc := Get_Argc;
    Assign (Parms, "");
    Append_Resize (Parms, ""  
                              & "DEBUG,"

                              & "TeleGen2               => True,"  
                              & "Unix                   => True,"  
                              & "SysV                   => False,"

-- Bugs present in TeleGen2 68K Unix; including version 1.4A

                              & "TeleGen2_2d_Bug        => True,"  
                              & "TeleGen2_Derive_Bug    => True,"  
                              & "TeleGen2_Pack_Bug      => True,"

-- Bugs fixed in TeleGen2 68K Unix; prior to version 1.4A

                              & "TeleGen2_Length_Bug    => False,"

                              & "Multitask_Locking,"

                              & "Inline,"  
                              & "Length_Clauses,"  
                              & "Pack,"  
                              & "Record_Rep_Clauses,"

                              & "Bit0_Sign_Bit             => True, "  
                              & "Byte0_Sign_Byte           => True, "  
                              & "Positive_Is_Large         => False,"  
                              & "Record_Rep_Storage_Unit_8 => True, "  
                              & "Raw_Is_Unsigned           => True, "  
                              & "Row_Major_Order           => True, ",  
                   1024);

--/ end if;

----Process the command line arguments.  Skip the 0'th argument, it is just
--  our command name.

--/ if Unix then

    Argvi := 1;
    while Argvi < Argc loop
        Argvlen := Get_Argv (Argvi, Argv (Argv'First)'Address, Argv'Length);

        if Argv (1 .. Argvlen) = "-x" then
            Extension := True;
            Argvi     := Argvi + 1;

        elsif Argv (1 .. Argvlen) = "-n" then
            Normalize := True;
            Argvi     := Argvi + 1;

        elsif Argv (1 .. Argvlen) = "-p" and then Argvi + 1 < Argc then
            Argvlen := Get_Argv
                          (Argvi + 1, Argv (Argv'First)'Address, Argv'Length);
            Append_Resize (Parms, ",", 1024);
            Append_Resize (Parms, Argv (1 .. Argvlen), 1024);
            Argvi := Argvi + 2;

        elsif Argv (1 .. Argvlen) = "-help" then
            Usage (0);

        elsif Argv (1 .. Argvlen) = "-" or else
              (Argvlen > 1 and then Argv (1) /= '-') then
            if Input /= null then
                Error ("More than one input file given?  " &
                       To_String (To_String (Input)) & "  " &
                       To_String (Argv (1 .. Argvlen)));
                Usage (1);
            end if;
            Assign_New (Input, Argv (1 .. Argvlen));
            Argvi := Argvi + 1;

        elsif Argv (1 .. Argvlen) = "-i" and then Argvi + 1 < Argc then
            Argvlen := Get_Argv
                          (Argvi + 1, Argv (Argv'First)'Address, Argv'Length);
            if Input /= null then
                Error ("More than one input file given?  " &
                       To_String (To_String (Input)) & "  " &
                       To_String (Argv (1 .. Argvlen)));
                Usage (1);
            end if;
            Assign_New (Input, Argv (1 .. Argvlen));
            Argvi := Argvi + 2;

        else
            Error ("Unrecognized command line option: {" &
                   To_String (Argv (1 .. Argvlen)) & "}");
            Usage (1);
        end if;
    end loop;

--/ end if;     -- Unix

----We must have a filename.

    if Input = null then
        Assign_New (Input, "-");
    end if;

----Create the output filename.

    Assign_New (Output, Input);
    if Extension then
        for I in reverse 1 .. Output.Length loop
            if Output.Chars (I) = '.' then
                for J in I + 1 .. Output.Length loop
                    if Output.Chars (J) in 'A' .. 'Z' then
                        Output.Chars (J) :=
                           Character'Val (Character'Pos (Output.Chars (J)) -
                                          (Character'Pos ('A') -
                                           Character'Pos ('a')));
                    end if;
                end loop;
            elsif Output.Chars (I) = '/' then
                exit;
            end if;
        end loop;
    end if;

----Let the user know what is happening.

    Information ("[Ada_Parameterization(Input=>" & 
                 To_String (To_String (Input)) &
                 ", Output => " & To_String (To_String (Output)) &
                 ", Parms => """ & To_String (To_String (Parms)) & """" &    
                 ", Normalize => " & Boolean'Image(Normalize) & ")]");

----Process the parameters.

    Parameter_Definition (To_String (To_String (Parms)));

----If we are not processing standard-input then do things this way.

    if To_String (Input) /= "-" then
        Process_File (To_String (To_String (Input)), "ada.param.tmp",
                      Normalize);
        Replace_Old_File ("ada.param.tmp", To_String (To_String (Output)));  
        if Extension and then  
           To_String (Input) /= To_String (Output) then
--/ if TeleGen2 and then Unix then
            File_Ops.Unlink (To_String (To_String (Input)));
--/ end if;
            null;
        end if;

----If we are processing standard-input then do things this way.

    else
        Process_File (Text_Io.Standard_Input, Text_Io.Standard_Output,
                      Normalize);
    end if;

----Let the user know we are done.

    Information ("[Done Ada_Parameterization]");
--/ if TeleGen2 and then Unix then
    Process_Control.Exit_Execution (0);            -- Program exit
--/ end if;

--exception
--
--    when others =>
--        ----TeleSoft doesn't give an error status to Unix when a wild
--        --  exception happens.  Amazing.
--        Text_Io.Put_Line( "Unhandled exception occured in ada-param.  Abort.");
--        Process_Control.Exit_Execution( 1 );

end Ada_Param_Unix;