with Text_Io; use Text_Io; package body String_Pack is No_Way_In_Hell : exception; Digs : constant String := Numeric & Upper_Case; ----------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : The following function will strip leading or -- trailing BLANKS from the given string. -- Major Memory Usage : N/A -- Entry and Exit Parameters : See formal paramters -- Subroutine Called: Nada (internal) -- ************************************************************************ function Strip (From : String; What : Strip_What := All_Blanks) return String is My_String : String (1 .. Length (From) + 1) := (others => ' '); Start : Integer := From'First; Stop : Integer := From'Last; Pos : Integer := 0; begin if Nada (From) then -- Do nothing if the source string is empty null; else case What is -- Find the starting and ending positions for stripping -- the blanks when All_Blanks | All_But_One => for I in From'Range loop if From (I) /= ' ' then Start := I; exit; end if; end loop; for I in reverse From'Range loop if From (I) /= ' ' then Stop := I; exit; end if; end loop; when Leading => for I in From'Range loop if From (I) /= ' ' then Start := I; exit; end if; end loop; when Trailing => for I in reverse From'Range loop if From (I) /= ' ' then Stop := I; exit; end if; end loop; end case; -- Strip out the blanks for I in Start .. Stop loop Pos := Pos + 1; My_String (Pos) := From (I); end loop; end if; if What = All_But_One then Pos := Pos + 1; end if; return My_String (1 .. Pos); end Strip; -- ************************************************************************ -- Functional Description : This function returns a null string .. that -- is a variable length string of length 0. -- Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Null_Vstring return Vstring is Temp : Vstring (1); begin -- Sets the length of the string to zero Temp.Length := 0; return Temp; end Null_Vstring; ----------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : Returns the largest of two integers. -- Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Max (I1, I2 : Integer) return Integer is begin if I1 >= I2 then return I1; else return I2; end if; end Max; ----------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : Returns the smallest of tow integers. -- Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Min (I1, I2 : Integer) return Integer is begin if I1 <= I2 then return I1; else return I2; end if; end Min; ----------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : This function returns the minimum of two -- numbers. However, if the minimum value is -- less than or equal to zero, then the larger -- of the two is returned. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Non_Zero_Min (I1, I2 : Integer) return Integer is Temp : Integer; begin -- Returns the smallest of the two integers Temp := Min (I1, I2); if Temp > 0 then return Temp; else return Max (I1, I2); end if; end Non_Zero_Min; ----------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : Computes the length of the source string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Length (Input : String) return Integer is begin return Input'Last - Input'First + 1; end Length; ---------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : Returns the actual length of the variable -- length string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Length (Input : Vstring) return Integer is begin return Input.Length; end Length; ---------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : Returns the length of the source string base -- on its definition. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Length (internal) -- ************************************************************************ function Max_Length (Input : Vstring) return Integer is begin return Length (Input.Bod); end Max_Length; ---------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : This procedure will get (from the terminal) -- a variable_length string. If the string -- input on the terminal is greater than the -- declared length of the parameter "line" then -- the excess input is left in the system input -- buffer and may cause probems in subsequent -- "gets". -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Text_Io.Get_Line -- Move (internal) -- ************************************************************************ procedure Get (Line : in out Vstring) is Buf : String (1 .. Max_Length (Line)) := (others => ' '); Len : Integer; begin Get_Line (Buf, Len); Line.Length := Len; Move (Buf, Line.Bod); end Get; -- ************************************************************************ -- Functional Description : This procedure puts variable length -- strings out to the screen. Only the valid -- part of the variable lengthed string is -- displayed. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Text_Io.Put -- ************************************************************************ procedure Put (Word : in Vstring) is begin if Word.Length /= 0 then Text_Io.Put (Fix (Word)); end if; end Put; -- ************************************************************************ -- Functional Description : Outputs a blank line. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Text_Io.Put_Line -- ************************************************************************ procedure New_Line is begin Put_Line (""); end New_Line; -- ************************************************************************ -- Functional Description : The procedure will fill the variable_lengthed -- string parameter 'X' with whaterver is defined -- as Fill_Char (the default is " ". The declared -- maximum length of the variable string is used -- to determine the amount to fill. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Length (internal) -- Fill (internal) -- ************************************************************************ procedure Fill (X : in out Vstring; Fill_Char : Character := ' ') is begin X.Length := Length (X.Bod); Fill (X.Bod, Fill_Char); end Fill; -- ************************************************************************ -- Functional Description : The procedure will fill a string from x'first -- to x'last with the fill character..default is -- the ' '. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ procedure Fill (X : in out String; Fill_Char : Character := ' ') is begin for I in X'Range loop X(I) := Fill_Char; end loop; end Fill; -- ************************************************************************ -- Functional Description : Outputs to the terminal the contents of the -- Vstring record structure. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Text_Io.Put_Line -- ************************************************************************ procedure Dump (Input : Vstring) is begin Put_Line ("vstring_length--" & Integer'Image (Input.Length)); Put_Line ("fixed_length--" & Integer'Image (Length (Input.Bod))); Put_Line ("bod--|" & Input.Bod & "|"); end Dump; -- ************************************************************************ -- Functional Description : Checks for an empty string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Constr (internal) -- ************************************************************************ function Nada (X : String) return Boolean is begin -- Compares the source string with the character blank if Comstr (X, " ") = Equal then return True; else return False; end if; end Nada; -- ************************************************************************ -- Functional Description : Checks for an empty string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Fix (internal) -- Nada (internal) -- ************************************************************************ function Nada (X : Vstring) return Boolean is begin -- Converts the source string to a regular string before calling Nada return Nada (Fix (X)); end Nada; -- ************************************************************************ -- Functional Description : Checking the validity of taking a slice -- x(S)..x(L) from source string x. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Min (internal) -- ************************************************************************ procedure Trim_Args (X : String; S : in out Integer; L : in out Integer) is begin if X = "" then L := 0; return; end if; -- If the starting indice for the slice is not within the range of the -- string's upper bound, then raise an exception if S not in X'Range or L < 0 then raise No_Way_In_Hell; end if; -- (X'Last - S) is the largest posible slice for string x. If it is -- smaller than the request slice size, then reset the slice length. L := Min (L, X'Last - S + 1); end Trim_Args; -- ************************************************************************ -- Functional Description : The following procedure will take a string -- slice out of 'source' starting at position -- 'source_start' and of length 'source_length' -- and place that slice in the string 'target' -- in the slice starting at position 'target_start' -- and of length 'target_length'. If the slice -- is larger than the allotted space in the -- target string, then the slice is chopped off -- on the right end. If the slice is smaller than -- the allotted space, then it is blank padded on -- the right end to match the length of the space. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Trim_Args (internal) -- Substr (internal) -- ************************************************************************ procedure Substr (Source : String; Source_Start, Source_Length : Integer; Target : in out String; Target_Start, Target_Length : Integer) is Ss : Integer := Source_Start; Ts : Integer := Target_Start; Sl : Integer := Source_Length; Tl : Integer := Target_Length; begin if Source = "" or Sl = 0 then Substr (" ", 1, 1, Target, Target_Start, Target_Length); else -- Check the validity of the slice indices. If The requested slice -- is too large for the Source, then Trim_Args resets it. Trim_Args (Source, Ss, Sl); Trim_Args (Target, Ts, Tl); if Tl = 0 then return; end if; -- Moves the slice into the target string. If the source slice is -- less than the target slice, then fill the remaining portion of -- the target slice with blanks. for I in 0 .. Tl - 1 loop if I >= Sl then Target ((Ts + I)) := ' '; else Target (Integer (Ts + I)) := Source ((Ss + I)); end if; end loop; end if; exception when No_Way_In_Hell => Put_Line ("BLOW_IN_SUBSTR"); Put_Line ("source'first " & Integer'Image (Source'First)); Put_Line ("source'last " & Integer'Image (Source'Last)); Put_Line ("SS" & Integer'Image (Source_Start)); Put_Line ("SL" & Integer'Image (Source_Length)); Put_Line ("target'first " & Integer'Image (Target'First)); Put_Line ("target'last " & Integer'Image (Target'Last)); Put_Line ("TS" & Integer'Image (Target_Start)); Put_Line ("TL" & Integer'Image (Target_Length)); -- Interrupt.Signal (Interrupt.String_Pack, "BLOW IN SUBSTR"); end Substr; -- ************************************************************************ -- Functional Description : -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Substr (internal) -- Trim_Args (internal) -- ************************************************************************ procedure Substr_Reverse (Source : String; Source_Start, Source_Length : Integer; Target : in out String; Target_Start, Target_Length : Integer) is Ss : Integer := Source_Start; Ts : Integer := Target_Start; Sl : Integer := Source_Length; Tl : Integer := Target_Length; begin if Source = "" or Sl = 0 then Substr (" ", 1, 1, Target, Target_Start, Target_Length); else -- Check the validity of the slice indices. If The requested slice -- is too large for the Source, then Trim_Args resets it. Trim_Args (Source, Ss, Sl); Trim_Args (Target, Ts, Tl); if Tl = 0 then return; end if; -- Resets the starting index to begin at the end of the slice Ss := Ss + Sl - 1; Ts := Ts + Tl - 1; -- Moves the slice into the target string. If the source slice is -- less than the target slice, then fill the beginning of the -- the target slice with blanks. for I in 0 .. Tl - 1 loop if I >= Sl then Target ((Ts - I)) := ' '; else Target (Integer (Ts - I)) := Source ((Ss - I)); end if; end loop; end if; exception when others => Put_Line ("BLOW_IN_SUBSTR_REVERSE"); Put_Line ("source'first " & Integer'Image (Source'First)); Put_Line ("source'last " & Integer'Image (Source'Last)); Put_Line ("SS" & Integer'Image (Source_Start)); Put_Line ("SL" & Integer'Image (Source_Length)); Put_Line ("target'first " & Integer'Image (Target'First)); Put_Line ("target'last " & Integer'Image (Target'Last)); Put_Line ("TS" & Integer'Image (Target_Start)); Put_Line ("TL" & Integer'Image (Target_Length)); end Substr_Reverse; -- ************************************************************************ -- Functional Description : Returns a slice from the source string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Substr (internal) -- ************************************************************************ function Substr (Source : String; Source_Start, Source_Length : Integer) return String is Temp : String (1 .. Source_Length); begin Substr (Source, Source_Start, Source_Length, Temp, 1, Source_Length); return Temp; end Substr; -- ************************************************************************ -- Functional Description : Returns everything from source start to the -- end of the string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Subsrt (internal) -- ************************************************************************ function Substr (Source : String; -- the missing length means "the rest of it" Source_Start : Integer) return String is Length : Integer := Source'Last - Source_Start + 1; begin return Substr (Source, Source_Start, Length); end Substr; -- ************************************************************************ -- Functional Description : The following functions will return a -- vstring slice from 'source' starting at -- position source_start and which is -- source_length long. If the source_length -- parameter is left off, then the slice -- returned is the 'rest of the string' starting -- at position source_start. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Min (internal) -- Substr (internal) -- ************************************************************************ function Substr (Source : Vstring; Source_Start, Source_Length : Integer) return Vstring is Xlen : Integer := Min (Source_Length, Source.Length - Source_Start + 1); begin -- Checks the starting indiceto be sure that it is within the range of -- the source string upper bound if Source_Start not in 1 .. Source.Length then return Null_Vstring; end if; if Xlen <= 0 then return Null_Vstring; end if; declare Temp : Vstring (Xlen); begin -- Puts the slice into Temp.Bod Temp.Bod := Substr (Source.Bod, Source_Start, Xlen); Temp.Length := Xlen; return Temp; end; end Substr; -- ************************************************************************ -- Functional Description : Returns the slice from the starting indice to -- end of the string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Substr (internal) -- ************************************************************************ function Substr (Source : Vstring; -- the missing length means "the rest of it" Source_Start : Integer) return Vstring is begin return Substr (Source, Source_Start, Source.Length - Source_Start + 1); end Substr; -- ************************************************************************ -- Functional Description : Move the source string into the target string. -- The move terminates when it encounters the end -- of the source string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ procedure Maybe_Move (Source : in String; Target : in out String) is Tp : Integer := Target'First; begin -- Blank out the targer string for I in Target'Range loop Target(I) := ' '; end loop; -- Loop until the end of the source string is encountered for I in Source'Range loop exit when Tp not in Target'Range; Target (Tp) := Source (I); Tp := Tp + 1; end loop; end Maybe_Move; -- ************************************************************************ -- Functional Description : The move procedures are like assigns, except -- that truncation or blank fill will be done in -- the case of unequal lengths. Let alignment is -- assumed. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ procedure Move (Source : in String; Target : in out String) is Source_Length : Integer := Source'Length; Target_Length : Integer := Target'Length; begin -- If the strings are equal, do a simple store assignment. if Source_Length = Target_Length then Target := Source; return; end if; -- If the source string is longer than the target string, then trunicate -- the source string during the move. if Source_Length > Target_Length then Target := Source (Source'First .. Source'First + Target_Length - 1); return; end if; -- If the target is longer than the source string, then pad the target -- string with blanks. Target (Target'First .. Target'First + Source_Length - 1) := Source; for I in Target'First + Source_Length .. Target'Last loop Target (I) := ' '; end loop; return; end Move; -- ************************************************************************ -- Functional Description : Move the source variable length string into -- the taraget varibale length string. The min -- length of the two strings is stored into the -- target string and the target string is never -- padded with blanks, but it may be trunicated. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ procedure Move (Source : in Vstring; Target : in out Vstring) is begin -- Determine the minimun lenght of the two strings Target.Length := Min (Source.Length, Max_Length (Target)); Target.Bod (1 .. Target.Length) := Source.Bod (1 .. Target.Length); end Move; -- ************************************************************************ -- Functional Description : The move procedures are like assigns, except -- that truncation or blank fill will be done in -- the case of unequal lengths. Move_Reverse -- provides right alignment. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Substr_Reverse (internal) -- Comstr (internal) -- Substr (internal) -- ************************************************************************ procedure Move_Reverse (Source : in String; Target : in out String) is Source_Length : Integer := Length (Source); Target_Length : Integer := Length (Target); begin Substr_Reverse (Source, Source'First, Source_Length, Target, Target'First, Target_Length); if Source_Length > Target_Length then if Comstr (Substr (Source, Source'First, Source_Length - Target_Length), " ") /= Equal then null; end if; end if; end Move_Reverse; -- ************************************************************************ -- Functional Description : Converts a regular string into a variable -- length string with its length the same as -- the input strings's length. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Var (Input : String) return Vstring is Len : Integer := Length (Input); Temp : Vstring (Len); begin -- Sets the vstring length to the source string length Temp.Length := Len; Temp.Bod := Input; return Temp; end Var; -- ************************************************************************ -- Functional Description : Converts a variable length string to a regular -- string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Fix (Input : Vstring) return String is begin return Input.Bod (1 .. Input.Length); end Fix; -- ************************************************************************ -- Functional Description : Changes an upper case character to lower case -- and visa versa. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Change_Case (Achar : in String) return String is Thechar : String (1 .. 1) := " "; begin if Achar (1) in 'a' .. 'z' then -- The character is lower case, change it to upper case. Thechar (1) := Character'Val (Character'Pos (Achar (1)) - 32); elsif Achar (1) in 'A' .. 'Z' then -- The character is upper case, change it to lower case. Thechar (1) := Character'Val (Character'Pos (Achar (1)) + 32); else -- It is not a character, so return it as is Thechar (1) := Achar (1); end if; return Thechar; end Change_Case; -- ************************************************************************ -- Functional Description : The function will compare two strings. -- Independent of the length each of them is -- declared, the function returns an enumeration -- type of 'equal' ('less_than' or 'greater_than' -- when applicable) if the 'meaningful' portions -- of the two strings are equal, thereby ignoring -- trailing blanks of either string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Trim_Agrs (internal) -- Change_Case (internal) -- ************************************************************************ function Comstr (Source : String; Source_Start, Source_Length : Integer; Target : String; Target_Start, Target_Length : Integer) return Compare is Max : Integer; Blank : Character := ' '; Schar, Tchar : Character; Ss : Integer := Source_Start; Ts : Integer := Target_Start; Sl : Integer := Source_Length; Tl : Integer := Target_Length; Temp : String (1 .. 1) := " "; begin -- Check the validity of the slice indices. If The requested slice -- is too large for the Source, then Trim_Args resets it. Trim_Args (Source, Ss, Sl); Trim_Args (Target, Ts, Tl); -- Sets the length to the maximun string length of the two strings if Sl > Tl then Max := Sl; else Max := Tl; end if; if Max = 0 then return Equal; end if; -- Loop over the maximum string length for I in 0 .. Max - 1 loop if I >= Sl then -- Beyond the length of the source string Schar := Blank; else -- Get source character Schar := Source (Ss + I); end if; if I >= Tl then -- Beyond the length of the targer string Tchar := Blank; else -- Get target character Tchar := Target (Ts + I); end if; -- Stores the target character Temp (1) := Tchar; -- The test is not case senitive. If source < target, then -- it may not be of the same case. So change the case and then -- check for equality. Do the same for the less than check. if Schar < Tchar and then Schar /= Change_Case (Temp) (1) then return Less_Than; end if; if Schar > Tchar and then Schar /= Change_Case (Temp) (1) then return Greater_Than; end if; end loop; -- All comparisons were equal return Equal; exception when No_Way_In_Hell => Put_Line ("BLOW_IN_COMSTR"); Put_Line ("source'first " & Integer'Image (Source'First)); Put_Line ("source'last " & Integer'Image (Source'Last)); Put_Line ("SS" & Integer'Image (Source_Start)); Put_Line ("SL" & Integer'Image (Source_Length)); Put_Line ("target'first " & Integer'Image (Target'First)); Put_Line ("target'last " & Integer'Image (Target'Last)); Put_Line ("TS" & Integer'Image (Target_Start)); Put_Line ("TL" & Integer'Image (Target_Length)); -- Interrupt.Signal (Interrupt.String_Pack, "BLOW IN COMSTR"); end Comstr; -- ************************************************************************ -- Functional Description : The function will compare two strings. -- Independent of the length each of them is -- declared, the function returns an enumeration -- type of 'equal' ('less_than' or 'greater_than' -- when applicable) if the 'meaningful' portions -- of the two strings are equal, thereby ignoring -- trailing blanks of either string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function Comstr (Source, Target : String; Case_Sensitive : Boolean := True; Wild_Card : Character := Ascii.Nul) return Compare is Sc, Tc : Character; Count : Integer := Max (Length (Source), Length (Target)); Spos : Integer := Source'First; Tpos : Integer := Target'First; Wc : Character := Wild_Card; Pad : Character := ' '; procedure Upshift (X : in out Character) is begin if X in 'a' .. 'z' then X := Character'Val (Character'Pos (X) - 32); end if; end Upshift; begin -- This may be useful for BASIC type compares. -- if not Pad_Shorter then -- Pad := Ascii.Soh; -- end if; -- If not case sensitive, then upper case the wild card character. if not Case_Sensitive then Upshift (Wc); end if; -- Loop over the maximun lenth of the two strings for I in 1 .. Count loop if Spos <= Source'Last then Sc := Source (Spos); -- If not case sensitive, then upper case the source character. if not Case_Sensitive then Upshift (Sc); end if; else -- Beyond the length of the source string Sc := Pad; end if; if Tpos <= Target'Last then Tc := Target (Tpos); -- If not case sensitive, then upper case the target character. if not Case_Sensitive then Upshift (Tc); end if; else -- Beyond the length of the target string Tc := Pad; end if; -- If the wild card character is not the ascii null character, then -- check for equality among the source character and wild card, -- source character and target character and target character and -- wild card. if Wc /= Ascii.Nul and then (Sc = Wc or Tc = Wc or Sc = Tc) then null; elsif Sc = Tc then -- The source and target are equal; therefore, continue on. null; else if Sc < Tc then return Less_Than; else return Greater_Than; end if; end if; -- Advances the indices Spos := Spos + 1; Tpos := Tpos + 1; end loop; return Equal; end Comstr; -- ************************************************************************ -- Functional Description : The following function will search the -- source string for the first instance of the -- pattern and return its position in the -- source string. If it is not found, then 0 -- is returned. Also if either the source or -- pattern's length is not > 0 then 0 is returned. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Comstr (internal) -- ************************************************************************ function Indx (Source : String; Source_Start, Source_Length : Integer; Pattern : String; Pattern_Start, Pattern_Length : Integer) return Integer is K : Integer; begin if Pattern_Length <= 0 or Source_Length <= 0 then return 0; end if; if Pattern_Length > Source_Length then return 0; end if; -- The last position of the source string to be sent to the -- compare routine. If the pattern is of length 4, then the -- last four charaters of the source string will be tested on -- the (k - source_start + 1) time. K := Source_Length + Source_Start - Pattern_Length; if K < Source_Start then return 0; end if; for L in Source_Start .. K loop if Comstr (Source, L, Pattern_Length, Pattern, Pattern_Start, Pattern_Length) = Equal then -- Returns the starting position of the pattern in the source -- string. return (L); end if; end loop; -- Pattern was not found. return 0; exception when others => null; end Indx; -- ************************************************************************ -- Functional Description : Looks for the pattern in the source string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Indx (internal) -- ************************************************************************ function Indx (Source : String; Pattern : String) return Integer is begin return Indx (Source, Source'First, Length (Source), Pattern, Pattern'First, Length (Pattern)); end Indx; -- ************************************************************************ -- Functional Description : The following function searchs the -- source string (from left to right) looking -- for a character that is NOT present in the -- set of valid characters. If an invalid -- character is found in the source string, -- then its position in the source string is -- returned. If all the characters in the -- source ARE valid then a 0 is returned. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function Verify (Source : String; Source_Start, Source_Length : Integer; Valid_Characters : String; Valid_Character_Start, Valid_Character_Length : Integer) return Integer is begin -- Loop for the size of the source slice for M in Source_Start .. Source_Start + Source_Length - 1 loop -- If indx = 0, then some character that in not in the set of -- characters was found. if Indx (Valid_Characters, Valid_Character_Start, Valid_Character_Length, Source, M, 1) = 0 then -- Returns the position of the unmatched character return (M - (Source'First - 1)); end if; end loop; return 0; exception when others => null; end Verify; -- ************************************************************************ -- Functional Description : Returns the position within the source string -- of the character not in the Valid character set. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Verify (internal) -- ************************************************************************ function Verify (Source : String; Valid_Characters : String) return Integer is begin return Verify (Source, Source'First, Length (Source), Valid_Characters, Valid_Characters'First, Length (Valid_Characters)); end Verify; -- ************************************************************************ -- Functional Description : The following function examines characters -- from the source string one at a time (from -- left to right) and scans a character set for -- an occurence of the character. If found, its -- position in the set is returned. If it is not -- found, the scan continues until the end of the -- source string is reached (in this case a 0 is -- returned) or a character from source is found -- in the target set. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function Anything (Source : String; Character_Set : String) return Integer is Temp : String (1 .. 1); begin for I in Source'Range loop Temp (1) := Source (I); -- Returns the position of the first character that matched a -- charaters in the character set. if Indx (Character_Set, Temp) /= 0 then return I; end if; end loop; -- No character matched return 0; end Anything; -- ************************************************************************ -- Functional Description : The function will compare two vstrings. -- Independent of the length each of them is -- declared, the function returns an enumeration -- type of 'equal' ('less_than' or 'greater_than' -- when applicable) if the 'meaningful' portions -- of the two strings are equal, thereby ignoring -- trailing blanks of either string. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Comstr (internal) -- ************************************************************************ function Comstr (Source, Target : Vstring; Case_Sensitive : Boolean := True; Wild_Card : Character := Ascii.Nul) return Compare is begin -- Returns an enumerated value of type compare: -- Equal => source and target match character for character -- Less_Than => source string was alphabetically less than the target -- Greter_Than => source string was alpaabetically greater than the -- target return Comstr (Source.Bod (1 .. Source.Length), Target.Bod (1 .. Target.Length), Case_Sensitive, Wild_Card); end Comstr; -- ************************************************************************ -- Functional Description : The following function will search the source -- vstring for the first instance of the target -- vstring and return its position in the source. -- If it is not found, then 0 is returned. Also -- if either the source or target's length is -- not > 0 then 0 is returned. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Indx (internal) -- ************************************************************************ function Indx (Source : Vstring; Target : Vstring) return Integer is begin -- Returns the position of the founded pattern (i.e. target) return Indx (Source.Bod, 1, Source.Length, Target.Bod, 1, Target.Length); end Indx; -- ************************************************************************ -- Functional Description : The following function will search the -- source vstring (from left to right) looking -- for a character that is NOT present in the -- target vstring. If a character is NOT found -- in the target string then its position in the -- source string is returned. If all the -- characters in the source ARE found in the -- target then a 0 is returned. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Verify (internal) -- ************************************************************************ function Verify (Source : Vstring; Target : Vstring) return Integer is begin -- Returns the position of the first character found in the source -- vstring that is not in the character set. return Verify (Source.Bod, 1, Source.Length, Target.Bod, 1, Target.Length); end Verify; -- ************************************************************************ -- Functional Description : The following function examines characters -- from the source vstring one at a time (from -- left to right) and scans a character set for -- an occurence of the character. If found, its -- position in the character set is returned. -- If it is not found, the scan continues until -- the end of the source vstring is reached (in -- this case a 0 is returned) or a character from -- source is found in target. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Anything (internal) -- ************************************************************************ function Anything (Source : Vstring; Character_Set : Vstring) return Integer is begin -- Returns the position of the first character found in the source -- vstring that matches a character in the character set. -- Converts the source vstring and Character_Set into a regular strings -- before calling the routine. return Anything (Fix (Source), Fix (Character_Set)); end Anything; -- ************************************************************************ -- Functional Description : The following function will return the last -- character of a given vstring that is not equal -- to the character 'ignore'. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Last_Character (Source : Vstring; Ignore : Character := ' ') return Integer is begin -- Loops over the length of the source string for I in reverse 1 .. Source.Length loop if Source.Bod (I) /= Ignore then -- Returns the position of the last character in the srouce string -- that is not in the pattern. return I; end if; end loop; return 0; end Last_Character; -- ************************************************************************ -- Functional Description : The following function will return the first -- character of a given vstring that is not equal -- to the character 'ignore'. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Verify -- ************************************************************************ function First_Character (Source : Vstring; Ignore : Character := ' ') return Integer is Temp : Vstring (1); begin Temp.Bod (1) := Ignore; Temp.Length := 1; -- Returns the position of the first character within the vstring -- that is not in the pattern. return Verify (Source, Temp); end First_Character; -- ************************************************************************ -- Functional Description : Retuns an ascii null. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Spring return String is Temp : String (1 .. 1); begin Temp (1) := Ascii.Nul; return Temp; end Spring; -- ************************************************************************ -- Functional Description : The following function will 'stretch' a -- vstring out to some length 'target_length' by -- inserting blanks within the vstring. The -- position to insert these blanks into is -- determined by the string defined in the -- parameter stretch_after. The vstring is -- scanned from left to right searching for -- 'stretch_after'. If the string is found, -- then the blanks are inserted after the string. -- If the string is not found, then the blanks -- are added at the end of the vstring. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Move (internal) -- Length (internal) -- Indx (internal) -- Fix (internal) -- Fill (internal) -- Substr (internal) -- ************************************************************************ function Stretch (Source : Vstring; Target_Length : Integer; Stretch_After : String) return Vstring is Temp : Vstring (Target_Length); Break_Pos : Integer; begin if Length (Source) >= Target_Length then -- Moves the source string into a target buffer with trunication -- if the string are of equal length. Move (Source, Temp); return Temp; end if; -- Looks for the pattern Break_Pos := Indx (Fix (Source), Stretch_After); if Break_Pos = 0 then -- Did not find the pattern Move (Source, Temp); Temp.Length := Target_Length; return Temp; else declare Filler : String (1 .. Target_Length - Length (Source)); begin Break_Pos := Break_Pos + Length (Stretch_After) - 1; Fill (Filler); -- Pattern was found, now insert blank(s) after the pattern Move (Substr (Source, 1, Break_Pos) & Filler & Substr (Source, Break_Pos + 1), Temp); return Temp; end; end if; end Stretch; -- ************************************************************************ -- Functional Description : The following procedure will scan a vstring -- 'Source' searching for a vstring 'find'. If -- the vstring 'find' is found, then it is -- removed and the vstring replace is put in its -- place. This continues until the source string -- has been completely scanned for the 'find' -- string (ie all occurrences of 'find' are -- replaced). The vstring returned size will -- reflect the new size of the vstring after all -- replacements have been found. If 'find' is -- never found then the vstring is returned unchanged. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Move (internal) -- ************************************************************************ procedure Replace (Source : in out Vstring; Find, Replace : Vstring) is Cur_Pos : Integer := 1; Break_Pos : Integer; begin -- Replace all occurrences loop -- Finds the position of the pattern Break_Pos := Indx (Substr (Source, Cur_Pos), Find); -- All occurrences exhausted, exit. exit when Break_Pos = 0; -- Replace the found pattern with the new pattern Move (Substr (Source, 1, Break_Pos + Cur_Pos - 2) & Replace & Substr (Source, Break_Pos + Cur_Pos - 1 + Length (Find)), Source); -- Increment the pointer and continue to search Cur_Pos := Cur_Pos + Break_Pos + Length (Replace); end loop; end Replace; -- ************************************************************************ -- Functional Description : The following functions will take as input -- a string and return the input -- string without any blanks. If blanks appear -- within single quotes within the string, however, -- they will be left alone. For example the string -- "The boy ran" as source will return the string -- "Theboyran". The string "The 'b y' ran" -- will return the string "Theb yran". -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Compress (Source : String; What : Strip_What := All_Blanks) return String is Mash : Boolean := True; Temp : String (1 .. Length (Source)) := (others => ' '); Pos : Integer := 1; Got_One : Boolean := False; begin -- Loops over the entire string for I in Source'Range loop if Mash then if Source (I) /= ' ' then -- Not a blank so stores the character Got_One := False; Temp (Pos) := Source (I); Pos := Pos + 1; else case What is when All_But_One => if Got_One then null; else Got_One := True; -- Stores one blank Temp (Pos) := ' '; Pos := Pos + 1; end if; when others => null; end case; end if; else Temp (Pos) := Source (I); Pos := Pos + 1; end if; -- If a single or double quote is found thne toggle the Mash -- switch. The first quote turns the Mash off and the -- second quote turns it back on. if Source (I) = ''' or Source (I) = '"' then Mash := not Mash; Got_One := False; end if; end loop; -- Returns the string with either all leading and trailing blanks -- removed or just leading or trailing blanks. return Strip (Temp, What); end Compress; -- ************************************************************************ -- Functional Description : The following functions will take as input -- a vstring and return the input -- string without any blanks. If blanks appear -- within single quotes within the string, however, -- they will be left alone. For example the string -- "The boy ran" as source will return the string -- "Theboyran". The string "The 'b y' ran" -- will return the string "Theb yran". -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Var (internal) -- Compress (internal) -- Fix (internal) -- ************************************************************************ function Compress (Source : Vstring; What : Strip_What := All_Blanks) return Vstring is begin -- Converts the source string into a regular string and compresses the -- blanks return Var (Compress (Fix (Source))); end Compress; -- ************************************************************************ -- Functional Description : The following procedures will take a source -- vstring, search left to right for any character -- in 'break string' and return in source what -- came after that character in the break string, -- and what came before the character in break -- string in target. If the break string is not -- found in source, then source is returned as a -- null string and target attains the value of -- source. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Length (internal) -- Comstr (internal) -- Move (internal) -- Substr (internal) -- Anything (internal) -- Var (internal) -- First_Character (internal) -- Split_String (recursive) -- ************************************************************************ procedure Split_String (Source : in out Vstring; Target : in out Vstring; Break_String : in String := " ") is Split_Loc : Integer; Quote : Integer := 0; Left, Temp : Vstring (Length (Source)); begin if Length (Source) = 0 then Target.Length := 0; return; end if; if Comstr (Source, Var (" ")) = Equal then Target.Length := 0; Source.Length := 0; return; end if; -- Looks for the position of the first blank in the string. If the -- first position is non-blank, the it moves the segment from -- the first blank to the end of the string into itself. Source -- contains the last half of the string. if First_Character (Source) /= 1 then Move (Substr (Source, First_Character (Source)), Source); end if; -- If last half begins with a quote, then fins the closing quote. if Substr (Source, 1, 1) = Var ("'") then Quote := Indx (Substr (Source, 2), Var ("'")) + 1; if Quote /= 1 then Move (Substr (Source, 2, Quote - 2), Temp); Move (Substr (Source, Quote + 1), Source); Split_String (Source, Left, Break_String); Move (Temp & Left, Target); return; end if; end if; Split_Loc := Anything (Source, Var (Break_String)); <> if Split_Loc = 0 then Move (Source, Target); Source.Length := 0; else Move (Substr (Source, 1, Split_Loc - 1), Target); Move (Substr (Source, Split_Loc + 1), Source); end if; end Split_String; -- ************************************************************************ -- Functional Description : The following functions will take a vstring -- as input, scan from left to right for a legal -- string representation of an integer -- (this includes '+' and '-' signs) and returns -- the integer equivalent. If an integer -- representation is not present in the string, -- then 0 is returned. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function Inparm (Line : Vstring; Start, Length : Integer) return Integer is Temp : Vstring (Length); I : Integer; Ok : Boolean; begin if Length = 0 then return 0; end if; Move (Substr (Line, Start, Length), Temp); if First_Character (Temp) /= 1 then -- BLB Move (Substr (Temp, First_Character (Temp)), Temp); end if; I := Verify (Fix (Temp), Numeric); if I = 0 then String_To_Number (Strip (Temp.Bod), I, Ok, 10); return I; end if; if I = 1 then if Verify (Substr (Temp, 1, 1), Var ("+-")) /= 0 then I := 0; return I; end if; end if; Substr (" ", 1, 1, Temp.Bod, I, Length - I + 1); if Temp = Var (" ") then return 0; else String_To_Number (Strip (Temp.Bod), I, Ok, 10); return I; end if; end Inparm; -- ************************************************************************ -- Functional Description : Scans the vstring for a number and returns it -- as an integer. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function Inparm (Line : Vstring) return Integer is begin if Line = Var (" ") then return 0; else return Inparm (Line, 1, Length (Line)); end if; end Inparm; -- ************************************************************************ -- Functional Description : Changes a number to string representation. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function Jla_Number_To_String (Value : Integer; Base : Natural := 10; Width : Natural := 0; Leading : Character := ' ') return String is Temp : Vstring (129); Sign : Vstring (1); Val : Integer := Value; Pos, Residue : Integer := 0; begin if Base < 2 or Base > Length (Digs) then return "??"; end if; if Val = 0 then Move (Var ("0"), Temp); else if Val < 0 then Move (Var ("-"), Sign); Val := -Val; end if; loop exit when Val = 0; Residue := Val mod Base; Move (Substr (Digs, Residue + 1, 1) & Temp, Temp); Val := (Val - Residue) / Base; end loop; end if; Move (Sign & Temp, Temp); if Length (Temp) >= Width then return Fix (Temp); end if; declare Pad : String (1 .. Width - Length (Temp)) := (others => Leading); begin return Pad & Fix (Temp); end; end Jla_Number_To_String; ----------------------------------------------------------------------------- -- ************************************************************************ -- Functional Description : Changes a number to string representation. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ procedure Jla_String_To_Number (Source : String; Target : out Integer; Worked : out Boolean; Base : Natural := 10) is Val, I : Integer := 0; Temp : String (1 .. Length (Source) + 1) := (others => ' '); Sign : Integer := 1; Pos : Integer := 1; begin Target := 0; Worked := True; if Base < 2 or Base > Length (Digs) then Worked := False; return; end if; if Nada (Source) then return; end if; Move (Strip (Source), Temp); if Temp (1) = '-' then Sign := -1; Pos := Pos + 1; end if; if Temp (1) = '+' then Pos := Pos + 1; end if; loop exit when Temp (Pos) = ' '; I := Indx (Substr (Digs, 1, Base), Substr (Temp, Pos, 1)); -- ANY NON VALID CHARACTER WILL STOP THE SCAN, -- BUT LEAVE THE CURRENT VALUE IN TARGET. Pos := Pos + 1; if I = 0 then Worked := False; exit; end if; I := I - 1; Val := Val * Base + I; end loop; Target := Val * Sign; end Jla_String_To_Number; -- ************************************************************************ -- Functional Description : The following routine converts a string -- into an integer. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Jla_String_To_Number (internal) -- ************************************************************************ procedure String_To_Number (Source : String; Target : out Integer; Worked : out Boolean; Base : Natural := 10) is begin Jla_String_To_Number (Source, Target, Worked, Base); -- String_Utilities.String_To_Number -- (Source, Target, Worked, Base); end String_To_Number; -- ************************************************************************ -- Functional Description : The following routine converts an integer into -- a pre_defined Ada string. -- Functional Description : -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Jla_Number _To_String (internal) -- ************************************************************************ function Number_To_String (Value : Integer; Base : Natural := 10; Width : Natural := 0; Leading : Character := ' ') return String is begin return Jla_Number_To_String (Value, Base, Width, Leading); end Number_To_String; -- ************************************************************************ -- Functional Description : Changes a lower case string into upper case. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ procedure Upshift (X : in out String) is begin for I in X'Range loop if X (I) in 'a' .. 'z' then X (I) := Character'Val (Character'Pos (X (I)) - 32); end if; end loop; end Upshift; -- ************************************************************************ -- Functional Description : Changes a string into upper case. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Upshift (internal) -- ************************************************************************ function Change_To_Upper_Case (S : String) return String is Temp : String (S'Range) := S; begin Upshift (Temp); return Temp; end Change_To_Upper_Case; -- ************************************************************************ -- Functional Description : Changes an upper case string into lower case; -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ procedure Downshift (X : in out String) is begin for I in X'Range loop if X (I) in 'A' .. 'Z' then X (I) := Character'Val (Character'Pos (X (I)) + 32); end if; end loop; end Downshift; -- ************************************************************************ -- Functional Description : Changes a string into lower case. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Downshift (internal) -- ************************************************************************ function Change_To_Lower_Case (S : String) return String is Temp : String (S'Range) := S; begin Downshift (Temp); return Temp; end Change_To_Lower_Case; -- ************************************************************************ -- Functional Description : Changes a vstring into upper case. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: change_to_lower_case (internal) -- Fix (internal) -- Var (internal) -- ************************************************************************ function Change_To_Upper_Case (Var_S : Vstring) return Vstring is begin return Var (Change_To_Upper_Case (Fix (Var_S))); end Change_To_Upper_Case; -- ************************************************************************ -- Functional Description : Changes a vstring into lower case. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: change_to_lower_case (internal) -- Fix (internal) -- Var (internal) -- ************************************************************************ function Change_To_Lower_Case (Var_S : Vstring) return Vstring is begin return Var (Change_To_Lower_Case (Fix (Var_S))); end Change_To_Lower_Case; -- ************************************************************************ -- Functional Description : Splits a vstring into parts. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Split_String (internal) -- ************************************************************************ procedure Split_String (Source : in out Vstring; Target : out Integer; Break_String : in String := " ") is Temp : Vstring (Length (Source)); begin Split_String (Source, Temp, Break_String); Target := Inparm (Temp); end Split_String; -- ************************************************************************ -- Functional Description : Overloaded relational operators work as the -- string operators, but only on vstring types. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: -- ************************************************************************ function "=" (Left, Right : Vstring) return Boolean is begin return Comstr (Left, Right) = Equal; end "="; function ">=" (Left, Right : Vstring) return Boolean is begin return Comstr (Left, Right) /= Less_Than; end ">="; function "<=" (Left, Right : Vstring) return Boolean is begin return Comstr (Left, Right) /= Greater_Than; end "<="; function ">" (Left, Right : Vstring) return Boolean is begin return Comstr (Left, Right) = Greater_Than; end ">"; function "<" (Left, Right : Vstring) return Boolean is begin return Comstr (Left, Right) = Less_Than; end "<"; -- ************************************************************************ -- Functional Description : The following function works just as defined -- Ada concatenation except that the resulting -- vstring now has a length equal to the -- two concatenated parts. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Substr (internal) -- ************************************************************************ function "&" (Left : Vstring; Right : Vstring) return Vstring is Len : Integer := Left.Length + Right.Length; Temp : Vstring (Len); begin -- Sets the maximum length Temp.Length := Len; -- Move the left string into temp if Left.Length > 0 then Substr (Left.Bod, 1, Left.Length, Temp.Bod, 1, Left.Length); end if; -- Move the right string into temp right preceeding the left string if Right.Length > 0 then Substr (Right.Bod, 1, Right.Length, Temp.Bod, Left.Length + 1, Right.Length); end if; return Temp; end "&"; -- ************************************************************************ -- Functional Description : The following function works just as defined -- Ada concatenation except that the resulting -- vstring now has a length equal to the -- two concatenated parts. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Var -- "&" -- ************************************************************************ function "&" (Left : String; Right : Vstring) return Vstring is begin -- Convert the left string into a vstring before the -- concatenation. return Var (Left) & Right; end "&"; -- ************************************************************************ -- Functional Description : The following function works just as defined -- Ada concatenation except that the resulting -- vstring now has a length equal to the -- two concatenated parts. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: "&" -- Var (internal) -- ************************************************************************ function "&" (Left : Vstring; Right : String) return Vstring is begin -- Converts the right string into a vstring before the -- concatenation. return Left & Var (Right); end "&"; -- ************************************************************************ -- Functional Description : The following function returns the exact -- reverse of the source string that -- is input. The length of the returned -- string is the same as the source. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Reverse_String (Source : in String) return String is Temp_String : String (1 .. Length (Source)); Counter : Integer := 1; begin for I in reverse Source'First .. Source'Last loop Temp_String (Counter) := Source (I); Counter := Counter + 1; end loop; return Temp_String; end Reverse_String; -- ************************************************************************ -- Functional Description : The following function returns the exact -- reverse of the source vstring that -- is input. The length of the returned -- vstring is the same as the source. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: Var (internal) -- Reverse_String (internal) -- ************************************************************************ function Reverse_String (Source : in Vstring) return Vstring is Temp_String : Vstring (Length (Source)); Temp_String1 : String (1 .. Length (Source)); begin Temp_String1 := Fix (Source); Temp_String := Var (Reverse_String (Temp_String1)); return Temp_String; end Reverse_String; -- ************************************************************************ -- Functional Description : Returns a string of ascii del's -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function High_String (Length : Integer) return String is Temp : String (1 .. Length) := (others => Character'Last); begin return Temp; end High_String; -- ************************************************************************ -- Functional Description : Returns a string fill with ascii null's. -- Major Major Memory Usage : N/A -- Entry and Exit Parameters : See formal parameters -- Subroutine Called: None -- ************************************************************************ function Low_String (Length : Integer) return String is Temp : String (1 .. Length) := (others => Character'First); begin return Temp; end Low_String; end String_Pack;