(* 
	Programme pour interpreter un Pcode, version MIAS2 1999.

	La plupart des tests qui sont effectuÈs sont inutiles, 
	lorsque la traduction est correcte !
*)

uses crt, dos ;


Const 

	PMax = 8000 ;

        ADD = 1 ;       SUB = 2 ;       MUL = 3 ;       NEG = 4 ;
        ET = 5 ;        OU = 6 ;        LNEG = 7 ;      EQU = 8 ;
        GEQ = 9 ;       LEQ = 10 ;      LES = 11 ;      GRT = 12 ;
        NEQ = 13 ;      LDC = 14 ;      LDO = 15 ;      STO = 16 ;
        MOV = 17 ;      CHK = 18 ;      PECRIRE = 19 ;  PLIRE = 20 ;
        UJP = 21 ;      FJP = 22 ;      INIT = 23 ;     RES = 24 ;
        RET = 25 ;      ERREUR = 26 ;   PECRIREC = 27 ;


Type
	pinstruction = record
		operation : integer ;
		argument : longint
	end ;

Var
	pcode : file of pinstruction ;
	voperation : integer ;
	vargument : longint ;

	Pile : array[0..PMax] of longint ;
        Pdef : array[0..PMax] of boolean ; (* definition des donnees *)
        SP,                     (* pointeur de pile *)
        SPdonnees : integer ;   (* sommet des donnees *)

        caracteres : boolean ;  (* pour l'utilisation de PECRIREC *)

	CPdonnees,	   (* adresse du dernier RES *)
	i,	           (* un compteur pour RES et PLIRE *)
        entree : integer ; (* pour PLIRE *)

	CPMax : longint ;  (* derniere ligne du Pcode *)
	
        fichier : PathStr ;   (* types definis dans l'unite Dos *)
	repertoire : Dirstr ;
	nom : NameStr ;
	extension : ExtStr ;

function position : longint ;
begin
	position := filepos( pcode )
end ;

procedure sortir ;
begin
        writeln( ' (ligne : ',  position - 1, ' du Pcode)' ) ;
        halt( 1 )
end ;

procedure empilement ( k : integer ) ;
begin
	if SP + k > PMax then begin
		writeln( 'Debordement de la pile' ) ;
                sortir
	end
end ;

procedure arite ( k : integer ) ; (* normalement : test inutile *)
begin
	if SP < SPdonnees + k  then begin
		write( 'Nombre d''arguments insuffisant' ) ;
                sortir
	end
end ;

procedure consulter ; (* lire une ligne du Pcode *)
var v : pinstruction ;
begin
	read( pcode, v ) ;
	voperation := v.operation ;
	vargument := v.argument
end ;



begin

	if paramcount = 0 then begin
		writeln( 'Commande : Pcode Fichier[.PCO]' ) ;
		halt( 1 )
	end ;

	fichier := fexpand( paramstr( 1 ) ) ;
	fsplit( fichier, repertoire, nom, extension ) ;

	if nom + extension = '' then begin
		writeln( 'Commande : Pcode Fichier[.PCO]' ) ;
		halt( 1 )
	end ;

	if extension = '' then extension := '.PCO' ;

	{$I-}
	assign( pcode, repertoire + nom + extension ) ;
	reset( pcode ) ;
	{$I+}

	if IOResult <> 0 then begin
		write('Impossible d''ouvrir le fichier : ' ) ;
		writeln( repertoire + nom + extension ) ;
		halt( 1 )
	end ;

	CPMax := filesize( pcode ) ;     (* nombre de Pinstructions *)
	
	if CPMax = 0 then begin
		writeln( 'Fichier vide !' ) ;
		halt( 1 )
	end ;

	(* on commence la lecture du Pcode *)
	
	reset( pcode ) ;
	consulter ;
	if voperation <> INIT then begin
		writeln( 'Un Pcode doit commencer par INIT' ) ;
		halt( 1 )
	end ;

	caracteres := ( vargument = 1 ) ;
	SP := -1 ;
	SPdonnees := SP ;

	CPdonnees := 0 ;
	

	while not eof( pcode ) do begin  (* boucle principale *)

	consulter ;

	case voperation of

	ADD 	: begin
			arite( 2 ) ;
			Pile[SP - 1] := Pile[SP - 1] + Pile[SP] ;
			SP := SP - 1
		  end ;
	SUB	: begin
			arite( 2 ) ;
			Pile[SP - 1] := Pile[SP - 1] - Pile[SP] ;
			SP := SP - 1
		  end ;
	MUL	: begin
			arite( 2 ) ;
			Pile[SP - 1] := Pile[SP - 1] * Pile[SP] ;
			SP := SP - 1
		  end ;
	NEG	: begin
			arite( 1 ) ;
			Pile[SP] := - Pile[SP]
		  end ;
	ET	: begin
			arite( 2 ) ;
			if Pile[SP - 1] <> 0 then Pile[SP - 1] := Pile[SP] ;
			SP := SP - 1
		  end ;
	OU	: begin
			arite( 2 ) ;
			if Pile[SP - 1] = 0 then Pile[SP - 1] := Pile[SP] ;
			SP := SP - 1
		  end ;

        LNEG    : begin
			arite( 1 ) ;
			if Pile[SP] = 0 then Pile[SP] := 1
			else Pile[SP] := 0
		  end ;
	EQU	: begin 
			arite( 2 ) ;
			if Pile[SP - 1] = Pile[SP]
                        then Pile[SP - 1] := 1
			else Pile[SP - 1] := 0 ;
			SP := SP - 1
		  end ;
	GEQ	: begin 
			arite( 2 ) ;
                        if (Pile[SP - 1] >= Pile[SP]) then Pile[SP - 1] := 1
			else Pile[SP - 1] := 0 ;
			SP := SP - 1
		  end ;
	LEQ	: begin 
			arite( 2 ) ;
			if (Pile[SP - 1] <= Pile[SP]) then Pile[SP - 1] := 1
			else Pile[SP - 1] := 0 ;
			SP := SP - 1
		  end ;
	LES	: begin 
			arite( 2 ) ;
			if (Pile[SP - 1] < Pile[SP]) then Pile[SP - 1] := 1
			else Pile[SP - 1] := 0 ;
			SP := SP - 1
		  end ;
 	GRT	: begin 
			arite( 2 ) ;
			if (Pile[SP - 1] > Pile[SP]) then Pile[SP - 1] := 1
			else Pile[SP - 1] := 0 ;
			SP := SP - 1
		  end ;
	NEQ	: begin 
			arite( 2 ) ;
			if (Pile[SP - 1] <> Pile[SP]) then Pile[SP - 1] := 1
			else Pile[SP - 1] := 0 ;
			SP := SP - 1
		  end ;
	LDC	: begin 
			empilement( 1 ) ;
			SP := SP + 1 ;
			Pile[SP] := vargument
		   end ;
	LDO	: begin 
			empilement( 1 ) ;
			if (vargument < 0) or (vargument > SPdonnees) then
                        begin
				write( 'L''adresse ', vargument ) ;
				writeln( ' ne contient pas de donnee.' ) ;
                                sortir
			end ;
			if not Pdef[vargument] then begin
				write( 'Donnee non definie ' ) ;

				writeln( 'a l''adresse ', vargument ) ;
                                sortir
			end ;
			SP := SP + 1 ;
			Pile[SP] := Pile[vargument] 
		  end ;
	STO	: begin 
			arite( 2 ) ;
			if (Pile[SP-1] < 0) or (Pile[SP-1] > SPdonnees) then
                        begin
				write( 'L''adresse ', Pile[SP - 1]  ) ;
				writeln( ' ne contient pas de donnee.' ) ;
                                sortir
			end ;
			Pile[Pile[SP - 1]] := Pile[SP] ;
			Pdef[Pile[SP - 1]] := true ;
			SP := SP - 2
		  end ;
	MOV	: begin 
			arite( 1 ) ;
			if (Pile[SP] < 0) or (Pile[SP] > SPdonnees) then
                        begin
				write( 'L''adresse ', Pile[SP] ) ;
				writeln( ' ne contient pas de donnee.' ) ;
                                sortir
			end ;
			if not Pdef[Pile[SP]] then begin
				write( 'Donnee non definie ' ) ;
				writeln( 'a l''adresse ', Pile[SP] ) ;
                                sortir
			end ;
			Pile[SP] := Pile[Pile[SP]]
		  end ;
	CHK	: begin 
			arite( 1 ) ;
			if (Pile[SP] < 0) or  (Pile[SP] >= vargument) then
                        begin
				write( 'Depassement de domaine ' ) ;
				writeln( 'dans un tableau.' ) ;
                                sortir
			end
		  end ;
        PECRIRE : begin 
			arite( 1 ) ;
			write( Pile[SP] : 10 ) ;
                        if not caracteres then writeln ;
			SP := SP - 1
		  end ;
        PLIRE    : begin 
			empilement( 1 ) ;
			i := 0 ;
			repeat
				if i = 0 then write( 'Rentrer un entier : ' )
				else write( 'Un veritable entier : ' ) ;
				{$I-}
				readln( entree ) ;
				{$I+}
				i := i + 1
                        until IOResult = 0 ;
			SP := SP + 1 ;
			Pile[SP] := entree
		  end ;
	UJP	: begin
			if (vargument < 0) or (vargument > CPMax) then
                        begin
				write( 'Saut en dehors du Pcode !' ) ;
                                sortir
			end ;
			if vargument <= CPdonnees then begin
				write( 'Saut dans les declarations !' ) ;
                                sortir
			end ;
			if vargument = CPMax then begin
				write( 'Fin d''execution inattendue !' ) ;
                                sortir
			end ;
			seek( pcode, vargument ) 
		  end ;
 	FJP	: begin 
			arite( 1 ) ;
			if (vargument < 0) or (vargument > CPMax) then
                        begin
				write( 'Saut en dehors du Pcode !' ) ;
                                sortir
			end ;
			if vargument <= CPdonnees then begin
				write( 'Saut dans les declarations !' ) ;
                                sortir
			end ;
			if vargument = CPMax then begin
				write( 'Fin d''execution inattendue !' ) ;
                                sortir
			end ;
			if Pile[SP] = 0 then seek( pcode, vargument )
		  end ;
	INIT	: begin
			write( 'Pinstruction inattendue, ' ) ;
                        sortir
		  end ;
	RES	: begin 
			empilement( vargument ) ;
			for i := 1 to vargument do begin 
				SP := SP + 1 ;
				Pile[SP] := 0 ;
				Pdef[SP] := false ;
				SPdonnees := SPdonnees + 1
			end ;
			CPdonnees := CPdonnees + 1
		   end ;
	RET	: begin
                        writeln( 'Execution achevee.' ) ;
			halt( 0 ) ;
		  end ;
	ERREUR	: begin	(* on ne devrait jamais arriver ici *)
			writeln( ' Fin d''execution inattendue !' ) ;
                        sortir
		  end ;

        PECRIREC : begin 
			if (vargument < 0) or (vargument > 255) then
                        begin
				write('Code ASCII incorrect');
                                sortir
			end ;
			write( chr( vargument ) ) 
		  end ;

        ELSE      begin
			write( 'Pcode incorrect' ) ;
                        sortir
                  end ;

	end { case voperation of }

	end ;	 { while not eof( pcode ) }

	close( pcode ) ;

end.