paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 05:29:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ import catch, throw and stack management win16 api functions

Browse Source 
git-svn-id: trunk@31540 -
This commit is contained in:
nickysn 2015-09-05 21:41:37 +00:00
parent e09f230250
commit 10a01c0127
2 changed files with 22 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
rtl/win16/winprocs.pp
View File

@ -1,5 +1,9 @@
unit winprocs;
{$if defined(FPC_MM_COMPACT) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)}
{$define VAR_PARAMS_ARE_FAR}
{$endif}
interface
uses
@ -50,6 +54,18 @@ procedure OutputDebugString(OutputString: LPCSTR); external 'KERNEL';
function SetErrorMode(Mode: UINT): UINT; external 'KERNEL';
{ Catch/Throw and stack management }
function Catch(CatchBuf: LPCATCHBUF): SmallInt; external 'KERNEL';
procedure Throw(CatchBuf: LPCATCHBUF; ThrowBack: SmallInt); external 'KERNEL';
{$ifdef VAR_PARAMS_ARE_FAR}
function Catch(var CatchBuf: TCatchBuf): SmallInt; external 'KERNEL';
procedure Throw(var CatchBuf: TCatchBuf; ThrowBack: SmallInt); external 'KERNEL';
{$endif}
procedure SwitchStackBack; external 'KERNEL';
procedure SwitchStackTo(StackSegment, StackPointer, StackTop: UINT); external 'KERNEL';
implementation
function LOBYTE(w: Word): Byte;

6
rtl/win16/wintypes.pp
View File

@ -87,6 +87,12 @@ const
SEM_NOGPFAULTERRORBOX = $0002;
SEM_NOOPENFILEERRORBOX = $8000;
type
LPCATCHBUF = ^CATCHBUF; far;
CATCHBUF = array [0..8] of SmallInt;
PCatchBuf = ^TCatchBuf;
TCatchBuf = CATCHBUF;
implementation
end.