unit uovl;

interface
uses umain;
  procedure razall;
  procedure clear_stat;
  procedure tstat;
  procedure t_flag;
  procedure tspy(v:integer);
  procedure tloop(v:integer);
  procedure tedit(v:integer; modu : integer);
  procedure tsave(v,modu:integer);
  procedure tprint(sp:integer;modu:integer);


implementation
uses usp,uio,udiv,uini;
		(****************************************)
		(*	movl.pas	-	prolog	*)
		(****************************************)

		(*	stat, flag		*)
		(*	spy			*)
		(*	save_bin, load_bin	*)
		(*	help			*)

(* procedure fdate(writ:integer);

var	recpack:registers;
	month,day:string[2];
	year:string[4];
	dat:tstring;
	sor,nc	: integer;
	stt	: integer;
begin
with recpack do
	begin
	ax:=$2a shl 8;
	end;
msdos(recpack);
with recpack do
	begin
	str(cx,year);
	str(dx mod 256,day);
	str(dx shr 8,month);
	end;
dat:=day+'-'+month+'-'+year;
if writ = 1
then	begin
	stt := ttyout;
	if fils1 <> 0
	then	choix_out;
	putk(dat);
	ttyout := stt;
	end
else	begin
	convertir_mot(dat , 0 , nc);
	prend_noeud(sor);
	noeud^[sor].code := nc;
	rend_liste(sor,1);
	end;
end;                   *)

(* procedure ftime(writ : integer);
var	recpack:registers;
	heure,minute,seconde:string[2];
	dat:tstring;
	sor,nc	: integer;
	stt	: integer;
begin
with recpack do
	begin
	ax:=$2c shl 8;
	end;
msdos(recpack);
with recpack do
	begin
	str(cx shr 8,heure);
	str(cx mod 256,minute);
	str(dx shr 8,seconde);
	end;
dat:=heure+'/'+minute+'/'+seconde;

if writ = 1
then	begin
	stt := ttyout;
	if fils1 <> 0
	then	choix_out;
	putk(dat);
	ttyout := stt;
	end
else	begin
	convertir_mot(dat , 0 , nc);
	prend_noeud(sor);
	noeud^[sor].code := nc;
	rend_liste(sor,1);
	end;
end; *)

procedure razall;
var	i,j,k,no,hsh	: integer;
begin
if nfait = 0
then	begin		(* clear module, il faut supprimer les symboles *)
	nmodule := -2;
	if nhsh_coded <> 0
	then	begin
		for i := 1 to nhsh_coded do
			begin
			if table_coded[i] <> nil
			then	begin
				dispose(table_coded[i]);
				table_coded[i] := nil;
				end;
			end;
		nhsh_coded := 0;
		end;
	if nglob <> 0
	then	begin
		nglob := 0;
		for i := 1 to max_glob do
			noeud^[i].fils := i+1;
		noeud^[max_glob].fils := 0;
		libglob := 1;
		end;
	nsym := npredef;
	for j:=0 to max_par do
		begin
		for hsh := 0 to max_hsh do
			begin
			k:=premier_sym[j,hsh];
			if k > npredef
			then	begin
				k := 0;
				premier_sym[j,hsh] := 0;
				dernier_sym[j,hsh] := 0;
				end;
			while k <> 0 do
				begin
				if k <= npredef
				then	begin
					i := k;
					table_symbole^[i].vale := 0;
					k := table_symbole^[i].suivant;
					if k > npredef
					then	begin
						table_symbole^[i].suivant := 0;
						dernier_sym[j,hsh] := i;
						k := 0;
						end;
					end
				else	k := 0;
				end;
			end;
		end;
	end;
end;

procedure clear_stat;
begin
nbenv := 0;
nbarbre := 0;
nbglob := 0;
nbnoeud := max_glob;
end;

procedure tstat;
var	k,v1,v2,n:integer;
begin
writeln(output);
writeln(output,'            Statistiques');
writeln(output);

(* pdbzro writeln(output,'heap      ',memavail);     *)

writeln(output,'symboles  ',nsym,'      ','max=',max_sym);
writeln(output,'globales  ',nglob ,'  dyn=',nbglob,'  max=',max_glob);
writeln(output,'noeuds    ',nnoeud-max_glob,'  dyn=',nbnoeud-max_glob,
	'  max=',max_noeud-max_glob);
writeln(output,'arbre     ',narbre,'  dyn=',nbarbre,'  max=',max_arbre);
writeln(output,'env       ',nenv,'  niv=',nniveau,'  ',nenv+nniveau);
writeln(output,'            dyn=',nbenv,'  max=',max_env);
writeln(output,'fait      ',nfait,'  dyn=',nnfait,'  max=',max_fait);
writeln(output,'nombre de hsh_coded ',nhsh_coded,' max=',max_hsh_coded);
end;

procedure t_flag;
var	i	: integer;
procedure edit(tt:tstring;v:boolean);
begin
write(output,tt,' : ');
if v
then	write(output,' oui')
else	write(output,' non');
writeln(output);
end;

begin	(* code de tflag *)
writeln(output);
writeln(output,'     Etat des indicateurs');
edit('echo     ',echo);
edit('auto     ',auto);
edit('fait     ',indfait);
edit('trace    ',trace);
edit('silent   ',not(read_bavard));
if nspy <> 0
then	begin
	writeln(output,'predicats en trace :');
	for i:=1 to nspy do
		begin
		lire_symbole(table_spy[i]);
		writeln(output,'    ',symbole_lu);
		end;
	end;
end;

procedure tspy(v:integer);
var	i:integer;
	trouve:boolean;
begin
trouve:=false;
for i:=1 to nspy do
	begin
	if table_spy[i] = noeud^[fils1].code
	then	begin
		if v=1
		then	begin
			table_spy[i]:=table_spy[nspy];
			nspy:=nspy-1;
			trouve:=true;
			end;
		end;
	end;
if not trouve and (v=0)
then	begin
	if nspy=max_spy
	then	begin
		eros;
		writeln(output,'trop d''espionite en spy');
		end
	else	begin
		nspy:=nspy+1;
		table_spy[nspy]:=noeud^[fils1].code;
		end;
	end;
end;

procedure tloop(v:integer);
var	i:integer;
	trouve:boolean;
begin
trouve:=false;
for i:=1 to nloop do
	begin
	if table_loop[i] = noeud^[fils1].code
	then	begin
		if v=1
		then	begin
			table_loop[i]:=table_loop[nloop];
			nloop:=nloop-1;
			trouve:=true;
			end;
		end;
	end;
if not trouve and (v=0)
then	begin
	if nloop=max_loop
	then	begin
		eros;
		writeln(output,'trop d''espionite en loop');
		end
	else	begin
		nloop:=nloop+1;
		table_loop[nloop]:=noeud^[fils1].code;
		end;
	end;
end;

(* procedure thelp;
var	code	: integer;
	goon,afficher	: boolean;
	mot	: tstring;
	fich	: ttstring;
begin
if noeud^[objet].code = p_help
then	fich := '%:prolog2.hlp'
else	begin
	lire_symbole(noeud^[fils1].code);
	fich := symbole_lu;
	end;
if noeud^[objet].code = p_help
then	code := noeud^[fils1].code
else	code := noeud^[fils2].code;
lire_symbole(code);
help(fich , symbole_lu);
end;       *)

procedure tedit(v:integer; modu : integer);
var	i	: integer;
begin
stt := ttyout;
topen(-1,ttyout);
save_txt := 1;
listing(v,modu,0);
close(fichier[1]);
cfichier[1]:=0;
save_txt:=0;
ttyout := stt;
(* pdbzro tedt('buffer.tmp',backtrack);   *)
if not backtrack
then	begin
	if modu=0
	then	begin
		final;
		iniprol;
		sortie := true;
		end
	else	begin
		save_txt := 1;
		listing(v,nmodule,1);
		save_txt := 0;
		end;
	tlire('buffer.tmp');
	end;
end;

procedure tsave(v,modu:integer);
begin
stt := ttyout;
topen(0,ttyout);
save_txt := 1;
listing(v,modu,0);
close(fichier[1]);
save_txt := 0;
ttyout := stt;
end;

procedure tprint(sp:integer;modu:integer);
var	stt	: integer;
begin
stt := ttyout;
ttyout := 2;
listing(sp,modu,0);
ttyout := stt;
end;
end.
