Przeglądaj źródła

+ RTL exception handler for OS/2

git-svn-id: trunk@8692 -
Tomas Hajny 18 lat temu
rodzic
commit
b71f5e80b0
3 zmienionych plików z 689 dodań i 238 usunięć
  1. 9 0
      rtl/os2/prt0.as
  2. 220 161
      rtl/os2/sysos.inc
  3. 460 77
      rtl/os2/system.pas

+ 9 - 0
rtl/os2/prt0.as

@@ -12,6 +12,7 @@
         .globl  __init
         .globl  __init
         .globl  __dos_init
         .globl  __dos_init
         .globl  __dos_syscall
         .globl  __dos_syscall
+        .comm _excptregptr, 4
 
 
         .text
         .text
 
 
@@ -27,8 +28,16 @@ ___SYSCALL:
         .space  6, 0x90
         .space  6, 0x90
 
 
 __init: cld
 __init: cld
+        pushl %eax
+        pushl %eax
+        pushl %eax
+        movl %esp,%eax
+        addl $4,%eax
+        movl %eax, _excptregptr
+        popl %eax
 
 
         call    _main
         call    _main
+
         movb    $0x4c,%ah
         movb    $0x4c,%ah
         call    ___SYSCALL
         call    ___SYSCALL
 2:      jmp     2b
 2:      jmp     2b

+ 220 - 161
rtl/os2/sysos.inc

@@ -15,6 +15,42 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
+type
+  TByteArray = array [0..$FFFF] of byte;
+  PByteArray = ^TByteArray;
+
+  TSysThreadIB = record
+    TID,
+    Priority,
+    Version: cardinal;
+    MCCount,
+    MCForceFlag: word;
+  end;
+  PSysThreadIB = ^TSysThreadIB;
+
+  TThreadInfoBlock = record
+    PExChain,
+    Stack,
+    StackLimit: pointer;
+    TIB2: PSysThreadIB;
+    Version,
+    Ordinal: cardinal;
+  end;
+  PThreadInfoBlock = ^TThreadInfoBlock;
+  PPThreadInfoBlock = ^PThreadInfoBlock;
+
+  TProcessInfoBlock = record
+    PID,
+    ParentPid,
+    Handle: cardinal;
+    Cmd,
+    Env: PByteArray;
+    Status,
+    ProcType: cardinal;
+  end;
+  PProcessInfoBlock = ^TProcessInfoBlock;
+  PPProcessInfoBlock = ^PProcessInfoBlock;
+
 var
 var
   ProcessID: SizeUInt;
   ProcessID: SizeUInt;
 
 
@@ -194,166 +230,189 @@ const
    end;
    end;
 
 
 
 
-{$IFDEF OS2EXCEPTIONS}
-(*
-The operating system defines a class of error conditions called exceptions, and specifies the default actions that are taken when these exceptions occur. The system default action in most cases is to terminate the thread that caused the exception.
-
-Exception values have the following 32-bit format:
-
- 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
- 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-ÚÄÄÄÂÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
-³Sev³C³       Facility          ³               Code            ³
-ÀÄÄÄÁÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
-
-
-Sev Severity code. Possible values are described in the following list:
-
-00 Success
-01 Informational
-10 Warning
-11 Error
-
-C Customer code flag.
-
-Facility Facility code.
-
-Code Facility's status code.
-
-Exceptions that are specific to OS/2 Version 2.X (for example, XCPT_SIGNAL)
-have a facility code of 1.
-
-System exceptions include both synchronous and asynchronous exceptions.
-Synchronous exceptions are caused by events that are internal to a thread's
-execution. For example, synchronous exceptions could be caused by invalid
-parameters, or by a thread's request to end its own execution.
-
-Asynchronous exceptions are caused by events that are external to a thread's
-execution. For example, an asynchronous exception can be caused by a user's
-entering a Ctrl+C or Ctrl+Break key sequence, or by a process' issuing
-DosKillProcess to end the execution of another process.
-
-The Ctrl+Break and Ctrl+C exceptions are also known as signals, or as signal
-exceptions.
-
-The following tables show the symbolic names of system exceptions, their
-numerical values, and related information fields.
-
-Portable, Non-Fatal, Software-Generated Exceptions
-
-ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿
-³Exception Name                       ³Value     ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_GUARD_PAGE_VIOLATION            ³0x80000001³
-³  ExceptionInfo[0] - R/W flag        ³          ³
-³  ExceptionInfo[1] - FaultAddr       ³          ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_UNABLE_TO_GROW_STACK            ³0x80010001³
-ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ
-
-
-Portable, Fatal, Hardware-Generated Exceptions
-
-ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
-³Exception Name                       ³Value     ³Related Trap ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_ACCESS_VIOLATION                ³0xC0000005³0x09, 0x0B,  ³
-³  ExceptionInfo[0] - Flags           ³          ³0x0C, 0x0D,  ³
-³    XCPT_UNKNOWN_ACCESS  0x0         ³          ³0x0E         ³
-³    XCPT_READ_ACCESS     0x1         ³          ³             ³
-³    XCPT_WRITE_ACCESS    0x2         ³          ³             ³
-³    XCPT_EXECUTE_ACCESS  0x4         ³          ³             ³
-³    XCPT_SPACE_ACCESS    0x8         ³          ³             ³
-³    XCPT_LIMIT_ACCESS    0x10        ³          ³             ³
-³  ExceptionInfo[1] - FaultAddr       ³          ³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_INTEGER_DIVIDE_BY_ZERO          ³0xC000009B³0            ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_DIVIDE_BY_ZERO            ³0xC0000095³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_INVALID_OPERATION         ³0xC0000097³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_ILLEGAL_INSTRUCTION             ³0xC000001C³0x06         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_PRIVILEGED_INSTRUCTION          ³0xC000009D³0x0D         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_INTEGER_OVERFLOW                ³0xC000009C³0x04         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_OVERFLOW                  ³0xC0000098³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_UNDERFLOW                 ³0xC000009A³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_DENORMAL_OPERAND          ³0xC0000094³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_INEXACT_RESULT            ³0xC0000096³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_FLOAT_STACK_CHECK               ³0xC0000099³0x10         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_DATATYPE_MISALIGNMENT           ³0xC000009E³0x11         ³
-³  ExceptionInfo[0] - R/W flag        ³          ³             ³
-³  ExceptionInfo[1] - Alignment       ³          ³             ³
-³  ExceptionInfo[2] - FaultAddr       ³          ³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_BREAKPOINT                      ³0xC000009F³0x03         ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_SINGLE_STEP                     ³0xC00000A0³0x01         ³
-ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
-
-
-Portable, Fatal, Software-Generated Exceptions
-
-ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
-³Exception Name                       ³Value     ³Related Trap ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_IN_PAGE_ERROR                   ³0xC0000006³0x0E         ³
-³  ExceptionInfo[0] - FaultAddr       ³          ³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_PROCESS_TERMINATE               ³0xC0010001³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_ASYNC_PROCESS_TERMINATE         ³0xC0010002³             ³
-³  ExceptionInfo[0] - TID of          ³          ³             ³
-³      terminating thread             ³          ³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_NONCONTINUABLE_EXCEPTION        ³0xC0000024³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_INVALID_DISPOSITION             ³0xC0000025³             ³
-ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
-
-
-Non-Portable, Fatal Exceptions
-
-ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
-³Exception Name                       ³Value     ³Related Trap ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_INVALID_LOCK_SEQUENCE           ³0xC000001D³             ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_ARRAY_BOUNDS_EXCEEDED           ³0xC0000093³0x05         ³
-ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
-
-
-Unwind Operation Exceptions
-
-ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿
-³Exception Name                       ³Value     ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_UNWIND                          ³0xC0000026³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_BAD_STACK                       ³0xC0000027³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_INVALID_UNWIND_TARGET           ³0xC0000028³
-ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ
-
-
-Fatal Signal Exceptions
-
-ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿
-³Exception Name                       ³Value     ³
-ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
-³XCPT_SIGNAL                          ³0xC0010003³
-³  ExceptionInfo[ 0 ] - Signal        ³          ³
-³      Number                         ³          ³
-ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ
-*)
-{$ENDIF OS2EXCEPTIONS}
+(* Types and constants for exception handler support *)
+const
+  deHardErr           = 1;    {Pop-ups for hard errors are enabled, to disable
+                               do not give this switch.}
+  deDisableExceptions = 2;    {Pop-ups for exceptions are disabled, to enable
+                               do not give this switch.}
+  MaxExceptionParameters = 4; {Enough for all system exceptions.}
+
+  Xcpt_Continue_Search            = $00000000;
+  Xcpt_Continue_Execution         = $ffffffff;
+  Xcpt_Continue_Stop              = $00716668;
+
+  Xcpt_Signal_Intr                = 1;
+  Xcpt_Signal_KillProc            = 3;
+  Xcpt_Signal_Break               = 4;
+
+  Xcpt_Fatal_Exception            = $c0000000;
+  Xcpt_Severity_Code              = $c0000000;
+  Xcpt_Customer_Code              = $20000000;
+  Xcpt_Facility_Code              = $1fff0000;
+  Xcpt_Exception_Code             = $0000ffff;
+
+  Xcpt_Unknown_Access             = $00000000;
+  Xcpt_Read_Access                = $00000001;
+  Xcpt_Write_Access               = $00000002;
+  Xcpt_Execute_Access             = $00000004;
+  Xcpt_Space_Access               = $00000008;
+  Xcpt_Limit_Access               = $00000010;
+  Xcpt_Data_Unknown               = $ffffffff;
+
+  Xcpt_Guard_Page_Violation       = $80000001;
+  Xcpt_Unable_To_Grow_Stack       = $80010001;
+  Xcpt_Access_Violation           = $c0000005;
+  Xcpt_In_Page_Error              = $c0000006;
+  Xcpt_Illegal_Instruction        = $c000001c;
+  Xcpt_Invalid_Lock_Sequence      = $c000001d;
+  Xcpt_Noncontinuable_Exception   = $c0000024;
+  Xcpt_Invalid_Disposition        = $c0000025;
+  Xcpt_Unwind                     = $c0000026;
+  Xcpt_Bad_Stack                  = $c0000027;
+  Xcpt_Invalid_Unwind_Target      = $c0000028;
+  Xcpt_Array_Bounds_Exceeded      = $c0000093;
+  Xcpt_Float_Denormal_Operand     = $c0000094;
+  Xcpt_Float_Divide_By_Zero       = $c0000095;
+  Xcpt_Float_Inexact_Result       = $c0000096;
+  Xcpt_Float_Invalid_Operation    = $c0000097;
+  Xcpt_Float_Overflow             = $c0000098;
+  Xcpt_Float_Stack_Check          = $c0000099;
+  Xcpt_Float_Underflow            = $c000009a;
+  Xcpt_Integer_Divide_By_Zero     = $c000009b;
+  Xcpt_Integer_Overflow           = $c000009c;
+  Xcpt_Privileged_Instruction     = $c000009d;
+  Xcpt_Datatype_Misalignment      = $c000009e;
+  Xcpt_Breakpoint                 = $c000009f;
+  Xcpt_Single_Step                = $c00000a0;
+  Xcpt_Process_Terminate          = $c0010001;
+  Xcpt_Async_Process_Terminate    = $c0010002;
+  Xcpt_Signal                     = $c0010003;
+
+  Context_Control        = $00000001; { SS:ESP, CS:EIP, EFLAGS and EBP set }
+  Context_Integer        = $00000002; { EAX, EBX, ECX, EDX, ESI and EDI set }
+  Context_Segments       = $00000004; { DS, ES, FS, and GS set }
+  Context_Floating_Point = $00000008; { numeric coprocessor state set }
+  Context_Full           = Context_Control or
+                           Context_Integer or
+                           Context_Segments or
+                           Context_Floating_Point;
+
+type
+  PExceptionRegistrationRecord = ^TExceptionRegistrationRecord;
+  PExceptionReportRecord = ^TExceptionReportRecord;
+  PContextRecord = ^TContextRecord;
+
+  TExceptionHandler = function (Report: PExceptionReportRecord;
+                                RegRec: PExceptionRegistrationRecord;
+                                Context: PContextRecord;
+                                DispContext: pointer): cardinal; cdecl;
+
+  TExceptionRegistrationRecord = record
+    Prev_Structure: PExceptionRegistrationRecord;
+    ExceptionHandler: TExceptionHandler;
+  end;
+
+  TExceptionReportRecord = record
+    Exception_Num,
+    HandlerFlags: cardinal;
+    Nested_RepRec: PExceptionReportRecord;
+    Address: pointer;
+    ParamCount: cardinal;
+    Parameters: array [0..MaxExceptionParameters] of cardinal;
+  end;
+
+  TContextRecord = packed record
+    ContextFlags: cardinal;
+    Env: array [1..7] of cardinal;
+    FPUStack: array [0..7] of extended;
+    Reg_GS,
+    Reg_FS,
+    Reg_ES,
+    Reg_DS,
+    Reg_EDI,
+    Reg_ESI,
+    Reg_EAX,
+    Reg_EBX,
+    Reg_ECX,
+    Reg_EDX,
+    Reg_EBP,
+    Reg_EIP,
+    Reg_CS,
+    Flags,
+    Reg_ESP,
+    Reg_SS: cardinal;
+  end;
 
 
 
 
+function DosSetExceptionHandler (var RegRec: TExceptionRegistrationRecord):
+                                                               cardinal; cdecl;
+external 'DOSCALLS' index 354;
+
+function DosUnsetExceptionHandler (var RegRec: TExceptionRegistrationRecord):
+                                                               cardinal; cdecl;
+external 'DOSCALLS' index 355;
+
+{Full screen applications can get Ctrl-C and Ctrl-Break focus. For all
+ processes sharing one screen, only one can have Ctrl-C focus.
+ Enable     = 0 = Release focus, 1 = Get focus.
+ Times      = Number of times focus has been get minus number of times it
+              has been released.}
+function DosSetSignalExceptionFocus (Enable: cardinal;
+                                         var Times: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 378;
+
+{Tell we want further signal exceptions.
+ SignalNum  = Signal number to acknowlegde.}
+function DosAcknowledgeSignalException (SignalNum: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 418;
+
+function DosError (Error: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 212;
+
+
+type
+  TWinMessageBox = function (Parent, Owner: cardinal;
+         BoxText, BoxTitle: PChar; Identity, Style: cardinal): cardinal; cdecl;
+  TWinInitialize = function (Options: cardinal): cardinal; cdecl;
+  TWinCreateMsgQueue = function (Handle: cardinal; cmsg: longint): cardinal;
+                                                                         cdecl;
+
+const
+  ErrorBufferLength = 1024;
+  mb_OK = $0000;
+  mb_Error = $0040;
+  mb_Moveable = $4000;
+  MBStyle = mb_OK or mb_Error or mb_Moveable;
+
+  mfPag_Read      = $00001;   {Give read access to memory.}
+  mfPag_Write     = $00002;   {Give write access to memory.}
+  mfPag_Execute   = $00004;   {Allow code execution in memory.}
+  mfPag_Guard     = $00008;   {Used for dynamic memory growing. Create
+                               uncommitted memory and make the first
+                               page guarded. Once it is accessed it
+                               will be made committed, and the next
+                               uncommitted page will be made guarded.}
+  mfPag_Commit    = $00010;   {Make the memory committed.}
+  mfPag_Decommit  = $00020;   {Decommit the page.}
+  mfObj_Tile      = $00040;   {Also allocate 16-bit segments of 64k
+                               which map the memory. (Makes 16<>32 bit
+                               pointer conversion possible.}
+  mfObj_Protected = $00080;
+  mfObj_Gettable  = $00100;
+  mfObj_Giveable  = $00200;
+  mfObj_Any       = $00400;   {Allow using high memory (> 512 MB).}
+  mfPag_Default   = $00400;
+  mfPag_Shared    = $02000;
+  mfPag_Free      = $04000;
+  mfPag_Base      = $10000;
+
+  mfSub_Init      = $00001;   {Use base, if not set, choose a base
+                               address yourself.}
+  mfSub_Grow      = $00002;   {Grow the specified heap, instead of
+                               allocating it. Ignore mfSub_Init.}
+  mfSub_Sparse    = $00004;
+  mfSub_Serialize = $00008;
+
+function DosQueryMem (P: pointer; var Size, Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 306;

+ 460 - 77
rtl/os2/system.pas

@@ -26,20 +26,10 @@ interface
   {.$define DEBUGARGUMENTS}
   {.$define DEBUGARGUMENTS}
 {$endif SYSTEMDEBUG}
 {$endif SYSTEMDEBUG}
 
 
-{ $DEFINE OS2EXCEPTIONS}
+{$DEFINE OS2EXCEPTIONS}
 
 
 {$I systemh.inc}
 {$I systemh.inc}
 
 
-{$IFDEF OS2EXCEPTIONS}
-(* Types and constants for exception handler support *)
-type
-{x}   PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
-{x}   TEXCEPTION_FRAME = record
-{x}     next : PEXCEPTION_FRAME;
-{x}     handler : pointer;
-{x}   end;
-
-{$ENDIF OS2EXCEPTIONS}
 
 
 const
 const
   LineEnding = #13#10;
   LineEnding = #13#10;
@@ -54,47 +44,8 @@ const
   
   
 type    Tos=(osDOS,osOS2,osDPMI);
 type    Tos=(osDOS,osOS2,osDPMI);
 
 
-const   os_mode: Tos = osOS2;
-        first_meg: pointer = nil;
-
-{$IFDEF OS2EXCEPTIONS}
-{x}  System_exception_frame : PEXCEPTION_FRAME =nil;
-{$ENDIF OS2EXCEPTIONS}
-
-type    TByteArray = array [0..$ffff] of byte;
-        PByteArray = ^TByteArray;
-
-        TSysThreadIB = record
-            TID,
-            Priority,
-            Version: cardinal;
-            MCCount,
-            MCForceFlag: word;
-        end;
-        PSysThreadIB = ^TSysThreadIB;
-
-        TThreadInfoBlock = record
-            PExChain,
-            Stack,
-            StackLimit: pointer;
-            TIB2: PSysThreadIB;
-            Version,
-            Ordinal: cardinal;
-        end;
-        PThreadInfoBlock = ^TThreadInfoBlock;
-        PPThreadInfoBlock = ^PThreadInfoBlock;
-
-        TProcessInfoBlock = record
-            PID,
-            ParentPid,
-            Handle: cardinal;
-            Cmd,
-            Env: PByteArray;
-            Status,
-            ProcType: cardinal;
-        end;
-        PProcessInfoBlock = ^TProcessInfoBlock;
-        PPProcessInfoBlock = ^PProcessInfoBlock;
+const   OS_Mode: Tos = osOS2;
+        First_Meg: pointer = nil;
 
 
 const   UnusedHandle=-1;
 const   UnusedHandle=-1;
         StdInputHandle=0;
         StdInputHandle=0;
@@ -185,23 +136,431 @@ const
 
 
 implementation
 implementation
 
 
-{$I system.inc}
 
 
+{*****************************************************************************
 
 
-{****************************************************************************
+                        System unit initialization.
 
 
-                    Miscellaneous related routines.
+****************************************************************************}
+
+{$I system.inc}
+
+{*****************************************************************************
+
+                           Exception handling.
 
 
 ****************************************************************************}
 ****************************************************************************}
 
 
+{$IFDEF OS2EXCEPTIONS}
+var
+  { value of the stack segment
+    to check if the call stack can be written on exceptions }
+  _SS : Cardinal;
+
+function Is_Prefetch (P: pointer): boolean;
+  var
+    A: array [0..15] of byte;
+    DoAgain: boolean;
+    InstrLo, InstrHi, OpCode: byte;
+    I: longint;
+    MemSize, MemAttrs: cardinal;
+  begin
+    Is_Prefetch := false;
+
+    MemSize := SizeOf (A);
+    DosQueryMem (P, MemSize, MemAttrs);
+    if (MemAttrs and (mfPag_Free or mfPag_Commit) <> 0)
+                                               and (MemSize >= SizeOf (A)) then
+     Move (P^, A [0], SizeOf (A))
+    else
+     Exit;
+    I := 0;
+    DoAgain := true;
+    while DoAgain and (I < 15) do
+      begin
+        OpCode := A [I];
+        InstrLo := OpCode and $f;
+        InstrHi := OpCode and $f0;
+        case InstrHi of
+          { prefix? }
+          $20, $30:
+            DoAgain := (InstrLo and 7) = 6;
+          $60:
+            DoAgain := (InstrLo and $c) = 4;
+          $f0:
+            DoAgain := InstrLo in [0, 2, 3];
+          $0:
+            begin
+              Is_Prefetch := (InstrLo = $f) and (A [I + 1] in [$D, $18]);
+              Exit;
+            end;
+          else
+            DoAgain := false;
+        end;
+        Inc (I);
+      end;
+  end;
+
+const
+  MaxExceptionLevel = 16;
+  ExceptLevel: byte = 0;
+
+var
+  ExceptEIP: array [0..MaxExceptionLevel - 1] of longint;
+  ExceptError: array [0..MaxExceptionLevel - 1] of byte;
+  ResetFPU: array [0..MaxExceptionLevel - 1] of boolean;
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+procedure DebugHandleErrorAddrFrame (Error: longint; Addr, Frame: pointer);
+begin
+ if IsConsole then
+  begin
+   Write (StdErr, ' HandleErrorAddrFrame (error = ', Error);
+   Write (StdErr, ', addr = ', hexstr (PtrUInt (Addr), 8));
+   WriteLn (StdErr, ', frame = ', hexstr (PtrUInt (Frame), 8), ')');
+  end;
+ HandleErrorAddrFrame (Error, Addr, Frame);
+end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+
+procedure JumpToHandleErrorFrame;
+var
+ EIP, EBP, Error: longint;
+begin
+ (* save ebp *)
+ asm
+  movl (%ebp),%eax
+  movl %eax,ebp
+ end;
+ if (ExceptLevel > 0) then
+  Dec (ExceptLevel);
+ EIP := ExceptEIP [ExceptLevel];
+ Error := ExceptError [ExceptLevel];
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then
+  WriteLn (StdErr, 'In JumpToHandleErrorFrame error = ', Error);
+{$endif SYSTEMEXCEPTIONDEBUG}
+ if ResetFPU [ExceptLevel] then
+  SysResetFPU;
+ { build a fake stack }
+ asm
+{$ifdef REGCALL}
+  movl   ebp,%ecx
+  movl   eip,%edx
+  movl   error,%eax
+  pushl  eip
+  movl   ebp,%ebp // Change frame pointer
+{$else}
+  movl   ebp,%eax
+  pushl  %eax
+  movl   eip,%eax
+  pushl  %eax
+  movl   error,%eax
+  pushl  %eax
+  movl   eip,%eax
+  pushl  %eax
+  movl   ebp,%ebp // Change frame pointer
+{$endif}
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+  jmpl   DebugHandleErrorAddrFrame
+{$else not SYSTEMEXCEPTIONDEBUG}
+  jmpl   HandleErrorAddrFrame
+{$endif SYSTEMEXCEPTIONDEBUG}
+ end;
+end;
+
+
+function System_Exception_Handler (Report: PExceptionReportRecord;
+                                   RegRec: PExceptionRegistrationRecord;
+                                   Context: PContextRecord;
+                                   DispContext: pointer): cardinal; cdecl;
+var
+ Res: cardinal;
+ Err: byte;
+ Must_Reset_FPU: boolean;
+ CurSS: cardinal;
+ B: byte;
+begin
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then
+  begin
+    asm
+      xorl %eax,%eax
+      movw %ss,%ax
+      movl %eax,CurSS
+    end;
+    WriteLn (StdErr, 'In System_Exception_Handler, error = ',
+                                            HexStr (Report^.Exception_Num, 8));
+    WriteLn (StdErr, 'Context SS = ', HexStr (Context^.Reg_SS, 8),
+                                         ', current SS = ', HexStr (CurSS, 8));
+  end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ Res := Xcpt_Continue_Search;
+ if Context^.Reg_SS = _SS then
+  begin
+   Err := 0;
+   Must_Reset_FPU := true;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+   if IsConsole then
+    Writeln (StdErr, 'Exception  ', HexStr (Report^.Exception_Num, 8));
+{$endif SYSTEMEXCEPTIONDEBUG}
+   case Report^.Exception_Num of
+    Xcpt_Integer_Divide_By_Zero,
+    Xcpt_Float_Divide_By_Zero:
+      Err := 200;
+    Xcpt_Array_Bounds_Exceeded:
+     begin
+      Err := 201;
+      Must_Reset_FPU := false;
+     end;
+    Xcpt_Unable_To_Grow_Stack:
+     begin
+      Err := 202;
+      Must_Reset_FPU := false;
+     end;
+    Xcpt_Float_Overflow:
+     Err := 205;
+    Xcpt_Float_Denormal_Operand,
+    Xcpt_Float_Underflow:
+     Err := 206;
+    {Context^.FloatSave.StatusWord := Context^.FloatSave.StatusWord and $ffffff00;}
+    Xcpt_Float_Inexact_Result,
+    Xcpt_Float_Invalid_Operation,
+    Xcpt_Float_Stack_Check:
+     Err := 207;
+    Xcpt_Integer_Overflow:
+     begin
+      Err := 215;
+      Must_Reset_FPU := false;
+     end;
+    Xcpt_Illegal_Instruction:
+          { if we're testing sse support, simply set the flag and continue }
+     if SSE_Check then
+      begin
+       OS_Supports_SSE := false;
+          { skip the offending movaps %xmm7, %xmm6 instruction }
+       Inc (Context^.Reg_EIP, 3);
+       Report^.Exception_Num := 0;
+       Res := Xcpt_Continue_Execution;
+      end
+     else
+      Err := 216;
+    Xcpt_Access_Violation:
+     { Athlon prefetch bug? }
+     if Is_Prefetch (pointer (Context^.Reg_EIP)) then
+      begin
+       { if yes, then retry }
+       Report^.Exception_Num := 0;
+       Res := Xcpt_Continue_Execution;
+      end
+     else
+      Err := 216;
+    Xcpt_Signal:
+     case Report^.Parameters [0] of
+      Xcpt_Signal_KillProc:
+       Err := 217;
+      Xcpt_Signal_Break,
+      Xcpt_Signal_Intr:
+       if Assigned (CtrlBreakHandler) then
+        if CtrlBreakHandler (Report^.Parameters [0] = Xcpt_Signal_Break) then
+         begin
+{$IFDEF SYSTEMEXCEPTIONDEBUG}
+          WriteLn (StdErr, 'CtrlBreakHandler returned true');
+{$ENDIF SYSTEMEXCEPTIONDEBUG}
+          Report^.Exception_Num := 0;
+          Res := Xcpt_Continue_Execution;
+          DosAcknowledgeSignalException (Report^.Parameters [0]);
+         end
+        else
+         Err := 217;
+     end;
+    Xcpt_Privileged_Instruction:
+     begin
+      Err := 218;
+      Must_Reset_FPU := false;
+     end;
+    else
+     begin
+      if ((Report^.Exception_Num and Xcpt_Severity_Code)
+                                                   = Xcpt_Fatal_Exception) then
+       Err := 217
+      else
+       Err := 255;
+     end;
+   end;
+
+   if (Err <> 0) and (ExceptLevel < MaxExceptionLevel) then
+    begin
+     ExceptEIP [ExceptLevel] := Context^.Reg_EIP;
+     ExceptError [ExceptLevel] := Err;
+     ResetFPU [ExceptLevel] := Must_Reset_FPU;
+     Inc (ExceptLevel);
+
+     Context^.Reg_EIP := cardinal (@JumpToHandleErrorFrame);
+     Report^.Exception_Num := 0;
+
+     Res := Xcpt_Continue_Execution;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+     if IsConsole then
+      begin
+       WriteLn (StdErr, 'Exception Continue Exception set at ',
+                                          HexStr (ExceptEIP [ExceptLevel], 8));
+       WriteLn (StdErr, 'EIP changed to ',
+             HexStr (longint (@JumpToHandleErrorFrame), 8), ', error = ', Err);
+      end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+    end;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+  end
+ else
+  if (Report^.Exception_Num = Xcpt_Signal) and
+    (Report^.Parameters [0] and (Xcpt_Signal_Intr or Xcpt_Signal_Break) <> 0)
+                                           and Assigned (CtrlBreakHandler) then
+{$IFDEF SYSTEMEXCEPTIONDEBUG}
+   begin
+    WriteLn (StdErr, 'XCPT_SIGNAL caught, CtrlBreakHandler assigned, Param = ',
+                                                       Report^.Parameters [0]);
+{$ENDIF SYSTEMEXCEPTIONDEBUG}
+   if CtrlBreakHandler (Report^.Parameters [0] = Xcpt_Signal_Break) then
+    begin
+{$IFDEF SYSTEMEXCEPTIONDEBUG}
+     WriteLn (StdErr, 'CtrlBreakHandler returned true');
+{$ENDIF SYSTEMEXCEPTIONDEBUG}
+     Report^.Exception_Num := 0;
+     Res := Xcpt_Continue_Execution;
+     DosAcknowledgeSignalException (Report^.Parameters [0]);
+    end
+   else
+    Err := 217
+{$IFDEF SYSTEMEXCEPTIONDEBUG}
+   end
+{$ENDIF SYSTEMEXCEPTIONDEBUG}
+  else
+   if IsConsole then
+    begin
+     WriteLn (StdErr, 'Ctx flags = ', HexStr (Context^.ContextFlags, 8));
+     if Context^.ContextFlags and Context_Floating_Point <> 0 then
+      begin
+       for B := 1 to 6 do
+        Write (StdErr, 'Ctx Env [', B, '] = ', HexStr (Context^.Env [B], 8),
+                                                                         ', ');
+        WriteLn (StdErr, 'Ctx Env [7] = ', HexStr (Context^.Env [7], 8));
+       for B := 0 to 6 do
+        Write (StdErr, 'FPU stack [', B, '] = ', Context^.FPUStack [B], ', ');
+       WriteLn (StdErr, 'FPU stack [7] = ', Context^.FPUStack [7]);
+      end;
+     if Context^.ContextFlags and Context_Segments <> 0 then
+      WriteLn (StdErr, 'GS = ', HexStr (Context^.Reg_GS, 8),
+                     ', FS = ', HexStr (Context^.Reg_FS, 8),
+                     ', ES = ', HexStr (Context^.Reg_ES, 8),
+                     ', DS = ', HexStr (Context^.Reg_DS, 8));
+     if Context^.ContextFlags and Context_Integer <> 0 then
+      begin
+       WriteLn (StdErr, 'EDI = ', HexStr (Context^.Reg_EDI, 8),
+                      ', ESI = ', HexStr (Context^.Reg_ESI, 8));
+       WriteLn (StdErr, 'EAX = ', HexStr (Context^.Reg_EAX, 8),
+                      ', EBX = ', HexStr (Context^.Reg_EBX, 8),
+                      ', ECX = ', HexStr (Context^.Reg_ECX, 8),
+                      ', EDX = ', HexStr (Context^.Reg_EDX, 8));
+      end;
+     if Context^.ContextFlags and Context_Control <> 0 then
+      begin
+       WriteLn (StdErr, 'EBP = ', HexStr (Context^.Reg_EBP, 8),
+                      ', SS = ', HexStr (Context^.Reg_SS, 8),
+                      ', ESP = ', HexStr (Context^.Reg_ESP, 8));
+       WriteLn (StdErr, 'CS = ', HexStr (Context^.Reg_CS, 8),
+                      ', EIP = ', HexStr (Context^.Reg_EIP, 8),
+                      ', EFlags = ', HexStr (Context^.Flags, 8));
+      end;
+    end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ System_Exception_Handler := Res;
+end;
+
+
+var
+  ExcptReg: PExceptionRegistrationRecord; public name '_excptregptr';
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+var
+ OldExceptAddr,
+ NewExceptAddr: PtrUInt;
+{$endif SYSTEMEXCEPTIONDEBUG}
+
+procedure Install_Exception_Handler;
+var
+ T: cardinal;
+begin
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+(* ThreadInfoBlock is located at FS:[0], the first      *)
+(* entry is pointer to head of exception handler chain. *)
+ asm
+  movl $0,%eax
+  movl %fs:(%eax),%eax
+  movl %eax, OldExceptAddr
+ end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ with ExcptReg^ do
+  begin
+   Prev_Structure := nil;
+   ExceptionHandler := TExceptionHandler (@System_Exception_Handler);
+  end;
+ (* Disable pop-up windows for errors and exceptions *)
+ DosError (deDisableExceptions);
+ DosSetExceptionHandler (ExcptReg^);
+ if IsConsole then
+  begin
+   DosSetSignalExceptionFocus (1, T);
+   DosAcknowledgeSignalException (Xcpt_Signal_Intr);
+   DosAcknowledgeSignalException (Xcpt_Signal_Break);
+  end;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ asm
+  movl $0,%eax
+  movl %fs:(%eax),%eax
+  movl %eax, NewExceptAddr
+ end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+end;
+
+procedure Remove_Exception_Handlers;
+begin
+  DosUnsetExceptionHandler (ExcptReg^);
+end;
+{$ENDIF OS2EXCEPTIONS}
 
 
 procedure system_exit;
 procedure system_exit;
 begin
 begin
+(*  if IsLibrary then
+    ExitDLL(ExitCode);
+*)
+(*
+  if not IsConsole then
+   begin
+     Close(stderr);
+     Close(stdout);
+     Close(erroutput);
+     Close(Input);
+     Close(Output);
+   end;
+*)
+{$IFDEF OS2EXCEPTIONS}
+  Remove_Exception_Handlers;
+{$ENDIF OS2EXCEPTIONS}
   DosExit (1{process}, exitcode);
   DosExit (1{process}, exitcode);
 end;
 end;
 
 
 {$ASMMODE ATT}
 {$ASMMODE ATT}
 
 
+
+
+{****************************************************************************
+
+                    Miscellaneous related routines.
+
+****************************************************************************}
+
 function paramcount:longint;assembler;
 function paramcount:longint;assembler;
 asm
 asm
     movl argc,%eax
     movl argc,%eax
@@ -230,32 +589,13 @@ begin
   randseed:=dt.hour+(dt.minute shl 8)+(dt.second shl 16)+(dt.sec100 shl 32);
   randseed:=dt.hour+(dt.minute shl 8)+(dt.second shl 16)+(dt.sec100 shl 32);
 end;
 end;
 
 
-{$ASMMODE ATT}
 
 
 
 
-{*****************************************************************************
-
-                        System unit initialization.
-
-****************************************************************************}
-
 {****************************************************************************
 {****************************************************************************
                     Error Message writing using messageboxes
                     Error Message writing using messageboxes
 ****************************************************************************}
 ****************************************************************************}
 
 
-type
-  TWinMessageBox = function (Parent, Owner: cardinal;
-         BoxText, BoxTitle: PChar; Identity, Style: cardinal): cardinal; cdecl;
-  TWinInitialize = function (Options: cardinal): cardinal; cdecl;
-  TWinCreateMsgQueue = function (Handle: cardinal; cmsg: longint): cardinal;
-                                                                         cdecl;
-
 const
 const
-  ErrorBufferLength = 1024;
-  mb_OK = $0000;
-  mb_Error = $0040;
-  mb_Moveable = $4000;
-  MBStyle = mb_OK or mb_Error or mb_Moveable;
   WinInitialize: TWinInitialize = nil;
   WinInitialize: TWinInitialize = nil;
   WinCreateMsgQueue: TWinCreateMsgQueue = nil;
   WinCreateMsgQueue: TWinCreateMsgQueue = nil;
   WinMessageBox: TWinMessageBox = nil;
   WinMessageBox: TWinMessageBox = nil;
@@ -503,9 +843,10 @@ begin
   envp[env_count]:=nil;
   envp[env_count]:=nil;
 end;
 end;
 
 
+
 var
 var
 (* Initialized by system unit initialization *)
 (* Initialized by system unit initialization *)
-    PIB: PProcessInfoBlock;
+  PIB: PProcessInfoBlock;
 
 
 
 
 procedure InitArguments;
 procedure InitArguments;
@@ -736,14 +1077,43 @@ var TIB: PThreadInfoBlock;
 const
 const
     DosCallsName: array [0..8] of char = 'DOSCALLS'#0;
     DosCallsName: array [0..8] of char = 'DOSCALLS'#0;
 
 
+
+{*var}
+{* ST: pointer;}
+{*}
 begin
 begin
     IsLibrary := FALSE;
     IsLibrary := FALSE;
 
 
-    (* Initialize the amount of file handles *)
-    FileHandleCount := GetFileHandleCount;
+{$IFDEF OS2EXCEPTIONS}
+(*    asm
+      { allocate space for exception registration record }
+     pushl $0
+     pushl $0}
+{*     pushl %fs:(0)}
+        { movl  %esp,%fs:(0)
+          but don't insert it as it doesn't
+          point to anything yet
+          this will be used in signals unit }
+     movl %esp,%eax
+     movl %eax,ExcptReg
+     pushl %ebp
+     movl %esp,%eax
+{*     movl %eax,st*}
+     movl %eax,StackTop
+    end;
+{*    StackTop:=st;}
+*)    asm
+     xorl %eax,%eax
+     movw %ss,%ax
+     movl %eax,_SS
+     call SysResetFPU
+    end;
+{$ENDIF OS2EXCEPTIONS}
     DosGetInfoBlocks (@TIB, @PIB);
     DosGetInfoBlocks (@TIB, @PIB);
     StackBottom := TIB^.Stack;
     StackBottom := TIB^.Stack;
+{ $IFNDEF OS2EXCEPTIONS}
     StackTop := TIB^.StackLimit;
     StackTop := TIB^.StackLimit;
+{ $ENDIF OS2EXCEPTIONS}
     StackLength := CheckInitialStkLen (InitialStkLen);
     StackLength := CheckInitialStkLen (InitialStkLen);
 
 
     {Set type of application}
     {Set type of application}
@@ -754,6 +1124,13 @@ begin
 
 
     ExitProc := nil;
     ExitProc := nil;
 
 
+{$IFDEF OS2EXCEPTIONS}
+    Install_Exception_Handler;
+{$ENDIF OS2EXCEPTIONS}
+
+    (* Initialize the amount of file handles *)
+    FileHandleCount := GetFileHandleCount;
+
     {Initialize the heap.}
     {Initialize the heap.}
     (* Logic is following:
     (* Logic is following:
        The heap is initially restricted to low address space (< 512 MB).
        The heap is initially restricted to low address space (< 512 MB).
@@ -795,6 +1172,7 @@ begin
 
 
     { ... and exceptions }
     { ... and exceptions }
     SysInitExceptions;
     SysInitExceptions;
+    fpc_cpucodeinit;
 
 
     { ... and I/O }
     { ... and I/O }
     SysInitStdIO;
     SysInitStdIO;
@@ -821,4 +1199,9 @@ begin
 {$IFDEF EXTDUMPGROW}
 {$IFDEF EXTDUMPGROW}
 {    Int_HeapSize := high (cardinal);}
 {    Int_HeapSize := high (cardinal);}
 {$ENDIF EXTDUMPGROW}
 {$ENDIF EXTDUMPGROW}
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then
+  WriteLn (StdErr, 'Old exception ', HexStr (OldExceptAddr, 8),
+   ', new exception ', HexStr (NewExceptAddr, 8), ', _SS = ', HexStr (_SS, 8));
+{$endif SYSTEMEXCEPTIONDEBUG}
 end.
 end.