systemh.inc 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811
  1. {
  2. This file contains the OS independent declarations of the system unit
  3. This file is part of the Free Pascal Run time library.
  4. Copyright (c) 1999-2005 by the Free Pascal development team
  5. See the File COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {****************************************************************************
  12. Needed switches
  13. ****************************************************************************}
  14. {$I-,Q-,H-,R-,V-}
  15. {$mode objfpc}
  16. { At least 2.0.0 is required }
  17. {$ifdef VER1}
  18. {$fatal You need at least FPC 2.0.0}
  19. {$endif}
  20. { Using inlining for small system functions/wrappers }
  21. {$inline on}
  22. {$ifdef COMPPROCINLINEFIXED}
  23. {$define SYSTEMINLINE}
  24. {$endif COMPPROCINLINEFIXED}
  25. { don't use FPU registervariables on the i386 }
  26. {$ifdef CPUI386}
  27. {$maxfpuregisters 0}
  28. {$endif CPUI386}
  29. { the assembler helpers need this}
  30. {$ifdef CPUPOWERPC}
  31. {$goto+}
  32. {$endif CPUPOWERPC}
  33. { needed for insert,delete,readln }
  34. {$P+}
  35. { stack checking always disabled
  36. for system unit. This is because
  37. the startup code might not
  38. have been called yet when we
  39. get a stack error, this will
  40. cause big crashes
  41. }
  42. {$S-}
  43. {****************************************************************************
  44. Global Types and Constants
  45. ****************************************************************************}
  46. Type
  47. { The compiler has all integer types defined internally. Here
  48. we define only aliases }
  49. DWord = LongWord;
  50. Cardinal = LongWord;
  51. Integer = SmallInt;
  52. {$ifdef CPUI386}
  53. {$define CPU32}
  54. {$define DEFAULT_EXTENDED}
  55. {$define SUPPORT_SINGLE}
  56. {$define SUPPORT_DOUBLE}
  57. {$define SUPPORT_EXTENDED}
  58. {$define SUPPORT_COMP}
  59. ValReal = Extended;
  60. {$endif CPUI386}
  61. {$ifdef CPUX86_64}
  62. {$ifndef WIN64}
  63. { win64 doesn't support the legacy fpu }
  64. {$define DEFAULT_EXTENDED}
  65. {$define SUPPORT_EXTENDED}
  66. {$define SUPPORT_COMP}
  67. ValReal = Extended;
  68. {$else WIN64}
  69. {$define DEFAULT_DOUBLE}
  70. ValReal = Double;
  71. { map comp to int64, but this doesn't mean we compile the comp support in! }
  72. Comp = Int64;
  73. PComp = ^Comp;
  74. {$endif WIN64}
  75. {$define SUPPORT_SINGLE}
  76. {$define SUPPORT_DOUBLE}
  77. {$endif CPUX86_64}
  78. {$ifdef CPUM68K}
  79. ValReal = Real;
  80. {$define SUPPORT_SINGLE}
  81. {$IFDEF Unix}
  82. { Linux FPU emulator will be used }
  83. {$define SUPPORT_DOUBLE}
  84. {$ENDIF}
  85. {$IFOPT E-}
  86. { If not compiling with emulation }
  87. { then support double type. }
  88. {$define SUPPORT_DOUBLE}
  89. {$ENDIF}
  90. { Comp type does not exist on fpu }
  91. Comp = int64;
  92. PComp = ^Comp;
  93. FarPointer = Pointer;
  94. {$endif CPUM68K}
  95. {$ifdef CPUPOWERPC}
  96. {$define DEFAULT_DOUBLE}
  97. {$define SUPPORT_SINGLE}
  98. {$define SUPPORT_DOUBLE}
  99. {$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
  100. ValReal = Double;
  101. { map comp to int64, but this doesn't mean we compile the comp support in! }
  102. Comp = Int64;
  103. PComp = ^Comp;
  104. FarPointer = Pointer;
  105. {$endif CPUPOWERPC}
  106. {$ifdef CPUSPARC}
  107. {$define DEFAULT_DOUBLE}
  108. {$define SUPPORT_SINGLE}
  109. {$define SUPPORT_DOUBLE}
  110. {$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
  111. ValReal = Double;
  112. { map comp to int64, but this doesn't mean we compile the comp support in! }
  113. Comp = Int64;
  114. PComp = ^Comp;
  115. FarPointer = Pointer;
  116. {$endif CPUSPARC}
  117. {$ifdef CPUARM}
  118. {$define DEFAULT_DOUBLE}
  119. {$define SUPPORT_SINGLE}
  120. {$define SUPPORT_DOUBLE}
  121. {$define FPC_INCLUDE_SOFTWARE_MOD_DIV}
  122. {$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
  123. {$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
  124. ValReal = Real;
  125. { map comp to int64, but this doesn't mean we compile the comp support in! }
  126. Comp = Int64;
  127. PComp = ^Comp;
  128. FarPointer = Pointer;
  129. {$endif CPUARM}
  130. {$ifdef CPU64}
  131. SizeInt = Int64;
  132. SizeUInt = QWord;
  133. PtrInt = Int64;
  134. PtrUInt = QWord;
  135. ValSInt = int64;
  136. ValUInt = qword;
  137. {$endif CPU64}
  138. {$ifdef CPU32}
  139. SizeInt = Longint;
  140. SizeUInt = DWord;
  141. PtrInt = Longint;
  142. PtrUInt = DWord;
  143. ValSInt = Longint;
  144. ValUInt = Cardinal;
  145. {$endif CPU32}
  146. { Zero - terminated strings }
  147. PChar = ^Char;
  148. PPChar = ^PChar;
  149. { AnsiChar is equivalent of Char, so we need
  150. to use type renamings }
  151. TAnsiChar = Char;
  152. AnsiChar = Char;
  153. PAnsiChar = PChar;
  154. PPAnsiChar = PPChar;
  155. UCS4Char = type LongWord;
  156. PUCS4Char = ^UCS4Char;
  157. TUCS4CharArray = array[0..$effffff] of UCS4Char;
  158. PUCS4CharArray = ^TUCS4CharArray;
  159. UCS4String = array of UCS4Char;
  160. UTF8String = type ansistring;
  161. PUTF8String = ^UTF8String;
  162. HRESULT = type Longint;
  163. TDateTime = type Double;
  164. TError = type Longint;
  165. PSingle = ^Single;
  166. PDouble = ^Double;
  167. PCurrency = ^Currency;
  168. {$ifdef SUPPORT_COMP}
  169. PComp = ^Comp;
  170. {$endif SUPPORT_COMP}
  171. PExtended = ^Extended;
  172. PSmallInt = ^Smallint;
  173. PShortInt = ^Shortint;
  174. PInteger = ^Integer;
  175. PByte = ^Byte;
  176. PWord = ^word;
  177. PDWord = ^DWord;
  178. PLongWord = ^LongWord;
  179. PLongint = ^Longint;
  180. PCardinal = ^Cardinal;
  181. PQWord = ^QWord;
  182. PInt64 = ^Int64;
  183. PPtrInt = ^PtrInt;
  184. PSizeInt = ^SizeInt;
  185. PPointer = ^Pointer;
  186. PPPointer = ^PPointer;
  187. PBoolean = ^Boolean;
  188. PWordBool = ^WordBool;
  189. PLongBool = ^LongBool;
  190. PShortString = ^ShortString;
  191. PAnsiString = ^AnsiString;
  192. PDate = ^TDateTime;
  193. PError = ^TError;
  194. PVariant = ^Variant;
  195. POleVariant = ^OleVariant;
  196. PWideChar = ^WideChar;
  197. PPWideChar = ^PWideChar;
  198. WChar = Widechar;
  199. UCS2Char = WideChar;
  200. PUCS2Char = PWideChar;
  201. PWideString = ^WideString;
  202. { Needed for fpc_get_output }
  203. PText = ^Text;
  204. TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);
  205. { procedure type }
  206. TProcedure = Procedure;
  207. { platform dependent types }
  208. {$i sysosh.inc}
  209. const
  210. { Maximum value of the biggest signed and unsigned integer type available}
  211. MaxSIntValue = High(ValSInt);
  212. MaxUIntValue = High(ValUInt);
  213. { max. values for longint and int}
  214. maxLongint = $7fffffff;
  215. maxSmallint = 32767;
  216. maxint = maxsmallint;
  217. type
  218. IntegerArray = array[0..$effffff] of Integer;
  219. PIntegerArray = ^IntegerArray;
  220. PointerArray = array [0..512*1024*1024 - 2] of Pointer;
  221. PPointerArray = ^PointerArray;
  222. TBoundArray = array of SizeInt;
  223. TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
  224. PPCharArray = ^TPCharArray;
  225. const
  226. {$ifdef cpui386}
  227. { Always i386 or newer }
  228. Test8086 : byte = 2;
  229. { Always 387 or newer. Emulated if needed. }
  230. Test8087 : byte = 3;
  231. { will be detected at startup }
  232. has_sse_support : boolean = false;
  233. has_mmx_support : boolean = false;
  234. {$endif cpui386}
  235. {$ifdef cpum68k}
  236. Test68000 : byte = 0; { Must be determined at startup for both }
  237. Test68881 : byte = 0;
  238. {$endif cpum68k}
  239. { max level in dumping on error }
  240. Max_Frame_Dump : Word = 8;
  241. { Exit Procedure handling consts and types }
  242. ExitProc : pointer = nil;
  243. Erroraddr: pointer = nil;
  244. Errorcode: Word = 0;
  245. { file input modes }
  246. fmClosed = $D7B0;
  247. fmInput = $D7B1;
  248. fmOutput = $D7B2;
  249. fmInOut = $D7B3;
  250. fmAppend = $D7B4;
  251. Filemode : byte = 2;
  252. CmdLine : PChar = nil;
  253. (* Value should be changed during system initialization as appropriate. *)
  254. { assume that this program will not spawn other threads, when the
  255. first thread is started the following constants need to be filled }
  256. IsMultiThread : boolean = FALSE;
  257. { set to true, if a threading helper is used before a thread
  258. manager has been installed }
  259. ThreadingAlreadyUsed : boolean = FALSE;
  260. { Indicates if there was an error }
  261. StackError : boolean = FALSE;
  262. InitProc : Pointer = nil;
  263. var
  264. ExitCode : Word; public name 'operatingsystem_result';
  265. RandSeed : Cardinal;
  266. { Delphi compatibility }
  267. IsLibrary : boolean;
  268. IsConsole : boolean;
  269. { Threading support }
  270. fpc_threadvar_relocate_proc : pointer; public name 'FPC_THREADVAR_RELOCATE';
  271. ThreadVar
  272. ThreadID : TThreadID;
  273. { Standard In- and Output }
  274. ErrOutput,
  275. Output,
  276. Input,
  277. StdOut,
  278. StdErr : Text;
  279. InOutRes : Word;
  280. { Stack checking }
  281. StackTop,
  282. StackBottom : Pointer;
  283. StackLength : SizeUInt;
  284. { Numbers for routines that have compiler magic }
  285. {$I innr.inc}
  286. {****************************************************************************
  287. Processor specific routines
  288. ****************************************************************************}
  289. {$ifdef FPC_USE_LIBC}
  290. {$ifdef SYSTEMINLINE}
  291. {$define INLINEGENERICS}
  292. {$endif}
  293. {$endif}
  294. {$ifdef INTERNALMOVEFILLCHAR}
  295. Procedure SysMoveForward(const source;var dest;count:SizeInt);
  296. Procedure SysMoveBackward(const source;var dest;count:SizeInt);
  297. Procedure SysFillChar(var x;count:SizeInt;Value:Byte);
  298. procedure FillByte(var x;count:SizeInt;value:byte);[INTERNPROC: fpc_in_fillchar_x];
  299. {$else INTERNALMOVEFILLCHAR}
  300. Procedure Move(const source;var dest;count:SizeInt);{$ifdef INLINEGENERICS}inline;{$endif}
  301. Procedure FillChar(var x;count:SizeInt;Value:Boolean);{$ifdef SYSTEMINLINE}inline;{$endif}
  302. Procedure FillChar(var x;count:SizeInt;Value:Char);{$ifdef SYSTEMINLINE}inline;{$endif}
  303. Procedure FillChar(var x;count:SizeInt;Value:Byte);{$ifdef INLINEGENERICS}inline;{$endif}
  304. procedure FillByte(var x;count:SizeInt;value:byte);{$ifdef INLINEGENERICS}inline;{$endif}
  305. {$endif INTERNALMOVEFILLCHAR}
  306. Procedure FillWord(var x;count:SizeInt;Value:Word);
  307. procedure FillDWord(var x;count:SizeInt;value:DWord);
  308. function IndexChar(const buf;len:SizeInt;b:char):SizeInt;
  309. function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
  310. function Indexword(const buf;len:SizeInt;b:word):SizeInt;
  311. function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt;
  312. function CompareChar(const buf1,buf2;len:SizeInt):SizeInt;
  313. function CompareByte(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
  314. function CompareWord(const buf1,buf2;len:SizeInt):SizeInt;
  315. function CompareDWord(const buf1,buf2;len:SizeInt):SizeInt;
  316. procedure MoveChar0(const buf1;var buf2;len:SizeInt);
  317. function IndexChar0(const buf;len:SizeInt;b:char):SizeInt;
  318. function CompareChar0(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
  319. procedure prefetch(const mem);[internproc:fpc_in_prefetch_var];
  320. {$ifdef INTERNALMOVEFILLCHAR}
  321. var
  322. fpc_moveforward_proc : pointer = @SysMoveForward public name 'FPC_MOVEFORWARD_PROC';
  323. fpc_movebackward_proc : pointer = @SysMoveBackward public name 'FPC_MOVEBACKWARD_PROC';
  324. fpc_fillchar_proc : pointer = @SysFillChar public name 'FPC_FILLCHAR_PROC';
  325. {$endif INTERNALMOVEFILLCHAR}
  326. {****************************************************************************
  327. Math Routines
  328. ****************************************************************************}
  329. Function lo(B: Byte):Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  330. Function hi(b : Byte) : Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  331. Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
  332. Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
  333. Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];
  334. Function lo(l : DWord) : Word; [INTERNPROC: fpc_in_lo_long];
  335. Function lo(i : Int64) : DWord; [INTERNPROC: fpc_in_lo_qword];
  336. Function lo(q : QWord) : DWord; [INTERNPROC: fpc_in_lo_qword];
  337. Function hi(i : Integer) : byte; [INTERNPROC: fpc_in_hi_Word];
  338. Function hi(w : Word) : byte; [INTERNPROC: fpc_in_hi_Word];
  339. Function hi(l : Longint) : Word; [INTERNPROC: fpc_in_hi_long];
  340. Function hi(l : DWord) : Word; [INTERNPROC: fpc_in_hi_long];
  341. Function hi(i : Int64) : DWord; [INTERNPROC: fpc_in_hi_qword];
  342. Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
  343. Function swap (X : Word) : Word;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_word];
  344. Function Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_word];
  345. Function swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_long];
  346. Function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_long];
  347. Function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_qword];
  348. Function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_qword];
  349. Function Align (Addr : PtrUInt; Alignment : PtrUInt) : PtrUInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  350. Function Align (Addr : Pointer; Alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
  351. Function Random(l:longint):longint;
  352. Function Random(l:int64):int64;
  353. Function Random: extended;
  354. Procedure Randomize;
  355. Function abs(l:Longint):Longint;[internconst:fpc_in_const_abs];{$ifdef SYSTEMINLINE}inline;{$endif}
  356. Function abs(l:Int64):Int64;[internconst:fpc_in_const_abs];{$ifdef SYSTEMINLINE}inline;{$endif}
  357. Function sqr(l:Longint):Longint;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
  358. Function sqr(l:Int64):Int64;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
  359. Function sqr(l:QWord):QWord;[internconst:fpc_in_const_sqr];{$ifdef SYSTEMINLINE}inline;{$endif}
  360. Function odd(l:Longint):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif}
  361. Function odd(l:Longword):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif}
  362. Function odd(l:Int64):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif}
  363. Function odd(l:QWord):Boolean;[internconst:fpc_in_const_odd];{$ifdef SYSTEMINLINE}inline;{$endif}
  364. function SwapEndian(const AValue: SmallInt): SmallInt;
  365. function SwapEndian(const AValue: Word): Word;
  366. function SwapEndian(const AValue: LongInt): LongInt;
  367. function SwapEndian(const AValue: DWord): DWord;
  368. function SwapEndian(const AValue: Int64): Int64;
  369. function SwapEndian(const AValue: QWord): QWord;
  370. function BEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  371. function BEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  372. function BEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  373. function BEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  374. function BEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  375. function BEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  376. function LEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  377. function LEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  378. function LEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  379. function LEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  380. function LEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  381. function LEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  382. function NtoBE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  383. function NtoBE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  384. function NtoBE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  385. function NtoBE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  386. function NtoBE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  387. function NtoBE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  388. function NtoLE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  389. function NtoLE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  390. function NtoLE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  391. function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  392. function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  393. function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  394. { float math routines }
  395. {$I mathh.inc}
  396. {****************************************************************************
  397. Addr/Pointer Handling
  398. ****************************************************************************}
  399. Function ptr(sel,off:Longint):farpointer;[internconst:fpc_in_const_ptr];{$ifdef SYSTEMINLINE}inline;{$endif}
  400. Function Cseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  401. Function Dseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  402. Function Sseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  403. {****************************************************************************
  404. PChar and String Handling
  405. ****************************************************************************}
  406. function strpas(p:pchar):shortstring;external name 'FPC_PCHAR_TO_SHORTSTR';
  407. function strlen(p:pchar):longint;external name 'FPC_PCHAR_LENGTH';
  408. { Shortstring functions }
  409. Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
  410. Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);
  411. Procedure Insert(source:Char;var s:shortstring;index:SizeInt);
  412. Function Pos(const substr:shortstring;const s:shortstring):SizeInt;
  413. Function Pos(C:Char;const s:shortstring):SizeInt;
  414. Function Pos (const Substr : ShortString; const Source : AnsiString) : SizeInt;
  415. Procedure SetString (out S : Shortstring; Buf : PChar; Len : SizeInt);
  416. Procedure SetString (out S : AnsiString; Buf : PChar; Len : SizeInt);
  417. Function upCase(const s:shortstring):shortstring;
  418. Function lowerCase(const s:shortstring):shortstring; overload;
  419. Function Space(b:byte):shortstring;
  420. Function hexStr(Val:Longint;cnt:byte):shortstring;
  421. Function OctStr(Val:Longint;cnt:byte):shortstring;
  422. Function binStr(Val:Longint;cnt:byte):shortstring;
  423. Function hexStr(Val:int64;cnt:byte):shortstring;
  424. Function OctStr(Val:int64;cnt:byte):shortstring;
  425. Function binStr(Val:int64;cnt:byte):shortstring;
  426. Function hexStr(Val:Pointer):shortstring;
  427. { Char functions }
  428. Function chr(b : byte) : Char; [INTERNPROC: fpc_in_chr_byte];
  429. Function upCase(c:Char):Char;
  430. Function lowerCase(c:Char):Char; overload;
  431. function pos(const substr : shortstring;c:char): SizeInt;
  432. {****************************************************************************
  433. AnsiString Handling
  434. ****************************************************************************}
  435. Procedure UniqueString(var S : AnsiString);external name 'FPC_ANSISTR_UNIQUE';
  436. Function Pos (const Substr : AnsiString; const Source : AnsiString) : SizeInt;
  437. Function Pos (c : Char; const s : AnsiString) : SizeInt;
  438. Procedure Insert (const Source : AnsiString; var S : AnsiString; Index : SizeInt);
  439. Procedure Delete (var S : AnsiString; Index,Size: SizeInt);
  440. Function StringOfChar(c : char;l : SizeInt) : AnsiString;
  441. function upcase(const s : ansistring) : ansistring;
  442. function lowercase(const s : ansistring) : ansistring;
  443. {****************************************************************************
  444. WideString Handling
  445. ****************************************************************************}
  446. {$i wstringh.inc}
  447. {****************************************************************************
  448. Untyped File Management
  449. ****************************************************************************}
  450. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;const Name:string);
  451. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;p:pchar);
  452. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;c:char);
  453. Procedure Rewrite(var f:File;l:Longint);
  454. Procedure Rewrite(var f:File);
  455. Procedure Reset(var f:File;l:Longint);
  456. Procedure Reset(var f:File);
  457. Procedure Close(var f:File);
  458. Procedure BlockWrite(var f:File;const Buf;Count:Int64;var Result:Int64);
  459. Procedure BlockWrite(var f:File;const Buf;Count:Longint;var Result:Longint);
  460. Procedure BlockWrite(var f:File;const Buf;Count:Cardinal;var Result:Cardinal);
  461. Procedure BlockWrite(var f:File;const Buf;Count:Word;var Result:Word);
  462. Procedure BlockWrite(var f:File;const Buf;Count:Word;var Result:Integer);
  463. Procedure BlockWrite(var f:File;const Buf;Count:Longint);
  464. Procedure BlockRead(var f:File;var Buf;count:Int64;var Result:Int64);
  465. Procedure BlockRead(var f:File;var Buf;count:Longint;var Result:Longint);
  466. Procedure BlockRead(var f:File;var Buf;count:Cardinal;var Result:Cardinal);
  467. Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);
  468. Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);
  469. Procedure BlockRead(var f:File;var Buf;count:Int64);
  470. Function FilePos(var f:File):Int64;
  471. Function FileSize(var f:File):Int64;
  472. Procedure Seek(var f:File;Pos:Int64);
  473. Function EOF(var f:File):Boolean;
  474. Procedure Erase(var f:File);
  475. Procedure Rename(var f:File;const s:string);
  476. Procedure Rename(var f:File;p:pchar);
  477. Procedure Rename(var f:File;c:char);
  478. Procedure Truncate (var F:File);
  479. {****************************************************************************
  480. Typed File Management
  481. ****************************************************************************}
  482. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;const Name:string);
  483. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;p:pchar);
  484. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;c:char);
  485. Procedure Reset(var f : TypedFile); [INTERNPROC: fpc_in_Reset_TypedFile];
  486. Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
  487. {****************************************************************************
  488. Text File Management
  489. ****************************************************************************}
  490. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;const s:string);
  491. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;p:pchar);
  492. Procedure Assign({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;c:char);
  493. Procedure Close(var t:Text);
  494. Procedure Rewrite(var t:Text);
  495. Procedure Reset(var t:Text);
  496. Procedure Append(var t:Text);
  497. Procedure Flush(var t:Text);
  498. Procedure Erase(var t:Text);
  499. Procedure Rename(var t:Text;const s:string);
  500. Procedure Rename(var t:Text;p:pchar);
  501. Procedure Rename(var t:Text;c:char);
  502. Function EOF(var t:Text):Boolean;
  503. Function EOF:Boolean;
  504. Function EOLn(var t:Text):Boolean;
  505. Function EOLn:Boolean;
  506. Function SeekEOLn (var t:Text):Boolean;
  507. Function SeekEOF (var t:Text):Boolean;
  508. Function SeekEOLn:Boolean;
  509. Function SeekEOF:Boolean;
  510. Procedure SetTextBuf(var f:Text; var Buf);[INTERNPROC:fpc_in_settextbuf_file_x];
  511. Procedure SetTextBuf(var f:Text; var Buf; Size:SizeInt);
  512. Procedure SetTextLineEnding(var f:Text; Ending:string);
  513. {****************************************************************************
  514. Directory Management
  515. ****************************************************************************}
  516. Procedure chdir(const s:string);
  517. Procedure mkdir(const s:string);
  518. Procedure rmdir(const s:string);
  519. Procedure getdir(drivenr:byte;var dir:shortstring);
  520. Procedure getdir(drivenr:byte;var dir:ansistring);
  521. {*****************************************************************************
  522. Miscellaneous
  523. *****************************************************************************}
  524. { os independent calls to allow backtraces }
  525. {$IFDEF INTERNAL_BACKTRACE}
  526. function get_frame:pointer;[INTERNPROC:fpc_in_get_frame];
  527. function get_caller_addr(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_addr];
  528. function get_caller_frame(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_frame];
  529. {$ELSE}
  530. function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
  531. function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
  532. function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
  533. {$ENDIF}
  534. Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  535. Function Sptr:Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_ptr];
  536. Function GetProcessID:SizeUInt;
  537. Function GetThreadID:TThreadID;{$ifdef SYSTEMINLINE}inline;{$endif}
  538. function InterLockedIncrement (var Target: longint) : longint; public name 'FPC_INTERLOCKEDINCREMENT';
  539. function InterLockedDecrement (var Target: longint) : longint; public name 'FPC_INTERLOCKEDDECREMENT';
  540. function InterLockedExchange (var Target: longint;Source : longint) : longint; public name 'FPC_INTERLOCKEDEXCHANGE';
  541. function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; public name 'FPC_INTERLOCKEDEXCHANGEADD';
  542. function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; public name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
  543. {$ifdef cpu64}
  544. function InterLockedIncrement64 (var Target: int64) : int64; public name 'FPC_INTERLOCKEDINCREMENT64';
  545. function InterLockedDecrement64 (var Target: int64) : int64; public name 'FPC_INTERLOCKEDDECREMENT64';
  546. function InterLockedExchange64 (var Target: int64;Source : int64) : int64; public name 'FPC_INTERLOCKEDEXCHANGE64';
  547. function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64; public name 'FPC_INTERLOCKEDEXCHANGEADD64';
  548. function InterlockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64; public name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
  549. {$endif cpu64}
  550. { Pointer overloads }
  551. {$ifdef cpu64}
  552. function InterLockedIncrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDINCREMENT64';
  553. function InterLockedDecrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDDECREMENT64';
  554. function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGE64';
  555. function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD64';
  556. function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
  557. {$else cpu64}
  558. function InterLockedIncrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDINCREMENT';
  559. function InterLockedDecrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDDECREMENT';
  560. function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGE';
  561. function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD';
  562. function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
  563. {$endif cpu64}
  564. {*****************************************************************************
  565. Init / Exit / ExitProc
  566. *****************************************************************************}
  567. type
  568. TRuntimeError =
  569. (reNone, reOutOfMemory, reInvalidPtr, reDivByZero, reRangeError,
  570. reIntOverflow, reInvalidOp, reZeroDivide, reOverflow, reUnderflow,
  571. reInvalidCast, reAccessViolation, rePrivInstruction, reControlBreak,
  572. reStackOverflow, reVarTypeCast, reVarInvalidOp, reVarDispatch,
  573. reVarArrayCreate, reVarNotArray, reVarArrayBounds, reAssertionFailed,
  574. reExternalException, reIntfCastError, reSafeCallError, reQuit,
  575. reCodesetConversion);
  576. Const
  577. // Please keep locations corresponding to location in array above
  578. RuntimeErrorExitCodes : Array[TRuntimeError] of Byte = (
  579. 0 , 203, 204, 200, 201,
  580. 215, 207, 200, 205, 206,
  581. 219, 216, 218, 217,
  582. 202, 220, 221, 222,
  583. 223, 224, 225, 227,
  584. 0 , 228, 229, 233,
  585. 234);
  586. Procedure Error(RunTimeError : TRunTimeError);
  587. Function Paramcount:Longint;
  588. Function ParamStr(l:Longint):string;
  589. Procedure Dump_Stack(var f : text;bp:pointer);
  590. Procedure RunError(w:Word);
  591. Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
  592. Procedure halt(errnum:byte);
  593. Procedure AddExitProc(Proc:TProcedure);
  594. Procedure halt;{$ifdef SYSTEMINLINE}inline;{$endif}
  595. { Need to be exported for threads unit }
  596. Procedure SysInitExceptions;
  597. procedure SysInitStdIO;
  598. Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
  599. {*****************************************************************************
  600. Abstract/Assert/Error Handling
  601. *****************************************************************************}
  602. function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
  603. Function StringToPPChar(var S:AnsiString;ReserveEntries:integer):ppchar;
  604. Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
  605. procedure AbstractError;external name 'FPC_ABSTRACTERROR';
  606. Function SysBackTraceStr(Addr:Pointer): ShortString;
  607. Procedure SysAssert(const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
  608. { Error handlers }
  609. Type
  610. TBackTraceStrFunc = Function (Addr: Pointer): ShortString;
  611. TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
  612. TAbstractErrorProc = Procedure;
  613. TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
  614. TSafeCallErrorProc = Procedure(error : HResult;addr : pointer);
  615. const
  616. BackTraceStrFunc : TBackTraceStrFunc = @SysBackTraceStr;
  617. ErrorProc : TErrorProc = nil;
  618. AbstractErrorProc : TAbstractErrorProc = nil;
  619. AssertErrorProc : TAssertErrorProc = @SysAssert;
  620. SafeCallErrorProc : TSafeCallErrorProc = nil;
  621. {*****************************************************************************
  622. SetJmp/LongJmp
  623. *****************************************************************************}
  624. {$i setjumph.inc}
  625. {*****************************************************************************
  626. Object Pascal support
  627. *****************************************************************************}
  628. {$i objpash.inc}
  629. {*****************************************************************************
  630. Variant support
  631. *****************************************************************************}
  632. {$i varianth.inc}
  633. {*****************************************************************************
  634. Internal helper routines support
  635. *****************************************************************************}
  636. {$i dynarrh.inc}
  637. {$i compproc.inc}
  638. {*****************************************************************************
  639. Heap
  640. *****************************************************************************}
  641. {$i heaph.inc}
  642. {*****************************************************************************
  643. Thread support
  644. *****************************************************************************}
  645. { Generic threadmanager }
  646. {$i threadh.inc}
  647. {*****************************************************************************
  648. Resources support
  649. *****************************************************************************}
  650. {$i resh.inc}
  651. {*****************************************************************************
  652. FPDoc phony declarations.
  653. *****************************************************************************}
  654. {$ifdef fpdocsystem}
  655. {$i system.fpd}
  656. {$endif}