|
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 - download
Length: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Condition, seg_02bacc
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
package body Generic_Condition is
type Alias_Storage is array (Alias) of Integer;
The_Aliases : Alias_Storage := (others => 0);
function Is_Any return Generic_Condition.Object is
begin
return (Count => 1, Value => (others => (Is_Any, 0)));
end Is_Any;
-- value condition
function Is_Equal (Value : Integer) return Object is
begin
return (Count => 1, Value => (others => (Is_Equal, Value)));
end Is_Equal;
function Is_Less (Value : Integer) return Object is
begin
return (Count => 1, Value => (others => (Is_Less, Value)));
end Is_Less;
function Is_Less_Or_Equal (Value : Integer) return Object is
begin
return (Count => 1, Value => (others => (Is_Less_Or_Equal, Value)));
end Is_Less_Or_Equal;
function Is_Greater (Value : Integer) return Object is
begin
return (Count => 1, Value => (others => (Is_Greater, Value)));
end Is_Greater;
function Is_Greater_Or_Equal (Value : Integer) return Object is
begin
return (Count => 1, Value => (others => (Is_Greater_Or_Equal, Value)));
end Is_Greater_Or_Equal;
function Is_Different (Value : Integer) return Object is
begin
return (Count => 1, Value => (others => (Is_Different, Value)));
end Is_Different;
-- alias condition
function Is_Equal (Value : Alias) return Object is
begin
return (Count => 1,
Value => (others => (Is_Equal_To_Alias, Alias'Pos (Value))));
end Is_Equal;
function Is_Less (Value : Alias) return Object is
begin
return (Count => 1,
Value => (others => (Is_Less_Than_Alias, Alias'Pos (Value))));
end Is_Less;
function Is_Less_Or_Equal (Value : Alias) return Object is
begin
return (Count => 1,
Value => (others =>
(Is_Less_Or_Equal_Than_Alias, Alias'Pos (Value))));
end Is_Less_Or_Equal;
function Is_Greater (Value : Alias) return Object is
begin
return (Count => 1,
Value => (others =>
(Is_Greater_Than_Alias, Alias'Pos (Value))));
end Is_Greater;
function Is_Greater_Or_Equal (Value : Alias) return Object is
begin
return (Count => 1,
Value => (others => (Is_Greater_Or_Equal_Than_Alias,
Alias'Pos (Value))));
end Is_Greater_Or_Equal;
function Is_Different (Value : Alias) return Object is
begin
return (Count => 1,
Value => (others =>
(Is_Different_Than_Alias, Alias'Pos (Value))));
end Is_Different;
-- miscellaneous condition
function Say_It_Is (Object : Alias) return Generic_Condition.Object is
begin
return (Count => 1,
Value => (others => (Say_It_Is, Alias'Pos (Object))));
end Say_It_Is;
function "and" (Left, Right : Object) return Object is
begin
return (Count => Left.Count + Right.Count,
Value => Left.Value & Right.Value);
end "and";
function Value_Match (Value : Integer; Against : Term) return Boolean is
Operator : Operators renames Against.Operator;
Operand : Integer renames Against.Operand;
begin
case Value_Operators'(Operator) is
when Is_Equal =>
return Value = Operand;
when Is_Less =>
return Value < Operand;
when Is_Less_Or_Equal =>
return Value <= Operand;
when Is_Greater =>
return Value > Operand;
when Is_Greater_Or_Equal =>
return Value >= Operand;
when Is_Different =>
return Value /= Operand;
end case;
end Value_Match;
function Alias_Match (Value : Integer; Against : Term) return Boolean is
Operator : Operators renames Against.Operator;
Alias_Id : constant Alias := Alias'Val (Against.Operand);
Operand : Integer renames The_Aliases (Alias_Id);
begin
case Alias_Operators'(Operator) is
when Is_Equal_To_Alias =>
return Value = Operand;
when Is_Less_Than_Alias =>
return Value < Operand;
when Is_Less_Or_Equal_Than_Alias =>
return Value <= Operand;
when Is_Greater_Than_Alias =>
return Value > Operand;
when Is_Greater_Or_Equal_Than_Alias =>
return Value >= Operand;
when Is_Different_Than_Alias =>
return Value /= Operand;
end case;
end Alias_Match;
function Miscellaneous_Match
(Value : Integer; Against : Term) return Boolean is
Operator : Operators renames Against.Operator;
Operand : Integer renames Against.Operand;
begin
case Miscellaneous_Operators'(Operator) is
when Is_Any =>
return True;
when Say_It_Is =>
The_Aliases (Alias'Val (Operand)) := Value;
return True;
end case;
end Miscellaneous_Match;
function Match (Value : Integer; Against : Term) return Boolean is
Operator : Operators renames Against.Operator;
begin
case Operator is
when Value_Operators =>
return Value_Match (Value, Against);
when Alias_Operators =>
return Alias_Match (Value, Against);
when Miscellaneous_Operators =>
return Miscellaneous_Match (Value, Against);
end case;
end Match;
function Match (Value : Integer; Against : Object) return Boolean is
begin
for I in Against.Value'Range loop
if not Match (Value, Against.Value (I)) then
return False;
end if;
end loop;
return True;
end Match;
procedure Put (The_Term : Term; Where : Output_Stream.Object) is
use Output_Stream;
begin
Put (Operators'Image (The_Term.Operator), Where);
case The_Term.Operator is
when Value_Operators =>
Put (" (" & Integer'Image (The_Term.Operand) & ")", Where);
when Alias_Operators | Say_It_Is =>
Put (" (Alias'", Where);
Put (Alias'Image (Alias'Val (The_Term.Operand)), Where);
Put (")", Where);
when Is_Any =>
null;
end case;
end Put;
procedure Put (The_Condition : Object; Where : Output_Stream.Object) is
First : Boolean := True;
use Output_Stream;
begin
if The_Condition.Count = 0 then
Put ("Any", Where);
else
for I in The_Condition.Value'Range loop
if not First then
New_Line (Where);
Put (" & ", Where);
else
First := False;
end if;
Put (The_Condition.Value (I), Where);
end loop;
end if;
end Put;
end Generic_Condition;
nblk1=c
nid=3
hdr6=10
[0x00] rec0=23 rec1=00 rec2=01 rec3=084
[0x01] rec0=24 rec1=00 rec2=08 rec3=026
[0x02] rec0=21 rec1=00 rec2=07 rec3=024
[0x03] rec0=18 rec1=00 rec2=06 rec3=046
[0x04] rec0=19 rec1=00 rec2=05 rec3=03c
[0x05] rec0=1f rec1=00 rec2=0a rec3=02e
[0x06] rec0=1f rec1=00 rec2=04 rec3=010
[0x07] rec0=13 rec1=00 rec2=09 rec3=000
[0x08] rec0=00 rec1=00 rec2=09 rec3=006
[0x09] rec0=1e rec1=00 rec2=03 rec3=002
[0x0a] rec0=15 rec1=00 rec2=02 rec3=000
[0x0b] rec0=08 rec1=00 rec2=00 rec3=000
tail 0x215237e4083eb6c0d3aea 0x42a00088462063c03
Free Block Chain:
0x3: 0000 00 02 02 92 80 04 50 75 74 3b 04 00 00 00 00 4b ┆ Put; K┆
0x2: 0000 00 0b 02 99 80 0b 20 20 20 65 6e 64 20 50 75 74 ┆ end Put┆
0xb: 0000 00 0c 00 06 80 03 71 75 61 03 00 00 00 00 00 00 ┆ qua ┆
0xc: 0000 00 00 00 0a 80 07 2c 20 56 61 6c 75 65 07 00 00 ┆ , Value ┆