|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 11264 (0x2c00) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Document, seg_04770a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─⟦5a81ac88f⟧ »Space Info Vol 1« └─⟦this⟧
with Text_Io, Filtre_D_Entree, Nos_Chaines; package body Document is Ligne_Courante : Mots.Number := 1; The_File : Text_Io.File_Type; ------------------------------------------------------------------------------ procedure Fopen (File_Name : in String) is begin Text_Io.Open (The_File, Text_Io.In_File, File_Name); Text_Io.Set_Input (The_File); Filtre_D_Entree.Purger; exception when others => Text_Io.Put_Line ("Erreur Fopen"); end Fopen; ------------------------------------------------------------------------------ procedure Fclose is begin Text_Io.Close (The_File); Text_Io.Set_Input (Text_Io.Standard_Input); exception when others => Text_Io.Put_Line ("Erreur Fclose"); end Fclose; ------------------------------------------------------------------------------ function En_Fin_De_Fichier return Boolean is begin return Text_Io.End_Of_File; end En_Fin_De_Fichier; ------------------------------------------------------------------------------ procedure File_Get (Le_Mot : out Mots.Mot; Le_Numero : out Mots.Number) is Caractere_Temporaire : Character; Mot_Temporaire : String (1 .. 80); Indice : Natural := 0; function "+" (X, Y : in Mots.Number) return Mots.Number renames Standard."+"; begin loop Filtre_D_Entree.File_Entrer (Caractere_Temporaire); case Caractere_Temporaire is when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' => Indice := Indice + 1; Mot_Temporaire (Indice) := Caractere_Temporaire; when Filtre_D_Entree.Termine_Fichier => raise Fin_De_Fichier; when Filtre_D_Entree.Termine_Page => null; when Filtre_D_Entree.Termine_Ligne => if Indice > 0 then Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice)); Le_Numero := Ligne_Courante + 1; Ligne_Courante := Ligne_Courante + 1; return; end if; when others => if Indice > 0 then Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice)); Le_Numero := Ligne_Courante; return; end if; end case; end loop; exception when Text_Io.End_Error => raise Fin_De_Fichier; when Constraint_Error => raise Mot_Trop_Long; end File_Get; ------------------------------------------------------------------------------ procedure Open is begin Text_Io.Set_Input (Text_Io.Standard_Input); exception when others => Text_Io.Put_Line ("Erreur open"); end Open; ------------------------------------------------------------------------------ procedure Close is begin Text_Io.Put_Line ("fin de programme"); Text_Io.Set_Input (Text_Io.Standard_Input); exception when others => Text_Io.Put_Line ("Erreur Close"); end Close; ------------------------------------------------------------------------------ procedure Get (Table_Of_Word : in out Mots.T_Tab_Commande; Number_Of_Words : out Mots.Number) is Num_Of_Words : Mots.Number := 0; Existe_Instruction : Boolean := False; Error_Number : Boolean := False; Tmp_Char : Character; Tmp_Word, Tmp1_Word : Mots.Word; Tmp_String : String (1 .. 80); Line_Len : Natural := 0; Word_Len : Natural := 0; begin Filtre_D_Entree.Enter (Tmp_String, Line_Len); if Line_Len > 0 then Tmp_Word := Nos_Chaines.Unbounded_Value (Tmp_String); for Indice in 1 .. Line_Len loop Tmp_Char := Nos_Chaines.Char_At_Pos (Tmp_Word, Indice); case Tmp_Char is when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' => Nos_Chaines.Infinite_String.Append (Tmp1_Word, Tmp_Char); Word_Len := Word_Len + 1; Existe_Instruction := True; if Indice = Line_Len then if Word_Len > 0 then if Num_Of_Words >= Mots.Max_Number_Words then Error_Number := True; exit; else Num_Of_Words := Num_Of_Words + 1; Nos_Chaines.Copy (Table_Of_Word (Num_Of_Words), Tmp1_Word); Nos_Chaines.Free (Tmp1_Word); Nos_Chaines.Free (Tmp_Word); Word_Len := 0; end if; else if not Existe_Instruction then Table_Of_Word (1) := Nos_Chaines.Unbounded_Value ("nothing"); end if; end if; end if; when others => if Word_Len > 0 then if Num_Of_Words >= Mots.Max_Number_Words then Error_Number := True; exit; else Num_Of_Words := Num_Of_Words + 1; Nos_Chaines.Copy (Table_Of_Word (Num_Of_Words), Tmp1_Word); Nos_Chaines.Free (Tmp1_Word); Word_Len := 0; end if; end if; end case; end loop; if Error_Number then Number_Of_Words := Mots.Max_Number_Words + 1; else Number_Of_Words := Num_Of_Words; end if; else Number_Of_Words := Num_Of_Words; end if; exception when Constraint_Error => raise Mot_Trop_Long; when others => Text_Io.Put_Line ("Erreur get!"); end Get; end Document;
nblk1=a nid=7 hdr6=10 [0x00] rec0=22 rec1=00 rec2=01 rec3=00e [0x01] rec0=11 rec1=00 rec2=08 rec3=00c [0x02] rec0=13 rec1=00 rec2=02 rec3=042 [0x03] rec0=24 rec1=00 rec2=09 rec3=000 [0x04] rec0=19 rec1=00 rec2=03 rec3=062 [0x05] rec0=13 rec1=00 rec2=0a rec3=062 [0x06] rec0=15 rec1=00 rec2=05 rec3=05e [0x07] rec0=10 rec1=00 rec2=06 rec3=000 [0x08] rec0=09 rec1=00 rec2=07 rec3=000 [0x09] rec0=cd rec1=0c rec2=22 rec3=6d2 tail 0x215447d0a86544f1469bd 0x42a00088462060003 Free Block Chain: 0x7: 0000 00 04 00 c1 80 07 63 65 70 74 69 6f 6e 07 00 20 ┆ ception ┆ 0x4: 0000 00 00 00 dd 80 28 20 20 20 20 20 20 20 20 20 20 ┆ ( ┆