paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-27 08:13:42 +02:00
Code Issues Packages Projects Releases Wiki Activity
aaef13ac01
fpc/rtl/inc/systemh.inc
florian aaef13ac01 + fpuint64 to system unit interface added: if it is true, the rtl 
uses the fpu to do int64 operations, if possible
1999-06-30 22:17:22 +00:00

659 lines
22 KiB
PHP
Raw Blame History

{
$Id$
This file is part of the Free Pascal Run time library.
Copyright (c) 1993,97 by the Free Pascal development team
This File contains the OS independent declarations of the system unit
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.
**********************************************************************}
{
Supported conditionnals:
------------------------
RTLLITE Create a somewhat smaller RTL
}
{****************************************************************************
Needed switches
****************************************************************************}
{$I-,Q-,H-,R-,V-}
{$mode objfpc}
{ needed for insert,delete,readln }
{$P+}
{ Stack check gives a note under linux }
{$ifndef linux}
{$S-}
{$endif}
{****************************************************************************
Global Types and Constants
****************************************************************************}
Type
Longint = $80000000..$7fffffff; { $8000000 creates a longint overfow !! }
Integer = -32768..32767;
shortint = -128..127;
byte = 0..255;
Word = 0..65535;
{ at least declare Turbo Pascal real types }
{$ifdef i386}
StrLenInt = LongInt;
{$ifndef INTERNDOUBLE}
Double = real;
{$endif}
{$define DEFAULT_EXTENDED}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define SUPPORT_EXTENDED}
{$define SUPPORT_COMP}
{ define SUPPORT_FIXED}
ValSInt = Longint;
ValUInt = Cardinal;
ValReal = Extended;
{$endif}
{$ifdef m68k}
StrLenInt = Longint;
ValSInt = Longint;
ValUInt = Cardinal;
ValReal = Real;
{$define SUPPORT_SINGLE}
{$endif}
{ some type aliases }
dword = cardinal;
longword = cardinal;
{ Zero - terminated strings }
PChar = ^Char;
PPChar = ^PChar;
{ procedure type }
TProcedure = Procedure;
const
{$IfDef ValInternCompiled}
{ Maximum value of the biggest signed and unsigned integer type available}
MaxSIntValue = High(ValSInt);
MaxUIntValue = High(ValUInt);
{$EndIf ValInternCompiled}
{ max. values for longint and int}
maxLongint = $7fffffff;
maxint = 32767;
{ Compatibility With TP }
{$ifdef i386}
Test8086 : byte = 2; { Always i386 or newer }
Test8087 : byte = 3; { Always 387 or newer. Emulated if needed. }
FPUInt64 : boolean = true; { set this to false if you don't want that }
{ the fpu does int64*int64 and }
{ int64 div int64, if the * is overflow }
{ checked, it is done in software }
{$endif i386}
{$ifdef m68k}
Test68000 : byte = 0; { Must be determined at startup for both }
Test68881 : byte = 0;
{$endif}
{ max level in dumping on error }
Max_Frame_Dump : Word = 8;
{ Exit Procedure handling consts and types }
ExitProc : pointer = nil;
Erroraddr: pointer = nil;
Errorcode: Word = 0;
{ file input modes }
fmClosed = $D7B0;
fmInput = $D7B1;
fmOutput = $D7B2;
fmInOut = $D7B3;
fmAppend = $D7B4;
Filemode : byte = 2;
CmdLine : PChar = nil;
Type
TErrorProc = Procedure (ErrNo : Longint; Address : Pointer);
var
{ Standard In- and Output }
Output,
Input,
StdOut,
StdErr : Text;
ExitCode,
InOutRes : Word;
StackBottom,
LowestStack,
RandSeed : Cardinal;
{ Error handlers }
ErrorProc : Pointer;
{****************************************************************************
Processor specific routines
****************************************************************************}
Procedure Move(Var source,dest;count:Longint);
Procedure FillChar(Var x;count:Longint;Value:Boolean);
Procedure FillChar(Var x;count:Longint;Value:Char);
Procedure FillChar(Var x;count:Longint;Value:Byte);
{$ifndef RTLLITE}
Procedure FillWord(Var x;count:Longint;Value:Word);
{$endif RTLLITE}
{****************************************************************************
Math Routines
****************************************************************************}
{$ifndef RTLLITE}
Function lo(w:Word):byte;
Function lo(l:Longint):Word;
Function lo(l:DWord):Word;
Function lo(i:Integer):byte;
Function lo(B: Byte):Byte;
Function hi(w:Word):byte;
Function hi(i:Integer):byte;
Function hi(l:Longint):Word;
Function hi(b : Byte) : Byte;
Function hi(l: DWord): Word;
Function Swap (X:Word):Word;
Function Swap (X:Integer):Integer;
Function Swap (X:Cardinal):Cardinal;
Function Swap (X:Longint):Longint;
{$endif RTLLITE}
Function Random(l:Longint):Longint;
Function Random:real;
Procedure Randomize;
Function abs(l:Longint):Longint;
Function sqr(l:Longint):Longint;
Function odd(l:Longint):Boolean;
{ float math routines }
{$I mathh.inc}
{****************************************************************************
Addr/Pointer Handling
****************************************************************************}
{$ifndef RTLLITE}
Function ptr(sel,off:Longint):pointer;
{$ifndef INTERNALADDR}
Function Addr(var x):pointer;
{$endif}
Function Cseg:Word;
Function Dseg:Word;
Function Sseg:Word;
{$endif RTLLITE}
{****************************************************************************
PChar and String Handling
****************************************************************************}
function strpas(p:pchar):shortstring;
function strlen(p:pchar):longint;
{ Shortstring functions }
Function Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
Procedure Insert(source:Char;Var s:shortstring;index:StrLenInt);
Function Pos(const substr:shortstring;const s:shortstring):StrLenInt;
Function Pos(C:Char;const s:shortstring):StrLenInt;
Procedure SetLength(var s:shortstring;len:StrLenInt);
Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
Function Length(s:string):byte;
{ Char functions to overcome overloading problem with ansistrings }
function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
function pos(const substr : shortstring;c:char): StrLenInt;
function length(c:char):byte;
Function Chr(b:byte):Char;
Function upCase(const s:shortstring):shortstring;
Function upCase(c:Char):Char;
{$ifndef RTLLITE}
Function lowerCase(c:Char):Char;
Function lowerCase(const s:shortstring):shortstring;
Function hexStr(Val:Longint;cnt:byte):shortstring;
Function binStr(Val:Longint;cnt:byte):shortstring;
{$endif RTLLITE}
Function Space(b:byte):shortstring;
{$IfNDef ValInternCompiled}
Procedure Val(const s:shortstring;Var l:Longint;Var code:Word);
Procedure Val(const s:shortstring;Var l:Longint;Var code:Integer);
Procedure Val(const s:shortstring;Var l:Longint;Var code:Longint);
Procedure Val(const s:shortstring;Var l:Longint);
Procedure Val(const s:shortstring;Var b:byte;Var code:Word);
Procedure Val(const s:shortstring;Var b:byte;Var code:Integer);
Procedure Val(const s:shortstring;Var b:byte;Var code:Longint);
Procedure Val(const s:shortstring;Var b:byte);
Procedure Val(const s:shortstring;Var b:shortint;Var code:Word);
Procedure Val(const s:shortstring;Var b:shortint;Var code:Integer);
Procedure Val(const s:shortstring;Var b:shortint;Var code:Longint);
Procedure Val(const s:shortstring;Var b:shortint);
Procedure Val(const s:shortstring;Var b:Word;Var code:Word);
Procedure Val(const s:shortstring;Var b:Word;Var code:Integer);
Procedure Val(const s:shortstring;Var b:Word;Var code:Longint);
Procedure Val(const s:shortstring;Var b:Word);
Procedure Val(const s:shortstring;Var b:Integer;Var code:Word);
Procedure Val(const s:shortstring;Var b:Integer;Var code:Integer);
Procedure Val(const s:shortstring;Var b:Integer;Var code:Longint);
Procedure Val(const s:shortstring;Var b:Integer);
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Word);
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Integer);
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Longint);
Procedure Val(const s:shortstring;Var v:cardinal);
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Word);
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Integer);
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Longint);
Procedure Val(const s:shortstring;Var d:ValReal);
{$ifdef SUPPORT_SINGLE}
Procedure Val(const s:shortstring;Var d:single;Var code:Word);
Procedure Val(const s:shortstring;Var d:single;Var code:Integer);
Procedure Val(const s:shortstring;Var d:single;Var code:Longint);
Procedure Val(const s:shortstring;Var d:single);
{$endif SUPPORT_SINGLE}
{$ifdef SUPPORT_COMP}
Procedure Val(const s:shortstring;Var d:comp;Var code:Word);
Procedure Val(const s:shortstring;Var d:comp;Var code:Integer);
Procedure Val(const s:shortstring;Var d:comp;Var code:Longint);
Procedure Val(const s:shortstring;Var d:comp);
{$endif SUPPORT_COMP}
{$ifdef SUPPORT_FIXED}
Procedure Val(const s:shortstring;Var d:fixed;Var code:Word);
Procedure Val(const s:shortstring;Var d:fixed;Var code:Integer);
Procedure Val(const s:shortstring;Var d:fixed;Var code:Longint);
Procedure Val(const s:shortstring;Var d:fixed);
{$endif SUPPORT_FIXED}
{$ifdef DEFAULT_EXTENDED}
Procedure Val(const s:shortstring;Var d:Real;Var code:Word);
Procedure Val(const s:shortstring;Var d:Real;Var code:Integer);
Procedure Val(const s:shortstring;Var d:Real;Var code:Longint);
Procedure Val(const s:shortstring;Var d:Real);
{$else DEFAULT_EXTENDED}
{$ifdef SUPPORT_EXTENDED}
Procedure Val(const s:shortstring;Var d:Extended;Var code:Word);
Procedure Val(const s:shortstring;Var d:Extended;Var code:Integer);
Procedure Val(const s:shortstring;Var d:Extended;Var code:Longint);
Procedure Val(const s:shortstring;Var d:Extended);
{$endif}
{$endif DEFAULT_EXTENDED}
{$EndIf ValInternCompiled}
{****************************************************************************
AnsiString Handling
****************************************************************************}
Procedure SetLength (Var S : AnsiString; l : Longint);
Procedure UniqueAnsiString (Var S : AnsiString);
Function Length (Const S : AnsiString) : Longint;
Function Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
Procedure Delete (Var S : AnsiString; Index,Size: Longint);
{$IfNDef ValInternCompiled}
Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer);
{
Procedure Val (Const S : AnsiString; var D : Double; Var Code : Integer);
}
Procedure Val (Const S : AnsiString; var E : Extended; Code : Integer);
Procedure Val (Const S : AnsiString; var C : Cardinal; Code : Integer);
Procedure Val (Const S : AnsiString; var L : Longint; Var Code : Integer);
Procedure Val (Const S : AnsiString; var W : Word; Var Code : Integer);
Procedure Val (Const S : AnsiString; var I : Integer; Var Code : Integer);
Procedure Val (Const S : AnsiString; var B : Byte; Var Code : Integer);
Procedure Val (Const S : AnsiString; var SI : ShortInt; Var Code : Integer);
{$EndIf ValInternCompiled}
{
Procedure Str (Const R : Real;Len, fr : longint; Var S : AnsiString);
Procedure Str (Const D : Double;Len,fr : longint; Var S : AnsiString);
Procedure Str (Const E : Extended;Len,fr : longint; Var S : AnsiString);
Procedure Str (Const C : Cardinal;len : Longint; Var S : AnsiString);
Procedure Str (Const L : LongInt;len : longint; Var S : AnsiString);
Procedure Str (Const W : Word;len : longint; Var S : AnsiString);
Procedure Str (Const I : Integer;len : Longint; Var S : AnsiString);
Procedure Str (Const B : Byte; Len : longint; Var S : AnsiString);
Procedure Str (Const SI : ShortInt; Len : longint; Var S : AnsiString);
}
{****************************************************************************
Untyped File Management
****************************************************************************}
Procedure Assign(Var f:File;const Name:string);
Procedure Assign(Var f:File;p:pchar);
Procedure Assign(Var f:File;c:char);
Procedure Rewrite(Var f:File;l:Longint);
Procedure Rewrite(Var f:File);
Procedure Reset(Var f:File;l:Longint);
Procedure Reset(Var f:File);
Procedure Close(Var f:File);
Procedure BlockWrite(Var f:File;Var Buf;Count:Longint;Var Result:Longint);
Procedure BlockWrite(Var f:File;Var Buf;Count:Word;Var Result:Word);
Procedure BlockWrite(Var f:File;Var Buf;Count:Word;Var Result:Integer);
Procedure BlockWrite(Var f:File;Var Buf;Count:Longint);
Procedure BlockRead(Var f:File;Var Buf;count:Longint;Var Result:Longint);
Procedure BlockRead(Var f:File;Var Buf;count:Word;Var Result:Word);
Procedure BlockRead(Var f:File;Var Buf;count:Word;Var Result:Integer);
Procedure BlockRead(Var f:File;Var Buf;count:Longint);
Function FilePos(Var f:File):Longint;
Function FileSize(Var f:File):Longint;
Procedure Seek(Var f:File;Pos:Longint);
Function EOF(Var f:File):Boolean;
Procedure Erase(Var f:File);
Procedure Rename(Var f:File;const s:string);
Procedure Rename(Var f:File;p:pchar);
Procedure Rename(Var f:File;c:char);
Procedure Truncate (Var F:File);
{****************************************************************************
Typed File Management
****************************************************************************}
Procedure Assign(Var f:TypedFile;const Name:string);
Procedure Assign(Var f:TypedFile;p:pchar);
Procedure Assign(Var f:TypedFile;c:char);
Procedure Rewrite(Var f:TypedFile);
Procedure Reset(Var f:TypedFile);
{****************************************************************************
Text File Management
****************************************************************************}
Procedure Assign(Var t:Text;const s:string);
Procedure Assign(Var t:Text;p:pchar);
Procedure Assign(Var t:Text;c:char);
Procedure Close(Var t:Text);
Procedure Rewrite(Var t:Text);
Procedure Reset(Var t:Text);
Procedure Append(Var t:Text);
Procedure Flush(Var t:Text);
Procedure Erase(Var t:Text);
Procedure Rename(Var t:Text;const s:string);
Procedure Rename(Var t:Text;p:pchar);
Procedure Rename(Var t:Text;c:char);
Function EOF(Var t:Text):Boolean;
Function EOF:Boolean;
Function EOLn(Var t:Text):Boolean;
Function EOLn:Boolean;
Function SeekEOLn (Var t:Text):Boolean;
Function SeekEOF (Var t:Text):Boolean;
Function SeekEOLn:Boolean;
Function SeekEOF:Boolean;
Procedure SetTextBuf(Var f:Text; Var Buf);
Procedure SetTextBuf(Var f:Text; Var Buf; Size:Word);
{****************************************************************************
Directory Management
****************************************************************************}
Procedure chdir(const s:string);
Procedure mkdir(const s:string);
Procedure rmdir(const s:string);
Procedure getdir(drivenr:byte;Var dir:shortstring);
Procedure getdir(drivenr:byte;Var dir:ansistring);
{*****************************************************************************
Miscelleaous
*****************************************************************************}
{ os independent calls to allow backtraces }
function get_frame:longint;
function get_caller_addr(framebp:longint):longint;
function get_caller_frame(framebp:longint):longint;
Function IOResult:Word;
Function Sptr:Longint;
{*****************************************************************************
Init / Exit / ExitProc
*****************************************************************************}
Function Paramcount:Longint;
Function ParamStr(l:Longint):string;
{$ifndef RTLLITE}
Procedure Dump_Stack(var f : text;bp:Longint);
{$endif RTLLITE}
Procedure RunError(w:Word);
Procedure RunError;
Procedure halt(errnum:byte);
{$ifndef RTLLITE}
Procedure AddExitProc(Proc:TProcedure);
{$endif RTLLITE}
Procedure halt;
{*****************************************************************************
Abstract/Assert
*****************************************************************************}
procedure AbstractError;
Procedure SysAssert(Const Msg,FName:string;LineNo,ErrorAddr:Longint);
const
AssertErrorProc : Pointer=@SysAssert;
AbstractErrorProc : Pointer=nil;
{*****************************************************************************
SetJmp/LongJmp
*****************************************************************************}
{$i setjumph.inc}
{*****************************************************************************
Object Pascal support
*****************************************************************************}
{$i objpash.inc}
{
$Log$
Revision 1.58 1999-06-30 22:17:22 florian
+ fpuint64 to system unit interface added: if it is true, the rtl
uses the fpu to do int64 operations, if possible
Revision 1.57 1999/05/17 21:52:40 florian
* most of the Object Pascal stuff moved to the system unit
Revision 1.56 1999/05/06 09:05:14 peter
* generic write_float str_float
Revision 1.55 1999/04/17 13:10:26 peter
* addr() internal
Revision 1.54 1999/04/08 15:57:56 peter
+ subrange checking for readln()
Revision 1.53 1999/03/16 17:49:37 jonas
* changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
* in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
* in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,
Revision 1.52 1999/03/10 22:15:30 florian
+ system.cmdline variable for go32v2 and win32 added
Revision 1.51 1999/03/03 15:23:58 michael
+ Added setstring for Delphi compatibility
Revision 1.50 1999/02/01 00:05:16 florian
+ functions lo/hi for DWord type implemented
Revision 1.49 1999/01/29 09:23:10 pierre
* Fillchar(..,..,boolean) added
Revision 1.48 1999/01/22 12:39:24 pierre
+ added text arg for dump_stack
Revision 1.47 1999/01/11 19:26:53 jonas
* made inster(string,string,index) a bit faster
+ overloaded insert(char,string,index)
Revision 1.46 1998/12/28 15:50:48 peter
+ stdout, which is needed when you write something in the system unit
to the screen. Like the runtime error
Revision 1.45 1998/12/15 22:43:04 peter
* removed temp symbols
Revision 1.44 1998/11/27 14:50:57 peter
+ open strings, $P switch support
Revision 1.43 1998/11/26 23:16:13 jonas
* changed RandSeed and OldRandSeed to Cardinal to avoid negative random numbers
Revision 1.42 1998/11/24 17:12:43 peter
* fixed length(char)
- removed obsolete version.inc
Revision 1.41 1998/11/16 10:21:26 peter
* fixes for H+
Revision 1.40 1998/11/05 10:29:37 pierre
* fix for length(char) in const expressions
Revision 1.39 1998/11/04 20:34:01 michael
+ Removed ifdef useansistrings
Revision 1.38 1998/11/04 10:20:51 peter
* ansistring fixes
Revision 1.37 1998/10/10 15:28:47 peter
+ read single,fixed
+ val with code:longint
+ val for fixed
Revision 1.36 1998/10/05 17:22:54 pierre
* avoid overflow on $8000000 with $Q-
Revision 1.35 1998/10/05 12:32:52 peter
+ assert() support
Revision 1.34 1998/10/01 14:54:48 peter
* export also stackframe functions
Revision 1.33 1998/09/28 14:02:33 michael
+ AnsiString changes
Revision 1.32 1998/09/22 15:30:55 peter
* shortstring=string type added
Revision 1.31 1998/09/20 17:49:09 florian
* some ansistring fixes
Revision 1.30 1998/09/17 16:34:17 peter
* new eof,eoln,seekeoln,seekeof
* speed upgrade for read_string
* inoutres 104/105 updates for read_* and write_*
Revision 1.29 1998/09/16 13:08:04 michael
Added AbstractErrorHandler
Revision 1.28 1998/09/14 10:48:22 peter
* FPC_ names
* Heap manager is now system independent
Revision 1.27 1998/09/08 15:03:28 peter
* moved getmem/freemem/memavail/maxavail to heaph.inc
Revision 1.26 1998/09/04 18:16:14 peter
* uniform filerec/textrec (with recsize:longint and name:0..255)
Revision 1.25 1998/09/01 17:36:22 peter
+ internconst
Revision 1.24 1998/08/11 21:39:08 peter
* splitted default_extended from support_extended
Revision 1.23 1998/08/11 00:05:27 peter
* $ifdef ver0_99_5 updates
Revision 1.22 1998/08/08 12:28:14 florian
* a lot small fixes to the extended data type work
Revision 1.21 1998/07/30 13:26:17 michael
+ Added support for ErrorProc variable. All internal functions are required
to call HandleError instead of runerror from now on.
This is necessary for exception support.
Revision 1.20 1998/07/28 20:37:47 michael
+ added setjmp/longjmp and exception support
Revision 1.19 1998/07/20 23:36:57 michael
changes for ansistrings
Revision 1.18 1998/07/18 17:14:24 florian
* strlenint type implemented
Revision 1.17 1998/07/10 11:02:39 peter
* support_fixed, becuase fixed is not 100% yet for the m68k
Revision 1.16 1998/07/02 12:13:18 carl
* No SINGLE type for m68k or other non-intel processors!
Revision 1.15 1998/07/01 14:43:46 carl
- max_frame_dump reduced to 8, 20 is too much!
Revision 1.14 1998/06/25 14:04:26 peter
+ internal inc/dec
Revision 1.13 1998/06/25 09:44:21 daniel
+ RTLLITE directive to compile minimal RTL.
Revision 1.12 1998/06/15 15:16:27 daniel
* RTLLITE conditional added to produce smaller RTL
Revision 1.11 1998/06/08 12:38:23 michael
Implemented rtti, inserted ansistrings again
Revision 1.10 1998/06/04 23:46:02 peter
* comp,extended are only i386 added support_comp,support_extended
Revision 1.9 1998/06/04 08:26:03 pierre
* boolean internal definition again (needed to compile
older RTL's)
Revision 1.8 1998/06/03 23:39:53 peter
+ boolean=bytebool
Revision 1.7 1998/05/22 12:34:11 peter
* fixed the optimizes of daniel
Revision 1.6 1998/05/21 19:31:00 peter
* objects compiles for linux
+ assign(pchar), assign(char), rename(pchar), rename(char)
* fixed read_text_as_array
+ read_text_as_pchar which was not yet in the rtl
Revision 1.5 1998/05/12 10:42:45 peter
* moved getopts to inc/, all supported OS's need argc,argv exported
+ strpas, strlen are now exported in the systemunit
* removed logs
* removed $ifdef ver_above
Revision 1.4 1998/04/16 12:30:47 peter
+ inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
}
Reference in New Issue View Git Blame Copy Permalink