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 - metrics - download

⟦c36a85e90⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Control, seg_005e36

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;
package body Control is
    procedure Set (The_Object : in out Object; To_Value : Integer) is  
    begin
        if To_Value < Minimum then
            case The_Object.Mode is
                when Checked =>
                    raise Underflow;
                when Constrained | Circulary =>
                    The_Object.Value := Minimum;
            end case;
        elsif To_Value > Maximum then
            case The_Object.Mode is
                when Checked =>
                    raise Overflow;
                when Constrained | Circulary =>
                    The_Object.Value := Maximum;
            end case;
        else
            The_Object.Value := To_Value;
        end if;
    end Set;


    procedure Set (The_Object : in out Object; To_Mode : Running_Modes) is
    begin
        The_Object.Mode := To_Mode;
    end Set;


    procedure Reset (The_Object : in out Object) is
    begin
        The_Object.Value := Default;
    end Reset;

    procedure Up_One (The_Object : in out Object) is
    begin
        if The_Object.Value = Maximum then
            case The_Object.Mode is
                when Checked =>
                    raise Overflow;
                when Constrained =>
                    null;
                when Circulary =>
                    The_Object.Value := Minimum;
            end case;
        else
            The_Object.Value := The_Object.Value + 1;
        end if;
    end Up_One;



    procedure Up (The_Object : in out Object; Count : Positive := 1) is
    begin
        for I in 1 .. Count loop
            Up_One (The_Object);
        end loop;
    end Up;


    procedure Down_One (The_Object : in out Object) is
    begin
        if The_Object.Value = Minimum then
            case The_Object.Mode is
                when Checked =>
                    raise Underflow;
                when Constrained =>
                    null;
                when Circulary =>
                    The_Object.Value := Maximum;
            end case;
        else
            The_Object.Value := The_Object.Value - 1;
        end if;
    end Down_One;


    procedure Down (The_Object : in out Object; Count : Positive := 1) is
    begin
        for I in 1 .. Count loop
            Down_One (The_Object);
        end loop;
    end Down;


    procedure Put (The_Object : Object) is
    begin
        Text_Io.Put_Line (Running_Modes'Image (The_Object.Mode) &
                          " counter from " & Integer'Image (Minimum) & " to " &
                          Integer'Image (Maximum) & " set to value: " &
                          Integer'Image (The_Object.Value));
    end Put;

    function Get (The_Object : Object) return Running_Modes is
    begin
        return The_Object.Mode;
    end Get;
end Control;

    nblk1=4
    nid=3
    hdr6=6
        [0x00] rec0=22 rec1=00 rec2=01 rec3=034
        [0x01] rec0=24 rec1=00 rec2=04 rec3=014
        [0x02] rec0=1f rec1=00 rec2=02 rec3=000
        [0x03] rec0=1b rec1=00 rec2=02 rec3=000
    tail 0x217016bd081ba71294797 0x42a00088462063c03
Free Block Chain:
  0x3: 0000  00 00 00 13 80 0a 3d 20 44 65 66 61 75 6c 74 3b  ┆      = Default;┆