Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / pascal / library / dos / err_trap / frte / frte.pas < prev next >

Wrap

Pascal/Delphi Source File | 1991-01-06 | 24.5 KB | 586 lines

{$R-,S-,I-,D-,F-,V-,B-,N-,L+ } Unit FRTE; (**************************************************************** FORCED RUNTIME ERROR WITH ADDRESS UNIT FRTE5 Version 3.0 This is an experimental unit that provides a way for your "polished" procedures and functions to use TURBOs runtime error trapping support just as it does for TURBO's own system level procedures and functions. Many of the units we are now seeing generate error codes when the procedures and functions in the unit are passed bad or invalid data. These are normally handled one of four ways, 1) the program is halted with an error code (worst case), 2) a function like TURBO's ioresult function is used to test to see if any errors have occured, 3) the procedures and functions return an error code which the user must test for to detect an error, or 4) the unit sets a global error variable, which must then be tested. When you are using porcedures in such a Unit, it is tough to track down where in your code these errors are occuring, particularly if you have no source code for a unit. Likely you wrap around each call to the unit you are using a routine that checks to see if an error was detected our you use the debugger to back step through the program. Both of these can often be tedious, can require a lot more code and time, which literally clutters up a program. When you work with TURBO's procedures and functions, for example its IO routines, you can set the range and IO compiler flags to force TURBO to stop execution on an error, enter the editor, move the cursor to the line where the error occured, and diplay an error message. Nice. Well it was designed that way of course. Unfortunately, user routines do not have the same luxury. The FRTE unit is an attempt to improve this situation. FRTE allows any procedure to trap an error, link into Turbo's runtime error routines, and indicate an error has occured, WHERE THE PROCEDURE WAS CALLED, NOT WITHIN THE PROCEDURE ITSELF ! This makes debugging a LOT easier. FRTE also allows you to create central error handling routines that can make decisions as to how to respond to specific errors, i.e. correct it and continue, halt the program, or jump to Turbo's error handling routines. This version will work with TP ver 4.0, 5.0, 5.5, and 6.0. This unit is NOT dependent on any other Turbo units. This version uses about 1.5 K of code and data space. This unit at this time will NOT work with Turbo Professional 4.0 or 5.0 TPERRHAN Runtime Error Recovery routines (sorry). DOCUMENTATION procedure FRTError(FRTEaddr:pointer;errorcode:word); This is the routine that you can use to cause a runtime error similar to turbo's internal runtime errors, range errors etc. You supply and address where the error occurs, and an error code. This routine first shows an error message if ShowFRTEMessage is TRUE. Then it calls a runtime error handler function. A default error handler is installed by the initialization code which cause FRTE to halt the system via Turbo's error handlers. In this case if you are running under the IDE, the system will halt, the editor will be evoked, and the cursor will be placed on the line idenitified by FRTEaddr (see Find_FAR_Caller below for details). However, you can install your own routine via InstallFRTE(). The value returned by this user installed error handler is used to decide if the error will be ignored, if a jump to Turbo's SYSTEM:Runtime error routine will be made, or the program will be halted with an ErrorCode. When passed on to Turbo's routines with the address where the error occured, as defined by FRTEaddr, and the defined error code, the system will respond just like it does when Turbo generates a runtime error. If executed under the integrated editor, this will cause the compiler to search through the source code for the error location passed with FRTEaddr. It will then place you in the editor at the line for FRTEaddr. Now up to now, not much is different from TURBO's RUNERROR() procedure. However, when you execute RUNERROR(), the error is shown to have occured in the line with RUNERROR(). That is not what we want. We want the error to be where our unit was called. Find_FAR_Caller or Find_NEAR_Caller can be used to determine this location. function Find_Far_Caller(generation:word):pointer; Find_FAR_Caller is an unusual routine that can trace back a history of the location from which far declared procedures and functions (that is proceded with a $F+ compiler directive or declared in an interface section of a unit, or declared FAR) have been called. Hmmm ...... This will require a graphic. Take the following code: {$F+} procedure Child; begin P1 := Find_FAR_Caller(1); P2 := Find_FAR_Caller(2); P3 := Find_FAR_Caller(3); P4 := Find_FAR_Caller(4); end; procedure Parent; begin Child; end; procedure GrandParent; begin Parent; end; procedure GreatGrandParent; begin GrandParent; end; If we call GreatGrandParent by the time it finishes getting done with Child, P1 will be where Child was called in Parent, P2 will be where Parent was called in GrandParent, P3 will be where GrandParent was called in GreatGrandParent, P4 will be whereever GreatGrandParent was called. This function provides a way to figure out who called the routine that caused the error. This can then be passed to the error routine to show the error at the point routine was called, not in routine itself. Find_FAR_Caller(1) would be the location where the last call was made, Find_FAR_Caller(2) would be the location of the next to last call was made, etc. So by knowing how far your routine is nested, within your own unit, you should be able to find the routine making the call into the unit. Find_Near_Caller (generation:word):pointer; This functions the same as Find_Far_Caller, except it id used to trace through a stack of near (local) procedures and functions. ShowFRTEMessage : boolean; This boolean flag is used to determine if FRTE will display and error message. See FRTE_Message below. This is an easy way to use FRTE to display a custom error message without linking into FRTE with InstallFRTE. Normally a UNITS error handling routine will display a message so this is FALSE by default. FRTE_Message : string[40]; FRTE uses FRTEMessage for error display formating if ShowFRTEMessage is true. FRTEMessage must be a string. Several special codes are allowed in this string '#A' means display in hexidecimal format the adress where the error occured, '#C' means display error code in decimal, '#H' means display error code in Hex. InstallFRTE( UNIT_Error_Handler:FRTE_Handler_type ):word If you want you can use this routine to link your unit into the FRTE system, but this is optional. If your unit does not call this function, the FRTE system will work, but a default error handler will be used. This default error handler will halt the system via TURBO's runtime system. (See below for FRTE_handoer_type) If your unit does use this function, then FRTE will use your own custom error handling routine. InstallFRTE returns the an ID. This can be used with the error codes passed to FRTE. (See ERROR CODES ) Each time InstallFRTE is called a unique ID will be returned for up to 16 calls. This means multiple units can be using FRTE at the same time and FRTE will keep track of them. If InstallFRTE returns 0, then the unit was not installed and the default routine will be used. This can happen only if more than 16 units try to use FRTE at once. type FRTE_Handler_Type = function(ErrorAddress:pointer; ErrorCode:word):integer; This is the type of function to declare for InstallFRTE(). If this function returns a 0 then the error is ignored and execution continues at the point after FRTE() was called. If it returns a 1 then the FRTE system traps it. If it returns a -1 then then system is halted via the HALT() procedure with the errorcode passed used as the DOS error level code passed to HALT(). ErrorAddress is a the same address passed to FRTError and ErrorCode is the same value passed to FRTError with the ID stripped out (unless defined not to do so) See Below for details. With in this function you have full access to all of Turbo's procedures and functions. Generating an error code in this routine can result in very unpredictable results. ERROR CODES When FRTE is used by different UNITS a problem arises. Two units that use FRTE but come from different sources, could end up using the same error codes. This would get mighty confusing to the end user, or worse result in bad error handling. One unit using FRTE may trap another units error and do something it shouldn't. So to prevent this, FRTE maintains an array index of errorhandling routines to make sure each error is handled by the correct routine. This requires creating an ID for each unit or units that uses FRTE. The function InstallFRTE() returns a word value. This is an ID that is used with the errorcode in FRTError(). Even though TURBO's internal routines error codes currently are less than 256, these routines will accept and pass on a full 16 bit word error codes. (Version 5.5 and below will not display a code bigger than 256, ver 6 will display larger values). This allows the use of the high nibble of the error code as an id for each unit. The low byte then being the actual error code. This provides a scheme for tagging UNITS error codes and keeping them straight. With this in mind, UNITs error handling procedures muts use the following rules. 1) All UNITS must use errorcode less than $1fff. 2) Second, The InstallFRTE routine is a function that returns a word value. When a UNIT calls InstallFRTE, the value returned will be the UNIT'S id. Each unit when it passess an error code to FRTE must OR the errorcode value with its ID. This will let FRTE know which routine to pass error handling to. By default FRTE will strip off the ID before it passes control to the errorhandling routine. The error handling routine will receive the 12 bit errorcode. (This can be changed by removing the $DEFINE STRIPID in the implementation section of this unit. Leaving the ID attached will allow for the creation of central errorhandling routines that service multiple units.) 3) To set some standards (maybe) the following table of error codes is suggested for use. Error Codes Decimal Hex Purpose ------------------ ------- 1 - 34 $1- $22 Reserved - TURBO's DOS error code list 35 - 65 $23-$41 AVAILABLE - Use for DOS related error codes (31 codes available) 66 - 99 $42-$63 AVAILABLE - Use for UNIT specific error codes (34 codes available) 100 - 118 $64-$76 Reserved - TURBO's IO error codes list 119 - 149 $77-$95 AVAILABLE - Use for IO related error codes (31 codes available) 150 - 174 $96-$AE Reserved - TURBO's Critical error codes list 175 - 199 $AF-$C7 AVAILABLE - Use for error codes considered critical but which may not need to bring the system to a halt. (25 codes available) 200 - 224 $C8-$E0 Reserved TURBO's Fatal Error code list 225 - 255 $E1-$FF AVAILABLE - Use for fatal error codes that likely will require system to halt (31 error codes available) 256 - 511 $100-$1FF UNIT specific error codes, but use of these is discouraged. Refer to note below. (256 codes available) Units can still use Errorcodes located in the ranges reserved for TURBO if the error code/message matches TURBO's. For example a unit may need to use a file and cannot find it. Error codes 2,3,103 etc. may be appropriate. (Be sure to OR the error code with the Units ID. LIMITATIONS There are several limitations to this unit as now implemented. First, the programmer of a UNIT must develop a strategy to trace its lineage back to where it was called from the main code. With circular units and units that have a lot of internal (near) calls mixed with FAR calls, this can be quite confusing. A function called Get_EVE which requires no generation value, nor does it need to be near or far specific is now being played with. It may be included in a future update. FRTE can be used by only 16 units at one time. This can be expanded via the source code. copyright (C) 1990 McQuay Technologies Released into the public domain.........Be nice folks and share the credit if credit is due. ray quay version 3 12/1/90 Compuserve ID 72307,320 Prodigy ID WPTD01A McQuay Technologies 2329 E Cortez St Phoenix AZ 85028 Suite 291 8045 Antoine Houston TX 77088 =====================================================================*) Interface type FRTE_Handler_Type = function(ErrorAddress:pointer; ErrorCode:word):integer; const ShowFRTEMessage : boolean = false; FRTE_Message : string[40] = 'Extended ErrorCode #C #H at #A'; function InstallFRTE(Error_Handler:FRTE_Handler_type):word; procedure FRTError(FRTEaddr:pointer;errorcode:word); function Find_Far_Caller(generation:word):pointer; function Find_NEAR_Caller(generation:word):pointer; {=====================================================================} Implementation {$DEFINE STripID} const MAXUNITS = 16; UNITID : word = 0; UNITS_Loaded : byte = 0; var Error_Jump : pointer; Error_Jump_Ofs : word; BaseSeg : word; FRTE_Handler_Table : array[0..MAXUNITS] of record ID:word; UNITHandler:FRTE_Handler_Type; end; {--------------------------------------------------------------------------} { Used to display hex values, short and sweet } const hexchar : array[0..15] of char = ('0','1','2','3','4','5','6','7','8', '9','A','B','C','D','E','F'); function hexptr(value:pointer):string; var data : array[0..3] of byte absolute value; begin hexptr[1] := hexchar[data[3] shr 4]; hexptr[2] := hexchar[data[3] and $f]; hexptr[3] := hexchar[data[2] shr 4]; hexptr[4] := hexchar[data[2] and $f]; hexptr[6] := hexchar[data[1] shr 4]; hexptr[7] := hexchar[data[1] and $f]; hexptr[8] := hexchar[data[0] shr 4]; hexptr[9] := hexchar[data[0] and $f]; hexptr[5] := ':'; hexptr[0] := char(9); end; function hexword(value:word):string; var data : array[0..1] of byte absolute value; begin hexword[1] := hexchar[data[1] shr 4]; hexword[2] := hexchar[data[1] and $f]; hexword[3] := hexchar[data[0] shr 4]; hexword[4] := hexchar[data[0] and $f]; hexword[0] := char(4); end; {$F+} {--------------------------------------------------------------------------} { This function provides away to figure out who called the routine that caused the error. This can then be passed to the error routine to show the error at the point routine was called, not in routine itself. Find_FAR_Caller(1) would be the location where the last call was made, Find_FAR_Caller(2) would be the location of the next to last call was made, etc. So by knowing how far your routine is nested, you should be able to find the routine making the call into the unit. } function Find_FAR_Caller(generation:word):pointer; begin inline( $8B/$4E/$06/ { MOV CX,[BP+06] ; get genreation } $8B/$5E/$00/ { MOV BX,[BP+00] ; get BP calling } $E2/$02/ { start LOOP getBP ; if CX >1 loop } $EB/$05/ { JMP getadr ; OK get address } $36/$8B/$1F/ { getBP MOV BX,SS:[BX] ; get next BP } $EB/$F7/ { JMP start ; go to check } $36/$8B/$47/$02/ { getadr MOV AX,[BX+02] ; get offset } $36/$8B/$57/$04/ { MOV DX,[BX+04] ; get segment } $2D/$07/$00/ { SUB AX,07h ; adjust for call} $89/$EC/ { MOV sp,bp ; scrap scratch } $5D/ { POP bp ; get BP } $CA/$02/$00); { RTN far 0002 ; return } end; function Find_Near_Caller(generation:word):pointer; begin inline( $8B/$4E/$06/ { MOV CX,[BP+06] ; get genreation } $8B/$5E/$00/ { MOV BX,[BP+00] ; get BP calling } $E2/$02/ { start LOOP getBP ; if CX >1 loop } $EB/$05/ { JMP getadr ; OK get address } $36/$8B/$1F/ { getBP MOV BX,SS:[BX] ; get next BP } $EB/$F7/ { JMP start ; go to check } $36/$8B/$47/$02/ { getadr MOV AX,[BX+02] ; get offset } $36/$8B/$57/$04/ { MOV DX,[BP+02] ; get near segment} $2D/$07/$00/ { SUB AX,07h ; adjust for call} $89/$EC/ { MOV sp,bp ; scrap scratch } $5D/ { POP bp ; get BP } $CA/$02/$00); { RTN far 0002 ; return } end; {---------------------------------------------------} function get_int_seg(interrupt_number:word):word; { This function uses DOSs get interrupt vector function $35, so we do not need to include Turbos DOS unit. } inline ( $58/ { pop ax } $B4/$35/ { mov ah,35h } $CD/$21/ { int 21h } $8C/$C0); { mov ax,es } procedure incptr(var P:pointer;increment:word); { This is an inline directive that increments a pointer but !! it makes no checks to see if there was an overflow !!! } inline( $58/ { pop ax ;get increment size } $5F/ { pop di ;get p's offset } $07/ { pop es ;get p's segment } $26/$01/$05); { add es:[di],ax ;increment offset } {---------------------------------------------------} const trapid : array[1..4] of byte = ($59,$5B,$EB,$BA); function find_error_entry:pointer; var byteptr : ^byte; wordptr : ^word absolute byteptr; aptr : pointer absolute byteptr; trapptr : pointer; begin byteptr := ptr(get_int_seg(0),1); while (( ofs(byteptr^)<$300 ) and ( ofs(byteptr^)>0) ) do begin if (byteptr^ = trapid[1]) then begin trapptr := byteptr; incptr(aptr,1); if (byteptr^ = trapid[2]) then begin incptr(aptr,1); if (byteptr^ = trapid[3]) then begin incptr(aptr,1); incptr(aptr,byteptr^ + 1); if (byteptr^ = trapid[4]) then begin incptr(aptr,1); if wordptr^ = Dseg then begin find_error_entry := trapptr; exit; end; end; end; end; end; incptr(aptr,1); end; find_error_entry := nil; end; {---------------------------------------------------} {--------------------------------------------------------------------------} {$F+} { This is the routine that determines disposition of the user error. It returns an integer. This value is used to determine action on error. 1 - stop program and jump to Turbo's runtime routines, pass address. 0 - do not halt program (user has option to set error flags. -1 - halt program, bypass Turbo runtime, put error in dos error flag. EC is the ErrorCode detected, EA is the address where the error occured. } function Default_FRTE_Handler(EA:pointer;EC:word):integer; begin Default_FRTE_Handler := 1; end; {---------------------------------------------------} function InstallFRTE(Error_Handler:FRTE_Handler_Type):word; begin if Units_Loaded = MAXUNITS then InstallFRTE := 0 else begin inc(Units_Loaded); UNITID := UNITID + $200; FRTE_Handler_Table[Units_Loaded].ID := UNITID; FRTE_Handler_Table[Units_Loaded].UNITHandler := Error_Handler; InstallFRTE := UNITID; end; end; {--------------------------------------------------------------------------} procedure FRTError(FRTEaddr:pointer;errorcode:word); { This routine first shows an error message if ShowFRTEMessage is TRUE. Then it calls a runtime error handler. A default is installed by the initialization code, but another can be installed via FRTE_handler_Vector. The value returned by this function is used to decide if the error will be ignored, if jump to Turbo's SYSTEM:Runtime error routine will be made, or the program will be halted with an ErrorCode. If passed on to Turbo's routines, the location where the error occured, as defined by FRTEaddr, and the error code is passsed on to Turbo's rtuntime error routines. If executed under the integrated editor, this will cause compiler to search through the source code for the error location passed with FRTEaddr. Get_FAR/NEAR_Caller can be used to determine the location where the routine was called from. This makes debugging code that uses "air tight" units a lot easier because any state that the unit considers a runtime error, can be trapped and the location of the offending call found by the integrated editor. This routine uses FRTEMessage for error display formating if ShoeFRTEMessage is true. FRTEMessage must be a string. Several special codes are allowed in this string '#A' means display in hexidecimal format the adress where error occured as defined by FRTEaddr, '#C' means display error code in decimal, '#H' means display error code in Hex. } var i:integer; j:word; begin if ShowFRTEMessage then begin for i:=1 to length(FRTE_message) do if (FRTE_message[i]='#') then begin inc(i); case FRTE_message [i] of 'A': write('$',hexptr(FRTEaddr)); 'C': write(errorcode); 'H': write('$',hexword(errorcode)); end; end else write(FRTE_message[i]); writeln; end; j:=1; i:=Errorcode and $FE00; while (FRTE_handler_table[j].ID <> i)and(j<=UNITS_LOADED) do inc(j); if j>Units_Loaded then j:=0; {$IFDEF StripID} if j>0 then errorcode := Errorcode xor i; {$ENDIF} i := FRTE_HANDLER_TAble[j].UnitHandler(FRTEaddr,ErrorCode); case i of 1: inline ( $89/$EC/ { mov sp,bp ;restore sp } $5D/ { pop BP ;restore BP } $58/ { pop ax ;trash rtnaddr } $58/ { pop ax } $58/ { pop ax ;get errorcode } $8B/$36/error_jump_ofs/ { mov si, error_jump_ofs } $FF/$2c); { jmp far ptr [si] ;jmp! } -1:halt(errorcode); 0:exit; end; end; {--------------------------------------------------------------------------} begin { get CS of main PROGRAM } inline( $8B/$46/$02/ { mov ax,[bp+2] } $A3/BaseSeg ); { mov BaseSeg,ax } error_jump := find_error_entry; if error_jump = nil then begin writeln(' FRTE Not Installed! '); halt; end; error_jump_ofs := ofs(error_jump); FRTE_Handler_table[0].UNITHandler := Default_FRTE_handler; end.