|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 25600 (0x6400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Vstring_Scan, seg_005843
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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.
------------------------------------------------------------------------------
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
whenSa_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;
--\x0c
procedure Trunc_Scan (From : Vstring;
Brk : Breakset;
Break_Char : out Character) is
begin
Trunc_Scan (From.all, Brk, Break_Char);
end Trunc_Scan;
--\x0c
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;
--\x0c
end Vstring_Scan;
nblk1=18
nid=0
hdr6=30
[0x00] rec0=19 rec1=00 rec2=01 rec3=00c
[0x01] rec0=16 rec1=00 rec2=02 rec3=012
[0x02] rec0=00 rec1=00 rec2=18 rec3=00a
[0x03] rec0=16 rec1=00 rec2=03 rec3=044
[0x04] rec0=01 rec1=00 rec2=17 rec3=04c
[0x05] rec0=14 rec1=00 rec2=04 rec3=048
[0x06] rec0=03 rec1=00 rec2=16 rec3=01a
[0x07] rec0=1a rec1=00 rec2=05 rec3=042
[0x08] rec0=01 rec1=00 rec2=15 rec3=012
[0x09] rec0=1d rec1=00 rec2=06 rec3=002
[0x0a] rec0=00 rec1=00 rec2=14 rec3=060
[0x0b] rec0=1d rec1=00 rec2=07 rec3=048
[0x0c] rec0=18 rec1=00 rec2=08 rec3=02c
[0x0d] rec0=1b rec1=00 rec2=09 rec3=028
[0x0e] rec0=00 rec1=00 rec2=13 rec3=002
[0x0f] rec0=1a rec1=00 rec2=0a rec3=008
[0x10] rec0=00 rec1=00 rec2=12 rec3=038
[0x11] rec0=19 rec1=00 rec2=0b rec3=072
[0x12] rec0=00 rec1=00 rec2=11 rec3=024
[0x13] rec0=13 rec1=00 rec2=0c rec3=036
[0x14] rec0=01 rec1=00 rec2=10 rec3=010
[0x15] rec0=12 rec1=00 rec2=0d rec3=026
[0x16] rec0=16 rec1=00 rec2=0e rec3=036
[0x17] rec0=1c rec1=00 rec2=0f rec3=000
tail 0x21500affa81978f26b9f6 0x42a00088462063203