|
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: 25600 (0x6400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Scheduler, seg_0573ba
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Byte_Defs, Tableur, Transport,
Transport_Defs, Bounded_String, Trame, Utils;
with Affichage;
use Affichage, Tableur, Bounded_String, Trame, Transport_Defs;
package body Scheduler is
type Identite is new Object;
Buffer_Reception : Tableur.Tache_Tableur;
Id_Rec, Id_Emet : Identite;
Index_Courant : Positive;
Done : Boolean := False;
--*************************************************************************************
task Reception is
entry Go_Reception;
end Reception;
task Emission is
entry Envoi (Message : Byte_Defs.Byte_String);
entry Dispose;
end Emission;
task Majordome is
entry Extract (Num_Requete : in Positive;
Num_Param : in Positive;
Reponse : out String);
entry Request (Message : in String; Num_Requete : out Positive);
entry Answer (Message : Byte_Defs.Byte_String);
entry Registration (Message : in String);
entry Unregistration (Message : in String);
end Majordome;
procedure Init_Socket_Recepteur (S : Transport_Defs.Socket_Id);
procedure Definir_Socket_Recepteur;
--*************************************************************************************
procedure Init_Socket_Recepteur (S : Transport_Defs.Socket_Id) is
begin
Id_Rec.Socket := S;
end Init_Socket_Recepteur;
--*************************************************************************************
procedure Init_Socket_Emetteur (S : Transport_Defs.Socket_Id) is
begin
Id_Emet.Socket := S;
end Init_Socket_Emetteur;
--*************************************************************************************
procedure Definir_Socket_Recepteur is
begin
while not (Transport.Is_Open (Id_Rec.Connection)) loop
Transport.Open (Id_Rec.Connection, Id_Rec.Status,
Id_Rec.Network, Id_Rec.Socket);
end loop;
Id_Rec.Socket := Transport.Local_Socket (Id_Rec.Connection);
end Definir_Socket_Recepteur;
--*************************************************************************************
procedure Definir_Communication_Pour_Objet is
begin
Init_Socket_Emetteur ((10, 46));
Definir_Socket_Recepteur;
end Definir_Communication_Pour_Objet;
--*************************************************************************************
procedure Definir_Communication_Pour_Orb is
begin
Init_Socket_Recepteur ((10, 46));
end Definir_Communication_Pour_Orb;
--*************************************************************************************
procedure Envoi_Demande (Message : in String; Num_Requete : out Positive) is
begin
Majordome.Request (Message, Num_Requete);
end Envoi_Demande;
--**************************************************************************
function Extrait_Parametre (Num_Param : in Positive) return String is
--Renvoie le contenu du sous-champ No. Num_Param, a partir d'un Index connu(Index_Courant)
--...contenu dans le champ "Commande"
Commande : Bounded_String.Variable_String (1024);
Debut : Positive := 1;
Long : Positive;
Compteur : Positive := 1;
begin
--Lecture du champ "commande"...
Buffer_Reception.Donne_String (Index_Courant, 6, Commande);
--Trouve la position du Num_Param'ieme "$" (debut)
while Compteur /= Num_Param + 1 loop
while Bounded_String.Char_At (Commande, Debut) /= '$' loop
Debut := Debut + 1;
end loop;
Compteur := Compteur + 1;
Debut := Debut + 1;
end loop;
--Efface le debut
Bounded_String.Delete (Commande, 1, Debut - 1);
Compteur := 1;
Long := Bounded_String.Length (Commande);
--Trouve la position du prochain "$" (fin)
while Bounded_String.Char_At (Commande, Compteur) /= '$' loop
Compteur := Compteur + 1;
end loop;
--Efface la fin, et retourne la portion demandee (No. Num_Param)
Bounded_String.Delete (Commande, Compteur, Long - Compteur + 1);
return Bounded_String.Image (Commande);
end Extrait_Parametre;
--*************************************************************************************
function Extrait_Reponse
(Num_Requete : in Positive; Num_Param : in Positive)
return String is
--Renvoie le contenu du sous-champ No. Num_Param, a partir du numero de requete
--...contenu dans le champ "Commande"
Commande : Bounded_String.Variable_String (1024);
Contenu : Bounded_String.Variable_String (1024);
Index_Courant : Positive;
Debut : Positive := 1;
Long : Positive;
Compteur : Positive := 1;
Compt : Positive;
Error : Boolean := False;
begin
--Recherche l'Index contenant le numero de requete
Buffer_Reception.Trouve_Index (Num_Requete, Index_Courant, Error);
if Error then
Bounded_String.Copy (Commande, "Erreur");
else
--Le numero de requete etant trouve,
--Lecture du champ "commande"
Buffer_Reception.Donne_String (Index_Courant, 6, Commande);
--Trouve la position du Num_Param'ieme "$" (debut)
while Compteur /= Num_Param + 1 loop
while Bounded_String.Char_At (Commande, Debut) /= '$' loop
Debut := Debut + 1;
end loop;
Compteur := Compteur + 1;
Debut := Debut + 1;
end loop;
--Efface le debut
Bounded_String.Delete (Commande, 1, Debut - 1);
Compteur := 1;
Long := Bounded_String.Length (Commande);
--Trouve la position du prochain "$" (fin)
while Bounded_String.Char_At (Commande, Compteur) /= '$' loop
Compteur := Compteur + 1;
end loop;
--Efface la fin, et retourne la portion demandee (No. Num_Param)
Bounded_String.Delete (Commande, Compteur, Long - Compteur + 1);
end if;
return Bounded_String.Image (Commande);
end Extrait_Reponse;
--*************************************************************************************
procedure Efface_Par_Requete (Num_Requete : in Positive) is
Erreur : Boolean := False;
Index : Positive;
begin
Buffer_Reception.Trouve_Index (Num_Requete, Index, Erreur);
if not (Erreur) then
Buffer_Reception.Efface (Index, Erreur);
end if;
end Efface_Par_Requete;
--*************************************************************************************
procedure Efface_Par_Index (Index : in Positive) is
Erreur : Boolean;
begin
Buffer_Reception.Efface (Index, Erreur);
end Efface_Par_Index;
--*************************************************************************************
procedure Init_Tab_Reception is
begin
Buffer_Reception.Init;
end Init_Tab_Reception;
--*************************************************************************************
procedure Enregistre_Service (Message : in String) is
begin
Majordome.Registration (Message);
end Enregistre_Service;
--*************************************************************************************
procedure Supprime_Service (Message : in String) is
begin
Majordome.Unregistration (Message);
end Supprime_Service;
--*************************************************************************************
procedure Place_Reponse (Index : in Positive; Message : in String) is
Nom_Contrat : Bounded_String.Variable_String (1024);
begin
Buffer_Reception.Donne_Contrat (Index, Nom_Contrat);
Bounded_String.Append (Nom_Contrat, '(' & Message & ')');
Buffer_Reception.Insere_Integer (Index, 1, 2);
--Le 2 indique que la reponse est arrivee (type_msg)
Buffer_Reception.Insere_String (Index, 6, Nom_Contrat);
--Place le message dans le champ Commande
end Place_Reponse;
--*************************************************************************************
procedure Donne_Taille_Buffer_Reception (Taille : out Positive) is
begin
Buffer_Reception.Taille_Max (Taille);
end Donne_Taille_Buffer_Reception;
--*************************************************************************************
procedure Donne_Champ_Type_Integer (Index : in Positive;
Rang : in Positive;
Resultat : in out Integer) is
begin
Buffer_Reception.Donne_Integer (Index, Rang, Resultat);
end Donne_Champ_Type_Integer;
--*************************************************************************************
procedure Accepte_Reception is
begin
Reception.Go_Reception;
end Accepte_Reception;
--*************************************************************************************
procedure Fabrique_Trame (Index : in Positive;
Trame : out Byte_Defs.Byte_String) is
begin
Buffer_Reception.Fait_Trame (Index, Trame);
end Fabrique_Trame;
--*************************************************************************************
procedure Envoi_Trame (Trame : Byte_Defs.Byte_String) is
begin
Emission.Envoi (Trame);
end Envoi_Trame;
--*************************************************************************************
procedure Trouve_Reponse (Codage : in Positive;
Rang : in Positive;
Reponse : out String;
Erreur : in out Boolean) is
Index : Positive;
Rep : Bounded_String.Variable_String (1024);
begin
Buffer_Reception.Trouve_Index (Codage, Index, Erreur);
Buffer_Reception.Donne (Codage, Rang, Rep, Erreur);
Reponse := Bounded_String.Image (Rep);
end Trouve_Reponse;
--*************************************************************************************
task body Reception is
Total, Count : Natural;
Data : Byte_Defs.Byte_String (1 .. 1024);
Etat : Boolean;
Erreur : Boolean;
begin
Id_Rec.Max_Wait := 3.0;
Done := False;
select
accept Go_Reception;
Pl ("Reception: Debut");
loop
-- Arrete la reception si plein
Buffer_Reception.Teste_Plein (Etat);
if not (Etat) then
while not (Transport.Is_Open (Id_Rec.Connection)) and
Id_Rec.Status /= Transport_Defs.Ok loop
Transport.Open (Id_Rec.Connection, Id_Rec.Status,
Id_Rec.Network, Id_Rec.Socket);
end loop;
if Transport.Is_Connected (Id_Rec.Connection) then
Pl ("Reception: Connection etablie");
Count := 0;
while Count = 0 loop
Transport.Receive (Id_Rec.Connection, Id_Rec.Status,
Data, Count, Id_Rec.Max_Wait);
end loop;
Erreur := False;
P ("Message Recu: ");
Pl (Bounded_String.Image (Extrait (Data, 5)));
--Pl (Utils.Byte_String_To_String (Data));
Buffer_Reception.Ajoute (Data, Erreur);
Transport.Disconnect (Id_Rec.Connection);
else
Transport.Connect (Id_Rec.Connection,
Id_Rec.Status, Id_Rec.Max_Wait);
--P (".");
delay 0.5;
end if;
end if;
exit when Done;
end loop;
Transport.Close (Id_Rec.Connection);
end select;
end Reception;
--*************************************************************************************
task body Emission is
Done : Boolean := False;
Compteur_Essais : Positive;
Max_Essais : constant Positive := 10;
Attente : constant Duration := 6.0;
--Duree max. d'attente pour connection = Max_Essais*Attente (=60s)
begin
loop
Compteur_Essais := 1;
select
accept Envoi (Message : Byte_Defs.Byte_String) do
Pl ("Emission: Debut");
while not (Transport.Is_Open (Id_Emet.Connection)) and
Id_Emet.Status /= Transport_Defs.Ok loop
Transport.Open (Id_Emet.Connection,
Id_Emet.Status, Id_Emet.Network);
end loop;
while (not (Transport.Is_Connected
(Id_Emet.Connection))) and
(Compteur_Essais <= Max_Essais) loop
Transport.Connect (Id_Emet.Connection,
Id_Emet.Status, Id_Emet.Host,
Id_Emet.Socket, Id_Emet.Max_Wait);
delay (Attente);
Compteur_Essais := Compteur_Essais + 1;
end loop;
if Transport.Is_Connected (Id_Emet.Connection) then
Pl ("Emission: Connection etablie");
Transport.Transmit (Id_Emet.Connection,
Id_Emet.Status, Message,
Id_Emet.Count, Id_Emet.Max_Wait,
Id_Emet.More_Data);
P ("Message Emis: ");
Pl (Bounded_String.Image (Extrait (Message, 5)));
--P (Bounded_String.Image (Trame.Extrait (Message, 1)));
--P (Bounded_String.Image (Trame.Extrait (Message, 2)));
--P (Bounded_String.Image (Trame.Extrait (Message, 3)));
--P (Bounded_String.Image (Trame.Extrait (Message, 4)));
--P (Bounded_String.Image (Trame.Extrait (Message, 5)));
end if;
Transport.Disconnect (Id_Emet.Connection);
end Envoi;
or
accept Dispose do
Transport.Close (Id_Emet.Connection);
Done := True;
end Dispose;
end select;
exit when Done;
end loop;
end Emission;
--*************************************************************************************
task body Majordome is
Texte : Variable_String (1024);
Code : Positive := 1000;
Type_Message : Positive;
Erreur : Boolean;
Index : Positive;
begin
loop
select
accept Request (Message : in String;
Num_Requete : out Positive) do
if Code < 999 then
Code := Code + 1;
else
Code := 1;
end if;
Num_Requete := Code;
Type_Message := 1;
Emission.Envoi (Trame.Fait_Trame
(Type_Message, Fait_Host (Id_Rec.Host),
Fait_Socket (Id_Rec.Socket),
Code, Value (Message)));
end Request;
or
accept Extract (Num_Requete : in Positive;
Num_Param : in Positive;
Reponse : out String) do
Buffer_Reception.Donne
(Num_Requete, Num_Param, Texte, Erreur);
Reponse := Image (Texte);
end Extract;
or
accept Answer (Message : Byte_Defs.Byte_String) do
Emission.Envoi (Message);
end Answer;
or
accept Registration (Message : in String) do
Type_Message := 3;
Emission.Envoi (Trame.Fait_Trame
(Type_Message, Fait_Host (Id_Rec.Host),
Fait_Socket (Id_Rec.Socket),
1001, Value (Message)));
end Registration;
or
accept Unregistration (Message : in String) do
Type_Message := 4;
Emission.Envoi (Trame.Fait_Trame
(Type_Message, Fait_Host (Id_Rec.Host),
Fait_Socket (Id_Rec.Socket),
1002, Value (Message)));
end Unregistration;
end select;
exit when Done;
end loop;
end Majordome;
end Scheduler;
nblk1=18
nid=e
hdr6=2c
[0x00] rec0=1e rec1=00 rec2=01 rec3=022
[0x01] rec0=00 rec1=00 rec2=02 rec3=03a
[0x02] rec0=17 rec1=00 rec2=06 rec3=06a
[0x03] rec0=19 rec1=00 rec2=12 rec3=096
[0x04] rec0=1a rec1=00 rec2=11 rec3=056
[0x05] rec0=18 rec1=00 rec2=0d rec3=02c
[0x06] rec0=1a rec1=00 rec2=10 rec3=034
[0x07] rec0=1b rec1=00 rec2=09 rec3=060
[0x08] rec0=08 rec1=00 rec2=08 rec3=00e
[0x09] rec0=17 rec1=00 rec2=15 rec3=060
[0x0a] rec0=15 rec1=00 rec2=0a rec3=034
[0x0b] rec0=18 rec1=00 rec2=13 rec3=04a
[0x0c] rec0=19 rec1=00 rec2=03 rec3=056
[0x0d] rec0=11 rec1=00 rec2=0f rec3=076
[0x0e] rec0=01 rec1=00 rec2=0c rec3=088
[0x0f] rec0=1a rec1=00 rec2=04 rec3=006
[0x10] rec0=11 rec1=00 rec2=07 rec3=034
[0x11] rec0=12 rec1=00 rec2=17 rec3=036
[0x12] rec0=1a rec1=00 rec2=16 rec3=05a
[0x13] rec0=03 rec1=00 rec2=05 rec3=050
[0x14] rec0=15 rec1=00 rec2=0b rec3=016
[0x15] rec0=0e rec1=00 rec2=14 rec3=000
[0x16] rec0=10 rec1=00 rec2=07 rec3=000
[0x17] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21764260a87c7488553b6 0x42a00088462060003
Free Block Chain:
0xe: 0000 00 18 03 fc 80 32 20 20 20 20 20 20 20 20 20 20 ┆ 2 ┆
0x18: 0000 00 00 00 0b 80 08 20 20 20 20 20 20 20 20 08 09 ┆ ┆