|
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: ┃ B T ┃
Length: 8153 (0x1fd9)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦4c85d69e2⟧
└─⟦this⟧
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1988 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054-3197
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1988. ALL RIGHTS RESERVED.
--
--
package body Command_Line is
Max_Param_Size : constant := 512 * 8;
subtype Param_String is String (1 .. Max_Param_Size);
type Param_Ptr_Type is access Param_String;
for Param_Ptr_Type'Storage_Size use 0; -- suppress collection
Param_Size : Natural;
pragma Import_Object (Param_Size, "__OS_PARAM_SIZE");
Param_Ptr : Param_Ptr_Type;
pragma Import_Object (Param_Ptr, "__OS_PARAM_PTR");
Parameter_String : Param_String := Param_Ptr.all;
Param_First : constant Natural := 1;
Param_Last : Natural := Param_Size;
Environ_First : Natural := Param_Size + 1;
Environ_Last : Natural := 0;
function Upper_Case (C : Character) return Character is
begin
case C is
when 'a' .. 'z' =>
return Character'Val (Character'Pos (C) - 16#20#);
when others =>
return C;
end case;
end Upper_Case;
function Equal_Mod_Case (C1 : Character; C2 : Character) return Boolean is
begin
if C1 = C2 then
return True;
else
return Upper_Case (C1) = Upper_Case (C2);
end if;
end Equal_Mod_Case;
procedure Find_Insensitive (Substr : String;
Start : Natural;
Finish : Natural;
Found : out Boolean;
Next_Index : out Natural) is
First_Index : constant Natural := Substr'First;
First_Char : constant Character := Substr (First_Index);
Last_Char : constant Character := Substr (Substr'Last);
Last_Bias : constant Natural := Substr'Length - 1;
begin
for I in Start .. Finish - Last_Bias loop
if Equal_Mod_Case (First_Char, Parameter_String (I)) and then
Equal_Mod_Case (Last_Char, Parameter_String (I + Last_Bias)) then
for J in reverse 1 .. Last_Bias - 1 loop
if not Equal_Mod_Case (Substr (First_Index + J),
Parameter_String (I + J)) then
goto Inner_Character_Mismatch;
end if;
end loop;
Found := True;
Next_Index := I + Last_Bias + 1;
return;
end if;
<<Inner_Character_Mismatch>> null;
end loop;
Found := False;
Next_Index := 0;
end Find_Insensitive;
procedure Find_Sensitive (Substr : String;
Start : Natural;
Finish : Natural;
Found : out Boolean;
Next_Index : out Natural) is
First_Index : constant Natural := Substr'First;
First_Char : constant Character := Substr (First_Index);
Last_Char : constant Character := Substr (Substr'Last);
Last_Bias : constant Natural := Substr'Length - 1;
begin
for I in Start .. Finish - Last_Bias loop
if First_Char = Parameter_String (I) and then
Last_Char = Parameter_String (I + Last_Bias) then
for J in reverse 1 .. Last_Bias - 1 loop
if Substr (First_Index + J) /= Parameter_String (I + J) then
goto Inner_Character_Mismatch;
end if;
end loop;
Found := True;
Next_Index := I + Last_Bias + 1;
return;
end if;
<<Inner_Character_Mismatch>> null;
end loop;
Found := False;
Next_Index := 0;
end Find_Sensitive;
function Length_Of_Parameters return Natural is
begin
if Param_Last > Param_First then
return Param_Last - Param_First + 1;
else
return 0;
end if;
end Length_Of_Parameters;
function Parameters return String is
begin
return Parameter_String (Param_First .. Param_Last);
end Parameters;
function Contains_Substring (S : String; Case_Insensitive : Boolean := True)
return Boolean is
Found_It : Boolean;
Next : Natural;
begin
if S'Length > 0 then
if Case_Insensitive then
Find_Insensitive (S, Param_First, Param_Last, Found_It, Next);
else
Find_Sensitive (S, Param_First, Param_Last, Found_It, Next);
end if;
return Found_It;
else
return True; -- vacuously contains ""
end if;
end Contains_Substring;
function Length_Of_Environment return Natural is
begin
if Environ_Last > Environ_First then
return Environ_Last - Environ_First + 1;
else
return 0;
end if;
end Length_Of_Environment;
function Environment return String is
begin
return Parameter_String (Environ_First .. Environ_Last);
end Environment;
function Environment_Value
(Name : String; Case_Insensitive : Boolean := True)
return String is
Found_It : Boolean;
Value_First : Natural;
Value_Last : Natural := Environ_Last;
begin
if Name'Length > 0 then
if Case_Insensitive then
Find_Insensitive (Name & '=', Environ_First,
Environ_Last, Found_It, Value_First);
else
Find_Sensitive (Name & '=', Environ_First,
Environ_Last, Found_It, Value_First);
end if;
else
return "";
end if;
if Found_It then
for I in Value_First .. Environ_Last loop
if Parameter_String (I) = ' ' then
Value_Last := I - 1;
exit;
end if;
end loop;
return Parameter_String (Value_First .. Value_Last);
else
return "";
end if;
end Environment_Value;
function Is_Printable (C : Character) return Boolean is
begin
return C >= ' ';
end Is_Printable;
procedure Setup_Parameter_Bounds is
begin
First_Loop:
for I in 1 .. Param_Size loop
if (Parameter_String (I) = Ascii.Cr) or else
(Parameter_String (I) = Ascii.Nul) then
Param_Last := I - 1;
for J in I + 1 .. Param_Size loop
if Is_Printable (Parameter_String (J)) then
Environ_First := J;
exit First_Loop;
end if;
end loop;
end if;
end loop First_Loop;
Second_Loop:
for I in Environ_First .. Param_Size loop
if not Is_Printable (Parameter_String (I)) then
Environ_Last := I - 1;
exit Second_Loop;
end if;
end loop Second_Loop;
end Setup_Parameter_Bounds;
begin
Setup_Parameter_Bounds;
end Command_Line;