mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 05:38:05 +02:00
482 lines
14 KiB
PHP
482 lines
14 KiB
PHP
{%MainUnit sysutils.pp}
|
|
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Florian Klaempfl
|
|
member of the Free Pascal development team
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
{$MACRO ON}
|
|
{$IFNDEF FPC_DOTTEDUNITS}
|
|
{$DEFINE SUT:=sysutils}
|
|
{$DEFINE BU:=baseunix}
|
|
{$ELSE}
|
|
{$DEFINE SUT:=System.SysUtils}
|
|
{$DEFINE BU:=UnixApi.Base}
|
|
{$ENDIF}
|
|
|
|
{ Using inlining for small system functions/wrappers }
|
|
{$inline on}
|
|
{$define SYSUTILSINLINE}
|
|
|
|
{ Read internationalization settings }
|
|
{$i sysinth.inc}
|
|
|
|
{ Read date & Time function declarations }
|
|
{$i osutilsh.inc}
|
|
|
|
{$ifndef FPUNONE}
|
|
{$i datih.inc}
|
|
{$endif}
|
|
|
|
function GetTickCount: LongWord; deprecated 'Use GetTickCount64 instead';
|
|
function GetTickCount64: QWord;
|
|
|
|
{ Read String Handling functions declaration }
|
|
{$i sysstrh.inc}
|
|
|
|
type
|
|
{ some helpful data types }
|
|
|
|
THandle = System.THandle;
|
|
|
|
TProcedure = procedure;
|
|
|
|
TFileName = type string;
|
|
|
|
TIntegerSet = Set of 0..SizeOf(Integer)*8-1;
|
|
|
|
LongRec = packed record
|
|
case Integer of
|
|
{$ifdef FPC_LITTLE_ENDIAN}
|
|
0 : (Lo,Hi : Word);
|
|
{$else FPC_LITTLE_ENDIAN}
|
|
0 : (Hi,Lo : Word);
|
|
{$endif FPC_LITTLE_ENDIAN}
|
|
1 : (Bytes : Array[0..3] of Byte);
|
|
end;
|
|
|
|
WordRec = packed record
|
|
{$ifdef FPC_LITTLE_ENDIAN}
|
|
Lo,Hi : Byte;
|
|
{$else FPC_LITTLE_ENDIAN}
|
|
Hi,Lo : Byte;
|
|
{$endif FPC_LITTLE_ENDIAN}
|
|
end;
|
|
|
|
Int64Rec = packed record
|
|
case integer of
|
|
{$ifdef FPC_LITTLE_ENDIAN}
|
|
0 : (Lo,Hi : Cardinal);
|
|
{$else FPC_LITTLE_ENDIAN}
|
|
0 : (Hi,Lo : Cardinal);
|
|
{$endif FPC_LITTLE_ENDIAN}
|
|
1 : (Words : Array[0..3] of Word);
|
|
2 : (Bytes : Array[0..7] of Byte);
|
|
end;
|
|
|
|
Int128Rec = packed record
|
|
case integer of
|
|
{$ifdef FPC_LITTLE_ENDIAN}
|
|
0 : (Lo,Hi : QWord);
|
|
{$else FPC_LITTLE_ENDIAN}
|
|
0 : (Hi,Lo : QWord);
|
|
{$endif FPC_LITTLE_ENDIAN}
|
|
1 : (DWords : Array[0..3] of DWord);
|
|
2 : (Words : Array[0..7] of Word);
|
|
3 : (Bytes : Array[0..15] of Byte);
|
|
end;
|
|
|
|
OWordRec = packed record
|
|
case integer of
|
|
{$ifdef FPC_LITTLE_ENDIAN}
|
|
0 : (Lo,Hi : QWord);
|
|
{$else FPC_LITTLE_ENDIAN}
|
|
0 : (Hi,Lo : QWord);
|
|
{$endif FPC_LITTLE_ENDIAN}
|
|
1 : (DWords : Array[0..3] of DWord);
|
|
2 : (Words : Array[0..7] of Word);
|
|
3 : (Bytes : Array[0..15] of Byte);
|
|
end;
|
|
|
|
PByteArray = ^TByteArray;
|
|
TByteArray = Array[0..{$ifdef CPU16}32766{$else}32767{$endif}] of Byte;
|
|
|
|
PWordarray = ^TWordArray;
|
|
TWordArray = array[0..{$ifdef CPU16}16382{$else}16383{$endif}] of Word;
|
|
|
|
TBytes = array of Byte;
|
|
|
|
{ exceptions }
|
|
Exception = class(TObject)
|
|
private
|
|
fmessage : string;
|
|
fhelpcontext : longint;
|
|
public
|
|
constructor Create(const msg : string);
|
|
constructor CreateFmt(const msg : string; const args : array of const);
|
|
constructor CreateRes(ResString: PResStringRec);
|
|
constructor CreateResFmt(ResString: PResStringRec; const Args: array of const);
|
|
constructor CreateHelp(const Msg: string; AHelpContext: Longint);
|
|
constructor CreateFmtHelp(const Msg: string; const Args: array of const;
|
|
AHelpContext: Longint);
|
|
constructor CreateResHelp(ResString: PResStringRec; AHelpContext: Longint);
|
|
constructor CreateResFmtHelp(ResString: PResStringRec; const Args: array of const;
|
|
AHelpContext: Longint);
|
|
Function ToString : RTLString; override;
|
|
|
|
function GetBaseException : Exception;virtual;
|
|
|
|
property HelpContext : longint read fhelpcontext write fhelpcontext;
|
|
property Message : string read fmessage write fmessage;
|
|
end;
|
|
|
|
ExceptClass = class of Exception;
|
|
|
|
EExternal = class(Exception)
|
|
{$if defined(win32) or defined(win64) or defined(wince)}
|
|
{ OS-provided exception record is stored on stack and has very limited lifetime.
|
|
Therefore store a complete copy. }
|
|
private
|
|
FExceptionRecord: TExceptionRecord;
|
|
function GetExceptionRecord: PExceptionRecord;
|
|
public
|
|
property ExceptionRecord : PExceptionRecord read GetExceptionRecord;
|
|
{$endif win32 or win64 or wince}
|
|
end;
|
|
|
|
{ integer math exceptions }
|
|
EIntError = Class(EExternal);
|
|
EDivByZero = Class(EIntError);
|
|
ERangeError = Class(EIntError);
|
|
EIntOverflow = Class(EIntError);
|
|
|
|
{ General math errors }
|
|
EMathError = Class(EExternal);
|
|
EInvalidOp = Class(EMathError);
|
|
EZeroDivide = Class(EMathError);
|
|
EOverflow = Class(EMathError);
|
|
EUnderflow = Class(EMathError);
|
|
EInvalidArgument = class(EMathError);
|
|
|
|
{ Run-time and I/O Errors }
|
|
EInOutError = class(Exception)
|
|
public
|
|
ErrorCode : Integer;
|
|
end;
|
|
|
|
EHeapMemoryError = class(Exception)
|
|
protected
|
|
AllowFree : boolean;
|
|
public
|
|
procedure FreeInstance;override;
|
|
end;
|
|
|
|
EHeapException = EHeapMemoryError;
|
|
|
|
EExternalException = class(EExternal);
|
|
EInvalidPointer = Class(EHeapMemoryError);
|
|
EOutOfMemory = Class(EHeapMemoryError);
|
|
EInvalidCast = Class(Exception);
|
|
EVariantError = Class(Exception)
|
|
ErrCode : longint;
|
|
Constructor CreateCode(Code : Longint);
|
|
end;
|
|
|
|
EAccessViolation = Class(EExternal);
|
|
EBusError = Class(EAccessViolation);
|
|
EPrivilege = class(EExternal);
|
|
EStackOverflow = class(EExternal);
|
|
EControlC = class(EExternal);
|
|
|
|
{ String conversion errors }
|
|
EConvertError = class(Exception);
|
|
EFormatError = class(Exception);
|
|
|
|
{ Other errors }
|
|
EAbort = Class(Exception);
|
|
EAbstractError = Class(Exception);
|
|
EAssertionFailed = Class(Exception);
|
|
EObjectCheck = Class(Exception);
|
|
EThreadError = Class(Exception);
|
|
ESigQuit = Class(Exception);
|
|
|
|
EPropReadOnly = class(Exception);
|
|
EPropWriteOnly = class(Exception);
|
|
|
|
EIntfCastError = class(Exception);
|
|
EInvalidContainer = class(Exception);
|
|
EInvalidInsert = class(Exception);
|
|
|
|
EPackageError = class(Exception);
|
|
ECFError = class(Exception);
|
|
|
|
EOSError = class(Exception)
|
|
public
|
|
ErrorCode: Longint;
|
|
end;
|
|
|
|
ESafecallException = class(Exception);
|
|
ENoThreadSupport = Class(Exception);
|
|
ENoWideStringSupport = Class(Exception);
|
|
ENoDynLibsSupport = class(Exception);
|
|
|
|
EProgrammerNotFound = class(Exception);
|
|
|
|
EMonitor = class(Exception);
|
|
EMonitorLockException = class(EMonitor);
|
|
ENoMonitorSupportException = class(EMonitor);
|
|
|
|
EObjectDisposed = class(Exception);
|
|
|
|
ENotImplemented = class(Exception);
|
|
|
|
EArgumentException = class(Exception);
|
|
EArgumentOutOfRangeException = class(EArgumentException);
|
|
EArgumentNilException = class(EArgumentException);
|
|
|
|
EPathTooLongException = class(Exception);
|
|
ENotSupportedException = class(Exception);
|
|
EDirectoryNotFoundException = class(Exception);
|
|
EFileNotFoundException = class(Exception);
|
|
EPathNotFoundException = class(Exception);
|
|
|
|
EInOutArgumentException = class(EArgumentException)
|
|
public
|
|
Path: string;
|
|
constructor Create(const aMsg, aPath: string); overload;
|
|
constructor CreateRes(ResStringRec: PResStringRec; const aPath: string); overload;
|
|
constructor CreateFmt(const fmt : string; const args : array of const; const aPath : String); overload;
|
|
end;
|
|
|
|
EInvalidOpException = class(Exception);
|
|
|
|
ENoConstructException = class(Exception);
|
|
EListError = Class(Exception);
|
|
|
|
EOperationCancelled = class(Exception);
|
|
|
|
{ Exception handling routines }
|
|
function ExceptObject: TObject;
|
|
function ExceptAddr: CodePointer;
|
|
function ExceptFrameCount: Longint;
|
|
function ExceptFrames: PCodePointer;
|
|
function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
|
|
Buffer: PAnsiChar; Size: Integer): Integer;
|
|
procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
|
|
procedure Abort;
|
|
procedure OutOfMemoryError;
|
|
procedure ListIndexError(aIndex,aMax: Integer; aObj: TObject);
|
|
|
|
Type
|
|
TBeepHandler = Procedure;
|
|
|
|
Var
|
|
OnBeep : TBeephandler = Nil;
|
|
|
|
procedure Beep;
|
|
function SysErrorMessage(ErrorCode: Integer): String;
|
|
|
|
Type
|
|
TCreateGUIDFunc = Function(Out GUID : TGUID) : Integer;
|
|
|
|
Var
|
|
OnCreateGUID : TCreateGUIDFunc = Nil;
|
|
Function CreateGUID(out GUID : TGUID) : Integer;
|
|
|
|
type
|
|
TTerminateProc = Function: Boolean;
|
|
|
|
procedure AddTerminateProc(TermProc: TTerminateProc);
|
|
function CallTerminateProcs: Boolean;
|
|
|
|
{$IFNDEF VER3_0}
|
|
generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;
|
|
generic function Exchange<T>(var target:T; const newvalue:T) :T; inline;
|
|
{$ENDIF}
|
|
|
|
Var
|
|
OnShowException : Procedure (Msg : ShortString);
|
|
|
|
Const
|
|
HexDisplayPrefix : string = '$';
|
|
|
|
const
|
|
// commenting is VP fix. These idents are in a different unit there.
|
|
PathDelim={System.}DirectorySeparator;
|
|
DriveDelim={System.}DriveSeparator;
|
|
PathSep={System.}PathSeparator;
|
|
MAX_PATH={System.}MaxPathLen;
|
|
|
|
Type
|
|
TFileRec=FileRec;
|
|
TTextRec=TextRec;
|
|
|
|
|
|
{ Read PAnsiChar handling functions declaration }
|
|
{$i syspchh.inc}
|
|
|
|
{ MCBS functions }
|
|
{$i sysansih.inc}
|
|
{$i syscodepagesh.inc}
|
|
|
|
{ wide string functions }
|
|
{$i syswideh.inc}
|
|
|
|
{$ifdef FPC_HAS_UNICODESTRING}
|
|
{ unicode string functions }
|
|
{$i sysunih.inc}
|
|
{$i sysencodingh.inc}
|
|
{$endif FPC_HAS_UNICODESTRING}
|
|
|
|
{$macro on}
|
|
{$define PathStr:=UnicodeString}
|
|
{$define PathPChar:=PUnicodeChar}
|
|
{ Read filename handling functions declaration }
|
|
{$i finah.inc}
|
|
{$define PathStr:=RawByteString}
|
|
{$define PathPChar:=PAnsiChar}
|
|
{ Read filename handling functions declaration }
|
|
{$i finah.inc}
|
|
{$undef PathStr}
|
|
{$undef PathPChar}
|
|
|
|
{ Read other file handling function declarations }
|
|
{$i filutilh.inc}
|
|
|
|
{ Read disk function declarations }
|
|
{$i diskh.inc}
|
|
|
|
{ read thread handling }
|
|
{$i systhrdh.inc}
|
|
|
|
{ Type Helpers}
|
|
{$i syshelph.inc}
|
|
|
|
procedure FreeAndNil(var obj);
|
|
procedure FreeMemAndNil(var p);
|
|
|
|
{ interface handling }
|
|
{$i intfh.inc}
|
|
|
|
{$IFDEF FPC_HAS_FEATURE_UNICODESTRINGS}
|
|
{ strange Delphi thing }
|
|
{$i sysmarshalh.inc}
|
|
{$ENDIF}
|
|
|
|
function SafeLoadLibrary(const FileName: AnsiString;
|
|
ErrorMode: DWord = {$ifdef windows}SEM_NOOPENFILEERRORBOX{$else windows}0{$endif windows}): HMODULE;
|
|
|
|
function GetModuleName(Module: HMODULE): string;
|
|
|
|
{ some packages and unit related constants for compatibility }
|
|
|
|
const
|
|
pfExeModule = $00000000;
|
|
pfNeverBuild = $00000001;
|
|
pfDesignOnly = $00000002;
|
|
pfRunOnly = $00000004;
|
|
pfIgnoreDupUnits = $00000008;
|
|
pfPackageModule = $40000000;
|
|
pfModuleTypeMask = $C0000000;
|
|
pfV3Produced = $00000000;
|
|
pfProducerUndefined = $04000000;
|
|
pfBCB4Produced = $08000000;
|
|
pfDelphi4Produced = $0C000000;
|
|
pfLibraryModule = $80000000;
|
|
pfProducerMask = $0C000000;
|
|
|
|
const
|
|
ufMainUnit = $01;
|
|
ufPackageUnit = $02;
|
|
ufWeakUnit = $04;
|
|
ufOrgWeakUnit = $08;
|
|
ufImplicitUnit = $10;
|
|
|
|
ufWeakPackageUnit = ufPackageUnit or ufWeakUnit;
|
|
|
|
Type
|
|
TUTF8StringDynArray = Array of UTF8String;
|
|
|
|
Function ArrayOfConstToStr(Args: array of const ; aSeparator : Char = ','; aQuoteBegin : Char = '"'; aQuoteEnd : Char = '"') : UTF8String;
|
|
Function ArrayOfConstToStrArray(Args: array of const) : TUTF8StringDynArray;
|
|
|
|
{ Delphi compatibility }
|
|
|
|
Type
|
|
|
|
{ TOSVersion }
|
|
|
|
TOSVersion = record
|
|
public type
|
|
TArchitecture = (arIntelX86, arIntelX64, arARM32, arARM64, arIntelX16, arXTensa, arAVR, arM68k, arPowerPC, arPower64,
|
|
arMips, arMipsel, arMips64, arMips64el, arJVM, arWasm32, arSparc, arSparc64, arRiscV32, arRiscV64, arZ80,
|
|
arLoongArch64, arOther);
|
|
|
|
TPlatform = (pfWindows, pfMacOS, pfiOS, pfAndroid, pfWinRT, pfLinux,
|
|
pfGo32v2, pfOS2, pfFreeBSD, pfBeos, pfNetBSD, pfAmiga,
|
|
pfAtari, pfSolaris, pfQNX, pfNetware, pfOpenBSD, pfWDosX,
|
|
pfPalmos, pfMacOSClassic, pfDarwin, pfEMX, pfWatcom,
|
|
pfMorphos, pfNetwLibC, pfWinCE, pfGBA, pfNDS, pfEmbedded,
|
|
pfSymbian, pfHaiku, pfIPhoneSim, pfAIX, pfJava,
|
|
pfNativeNT, pfMSDos, pfWII, pfAROS, pfDragonFly, pfWin16,
|
|
pfFreeRTOS, pfZXSpectrum, pfMSXDOS, pfAmstradCPC,
|
|
pfSinclairQL, pfWasi, pfOther);
|
|
TDelphiPlatform = TPlatform.pfWindows..TPlatform.pfLinux;
|
|
public const
|
|
AllArchitectures = [Low(TArchitecture) .. High(TArchitecture)];
|
|
AllPlatforms = [Low(TPlatform) .. High(TPlatform)];
|
|
private
|
|
class var FFull : string;
|
|
class var FArchitecture: TArchitecture;
|
|
class var FBuild: Integer;
|
|
class var FMajor: Integer;
|
|
class var FMinor: Integer;
|
|
class var FName: string;
|
|
class var FPlatform: TPlatform;
|
|
class var FServicePackMajor: Integer;
|
|
class var FServicePackMinor: Integer;
|
|
{$IFDEF LINUX}
|
|
class var FPrettyName: string;
|
|
class var FLibCVersionMajor: Integer;
|
|
class var FLibCVersionMinor: Integer;
|
|
{$ENDIF LINUX}
|
|
class constructor Create;
|
|
public
|
|
class function Check(AMajor: Integer): Boolean; overload; static; inline;
|
|
class function Check(AMajor, AMinor: Integer): Boolean; overload; static; inline;
|
|
class function Check(AMajor, AMinor, AServicePackMajor: Integer): Boolean; overload; static; inline;
|
|
class function ToString: string; static;
|
|
class property Architecture: TArchitecture read FArchitecture;
|
|
class property Build: Integer read FBuild;
|
|
class property Major: Integer read FMajor;
|
|
class property Minor: Integer read FMinor;
|
|
class property Name: string read FName;
|
|
class property Platform: TPlatform read FPlatform;
|
|
class property ServicePackMajor: Integer read FServicePackMajor;
|
|
class property ServicePackMinor: Integer read FServicePackMinor;
|
|
{$IFDEF LINUX}
|
|
class property PrettyName: string read FPrettyName;
|
|
class property LibCVersionMajor: Integer read FLibCVersionMajor;
|
|
class property LibCVersionMinor: Integer read FLibCVersionMinor;
|
|
{$ENDIF LINUX}
|
|
end;
|
|
|
|
TArchitectures = set of TOSVersion.TArchitecture;
|
|
TPlatforms = set of TOSVersion.TPlatform;
|
|
TDelphiPlatforms = set of TOSVersion.TDelphiPlatform;
|
|
|
|
Function GetCompiledArchitecture : TOSVersion.TArchitecture;
|
|
Function GetCompiledPlatform : TOSVersion.TPlatform;
|
|
|
|
{$IFNDEF HAS_INVALIDHANDLE}
|
|
const
|
|
INVALID_HANDLE_VALUE = DWORD(-1);
|
|
{$ENDIF}
|