|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ A T ┃
Length: 17569 (0x44a1)
Types: TextFile
Names: »ADA_PARAM_UNIX_BODY«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦591c5b094⟧
└─⟦this⟧
-- 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;