home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 December
/
simtel1292_SIMTEL_1292_Walnut_Creek.iso
/
msdos
/
calcultr
/
doit.arc
/
DO_EVAL.PAS
next >
Wrap
Pascal/Delphi Source File
|
1989-09-24
|
9KB
|
255 lines
{ $ DEFINE DEBUG}
Unit Do_eval;
(*
┌───────────────────────────────────────────────────────────────────────────┐
│ Unidad DO_EVAL.PAS │
├───────────────────────────────────────────────────────────────────────────┤
│ Versión : 1.0 │
│ Computadora : IBM-PC o compatible │
│ Lenguaje : Turbo Pascal 5.5 │
│ Autor : Bernardo Zamora Etcharren │
├──────────────────┬────────────────────────────────────────────────────────┤
│ Explanation : │ │
├──────────────────┘ │
│ This unit evaluates a function already converted to RPN. │
│ │
│ │
└───────────────────────────────────────────────────────────────────────────┘
*)
INTERFACE
Uses
do_type;
Function evalua_polaca(var rpn : rpn_type; valor : real):real;
IMPLEMENTATION
uses
do_mate;
var
i : integer;
stack : array[1..100] of real;
stk : integer; { stack counter }
aux,aux2 : real;
auxtxt : string; { for the messages generated by the operation }
nodo : do_element;
Function evalua_polaca(var rpn : rpn_type; valor : real):real;
Procedure do_Error(num:integer; ss:string);
{ updates error value and error string }
begin
rpn.message := ss;
rpn.error := num;
end;
Function Pop : real;
begin
pop:=stack[stk];
dec(stk);
end;
Procedure Push(x:real);
begin
inc(stk);
stack[stk]:=x;
end;
{ MAIN evalua_polaca }
begin
with RPN do begin
error := 0; message := ''; { zero initial conditions }
stk:=0;
evalua_polaca:=0;
{$IFDEF DEBUG}
writeln;
{$ENDIF}
for i:=1 to p1 do begin
{$IFDEF DEBUG}
writeln('A ver que hago con un ',s1[i].tipo);
{$ENDIF}
case s1[i].tipo of
'P':{parentesis}
{$IFDEF DEBUG}
writeln('ERROR, check EVALUATE unit.') { thsi SHOULDN'T happen!! }
{$ENDIF}
;
'U':{operacion unaria}
begin
if s1[i].operacion = 'SIN' then
push(sin(pop))
else if s1[i].operacion = 'COS' then
push(cos(pop))
else if s1[i].operacion = 'TAN' then begin
aux:=pop;
if abs(aux)<>pi then push(tan(aux))
else do_error(ERROR_TANGENTE,ERROR_TANGENTE_S);
end else if s1[i].operacion = 'COT' then begin
aux:=tan(pop);
if aux<>0 then push(1/aux)
else do_error(ERROR_COTANGENTE,ERROR_COTANGENTE_S);
end else if s1[i].operacion = 'SEC' then begin
aux:=cos(pop);
if aux<>0 then push(1/aux)
else do_error(ERROR_SECANTE,ERROR_SECANTE_S);
end else if s1[i].operacion = 'CSC' then begin
aux:=sin(pop);
if aux<>0 then push(1/aux)
else do_error(ERROR_COSECANTE,ERROR_COSECANTE_S);
end
else if s1[i].operacion = 'LN' then begin
aux:=pop;
if aux>0.001 then push(ln(aux))
else do_error(ERROR_LN,ERROR_LN_S);
end else if s1[i].operacion = 'LOG' then begin
aux:=pop;
if aux>0 then push(log(aux))
else do_error(ERROR_LOG,ERROR_LOG_S);
end
else if s1[i].operacion = 'FRAC' then
push(frac(pop))
else if s1[i].operacion = 'INT' then
push(int(pop)) { why not using trunc ?? don't know!! }
else if s1[i].operacion = 'ABS' then
push(abs(pop))
else if s1[i].operacion = 'ROUND' then
push(round(pop))
else if s1[i].operacion = 'SGN' then
push(sgn(pop))
else if s1[i].operacion = 'SQRT' then begin
aux:=pop;
if aux>=0 then push(sqrt(aux))
else do_error(ERROR_SQRT,ERROR_SQRT_S);
end
else if s1[i].operacion = 'ASIN' then begin
aux:=pop;
aux:=-aux*aux+1;
if aux>0 then { strictly greater }
push( arctan (aux / (sqrt(aux)) ) )
else do_error(ERROR_SIN_INV,ERROR_SIN_INV_S);
end else if s1[i].operacion = 'ACOS' then begin
aux:=pop;
aux:=-aux*aux+1;
if aux>0 then { strictly greater }
push(arctan ( aux / (sqrt(aux)) + 1.5708))
else do_error(ERROR_COS_INV,ERROR_COS_INV_S);
end else if s1[i].operacion = 'ATAN' then
push(arctan(pop))
else if s1[i].operacion = 'ACOT' then begin
aux:=pop;
push(arctan(aux)+1.5708)
end else if s1[i].operacion = 'ASEC' then begin
aux:=pop;
aux2:=aux*aux-1;
if aux2>0 then { strictly greater }
push( arctan( aux / sqrt (aux2) ) + sgn(sgn(aux)-1) * 1.5708)
else do_error(ERROR_SEC_INV,ERROR_SEC_INV_S);
end else if s1[i].operacion = 'ACSC' then begin
aux:=pop;
aux2:=aux*aux-1;
if aux2>0 then { strictly greater }
push(arctan(aux/sqrt(aux2))+(sgn(aux)-1)*1.5708)
else do_error(ERROR_CSC_INV,ERROR_CSC_INV_S);
end
else if s1[i].operacion = 'SINH' then begin
aux:=pop;
push( (exp(aux)-exp(-aux))/2 )
end else if s1[i].operacion = 'COSH' then begin
aux:=pop;
push( (exp(aux)+exp(-aux))/2 )
end else if s1[i].operacion = 'TANH' then begin
aux:=pop;
aux2:=exp(aux)+exp(-aux);
if aux2<>0 then
push( (exp(aux)-exp(-aux))/aux2)
else do_error(ERROR_TAN_HIP,ERROR_TAN_HIP_S);
end else if s1[i].operacion = 'COTH' then begin
aux:=pop;
aux2:=exp(aux)-exp(-aux);
if aux2<>0 then
push((exp(aux)+exp(-aux))/aux2)
else do_error(ERROR_COT_HIP,ERROR_COT_HIP_S);
end else if s1[i].operacion = 'SECH' then begin
aux:=pop;
aux:=exp(aux) + exp(-aux);
if aux<>0 then
push(2/aux)
else do_error(ERROR_SEC_HIP,ERROR_SEC_HIP_S);
end else if s1[i].operacion = 'CSCH' then begin
aux:=pop;
aux:=exp(aux) - exp(-aux);
if aux<>0 then
push(2/aux)
else do_error(ERROR_CSC_HIP,ERROR_CSC_HIP_S);
end
else if s1[i].operacion = 'GRADOS' then
push(grados(pop))
else if s1[i].operacion = 'RAD' then
push(rad(pop))
else if s1[i].operacion = '-' then
push(-(pop))
else if s1[i].operacion = 'EXP' then
push(exp(pop))
end; { 'U - unary operation }
'O':{binary operation}
case s1[i].operacion[1] of
'+': push (pop + pop);
'-': begin
aux := -pop;
push (aux + pop);
end;
'*': push (pop * pop);
'/': begin aux:=pop;
if aux<>0 then
push ( (1/aux) * pop)
else do_error(ERROR_X_ENTRE_0,ERROR_X_ENTRE_0_S);
end;
'^': begin
aux:=pop; { The exponent }
if abs(aux)=int(aux) then { Exponent positive integer }
push ( ALAI(pop,trunc(aux)) )
else begin { Exponent fraccionary or negative }
aux2:=pop; { The base }
if aux2>0 then
push(ALA(aux2,aux))
else do_error(ERROR_EXP_Y_BASE_NEG,ERROR_EXP_Y_BASE_NEG_S);
end;
end;
end;
'N':{constant number}
push(s1[i].numero);
'V':{variable that is to be substituted}
push(valor);
end; {case}
end;
aux:=pop;
if error=0 then evalua_polaca := aux;
{ This last line if_not_error is VITAL 'cause if not present it makes
a POP of garbage.. discovered trying y=sqrt(1-x) }
end; { with rpn do }
end;
begin
end.
