freepascal.compiler/rtl/inc/systemh.inc

{
    $Id$
    This file is part of the Free Pascal Run time library.
    Copyright (c) 1999-2000 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.

 **********************************************************************}


{****************************************************************************
                             Needed switches
****************************************************************************}

{$I-,Q-,H-,R-,V-}
{$mode objfpc}

{ don't use FPU registervariables on the i386 }
{$ifdef i386}
  {$maxfpuregisters 0}
{$endif i386}

{ needed for insert,delete,readln }
{$P+}

{ Stack check gives a note under linux }
{$ifndef unix}
  {$S-}
{$endif}

{****************************************************************************
                         Global Types and Constants
****************************************************************************}

Type
  ShortInt = -128..127;
  SmallInt = -32768..32767;
  { can't use -2147483648 because of a bug in 1.0.2's val() procedure (JM) }
  Longint  = +(-2147483647-1)..$7fffffff;
  Byte     = 0..255;
  Word     = 0..65535;
  DWord    = Cardinal;
  LongWord = Cardinal;
  Integer  = SmallInt;

{ at least declare Turbo Pascal real types }
{$ifdef i386}
  StrLenInt = LongInt;

  {$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}

{ Zero - terminated strings }
  PChar               = ^Char;
  PPChar              = ^PChar;

  TAnsiChar           = Char;
  AnsiChar            = TAnsiChar;
  PAnsiChar           = ^TAnsiChar;
  PPAnsiChar          = ^PAnsiChar;

  Currency            = Int64;
  HRESULT             = Longint;
  TDateTime           = Double;
  Error               = Longint;

  PSingle             = ^Single;
  PDouble             = ^Double;
  PCurrency           = ^Currency;
{$ifdef SUPPORT_COMP}
  PComp               = ^Comp;
{$endif SUPPORT_COMP}
{$ifdef SUPPORT_EXTENDED}
  PExtended           = ^Extended;
{$endif SUPPORT_EXTENDED}

  PSmallInt           = ^Smallint;
  PInteger            = ^Longint;
  PByte               = ^Byte;
  PWord               = ^word;
  PDWord              = ^DWord;
  PLongWord           = ^LongWord;
  PLongint            = ^Longint;
  PQWord              = ^QWord;
  PInt64              = ^Int64;

  PPointer            = ^Pointer;
  PPPointer           = ^PPointer;

  PBoolean            = ^Boolean;
  PWordBool           = ^WordBool;
  PLongBool           = ^LongBool;

  PShortString        = ^ShortString;
  PAnsiString         = ^AnsiString;

  PDate               = ^TDateTime;
  PError              = ^Error;
{$ifdef HASVARIANT}
  PVariant            = ^Variant;
{$endif HASVARIANT}

{$ifdef HASWIDECHAR}
  PWideChar           = ^WideChar;
  PPWideChar          = ^PWideChar;
  PWideString         = ^WideString;
{$endif HASWIDECHAR}

  TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);

{ procedure type }
  TProcedure  = Procedure;

const
{ Maximum value of the biggest signed and unsigned integer type available}
  MaxSIntValue = High(ValSInt);
  MaxUIntValue = High(ValUInt);

{ max. values for longint and int}
  maxLongint  = $7fffffff;
  maxSmallint = 32767;

const
  maxint   = maxsmallint;

{ Compatibility With  TP }
const
  { code to use comps in int64mul and div code is commented out! (JM) }
  FPUInt64 : boolean = false; { 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          }
{$ifdef i386}
  Test8086 : byte = 2;       { Always i386 or newer }
  Test8087 : byte = 3;       { Always 387 or newer. Emulated if needed. }
{$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;

var
{ Standard In- and Output }
  Output,
  Input,
  StdOut,
  StdErr      : Text;
  ExitCode    : Word;
  StackBottom,
  LowestStack,
  RandSeed    : Cardinal;
{ Delphi compatible }
  IsLibrary,IsMultiThreaded,IsConsole : boolean;
{$ifdef MT}
ThreadVar
{$else MT}
Var
{$endif MT}
  InOutRes    : Word;

{****************************************************************************
                        Processor specific routines
****************************************************************************}

Procedure Move(const source;var 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);
procedure FillByte(var x;count:longint;value:byte);
Procedure FillWord(Var x;count:Longint;Value:Word);
procedure FillDWord(var x;count:longint;value:DWord);
function  IndexChar(var buf;len:longint;b:char):longint;
function  IndexByte(var buf;len:longint;b:byte):longint;
function  Indexword(var buf;len:longint;b:word):longint;
function  IndexDWord(var buf;len:longint;b:DWord):longint;
function  CompareChar(var buf1,buf2;len:longint):longint;
function  CompareByte(var buf1,buf2;len:longint):longint;
function  CompareWord(var buf1,buf2;len:longint):longint;
function  CompareDWord(var buf1,buf2;len:longint):longint;
procedure MoveChar0(var buf1,buf2;len:longint);
function  IndexChar0(var buf;len:longint;b:char):longint;
function  CompareChar0(var buf1,buf2;len:longint):longint;


{****************************************************************************
                          Math Routines
****************************************************************************}

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;
Function  lo(q : QWord) : DWord;
Function  lo(i : Int64) : DWord;
Function  hi(q : QWord) : DWord;
Function  hi(i : Int64) : DWord;
Function  Swap (X:QWord):QWord;
Function  Swap (X:Int64):Int64;

Function  Random(l:cardinal):cardinal;
Function  Random(l:longint):longint;
Function  Random: extended;
Procedure Randomize;

Function abs(l:Longint):Longint;
Function sqr(l:Longint):Longint;
Function odd(l:Longint):Boolean;
Function odd(l:Cardinal):Boolean;
Function odd(l:Int64):Boolean;
Function odd(l:QWord):Boolean;

{ float math routines }
{$I mathh.inc}

{****************************************************************************
                         Addr/Pointer Handling
****************************************************************************}

Function  ptr(sel,off:Longint):farpointer;
Function  Cseg:Word;
Function  Dseg:Word;
Function  Sseg:Word;

{****************************************************************************
                      PChar and String Handling
****************************************************************************}

function strpas(p:pchar):shortstring;
function strlen(p:pchar):longint;

{ Shortstring functions }
{$ifndef INTERNSETLENGTH}
Procedure SetLength (Var S:ShortString;len:StrLenInt);
{$endif INTERNSETLENGTH}
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 SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
Procedure SetString (Var S : AnsiString; Buf : PChar; Len : Longint);
Function  Length(s:string):byte;
Function  upCase(const s:shortstring):shortstring;
Function  lowerCase(const s:shortstring):shortstring;
Function  Space(b:byte):shortstring;
Function  hexStr(Val:Longint;cnt:byte):shortstring;
Function  binStr(Val:Longint;cnt:byte):shortstring;

{ Char functions }
Function  Chr(b:byte):Char;
Function  upCase(c:Char):Char;
Function  lowerCase(c:Char):Char;
function  copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
function  pos(const substr : shortstring;c:char): StrLenInt;
function  length(c:char):byte;


{****************************************************************************
                             AnsiString Handling
****************************************************************************}

{$ifndef INTERNSETLENGTH}
Procedure SetLength (Var S : AnsiString; l : Longint);
{$endif INTERNSETLENGTH}
Procedure UniqueString (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;
Function  Pos (c : Char; Const s : AnsiString) : Longint;
Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
Procedure Delete (Var S : AnsiString; Index,Size: Longint);
Function  StringOfChar(c : char;l : longint) : AnsiString;
function  upcase(const s : ansistring) : ansistring;
function  lowercase(const s : ansistring) : ansistring;


{****************************************************************************
                             WideString Handling
****************************************************************************}

{$ifdef haswidechar}
{$ifndef INTERNSETLENGTH}
Procedure SetLength (Var S : WideString; l : Longint);
{$endif INTERNSETLENGTH}
Procedure UniqueString (Var S : WideString);
Function  Length (Const S : WideString) : Longint;
Function  Copy (Const S : WideString; Index,Size : Longint) : WideString;
Function  Pos (Const Substr : WideString; Const Source : WideString) : Longint;
Procedure Insert (Const Source : WideString; Var S : WideString; Index : Longint);
Procedure Delete (Var S : WideString; Index,Size: Longint);
{$endif haswidechar}


{****************************************************************************
                          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:Longint);


{****************************************************************************
                            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;
Procedure Dump_Stack(var f : text;bp:Longint);
Procedure RunError(w:Word);
Procedure RunError;
Procedure halt(errnum:byte);
Procedure AddExitProc(Proc:TProcedure);
Procedure halt;


{*****************************************************************************
                         Abstract/Assert/Error Handling
*****************************************************************************}

procedure AbstractError;
Function  SysBackTraceStr(Addr: Longint): ShortString;
Procedure SysAssert(Const Msg,FName:ShortString;LineNo,ErrorAddr:Longint);

{ Error handlers }
Type
  TBackTraceStrFunc = Function (Addr: Longint): ShortString;
  TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
  TAbstractErrorProc = Procedure;
  TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno,erroraddr:longint);



const
  BackTraceStrFunc  : TBackTraceStrFunc = @SysBackTraceStr;
  ErrorProc         : TErrorProc = nil;
  AbstractErrorProc : TAbstractErrorProc = nil;
  AssertErrorProc   : TAssertErrorProc = @SysAssert;


{*****************************************************************************
                          SetJmp/LongJmp
*****************************************************************************}

{$i setjumph.inc}


{*****************************************************************************
                       Object Pascal support
*****************************************************************************}

{$i objpash.inc}

{
  $Log$
  Revision 1.22  2001-05-16 17:44:25  jonas
    + odd() for cardinal, int64 and qword (merged)

  Revision 1.21  2001/05/09 19:57:07  peter
  *** empty log message ***

  Revision 1.20  2001/04/23 18:25:45  peter
    * m68k updates

  Revision 1.19  2001/04/13 18:06:07  peter
    * upcase, lowercase for ansistring

  Revision 1.18  2001/03/22 23:26:05  florian
    * some new types added like PBoolean

  Revision 1.17  2001/03/21 23:29:40  florian
    + sLineBreak and misc. stuff for Kylix compatiblity

  Revision 1.16  2001/01/24 21:47:18  florian
    + more MT stuff added

  Revision 1.15  2000/12/16 15:56:19  jonas
    - removed all ifdef cardinalmulfix code

  Revision 1.14  2000/12/08 14:04:43  jonas
    + added pos(char,ansistring), because there is also a pos(char,shortstring)
      and without the ansistring version, the shortstring version is always
      called when calling pos(char,pchar), even when using $h+ (because the
      first parameter matches exactly) (merged)

  Revision 1.13  2000/12/07 17:19:47  jonas
    * new constant handling: from now on, hex constants >$7fffffff are
      parsed as unsigned constants (otherwise, $80000000 got sign extended
      and became $ffffffff80000000), all constants in the longint range
      become longints, all constants >$7fffffff and <=cardinal($ffffffff)
      are cardinals and the rest are int64's.
    * added lots of longint typecast to prevent range check errors in the
      compiler and rtl
    * type casts of symbolic ordinal constants are now preserved
    * fixed bug where the original resulttype wasn't restored correctly
      after doing a 64bit rangecheck

  Revision 1.12  2000/11/13 13:40:04  marco
   * Renamefest

  Revision 1.11  2000/11/11 16:12:01  peter
    * ptr returns farpointer

  Revision 1.10  2000/11/06 21:35:59  peter
    * removed some warnings

  Revision 1.9  2000/11/06 20:34:24  peter
    * changed ver1_0 defines to temporary defs

  Revision 1.8  2000/10/23 16:15:40  jonas
    * renamed strlenint to longint since 1.0 doesn't know that type

  Revision 1.7  2000/10/23 14:00:59  florian
    * setlength export declaration for 1.0.2 fixed

  Revision 1.6  2000/10/21 18:20:17  florian
    * a lot of small changes:
       - setlength is internal
       - win32 graph unit extended
       ....

  Revision 1.5  2000/08/13 17:55:15  michael
  + Added some delphi compatibility types

  Revision 1.4  2000/08/08 22:11:45  sg
  * Added declarations for WideString utility functions

  Revision 1.3  2000/07/14 10:33:10  michael
  + Conditionals fixed

  Revision 1.2  2000/07/13 11:33:45  michael
  + removed logs

}