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;