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

⟦147b05a15⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Text_Io_8, seg_05c1db, seg_05c2b1

Derivation

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

with Duart_2661;  
with Duart_68681;
with Low_Level_Io_8;
with Low_Level_Io_2;
package body Text_Io_8 is

    type Name_Supported (Hw : Hw_Supported := Io_2) is
        record
            case Hw is
                when Io_2 =>
                    Name_2 : Duart_68681.Port_Name;
                when Io_8 =>
                    Name_8 : Low_Level_Io_8.Port_Nb;
            end case;
        end record;

    type Internal (Hw : Hw_Supported := Io_2) is
        record  
            case Hw is
                when Io_2 =>
                    Port_2 : Low_Level_Io_2.Object;
                when Io_8 =>
                    Port_8 : Low_Level_Io_8.Object;
            end case;
        end record;

    Current_Output_File, Current_Input_File : File_Type := null;

    procedure Get_Params (Form : in String;
                          S : out Duart_2661.Stop_Bit;
                          P : out Duart_2661.Parity;
                          C : out Duart_2661.Car_Length;
                          B : out Duart_2661.Baud_Rate) is
    begin
        if Form = "" then
            S := Duart_2661.Stop_Bit_1;
            P := Duart_2661.Parity_None;
            C := Duart_2661.Car_Length_8_Bit;
            B := Duart_2661.Baud_Rate_9600;
        else
            null; -- traiter plus tard la forme :
                  -- form => "9600 8 1 N"  (exemple)
        end if;
    end Get_Params;
    procedure Get_Params (Form : in String;
                          S : out Duart_68681.Stop_Bit;
                          P : out Duart_68681.Parity;
                          C : out Duart_68681.Car_Length;
                          B : out Duart_68681.Baud_Rate) is
    begin
        if Form = "" then
            S := Duart_68681.Stop_Bit_1;
            P := Duart_68681.Parity_None;
            C := Duart_68681.Car_Length_8_Bit;
            B := Duart_68681.Baud_Rate_9600;
        else
            null; -- traiter plus tard la forme :
                  -- form => "9600 8 1 N"  (exemple)
        end if;
    end Get_Params;

    procedure Get_Hw (Name : in String; Id : out Name_Supported) is
        Id_2 : Duart_68681.Port_Name;
        Id_8 : Low_Level_Io_8.Port_Nb;  
        Found : Boolean := False;
    begin
        begin
            Id_8 := Low_Level_Io_8.Port_Nb'Value (Name);
            Id := (Hw => Io_8, Name_8 => Id_8);
            Found := True;
        exception
            when Constraint_Error =>
                Found := False;
        end;  
        if not Found then
            begin
                Id_2 := Duart_68681.Port_Name'Value ("Port_" & Name);
                Id := (Hw => Io_2, Name_2 => Id_2);
            exception
                when Constraint_Error =>
                    raise;
            end;  
        end if;
    end Get_Hw;

    procedure Open (File : in out File_Type;
                    Name : in String;
                    Form : in String := "") is
        S8 : Duart_2661.Stop_Bit;
        P8 : Duart_2661.Parity;
        C8 : Duart_2661.Car_Length;
        B8 : Duart_2661.Baud_Rate;
        S2 : Duart_68681.Stop_Bit;
        P2 : Duart_68681.Parity;
        C2 : Duart_68681.Car_Length;
        B2 : Duart_68681.Baud_Rate;
        Port_8 : Low_Level_Io_8.Object;
        Port_2 : Low_Level_Io_2.Object;  
        Name_8 : Low_Level_Io_8.Port_Nb;
        Name_2 : Duart_68681.Port_Name;
        Id : Name_Supported;
    begin  
        Get_Hw (Name => Name, Id => Id);
        if Id.Hw = Io_8 then
            Get_Params (Form => Form, S => S8, P => P8, C => C8, B => B8);  
            Port_8 := Low_Level_Io_8.Open
                         (Nb => Id.Name_8, S => S8, P => P8, C => C8, B => B8);
            File := new Internal'(Hw => Io_8, Port_8 => Port_8);
        elsif Id.Hw = Io_2 then
            Get_Params (Form => Form, S => S2, P => P2, C => C2, B => B2);
            Port_2 :=
               Low_Level_Io_2.Open
                  (Name => Id.Name_2, S => S2, P => P2, C => C2, B => B2);
            File := new Internal'(Hw => Io_2, Port_2 => Port_2);
        end if;
    end Open;

    procedure Set_Input (File : in File_Type) is
    begin
        Current_Input_File := File;
    end Set_Input;

    procedure Set_Output (File : in File_Type) is
    begin
        Current_Output_File := File;
    end Set_Output;

    procedure New_Line (File : in File_Type;
                        Spacing : in Positive_Count := 1) is
    begin
        for I in 1 .. Spacing loop
            Put (File => File, Item => Ascii.Cr);
            Put (File => File, Item => Ascii.Lf);
        end loop;
    end New_Line;

    procedure New_Line (Spacing : in Positive_Count := 1) is
    begin
        New_Line (File => Current_Output_File, Spacing => Spacing);
    end New_Line;

    procedure Get (File : in File_Type; Item : out Character) is  
        Local_Echo : Character;
    begin         case File.Hw is
            when Io_8 =>
                Local_Echo := Character'Val
                                 (Low_Level_Io_8.Receive (Port => File.Port_8));
            when Io_2 =>
                Local_Echo := Character'Val
                                 (Low_Level_Io_2.Receive (Port => File.Port_2));
        end case;
        Put (File => File, Item => Local_Echo);
        Item := Local_Echo;
    end Get;

    procedure Get (Item : out Character) is
    begin
        Get (File => Current_Input_File, Item => Item);
    end Get;

    procedure Put (File : in File_Type; Item : in Character) is
    begin
        case File.Hw is
            when Io_8 =>
                Low_Level_Io_8.Send (Port => File.Port_8,
                                     Car => Character'Pos (Item));
            when Io_2 =>
                Low_Level_Io_2.Send (Port => File.Port_2,
                                     Car => Character'Pos (Item));
        end case;
    end Put;

    procedure Put (Item : in Character) is
    begin
        Put (File => Current_Output_File, Item => Item);
    end Put;

    procedure Get (File : in File_Type; Item : out String) is
    begin  
        for I in Item'Range loop
            Get (File => File, Item => Item (I));
        end loop;
    end Get;

    procedure Get (Item : out String) is
    begin
        Get (File => Current_Input_File, Item => Item);
    end Get;

    procedure Put (File : in File_Type; Item : in String) is
    begin
        for I in Item'Range loop
            Put (File => File, Item => Item (I));
        end loop;
    end Put;

    procedure Put (Item : in String) is
    begin
        Put (File => Current_Output_File, Item => Item);
    end Put;

    procedure Get_Line
                 (File : in File_Type; Item : out String; Last : out Natural) is
        L : Natural := 0;
        Car : Character := 'a';
    begin
        Get (File => File, Item => Car);
        while Car /= Ascii.Cr loop
            L := L + 1;
            Item (L) := Car;
            Get (File => File, Item => Car);
        end loop;
        Last := L;
    end Get_Line;

    procedure Get_Line (Item : out String; Last : out Natural) is
    begin
        Get_Line (File => Current_Input_File, Item => Item, Last => Last);
    end Get_Line;

    procedure Put_Line (File : in File_Type; Item : in String) is
    begin
        Put (File => File, Item => Item);
        New_Line (File => File);
    end Put_Line;

    procedure Put_Line (Item : in String) is
    begin
        Put_Line (File => Current_Output_File, Item => Item);
    end Put_Line;
end Text_Io_8;

    nblk1=b
    nid=0
    hdr6=16
        [0x00] rec0=21 rec1=00 rec2=01 rec3=026
        [0x01] rec0=19 rec1=00 rec2=08 rec3=01e
        [0x02] rec0=1e rec1=00 rec2=03 rec3=04a
        [0x03] rec0=02 rec1=00 rec2=0b rec3=028
        [0x04] rec0=18 rec1=00 rec2=06 rec3=012
        [0x05] rec0=20 rec1=00 rec2=09 rec3=002
        [0x06] rec0=01 rec1=00 rec2=05 rec3=010
        [0x07] rec0=1c rec1=00 rec2=0a rec3=00e
        [0x08] rec0=00 rec1=00 rec2=04 rec3=00c
        [0x09] rec0=23 rec1=00 rec2=07 rec3=00c
        [0x0a] rec0=18 rec1=00 rec2=02 rec3=001
    tail 0x2176b8b74895a7aead46d 0x42a00088462060003