|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 28407 (0x6ef7)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
with Context;
with Instance;
with Tuple_Collection;
with Text_Io;
package body Debugger is
Any : Natural := Natural'Last;
Textmode : Boolean := True;
-- TRUE if 100 % text mode, FALSE if 100 % graphic
Graffortext : Boolean := False;
-- TRUE if we are passing for N step in graphic mode
First_Menu : Boolean := False;
-- TRUE when 1st context entered has try to start menu
Was_Called : Boolean := False;
-- TRUE when someone has explicitly call the debugger
type Option_Array is array (Item_Debugged) of Boolean;
Debugger_Options : Option_Array;
Counter : Natural := 0;
Last_Context : Context.Reference := 1;
Last_Number : Context.Rule_Id := 1;
Current_Context : Context.Reference := 1;
Last_Context_Entered : Context.Reference := 0;
Bell : constant Character := Character'Val (7);
Aaah : constant Natural := Character'Pos ('A');
Space : constant Natural := Character'Pos (' ');
Zero : constant Natural := Character'Pos ('0');
package Int_Io is new Text_Io.Integer_Io (Integer);
First_Item : constant Item_Debugged := Context_Entered;
Last_Item : constant Item_Debugged := Action_Fact;
Graphic_Option : Natural := Item_Debugged'Pos (Last_Item) + 1;
Continue_Option : Natural := Item_Debugged'Pos (Last_Item) + 2;
Run_Option : Natural := Item_Debugged'Pos (Last_Item) + 3;
Break_Point_Option : Natural := Item_Debugged'Pos (Last_Item) + 4;
Run_All_Option : Natural := Item_Debugged'Pos (Last_Item) + 5;
List_Option : Natural := Item_Debugged'Pos (Last_Item) + 6;
Exit_Option : Natural := Item_Debugged'Pos (Last_Item) + 7;
subtype Command_Name is String (1 .. 22);
Cmd_Name : array (Item_Debugged) of Command_Name :=
("ENTREE EN CONTEXTE ", "STRATEGIE UTILISEE ",
"DEBUT ENS. DE CONFLIT ", "FIN ENS. DE CONFLIT ",
"CONDITIONS EVALUEES ", "REGLES CHOISIES ",
"ACTIONS CHOISIES ", "INSTANCES DES REGLES ",
"INSTANCE DES ACTIONS ",
others => " ");
Step_To_Jump : Natural := 1;
Step_Counter : Natural := 0;
type Bp_Info is
record
Bp_Rule_Number : Context.Rule_Id := 0;
Bp_Context_Number : Context.Reference := 0;
Bp_Times_Number : Natural := 0;
Bp_Counter : Natural := 0;
Bp_Used : Boolean := False;
end record;
Bp_List : array (Context.Reference) of Bp_Info;
Bp_Count : Natural := 0;
Bp_Options : Option_Array;
Bp_Saved : Boolean := False;
package Dbtext is
procedure Send_Context_Entered (With_Number : Context.Reference);
procedure Send_Strategy_Used (With_Name : Context.Strategy);
procedure Send_Conflict_Set_Started;
procedure Send_Conflict_Set_Finished;
procedure Send_Condition_Evalued (In_Context : Context.Reference;
With_Rule : Context.Rule_Id;
Result : Boolean;
Facts : Tuple_Collection.Object);
procedure Send_Choosed_Rule (In_Context : Context.Reference;
The_Rule : Context.Rule_Id;
The_Fact : Tuple.Object);
procedure Send_Choosed_Action (In_Context : Context.Reference;
The_Rule : Context.Rule_Id;
The_Fact : Tuple.Object);
procedure Send_New_Step;
procedure Send_Failed;
procedure Reset_Debug;
procedure Refresh_Debug;
end Dbtext;
------------------------------------------------------------------------------
procedure Menu_List is
A_Context : Context.Reference;
Touche : Character;
Integer_Value : Integer;
begin
Text_Io.New_Line;
Text_Io.New_Line;
Text_Io.Put_Line ("------------------------");
Text_Io.Put_Line ("LISTE ET ETAT DES REGLES");
Text_Io.Put_Line ("------------------------");
Text_Io.New_Line;
Text_Io.Put ("Donnez le numero du contexte desire 1 .." &
Integer'Image (Context.Max_Context) & " > ");
Int_Io.Get (Integer_Value);
Text_Io.Put (" Le nom de ce contexte est : ");
if Integer_Value <= 0 or Integer_Value > Context.Max_Context then
Text_Io.Put_Line ("CONTEXT_ILLEGAL");
else
A_Context := Context.Reference (Integer_Value);
Text_Io.Put_Line (Context.Image (A_Context));
if Context.Image (A_Context) /= "CONTEXT_INCONNU" then
Text_Io.Put_Line (" Les regles sont :");
Text_Io.Put_Line (" -----------------");
for I in 1 .. Context.Max_Rule loop
if I < 10 then
Text_Io.Put (" " & Integer'Image (I) & " ");
else
Text_Io.Put (" " & Integer'Image (I) & " ");
end if;
if Context.Is_Masked (In_Context => A_Context,
The_Rule => Context.Rule_Id (I)) then
Text_Io.Put (" (M) ");
else
Text_Io.Put (" (-) ");
end if;
Text_Io.Put_Line
(" : " & Context.Get (In_Context => A_Context,
The_Rule => Context.Rule_Id (I)));
end loop;
end if;
end if;
Text_Io.New_Line;
Text_Io.Put
("Pressez <S> et <RETURN> pour revenir au MENU du DEBUGGER > ");
Text_Io.Get (Touche);
end Menu_List;
------------------------------------------------------------------------------
procedure Menu_Break is
use Context;
Integer_Value : Integer;
A_Point : Integer;
begin
loop
Text_Io.New_Line;
Text_Io.New_Line;
Text_Io.Put_Line ("-----------------------");
Text_Io.Put_Line ("MENU DES POINTS D'ARRET");
Text_Io.Put_Line ("-----------------------");
Text_Io.New_Line;
Text_Io.Put_Line
(" Repondre 0,0,xxx pour desarmer un point d'arret");
Text_Io.New_Line;
Text_Io.Put_Line
("===========================================================+");
Text_Io.Put_Line
(" Numero Numero Numero Compteur Maxi Etat ");
Text_Io.Put_Line
(" Point Regle Contexte Passage Passage Point");
Text_Io.Put_Line
("===========================================================+");
Text_Io.New_Line;
for I in 1 .. Context.Reference'Last loop
Text_Io.Put (" " & Context.Reference'Image (I));
Text_Io.Put (" " & Context.Rule_Id'Image
(Bp_List (I).Bp_Rule_Number));
Text_Io.Put (" " & Context.Reference'Image
(Bp_List (I).Bp_Context_Number));
Text_Io.Put (" " & Integer'Image
(Bp_List (I).Bp_Counter));
Text_Io.Put (" " & Integer'Image
(Bp_List (I).Bp_Times_Number));
if Bp_List (I).Bp_Used then
Text_Io.Put_Line (" ON");
else
Text_Io.Put_Line (" OFF");
end if;
end loop;
Text_Io.Put (" Numero du point d'arret (1 .." &
Integer'Image (Context.Max_Context) &
") ou (0 pour sortir) >");
Int_Io.Get (A_Point);
if A_Point >= 1 and A_Point <= Context.Max_Context then
Text_Io.New_Line;
Text_Io.Put
(" Indiquer les caracteristiques du POINT d'ARRET No ");
Text_Io.Put_Line (Integer'Image (A_Point));
Text_Io.New_Line;
Text_Io.Put
(" Numero de la regle a attendre (0) ou (1- 30) ==>");
Int_Io.Get (Integer_Value);
Bp_List (A_Point).Bp_Rule_Number :=
Context.Rule_Id (Integer_Value);
Text_Io.Put (" Numero du contexte concerne (0) ou (1-"
& Integer'Image (Context.Max_Context) & ") ==>");
Int_Io.Get (Integer_Value);
Bp_List (A_Point).Bp_Context_Number :=
Context.Reference (Integer_Value);
Text_Io.Put
(" Nombre de passage avant arret (0 ou +) ==>");
Int_Io.Get (Integer_Value);
Bp_List (A_Point).Bp_Times_Number := Integer_Value;
Text_Io.New_Line;
Bp_List (A_Point).Bp_Counter := 0;
if Bp_List (A_Point).Bp_Rule_Number = Context.Null_Rule and
Bp_List (A_Point).Bp_Context_Number =
Context.Null_Reference then
Bp_List (A_Point).Bp_Used := False;
Bp_Count := Bp_Count - 1;
else
Bp_List (A_Point).Bp_Used := True;
Bp_Count := Bp_Count + 1;
end if;
else
if A_Point = 0 then
exit;
end if;
end if;
end loop;
end Menu_Break;
------------------------------------------------------------------------------
procedure Main_Menu is
Letter : Natural;
Choice : Character;
Program_End : exception;
procedure Turntograf is
begin
Text_Io.Put (" Combien de pas (1..32000) >");
Int_Io.Get (Step_To_Jump);
Textmode := False;
Graffortext := True;
if Bp_Saved = False then
Bp_Options := Debugger_Options;
Debugger_Options := (others => True);
end if;
end Turntograf;
procedure Jump_N_Step is
begin
Text_Io.Put (" Combien de pas (1..32000) >");
if Bp_Saved = False then
Bp_Options := Debugger_Options;
Bp_Saved := True;
Debugger_Options := (others => False);
Debugger_Options (Choosed_Rule) := True;
end if;
Int_Io.Get (Step_To_Jump);
end Jump_N_Step;
begin
loop
Text_Io.New_Line;
Text_Io.Put_Line
("********************************************************************************");
Text_Io.Put
(" MENU DEBUGGER COMPTE-TOUR MOTEUR : ");
Text_Io.Put_Line (Integer'Image (Counter));
Text_Io.Put_Line
("********************************************************************************");
Text_Io.New_Line;
for I in First_Item .. Last_Item loop
Text_Io.Put (Character'Val (Aaah + Item_Debugged'Pos (I)) &
" : " & Cmd_Name (I));
if Debugger_Options (I) then
Text_Io.Put (" oui ");
else
Text_Io.Put (" non ");
end if;
if (Item_Debugged'Pos (I) mod 2) = 1 then
Text_Io.New_Line;
end if;
Letter := Item_Debugged'Pos (I);
end loop;
Text_Io.New_Line;
-- Text_Io.Put (Character'Val (Aaah + Graphic_Option) & " : " &
-- "pour CONTINUER de X pas en GRAPHIQUE");
Text_Io.Put (Character'Val (Aaah + Continue_Option) &
" : " & "pour CONTINUER de 1 pas ");
Text_Io.Put_Line (Character'Val (Aaah + Run_Option) &
" : " & "pour CONTINUER de X pas");
Text_Io.Put (Character'Val (Aaah + Break_Point_Option) &
" : " & "pour le menu des POINTS D'ARRET ");
Text_Io.Put_Line (Character'Val (Aaah + Run_All_Option) &
" : " & ("pour TOUT lancer"));
Text_Io.Put (Character'Val (Aaah + List_Option) & " : " &
"pour la liste d'ETAT des REGLES ");
Text_Io.Put_Line (Character'Val (Aaah + Exit_Option) &
" : " & "pour TOUT ARRETER");
Text_Io.New_Line;
Text_Io.Put (" Votre choix S.V.P. > ");
Text_Io.Get (Choice);
if Choice >= 'a' and Choice <= 'z' then
Letter := Character'Pos (Choice) - Aaah - Space;
elsif Choice >= 'A' and Choice <= 'Z' then
Letter := Character'Pos (Choice) - Aaah;
else
Letter := 999;
end if;
if Letter >= Item_Debugged'Pos (First_Item) and
Letter <= Item_Debugged'Pos (Last_Item) then
Debugger_Options (Item_Debugged'Val (Letter)) :=
not Debugger_Options (Item_Debugged'Val (Letter));
else
if Letter = Exit_Option then
raise Program_End;
elsif Letter = Graphic_Option then
Turntograf;
exit;
elsif Letter = Continue_Option then
Step_To_Jump := 1;
exit;
elsif Letter = Run_Option then
Jump_N_Step;
exit;
elsif Letter = Break_Point_Option then
Menu_Break;
elsif Letter = List_Option then
Menu_List;
elsif Letter = Run_All_Option then
Step_To_Jump := Any;
exit;
else
Text_Io.Put (Bell);
end if;
end if;
end loop;
Text_Io.New_Line;
exception
when Program_End =>
Text_Io.New_Line;
Text_Io.New_Line;
Text_Io.Put_Line
("********************************************************************************");
Text_Io.Put_Line
("*** FIN DU DEBUGGER ***");
Text_Io.Put_Line
("********************************************************************************");
raise Program_End;
end Main_Menu;
------------------------------------------------------------------------------
procedure Break_Points_Update (Number : Context.Rule_Id) is
begin
if Bp_Count /= 0 then
for I in 1 .. Context.Reference'Last loop
if Bp_List (I).Bp_Context_Number = Last_Context_Entered and
Bp_List (I).Bp_Rule_Number = Number
then
Bp_List (I).Bp_Counter := Bp_List (I).Bp_Counter + 1;
end if;
end loop;
end if;
end Break_Points_Update;
------------------------------------------------------------------------------
function Break_Points_Arrived return Boolean is
begin
if Bp_Count = 0 then
return False;
else
for I in 1 .. Context.Reference'Last loop
if Bp_List (I).Bp_Counter >= Bp_List (I).Bp_Times_Number and
Bp_List (I).Bp_Counter /= 0 and Bp_List (I).Bp_Used then
Bp_List (I).Bp_Counter := 0;
Text_Io.Put (Bell);
Text_Io.Put_Line ("D# *******************************");
Text_Io.Put_Line ("D# *** POINT D'ARRET RENCONTRE ***");
Text_Io.Put_Line ("D# *******************************");
return True;
end if;
end loop;
return False;
end if;
end Break_Points_Arrived;
--============================================================================
package body Dbtext is
procedure Display_Ref (The_Reference : Instance.Reference) is
begin
Text_Io.Put (Instance.Isa (The_Reference));
Text_Io.Put (". ");
Text_Io.Put (Instance.Image (The_Reference));
Text_Io.Put (" / ");
end Display_Ref;
------------------------------------------------------------------------------
procedure Display_For_All_Tuple is new Tuple.For_All (Display_Ref);
procedure Display_Tuple (For_Tuple : Tuple.Object) is
begin
Text_Io.Put ("D# Instance : ");
Display_For_All_Tuple (For_Tuple);
Text_Io.New_Line;
end Display_Tuple;
procedure Display_For_All_Tuple_Collection is
new Tuple_Collection.For_All (Display_Ref);
procedure Display_Tuple_Collection
(For_Tuple_Collection : Tuple_Collection.Object) is
begin
Text_Io.Put_Line ("D# Instances de tuples : ");
Text_Io.Put (" ");
Display_For_All_Tuple_Collection (For_Tuple_Collection);
Text_Io.New_Line;
end Display_Tuple_Collection;
------------------------------------------------------------------------------
procedure Send_Context_Entered (With_Number : Context.Reference) is
begin
-- if With_Number /= Last_Context_Entered then
Last_Context_Entered := With_Number;
if Debugger_Options (Context_Entered) then
Text_Io.New_Line;
Text_Io.Put ("D# Nouveau contexte No ");
Text_Io.Put (Context.Reference'Image (With_Number));
Text_Io.Put (" : ");
Text_Io.Put_Line (Context.Image (With_Number));
end if;
-- end if;
if not First_Menu then
if Was_Called then
Main_Menu;
end if;
First_Menu := True;
end if;
end Send_Context_Entered;
------------------------------------------------------------------------------
procedure Send_Strategy_Used (With_Name : Context.Strategy) is
begin
if Debugger_Options (Strategy_Used) then
Text_Io.Put ("D# Strategie utilisee : ");
Text_Io.Put_Line (Context.Strategy'Image (With_Name));
end if;
end Send_Strategy_Used;
------------------------------------------------------------------------------
procedure Send_Conflict_Set_Started is
begin
if Debugger_Options (Conflict_Set_Started) then
Text_Io.New_Line;
Text_Io.Put_Line
("D# Construction de l'ensemble de conflit ... ");
end if;
end Send_Conflict_Set_Started;
------------------------------------------------------------------------------
procedure Send_Conflict_Set_Finished is
begin
if Debugger_Options (Conflict_Set_Finished) then
Text_Io.Put_Line ("D# Ensemble de conflit termine.");
Text_Io.New_Line;
end if;
end Send_Conflict_Set_Finished;
------------------------------------------------------------------------------
procedure Send_Condition_Evalued (In_Context : Context.Reference;
With_Rule : Context.Rule_Id;
Result : Boolean;
Facts : Tuple_Collection.Object) is
begin
if Debugger_Options (Condition_Evalued) then
Text_Io.Put ("D# Evaluation regle No ");
Text_Io.Put (Context.Rule_Id'Image (With_Rule));
if Result then
Text_Io.Put (" => VRAI : ");
else
Text_Io.Put (" => FAUX : ");
end if;
Text_Io.Put_Line (Context.Get (In_Context, With_Rule));
end if;
if Debugger_Options (Rule_Facts) and
Tuple_Collection.Is_Not_Null (Facts) then
Text_Io.Put_Line ("D# Faits impliques :");
Display_Tuple_Collection (Facts);
end if;
end Send_Condition_Evalued;
------------------------------------------------------------------------------
procedure Send_Choosed_Rule (In_Context : Context.Reference;
The_Rule : Context.Rule_Id;
The_Fact : Tuple.Object) is
begin
Break_Points_Update (The_Rule);
if Debugger_Options (Choosed_Rule) and Step_To_Jump = 1 then
Text_Io.Put ("D# Regle choisie : No ");
Text_Io.Put (Context.Rule_Id'Image (The_Rule));
Text_Io.New_Line;
end if;
if Debugger_Options (Rule_Facts) and
not Tuple.Is_Null (The_Fact) then
Text_Io.Put_Line ("D# Faits impliques :");
Display_Tuple (The_Fact);
end if;
if Break_Points_Arrived then
if Bp_Saved then
Debugger_Options := Bp_Options;
Bp_Saved := False;
end if;
Main_Menu;
Step_Counter := 0;
end if;
end Send_Choosed_Rule;
------------------------------------------------------------------------------
procedure Send_Choosed_Action (In_Context : Context.Reference;
The_Rule : Context.Rule_Id;
The_Fact : Tuple.Object) is
begin
if Debugger_Options (Choosed_Action) then
Text_Io.New_Line;
Text_Io.Put ("D# Action executee : No ");
Text_Io.Put (Context.Rule_Id'Image (The_Rule));
Text_Io.Put (" = ");
Text_Io.Put_Line (Context.Get (In_Context, The_Rule));
end if;
if Debugger_Options (Action_Fact) and
not Tuple.Is_Null (The_Fact) then
Text_Io.Put_Line ("D# Fait concerne :");
Display_Tuple (The_Fact);
end if;
end Send_Choosed_Action;
------------------------------------------------------------------------------
procedure Send_New_Step is
begin
if Counter >= Natural'Last then
Counter := 0;
end if;
Counter := Counter + 1;
if Debugger_Options (New_Step) and Step_To_Jump = 1 then
Text_Io.Put ("D# Compte-tour moteur : ");
Text_Io.Put (Integer'Image (Counter));
Text_Io.New_Line;
end if;
Step_Counter := Step_Counter + 1;
if Step_Counter = Step_To_Jump then
if Bp_Saved then
Debugger_Options := Bp_Options;
Bp_Saved := False;
end if;
Main_Menu;
Step_Counter := 0;
end if;
end Send_New_Step;
------------------------------------------------------------------------------
procedure Send_Failed is
begin
if Debugger_Options (Failed) or Step_To_Jump /= 1 then
Text_Io.Put ("D# Plus de regle valide. ");
Text_Io.New_Line;
end if;
end Send_Failed;
------------------------------------------------------------------------------
procedure Reset_Debug is
begin
Set_Debug_Off (Completly);
Counter := 0;
Step_To_Jump := 1;
Step_Counter := 0;
Last_Context_Entered := Context.Null_Reference;
for I in Context.Reference loop
Bp_List (I).Bp_Used := False;
end loop;
Bp_Count := 0;
Bp_Saved := False;
end Reset_Debug;
------------------------------------------------------------------------------
procedure Refresh_Debug is
begin
null;
end Refresh_Debug;
end Dbtext;
--============================================================================
procedure Send_Context_Entered (With_Number : Context.Reference) is
begin
Dbtext.Send_Context_Entered (With_Number);
end Send_Context_Entered;
procedure Send_Strategy_Used (With_Name : Context.Strategy) is
begin
Dbtext.Send_Strategy_Used (With_Name);
end Send_Strategy_Used;
procedure Send_Conflict_Set_Started is
begin
Dbtext.Send_Conflict_Set_Started;
end Send_Conflict_Set_Started;
procedure Send_Conflict_Set_Finished is
begin
Dbtext.Send_Conflict_Set_Finished;
end Send_Conflict_Set_Finished;
procedure Send_Condition_Evalued (In_Context : Context.Reference;
With_Rule : Context.Rule_Id;
Result : Boolean;
Facts : Tuple_Collection.Object) is
begin
Dbtext.Send_Condition_Evalued (In_Context, With_Rule, Result, Facts);
end Send_Condition_Evalued;
procedure Send_Choosed_Rule (In_Context : Context.Reference;
The_Rule : Context.Rule_Id;
The_Fact : Tuple.Object) is
begin
Dbtext.Send_Choosed_Rule (In_Context, The_Rule, The_Fact);
end Send_Choosed_Rule;
procedure Send_Choosed_Action (In_Context : Context.Reference;
The_Rule : Context.Rule_Id;
The_Fact : Tuple.Object) is
begin
Dbtext.Send_Choosed_Action (In_Context, The_Rule, The_Fact);
end Send_Choosed_Action;
procedure Send_New_Step is
begin
Dbtext.Send_New_Step;
end Send_New_Step;
procedure Send_Failed is
begin
Dbtext.Send_Failed;
end Send_Failed;
procedure Refresh_Debug is
begin
Dbtext.Refresh_Debug;
end Refresh_Debug;
function Is_Debugged (What : Item_Debugged) return Boolean is
begin
return Debugger_Options (What);
end Is_Debugged;
procedure Set_Debug_On (Item : Item_Debugged) is
begin
if Item = Completly then
for I in Item_Debugged loop
Debugger_Options (I) := True;
end loop;
else
Debugger_Options (Item) := True;
end if;
end Set_Debug_On;
procedure Set_Debug_On (Item : Item_Set) is
begin
for I in Item'Range loop
Set_Debug_On (Item (I));
end loop;
end Set_Debug_On;
procedure Set_Debug_Off (Item : Item_Debugged) is
begin
if Item = Completly then
for I in Item_Debugged loop
Debugger_Options (I) := False;
end loop;
else
Debugger_Options (Item) := False;
end if;
end Set_Debug_Off;
procedure Set_Debug_Off (Item : Item_Set) is
begin
for I in Item'Range loop
Set_Debug_Off (Item (I));
end loop;
end Set_Debug_Off;
procedure Reset_Debug (Mode : Debugging_Mode) is
begin
Graffortext := False;
Was_Called := True;
if Mode = Text then
Textmode := True;
First_Menu := False;
Dbtext.Reset_Debug;
else
Textmode := False;
First_Menu := True;
end if;
end Reset_Debug;
begin
Reset_Debug (Text);
Was_Called := False;
end Debugger;