[Download the source file]

Program mathrt_t(output);

{

Tests Pascal runtime library built-in functions:

Abs(), integer Sqr(), integer ** operator, Round(), Trunc().

All tests should pass, and error recovery tests at end should pass

when program linked with mathruntime_tune object code.

}

{$SETC M68K := UNDEFINED MWERKS | MAC68K}

{$IFC NOT M68K}

Uses 
  MachineExceptions; { InstallExceptionHandler }

{$ENDC}

{ Test MW Pascal MathRuntime library or its equivalent }

Type
  HandlerPtr = ^Char;
  error_vectors = (divide0, chk, overflow); { In 68K order, '020 p. 8-3 }

Var
  i: Integer;
  g_test_count : 0..MaxLongInt;
  g_exception_count : Integer;
  vector_p: array[error_vectors] of ^HandlerPtr;
  g_save_vector: array[error_vectors] of HandlerPtr;
  g_err_hdlr_68k : array[1..5] of Integer;

{$IFC NOT M68K}

  g_old_hdlr_ppc : ExceptionHandler;

{$ENDC}

Procedure Check(val, expected: Longint);

begin
g_test_count := g_test_count + 1;
if val <> expected then
  WriteLn(output, '###', g_test_count:4, ' ', val:0, ' # ',expected:0);
end;

Procedure Ignore(val: LongInt);

begin
end;

{ Prevent front-end evaluation of builtin functions w/ const. args. }

Function Trunc_(x: Extended): Longint;

begin
Trunc_ := Trunc(x)
end;

Function Round_(x: Extended): Longint;

begin
Round_ := Round(x)
end;

Function Abs_(x: Longint): Longint;

begin
Abs_ := Abs(x)
end;

Function Sqr_(x: Longint): Longint;

begin
Sqr_ := Sqr(x)
end;

Function Pow_(base,expon: Longint): Longint;

begin
Pow_ := base**expon
end;

{$IFC NOT M68K}

{$PUSH}

{ Can't allow runtime tests within error handler!! }

{$OV-}

{$R-}

Function MyExceptionHandler(var theException: ExceptionInformationPowerPC): 
OSStatus;

begin
MyExceptionHandler := -1; { What's the best default return value? }
if theException.theKind = kTrapException then 
  begin
  g_exception_count := g_exception_count + 1;
  { Make sure we resume after the tw instr. }
  { This add assumes only 32 bit PC! }
  theException.machineState^.PC.lo := theException.machineState^.PC.lo + 4;
  MyExceptionHandler := noErr;
  end
end; { MyExceptionHandler }

{$POP}

{$ENDC}

Procedure Install_Err_Handler;

Var
  er: error_vectors;
  exception_count_addr: LongInt;

begin

{$IFC M68K}

exception_count_addr := ord(@g_exception_count);

{ Kludge: store 2-instruction (5 word) trap handler in an array }
{ Avoiding inline asm makes compatible with Apple Pascal }

g_err_hdlr_68k[1] := $0679; { ADDI.W }
g_err_hdlr_68k[2] := 1;
g_err_hdlr_68k[3] := HiWrd(exception_count_addr); { (exception_count_addr).L }
g_err_hdlr_68k[4] := LoWrd(exception_count_addr);
g_err_hdlr_68k[5] := $4E73; { RTE }

for er := divide0 to overflow do 
  begin
  vector_p[er] := Pointer(ord(er)*4 + $14);
  g_save_vector[er] := vector_p[er]^;

{ All errors share same handler }

  vector_p[er]^ := @g_err_hdlr_68k;
  end;

{$ELSEC}

g_old_hdlr_ppc := InstallExceptionHandler(@MyExceptionHandler);

{$ENDC}

end; { Install_Err_Handler }

Procedure Remove_Err_Handler;

Var
  er: error_vectors;

begin

{$IFC M68K}

{ Restore original vectors }
for er := divide0 to overflow do
  vector_p[er]^ := g_save_vector[er];

{$ELSEC}

if InstallExceptionHandler(g_old_hdlr_ppc) = nil then; { Discard result }

{$ENDC}

end; { Remove_Err_Handler }

Begin { main }
g_test_count := 0;
g_exception_count := 0;
Install_Err_Handler;

Check(Sqr_(-32767), 1073676289);
Check(Sqr_(32768), $40000000);
Check(Sqr_(46340), 2147395600);
Check(Sqr_(0), 0);

Check(Pow_(3,15), 14348907);
Check(Pow_(-3,15),-14348907);
Check(Pow_(2,30), $40000000); 
Check(Pow_(-2,30), $40000000);
Check(Pow_(-2,31), -MaxLongInt-1);
Check(Pow_(10,6), 1000000);
Check(Pow_(1,-1), 1);
Check(Pow_(2,-1), 0);
Check(Pow_(2,0), 1);
Check(Pow_(-3,0), 1);
Check(Pow_(0,0), 1);
Check(Pow_(0,1), 0);
Check(Pow_(0,65536), 0);
Check(Pow_(-1,-1), -1);
Check(Pow_(-2,-1), 0);
Check(Pow_(MaxLongInt,-1), 0);
Check(Pow_(-MaxLongInt,-1), 0);

for i := 0 to +10000 do 
  begin
  Check(Trunc(i), i);
  Check(Trunc(i+0.1), i);
  Check(Trunc(i+0.5), i);
  Check(Trunc(i+0.99), i);
  Check(Trunc(-i), -i);
  Check(Trunc(-i-0.1), -i);
  Check(Trunc(-i-0.5), -i);
  Check(Trunc(-i-0.99), -i);
  end; 
Check(Trunc_(2147483646.9), 2147483646);
Check(Trunc_(-2147483646.9), -2147483646);
Check(Trunc_(-2147483648.9), -MaxLongInt-1);

for i := 0 to +10000 do 
  begin
  Check(Round(i), i);
  Check(Round(i+0.1), i);
  Check(Round(i+0.49), i);
  Check(Round(i+0.50), i+1);
  Check(Round(i+0.99), i+1);
  Check(Round(-i), -i);
  Check(Round(-i-0.1), -i);
  Check(Round(-i-0.49), -i);
  Check(Round(-i-0.50), -i-1);
  Check(Round(-i-0.99), -i-1);
  end; 
Check(Round_(2147483646.9), 2147483647);
Check(Round_(-2147483646.9), -2147483647);

Check(Abs_(-2983843), 2983843);
Check(Abs_(2983843), 2983843);
Check(Abs_(0), 0);

{ Test runtime errors in patched version of MathRuntime }
{ Relies upon trap handler to recover from errors }

Ignore(Pow_(0,-1));
Ignore(Pow_(2,31)); 
Ignore(Pow_(2,32));
Ignore(Pow_(3,20));
Ignore(Pow_(3,-20));
Ignore(Round_(-Inf));
Ignore(Trunc_(Inf));
Ignore(Trunc_(999999999999.0));
Ignore(Round_(-999999999999.0));
Ignore(Abs_(-MaxLongInt-1)); { PPC inline abs() doesn't check OV. }
if g_exception_count < 10 then 
  begin
  Writeln(output, '### Too few traps occurred (',g_exception_count:0,')!');
  end;

Remove_Err_Handler;
Writeln(output, '### Complete.')
end.