mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 11:24:16 +01:00
533 lines
18 KiB
PHP
533 lines
18 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2001-2015 by Free Pascal development team
|
|
|
|
This file contains a subset of OS/2 base types and imported OS/2 API
|
|
functions necessary for implementation of unit system.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
|
|
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
|
|
ProcessID: SizeUInt;
|
|
|
|
function GetProcessID: SizeUInt;
|
|
begin
|
|
GetProcessID := ProcessID;
|
|
end;
|
|
|
|
|
|
type
|
|
TSysDateTime=packed record
|
|
Hour,
|
|
Minute,
|
|
Second,
|
|
Sec100,
|
|
Day,
|
|
Month: byte;
|
|
Year: word;
|
|
TimeZone: smallint;
|
|
WeekDay: byte;
|
|
end;
|
|
|
|
|
|
procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
|
|
PAPIB: PPProcessInfoBlock); cdecl;
|
|
external 'DOSCALLS' index 312;
|
|
|
|
function DosLoadModule (ObjName: PAnsiChar; ObjLen: cardinal; DLLName: PAnsiChar;
|
|
var Handle: THandle): cardinal; cdecl;
|
|
external 'DOSCALLS' index 318;
|
|
|
|
function DosFreeModule (Handle: THandle): cardinal; cdecl;
|
|
external 'DOSCALLS' index 322;
|
|
|
|
function DosQueryModuleHandle (DLLName: PAnsiChar; var Handle: THandle): cardinal;
|
|
cdecl;
|
|
external 'DOSCALLS' index 319;
|
|
|
|
function DosQueryProcAddr (Handle, Ordinal: cardinal; ProcName: PAnsiChar;
|
|
var Address: pointer): cardinal; cdecl;
|
|
external 'DOSCALLS' index 321;
|
|
|
|
function DosSetRelMaxFH (var ReqCount: longint; var CurMaxFH: cardinal):
|
|
cardinal; cdecl;
|
|
external 'DOSCALLS' index 382;
|
|
|
|
function DosSetCurrentDir (Name:PAnsiChar): cardinal; cdecl;
|
|
external 'DOSCALLS' index 255;
|
|
|
|
procedure DosQueryCurrentDisk(var DiskNum:cardinal;var Logical:cardinal); cdecl;
|
|
external 'DOSCALLS' index 275;
|
|
|
|
function DosSetDefaultDisk (DiskNum:cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 220;
|
|
|
|
{ This is not real prototype, but is close enough }
|
|
{ for us (the 2nd parameter is actually a pointer }
|
|
{ to a structure). }
|
|
function DosCreateDir (Name: PAnsiChar; P: pointer): cardinal; cdecl;
|
|
external 'DOSCALLS' index 270;
|
|
|
|
function DosDeleteDir (Name: PAnsiChar): cardinal; cdecl;
|
|
external 'DOSCALLS' index 226;
|
|
|
|
function DosQueryCurrentDir(DiskNum:cardinal;var Buffer;
|
|
var BufLen:cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 274;
|
|
|
|
function DosMove(OldFile,NewFile:PAnsiChar):cardinal; cdecl;
|
|
external 'DOSCALLS' index 271;
|
|
|
|
function DosDelete(FileName:PAnsiChar):cardinal; cdecl;
|
|
external 'DOSCALLS' index 259;
|
|
|
|
procedure DosExit(Action, Result: cardinal); cdecl;
|
|
external 'DOSCALLS' index 234;
|
|
|
|
// EAs not used in System unit
|
|
function DosOpen(FileName:PAnsiChar;var Handle: THandle;var Action:cardinal;
|
|
InitSize,Attrib,OpenFlags,FileMode:cardinal;
|
|
EA:Pointer): cardinal; cdecl;
|
|
external 'DOSCALLS' index 273;
|
|
|
|
function DosClose(Handle: THandle): cardinal; cdecl;
|
|
external 'DOSCALLS' index 257;
|
|
|
|
function DosRead(Handle: THandle; Buffer: Pointer; Count: cardinal;
|
|
var ActCount: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 281;
|
|
|
|
function DosWrite(Handle: THandle; Buffer: Pointer;Count: cardinal;
|
|
var ActCount: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 282;
|
|
|
|
function DosSetFilePtr(Handle: THandle; Pos:longint; Method:cardinal;
|
|
var PosActual: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 256;
|
|
|
|
function DosSetFileSize(Handle: THandle; Size: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 272;
|
|
|
|
function DosQueryHType(Handle: THandle; var HandType: cardinal;
|
|
var Attr: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 224;
|
|
|
|
function DosQueryModuleName (Handle: THandle; NameLen: cardinal; Name: PAnsiChar):
|
|
cardinal; cdecl;
|
|
external 'DOSCALLS' index 320;
|
|
|
|
function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
|
|
external 'DOSCALLS' index 230;
|
|
|
|
|
|
{
|
|
Already declared in interface part:
|
|
type
|
|
TDosOpenL = function (FileName: PAnsiChar; var Handle: THandle;
|
|
var Action: cardinal; InitSize: int64;
|
|
Attrib, OpenFlags, FileMode: cardinal;
|
|
EA: pointer): cardinal; cdecl;
|
|
|
|
TDosSetFilePtrL = function (Handle: THandle; Pos: int64; Method: cardinal;
|
|
var PosActual: int64): cardinal; cdecl;
|
|
|
|
TDosSetFileSizeL = function (Handle: THandle; Size: int64): cardinal; cdecl;
|
|
}
|
|
|
|
function DummyDosOpenL (FileName: PAnsiChar; var Handle: THandle;
|
|
var Action: cardinal; InitSize: int64;
|
|
Attrib, OpenFlags, FileMode: cardinal;
|
|
EA: pointer): cardinal; cdecl;
|
|
begin
|
|
DummyDosOpenL := DosOpen (FileName, Handle, Action, InitSize, Attrib,
|
|
OpenFlags, FileMode, EA);
|
|
end;
|
|
|
|
|
|
function DummyDosSetFilePtrL (Handle: THandle; Pos: int64; Method: cardinal;
|
|
var PosActual: int64): cardinal; cdecl;
|
|
var
|
|
PosAct0: cardinal;
|
|
begin
|
|
DummyDosSetFilePtrL := DosSetFilePtr (Handle, Pos, Method, PosAct0);
|
|
PosActual := PosAct0;
|
|
end;
|
|
|
|
|
|
function DummyDosSetFileSizeL (Handle: THandle; Size: int64): cardinal; cdecl;
|
|
begin
|
|
DummyDosSetFileSizeL := DosSetFileSize (Handle, Size);
|
|
end;
|
|
|
|
|
|
const
|
|
OrdDosOpenL = 981;
|
|
OrdDosSetFilePtrL = 988;
|
|
OrdDosSetFileSizeL = 989;
|
|
|
|
{ converts an OS/2 error code to a TP compatible error }
|
|
{ code. Same thing exists under most other supported }
|
|
{ systems. }
|
|
{ Only call for OS/2 DLL imported routines }
|
|
Procedure Errno2InOutRes;
|
|
Begin
|
|
{ errors 1..18 are the same as in DOS }
|
|
case InOutRes of
|
|
{ simple offset to convert these error codes }
|
|
{ exactly like the error codes in Win32 }
|
|
19..31 : InOutRes := InOutRes + 131;
|
|
{ gets a bit more complicated ... }
|
|
32..33 : InOutRes := 5;
|
|
38 : InOutRes := 100;
|
|
39 : InOutRes := 101;
|
|
112 : InOutRes := 101;
|
|
110 : InOutRes := 5;
|
|
114 : InOutRes := 6;
|
|
206 : InOutRes := 3; (* TH: Path too long *)
|
|
290 : InOutRes := 4;
|
|
end;
|
|
{ all other cases ... we keep the same error code }
|
|
end;
|
|
|
|
|
|
(* 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..Pred (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: PAnsiChar; 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;
|
|
|
|
function DosQuerySysInfo (First, Last: cardinal; var Buf; BufSize: cardinal):
|
|
cardinal; cdecl;
|
|
external 'DOSCALLS' index 348;
|
|
|
|
type
|
|
TCPArray = array [0..2] of cardinal;
|
|
PCPArray = ^TCPArray;
|
|
|
|
function DosQueryCP (Size: cardinal; CodePages: PCPArray;
|
|
var ActSize: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 291;
|
|
|
|
function DosSetProcessCP (CP: cardinal): cardinal; cdecl;
|
|
external 'DOSCALLS' index 289;
|
|
|
|
type
|
|
TCountryCode = record
|
|
Country, {Country to query info about (0=current).}
|
|
CodePage: cardinal; {Code page to query info about (0=current).}
|
|
end;
|
|
|
|
function DosMapCase (Size: cardinal; var Country: TCountryCode;
|
|
AString: PAnsiChar): cardinal; cdecl;
|
|
external 'NLS' index 7;
|
|
|
|
function DosQueryDBCSEnv (Size: cardinal; var Country: TCountryCode;
|
|
Buf: PAnsiChar): cardinal; cdecl;
|
|
external 'NLS' index 6;
|
|
|
|
function DosQueryCollate (Size: cardinal; var Country: TCountryCode;
|
|
Buf: PByteArray; var TableLen: cardinal): cardinal; cdecl;
|
|
external 'NLS' index 8;
|
|
|
|
type
|
|
TTimeFmt = (Clock12, Clock24);
|
|
|
|
TCountryInfo = record
|
|
Country, CodePage: cardinal; {Country and codepage requested.}
|
|
DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
|
|
CurrencyUnit: array [0..4] of AnsiChar;
|
|
ThousandSeparator: AnsiChar; {Thousands separator.}
|
|
Zero1: byte; {Always zero.}
|
|
DecimalSeparator: AnsiChar; {Decimals separator,}
|
|
Zero2: byte;
|
|
DateSeparator: AnsiChar; {Date separator.}
|
|
Zero3: byte;
|
|
TimeSeparator: AnsiChar; {Time separator.}
|
|
Zero4: byte;
|
|
CurrencyFormat, {Bit field:
|
|
Bit 0: 0=indicator before value
|
|
1=indicator after value
|
|
Bit 1: 1=insert space after indicator.
|
|
Bit 2: 1=Ignore bit 0&1, replace
|
|
decimal separator with
|
|
indicator.}
|
|
DecimalPlace: byte; {Number of decimal places used in
|
|
currency indication.}
|
|
TimeFormat: TTimeFmt; {12/24 hour.}
|
|
Reserve1: array [0..1] of word;
|
|
DataSeparator: AnsiChar; {Data list separator}
|
|
Zero5: byte;
|
|
Reserve2: array [0..4] of word;
|
|
end;
|
|
|
|
const
|
|
CurrentCountry: TCountryCode = (Country: 0; CodePage: 0);
|
|
|
|
function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
|
|
var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
|
|
external 'NLS' index 5;
|
|
|
|
type
|
|
PInsertTable = ^TInsertTable;
|
|
TInsertTable = array [1..9] of PAnsiChar;
|
|
|
|
function DosTrueGetMessage (MsgSeg: pointer; Table: PInsertTable;
|
|
TableSize: cardinal; Buf: PAnsiChar;
|
|
BufSize, MsgNumber: cardinal; FileName: PAnsiChar;
|
|
var MsgSize: cardinal): cardinal; cdecl;
|
|
external 'MSG' index 6;
|
|
|
|
procedure MagicHeaderEnd; assembler; forward;
|
|
|
|
{$ASMMODE INTEL}
|
|
|
|
{start of _MSGSEG32 segment}
|
|
procedure MagicHeaderStart; assembler;
|
|
asm
|
|
db $0FF
|
|
db $4D,$53,$47,$53,$45,$47,$33,$32, 0 //'MSGSEG32'
|
|
dd $8001
|
|
dd MagicHeaderEnd
|
|
end;
|
|
|
|
function DosGetMessage (Table: PInsertTable; TableSize: cardinal; Buf: PAnsiChar;
|
|
BufSize, MsgNumber: cardinal; FileName: PAnsiChar;
|
|
var MsgSize: cardinal): cardinal; cdecl; assembler;
|
|
nostackframe;
|
|
asm
|
|
pop eax
|
|
push offset MagicHeaderStart
|
|
push eax
|
|
jmp DosTrueGetMessage
|
|
end;
|
|
|
|
procedure MagicHeaderEnd; assembler;
|
|
asm
|
|
dd $0FFFF0000
|
|
end;
|
|
{$ASMMODE DEFAULT}
|