Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Trapping FP overflows and other exceptions

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Trapping FP overflows and other exceptions

    This PBCC4 program is intended to show how to install and use an exception handler.
    It's not complete but should provide a useful framework for those interested in trapping their own exceptions.
    As it stands it demonstrates 3 different ways to handle exceptions.
    Exceptions include FP overflows and divide by zero errors.

    Discussion thread:
    http://www.powerbasic.com/support/pb...212#post289212

    Paul.
    Code:
    'PBCC4.0 program
    'This code attempts to handle exceptions not normally trapped by PowerBASIC.
    'It consists of 3 routines.
    '1) PBMain just a short routine to show how to use the other 2 functions
    '2) SetupExceptionHandler which installs or removes the exception handler
    '3) ExceptionHandler  which is called, via the operating system, when an exception occurs.
    '
    'Floating point exceptions need to be explicitly allowed by clearing one or more of 6 mask bits in the FPU control word.
    'Other exceptions happen anyway but this program shows how to intercept them to do something useful before the default
    '  exception handler of the OS gets them and reports a the error.
    '
    ' It is possible, though sometimes difficult, to resume execution of the program from after the point of the exception.
    '  This code shows how to resume at the next address after a PrivelidgedInstruction exception.
    '  It also shows how to resume at another address such as an error handler. This should be in the same SUB/FUNCTION as the error.
    '
    'The default in this program is to enable all FP exceptions apart from INEXACT_RESULT as this will trip up most people
    '  more than it helps them! e.g. 1/3 will trigger the exception as the result cannot be exactly represented in binary.
    '  If you want to trap INEXACT_RESULT then set %FPTrapInexactResultException = 1   below.
    '
    'The only ASM here is to set the FPU control register bits so don't be put off by it.
    '
    'Three distict outcomes are shown in this code.
    ' If there is a priveliged instruction exception caused by CLI or STI (clear or set interrupt flag) then the inxtruction is ignored
    '  and execution continues at the next address as if the instruction wasn't there. Other priviliged instructions are passed to the
    '  default handler (usually the OS).
    '
    'If there is a floating point exception then it is reported along with a dump of the FP registers, it's then passed to the default handler.
    '
    'If there is an integer divide by zero then the error is reported and execution continues at the error handler specified in the call
    '   when the Exception Handler was installed.
    '
    'There are lots of potential problems here. This code is just posted to demonstrate how exceptions can be dealt with.
    'In particular, returning execution to the ResumeAddress will only work if the exception occurs in the same function as the ResumeAddress
    ' but calls to outside functions in maths routines are very common so care needs to be taken.
    '
    'Just for demonstration purposes I print things out in the ExceptionHandler to inform the user what has happened. Normally you wouldn't
    '  do this if you are returning execution to the program.
    
    
    #COMPILE EXE
    #DIM ALL
    #REGISTER NONE
    
    #INCLUDE "win32api.inc"
    
    DECLARE FUNCTION AddVectoredExceptionHandler LIB "KERNEL32.DLL" ALIAS "AddVectoredExceptionHandler" (BYVAL First AS DWORD, BYVAL Handler AS DWORD) AS LONG
    DECLARE FUNCTION RemoveVectoredExceptionHandler LIB "KERNEL32.DLL" ALIAS "RemoveVectoredExceptionHandler" (BYVAL Handler AS DWORD) AS LONG
    
    %FPTrapInexactResultException = 0    'set to non zero if you want to trap FPInexactResults (specialised use only)
    %enable = 1
    %disable= 0
    
    %CLI= &hfa     'opcode of STI instruction    'these are just to test the PRIVILEGED_INSTRUCTION exception
    %STI= &hfb     'opcode of CLI instruction
     
     
    GLOBAL ExeptionHandlerResumeAddress AS DWORD
    
    
    
    FUNCTION SetupExceptionHandler(EnableTrap AS LONG,ResumeAddress AS DWORD) AS LONG
    'EnableTrap = 0 for uninstall handler, not 0 for install handler
    'ResumeAddress = address WITHIN THE ERRING FUNCTION/SUB to which you would like the code to return after the exception is handled
    '              =0 for don't resume.
    
    STATIC hHandler AS LONG
    
    LOCAL HandlerPointer AS LONG
    LOCAL NewControlWord, mask AS INTEGER    'control word is a 16 bit register
    LOCAL OriginalControlWord AS INTEGER
    
    ExeptionHandlerResumeAddress = ResumeAddress
    
        IF EnableTrap THEN
            'install the exception handler
            HandlerPointer = CODEPTR(ExceptionHandler)
            hHandler = AddVectoredExceptionHandler( 1  , HandlerPointer )
    
            IF hHandler = 0 THEN
               'Failed to add handler
                FUNCTION = 0
            ELSE
                'Handler installed
                FUNCTION = 1
             
                'now set the FPU control register to enable exceptions on all conditions
                !fstcw OriginalControlWord  'save the original control word
                !mov ax,OriginalControlWord 'get the control word
                
                #IF %FPTrapInexactResultException = 0
                !and ax,&hffe0              'zero the exception mask bits except for InexactResult
                #ELSE
                !and ax,&hffc0              'zero the exception mask bits (lower 6 bits or control word) to allow all 6 exceptions
                #ENDIF
                
                !mov NewControlWord,ax      'save the new control word
                !fldcw NewControlWord       'set the FPU to use the new control word
    
            END IF
    
        ELSE
            'remove the exception handler
            hHandler = RemoveVectoredExceptionHandler(hHandler)
            IF hHandler = 0 THEN
                'Couldn't remove exception handler
                FUNCTION = 0
    
            ELSE
                'Exception handler removed
                FUNCTION = 1
                !fldcw OriginalControlWord  'restore the original control word
    
            END IF
    
        END IF
    
    END FUNCTION
    
    
    
    FUNCTION ExceptionHandler(BYVAL pException_Pointers AS Exception_Pointers PTR) AS LONG
    
    LOCAL ThisExceptionPointer AS Exception_Pointers
    LOCAL ThisExceptionRecordPointer AS Exception_Record PTR
    LOCAL ThisExceptionRecord AS Exception_Record
    LOCAL temp AS BYTE PTR
    LOCAL r AS LONG
    LOCAL pt AS DWORD
    LOCAL FPControlWord AS INTEGER
    LOCAL FPControlWordNew AS INTEGER
    LOCAL WhatToDoNext  AS LONG
    
    
    ThisExceptionPointer = @pException_Pointers
    ThisExceptionRecordPointer = ThisExceptionPointer.pExceptionRecord
    ThisExceptionRecord = @ThisExceptionRecordPointer
    
    WhatToDoNext=%EXCEPTION_CONTINUE_SEARCH 'set the default for all exceptions I don't handle here.
                                            'the 2 options are:
                                            '%EXCEPTION_CONTINUE_SEARCH which passes the exception on to the next handler in line (the OS?)
                                            '%EXCEPTION_CONTINUE_EXECUTION which resumes execution of the code
                                            'If execution is resumed, the address to resume at can be set within the handler
                                            
    !fnstcw FPControlWord   'get FP control word
    !fnclex                 'clear all FP exeptions. Got to do this as following lines use the FPU and may cause a recurring exception
    !mov ax,FPControlWord
    !or ax,&h3f             'mask all exception while in the exception routine
    !mov FPControlWord,ax
    !fldcw FPControlWord    'load new FP control word
    
    'now handle each possible exception
    SELECT CASE ThisExceptionRecord.ExceptionCode
        CASE  %STATUS_FLOAT_OVERFLOW
    
            PRINT "There has been a FP overflow at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
            PRINT "here are the FPU details at the time of the exception"
    
            PRINT "ControlWord   ";HEX$(@[email protected])
            PRINT "StatusWord    ";HEX$(@[email protected])
            PRINT "TagWord       ";HEX$(@[email protected])
            PRINT "ErrorOffset   ";HEX$(@[email protected])
            PRINT "ErrorSelector ";HEX$(@[email protected])
            PRINT "DataOffset    ";HEX$(@[email protected])
            PRINT "DataSelector  ";HEX$(@[email protected])
    
            pt=VARPTR(@[email protected](0))
    
            REDIM reg(0 TO 7) AS EXT AT pt
            FOR r& = 0 TO 7
                PRINT "ST(";r&;")=";reg(r&)
            NEXT
    
            PRINT
            PRINT "Press a key to pass error to default exception handler"
            WAITKEY$
            
            
        CASE %STATUS_FLOAT_UNDERFLOW
            PRINT "There has been a FP underflow at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
            WAITKEY$
            
        CASE %STATUS_FLOAT_INVALID_OPERATION
            PRINT "There has been an Invalid FP Operation at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
            WAITKEY$
        
        CASE %STATUS_FLOAT_INEXACT_RESULT
            
        
        CASE %STATUS_FLOAT_DIVIDE_BY_ZERO
            
        
        CASE %STATUS_FLOAT_DENORMAL_OPERAND
            
        
        CASE %STATUS_ILLEGAL_INSTRUCTION
            
        
        CASE %STATUS_ACCESS_VIOLATION
    
    
        CASE %STATUS_PRIVILEGED_INSTRUCTION
            PRINT "STATUS_PRIVILEGED_INSTRUCTION exception has occurred"
    
            temp = @[email protected]    'get the EIP register to see where the instruction was that caused the exception
    
            IF @temp = %STI OR  @temp = %CLI THEN   '@temp = the instruction itself
                'if its set/clear interrupt flag I'll just increment the return address pointer to ignore the exception
                INCR @[email protected]    'return execution to the byte after the one that caused the exception
    
                PRINT "You can't mess with the interrupt flag. I'll ignore it."
                PRINT "Execution will now continue"
                PRINT
                WhatToDoNext=%EXCEPTION_CONTINUE_EXECUTION
            ELSE
                'it's not an interrupt flag instruction so pass it to the default handler
                PRINT "You aren't allowed to use that instruction at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                PRINT "I'm going to crash now."
    
                WhatToDoNext=%EXCEPTION_CONTINUE_SEARCH
            END IF
    
    
            
        CASE %STATUS_STACK_OVERFLOW
            
        
        CASE %STATUS_FLOAT_MULTIPLE_FAULTS
            
        
        CASE %STATUS_INTEGER_OVERFLOW
            
        
        CASE %STATUS_INTEGER_DIVIDE_BY_ZERO
            PRINT "Integer divide by zero at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
            PRINT
            'as a test we'll try to return to the faulty function's error trap
            IF ExeptionHandlerResumeAddress <>0 THEN
                @[email protected] = ExeptionHandlerResumeAddress
            END IF
    
            WhatToDoNext=%EXCEPTION_CONTINUE_EXECUTION
        
    END SELECT
    
    
    IF WhatToDoNext =%EXCEPTION_CONTINUE_SEARCH THEN
        FUNCTION = %EXCEPTION_CONTINUE_SEARCH
    ELSE
        FUNCTION = %EXCEPTION_CONTINUE_EXECUTION
        !fldcw FPControlWord   'restore the FPUControl word if I'm going to return to executing my code
    
    END IF
    
    
    END FUNCTION
    
    
    
    FUNCTION PBMAIN () AS LONG
    
    LOCAL sum AS SINGLE
    LOCAL ResumeAddress AS LONG
    
    ResumeAddress = CODEPTR(ErrorTrap)
    
    
    IF SetupExceptionHandler(%enable,ResumeAddress) = 0 THEN
        PRINT "Failed to add exception handler"
    ELSE
        PRINT "Exception Handler installed "
        PRINT "Press a key to cause a Privileged Instruction exception"
        PRINT
        WAITKEY$
    
    '############################################
    '# cause a Privileged Instruction exception
    '############################################
    
    !cli
    
    
        PRINT "Press a key to cause an Integer Divide by zero exception"
        PRINT
        WAITKEY$
    
    '############################################
    '# cause an integer divide by zero exception
    '############################################
    LOCAL a,b,c AS LONG
    
    a=0
    b=1
    c=b\a
    
        'in this example the code doesn't reach this point but in real code you should uninstall the exception handler
        ''like this when you're finished with it.
        IF SetupExceptionHandler(%disable,0)= 0 THEN
            PRINT "Couldn't remove exception handler"
        ELSE
            PRINT "Exception handler removed"
        END IF
    
    
    END IF
    GOTO xit
    
    ErrorTrap:
    PRINT "I've resumed execution at the error trap."
    PRINT "press a key to cause a fatal FP overflow"
    PRINT
    WAITKEY$
    
    '############################################
    '# cause a FP overflow exception
    '############################################
    
    
        sum = 1
        DO
            sum = sum + sum        'cause an overflow exception by counting too high
        LOOP
    
         
    xit:
    WAITKEY$
    END FUNCTION

  • #2
    withdraw
    Last edited by Arthur Gomide; 16 Jan 2013, 11:02 AM.
    "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

    Comment


    • #3
      The original was written for PBCC4.
      Changes to the Win32api.inc files in later versions of the complier caused problems with the original so this version
      is the exact same code but with all the relevant definitions extracted from the PCBB4 .inc files and included directly in the source code instead.
      It now works in PBCC6.


      Code:
      'PBCC4.0 program
      'This code attempts to handle exceptions not normally trapped by PowerBASIC.
      'It consists of 3 routines.
      '1) PBMain just a short routine to show how to use the other 2 functions
      '2) SetupExceptionHandler which installs or removes the exception handler
      '3) ExceptionHandler  which is called, via the operating system, when an exception occurs.
      '
      'Floating point exceptions need to be explicitly allowed by clearing one or more of 6 mask bits in the FPU control word.
      'Other exceptions happen anyway but this program shows how to intercept them to do something useful before the default
      '  exception handler of the OS gets them and reports a the error.
      '
      ' It is possible, though sometimes difficult, to resume execution of the program from after the point of the exception.
      '  This code shows how to resume at the next address after a PrivelidgedInstruction exception.
      '  It also shows how to resume at another address such as an error handler. This should be in the same SUB/FUNCTION as the error.
      '
      'The default in this program is to enable all FP exceptions apart from INEXACT_RESULT as this will trip up most people
      '  more than it helps them! e.g. 1/3 will trigger the exception as the result cannot be exactly represented in binary.
      '  If you want to trap INEXACT_RESULT then set %FPTrapInexactResultException = 1   below.
      '
      'The only ASM here is to set the FPU control register bits so don't be put off by it.
      '
      'Three distict outcomes are shown in this code.
      ' If there is a priveliged instruction exception caused by CLI or STI (clear or set interrupt flag) then the inxtruction is ignored
      '  and execution continues at the next address as if the instruction wasn't there. Other priviliged instructions are passed to the
      '  default handler (usually the OS).
      '
      'If there is a floating point exception then it is reported along with a dump of the FP registers, it's then passed to the default handler.
      '
      'If there is an integer divide by zero then the error is reported and execution continues at the error handler specified in the call
      '   when the Exception Handler was installed.
      '
      'There are lots of potential problems here. This code is just posted to demonstrate how exceptions can be dealt with.
      'In particular, returning execution to the ResumeAddress will only work if the exception occurs in the same function as the ResumeAddress
      ' but calls to outside functions in maths routines are very common so care needs to be taken.
      '
      'Just for demonstration purposes I print things out in the ExceptionHandler to inform the user what has happened. Normally you wouldn't
      '  do this if you are returning execution to the program.
      
      
      #COMPILE EXE
      #DIM ALL
      #REGISTER NONE
      
      
      '#INCLUDE "win32api.inc"
      '################################################################################################################################################################
      'The following are extracted from the PBCC4 winapi.inc file.
      'It's differences in .inc files that is causing the original to fail to compile in later compilers
      DECLARE FUNCTION AddVectoredExceptionHandler LIB "KERNEL32.DLL" ALIAS "AddVectoredExceptionHandler" (BYVAL First AS DWORD, BYVAL Handler AS DWORD) AS LONG
      DECLARE FUNCTION RemoveVectoredExceptionHandler LIB "KERNEL32.DLL" ALIAS "RemoveVectoredExceptionHandler" (BYVAL Handler AS DWORD) AS LONG
      
      %EXCEPTION_EXECUTE_HANDLER    = 1
      %EXCEPTION_CONTINUE_SEARCH    = 0
      %EXCEPTION_CONTINUE_EXECUTION = -1
      
      %EXCEPTION_NONCONTINUABLE     = &H1  ' Noncontinuable exception
      %EXCEPTION_MAXIMUM_PARAMETERS = 15   ' maximum number of exception parameters
      
      %STATUS_WAIT_0                   = &H00000000???
      %STATUS_ABANDONED_WAIT_0         = &H00000080???
      %STATUS_USER_APC                 = &H000000C0???
      %STATUS_TIMEOUT                  = &H00000102???
      %STATUS_PENDING                  = &H00000103???
      %STILL_ACTIVE                    = %STATUS_PENDING
      %STATUS_DATATYPE_MISALIGNMENT    = &H80000002???
      %STATUS_BREAKPOINT               = &H80000003???
      %STATUS_SINGLE_STEP              = &H80000004???
      %STATUS_ACCESS_VIOLATION         = &HC0000005???
      %STATUS_IN_PAGE_ERROR            = &HC0000006???
      %STATUS_INVALID_HANDLE           = &HC0000008???
      %STATUS_NO_MEMORY                = &HC0000017???
      %STATUS_ILLEGAL_INSTRUCTION      = &HC000001D???
      %STATUS_NONCONTINUABLE_EXCEPTION = &HC0000025???
      %STATUS_INVALID_DISPOSITION      = &HC0000026???
      %STATUS_ARRAY_BOUNDS_EXCEEDED    = &HC000008C???
      %STATUS_FLOAT_DENORMAL_OPERAND   = &HC000008D???
      %STATUS_FLOAT_DIVIDE_BY_ZERO     = &HC000008E???
      %STATUS_FLOAT_INEXACT_RESULT     = &HC000008F???
      %STATUS_FLOAT_INVALID_OPERATION  = &HC0000090???
      %STATUS_FLOAT_OVERFLOW           = &HC0000091???
      %STATUS_FLOAT_STACK_CHECK        = &HC0000092???
      %STATUS_FLOAT_UNDERFLOW          = &HC0000093???
      %STATUS_INTEGER_DIVIDE_BY_ZERO   = &HC0000094???
      %STATUS_INTEGER_OVERFLOW         = &HC0000095???
      %STATUS_PRIVILEGED_INSTRUCTION   = &HC0000096???
      %STATUS_STACK_OVERFLOW           = &HC00000FD???
      %STATUS_CONTROL_C_EXIT           = &HC000013A???
      %STATUS_FLOAT_MULTIPLE_FAULTS    = &HC00002B4???
      %STATUS_FLOAT_MULTIPLE_TRAPS     = &HC00002B5???
      %STATUS_ILLEGAL_VLM_REFERENCE    = &HC00002C0???
      %STATUS_REG_NAT_CONSUMPTION      = &HC00002C9???
      %STATUS_SXS_EARLY_DEACTIVATION   = &HC015000F???
      %STATUS_SXS_INVALID_DEACTIVATION = &HC0150010???
      
      %SIZE_OF_80387_REGISTERS = 80
      
      TYPE FLOATING_SAVE_AREA
        ControlWord AS DWORD
        StatusWord AS DWORD
        TagWord AS DWORD
        ErrorOffset AS DWORD
        ErrorSelector AS DWORD
        DataOffset AS DWORD
        DataSelector AS DWORD
        RegisterArea(0 TO %SIZE_OF_80387_REGISTERS - 1) AS BYTE
        Cr0NpxState AS DWORD
      END TYPE
      
      
      TYPE CONTEXT
        '
        ' The flags values within this flag control the contents of
        ' a CONTEXT record.
        '
        ' If the context record is used as an input parameter, then
        ' for each portion of the context record controlled by a flag
        ' whose value is set, it is assumed that that portion of the
        ' context record contains valid context. If the context record
        ' is being used to modify a threads context, then only that
        ' portion of the threads context will be modified.
        '
        ' If the context record is used as an IN OUT parameter to capture
        ' the context of a thread, then only those portions of the thread's
        ' context corresponding to set flags will be returned.
        '
        ' The context record is never used as an OUT only parameter.
        '
        ContextFlags AS DWORD
      
        ' This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
        ' set in ContextFlags.  Note that CONTEXT_DEBUG_REGISTERS is NOT
        ' included in CONTEXT_FULL.
        Dr0 AS DWORD
        Dr1 AS DWORD
        Dr2 AS DWORD
        Dr3 AS DWORD
        Dr6 AS DWORD
        Dr7 AS DWORD
      
        ' This section is specified/returned if the
        ' ContextFlags word contians the flag CONTEXT_FLOATING_POINT.
        FloatSave AS FLOATING_SAVE_AREA
      
        ' This section is specified/returned if the
        ' ContextFlags word contians the flag CONTEXT_SEGMENTS.
        regGs AS DWORD
        regFs AS DWORD
        regEs AS DWORD
        regDs AS DWORD
      
        ' This section is specified/returned if the
        ' ContextFlags word contians the flag CONTEXT_INTEGER.
        regEdi AS DWORD
        regEsi AS DWORD
        regEbx AS DWORD
        regEdx AS DWORD
        regEcx AS DWORD
        regEax AS DWORD
      
        ' This section is specified/returned if the
        ' ContextFlags word contians the flag CONTEXT_CONTROL.
        regEbp AS DWORD
        regEip AS DWORD
        regCs AS DWORD      ' MUST BE SANITIZED
        regFlag AS DWORD    ' MUST BE SANITIZED
        regEsp AS DWORD
        regSs AS DWORD
      END TYPE
      
      
      TYPE EXCEPTION_RECORD
        ExceptionCode AS DWORD
        ExceptionFlags AS DWORD
        pExceptionRecord AS EXCEPTION_RECORD PTR
        ExceptionAddress AS DWORD
        NumberParameters AS DWORD
        ExceptionInformation(0 TO %EXCEPTION_MAXIMUM_PARAMETERS - 1) AS DWORD
      END TYPE
      
      TYPE EXCEPTION_POINTERS
        pExceptionRecord AS EXCEPTION_RECORD PTR
        ContextRecord AS CONTEXT PTR
      END TYPE
      
      'End of data extracted from PBCC4 Win32api.inc
      '################################################################################################################################################################
      
      
      %FPTrapInexactResultException = 0    'set to non zero if you want to trap FPInexactResults (specialised use only)
      %enable = 1
      %disable= 0
      
      %CLI= &hfa     'opcode of STI instruction    'these are just to test the PRIVILEGED_INSTRUCTION exception
      %STI= &hfb     'opcode of CLI instruction
      
      
      GLOBAL ExeptionHandlerResumeAddress AS DWORD
      
      
      
      FUNCTION SetupExceptionHandler(EnableTrap AS LONG,ResumeAddress AS DWORD) AS LONG
      'EnableTrap = 0 for uninstall handler, not 0 for install handler
      'ResumeAddress = address WITHIN THE ERRING FUNCTION/SUB to which you would like the code to return after the exception is handled
      '              =0 for don't resume.
      
      STATIC hHandler AS LONG
      
      LOCAL HandlerPointer AS LONG
      LOCAL NewControlWord, mask AS INTEGER    'control word is a 16 bit register
      LOCAL OriginalControlWord AS INTEGER
      
      ExeptionHandlerResumeAddress = ResumeAddress
      
          IF EnableTrap THEN
              'install the exception handler
              HandlerPointer = CODEPTR(ExceptionHandler)
              hHandler = AddVectoredExceptionHandler( 1  , HandlerPointer )
      
              IF hHandler = 0 THEN
                 'Failed to add handler
                  FUNCTION = 0
              ELSE
                  'Handler installed
                  FUNCTION = 1
      
                  'now set the FPU control register to enable exceptions on all conditions
                  !fstcw OriginalControlWord  'save the original control word
                  !mov ax,OriginalControlWord 'get the control word
      
                  #IF %FPTrapInexactResultException = 0
                  !and ax,&hffe0              'zero the exception mask bits except for InexactResult
                  #ELSE
                  !and ax,&hffc0              'zero the exception mask bits (lower 6 bits or control word) to allow all 6 exceptions
                  #ENDIF
      
                  !mov NewControlWord,ax      'save the new control word
                  !fldcw NewControlWord       'set the FPU to use the new control word
      
              END IF
      
          ELSE
              'remove the exception handler
              hHandler = RemoveVectoredExceptionHandler(hHandler)
              IF hHandler = 0 THEN
                  'Couldn't remove exception handler
                  FUNCTION = 0
      
              ELSE
                  'Exception handler removed
                  FUNCTION = 1
                  !fldcw OriginalControlWord  'restore the original control word
      
              END IF
      
          END IF
      
      END FUNCTION
      
      
      
      FUNCTION ExceptionHandler(BYVAL pException_Pointers AS Exception_Pointers PTR) AS LONG
      
      LOCAL ThisExceptionPointer AS Exception_Pointers
      LOCAL ThisExceptionRecordPointer AS Exception_Record PTR
      LOCAL ThisExceptionRecord AS Exception_Record
      LOCAL temp AS BYTE PTR
      LOCAL r AS LONG
      LOCAL pt AS DWORD
      LOCAL FPControlWord AS INTEGER
      LOCAL FPControlWordNew AS INTEGER
      LOCAL WhatToDoNext  AS LONG
      
      
      ThisExceptionPointer = @pException_Pointers
      ThisExceptionRecordPointer = ThisExceptionPointer.pExceptionRecord
      ThisExceptionRecord = @ThisExceptionRecordPointer
      
      WhatToDoNext=%EXCEPTION_CONTINUE_SEARCH 'set the default for all exceptions I don't handle here.
                                              'the 2 options are:
                                              '%EXCEPTION_CONTINUE_SEARCH which passes the exception on to the next handler in line (the OS?)
                                              '%EXCEPTION_CONTINUE_EXECUTION which resumes execution of the code
                                              'If execution is resumed, the address to resume at can be set within the handler
      
      !fnstcw FPControlWord   'get FP control word
      !fnclex                 'clear all FP exeptions. Got to do this as following lines use the FPU and may cause a recurring exception
      !mov ax,FPControlWord
      !or ax,&h3f             'mask all exception while in the exception routine
      !mov FPControlWord,ax
      !fldcw FPControlWord    'load new FP control word
      
      'now handle each possible exception
      SELECT CASE ThisExceptionRecord.ExceptionCode
          CASE  %STATUS_FLOAT_OVERFLOW
      
              PRINT "There has been a FP overflow at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
              PRINT "here are the FPU details at the time of the exception"
      
              PRINT "ControlWord   ";HEX$(@[email protected])
              PRINT "StatusWord    ";HEX$(@[email protected])
              PRINT "TagWord       ";HEX$(@[email protected])
              PRINT "ErrorOffset   ";HEX$(@[email protected])
              PRINT "ErrorSelector ";HEX$(@[email protected])
              PRINT "DataOffset    ";HEX$(@[email protected])
              PRINT "DataSelector  ";HEX$(@[email protected])
      
              pt=VARPTR(@[email protected](0))
      
              REDIM reg(0 TO 7) AS EXT AT pt
              FOR r& = 0 TO 7
                  PRINT "ST(";r&;")=";reg(r&)
              NEXT
      
              PRINT
              PRINT "Press a key to pass error to default exception handler"
              WAITKEY$
      
      
          CASE %STATUS_FLOAT_UNDERFLOW
              PRINT "There has been a FP underflow at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
              WAITKEY$
      
          CASE %STATUS_FLOAT_INVALID_OPERATION
              PRINT "There has been an Invalid FP Operation at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
              WAITKEY$
      
          CASE %STATUS_FLOAT_INEXACT_RESULT
      
      
          CASE %STATUS_FLOAT_DIVIDE_BY_ZERO
      
      
          CASE %STATUS_FLOAT_DENORMAL_OPERAND
      
      
          CASE %STATUS_ILLEGAL_INSTRUCTION
      
      
          CASE %STATUS_ACCESS_VIOLATION
      
      
          CASE %STATUS_PRIVILEGED_INSTRUCTION
              PRINT "STATUS_PRIVILEGED_INSTRUCTION exception has occurred"
      
              temp = @[email protected]    'get the EIP register to see where the instruction was that caused the exception
      
              IF @temp = %STI OR  @temp = %CLI THEN   '@temp = the instruction itself
                  'if its set/clear interrupt flag I'll just increment the return address pointer to ignore the exception
                  INCR @[email protected]    'return execution to the byte after the one that caused the exception
      
                  PRINT "You can't mess with the interrupt flag. I'll ignore it."
                  PRINT "Execution will now continue"
                  PRINT
                  WhatToDoNext=%EXCEPTION_CONTINUE_EXECUTION
              ELSE
                  'it's not an interrupt flag instruction so pass it to the default handler
                  PRINT "You aren't allowed to use that instruction at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                  PRINT "I'm going to crash now."
      
                  WhatToDoNext=%EXCEPTION_CONTINUE_SEARCH
              END IF
      
      
      
          CASE %STATUS_STACK_OVERFLOW
      
      
          CASE %STATUS_FLOAT_MULTIPLE_FAULTS
      
      
          CASE %STATUS_INTEGER_OVERFLOW
      
      
          CASE %STATUS_INTEGER_DIVIDE_BY_ZERO
              PRINT "Integer divide by zero at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
              PRINT
              'as a test we'll try to return to the faulty function's error trap
              IF ExeptionHandlerResumeAddress <>0 THEN
                  @[email protected] = ExeptionHandlerResumeAddress
              END IF
      
              WhatToDoNext=%EXCEPTION_CONTINUE_EXECUTION
      
      END SELECT
      
      
      IF WhatToDoNext =%EXCEPTION_CONTINUE_SEARCH THEN
          FUNCTION = %EXCEPTION_CONTINUE_SEARCH
      ELSE
          FUNCTION = %EXCEPTION_CONTINUE_EXECUTION
          !fldcw FPControlWord   'restore the FPUControl word if I'm going to return to executing my code
      
      END IF
      
      
      END FUNCTION
      
      
      
      FUNCTION PBMAIN () AS LONG
      
      LOCAL sum AS SINGLE
      LOCAL ResumeAddress AS LONG
      
      ResumeAddress = CODEPTR(ErrorTrap)
      
      
      IF SetupExceptionHandler(%enable,ResumeAddress) = 0 THEN
          PRINT "Failed to add exception handler"
      ELSE
          PRINT "Exception Handler installed "
          PRINT "Press a key to cause a Privileged Instruction exception"
          PRINT
          WAITKEY$
      
      '############################################
      '# cause a Privileged Instruction exception
      '############################################
      
      !cli
      
      
          PRINT "Press a key to cause an Integer Divide by zero exception"
          PRINT
          WAITKEY$
      
      '############################################
      '# cause an integer divide by zero exception
      '############################################
      LOCAL a,b,c AS LONG
      
      a=0
      b=1
      c=b\a
      
          'in this example the code doesn't reach this point but in real code you should uninstall the exception handler
          ''like this when you're finished with it.
          IF SetupExceptionHandler(%disable,0)= 0 THEN
              PRINT "Couldn't remove exception handler"
          ELSE
              PRINT "Exception handler removed"
          END IF
      
      
      END IF
      GOTO xit
      
      ErrorTrap:
      PRINT "I've resumed execution at the error trap."
      PRINT "press a key to cause a fatal FP overflow"
      PRINT
      WAITKEY$
      
      '############################################
      '# cause a FP overflow exception
      '############################################
      
      
          sum = 1
          DO
              sum = sum + sum        'cause an overflow exception by counting too high
          LOOP
      
      
      xit:
      WAITKEY$
      END FUNCTION

      Comment


      • #4
        It occurred to me that if anyone tries to add to this code that they might add in the latest win32api.inc which will then conflict with all the definitions I copied from the old .inc file so here's a modified version which now works with the PBCC6 .inc files.

        Code:
        'PBCC6.0 program
        'This code attempts to handle exceptions not normally trapped by PowerBASIC.
        'It consists of 3 routines.
        '1) PBMain just a short routine to show how to use the other 2 functions
        '2) SetupExceptionHandler which installs or removes the exception handler
        '3) ExceptionHandler  which is called, via the operating system, when an exception occurs.
        '
        'Floating point exceptions need to be explicitly allowed by clearing one or more of 6 mask bits in the FPU control word.
        'Other exceptions happen anyway but this program shows how to intercept them to do something useful before the default
        '  exception handler of the OS gets them and reports a the error.
        '
        ' It is possible, though sometimes difficult, to resume execution of the program from after the point of the exception.
        '  This code shows how to resume at the next address after a PrivelidgedInstruction exception.
        '  It also shows how to resume at another address such as an error handler. This should be in the same SUB/FUNCTION as the error.
        '
        'The default in this program is to enable all FP exceptions apart from INEXACT_RESULT as this will trip up most people
        '  more than it helps them! e.g. 1/3 will trigger the exception as the result cannot be exactly represented in binary.
        '  If you want to trap INEXACT_RESULT then set %FPTrapInexactResultException = 1   below.
        '
        'The only ASM here is to set the FPU control register bits so don't be put off by it.
        '
        'Three distict outcomes are shown in this code.
        ' If there is a priveliged instruction exception caused by CLI or STI (clear or set interrupt flag) then the inxtruction is ignored
        '  and execution continues at the next address as if the instruction wasn't there. Other priviliged instructions are passed to the
        '  default handler (usually the OS).
        '
        'If there is a floating point exception then it is reported along with a dump of the FP registers, it's then passed to the default handler.
        '
        'If there is an integer divide by zero then the error is reported and execution continues at the error handler specified in the call
        '   when the Exception Handler was installed.
        '
        'There are lots of potential problems here. This code is just posted to demonstrate how exceptions can be dealt with.
        'In particular, returning execution to the ResumeAddress will only work if the exception occurs in the same function as the ResumeAddress
        ' but calls to outside functions in maths routines are very common so care needs to be taken.
        '
        'Just for demonstration purposes I print things out in the ExceptionHandler to inform the user what has happened. Normally you wouldn't
        '  do this if you are returning execution to the program.
        
        
        #COMPILE EXE
        #DIM ALL
        #REGISTER NONE
        
        #INCLUDE "win32api.inc"
        
        
        %FPTrapInexactResultException = 0    'set to non zero if you want to trap FPInexactResults (specialised use only)
        %enable = 1
        %disable= 0
        
        %CLI= &hfa     'opcode of STI instruction    'these are just to test the PRIVILEGED_INSTRUCTION exception
        %STI= &hfb     'opcode of CLI instruction
        
        
        GLOBAL ExeptionHandlerResumeAddress AS DWORD
        
        
        
        FUNCTION SetupExceptionHandler(EnableTrap AS LONG,ResumeAddress AS DWORD) AS LONG
        'EnableTrap = 0 for uninstall handler, not 0 for install handler
        'ResumeAddress = address WITHIN THE ERRING FUNCTION/SUB to which you would like the code to return after the exception is handled
        '              =0 for don't resume.
        
        STATIC hHandler AS LONG
        
        LOCAL HandlerPointer AS LONG
        LOCAL NewControlWord, mask AS INTEGER    'control word is a 16 bit register
        LOCAL OriginalControlWord AS INTEGER
        
        ExeptionHandlerResumeAddress = ResumeAddress
        
            IF EnableTrap THEN
                'install the exception handler
                HandlerPointer = CODEPTR(ExceptionHandler)
                hHandler = AddVectoredExceptionHandler( 1  , HandlerPointer )
        
                IF hHandler = 0 THEN
                   'Failed to add handler
                    FUNCTION = 0
                ELSE
                    'Handler installed
                    FUNCTION = 1
        
                    'now set the FPU control register to enable exceptions on all conditions
                    !fstcw OriginalControlWord  'save the original control word
                    !mov ax,OriginalControlWord 'get the control word
        
                    #IF %FPTrapInexactResultException = 0
                    !and ax,&hffe0              'zero the exception mask bits except for InexactResult
                    #ELSE
                    !and ax,&hffc0              'zero the exception mask bits (lower 6 bits or control word) to allow all 6 exceptions
                    #ENDIF
        
                    !mov NewControlWord,ax      'save the new control word
                    !fldcw NewControlWord       'set the FPU to use the new control word
        
                END IF
        
            ELSE
                'remove the exception handler
                hHandler = RemoveVectoredExceptionHandler(hHandler)
                IF hHandler = 0 THEN
                    'Couldn't remove exception handler
                    FUNCTION = 0
        
                ELSE
                    'Exception handler removed
                    FUNCTION = 1
                    !fldcw OriginalControlWord  'restore the original control word
        
                END IF
        
            END IF
        
        END FUNCTION
        
        
        
        FUNCTION ExceptionHandler(BYVAL pException_Pointers AS Exception_Pointers PTR) AS LONG
        
        LOCAL ThisExceptionPointer AS Exception_Pointers
        LOCAL ThisExceptionRecordPointer AS Exception_Record PTR
        LOCAL ThisExceptionRecord AS Exception_Record
        LOCAL temp AS BYTE PTR
        LOCAL r AS LONG
        LOCAL pt AS DWORD
        LOCAL FPControlWord AS INTEGER
        LOCAL FPControlWordNew AS INTEGER
        LOCAL WhatToDoNext  AS LONG
        
        
        ThisExceptionPointer = @pException_Pointers
        ThisExceptionRecordPointer = ThisExceptionPointer.ExceptionRecord
        ThisExceptionRecord = @ThisExceptionRecordPointer
        
        WhatToDoNext=%EXCEPTION_CONTINUE_SEARCH 'set the default for all exceptions I don't handle here.
                                                'the 2 options are:
                                                '%EXCEPTION_CONTINUE_SEARCH which passes the exception on to the next handler in line (the OS?)
                                                '%EXCEPTION_CONTINUE_EXECUTION which resumes execution of the code
                                                'If execution is resumed, the address to resume at can be set within the handler
        
        !fnstcw FPControlWord   'get FP control word
        !fnclex                 'clear all FP exeptions. Got to do this as following lines use the FPU and may cause a recurring exception
        !mov ax,FPControlWord
        !or ax,&h3f             'mask all exception while in the exception routine
        !mov FPControlWord,ax
        !fldcw FPControlWord    'load new FP control word
        
        'now handle each possible exception
        
        SELECT CASE ThisExceptionRecord.ExceptionCode
            CASE  BITS(DWORD,%STATUS_FLOAT_OVERFLOW)
        
                PRINT "There has been a FP overflow at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                PRINT "here are the FPU details at the time of the exception"
        
                PRINT "ControlWord   ";HEX$(@[email protected])
                PRINT "StatusWord    ";HEX$(@[email protected])
                PRINT "TagWord       ";HEX$(@[email protected])
                PRINT "ErrorOffset   ";HEX$(@[email protected])
                PRINT "ErrorSelector ";HEX$(@[email protected])
                PRINT "DataOffset    ";HEX$(@[email protected])
                PRINT "DataSelector  ";HEX$(@[email protected])
        
                pt=VARPTR(@[email protected](0))
        
                REDIM reg(0 TO 7) AS EXT AT pt
                FOR r& = 0 TO 7
                    PRINT "ST(";r&;")=";reg(r&)
                NEXT
        
                PRINT
                PRINT "Press a key to pass error to default exception handler"
                WAITKEY$
        
        
            CASE BITS(DWORD,%STATUS_FLOAT_UNDERFLOW)
                PRINT "There has been a FP underflow at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                WAITKEY$
        
            CASE BITS(DWORD,%STATUS_FLOAT_INVALID_OPERATION)
                PRINT "There has been an Invalid FP Operation at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                WAITKEY$
        
            CASE BITS(DWORD,%STATUS_FLOAT_INEXACT_RESULT)
        
        
            CASE BITS(DWORD,%STATUS_FLOAT_DIVIDE_BY_ZERO)
        
        
            CASE BITS(DWORD,%STATUS_FLOAT_DENORMAL_OPERAND)
        
        
            CASE BITS(DWORD,%STATUS_ILLEGAL_INSTRUCTION)
        
        
            CASE BITS(DWORD,%STATUS_ACCESS_VIOLATION)
        
        
            CASE BITS(DWORD,%STATUS_PRIVILEGED_INSTRUCTION)
                PRINT "STATUS_PRIVILEGED_INSTRUCTION exception has occurred"
        
                temp = @[email protected]    'get the EIP register to see where the instruction was that caused the exception
        
                IF @temp = %STI OR  @temp = %CLI THEN   '@temp = the instruction itself
                    'if its set/clear interrupt flag I'll just increment the return address pointer to ignore the exception
                    INCR @[email protected]    'return execution to the byte after the one that caused the exception
        
                    PRINT "You can't mess with the interrupt flag. I'll ignore it."
                    PRINT "Execution will now continue"
                    PRINT
                    WhatToDoNext=%EXCEPTION_CONTINUE_EXECUTION
                ELSE
                    'it's not an interrupt flag instruction so pass it to the default handler
                    PRINT "You aren't allowed to use that instruction at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                    PRINT "I'm going to crash now."
        
                    WhatToDoNext=%EXCEPTION_CONTINUE_SEARCH
                END IF
        
        
        
            CASE BITS(DWORD,%STATUS_STACK_OVERFLOW)
        
        
            CASE BITS(DWORD,%STATUS_FLOAT_MULTIPLE_FAULTS)
        
        
            CASE BITS(DWORD,%STATUS_INTEGER_OVERFLOW)
        
        
            CASE BITS(DWORD,%STATUS_INTEGER_DIVIDE_BY_ZERO)
                PRINT "Integer divide by zero at address &h";HEX$(ThisExceptionRecord.ExceptionAddress)
                PRINT
                'as a test we'll try to return to the faulty function's error trap
                IF ExeptionHandlerResumeAddress <>0 THEN
                    @[email protected] = ExeptionHandlerResumeAddress
                END IF
        
                WhatToDoNext=%EXCEPTION_CONTINUE_EXECUTION
        
        END SELECT
        
        
        IF WhatToDoNext =%EXCEPTION_CONTINUE_SEARCH THEN
            FUNCTION = %EXCEPTION_CONTINUE_SEARCH
        ELSE
            FUNCTION = %EXCEPTION_CONTINUE_EXECUTION
            !fldcw FPControlWord   'restore the FPUControl word if I'm going to return to executing my code
        
        END IF
        
        
        END FUNCTION
        
        
        
        FUNCTION PBMAIN () AS LONG
        
        LOCAL sum AS SINGLE
        LOCAL ResumeAddress AS LONG
        
        ResumeAddress = CODEPTR(ErrorTrap)
        
        
        IF SetupExceptionHandler(%enable,ResumeAddress) = 0 THEN
            PRINT "Failed to add exception handler"
        ELSE
            PRINT "Exception Handler installed "
            PRINT "Press a key to cause a Privileged Instruction exception"
            PRINT
            WAITKEY$
        
        '############################################
        '# cause a Privileged Instruction exception
        '############################################
        
        !cli
        
        
            PRINT "Press a key to cause an Integer Divide by zero exception"
            PRINT
            WAITKEY$
        
        '############################################
        '# cause an integer divide by zero exception
        '############################################
        LOCAL a,b,c AS LONG
        
        a=0
        b=1
        c=b\a
        
            'in this example the code doesn't reach this point but in real code you should uninstall the exception handler
            ''like this when you're finished with it.
            IF SetupExceptionHandler(%disable,0)= 0 THEN
                PRINT "Couldn't remove exception handler"
            ELSE
                PRINT "Exception handler removed"
            END IF
        
        
        END IF
        GOTO xit
        
        ErrorTrap:
        PRINT "I've resumed execution at the error trap."
        PRINT "press a key to cause a fatal FP overflow"
        PRINT
        WAITKEY$
        
        '############################################
        '# cause a FP overflow exception
        '############################################
        
        
            sum = 1
            DO
                sum = sum + sum        'cause an overflow exception by counting too high
            LOOP
        
        
        xit:
        WAITKEY$
        END FUNCTION

        Comment

        Working...
        X