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

⟦39825005c⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Machine_Io, seg_04cc9e, seg_04cd87

Derivation

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

with Device_Independent_Io;  
with Io_Exceptions;
with System;
with Text_Io;
with Terminal_Specific;


package body Machine_Io is

    function Blocked_Read return My_Types.Byte;
    package Byte_Io is new Text_Io.Integer_Io (System.Byte); -- trace

    F_In_Out : Terminal_Specific.File_Type;
    Col : Natural; -- trace
    Current_Level : Debug_Level := None;
    Current_Timeout : Duration := 2.0;

    procedure Set (Timeout : Duration) is
    begin
        Current_Timeout := Timeout;
    end Set;

    procedure Debug (Level : Debug_Level) is
    begin
        Current_Level := Level;
    end Debug;

    function Debug return String is
    begin
        return Debug_Level'Image (Current_Level);
    end Debug;

    procedure Open (With_Mode : Open_Mode) is
        Mode : Device_Independent_Io.File_Mode;
    begin
        Col := 0; -- trace
        case With_Mode is
            when Read_Mode =>
                Mode := Device_Independent_Io.In_File;
            when Write_Mode =>
                Mode := Device_Independent_Io.Out_File;
        end case;
        Device_Independent_Io.Open
           (File => F_In_Out, Mode => Mode, Name => Io_Port, Form => "");

        if With_Mode = Read_Mode then
            Terminal_Specific.Input.Set_Editing
               (File => F_In_Out, Mode => "None");
            Terminal_Specific.Input.Set_Echo (File => F_In_Out, Echo => False);
        else
            -- AAAAARRGH ! le code 16#A# (LF) est accompagne d'un CR
            Terminal_Specific.Output.Map_Lf_To_Crlf
               (File => F_In_Out, Value => False);
        end if;

    exception
        when Io_Exceptions.Use_Error =>
            Close;
            raise Open_Error;

    end Open;

    procedure Close is
    begin
        Device_Independent_Io.Close (File => F_In_Out);
        if (Current_Level /= None) then
            Text_Io.Put_Line ("");
        end if;
    end Close;

    procedure Flush is
    begin
        Open (With_Mode => Read_Mode);
        Terminal_Specific.Input.Flush (F_In_Out);
        Close;
    end Flush;

    procedure Write (S : in My_Types.Byte_String) is
        To_Send : System.Byte_String (1 .. S'Length);
    begin

        if (Current_Level /= None) then
            Text_Io.Put_Line ("Write : ");
        end if;

        for K in S'Range loop
            To_Send (K) := System.Byte (S (K));
            if (Current_Level = Bytes) then
                Byte_Io.Put (Item => To_Send (K), Width => 7, Base => 16);
                if (K mod 10) = 0 then
                    Text_Io.Put_Line (""); -- trace
                end if;
            end if;
        end loop;

        Device_Independent_Io.Write (File => F_In_Out, Item => To_Send);
    end Write;

    function Read return My_Types.Byte is

        Byte_Read : My_Types.Byte;

        task Timed is  
            entry Start;
            entry Read (Some_Byte : out My_Types.Byte);
        end Timed;

        task body Timed is
            To_Read : My_Types.Byte;
        begin
            select
                accept Start;
                To_Read := Blocked_Read;
                accept Read (Some_Byte : out My_Types.Byte) do
                    Some_Byte := To_Read;
                end Read;
            end select;
        end Timed;

    begin

        Timed.Start;

        select
            Timed.Read (Byte_Read);
        or
            delay Current_Timeout;
            abort Timed;
            raise Read_Timeout;

        end select;

        return Byte_Read;
    exception
        -- La tache peut etre morte avant le RdV ! -> cable debranche pendant la lecture ...
        when Tasking_Error =>
            raise Read_Timeout;
    end Read;

    function Blocked_Read return My_Types.Byte is
        Byte_Read : System.Byte;  
    begin
        Device_Independent_Io.Read (File => F_In_Out, Item => Byte_Read);
        if Current_Level /= None then
            if Col = 0 then                -- trace
                Text_Io.Put_Line ("Read :");
            end if;  
        end if;
        Col := Col + 1; -- trace
        if Current_Level = Bytes then
            Byte_Io.Put (Item => Byte_Read, Width => 7, Base => 16); -- trace

            if (Col mod 10) = 0 then
                Text_Io.Put_Line (""); -- trace
            end if;
        end if;
        return My_Types.Byte (Byte_Read);
    end Blocked_Read;

end Machine_Io;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=28 rec1=00 rec2=01 rec3=03e
        [0x01] rec0=1d rec1=00 rec2=02 rec3=01e
        [0x02] rec0=24 rec1=00 rec2=03 rec3=022
        [0x03] rec0=26 rec1=00 rec2=04 rec3=012
        [0x04] rec0=17 rec1=00 rec2=05 rec3=000
    tail 0x217540cda874f6e5e88c1 0x42a00088462060003