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

⟦a4547d0c8⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Terminal, seg_05c228, seg_05c2a5

Derivation

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

with Low_Level_Io_8;
with V_I_Mutex;
package body Terminal is

    task type Guetter is
        entry Go (H : in Handle);
    end Guetter;

    type Objet is
        record
            Port : Low_Level_Io_8.Object;
            No : Integer;
            Ecran : V_I_Mutex.A_Safe_Mutex_T;  
            Defini : Boolean := False;
        end record;

    Taches : array (Low_Level_Io_8.Port_Nb) of Guetter;

    procedure Init_Configuration is
    begin
        null;
    end Init_Configuration;

    procedure Ecrire_Chaine (S : in String; Port : in Low_Level_Io_8.Object) is
    begin
        for I in 1 .. S'Length loop
            Low_Level_Io_8.Send (Port => Port, Car => Character'Pos (S (I)));
        end loop;
    end Ecrire_Chaine;

    function Creer (Col : in Tcoordonnees := Max_Col;
                    Lin : in Tcoordonnees := Max_Lin;
                    No : in Integer) return Handle is  
        Init : Boolean;
        N : Low_Level_Io_8.Port_Nb := Low_Level_Io_8.Port_Nb (No);
        P : Low_Level_Io_8.Object;
        H : Handle := new Objet;
    begin
        P := Low_Level_Io_8.Open (Nb => N);
        H.Port := P;  
        H.No := No;
        H.Defini := True;
        Init := V_I_Mutex.Ts_Mutex_Init (Safe_Mutex => H.Ecran);
        Ecrire_Chaine (S => Ascii.Esc & ':', Port => H.Port);
        Ecrire_Chaine (S => Ascii.Esc & ".0", Port => H.Port);
        Taches (N).Go (H);  
        return H;
    end Creer;

    procedure Ecrire (Terminal : in Handle;
                      C : in Character;
                      X, Y : in Tcoordonnees;
                      Blink : in Boolean := False) is
        S_Lin : constant Character := Character'Val (Y + 31);
        S_Col : constant Character := Character'Val (X + 31);
    begin
        V_I_Mutex.Ts_Mutex_Lock (Safe_Mutex => Terminal.Ecran);
        if Blink then
            Ecrire_Chaine (S => Ascii.Esc & ')', Port => Terminal.Port);
        end if;
        Ecrire_Chaine (S => Ascii.Esc & '=' & S_Lin & S_Col & C,
                       Port => Terminal.Port);
        if Blink then
            Ecrire_Chaine (S => Ascii.Esc & '(', Port => Terminal.Port);
        end if;
        V_I_Mutex.Ts_Mutex_Unlock (Safe_Mutex => Terminal.Ecran);
    end Ecrire;

    task body Guetter is
        N : Integer;
        P : Low_Level_Io_8.Object;  
        Car : Character;
    begin
        accept Go (H : in Handle) do
            P := H.Port;
            N := H.No;
        end Go;
        loop
            Car := Character'Val (Low_Level_Io_8.Receive (Port => P));
            Envoyer_Caractere (C => Car, No => Integer (N));
        end loop;
    end Guetter;

    procedure Fermer (Terminal : in out Handle) is
    begin
        Low_Level_Io_8.Close (Port => Terminal.Port);
    end Fermer;
end Terminal;

    nblk1=5
    nid=3
    hdr6=6
        [0x00] rec0=24 rec1=00 rec2=01 rec3=022
        [0x01] rec0=18 rec1=00 rec2=05 rec3=08e
        [0x02] rec0=1e rec1=00 rec2=04 rec3=000
        [0x03] rec0=03 rec1=00 rec2=04 rec3=000
        [0x04] rec0=04 rec1=00 rec2=02 rec3=000
    tail 0x2176b8ed0895a84700bf4 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 02 03 9f 00 0f 20 20 20 20 20 20 20 20 65 6e  ┆              en┆
  0x2: 0000  00 00 00 5d 00 35 20 20 20 20 20 20 20 20 4c 6f  ┆   ] 5        Lo┆