|
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 - download
Length: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Document, seg_042e02
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Filtre_D_Entree;
package body Document is
Mot_Courant : Nombre_De_Mots.Numero := 0;
Ligne_Courante : Numeros_De_Lignes.Numero := 1;
The_File : Text_Io.File_Type;
Existe_Instruction : Boolean := False;
------------------------------------------------------------------------------
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 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;
------------------------------------------------------------------------------
procedure File_Get (Le_Mot : out Mots.Mot;
Le_Numero : out Numeros_De_Lignes.Numero) is
Caractere_Temporaire : Character;
Mot_Temporaire : String (1 .. 80);
Indice : Natural := 0;
function "+" (X, Y : in Numeros_De_Lignes.Numero)
return Numeros_De_Lignes.Numero
renames Numeros_De_Lignes."+";
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;
---------------------------------------------------------------------------
function En_Fin_De_Fichier return Boolean is
begin
return Text_Io.End_Of_File;
end En_Fin_De_Fichier;
------------------------------------------------------------------------------
--procedure purger_mot_courant is
--begin
-- if mot_courant <= 4 then
-- mot_courant := 0;
-- end if;
-- Mot_Temporaire(1..80) := (others=>' ');
-- Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice));
--end purger_mot_courant;
procedure Purger is
begin
Mot_Courant := 0;
Existe_Instruction := False;
end Purger;
------------------------------------------------------------------------------
procedure Get (Le_Nombre : out Nombre_De_Mots.Numero;
Ligne_Fini : out Boolean;
Tab_Chaine : out Pstring) is
Caractere_Temporaire : Character;
Ligne_Temporaire : String (1 .. 80);
Mot_Temporaire : String (1 .. 80);
Le_Mot : Mots.Mot;
type Tableau_String is access String;
Tab_Str : Tableau_String (1 .. 4);
Indice : Natural := 0;
Indice_Tableau : Natural := 0;
Last_Car : Natural := 0;
begin
Ligne_Fini := False;
Filtre_D_Entree.Entrer (Ligne_Temporaire, Last_Car);
for I in 1 .. Last_Car loop
case Ligne_Temporaire (I) is
when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' =>
Indice := Indice + 1;
Mot_Temporaire (Indice) := Caractere_Temporaire;
Existe_Instruction := True;
when Filtre_D_Entree.Termine_Ligne =>
Ligne_Fini := True;
if Indice > 0 then
Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice));
Indice_Tableau := Indice_Tableau + 1;
Tab_Chaine (Indice_Tableau) := Le_Mot;
Mot_Courant := Mot_Courant + 1;
Le_Nombre := Mot_Courant;
Purger;
return;
else
Mots.Creer (Le_Mot, "nothing");
if not Existe_Instruction then
Text_Io.Put_Line ("Il n'y a rien");
Purger;
Le_Nombre := Mot_Courant;
return;
else
Purger;
Le_Nombre := Mot_Courant;
return;
end if;
end if;
when others =>
if Indice > 0 then
Mot_Courant := Mot_Courant + 1;
Le_Nombre := Mot_Courant;
if Mot_Courant > 4 then
Purger;
end if;
Mots.Creer (Le_Mot, Mot_Temporaire (1 .. Indice));
return;
end if;
end case;
end loop;
exception
when Constraint_Error =>
raise Mot_Trop_Long;
when others =>
Text_Io.Put_Line ("Erreur get!");
end Get;
end Document;
nblk1=9
nid=5
hdr6=e
[0x00] rec0=23 rec1=00 rec2=01 rec3=012
[0x01] rec0=1e rec1=00 rec2=08 rec3=004
[0x02] rec0=16 rec1=00 rec2=02 rec3=03e
[0x03] rec0=20 rec1=00 rec2=06 rec3=018
[0x04] rec0=1c rec1=00 rec2=03 rec3=05e
[0x05] rec0=15 rec1=00 rec2=04 rec3=016
[0x06] rec0=19 rec1=00 rec2=07 rec3=000
[0x07] rec0=12 rec1=00 rec2=08 rec3=000
[0x08] rec0=11 rec1=00 rec2=03 rec3=000
tail 0x21743af0a8631600dd51c 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 09 00 04 80 01 6e 01 02 03 04 20 20 20 54 65 ┆ n Te┆
0x9: 0000 00 00 00 12 00 0f 20 20 20 20 20 20 20 20 54 65 ┆ Te┆