|
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, procedure Prog_Date, seg_03decb
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Prog_Date;
with Text_Io;
with Device_Independent_Io;
with System;
use Text_Io;
procedure Prog_Date is
type J is (Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi, Dimanche);
type M is (Janvier, Fevrier, Mars, Avril, Mai, Juin, Juillet,
Aout, Septembre, Octobre, Novembre, Decembre);
subtype D is Positive range 1 .. 31;
subtype A is Positive range 1000 .. 3000;
Date : D;
An_Biss, Nb_An, Last, Nb_An_Biss, Nb_J : Natural;
Jour : J;
Annee : A;
Ch : String (1 .. 35);
Z : Natural range 0 .. 12;
Mois : M;
--*************************************************
procedure Lecture (Date : in out D;
Last : in out Natural;
Mo : out M;
Annee : in out A) is
K : Integer range 0 .. 2;
Aux, I, U : Natural;
begin
loop
begin
K := 0;
U := 0;
Aux := 1;
Put ("Entrer la date: ");
Text_Io.Get_Line (Ch, Last);
Skip_Line;
Put ("Date entree");
for I in 1 .. Last loop
if (Ch (I) = ' ') and (I = 1) and (Ch (I + 1) = ' ') then
U := 0;
end if;
if (Ch (I) = ' ') and (I = 1) and (Ch (I + 1) /= ' ') then
Aux := I + 1;
end if;
if (I > 1) and then
((Ch (I - 1) = ' ') and (Ch (I) = ' ') and
(Ch (I + 1) = ' ')) then
U := 0;
end if;
if (I > 1) and then
((Ch (I - 1) /= ' ') and (Ch (I) = ' ') and
(Ch (I + 1) = ' ')) then
U := 1;
end if;
if (I > 1) and then
((Ch (I - 1) = ' ') and (Ch (I) = ' ') and
(Ch (I + 1) /= ' ')) then
U := 1;
end if;
if (I > 1) and then
((Ch (I - 1) /= ' ') and (Ch (I) = ' ') and
(Ch (I + 1) /= ' ')) then
U := 1;
end if;
if I = Last then
Annee := A'Value (Ch (Aux .. I));
exit;
end if;
if (Ch (I) = ' ') and (K < 3) and (U = 1) then
case K is
when 0 =>
Date := D'Value (Ch (Aux .. (I - 1)));
K := K + 1;
when 1 =>
Mo := M'Value (Ch (Aux .. (I - 1)));
K := K + 1;
when 2 =>
Annee := A'Value (Ch (Aux .. I));
exit;
K := K + 1;
when others =>
null;
end case;
end if;
if (I > 1) and then
((Ch (I - 1) /= ' ') and (Ch (I) = ' ') and
(Ch (I + 1) /= ' ')) then
Aux := I + 1;
end if;
end loop;
exit;
exception
when Constraint_Error =>
New_Line;
Put_Line ("date incorrecte...");
New_Line;
end;
end loop;
end Lecture;
begin
loop
loop
Lecture (Date, Last, Mois, Annee);
Nb_An := Annee - 1901;
An_Biss := (Nb_An) mod (4);
case Mois is
when Avril | Juin | Septembre | Novembre =>
if Date > 30 then
Put ("date incorrecte");
New_Line;
else
exit;
end if;
when Fevrier =>
if An_Biss = 3 then
if Date > 29 then
Put ("date incorrecte");
New_Line;
else
exit;
end if;
else
if Date > 28 then
Put ("date incorrecte");
New_Line;
else
exit;
end if;
end if;
when others =>
exit;
end case;
end loop;
if (Annee < 1901) or (Annee > 2000) then
exit;
end if;
Nb_An_Biss := Nb_An / 4;
if (An_Biss = 3) and (Mois > Fevrier) then
Nb_J := ((Nb_An - Nb_An_Biss) * 365) + (Nb_An_Biss * 366) + 1;
else
Nb_J := ((Nb_An - Nb_An_Biss) * 365) + (Nb_An_Biss * 366);
end if;
case Mois is
when Fevrier =>
Nb_J := Nb_J + 31;
when Mars =>
Nb_J := Nb_J + 59;
when Avril =>
Nb_J := Nb_J + 90;
when Mai =>
Nb_J := Nb_J + 120;
when Juin =>
Nb_J := Nb_J + 151;
when Juillet =>
Nb_J := Nb_J + 181;
when Aout =>
Nb_J := Nb_J + 212;
when Septembre =>
Nb_J := Nb_J + 243;
when Octobre =>
Nb_J := Nb_J + 273;
when Novembre =>
Nb_J := Nb_J + 304;
when Decembre =>
Nb_J := Nb_J + 334;
when others =>
null;
end case;
Put ("le ");
Put (Ch (1 .. Last));
Put (" est un ");
Put (J'Image (Jour));
New_Line;
end loop;
end Prog_Date;
nblk1=9
nid=4
hdr6=10
[0x00] rec0=24 rec1=00 rec2=01 rec3=02e
[0x01] rec0=1d rec1=00 rec2=09 rec3=030
[0x02] rec0=01 rec1=00 rec2=03 rec3=07a
[0x03] rec0=19 rec1=00 rec2=02 rec3=048
[0x04] rec0=1d rec1=00 rec2=08 rec3=03c
[0x05] rec0=1b rec1=00 rec2=06 rec3=060
[0x06] rec0=26 rec1=00 rec2=05 rec3=03e
[0x07] rec0=10 rec1=00 rec2=07 rec3=001
[0x08] rec0=bf rec1=94 rec2=00 rec3=005
tail 0x21536a7e685fd6e1313d2 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 00 00 4e 80 0b 31 29 20 61 6e 64 20 74 68 65 ┆ N 1) and the┆