MODULE DataErrors;
IMPORT SYSTEM, Machine, Kernel, Modules, Files, Beep, NbrInt, NbrRat, NbrRe, NbrCplx;
VAR
beepedError, beepedWarning: BOOLEAN; F: Files.File; W: Files.Writer;
TYPE
Variable = RECORD
adr, type, size, n, tdadr: LONGINT
END;
CONST
MaxString = 64; MaxArray = 8; MaxCols = 70; Sep = " "; SepLen = 2;
PROCEDURE FindProc( refs: Modules.Bytes; modpc: LONGINT ): LONGINT;
VAR i, m, t, proc: LONGINT; ch: CHAR;
BEGIN
proc := -1; i := 0; m := LEN( refs^ ); ch := refs[i]; INC( i );
WHILE (i < m) & ((ch = 0F8X) OR (ch = 0F9X)) DO
GetNum( refs, i, t );
IF t > modpc THEN
ch := 0X
ELSE
IF ch = 0F9X THEN
GetNum( refs, i, t );
INC( i, 3 )
END;
proc := i;
REPEAT ch := refs[i]; INC( i ) UNTIL ch = 0X;
IF i < m THEN
ch := refs[i]; INC( i );
WHILE (i < m) & (ch >= 1X) & (ch <= 3X) DO
ch := refs[i]; INC( i );
IF (ch >= 81X) OR (ch = 16X) OR (ch = 1DX) THEN
GetNum( refs, i, t )
END;
GetNum( refs, i, t );
REPEAT ch := refs[i]; INC( i ) UNTIL ch = 0X;
IF i < m THEN ch := refs[i]; INC( i ) END
END
END
END
END;
IF (proc = -1) & (i # 0) THEN proc := i END;
RETURN proc
END FindProc;
PROCEDURE WriteProc0( mod: Modules.Module; pc, fp: LONGINT; VAR refs: Modules.Bytes; VAR refpos, base: LONGINT );
VAR ch: CHAR;
BEGIN
refpos := -1;
IF mod = NIL THEN
IF pc = 0 THEN W.String( "NIL" ) ELSE W.String( "Unknown PC=" ); W.Hex( pc, 8 ); W.Char( "H" ) END;
IF fp # -1 THEN W.String( " FP=" ); W.Hex( fp, 8 ); W.Char( "H" ) END
ELSE
W.String( mod.name ); DEC( pc, SYSTEM.ADR( mod.code[0] ) ); refs := mod.refs;
IF (refs # NIL ) & (LEN( refs ) # 0) THEN
refpos := FindProc( refs, pc );
IF refpos # -1 THEN
W.Char( "." ); ch := refs[refpos]; INC( refpos );
IF ch = "$" THEN base := mod.sb ELSE base := fp END;
WHILE ch # 0X DO W.Char( ch ); ch := refs[refpos]; INC( refpos ) END
END
END;
W.String( " pc=" ); W.Int( pc, 1 )
END
END WriteProc0;
PROCEDURE WriteProc( pc: LONGINT );
VAR refs: Modules.Bytes; refpos, base: LONGINT;
BEGIN
WriteProc0( Modules.ThisModuleByAdr( pc ), pc, -1, refs, refpos, base )
END WriteProc;
PROCEDURE WriteSimpleVar( adr, type, tdadr: LONGINT; VAR col: LONGINT );
VAR ch: CHAR; sval: SHORTINT; ival: INTEGER; lval: LONGINT;
BEGIN
CASE type OF
1, 3:
SYSTEM.GET( adr, ch );
IF (ch > " ") & (ch <= "~") THEN W.Char( ch ); INC( col ) ELSE W.Hex( ORD( ch ), -2 ); W.Char( "X" ); INC( col, 3 ) END
| 2:
SYSTEM.GET( adr, ch );
IF ch = 0X THEN W.String( "FALSE" )
ELSIF ch = 1X THEN W.String( "TRUE" )
ELSE W.Int( ORD( ch ), 1 )
END;
INC( col, 5 )
| 4:
SYSTEM.GET( adr, sval );
W.Int( sval, 1 ); INC( col, 4 )
| 5:
SYSTEM.GET( adr, ival );
W.Int( ival, 1 ); INC( col, 5 )
| 6:
SYSTEM.GET( adr, lval );
W.Int( lval, 1 ); INC( col, 5 );
IF ABS( lval ) >= 10000H THEN W.String( " (" ); W.Hex( lval, 8 ); W.String( "H)" ); INC( col, 12 ) END
| 7, 8, 13, 16, 29:
INC( col, 9 );
IF (type = 8) OR (type = 16) THEN SYSTEM.GET( adr + 4, lval ); W.Hex( lval, 8 ); INC( col, 8 ) END;
SYSTEM.GET( adr, lval ); W.Hex( lval, 8 ); W.Char( "H" )
| 9:
SYSTEM.GET( adr, lval );
W.Set( SYSTEM.VAL( SET, lval ) ); INC( col, 8 )
| 22:
W.String( "Rec." ); W.Hex( tdadr, 8 ); W.Char( "H" ); INC( col, 13 )
| 14:
SYSTEM.GET( adr, lval ); WriteProc( lval ); INC( col, 25 )
END
END WriteSimpleVar;
PROCEDURE WriteVar( v: Variable; VAR col: LONGINT );
VAR ch: CHAR;
BEGIN
IF v.type = 15 THEN
W.Char( 22X );
LOOP
IF v.n = 0 THEN EXIT END;
SYSTEM.GET( v.adr, ch ); INC( v.adr );
IF (ch < " ") OR (ch > "~") THEN EXIT END;
W.Char( ch ); INC( col ); DEC( v.n )
END;
W.Char( 22X ); INC( col, 2 );
IF ch # 0X THEN W.Char( "!" ) END
ELSE
WHILE v.n > 0 DO
WriteSimpleVar( v.adr, v.type, v.tdadr, col ); DEC( v.n ); INC( v.adr, v.size );
IF v.n > 0 THEN W.String( ", " ); INC( col, 2 ) END
END
END
END WriteVar;
PROCEDURE GetNum( refs: Modules.Bytes; VAR i, num: LONGINT );
VAR n, s: LONGINT; x: CHAR;
BEGIN
s := 0; n := 0; x := refs[i]; INC( i );
WHILE ORD( x ) >= 128 DO INC( n, ASH( ORD( x ) - 128, s ) ); INC( s, 7 ); x := refs[i]; INC( i ) END;
num := n + ASH( ORD( x ) MOD 64 - ORD( x ) DIV 64 * 64, s )
END GetNum;
PROCEDURE NextVar( refs: Modules.Bytes; VAR refpos: LONGINT; base: LONGINT; VAR name: ARRAY OF CHAR; VAR v: Variable );
VAR x: Variable; j: LONGINT; ch, mode: CHAR;
BEGIN
name[0] := 0X;
IF refpos < LEN( refs^ ) - 1 THEN
mode := refs[refpos]; INC( refpos );
IF (mode >= 1X) & (mode <= 3X) THEN
x.type := ORD( refs[refpos] ); INC( refpos );
IF x.type > 80H THEN
IF x.type = 83H THEN x.type := 15 ELSE DEC( x.type, 80H ) END;
GetNum( refs, refpos, x.n )
ELSIF (x.type = 16H) OR (x.type = 1DH) THEN GetNum( refs, refpos, x.tdadr ); x.n := 1
ELSE
IF x.type = 15 THEN x.n := MaxString ELSE x.n := 1 END
END;
GetNum( refs, refpos, x.adr );
INC( x.adr, base );
IF x.n = 0 THEN
SYSTEM.GET( x.adr + 4, x.n )
END;
IF mode # 1X THEN SYSTEM.GET( x.adr, x.adr ) END;
CASE x.type OF
1..4, 15:
x.size := 1
| 5: x.size := 2
| 6..7, 9, 13, 14, 29:
x.size := 4
| 8, 16:
x.size := 8
| 22:
x.size := 0;
ASSERT ( x.n <= 1 )
ELSE x.size := -1
END;
IF x.size >= 0 THEN
ch := refs[refpos]; INC( refpos ); j := 0;
WHILE ch # 0X DO
IF j < LEN( name ) - 1 THEN name[j] := ch; INC( j ) END;
ch := refs[refpos]; INC( refpos )
END;
name[j] := 0X; v := x
END
END
END
END NextVar;
PROCEDURE Variables( refs: Modules.Bytes; refpos, base: LONGINT );
VAR v: Variable; j, col: LONGINT;
name: ARRAY 64 OF CHAR;
etc: BOOLEAN;
BEGIN
LOOP
NextVar( refs, refpos, base, name, v );
IF name[0] = 0X THEN EXIT END;
IF (col # 0) & (v.n > 1) & (v.type # 15) THEN
W.Ln(); col := 0
END;
W.String( Sep ); W.String( name ); W.Char( "=" ); j := 0;
WHILE name[j] # 0X DO INC( j ) END;
INC( col, SepLen + 1 + j );
IF (v.adr >= -4) & (v.adr < 4096) THEN
W.String( "NIL (" ); W.Hex( v.adr, 8 ); W.Char( ")" ); INC( col, 14 )
ELSE
etc := FALSE;
IF v.type = 15 THEN
IF v.n > MaxString THEN etc := TRUE; v.n := MaxString END
ELSE
IF v.n > MaxArray THEN etc := TRUE; v.n := MaxArray END
END;
WriteVar( v, col );
IF etc THEN W.String( "..." ); INC( col, 3 ) END
END;
IF col > MaxCols THEN W.Ln(); col := 0 END
END;
IF col # 0 THEN W.Ln() END
END Variables;
PROCEDURE InitVar( mod: Modules.Module; VAR refs: Modules.Bytes; VAR refpos, base: LONGINT );
VAR ch: CHAR;
BEGIN
refpos := -1;
IF mod # NIL THEN
refs := mod.refs; base := mod.sb;
IF (refs # NIL ) & (LEN( refs ) # 0) THEN
refpos := FindProc( refs, 0 );
IF refpos # -1 THEN
ch := refs[refpos]; INC( refpos );
WHILE ch # 0X DO ch := refs[refpos]; INC( refpos ) END
END
END
END
END InitVar;
PROCEDURE ModuleState( mod: Modules.Module );
VAR refpos, base: LONGINT; refs: Modules.Bytes;
BEGIN
InitVar( mod, refs, refpos, base );
IF refpos # -1 THEN W.String( "State " ); W.String( mod.name ); W.Char( ":" ); W.Ln(); Variables( refs, refpos, base ) END
END ModuleState;
PROCEDURE StackTraceBack( eip, ebp: LONGINT; long: BOOLEAN );
VAR count, refpos, base: LONGINT; m: Modules.Module; refs: Modules.Bytes;
CONST MaxFrames = 16;
BEGIN
count := 0;
REPEAT
m := Modules.ThisModuleByAdr( eip );
IF (m # NIL ) OR (count = 0) THEN
WriteProc0( m, eip, ebp, refs, refpos, base ); W.Ln();
IF long & ((count > 0)) THEN
IF refpos # -1 THEN Variables( refs, refpos, base ) END;
IF (m # NIL ) & (base # m.sb) & (count = 0) THEN ModuleState( m ) END
END;
SYSTEM.GET( ebp + 4, eip );
SYSTEM.GET( ebp, ebp );
INC( count )
ELSE ebp := 0
END
UNTIL (ebp = 0) OR (count = MaxFrames);
IF ebp # 0 THEN W.String( "..." ) END
END StackTraceBack;
PROCEDURE ErrorCaller( VAR m: Modules.Module; VAR pc, ebp, eip: NbrInt.Integer );
VAR i, reg: NbrInt.Integer; timer: Kernel.Timer;
BEGIN
reg := Machine.CurrentBP ();
SYSTEM.GET( reg, ebp );
SYSTEM.GET( ebp + 4, eip );
m := Modules.ThisModuleByAdr( eip );
IF m # NIL THEN pc := eip - SYSTEM.ADR( m.code[0] ) ELSE pc := MAX( LONGINT ) END;
IF ~beepedError THEN
beepedError := TRUE; NEW( timer );
FOR i := 1 TO 3 DO Beep.Beep( 125 ); timer.Sleep( 100 ); Beep.Beep( 0 ); timer.Sleep( 100 ) END;
FOR i := 1 TO 3 DO Beep.Beep( 100 ); timer.Sleep( 350 ); Beep.Beep( 0 ); timer.Sleep( 150 ) END;
FOR i := 1 TO 3 DO Beep.Beep( 125 ); timer.Sleep( 100 ); Beep.Beep( 0 ); timer.Sleep( 100 ) END
END
END ErrorCaller;
PROCEDURE WarningCaller( VAR m: Modules.Module; VAR pc, ebp, eip: NbrInt.Integer );
VAR reg: NbrInt.Integer; timer: Kernel.Timer;
BEGIN
reg := Machine.CurrentBP ();
SYSTEM.GET( reg, ebp );
SYSTEM.GET( ebp + 4, eip );
m := Modules.ThisModuleByAdr( eip );
IF m # NIL THEN pc := eip - SYSTEM.ADR( m.code[0] ) ELSE pc := MAX( LONGINT ) END;
IF ~beepedWarning THEN
beepedWarning := TRUE; NEW( timer ); Beep.Beep( 125 ); timer.Sleep( 100 ); Beep.Beep( 0 );
timer.Sleep( 100 ); Beep.Beep( 100 ); timer.Sleep( 100 ); Beep.Beep( 0 ); timer.Sleep( 100 );
Beep.Beep( 125 ); timer.Sleep( 100 ); Beep.Beep( 0 ); timer.Sleep( 100 )
END
END WarningCaller;
PROCEDURE IdentifyProcedure( VAR m: Modules.Module; pc: NbrInt.Integer; VAR module, type, proc: ARRAY OF CHAR );
VAR i: NbrInt.Integer; ch: CHAR; refs: Modules.Bytes; refpos: LONGINT;
BEGIN
module[0] := 0X; type[0] := 0X; proc[0] := 0X;
IF m = NIL THEN
IF pc = 0 THEN COPY( "NIL", proc ) ELSE COPY( "unknown pointer", proc ) END
ELSE
COPY( m.name, module ); refs := m.refs; refpos := FindProc( refs, pc );
IF refpos # -1 THEN
ch := refs[refpos]; NbrInt.Inc( refpos ); i := 0;
WHILE (ch # 0X) DO
proc[i] := ch; ch := refs[refpos]; NbrInt.Inc( refpos ); NbrInt.Inc( i );
IF ch = "." THEN ch := refs[refpos]; NbrInt.Inc( refpos ); proc[i] := 0X; COPY( proc, type ); i := 0 END
END;
proc[i] := 0X
ELSE COPY( "unknown", proc )
END
END
END IdentifyProcedure;
PROCEDURE Location( module, type, proc: ARRAY OF CHAR );
BEGIN
IF module[0] # 0X THEN W.String( " module: " ); W.String( module ); W.Ln END;
IF type[0] # 0X THEN
W.String( " type: " ); W.String( type ); W.Ln;
IF proc[0] # 0X THEN W.String( " method: " ); W.String( proc ); W.Ln END
ELSE
IF proc[0] # 0X THEN W.String( " procedure: " ); W.String( proc ); W.Ln END
END
END Location;
PROCEDURE DetailedErrorReport( VAR m: Modules.Module; pc: LONGINT; eip, ebp: LONGINT );
VAR refs: Modules.Bytes; refpos,adr: LONGINT;
BEGIN
IF m # NIL THEN
refs := m.refs; refpos := FindProc( refs, pc );
GetNum( refs, refpos, adr );
INC( adr, m.sb);
W.Hex(adr,8);W.Ln;
W.String( "Detailed Error Report" ); W.Ln;
IF m# NIL THEN W.String( "Module State:" ); W.Ln; ModuleState( m ); END;
W.String( "Stack trace back" ); W.Ln;
IF (eip # 0) & (ebp # 0) THEN StackTraceBack( eip, ebp, TRUE ); END;
END;
END DetailedErrorReport;
PROCEDURE Error*( message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
ErrorCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "An error of:" ); W.Ln; W.String( " " );
W.String( message ); W.Ln; W.String( "occurred in:" ); W.Ln; Location( module, type, proc ); W.Ln;
DetailedErrorReport(m,pc,eip,ebp);
W.Update
END
END Error;
PROCEDURE IntError*( int: NbrInt.Integer; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
ErrorCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "An ERROR occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this error was: " ); W.Ln; W.String( " " ); NbrInt.IntToString( int, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln;
DetailedErrorReport(m,pc,eip,ebp);
W.Update
END
END IntError;
PROCEDURE RatError*( rat: NbrRat.Rational; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
ErrorCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "An ERROR occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this error was: " ); W.Ln; W.String( " " ); NbrRat.RatToString( rat, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln;
DetailedErrorReport(m,pc,eip,ebp);
W.Update
END
END RatError;
PROCEDURE ReError*( re: NbrRe.Real; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
ErrorCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "An ERROR occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this error was: " ); W.Ln; W.String( " " ); NbrRe.ReToString( re, 15, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln;
DetailedErrorReport(m,pc,eip,ebp);
W.Update
END
END ReError;
PROCEDURE CplxError*( cplx: NbrCplx.Complex; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
ErrorCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "An ERROR occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this error was: " ); W.Ln; W.String( " " ); NbrCplx.CplxToPolarString( cplx, 15, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln;
DetailedErrorReport(m,pc,eip,ebp); W.Update
END
END CplxError;
PROCEDURE Warning*( message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
WarningCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "A WARNING of:" ); W.Ln; W.String( " " );
W.String( message ); W.Ln; W.String( "occurred in:" ); W.Ln; Location( module, type, proc ); W.Ln; W.Update
END
END Warning;
PROCEDURE IntWarning*( int: NbrInt.Integer; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
WarningCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "A WARNING occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this warning was: " ); W.Ln; W.String( " " ); NbrInt.IntToString( int, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln; W.Update
END
END IntWarning;
PROCEDURE RatWarning*( rat: NbrRat.Rational; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
WarningCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "A WARNING occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this warning was: " ); W.Ln; W.String( " " ); NbrRat.RatToString( rat, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln; W.Update
END
END RatWarning;
PROCEDURE ReWarning*( re: NbrRe.Real; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
WarningCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "A WARNING occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this warning was: " ); W.Ln; W.String( " " ); NbrRe.ReToString( re, 15, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln; W.Update
END
END ReWarning;
PROCEDURE CplxWarning*( cplx: NbrCplx.Complex; message: ARRAY OF CHAR );
VAR m: Modules.Module; pc: NbrInt.Integer;
module, type, proc, string: ARRAY 64 OF CHAR;
ebp, eip: LONGINT;
BEGIN {EXCLUSIVE}
IF W # NIL THEN
WarningCaller( m, pc, ebp, eip ); IdentifyProcedure( m, pc, module, type, proc ); W.String( "A WARNING occurred in:" ); W.Ln;
Location( module, type, proc ); W.String( "The argument passed that caused this warning was: " ); W.Ln; W.String( " " ); NbrCplx.CplxToPolarString( cplx, 15, string );
W.String( string ); W.Ln; W.String( "resulting in the following error message:" ); W.Ln; W.String( " " ); W.String( message ); W.Ln; W.Ln; W.Update
END
END CplxWarning;
PROCEDURE Open*;
VAR ignor: NbrInt.Integer; backup, current: Files.FileName;
BEGIN
beepedError := FALSE; beepedWarning := FALSE; COPY( "Error.Log", current ); COPY( "Error.Log.Bak", backup ); Files.Delete( backup, ignor );
Files.Rename( current, backup, ignor ); F := Files.New( current ); Files.OpenWriter( W, F, 0 )
END Open;
PROCEDURE Close*;
BEGIN
IF F # NIL THEN Files.Register( F ); W := NIL; F := NIL END
END Close;
BEGIN
Open; Modules.InstallTermHandler( Close )
END DataErrors.
DataErrors.Close ~
EditTools.OpenAscii Error.Log ~
EditTools.OpenAscii Error.Log.Bak ~