|
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: 14450 (0x3872)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦591c5b094⟧
└─⟦this⟧
with Arithmetic;
use Arithmetic;
with Vstring_Case;
use Vstring_Case;
with Vstring_Type;
use Vstring_Type;
package body Vstring_Scan is
------------------------------------------------------------------------------
-- Copyright 1988 - 1991 by Rational, Santa Clara, California.
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------
--\f
procedure Scan_Body (To : in out Vstring_Data;
To_Start : S_Natural;
From : in out Vstring_Data;
Brk : Breakset;
Break_Char : out Character) is
To_Pos : S_Natural := To_Start;
Pos : S_Natural := 1;
Last : S_Natural := From.Length;
begin
----If From is longer than To then this loop will scan just the start of the
-- From string.
Break_Char := Ascii.Nul;
if Last > To.Maximum_Length then
Last := To.Maximum_Length;
end if;
----Scan the whole string as directed by the Breakset. When the loop exits
-- the string to be kept will be From.Chars(Pos..From.Length).
while Pos <= Last loop
case Brk (From.Chars (Pos)) is
when Sa_Transfer =>
To_Pos := To_Pos + 1;
To.Chars (To_Pos) := From.Chars (Pos);
when Sa_Skip =>
null;
when Sa_Transfer_Uc =>
To_Pos := To_Pos + 1;
To.Chars (To_Pos) := Uc_Char (From.Chars (Pos));
when Sa_Transfer_Lc =>
To_Pos := To_Pos + 1;
To.Chars (To_Pos) := Lc_Char (From.Chars (Pos));
when Sa_Transfer_Break =>
To_Pos := To_Pos + 1;
To.Chars (To_Pos) := From.Chars (Pos);
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
goto Found_Break;
when Sa_Transfer_Uc_Break =>
To_Pos := To_Pos + 1;
To.Chars (To_Pos) := Uc_Char (From.Chars (Pos));
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
goto Found_Break;
when Sa_Transfer_Lc_Break =>
To_Pos := To_Pos + 1;
To.Chars (To_Pos) := Lc_Char (From.Chars (Pos));
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
goto Found_Break;
when Sa_Skip_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
goto Found_Break;
when Sa_Retain_Break =>
Break_Char := From.Chars (Pos);
goto Found_Break;
end case;
Pos := Pos + 1;
end loop;
----Scan the rest of the string as directed by the Breakset. When the loop
-- exits the string to be kept will be From.Chars(Pos..From.Length).
Last := From.Length;
while Pos <= Last loop
case Brk (From.Chars (Pos)) is
when Sa_Transfer =>
null;
when Sa_Skip =>
null;
when Sa_Transfer_Uc =>
null;
when Sa_Transfer_Lc =>
null;
when Sa_Transfer_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Transfer_Uc_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Transfer_Lc_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Skip_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Retain_Break =>
Break_Char := From.Chars (Pos);
exit;
end case;
Pos := Pos + 1;
end loop;
----Copy the unscanned portion of the string down to the start of the array
-- and set the length and return.
<<Found_Break>> null;
Last := From.Length - Pos + 1;
From.Chars (1 .. Last) := From.Chars (Pos .. From.Length);
From.Length := Last;
To.Length := To_Pos;
end Scan_Body;
--\f
procedure Scan (To : in out Vstring_Data;
From : in out Vstring_Data;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To, 0, From, Brk, Break_Char);
end Scan;
procedure Scan (To : in out Vstring_Data;
From : Vstring;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To, 0, From.all, Brk, Break_Char);
end Scan;
procedure Scan (To : Vstring;
From : in out Vstring_Data;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To.all, 0, From, Brk, Break_Char);
end Scan;
procedure Scan (To : Vstring;
From : Vstring;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To.all, 0, From.all, Brk, Break_Char);
end Scan;
--\f
procedure Append_Scan (To : in out Vstring_Data;
From : in out Vstring_Data;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To, To.Length, From, Brk, Break_Char);
end Append_Scan;
procedure Append_Scan (To : in out Vstring_Data;
From : Vstring;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To, To.Length, From.all, Brk, Break_Char);
end Append_Scan;
procedure Append_Scan (To : in out Vstring;
From : in out Vstring_Data;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To.all, To.Length, From, Brk, Break_Char);
end Append_Scan;
procedure Append_Scan (To : in out Vstring;
From : Vstring;
Brk : Breakset;
Break_Char : out Character) is
begin
Scan_Body (To.all, To.Length, From.all, Brk, Break_Char);
end Append_Scan;
--\f
procedure Trunc_Scan (From : in out Vstring_Data;
Brk : Breakset;
Break_Char : out Character) is
Pos : S_Natural := 1;
Last : S_Natural := From.Length;
begin
----Scan the whole string as directed by the Breakset. When the loop exits
-- the string to be kept will be From.Chars(Pos..Last).
Break_Char := Ascii.Nul;
while Pos <= Last loop
case Brk (From.Chars (Pos)) is
when Sa_Transfer =>
null;
when Sa_Skip =>
null;
when Sa_Transfer_Uc =>
null;
when Sa_Transfer_Lc =>
null;
when Sa_Transfer_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Transfer_Uc_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Transfer_Lc_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Skip_Break =>
Break_Char := From.Chars (Pos);
Pos := Pos + 1;
exit;
when Sa_Retain_Break =>
Break_Char := From.Chars (Pos);
exit;
end case;
Pos := Pos + 1;
end loop;
----Copy the unscanned portion of the string down to the start of the array
-- and set the length and return.
From.Length := Last - Pos + 1;
From.Chars (1 .. From.Length) := From.Chars (Pos .. Last);
end Trunc_Scan;
--\f
procedure Trunc_Scan (From : Vstring;
Brk : Breakset;
Break_Char : out Character) is
begin
Trunc_Scan (From.all, Brk, Break_Char);
end Trunc_Scan;
--\f
procedure Set_Breakset (Brk : in out Breakset;
Break : E_String;
Omit : E_String;
Mode : E_String) is
------------------------------------------------------------------------------
----Initialize a Breakset.
-- Break - Contains all characters that will (not) stop the scan.
-- Omit - Contains all characters to be dropped as From is scanned.
-- Mode - Mode setting characters:
-- I - Break contains scan stopping characters (Inclusive scan)
-- X - Break contains scan non-stopping chars (eXclusive scan)
-- A - Append break character in To string and stop
-- R - Retain break character in From string and stop
-- S - Skip (drop) break character and stop
-- U - Convert characters to Upper case as they are copied
-- L - Convert characters to Lower case as they are copied
------------------------------------------------------------------------------
Stop_Type : Scan_Action := Sa_Skip_Break;
Transfer_Type : Scan_Action := Sa_Transfer;
Inclusive : Boolean := True;
begin
----Loop over the Mode characters and set up our state variables accordingly.
-- Stop_Type - The Scan_Action to use for a Break character
-- Transfer_Type - The Scan_Action to use for a non-Break character
-- Inclusive - Inclusive or eXclusive scan
for I in Mode'Range loop
case Mode (I) is
when 'I' | 'i' => -- Inclusive Scan
Inclusive := True;
when 'X' | 'x' => -- eXclusive Scan
Inclusive := False;
when 'A' | 'a' => -- Append break character
case Transfer_Type is
when Sa_Transfer =>
Stop_Type := Sa_Transfer_Break;
when Sa_Transfer_Uc =>
Stop_Type := Sa_Transfer_Uc_Break;
when Sa_Transfer_Lc =>
Stop_Type := Sa_Transfer_Lc_Break;
when others =>
null;
end case;
when 'R' | 'r' => -- Retain break character
Stop_Type := Sa_Retain_Break;
when 'S' | 's' => -- Skip break character
Stop_Type := Sa_Skip_Break;
when 'U' | 'u' => -- Upper case transfers
Transfer_Type := Sa_Transfer_Uc;
if Stop_Type /= Sa_Retain_Break and then
Stop_Type /= Sa_Skip_Break then
Stop_Type := Sa_Transfer_Uc_Break;
end if;
when 'L' | 'l' => -- Lower case transfers
Transfer_Type := Sa_Transfer_Lc;
if Stop_Type /= Sa_Retain_Break and then
Stop_Type /= Sa_Skip_Break then
Stop_Type := Sa_Transfer_Lc_Break;
end if;
when others =>
raise Program_Error;
end case;
end loop;
----Init the Breakset to always stop or to always transfer depending upon the
-- type of scan being set up.
if Inclusive then
Brk := (others => Transfer_Type);
else
Brk := (others => Stop_Type);
end if;
----Set all Omit characters to Sa_Skip.
for I in Omit'Range loop
Brk (Omit (I)) := Sa_Skip;
end loop;
----Set all Break characters to Stop or to Transfer depending upon the scan
-- type.
if Inclusive then
for I in Break'Range loop
Brk (Break (I)) := Stop_Type;
end loop;
else
for I in Break'Range loop
Brk (Break (I)) := Transfer_Type;
end loop;
end if;
end Set_Breakset;
--\f
end Vstring_Scan;