unit execute;
(* Module d'execution "executeur" de PetitBasic. *)

interface

uses interpreteur;

procedure	initialise_executeur;
procedure	termine_executeur;

function	interprete_ligne (l : string) : boolean;
procedure	interprete_programme;

implementation

uses outils, lexical, instructions, syntaxe, variables, lignes, evalue;

const   TAILLE_PILE_GOSUB	= 32;
	TAILLE_PILE_WHILE	= 32;
	TAILLE_PILE_FOR_TO	= 32;

var	initialise	: boolean;

	pile_gosub	: array [1..TAILLE_PILE_GOSUB] of LIGNE;
	index_gosub	: integer;
	pile_while	: array [1..TAILLE_PILE_GOSUB] of LIGNE;
	index_while	: integer;
	pile_for_to	: array [1..TAILLE_PILE_GOSUB] of LIGNE;
	index_for_to	: integer;

	branchement	: boolean;
	prochain	: LIGNE;

procedure initialise_executeur;

begin
	initialise := true;
	index_gosub := 0;
	index_while := 0;
	index_for_to := 0;
	branchement := false;
	prochain := nil;
end;

procedure termine_executeur;

begin
	if not initialise then begin
		writeln('Erreur Interne: Executeur non initialis‚!');
		halt;
	end else begin
		initialise := false;
		index_gosub := 0;
		index_while := 0;
		index_for_to := 0;
		branchement := false;
		prochain := nil;
	end;
end;

function interprete_ligne (l : string) : boolean;
(* Interpr‚te une ligne, renvoie nil en cas d'erreur.  Cette fonction
 * utilise l'analyseur lexical.
 *)

function execute_instruction (p : INSTRUCTION) : boolean;
(* Execute l'instruction point‚ par p, renvoie true si tout s'est bien pass‚,
 * o— false en cas d'erreur, auquel cas la variable erreur_interpreteur donne
 * des pr‚cisions.  Cette fonction peut ˆtre appel‚ r‚cursivement.
 *)

function execute_if_then_else (p : INSTRUCTION) : boolean;
(* Execute une instruction if then else, renvoie false en cas d'erreur. *)

var	condition	: boolean;

begin
	condition := evalue_expression_logique(p^.condition_if);
	if erreur_interpreteur = INTERPRETEUR_OKAY then begin
		if condition then
			execute_instruction := execute_instruction(
				p^.instruction_then)
		else
			execute_instruction := execute_instruction(
				p^.instruction_else);
	end else
		execute_instruction := false;
end;

function execute_gosub (p : INSTRUCTION) : boolean;
(* Execute une instruction gosub, renvoie false en cas d'erreur. *)

var	l 	: LIGNE;

begin
	if index_gosub + 1 <= TAILLE_PILE_GOSUB then begin
		l := cherche_ligne(p^.numero_gosub);
		if l = nil then begin
			erreur_interpreteur := LIGNE_PAS_TROUVE;
			execute_gosub := false;
		end else begin
			index_gosub := index_gosub + 1;
			pile_gosub[index_gosub] := l;
			branchement := true;
			prochain := l;
			execute_gosub := true;
		end;
	end else begin
		erreur_interpreteur := OVERFLOW_PILE_GOSUB;
		execute_gosub := false;
	end;
end;

function execute_return (p : INSTRUCTION) : boolean;
(* Execute une instruction return, renvoie false en cas d'erreur. *)

begin
	if index_gosub >= 1 then begin
		branchement := true;
		prochain := pile_gosub[index_gosub];
		index_gosub := index_gosub - 1;
		execute_return := true;
	end else begin
		erreur_interpreteur := UNDERFLOW_PILE_GOSUB;
		execute_return := false;
	end;
end;

function execute_while (p : INSTRUCTION) : boolean;
(* Execute une instruction while, renvoie false en cas d'erreur.  La premiŠre
 * execution d'une boucle while doit r‚ussir, cela est du au fait que l'on
 * utilise une pile d'appel.
 *)

var	condition	: boolean;
	l		: LIGNE;

begin
end;

function execute_wend (p : INSTRUCTION) : boolean;
(* Execute une instruction wend, renvoie false en cas d'erreur. *)

begin
	if index_while >= 1 then begin
		branchement := true;
		prochain := pile_while[index_while];
		index_while := index_while - 1;
		execute_wend := true;
	end else begin
		erreur_interpreteur := UNDERFLOW_PILE_WHILE;
		execute_wend := false;
	end;
end;

function execute_for_to (p : INSTRUCTION) : boolean;
(* Execute une instruction for to, renvoie false en cas d'erreur. *)

begin
end;

function execute_next (p : INSTRUCTION) : boolean;
(* Execute une instruction next, renvoie false en cas d'erreur. *)

begin
	if index_for_to >= 1 then begin
		branchement := true;
		prochain := pile_for_to[index_for_to];
		index_for_to := index_for_to - 1;
		execute_next := true;
	end else begin
		erreur_interpreteur := UNDERFLOW_PILE_FOR_TO;
		execute_next := false;
	end;
end;

function execute_goto (p : INSTRUCTION) : boolean;
(* Execute une instruction goto, renvoie false en cas d'erreur. *)

var	l	: LIGNE;

begin
	l := cherche_ligne(p^.numero_goto);
	if l = nil then begin
		erreur_interpreteur := LIGNE_PAS_TROUVE;
		execute_goto := false;
	end else begin
		branchement := true;
		prochain := l;
		execute_goto := true;
	end;
end;

function execute_let (p : INSTRUCTION) : boolean;
(* Effectue une affectation, renvoie false en cas d'erreur. *)

var	v	: VARIABLE;
	reel	: boolean;
	r	: real;
	s	: string;

begin
	v := cherche_variable(p^.identificateur_let);

	if v = nil then
		case p^.type_affectation of
			TYPE_ENTIER :
				v := cree_variable_entiere(
					p^.identificateur_let, 0);
			TYPE_REEL :
				v := cree_variable_reelle(
					p^.identificateur_let, 0.0);
			TYPE_CHAINE :
				v := cree_variable_chaine(
					p^.identificateur_let, '');
		end;

	if v = nil then
		execute_let := false
	else
		case p^.type_affectation of
			TYPE_ENTIER : begin
				reel := false;
				r := evalue_expression_numerique(
					p^.entier, reel);
				if erreur_interpreteur <> INTERPRETEUR_OKAY
				then
					execute_let := false
				else begin
					v^.entier := round(r);
					execute_let := true;
				end;
			end;
			TYPE_REEL : begin
				reel := true;
				r := evalue_expression_numerique(
					p^.reel, reel);
				if erreur_interpreteur <> INTERPRETEUR_OKAY
				then
					execute_let := false
				else begin
					v^.reel := r;
					execute_let := true;
				end;
			end;
			TYPE_CHAINE : begin
				s := evalue_expression_chaine(p^.chaine);
				if erreur_interpreteur <> INTERPRETEUR_OKAY
				then
					execute_let := false
				else begin
					v^.chaine := s;
					execute_let := true;
				end;
			end;
		end;
end;

function execute_end (p : INSTRUCTION) : boolean;
(* Stop un programme, cela est consid‚r‚ comme ‚tant une pseudo-erreur, et
 * cette fonction renvoie de ce fait toujours false.
 *)

begin
	erreur_interpreteur := PROGRAMME_FINIE;
	execute_end := false;
end;

function execute_rem (p : INSTRUCTION) : boolean;
(* Une instruction rem ne fait rien, donc cela r‚ussi toujours. *)

begin
	execute_rem := true;
end;

function execute_input (p : INSTRUCTION) : boolean;
(* Execute une instruction input, renvoie false en cas d'erreur. *)

var	v 	: VARIABLE;
	buffer	: string;
	t	: TYPE_LEXEMES;
	e	: integer;
	r	: real;

begin
	case p^.type_input of
		TYPE_ENTIER : begin
			v := cherche_variable(p^.identificateur_input);
			if v = nil then
				cree_variable_entiere(
					p^.identificateur_input, 0);

			readln(buffer);
			initialise_analyseur_lexical(buffer);
			t := prend_lexeme;
			if t <> LITERAL_ENTIER then begin
				erreur_interpreteur := INPUT_ATTEND_ENTIER;
				termine_analyseur_lexical;
				execute_input := false;
			end else if not chaine_a_entier(lexeme, e) then begin
				erreur_interpreteur := INPUT_ATTEND_ENTIER;
				termine_analyseur_lexical;
				execute_input := false;
			end else begin
				v^.entier := e;
				termine_analyseur_lexical;
				execute_input := true;
			end;
		end;
		TYPE_REEL : begin
			v := cherche_variable(p^.identificateur_input);
			if v = nil then
				cree_variable_reelle(
					p^.identificateur_input, 0.0);

			readln(buffer);
			initialise_analyseur_lexical(buffer);
			t := prend_lexeme;
			if t <> LITERAL_REEL then begin
				erreur_interpreteur := INPUT_ATTEND_REEL;
				termine_analyseur_lexical;
				execute_input := false;
			end else if not chaine_a_reel(lexeme, r) then begin
				erreur_interpreteur := INPUT_ATTEND_REEL;
				termine_analyseur_lexical;
				execute_input := false;
			end else begin
				v^.reel := r;
				termine_analyseur_lexical;
				execute_input := true;
			end;
		end;
		TYPE_CHAINE : begin
			v := cherche_variable(p^.identificateur_input);
			if v = nil then
				cree_variable_chaine(
					p^.identificateur_input, '');

			readln(buffer);
			initialise_analyseur_lexical(buffer);
			t := prend_lexeme;
			if t <> LITERAL_CHAINE then begin
				erreur_interpreteur := INPUT_ATTEND_REEL;
				termine_analyseur_lexical;
				execute_input := false;
			end else begin
				v^.chaine := lexeme;
				termine_analyseur_lexical;
				execute_input := true;
			end;
		end;
	end;
end;

function execute_print (p : INSTRUCTION) : boolean;
(* Execute une instruction print, renvoie false en cas d'erreur. *)

var	reel	: boolean;
	r	: real;
	s	: string;

begin
	case p^.type_print of
		TYPE_NUMERIQUE : begin
			reel := false;
			r := evalue_expression_numerique(
				p^.numerique_print, reel);
			if erreur_interpreteur = INTERPRETEUR_OKAY then begin
				if reel then
					writeln(r)
				else
					writeln(round(r));
				execute_print := true;
			end else
				execute_print := false;
		end;
		TYPE_CHAINE : begin
			s := evalue_expression_chaine(p^.chaine_print);
			if erreur_interpreteur = INTERPRETEUR_OKAY then begin
				writeln(s);
				execute_print := true;
			end else
				execute_print := false;
		end;
	end;
end;

begin
	if erreur_interpreteur <> INTERPRETEUR_OKAY then
		execute_instruction := false
	else if p <> nil then
		case p^.type_instruction of
			INSTRUCTION_IF_THEN_ELSE :
				execute_instruction :=
					execute_if_then_else(p);
			INSTRUCTION_GOSUB :
				execute_instruction := execute_gosub(p);
			INSTRUCTION_RETURN :
				execute_instruction := execute_return(p);
			INSTRUCTION_WHILE :
				execute_instruction := execute_while(p);
			INSTRUCTION_WEND :
				execute_instruction := execute_wend(p);
			INSTRUCTION_FOR_TO :
				execute_instruction := execute_for_to(p);
			INSTRUCTION_NEXT :
				execute_instruction := execute_next(p);
			INSTRUCTION_GOTO :
				execute_instruction := execute_goto(p);
			INSTRUCTION_LET :
				execute_instruction := execute_let(p);
			INSTRUCTION_END :
				execute_instruction := execute_end(p);
			INSTRUCTION_REM :
				execute_instruction := execute_rem(p);
			INSTRUCTION_INPUT :
				execute_instruction := execute_input(p);
			INSTRUCTION_PRINT :
				execute_instruction := execute_print(p);
		end;
end;

var	p 	: INSTRUCTION;

begin
	initialise_analyseur_syntaxique(l);
	p := lit_instruction;
	if erreur_syntaxique <> ANALYSEUR_SYNTAXIQUE_OKAY then begin
		explique_erreur_syntaxique;
		interprete_ligne := false;
		termine_analyseur_syntaxique;
	end else begin
		termine_analyseur_syntaxique;
		erreur_interpreteur := INTERPRETEUR_OKAY;
		branchement := false;
		prochain := nil;
		if execute_instruction(p) then
			interprete_ligne := true
		else begin
			explique_erreur_interpreteur(l);
			interprete_ligne := false;
		end;
	end;
end;

procedure interprete_programme;
(* Interpr‚te le programme, s'arrˆte en cas d'erreur. *)

var	l 	: LIGNE;
	fin	: boolean;

begin
	l := programme;
	fin := false;
	repeat
		if l = nil then begin
			erreur_interpreteur := PROGRAMME_FINIE;
			fin := true;
		end else begin
			if interprete_ligne(l^.chaine) then begin

				if branchement then
					l := prochain
				else
					l := l^.prochain

			end else	(* erreur de l'interpr‚teur *)

				fin := true;
		end;
	until fin = true;
end;

begin
	initialise := false;
end.

end.