Patch title: Release 87 bulk changes
Abstract:
File: /pliant/language/debug/report.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


  function exception_handler num mark1 mark2 mark3 mark4 edi
    arg Int num mark1 mark2 mark3 mark4 edi esi ebp esp ebx 
    external_calling_convention
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


  function exception_handler num mark1 mark2 mark3 mark4 edi
    arg Int num mark1 mark2 mark3 mark4 edi esi ebp esp ebx 
    external_calling_convention
    if first_time
    if first_time and pliant_execution_phase<execution_phase_free
      first_time := false
      back_to_single_thread
      console_dump "/tmp/console"
      console "exception " ; console 'convert to string':num
      debugger_walk_stack (cast eip.-.1 Address) (cast ebp A
    os_exit 4
  gvar os_sigaction sa
  sa sa_handler := (the_function exception_handler Int Int I
  entry_root addressof:(the_function exception_handler Int I


  if os_kernel="OpenBSD"    # probably FreeBSD too (atleast 
    function exception_handler num info context
      arg Int num
      arg Address info
      arg os_sigcontext context
      external_calling_convention
      first_time := false
      back_to_single_thread
      console_dump "/tmp/console"
      console "exception " ; console 'convert to string':num
      debugger_walk_stack (cast eip.-.1 Address) (cast ebp A
    os_exit 4
  gvar os_sigaction sa
  sa sa_handler := (the_function exception_handler Int Int I
  entry_root addressof:(the_function exception_handler Int I


  if os_kernel="OpenBSD"    # probably FreeBSD too (atleast 
    function exception_handler num info context
      arg Int num
      arg Address info
      arg os_sigcontext context
      external_calling_convention
      if first_time
      if first_time and pliant_execution_phase<execution_phase_free
        first_time := false
        console_dump "/tmp/console"
        console "exception " ; console 'convert to string':n
        debugger_walk_stack (cast context:sc_pc.-.1 Address)
      os_exit 4
    gvar os_sigaction sa
    sa sa_flags := os_SA_SIGINFO
    sa sa_sigaction := (the_function exception_handler Int A
    entry_root addressof:(the_function exception_handler Int
  else
    function exception_handler num
      arg Int num
      external_calling_convention
        first_time := false
        console_dump "/tmp/console"
        console "exception " ; console 'convert to string':n
        debugger_walk_stack (cast context:sc_pc.-.1 Address)
      os_exit 4
    gvar os_sigaction sa
    sa sa_flags := os_SA_SIGINFO
    sa sa_sigaction := (the_function exception_handler Int A
    entry_root addressof:(the_function exception_handler Int
  else
    function exception_handler num
      arg Int num
      external_calling_convention
      if first_time
      if first_time and pliant_execution_phase<execution_phase_free
        first_time := false
        console_dump "/tmp/console"
        console "exception " ; console 'convert to string':n
        var Address ebp := cast i386_register:i386_ebp Addre
        debugger_walk_stack ((ebp translate Int 1) map Addre
      os_exit 4
    gvar os_sigaction sa
    sa sa_handler := (the_function exception_handler Int) ex
    entry_root addressof:(the_function exception_handler Int


  function exception_handler p -> ret
    arg os_EXCEPTION_POINTERS p ; arg Int ret
    external_calling_convention
        first_time := false
        console_dump "/tmp/console"
        console "exception " ; console 'convert to string':n
        var Address ebp := cast i386_register:i386_ebp Addre
        debugger_walk_stack ((ebp translate Int 1) map Addre
      os_exit 4
    gvar os_sigaction sa
    sa sa_handler := (the_function exception_handler Int) ex
    entry_root addressof:(the_function exception_handler Int


  function exception_handler p -> ret
    arg os_EXCEPTION_POINTERS p ; arg Int ret
    external_calling_convention
    if first_time
    if first_time and pliant_execution_phase<execution_phase_free
      first_time := false
      console_dump "c:/temp/console"
      console "exception[lf]"
      var Pointer:os_CONTEXT c :> p ContextRecord
      debugger_walk_stack (cast c:Eip.-.1 Address) (cast c:E
    # os_exit 4
    ret := os_EXCEPTION_CONTINUE_SEARCH
  entry_root addressof:(the_function exception_handler os_EX


  function break_handler signal -> ret
    arg Int signal ; arg CBool ret
    external_calling_convention
      first_time := false
      console_dump "c:/temp/console"
      console "exception[lf]"
      var Pointer:os_CONTEXT c :> p ContextRecord
      debugger_walk_stack (cast c:Eip.-.1 Address) (cast c:E
    # os_exit 4
    ret := os_EXCEPTION_CONTINUE_SEARCH
  entry_root addressof:(the_function exception_handler os_EX


  function break_handler signal -> ret
    arg Int signal ; arg CBool ret
    external_calling_convention
    if first_time
    if first_time and pliant_execution_phase<execution_phase_free
      first_time := false
      console_dump "c:/temp/console"
      console "break[lf]"
      # var Address ebp := cast i386_register:i386_ebp Addre
      # debugger_walk_stack ((ebp translate Int 1) map Addre
      var os_CONTEXT c ; c ContextFlags := CONTEXT_CONTROL
      if (os_GetThreadContext 'first thread handle' c)
        debugger_walk_stack (cast c:Eip.-.1 Address) (cast c
      else
        console "no context[lf]"
    ret := false
  entry_root addressof:(the_function break_handler Int -> CB


  function 'os2 exception routine' e h c p -> ret
    arg os_ExceptionReport e
    arg os_ExceptionHandler h
    arg os_ExceptionContext c
    arg Address p
    arg Int ret
    external_calling_convention
    # exception 3 is break
    # exception 5 is memory protection fault
      first_time := false
      console_dump "c:/temp/console"
      console "break[lf]"
      # var Address ebp := cast i386_register:i386_ebp Addre
      # debugger_walk_stack ((ebp translate Int 1) map Addre
      var os_CONTEXT c ; c ContextFlags := CONTEXT_CONTROL
      if (os_GetThreadContext 'first thread handle' c)
        debugger_walk_stack (cast c:Eip.-.1 Address) (cast c
      else
        console "no context[lf]"
    ret := false
  entry_root addressof:(the_function break_handler Int -> CB


  function 'os2 exception routine' e h c p -> ret
    arg os_ExceptionReport e
    arg os_ExceptionHandler h
    arg os_ExceptionContext c
    arg Address p
    arg Int ret
    external_calling_convention
    # exception 3 is break
    # exception 5 is memory protection fault
    if first_time and (e:num=3 or e:num=5)
    if first_time and (e:num=3 or e:num=5) and pliant_execution_phase<execution_phase_free
      first_time := false
      console_dump "/tmp/console"
      console "exception " ; console ('convert to string' e:
      debugger_walk_stack (cast c:eip.-.1 Address) (cast c:e
    return 0
  entry_root addressof:(the_function 'os2 exception routine'


  export 'os2 exception routine'
      first_time := false
      console_dump "/tmp/console"
      console "exception " ; console ('convert to string' e:
      debugger_walk_stack (cast c:eip.-.1 Address) (cast c:e
    return 0
  entry_root addressof:(the_function 'os2 exception routine'


  export 'os2 exception routine'