|
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: ┃ D T ┃
Length: 22786 (0x5902)
Types: TextFile
Names: »DEBUG_ADA«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with text_io;
separate(expertSystem)
package body debugger is
textMode : boolean :=TRUE ; -- T if 100 % text mode, F if 100 % graphic
grafForText : boolean :=FALSE; -- T if we are passing for N step in graphic mode
firstMenu : boolean :=FALSE; -- T when 1st context entered has try to start menu
wasCalled : boolean :=FALSE; -- T when someone has explicitly call the debugger
type stateArray is array(itemDebugged) of boolean;
state : stateArray;
counter : natural :=0;
lastContext : natural:=1;
lastNumber : natural:=1;
currentContext : natural:=1;
lastContextEntered : natural:=0;
lastStrategy : strategyName;
bell : constant character := character'VAL(7);
aaah : constant natural := character'POS('A');
space : constant natural := character'POS(' ');
zero : constant natural := character'POS('0');
package entier_io is new text_io.integer_io(integer);
firstItem : constant itemDebugged := contextEntered;
lastItem : constant itemDebugged := actionFact;
grafNr : natural :=itemDebugged'POS(lastItem)+1;
contNr : natural :=itemDebugged'POS(lastItem)+2;
runNr : natural :=itemDebugged'POS(lastItem)+3;
brkpNr : natural :=itemDebugged'POS(lastItem)+4;
exitNr : natural :=itemDebugged'POS(lastItem)+5;
listNr : natural :=itemDebugged'POS(lastItem)+6;
subtype commandName is string(1..22);
cmdName : array(itemDebugged) of commandName
:=( "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=>" ");
stepToJump : natural :=1;
stepCounter : natural :=0;
type BPinfo is record
BPruleNumber : ruleId := 0;
BPcontextNumber : contextId := 0;
BPtimesNumber : natural := 0;
BPcounter : natural := 0;
BPused : boolean := FALSE;
end record;
BPlist : array(contextId) of BPinfo;
BPcount : natural :=0;
BPstate : stateArray;
BPsaved : boolean :=FALSE;
contList : array(contextId) of contextName;
ruleList : array(contextId,ruleId) of ruleName;
package DBtext is
procedure sendContextEntered( name : contextName ;
number : contextId);
procedure sendStrategyUsed( name : strategyName);
procedure sendConflictSetStarted;
procedure sendConflictSetFinished;
procedure sendConditionEvalued( name : ruleName;
number : natural;
result : boolean;
facts : tupleCollection.object);
procedure sendChoosedRule( number : natural;
fact : tuple.object);
procedure sendChoosedAction( name : ruleName;
number : natural;
fact : tuple.object);
procedure sendNewStep;
procedure sendFailed;
procedure resetDebug;
procedure refreshDebug;
end DBtext;
package DBgraph is
procedure sendContextEntered( name : contextName ;
number : contextId);
procedure sendStrategyUsed( name : strategyName);
procedure sendConflictSetStarted;
procedure sendConflictSetFinished;
procedure sendConditionEvalued( name : ruleName;
number : natural;
result : boolean;
facts : tupleCollection.object);
procedure sendChoosedRule( number : natural;
fact : tuple.object);
procedure sendChoosedAction( name : ruleName;
number : natural;
fact : tuple.object);
procedure sendNewStep;
procedure sendFailed;
procedure resetDebug;
procedure refreshDebug;
end DBgraph;
procedure menuList is
choice : character;
cont : contextId;
touche : character;
begin
put_line("");
put_line(" LISTE DES REGLES ET ETAT DE CHACUNES ");
put_line("");
put("Donnez le numero du contexte desire 1..8 > ");
get(choice);
if choice>'0' and choice<='8' then
cont:=contextId'VAL(character'POS(choice)-zero);
else
cont:=1;
end if;
put("Le nom de ce contexte est ");
put_line(contList(cont));
for i in 1..ruleId'LAST loop
put(i); put(" : ");
put(ruleList(cont,i));
if ruleManager.isMasked(cont,i) then
put(" M ");
else
put(" - ");
end if;
if (i mod 2) = 0 then
put_line("");
end if;
end loop;
put_line("");
put("Pressez S et RETURN pour revenir au MENU du DEBUGGER > ");
get(touche);
end menuList;
procedure menuBreak is
letter : natural;
choice : character;
begin
loop
put_line("");
put_line("MENU DES POINTS D'ARRET. Repondre 0,0,xxx pour desarmer un point d'arret");
put_line("");
put_line(" Numero Numero Numero Compteur Maxi Etat");
put_line(" point regle contexte passage passage point");
put_line("===========================================================");
for i in 1..contextId'LAST loop
put(i) ; put(" ");
put(BPlist(i).BPruleNumber); put(" ");
put(BPlist(i).BPcontextNumber); put(" ");
put(BPlist(i).BPcounter); put(" ");
put(BPlist(i).BPtimesNumber); put(" ");
if BPlist(i).BPused then
put_line(" ON");
else
put_line(" OFF");
end if;
end loop;
put(" Tapez un chiffre (1..8 ou 0 pour sortir) >");
get(choice);
if choice>='0' and choice<='8' then
letter:=character'POS(choice)-zero;
else
letter:=500;
end if;
if letter >=1 and letter <=8 then
put("Indiquer les caracteristiques du POINT d'ARRET No ");
put(letter); put_line("");
put(" Numero de la regle a attendre (0 ou 1-30) ==>");
entier_io.get(BPlist(letter).BPruleNumber);
put(" Numero du contexte concerne (0 ou 1-8) ==>");
entier_io.get(BPlist(letter).BPcontextNumber);
put(" Nombre de passage avant arret (0 ou +) ==>");
entier_io.get(BPlist(letter).BPtimesNumber);
put_line("");
BPlist(letter).BPcounter:=0;
if BPlist(letter).BPruleNumber=0 and BPlist(letter).BPcontextNumber=0 then
BPlist(letter).BPused:=FALSE;
BPcount:=BPcount-1;
else
BPlist(letter).BPused:=TRUE;
BPcount:=BPcount+1;
end if;
else
if letter = 0 then
exit;
end if;
end if;
end loop;
end menuBreak;
procedure menu is
letter : natural;
choice : character;
procedure turnToGraf is
begin
put(" Combien de pas (1..32000) >");
entier_io.get(stepToJump);
DBgraph.refreshDebug;
textMode:=FALSE;
grafForText:=TRUE;
if BPsaved=FALSE then
BPstate:=state;
state:=(others=>TRUE);
end if;
end turnToGraf;
procedure jumpNstep is
begin
put(" Combien de pas (1..32000) >");
if BPsaved=FALSE then
BPstate:=state;
BPsaved:=TRUE;
state:=(others=>FALSE);
state(choosedRule):=TRUE;
end if;
entier_io.get(stepToJump);
end jumpNstep;
begin
loop
put_line("");
put(" MENU DEBUGGER COMPTE-TOUR MOTEUR : ");
put(counter); put_line("");
put_line("");
for i in firstItem..lastItem loop
put(character'VAL(aaah+itemDebugged'POS(i))); put(" : ");
put(cmdName(i));
if state(i) then
put(" oui ");
else
put(" non ");
end if;
if (itemDebugged'POS(i) mod 2) = 1 then
put_line("");
end if;
letter:=itemDebugged'POS(i);
end loop;
put(character'VAL(aaah+grafNr)); put(" : ");
put("pour CONTINUER de X pas en GRAPHIQUE");
put_line("");
put(character'VAL(aaah+contNr)); put(" : ");
put("pour CONTINUER de 1 pas ");
put(character'VAL(aaah+runNr)); put(" : ");
put_line("pour CONTINUER de X pas");
put(character'VAL(aaah+brkpNr)); put(" : ");
put("pour le menu des POINTS D'ARRET ");
put(character'VAL(aaah+exitNr)); put(" : ");
put_line("pour TOUT ARRETER D'URGENCE");
put(character'VAL(aaah+listNr)); put(" : ");
put("pour la liste d'ETAT des REGLES ");
put_line(""); put(" Tapez une lettre SVP >");
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:=500;
end if;
if letter >=itemDebugged'POS(firstItem) and
letter <=itemDebugged'POS(lastItem) then
state(itemDebugged'VAL(letter)):= not state(itemDebugged'VAL(letter));
else
if letter = exitNr then raise PROGRAM_ERROR;
elsif letter = grafNr then turnToGraf ; exit;
elsif letter = contNr then stepToJump:=1; exit;
elsif letter = runNr then jumpNstep; exit;
elsif letter = brkpNr then menuBreak;
elsif letter = listNr then menuList ;
else put(bell);
end if;
end if;
end loop;
put_line("");
end menu;
procedure breakPtsUpdate(number : natural) is
begin
if BPcount/=0 then
for i in 1..contextId'LAST loop
if BPlist(i).BPcontextNumber = lastContextEntered and
BPlist(i).BPruleNumber = number
then
BPlist(i).BPcounter := BPlist(i).BPcounter+1;
end if;
end loop;
end if;
end breakPtsUpdate;
function breakPtsArrived return boolean is
begin
if BPcount=0 then
return FALSE;
else
for i in 1..contextId'LAST loop
if BPlist(i).BPcounter>=BPlist(i).BPtimesNumber and
BPlist(i).BPcounter/=0
and BPlist(i).BPused then
BPlist(i).BPcounter:=0;
put(bell);
put_line("D# *******************************");
put_line("D# *** POINT D'ARRET RENCONTRE ***");
put_line("D# *******************************");
return TRUE;
end if;
end loop;
return FALSE;
end if;
end breakPtsArrived;
package body DBtext is
procedure displayRef( aRef : expertSystem.reference ) is
begin
put(classIdentity.unknownClassName(aRef));
put(".");
put(classIdentity.unknownObjectName(aRef));
put(" ");
end displayRef;
procedure displayTuple0 is new tuple.forAll(displayRef);
procedure displayTuple ( aTuple : tuple.object) is
begin
put("D# Instance : ");
displayTuple0(aTuple);
put_line(" ");
end displayTuple;
procedure displayTupleCollection0 is new tupleCollection.forAll(displayTuple);
procedure displayTupleCollection ( tc : tupleCollection.object) is
begin
displayTupleCollection0(tc);
end displayTupleCollection;
procedure sendContextEntered( name : contextName ; number : contextId) is
begin
if number/=lastContextEntered then
lastContextEntered:=number;
if state(contextEntered) then
put_line(" ");
put("D# Nouveau contexte No ");
put(number) ; put(" : ");
put_line(name);
end if;
end if;
if not firstMenu then
if wasCalled then
menu;
end if;
firstMenu:=TRUE;
end if;
end sendContextEntered;
procedure sendStrategyUsed( name : strategyName) is
begin
if state(strategyUsed) and lastStrategy/=name then
put("D# Strategie utilisee : ");
put_line(name);
lastStrategy:=name;
end if;
end sendStrategyUsed;
procedure sendConflictSetStarted is
begin
if state(conflictSetStarted) then
put_line(" ");
put_line("D# Construction de l'ensemble de conflit ... ");
end if;
end sendConflictSetStarted;
procedure sendConflictSetFinished is
begin
if state(conflictSetFinished) then
put_line("D# Ensemble de conflit termine.");
put_line(" ");
end if;
end sendConflictSetFinished;
procedure sendConditionEvalued( name : ruleName;
number : natural;
result : boolean;
facts : tupleCollection.object) is
begin
if state(conditionEvalued) then
put("D# Evaluation regle No ");
put(number);
if result then
put(" => VRAI : ");
else
put(" => FAUX : ");
end if;
put_line(name);
end if;
if state(ruleFacts) and tupleCollection.isNotNull(facts) then
put_line("D# Faits impliques :");
displayTupleCollection(facts);
end if;
end sendConditionEvalued;
procedure sendChoosedRule( number : natural;
fact : tuple.object) is
begin
breakPtsUpdate(number);
if state(choosedRule) and stepToJump=1 then
put("D# Regle choisie : No ");
put(number);
put_line(" ");
end if;
if state(ruleFacts) and tuple.isNotNull(fact) then
put_line("D# Faits impliques :");
displayTuple(fact);
end if;
if breakPtsArrived then
if BPsaved then
state:=BPstate;
BPsaved:=FALSE;
end if;
menu;
stepCounter:=0;
end if;
end sendChoosedRule;
procedure sendChoosedAction( name : ruleName;
number : natural;
fact : tuple.object) is
begin
if state(choosedAction) then
put_line(" ");
put("D# Action executee : No ");
put(number);
put(" = ");
put_line(name);
end if;
if state(actionFact) and tuple.isNotNull(fact) then
put_line("D# Fait concerne :");
displayTuple(fact);
end if;
end sendChoosedAction;
procedure sendNewStep is
begin
if counter>=natural'LAST then
counter:=0;
end if;
counter:=counter+1;
if state(newStep) and stepToJump=1 then
put("D# Compte-tour moteur : ");
put(counter);
put_line(" ");
end if;
stepCounter:=stepCounter+1;
if stepCounter=stepToJump then
if BPsaved then
state:=BPstate;
BPsaved:=FALSE;
end if;
menu;
stepCounter:=0;
end if;
end sendNewStep;
procedure sendFailed is
begin
if state(failed)
or stepToJump/=1 then
put("D# Plus de regle valide. ");
put_line(" ");
end if;
end sendFailed;
procedure resetDebug is
begin
setDebugOff(completly);
counter :=0;
stepToJump :=1;
stepCounter :=0;
lastContextEntered :=0;
lastStrategy :=" ";
for i in contextId loop
BPlist(i).BPused:=FALSE;
end loop;
BPcount:=0;
BPsaved:=FALSE;
end resetDebug;
procedure refreshDebug is
begin
null;
end refreshDebug;
end DBtext;
package body DBgraph is
procedure sendContextEntered( name : contextName ; number : contextId) is
begin
currentContext:=number;
if number/=lastContextEntered then
lastContextEntered:=number;
if state(contextEntered) then
terminal.atXY(1,11); put("Contexte courant : ");
put_line(name);
terminal.atXY(1,15);
end if;
end if;
end sendContextEntered;
procedure sendStrategyUsed( name : strategyName) is
begin
if state(strategyUsed) and name/=lastStrategy then
terminal.atXY(50,11); put("Strategie courante : ");
put_line(name);
terminal.atXY(1,15);
lastStrategy:=name;
end if;
end sendStrategyUsed;
procedure sendConflictSetStarted is
begin
if state(conflictSetStarted) then
terminal.atXY(1,12) ; put(" ");
terminal.atXY(1,12) ; put("Construction de l'ensemble de conflit ... ");
terminal.atXY(1,15);
end if;
end sendConflictSetStarted;
procedure sendConflictSetFinished is
begin
if state(conflictSetFinished) then
terminal.atXY(1,12) ; put(" ");
terminal.atXY(1,12) ; put("Ensemble de conflit termine. ");
terminal.atXY(1,15);
end if;
end sendConflictSetFinished;
procedure sendConditionEvalued( name : ruleName;
number : natural;
result : boolean;
facts : tupleCollection.object) is
nb : natural;
begin
terminal.atXY(number+1,currentContext+1);
nb:=tupleCollection.cardinality(facts);
if nb=0 then
put('.');
else
if nb>9 then
put('+');
else
put(character'VAL(nb+zero));
end if;
end if;
terminal.atXY(1,15);
end sendConditionEvalued;
procedure sendChoosedRule( number : natural;
fact : tuple.object) is
nb : natural;
touche : character;
begin
breakPtsUpdate(number);
if state(choosedRule) and number/=0 then
terminal.atXY(lastNumber+41,lastContext+1); put('.');
terminal.atXY(number+41,currentContext+1); put('*');
lastNumber := number;
lastContext := currentContext;
terminal.atXY(1,15);put(" ");
terminal.atXY(1,15);
end if;
if breakPtsArrived then
if BPsaved then
state:=BPstate;
BPsaved:=FALSE;
end if;
grafForText:=FALSE;
textMode:=TRUE;
put("Pressez S et RETURN pour revenir au DEBUGGER en mode TEXT > ");
get(touche);
menu;
stepCounter:=0;
end if;
end sendChoosedRule;
procedure sendChoosedAction( name : ruleName;
number : natural;
fact : tuple.object) is
begin
null;
end sendChoosedAction;
procedure sendNewStep is
touche : character;
begin
if counter>=natural'LAST then
counter:=0;
end if;
counter:=counter+1;
if state(newStep) then
terminal.atXY(53,12) ; put("Compte-tour moteur : ");
put(counter);
delay 1.0;
terminal.atXY(1,15);
end if;
if grafForText then
stepCounter:=stepCounter+1;
if stepCounter=stepToJump then
if BPsaved then
state:=BPstate;
BPsaved:=FALSE;
end if;
grafForText:=FALSE;
textMode:=TRUE;
put("Pressez S et RETURN pour revenir au DEBUGGER en mode TEXT > ");
get(touche);
menu;
stepCounter:=0;
end if;
end if;
end sendNewStep;
procedure sendFailed is
begin
counter:=0;
if state(failed) then
terminal.atXY(1,12) ; put(" ");
terminal.atXY(1,12) ; put("Plus de regle valide. ");
terminal.atXY(1,15);
end if;
end sendFailed;
procedure resetDebug is
begin
counter:=0;
setDebugOff(completly);
end resetDebug;
procedure refreshDebug is
begin
terminal.clear;
terminal.atXY(1,1); put(' ');
for i in 1..ruleId'LAST loop
put(character'VAL(zero + (i mod 10)));
end loop;
terminal.atXY(41,1); put(' ');
for i in 1..ruleId'LAST loop
put(character'VAL(zero + (i mod 10)));
end loop;
for i in 1..contextId'LAST loop
terminal.atXY( 1,i+1); put(character'VAL(zero + (i mod 10)));
terminal.atXY(41,i+1); put(character'VAL(zero + (i mod 10)));
end loop;
terminal.atXY(1,10) ; put(" REGLES EVALUEES REGLES CHOISIES");
terminal.atXY(1,15);
lastStrategy :=" ";
lastContextEntered :=0;
end refreshDebug;
end DBgraph;
procedure sendContextEntered( name : contextName ; number : contextId) is
begin
if textMode then
DBtext.sendContextEntered(name,number);
else
DBgraph.sendContextEntered(name,number);
end if;
end sendContextEntered;
procedure sendStrategyUsed( name : strategyName) is
begin
if textMode then
DBtext.sendStrategyUsed(name);
else
DBgraph.sendStrategyUsed(name);
end if;
end sendStrategyUsed;
procedure sendConflictSetStarted is
begin
if textMode then
DBtext.sendConflictSetStarted;
else
DBgraph.sendConflictSetStarted;
end if;
end sendConflictSetStarted;
procedure sendConflictSetFinished is
begin
if textMode then
DBtext.sendConflictSetFinished;
else
DBgraph.sendConflictSetFinished;
end if;
end sendConflictSetFinished;
procedure sendConditionEvalued( name : ruleName;
number : natural;
result : boolean;
facts : tupleCollection.object) is
begin
if textMode then
DBtext.sendConditionEvalued(name,number,result,facts);
else
DBgraph.sendConditionEvalued(name,number,result,facts);
end if;
end sendConditionEvalued;
procedure sendChoosedRule( number : natural;
fact : tuple.object) is
begin
if textMode then
DBtext.sendChoosedRule(number,fact);
else
DBgraph.sendChoosedRule(number,fact);
end if;
end sendChoosedRule;
procedure sendChoosedAction( name : ruleName;
number : natural;
fact : tuple.object) is
begin
if textMode then
DBtext.sendChoosedAction(name,number,fact);
else
DBgraph.sendChoosedAction(name,number,fact);
end if;
end sendChoosedAction;
procedure sendNewStep is
begin
if textMode then
DBtext.sendNewStep;
else
DBgraph.sendNewStep;
end if;
end sendNewStep;
procedure sendFailed is
begin
if textMode then
DBtext.sendFailed;
else
DBgraph.sendFailed;
end if;
end sendFailed;
procedure refreshDebug is
begin
if textMode then
DBtext.refreshDebug;
else
DBgraph.refreshDebug;
end if;
end refreshDebug;
function isDebugged(what : itemDebugged) return boolean is
begin
return state(what);
end isDebugged;
procedure setDebugOn( item : itemDebugged) is
begin
if item=completly then
for i in itemDebugged loop
state(i):=TRUE;
end loop;
else
state(item):=TRUE;
end if;
end setDebugOn;
procedure setDebugOn( item : itemSet) is
begin
for i in item'RANGE loop
setDebugOn(item(i));
end loop;
end setDebugOn;
procedure setDebugOff( item : itemDebugged) is
begin
if item=completly then
for i in itemDebugged loop
state(i):=FALSE;
end loop;
else
state(item):=FALSE;
end if;
end setDebugOff;
procedure setDebugOff( item : itemSet) is
begin
for i in item'RANGE loop
setDebugOff(item(i));
end loop;
end setDebugOff;
procedure resetDebug(mode : debuggingMode) is
begin
grafForText:=FALSE;
wasCalled:=TRUE;
if mode=text then
textMode:=TRUE;
firstMenu:=FALSE;
DBtext.resetDebug;
else
textMode:=FALSE;
firstMenu:=TRUE;
DBgraph.resetDebug;
end if;
end resetDebug;
procedure sendRulesNames( contextNumber : contextId;
ctxName : contextName;
name_1 ,name_2 ,name_3 ,name_4 ,name_5 ,name_6 ,name_7,
name_8 ,name_9 ,name_10,name_11,name_12,name_13,name_14,
name_15,name_16,name_17,name_18,name_19,name_20,name_21,
name_22,name_23,name_24,name_25,name_26,name_27,name_28,
name_29,name_30 : ruleName) is
begin
contList(contextNumber) :=ctxName;
ruleList(contextNumber,1):=name_1;
ruleList(contextNumber,2):=name_2;
ruleList(contextNumber,3):=name_3;
ruleList(contextNumber,4):=name_4;
ruleList(contextNumber,5):=name_5;
ruleList(contextNumber,6):=name_6;
ruleList(contextNumber,7):=name_7;
ruleList(contextNumber,8):=name_8;
ruleList(contextNumber,9):=name_9;
ruleList(contextNumber,10):=name_10;
ruleList(contextNumber,11):=name_11;
ruleList(contextNumber,12):=name_12;
ruleList(contextNumber,13):=name_13;
ruleList(contextNumber,14):=name_14;
ruleList(contextNumber,15):=name_15;
ruleList(contextNumber,16):=name_16;
ruleList(contextNumber,17):=name_17;
ruleList(contextNumber,18):=name_18;
ruleList(contextNumber,19):=name_19;
ruleList(contextNumber,20):=name_20;
ruleList(contextNumber,21):=name_21;
ruleList(contextNumber,22):=name_22;
ruleList(contextNumber,23):=name_23;
ruleList(contextNumber,24):=name_24;
ruleList(contextNumber,25):=name_25;
ruleList(contextNumber,26):=name_26;
ruleList(contextNumber,27):=name_27;
ruleList(contextNumber,28):=name_28;
ruleList(contextNumber,29):=name_29;
ruleList(contextNumber,30):=name_30;
end sendRulesNames;
begin
resetDebug(text);
wasCalled:=FALSE;
end debugger;