123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546 |
- (* CAPO - Computational Analysis Platform for Oberon - by Alan Freed and Felix Friedrich. *)
- (* Version 1, Update 2 *)
- MODULE DataErrors; (** AUTHOR "adf, fof"; PURPOSE "For reporting runtime warnings & errors into file Error.Log"; *)
- (** Error.Log is an error log file that can be viewed with any ASCII editor, and is overwritten with each session.
- If no errors or warnings were logged, the file will be empty. File Error.Log is automatically opened/closed whenever
- module DataErrors.Mod is loaded-into/freed-from the system. The Error.Log file from the previous session is saved in
- file Error.Log.Bak.
- Logging of the first error message of a session produces an audible SOS beep to inform the user to check this file.
- Logging of the first warning message of a session produces just 3 beeps (instead of 9) in the SOS tone sequence.
- Errors are for catostropic events, e.g., division by zero.
- Warnings are for non-optimal events, e.g., a series did not converge. *)
- IMPORT SYSTEM, Machine, Kernel, Modules, Files, Beep, NbrInt, NbrRat, NbrRe, NbrCplx;
- VAR
- beepedError, beepedWarning: BOOLEAN; F: Files.File; W: Files.Writer;
- (***! BEGIN part from Traps, todo: simplify and adjust to needs *)
- TYPE
- Variable = RECORD
- adr, type, size, n, tdadr: LONGINT
- END; (* variable descriptor *)
- CONST
- MaxString = 64; MaxArray = 8; MaxCols = 70; Sep = " "; SepLen = 2;
- (* Write the specified procedure name and returns parameters for use with NextVar and Variables. *)
- (* Find a procedure in the reference block. Return index of name, or -1 if not found. *)
- 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 (* proc *)
- GetNum( refs, i, t ); (* pofs *)
- IF t > modpc THEN (* previous procedure was the one *)
- ch := 0X (* stop search *)
- ELSE (* ~found *)
- IF ch = 0F9X THEN
- GetNum( refs, i, t ); (* nofPars *)
- INC( i, 3 ) (* RetType, procLev, slFlag *)
- END;
- proc := i; (* remember this position, just before the name *)
- REPEAT ch := refs[i]; INC( i ) UNTIL ch = 0X; (* pname *)
- IF i < m THEN
- ch := refs[i]; INC( i ); (* 1X | 3X | 0F8X | 0F9X *)
- WHILE (i < m) & (ch >= 1X) & (ch <= 3X) DO (* var *)
- ch := refs[i]; INC( i ); (* type *)
- IF (ch >= 81X) OR (ch = 16X) OR (ch = 1DX) THEN
- GetNum( refs, i, t ) (* dim/tdadr *)
- END;
- GetNum( refs, i, t ); (* vofs *)
- REPEAT ch := refs[i]; INC( i ) UNTIL ch = 0X; (* vname *)
- IF i < m THEN ch := refs[i]; INC( i ) END (* 1X | 3X | 0F8X | 0F9X *)
- END
- END
- END
- END;
- IF (proc = -1) & (i # 0) THEN proc := i END; (* first procedure *)
- 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, LONGINT(ADDRESSOF( 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 := LONGINT(mod.sb) ELSE base := fp END; (* for variables *)
- 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;
- (* Find procedure name and write it. *)
- PROCEDURE WriteProc( pc: LONGINT );
- VAR refs: Modules.Bytes; refpos, base: LONGINT;
- BEGIN
- WriteProc0( Modules.ThisModuleByAdr( pc ), pc, -1, refs, refpos, base )
- END WriteProc;
- (* Write a simple variable value. *)
- PROCEDURE WriteSimpleVar( adr, type, tdadr: LONGINT; VAR col: LONGINT );
- VAR ch: CHAR; sval: SHORTINT; ival: INTEGER; lval: LONGINT;
- BEGIN
- CASE type OF
- 1, 3: (* BYTE, CHAR *)
- 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: (* BOOLEAN *)
- 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: (* SHORTINT *)
- SYSTEM.GET( adr, sval );
- W.Int( sval, 1 ); INC( col, 4 )
- (*Streams.WriteString(w, " ("); Streams.WriteHex(w, sval, -3); Streams.WriteString(w, "H)")*)
- | 5: (* INTEGER *)
- SYSTEM.GET( adr, ival );
- W.Int( ival, 1 ); INC( col, 5 )
- (*Streams.WriteString(w, " ("); Streams.WriteHex(w, ival, 8); Streams.WriteString(w, "H)")*)
- | 6: (* LONGINT *)
- 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: (* REAL, LONGREAL, POINTER *)
- 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: (* SET *)
- SYSTEM.GET( adr, lval );
- W.Set( SYSTEM.VAL( SET, lval ) ); INC( col, 8 ) (* col is guess *)
- | 22: (* RECORD *)
- W.String( "Rec." ); W.Hex( tdadr, 8 ); W.Char( "H" ); INC( col, 13 )
- | 14: (* PROC *)
- SYSTEM.GET( adr, lval ); WriteProc( lval ); INC( col, 25 )
- END
- END WriteSimpleVar;
- (* Write a variable value. The v parameter is a variable descriptor obtained with NextVar. Parameter col is incremented with
- the (approximate) number of characters written. *)
- 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;
- (* Get a compressed refblk number. *)
- 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;
- (* Step to the next variable in the refs block. The name parameter returns empty if no more variables are found. The attributes
- are returned in v. Parameter refpos is modified. *)
- 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; (* empty name signals end or error *)
- IF refpos < LEN( refs^ ) - 1 THEN
- mode := refs[refpos]; INC( refpos );
- IF (mode >= 1X) & (mode <= 3X) THEN (* var *)
- 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 (* best guess *) ELSE x.n := 1 END
- END;
- (* get address *)
- GetNum( refs, refpos, x.adr );
- INC( x.adr, base ); (* convert to absolute address *)
- IF x.n = 0 THEN (* open array (only on stack, not global variable) *)
- SYSTEM.GET( x.adr + 4, x.n ) (* real LEN from stack *)
- END;
- IF mode # 1X THEN SYSTEM.GET( x.adr, x.adr ) END; (* indirect *)
- (* get size *)
- 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 (* ok, get name *)
- ch := refs[refpos]; INC( refpos ); j := 0;
- WHILE ch # 0X DO
- IF j < LEN( name ) - 1 THEN name[j] := ch; INC( j ) END; (* truncate long names *)
- ch := refs[refpos]; INC( refpos )
- END;
- name[j] := 0X; v := x (* non-empty name *)
- END
- END
- END
- END NextVar;
- (* Find the specified global variable and return its descriptor. Returns TRUE iff the variable is found. *)
- 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;
- (* write name *)
- IF (col # 0) & (v.n > 1) & (v.type # 15) THEN (* Ln before array (except string) *)
- 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 );
- (* write variable *)
- IF (v.adr >= -4) & (v.adr < 4096) THEN (* must be NIL VAR parameter *)
- 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 ); (* write value *)
- 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 := LONGINT(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;
- (* Display call trackback. *)
- PROCEDURE StackTraceBack( eip, ebp: LONGINT; long: BOOLEAN );
- VAR count, refpos, base: LONGINT; m: Modules.Module; refs: Modules.Bytes;
- CONST MaxFrames = 16;
- BEGIN
- count := 0; (* frame count *)
- 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 (* show variables *)
- 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 ); (* return addr from stack *)
- SYSTEM.GET( ebp, ebp ); (* follow dynamic link *)
- INC( count )
- ELSE ebp := 0
- END
- UNTIL (ebp = 0) OR (count = MaxFrames);
- IF ebp # 0 THEN W.String( "..." ) END
- END StackTraceBack;
- (***! END part from Traps *)
- (* From antsPortability *)
- PROCEDURE ErrorCaller( VAR m: Modules.Module; VAR pc, ebp, eip: NbrInt.Integer );
- VAR i, reg: NbrInt.Integer; timer: Kernel.Timer;
- BEGIN
- reg := LONGINT(SYSTEM.GetFramePointer ());
- SYSTEM.GET( reg, ebp ); (* stack frame of caller *)
- SYSTEM.GET( ebp + 4, eip ); (* return address from caller *)
- m := Modules.ThisModuleByAdr( eip );
- IF m # NIL THEN pc := LONGINT(eip - ADDRESSOF( 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 := LONGINT(SYSTEM.GetFramePointer ());
- SYSTEM.GET( reg, ebp ); (* stack frame of caller *)
- SYSTEM.GET( ebp + 4, eip ); (* return address from caller *)
- m := Modules.ThisModuleByAdr( eip );
- IF m # NIL THEN pc := LONGINT(eip - ADDRESSOF( 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: LONGINT; adr: LONGINT;
- BEGIN
- IF m # NIL THEN
- refs := m.refs; refpos := FindProc( refs, pc );
- GetNum( refs, refpos, adr );
- INC( adr, LONGINT(m.sb)); (* convert to absolute address *)
- 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;
- (** Log an error message to file Error.Log. *)
- 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;
- (** Log an error message to file Error.Log when an error arises from a passed parameter whose value was int. *)
- 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;
- (** Log an error message to file Error.Log when an error arises from a passed parameter whose value was rat. *)
- 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;
- (** Log an error message to file Error.Log when an error arises from a passed parameter whose value was re. *)
- 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;
- (** Log an error message to file Error.Log when an error arises from a passed parameter whose value was cplx. *)
- 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;
- (** Log a warning message to file Error.Log. *)
- 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;
- (** Log a warning message to file Error.Log when a warning arises from a passed parameter whose value was int. *)
- 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;
- (** Log a warning message to file Error.Log when a warning arises from a passed parameter whose value was rat. *)
- 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;
- (** Log a warning message to file Error.Log when a warning arises from a passed parameter whose value was re. *)
- 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;
- (** Log a warning message to file Error.Log when a warning arises from a passed parameter whose value was cplx. *)
- 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;
- (** Opens the file Error.Log, saving the prior log file to Error.Log.Bak.
- Error.Log is automatically opened whenever this module is loaded into memory,
- and it only needs to be reopened manually if you had previously closed it manually. *)
- PROCEDURE Open*;
- VAR ignor: WORD; 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;
- (** Closes the file Error.Log.
- Error.Log is automatically closed whenever this module is garbage collected.
- Executing Close forces the file to close immediately. *)
- 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 ~
-
|