DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦dd769e503⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Expression_Node, seg_041233

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Text_Io;
use Text_Io;
package body Expression_Node is

    use Kind;

    procedure Make (The_Kind : in Operator;
                    Left_Node, Right_Node : in P_Object;
                    Father_Node : out P_Object;
                    Ok : out Boolean) is

    begin
        case The_Kind is
            when '+' =>
                Father_Node := new Object'(Kind => '+',
                                           Left => Left_Node,
                                           Right => Right_Node);
                Ok := True;
            when '-' =>
                Father_Node := new Object'(Kind => '-',
                                           Left => Left_Node,
                                           Right => Right_Node);
                Ok := True;
            when '*' =>
                Father_Node := new Object'(Kind => '*',
                                           Left => Left_Node,
                                           Right => Right_Node);
                Ok := True;
            when '/' =>
                Father_Node := new Object'(Kind => '/',
                                           Left => Left_Node,
                                           Right => Right_Node);
                Ok := True;
        end case;
    end Make;


    procedure Make (The_Kind : in Value;
                    The_String : in String;
                    Node : out P_Object;
                    Ok : out Boolean) is

    begin
        case The_Kind is
            when Number =>
                Node := new Object'(Kind => Number,
                                    Value => Integer'Value (The_String));
                Ok := True;
            when Attribute =>
                null;  
                Ok := True;
            when Enumerate =>
                null;  
                Ok := True;
        end case;

    exception
        when Constraint_Error =>
            Ok := False;
    end Make;

    procedure Image (Item : in Object) is

    begin
        case Item.Kind is
            when '+' | '-' | '*' | '/' =>
                Image (Item.Left.all);
                Put (" " & Operator'Image (Item.Kind) & " ");
                Image (Item.Right.all);
                New_Line;
            when Number =>
                Put (Integer'Image (Item.Value));
            when Attribute =>
                Put (Natural'Image (Item.Complement) &
                     Natural'Image (Item.Field));
            when Enumerate =>
                Put (Natural'Image (Item.Enumeration) &
                     Natural'Image (Item.Literal));
            when Unknown =>   -- exception
                null;
        end case;
    end Image;


    function Evaluate (Item : in Object) return Integer is

        Result : Integer := 0;

    begin
        case Item.Kind is
            when '+' =>
                Result := Evaluate (Item.Left.all) + Evaluate (Item.Right.all);  
            when '-' =>
                Result := Evaluate (Item.Left.all) - Evaluate (Item.Right.all);
            when '*' =>
                Result := Evaluate (Item.Left.all) * Evaluate (Item.Right.all);
            when '/' =>
                Result := Evaluate (Item.Left.all) / Evaluate (Item.Right.all);  
            when Number =>
                Result := Item.Value;
            when Attribute =>
                null;
            when Enumerate =>
                return Item.Literal;
            when Unknown =>   -- exception
                null;
        end case;
        return Result;

    exception
        when Numeric_Error =>
            return 0;

    end Evaluate;



end Expression_Node;

    nblk1=5
    nid=2
    hdr6=8
        [0x00] rec0=1c rec1=00 rec2=01 rec3=062
        [0x01] rec0=20 rec1=00 rec2=05 rec3=030
        [0x02] rec0=21 rec1=00 rec2=03 rec3=060
        [0x03] rec0=1b rec1=00 rec2=04 rec3=000
        [0x04] rec0=c0 rec1=00 rec2=00 rec3=100
    tail 0x217416b1c861352a1827c 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 00 02 bb 80 23 74 2e 61 6c 6c 29 20 2d 20 45  ┆     #t.all) - E┆