|
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 - metrics - downloadIndex: B T
Length: 18809 (0x4979)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
package body Varhand is
--| overview
--| VARiableHANDler is a package to handle the initialization, assignment,
--| and other operations of variable record arrays. it also defines all
--| variable related types.
--| n/a: errors, raises, modifies, requires
--version: 0.0
--author: Alexis Wei
--initial release: 05/14/85
use Implementation_Dependencies;
use Type_Definitions;
use Text_Io;
use String_Pkg;
use Ivdarray_Pkg;
use Livdarray_Pkg;
use Fvdarray_Pkg;
-- use Lfvdarray_Pkg;
package Flo_Io is new Float_Io (Float);
-- package Lflo_Io is new
-- Float_Io (Long_Float);
package Int_Io is new Text_Io.Integer_Io (Integer);
package Lint_Io is new Text_Io.Integer_Io (Long_Integer);
type String_Variable_Array_Elements is
record
Unit_Id : Program_Unit_Unique_Identifier;
Variable_Name : Ada_Name;
Value : String_Variables;
end record;
package String_Variable_Array_Pkg is
new Dynarray_Pkg (String_Variable_Array_Elements);
String_Variable_Array : String_Variable_Array_Pkg.Darray;
First_String_Variable : Boolean := True;
procedure Initarray (Ivarray : in out Ivrecord;
Idarray : in out Ivdarray_Pkg.Darray;
Pid : in Program_Unit_Unique_Identifier;
Vname : in Filename;
Unitname : in Filename;
Value : in Integer;
Kunt : in Natural) is
begin
Ivarray.Programid := Pid;
Ivarray.Variablename := Vname;
Ivarray.Unitname := Unitname;
Ivarray.Current_V := Value;
Ivarray.Variablecount := 1;
Ivarray.Max_V := Value;
Ivarray.Min_V := Value;
Ivarray.Average_V := Value;
Add_High (Idarray, Ivarray);
end Initarray;
procedure Initarray (Livarray : in out Livrecord;
Lidarray : in out Livdarray_Pkg.Darray;
Pid : in Program_Unit_Unique_Identifier;
Vname : in Filename;
Unitname : in Filename;
Value : in Long_Integer;
Kunt : in Natural) is
begin
Livarray.Programid := Pid;
Livarray.Variablename := Vname;
Livarray.Unitname := Unitname;
Livarray.Current_Liv := Value;
Livarray.Variablecount := 1;
Livarray.Max_Liv := Value;
Livarray.Min_Liv := Value;
Livarray.Average_Liv := Value;
Add_High (Lidarray, Livarray);
end Initarray;
procedure Initarray (Fvarray : in out Fvrecord;
Fdarray : in out Fvdarray_Pkg.Darray;
Pid : in Program_Unit_Unique_Identifier;
Vname : in Filename;
Unitname : in Filename;
Value : in Float;
Kunt : in Natural) is
begin
Fvarray.Programid := Pid;
Fvarray.Variablename := Vname;
Fvarray.Unitname := Unitname;
Fvarray.Current_Fv := Value;
Fvarray.Variablecount := 1;
Fvarray.Max_Fv := Value;
Fvarray.Min_Fv := Value;
Fvarray.Average_Fv := Value;
Add_High (Fdarray, Fvarray);
end Initarray;
-- procedure Initarray (Lfvarray : in out Lfvrecord;
-- Lfdarray : in out Lfvdarray_Pkg.Darray;
-- Pid : in Program_Unit_Unique_Identifier;
-- Vname : in Filename;
-- Unitname : in Filename;
-- Value : in Long_Float;
-- Kunt : in Natural) is
-- begin
-- Lfvarray.Programid := Pid;
-- Lfvarray.Variablename := Vname;
-- Lfvarray.Unitname := Unitname;
-- Lfvarray.Current_Lfv := Value;
-- Lfvarray.Variablecount := 1;
-- Lfvarray.Max_Lfv := Value;
-- Lfvarray.Min_Lfv := Value;
-- Lfvarray.Average_Lfv := Value;
-- Add_High (Lfdarray, Lfvarray);
-- end Initarray;
--procedure initarray (fparray: in out fpvrecord;
-- fpdarray: in out fpvdarray_pkg.darray;
-- pid: in program_unit_unique_identifier;
-- vname: in filename;
-- unitname: in filename;
-- value: in fixed_point;
-- kunt: in natural) is
--
--
--begin
-- fparray.programid := pid;
-- fparray.variablename := vname;
-- fparray.unitname := unitname;
-- fparray.current_fpv := value;
-- fparray.variablecount := 1;
-- fparray.max_fpv := value;
-- fparray.min_fpv := value;
-- fparray.average_fpv := value;
-- add_high (fpdarray, fparray);
--end initarray;
procedure Find_Variable (Pid : in Program_Unit_Unique_Identifier;
Idarray : in out Ivdarray_Pkg.Darray;
Ivarray : in out Ivrecord;
Vname : in Filename;
Kunt : in Natural;
Idx : out Natural;
Found : out Boolean) is
begin
Found := False;
Idx := 0;
Search_Loop:
for I in Integer range 1 .. Kunt loop
Ivarray := Fetch (Idarray, I);
if (Ivarray.Programid.Program_Unit_Number =
Pid.Program_Unit_Number) and
Equal (Ivarray.Variablename, Vname) and
Equal (Ivarray.Programid.Enclosing_Unit_Identifier,
Pid.Enclosing_Unit_Identifier) then
Found := True;
Ivarray.Variablecount := Ivarray.Variablecount + 1;
Idx := I;
exit Search_Loop;
end if;
end loop Search_Loop;
end Find_Variable;
procedure Find_Variable (Pid : in Program_Unit_Unique_Identifier;
Lidarray : in out Livdarray_Pkg.Darray;
Livarray : in out Livrecord;
Vname : in Filename;
Kunt : in Natural;
Idx : out Natural;
Found : out Boolean) is
begin
Found := False;
Idx := 0;
Search_Loop:
for I in Integer range 1 .. Kunt loop
Livarray := Fetch (Lidarray, I);
if (Livarray.Programid.Program_Unit_Number =
Pid.Program_Unit_Number) and
Equal (Livarray.Variablename, Vname) and
Equal (Livarray.Programid.Enclosing_Unit_Identifier,
Pid.Enclosing_Unit_Identifier) then
Found := True;
Idx := I;
exit Search_Loop;
end if;
end loop Search_Loop;
end Find_Variable;
procedure Find_Variable (Pid : in Program_Unit_Unique_Identifier;
Fdarray : in out Fvdarray_Pkg.Darray;
Fvarray : in out Fvrecord;
Vname : in Filename;
Kunt : in Natural;
Idx : out Natural;
Found : out Boolean) is
begin
Found := False;
Idx := 0;
Search_Loop:
for I in Integer range 1 .. Kunt loop
Fvarray := Fetch (Fdarray, I);
if (Fvarray.Programid.Program_Unit_Number =
Pid.Program_Unit_Number) and
Equal (Fvarray.Variablename, Vname) and
Equal (Fvarray.Programid.Enclosing_Unit_Identifier,
Pid.Enclosing_Unit_Identifier) then
Found := True;
Fvarray.Variablecount := Fvarray.Variablecount + 1;
Idx := I;
exit Search_Loop;
end if;
end loop Search_Loop;
end Find_Variable;
-- procedure Find_Variable (Pid : in Program_Unit_Unique_Identifier;
-- Lfdarray : in out Lfvdarray_Pkg.Darray;
-- Lfvarray : in out Lfvrecord;
-- Vname : in Filename;
-- Kunt : in Natural;
-- Idx : out Natural;
-- Found : out Boolean) is
-- begin
-- Found := False;
-- Idx := 0;
-- Search_Loop:
-- for I in Integer range 1..Kunt loop
-- Lfvarray := Fetch (Lfdarray, I);
-- if (Lfvarray.Programid.Program_Unit_Number =
-- Pid.Program_Unit_Number) and
-- Equal (Lfvarray.Variablename, Vname) and
-- Equal (Lfvarray.Programid.
-- Enclosing_Unit_Identifier,
-- Pid.Enclosing_Unit_Identifier) then
-- Found := True;
-- Lfvarray.Variablecount := Lfvarray.Variablecount + 1;
-- Idx := I;
-- exit Search_Loop;
-- end if;
-- end loop Search_Loop;
-- end Find_Variable;
--procedure find_variable( --janus
-- pid: in program_unit_unique_identifier;
-- fpdarray: in out fpvdarray_pkg.darray;
-- fpvarray: in out fpvrecord;
-- vname: in filename;
-- kunt: in natural;
-- idx: out natural;
-- found: out boolean) is
--
--
--begin
--found := false;
--idx := 0;
--Search_loop:
-- for i in integer range 1..kunt loop
-- fpvarray := fetch ( fpdarray, i);
-- if (fpvarray.programid.program_unit_number = pid.program_unit_number) and
-- equal(fpvarray.variablename, vname) and
-- equal(fpvarray.programid.enclosing_unit_identifier,
-- pid.enclosing_unit_identifier) then
-- found := true;
-- fpvarray.variablecount := fpvarray.variablecount + 1;
-- idx := i;
-- exit search_loop;
-- end if;
-- end loop search_loop;
--end find_variable;
procedure Find_Maxmin (Ivarray : in out Ivrecord;
Idarray : in out Ivdarray_Pkg.Darray;
Idx : in Natural;
Value : in Integer) is
begin
if Ivarray.Min_V > Value then
Ivarray.Min_V := Value;
elsif Ivarray.Max_V < Value then
Ivarray.Max_V := Value;
end if;
-- update the variable array;
Store (Idarray, Idx, Ivarray);
end Find_Maxmin;
procedure Find_Maxmin (Livarray : in out Livrecord;
Lidarray : in out Livdarray_Pkg.Darray;
Idx : in Natural;
Value : in Long_Integer) is
begin
if Livarray.Min_Liv > Value then
Livarray.Min_Liv := Value;
elsif Livarray.Max_Liv < Value then
Livarray.Max_Liv := Value;
end if;
-- update the variable array;
Store (Lidarray, Idx, Livarray);
end Find_Maxmin;
procedure Find_Maxmin (Fvarray : in out Fvrecord;
Fdarray : in out Fvdarray_Pkg.Darray;
Idx : in Natural;
Value : in Float) is
begin
if Fvarray.Min_Fv > Value then
Fvarray.Min_Fv := Value;
elsif Fvarray.Max_Fv < Value then
Fvarray.Max_Fv := Value;
end if;
-- update the variable array;
Store (Fdarray, Idx, Fvarray);
end Find_Maxmin;
-- procedure Find_Maxmin (Lfvarray : in out Lfvrecord;
-- Lfdarray : in out Lfvdarray_Pkg.Darray;
-- Idx : in Natural;
-- Value : in Long_Float) is
-- begin
-- if Lfvarray.Min_Lfv > Value then
-- Lfvarray.Min_Lfv := Value;
-- elsif Lfvarray.Max_Lfv < Value then
-- Lfvarray.Max_Lfv := Value;
-- end if;
-- update the variable array;
-- Store (Lfdarray, Idx, Lfvarray);
-- end Find_Maxmin;
--procedure find_maxmin(
-- fpvarray: in out fpvrecord;
-- fpdarray: in out fpvdarray_pkg.darray;
-- idx: in natural;
-- value: in fixed_point) is
--begin
-- if fparray.min_fpv > value then
-- fparray.min_fpv := value;
-- elsif
-- fparray.max_fpv < value then
-- fparray.max_fpv := value;
-- end if;
-- update the variable array;
--store (fpdarray, idx, fpvarray);
--end find_maxmin;
function Last_Value ( --| Return the last value of the string variable
Unit_Id : Program_Unit_Unique_Identifier;
Variable_Name : Ada_Name;
Current_Value : String_Variables) return String is
--| Effects
--| Searches the String_Variable_Array for the last value of
--| the specified string variable. If it is the first occurrence
--| of the string variable then it is added to the array and
--| a null String_Type is returned. Otherwise the last value
--| stored in the array for the string variable is returned.
--| If the current value of the string variable is different
--| than the previous value then the array is updated with the
--| new current value.
--| Modifies
--| If it is the first occurrence of the string value of the string
--| variable of if the current value is different than the previous
--| value then the String_Array is updated
--| N/A: Raises, Requires, Errors
use String_Variable_Array_Pkg;
Last_Value : String_Type;
Next_Variable : String_Variable_Array_Elements;
begin
if First_String_Variable then
--| If this is the first string variable the the string
--| variable array must be created.
Create (1, 20, 100, 20, String_Variable_Array);
First_String_Variable := False;
end if;
for I in 1 .. Length (String_Variable_Array) loop
Next_Variable := Fetch (String_Variable_Array, I);
if Equal (Unit_Id.Enclosing_Unit_Identifier,
Next_Variable.Unit_Id.Enclosing_Unit_Identifier) and
Unit_Id.Program_Unit_Number =
Next_Variable.Unit_Id.Program_Unit_Number and
Equal (Variable_Name, Next_Variable.Variable_Name) then
--| The variable is already in the array.
--| If current value = old value then return old value
if Equal (Current_Value, Next_Variable.Value) then
return Value (Next_Variable.Value);
else
--| The values are different. Save the current value in the
--| array and return the previous value
String_Pkg.Flush (Last_Value);
Last_Value := Make_Persistent (Next_Variable.Value);
String_Pkg.Flush (Next_Variable.Value);
Next_Variable.Value := Make_Persistent (Current_Value);
Store (String_Variable_Array, I, Next_Variable);
return Value (Last_Value);
end if;
end if;
end loop;
--| The variable is not in the array. Add it.
Add_High (String_Variable_Array,
(Unit_Id, Make_Persistent (Variable_Name),
Make_Persistent (Current_Value)));
return "";
end Last_Value;
------------------
function Set_Length (--| Set the length of STR to WIDTH
Str : in String; --| The Integer to be converted
Width : in Natural :=
0 --| The width of the string to be returned
) return String is
--| Effects
--| STR contains non blank characters, right justified, and
--| padded on the left with blanks. SET_LENGTH
--| sets the length of STR equal to WIDTH. If Width = 0
--| then the length of the string is equal to the number of
--| non blank characters that are right justified in STR.
--| If Width is greater than the number of non blank characters
--| in STR then the STR( STR'LAST - Width + 1 .. STR'LAST
--| is returned.
package Int_Io is new Text_Io.Integer_Io (Integer);
Index : Natural;
begin
if Width > Str'Last then
Index := Str'First;
elsif Width = 0 then
for I in reverse Str'Range loop
exit when Str (I) = ' ';
Index := I;
end loop;
else
Index := Str'Last - Width + 1;
end if;
return Str (Index .. Str'Last);
end Set_Length;
function Long_Integer_To_Str
(Lint : Long_Integer; Width : Natural := 0) return String is
Str : String (1 .. 30);
begin
Lint_Io.Put (Str, Lint);
return Set_Length (Str, Width);
end Long_Integer_To_Str;
function Float_To_Str (Flo : Float; Width : Natural := 0) return String is
Str : String (1 .. 30);
begin
Flo_Io.Put (Str, Flo, 13, 4);
return Set_Length (Str, Width);
end Float_To_Str;
-- function Long_Float_To_Str (
-- Lflo : Long_Float;
-- Width : Natural := 0
-- ) return String is
-- Str : String (1..30);
-- begin
-- Lflo_Io.Put (Str, Lflo, 13, 4);
-- return Set_Length (Str, Width);
-- end Long_Float_To_Str;
end Varhand;