{ Pascal declarations of the GPC Run Time System routines that are
  implemented in C

  Note about the `GPC_' prefix:
  This is inserted so that some identifiers don't conflict with the
  built-in ones. In some cases, the built-in ones do exactly the
  same as the ones declared here, but often enough, they contain
  some "magic", so they should be used instead of the plain
  declarations here. In general, routines with a `GPC_' prefix
  should not be called from programs. They may change or disappear
  in future GPC versions.

  Copyright (C) 1998-2002 Free Software Foundation, Inc.

  Author: Frank Heckenbach <frank@pascal.gnu.de>

  This file is part of GNU Pascal.

  GNU Pascal is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published
  by the Free Software Foundation; either version 2, or (at your
  option) any later version.

  GNU Pascal 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. See the GNU
  General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with GNU Pascal; see the file COPYING. If not, write to the
  Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  02111-1307, USA.

  As a special exception, if you link this file with files compiled
  with a GNU compiler to produce an executable, this does not cause
  the resulting executable to be covered by the GNU General Public
  License. This exception does not however invalidate any other
  reasons why the executable file might be covered by the GNU
  General Public License. }

{$gnu-pascal,I-}

unit RTSC; asmname 'GPC';

interface

const
  MaxLongInt = High (LongInt);

  { Maximum size of a variable }
  MaxVarSize = MaxInt div 8;

{ If set, characters >= #$80 are assumed to be letters even if the
  locale routines don't say so. This is a kludge because some
  systems don't have correct non-English locale tables. }
var
  FakeHighLetters: Boolean = False; asmname '_p_FakeHighLetters';

{@internal}
{ The following declarations were created by running ../script/rts-c-to-pas }
{@endinternal}

type
  PCStrings = ^TCStrings;
  TCStrings = array [0 .. MaxVarSize div SizeOf (CString)] of CString;

  Int64 = Integer (64);
  UnixTimeType = LongInt;  { This is hard-coded in the compiler. Do not change here. }
  MicroSecondTimeType = LongInt;
  FileSizeType = LongInt;
  SignedSizeType = Integer (BitSizeOf (SizeType));
  TSignalHandler = procedure (Signal: Integer);

  StatFSBuffer = record
    BlockSize, BlocksTotal, BlocksFree: LongestInt;
    FilesTotal, FilesFree: Integer
  end;

  InternalSelectType = record
    Handle: Integer;
    Read, Write, Exception: Boolean
  end;

  { `+ 1' is a waste, but it is so the size of the array is not
    zero for Count = 0 }
  PPStrings = ^TPStrings;
  TPStrings (Count: Cardinal) = array [1 .. Count + 1] of ^String;

  GlobBuffer = record
    Result: PPStrings;
    Internal1: Pointer;
    Internal2: PCStrings;
    Internal3: Integer
  end;

  {@internal}
  TCPasswordEntry = record
    UserName, RealName, Password, HomeDirectory, Shell: CString;
    UID, GID: Integer
  end;

  PCPasswordEntries = ^TCPasswordEntries;
  TCPasswordEntries = array [0 .. MaxVarSize div SizeOf (TCPasswordEntry)] of TCPasswordEntry;
  {@endinternal}

{@internal}
{@endinternal}


{ Mathematical routines }

{@internal}
function  Real_Sin (x: Real): Real; attribute (const); asmname '_p_Real_Sin';
function  Real_Cos (x: Real): Real; attribute (const); asmname '_p_Real_Cos';
function  Real_ArcTan (x: Real): Real; attribute (const); asmname '_p_Real_ArcTan';
function  Real_SqRt (x: Real): Real; attribute (const); asmname '_p_Real_SqRt';
function  Real_Ln (x: Real): Real; attribute (const); asmname '_p_Real_Ln';
function  Real_Exp (x: Real): Real; attribute (const); asmname '_p_Real_Exp';
function  Real_Power (x: Real; y: Real): Real; attribute (const); asmname '_p_Real_Power';
function  Real_Hypot (x: Real; y: Real): Real; attribute (const); asmname '_p_Real_Hypot';
function  Real_Ln1Plus (x: Real): Real; attribute (const); asmname '_p_Real_Ln1Plus';
function  LongReal_Sin (x: LongReal): LongReal; attribute (const); asmname '_p_LongReal_Sin';
function  LongReal_Cos (x: LongReal): LongReal; attribute (const); asmname '_p_LongReal_Cos';
function  LongReal_ArcTan (x: LongReal): LongReal; attribute (const); asmname '_p_LongReal_ArcTan';
function  LongReal_SqRt (x: LongReal): LongReal; attribute (const); asmname '_p_LongReal_SqRt';
function  LongReal_Ln (x: LongReal): LongReal; attribute (const); asmname '_p_LongReal_Ln';
function  LongReal_Exp (x: LongReal): LongReal; attribute (const); asmname '_p_LongReal_Exp';
function  LongReal_Power (x: LongReal; y: LongReal): LongReal; attribute (const); asmname '_p_LongReal_Power';
{@endinternal}

function  SinH (x: Real): Real; attribute (const); asmname '_p_SinH';
function  CosH (x: Real): Real; attribute (const); asmname '_p_CosH';
function  ArcTan2 (y: Real; x: Real): Real; attribute (const); asmname '_p_ArcTan2';
function  IsInfinity (x: LongReal): Boolean; attribute (const); asmname '_p_IsInfinity';
function  IsNotANumber (x: LongReal): Boolean; attribute (const); asmname '_p_IsNotANumber';
procedure SplitReal (x: LongReal; var Exponent: Integer; var Mantissa: LongReal); asmname '_p_SplitReal';

{ Character routines }

{ Convert a character to upper case, according to the current
  locale.
  Except in `--borland-pascal' mode, `UpCase' does the same. }
function  LocaleUpCase (ch: Char): Char; attribute (const); asmname '_p_LocaleUpCase';

{ Convert a character to lower case, according to the current
  locale.
  Except in `--borland-pascal' mode, `UpCase' does the same. }
function  LocaleLoCase (ch: Char): Char; attribute (const); asmname '_p_LocaleLoCase';
function  IsUpCase (ch: Char): Boolean; attribute (const); asmname '_p_IsUpCase';
function  IsLoCase (ch: Char): Boolean; attribute (const); asmname '_p_IsLoCase';
function  IsAlpha (ch: Char): Boolean; attribute (const); asmname '_p_IsAlpha';
function  IsAlphaNum (ch: Char): Boolean; attribute (const); asmname '_p_IsAlphaNum';
function  IsAlphaNumUnderscore (ch: Char): Boolean; attribute (const); asmname '_p_IsAlphaNumUnderscore';
function  IsSpace (ch: Char): Boolean; attribute (const); asmname '_p_IsSpace';
function  IsPrintable (ch: Char): Boolean; attribute (const); asmname '_p_IsPrintable';

{ Time routines }

{ Sleep for a given number of seconds. }
procedure Sleep (Seconds: Integer); asmname '_p_Sleep';

{ Sleep for a given number of microseconds. }
procedure SleepMicroSeconds (MicroSeconds: Integer); asmname '_p_SleepMicroSeconds';

{ Set an alarm timer. }
function  Alarm (Seconds: Integer): Integer; asmname '_p_Alarm';

{ Convert a Unix time value to broken-down local time.
  All parameters except Time may be Null. }
procedure UnixTimeToTime (Time: UnixTimeType; var Year: Integer; var Month: Integer; var Day: Integer; var Hour: Integer; var Minute: Integer; var Second: Integer;
                                var TimeZone: Integer; var DST: Boolean; var TZName1: CString; var TZName2: CString); asmname '_p_UnixTimeToTime';

{ Convert broken-down local time to a Unix time value. }
function  TimeToUnixTime (Year: Integer; Month: Integer; Day: Integer; Hour: Integer; Minute: Integer; Second: Integer): UnixTimeType; asmname '_p_TimeToUnixTime';

{ Get the real time. MicroSecond can be Null and is ignored then. }
function  GetUnixTime (var MicroSecond: Integer): UnixTimeType; asmname '_p_GetUnixTime';

{ Get the CPU time used. MicroSecond can be Null and is ignored
  then. Now, GetCPUTime can measure long CPU times reliably on most
  systems (e.g. Solaris where it didn't work before). }
function  GetCPUTime (var MicroSecond: Integer): Integer; asmname '_p_GetCPUTime';

{@internal}
procedure InitTime; asmname '_p_InitTime';
function  CFormatTime (Time: UnixTimeType; Format: CString; Buf: CString; Size: Integer): Integer; asmname '_p_CFormatTime';
{@endinternal}


{ Signal and process routines }

{ Extract information from the status returned by PWait }
function  StatusExited (Status: Integer): Boolean; attribute (const); asmname '_p_StatusExited';
function  StatusExitCode (Status: Integer): Integer; attribute (const); asmname '_p_StatusExitCode';
function  StatusSignaled (Status: Integer): Boolean; attribute (const); asmname '_p_StatusSignaled';
function  StatusTermSignal (Status: Integer): Integer; attribute (const); asmname '_p_StatusTermSignal';
function  StatusStopped (Status: Integer): Boolean; attribute (const); asmname '_p_StatusStopped';
function  StatusStopSignal (Status: Integer): Integer; attribute (const); asmname '_p_StatusStopSignal';

{ Install a signal handler and optionally return the previous
  handler. OldHandler and OldRestart may be Null. }
function  InstallSignalHandler (Signal: Integer; Handler: TSignalHandler; Restart: Boolean; UnlessIgnored: Boolean;
  var OldHandler: TSignalHandler; var OldRestart: Boolean): Boolean; asmname '_p_InstallSignalHandler';

{ Block or unblock a signal. }
procedure BlockSignal (Signal: Integer; Block: Boolean); asmname '_p_BlockSignal';

{ Test whether a signal is blocked. }
function  SignalBlocked (Signal: Integer): Boolean; asmname '_p_SignalBlocked';

{ Sends a signal to a process. Returns True if successful. If Signal
  is 0, it doesn't send a signal, but still checks whether it would
  be possible to send a signal to the given process. }
function  Kill (PID: Integer; Signal: Integer): Boolean; asmname '_p_Kill';

{ Constant for WaitPID }
const
  AnyChild = -1;

{ Waits for a child process with the given PID (or any child process
  if PID = AnyChild) to terminate or be stopped. Returns the PID of
  the process. WStatus will contain the status and can be evaluated
  with StatusExited etc.. If nothing happened, and Block is False,
  the function will return 0, and WStatus will be 0. If an error
  occurred (especially on single tasking systems where WaitPID is
  not possible), the function will return a negative value, and
  WStatus will be 0. }
function  WaitPID (PID: Integer; var WStatus: Integer; Block: Boolean): Integer; asmname '_p_WaitPID';

{ Returns the process ID. }
function  ProcessID: Integer; asmname '_p_ProcessID';

{ Returns the real or effective user ID of the process. }
function  UserID (Effective: Boolean): Integer; asmname '_p_UserID';

{ Returns the real or effective group ID of the process. }
function  GroupID (Effective: Boolean): Integer; asmname '_p_GroupID';

{ Low-level file routines. Mostly for internal use. }

{ Get information about a file system. }
function  StatFS (Path: CString; var Buf: StatFSBuffer): Boolean; asmname '_p_StatFS';
function  CStringOpenDir (Name: CString): Pointer; asmname '_p_CStringOpenDir';
function  CStringReadDir (Dir: Pointer): CString; asmname '_p_CStringReadDir';
procedure CStringCloseDir (Dir: Pointer); asmname '_p_CStringCloseDir';

{ Returns the value of the symlink Name in a CString allocated from
  the heap. Returns nil if it is no symlink or the function is not
  supported. }
function  ReadLink (Name: CString): CString; asmname '_p_ReadLink';

{ The result of the following function is a pointer to a *static*
  buffer! }
function  CStringRealPath (Path: CString): CString; asmname '_p_CStringRealPath';

{ File mode constants that are ORed for BindingType.Mode, ChMod,
  CStringChMod and Stat. The values below are valid for all OSs
  (as far as supported). If the OS uses different values, they're
  converted internally. }
const
  fm_SetUID           = 8#4000;
  fm_SetGID           = 8#2000;
  fm_Sticky           = 8#1000;
  fm_UserReadable     = 8#400;
  fm_UserWritable     = 8#200;
  fm_UserExecutable   = 8#100;
  fm_GroupReadable    = 8#40;
  fm_GroupWritable    = 8#20;
  fm_GroupExecutable  = 8#10;
  fm_OthersReadable   = 8#4;
  fm_OthersWritable   = 8#2;
  fm_OthersExecutable = 8#1;

{ Constants for _p_Access() and _p_OpenHandle() }
const
  MODE_EXEC     = 1 shl 0;
  MODE_WRITE    = 1 shl 1;
  MODE_READ     = 1 shl 2;
  MODE_FILE     = 1 shl 3;
  MODE_DIR      = 1 shl 4;
  MODE_SPECIAL  = 1 shl 5;
  MODE_SYMLINK  = 1 shl 6;
  MODE_CREATE   = 1 shl 7;
  MODE_TRUNCATE = 1 shl 8;
  MODE_BINARY   = 1 shl 9;

{ Check if a file name is accessible. }
function  Access (Name: CString; Request: Integer): Integer; asmname '_p_Access';

{ Get information about a file. Any argument except Name can be
  Null. }
function  Stat (Name: CString; var Size: FileSizeType;
  var ATime: UnixTimeType; var MTime: UnixTimeType; var CTime: UnixTimeType;
  var User: Integer; var Group: Integer; var Mode: Integer; var Device: Integer; var INode: Integer; var Links: Integer;
  var SymLink: Boolean; var Dir: Boolean; var Special: Boolean): Integer; asmname '_p_Stat';
function  OpenHandle (Name: CString; Mode: Integer): Integer; asmname '_p_OpenHandle';
function  ReadHandle (Handle: Integer; Buffer: Pointer; Size: SizeType): SignedSizeType; asmname '_p_ReadHandle';
function  WriteHandle (Handle: Integer; Buffer: Pointer; Size: SizeType): SignedSizeType; asmname '_p_WriteHandle';
function  CloseHandle (Handle: Integer): Integer; asmname '_p_CloseHandle';
procedure FlushHandle (Handle: Integer); asmname '_p_FlushHandle';
function  CStringRename (OldName: CString; NewName: CString): Integer; asmname '_p_CStringRename';
function  CStringUnlink (Name: CString): Integer; asmname '_p_CStringUnlink';
function  CStringChDir (Name: CString): Integer; asmname '_p_CStringChDir';
function  CStringMkDir (Name: CString): Integer; asmname '_p_CStringMkDir';
function  CStringRmDir (Name: CString): Integer; asmname '_p_CStringRmDir';
function  CStringChMod (Name: CString; Mode: Integer): Integer; asmname '_p_CStringChMod';
function  CStringChOwn (Name: CString; Owner: Integer; Group: Integer): Integer; asmname '_p_CStringChOwn';
function  CStringUTime (Name: CString; AccessTime: UnixTimeType; ModificationTime: UnixTimeType): Integer; asmname '_p_CStringUTime';
function  SeekHandle (Handle: Integer; Offset: FileSizeType; Whence: Integer): FileSizeType; asmname '_p_SeekHandle';
function  TruncateHandle (Handle: Integer; Size: FileSizeType): Integer; asmname '_p_TruncateHandle';
function  LockHandle (Handle: Integer; WriteLock: Boolean; Block: Boolean): Boolean; asmname '_p_LockHandle';
function  UnlockHandle (Handle: Integer): Boolean; asmname '_p_UnlockHandle';
function  SelectHandle (Count: Integer; var Events: InternalSelectType; MicroSeconds: MicroSecondTimeType): Integer; asmname '_p_SelectHandle';

{ Constants for MMapHandle and MemoryMap }
const
  mm_Readable   = 1;
  mm_Writable   = 2;
  mm_Executable = 4;

{ Try to map (a part of) a file to memory. }
function  MMapHandle (Start: Pointer; Length: SizeType; Access: Integer; Shared: Boolean; Handle: Integer; Offset: FileSizeType): Pointer; asmname '_p_MMapHandle';

{ Unmap a previous memory mapping. }
function  MUnMapHandle (Start: Pointer; Length: SizeType): Integer; asmname '_p_MUnMapHandle';

{ Returns the file name of the terminal device that is open on
  Handle. Returns nil if (and only if) Handle is not open or not
  connected to a terminal. If NeedName is False, it doesn't bother
  to search for the real name and just returns DefaultName if it
  is a terminal and nil otherwise. DefaultName is also returned if
  NeedName is True, Handle is connected to a terminal, but the
  system does not provide information about the real file name. }
function  GetTerminalNameHandle (Handle: Integer; NeedName: Boolean; DefaultName: CString): CString; asmname '_p_GetTerminalNameHandle';

{ I/O routines }

{ Sets the process group of Process (or the current one if Process
  is 0) to ProcessGroup (or its PID if ProcessGroup is 0). Returns
  True if successful. }
function  SetProcessGroup (Process: Integer; ProcessGroup: Integer): Boolean; asmname '_p_SetProcessGroup';

{ Sets the process group of a terminal given by Terminal (as a file
  handle) to ProcessGroup. ProcessGroup must be the ID of a process
  group in the same session. Returns True if successful. }
function  SetTerminalProcessGroup (Handle: Integer; ProcessGroup: Integer): Boolean; asmname '_p_SetTerminalProcessGroup';

{ Returns the process group of a terminal given by Terminal (as a
  file handle), or -1 on error. }
function  GetTerminalProcessGroup (Handle: Integer): Integer; asmname '_p_GetTerminalProcessGroup';

{ Set the standard input's signal generation, if it is a terminal. }
procedure SetInputSignals (Signals: Boolean); asmname '_p_SetInputSignals';

{ Get the standard input's signal generation, if it is a terminal. }
function  GetInputSignals: Boolean; asmname '_p_GetInputSignals';

{ Internal routines }

{ Returns system information if available. Fields not available will
  be set to nil. }
procedure CStringSystemInfo (var SysName: CString; var NodeName: CString; var Release: CString; var Version: CString; var Machine: CString; var DomainName: CString); asmname '_p_CStringSystemInfo';

{ Returns the path of the running executable *if possible*. }
function  CStringExecutablePath (Buffer: CString): CString; asmname '_p_CStringExecutablePath';

{@internal}

{ Returns the path of the running executable *if possible*. }
function  CStringGetTempDirectory (Buffer: CString; Size: Integer): CString; asmname '_p_CStringGetTempDirectory';

{ Executes a command line. }
function  CSystem (CmdLine: CString): Integer; asmname '_p_CSystem';
function  GetStartEnvironment (ValueIfNotFound: PCStrings): PCStrings; asmname '_p_GetStartEnvironment';
procedure CStringSetEnv (VarName: CString; Value: CString; NewEnvCString: CString; UnSet: Boolean); asmname '_p_CStringSetEnv';
{@endinternal}


{ Sets ErrNo to the value of `errno' and returns the description
  for this error. May return nil if not supported! ErrNo may be
  Null (then only the description is returned). }
function  CStringStrError (var ErrNo: Integer): CString; asmname '_p_CStringStrError';

{@internal}

{ Returns a description for a signal. May return nil if not supported! }
function  CStringStrSignal (Signal: Integer): CString; asmname '_p_CStringStrSignal';
function  FNMatch (Pattern: CString; Name: CString): Integer; asmname '_p_FNMatch';
procedure GlobInternal (var Buf: GlobBuffer; Pattern: CString); asmname '_p_GlobInternal';
procedure GlobFreeInternal (var Buf: GlobBuffer); asmname '_p_GlobFreeInternal';
function  CGetPwNam (UserName: CString; var Entry: TCPasswordEntry): Boolean; asmname '_p_CGetPwNam';
function  CGetPwUID (UID: Integer; var Entry: TCPasswordEntry): Boolean; asmname '_p_CGetPwUID';
function  CGetPwEnt (var Entries: PCPasswordEntries): Integer; asmname '_p_CGetPwEnt';
procedure InitMisc; asmname '_p_InitMisc';
procedure InitMalloc (procedure WarnProc (Msg: CString)); asmname '_p_InitMalloc';
procedure ExitProgram (Status: Integer; AbortFlag: Boolean); attribute (noreturn); asmname '_p_ExitProgram';
{@endinternal}

{@internal}
{ End of declarations created by rts-c-to-pas }
{@endinternal}

{@internal}
{ error.pas }
procedure GPC_CheckInOutRes; asmname '_p_check_inoutres';

{ rtsc.pas }
type
  PProcedure = ^procedure;
  PProcList = ^TProcList;
  TProcList = record
    Next, Prev: PProcList;
    Proc: PProcedure
  end;

procedure RunFinalizers (var AtExitProcs: PProcList); asmname '_p_runfinalizers';

{ file.c }

type
  GPC_TChars = packed array [1 .. 1] of Char;
  GPC_PChars = ^GPC_TChars;

{@endinternal}
{ File routines }

type
  TOpenMode = (fo_None, fo_Reset, fo_Rewrite, fo_Append, fo_SeekRead, fo_SeekWrite, fo_SeekUpdate);
  AnyFile = Text;  { @@ create `AnyFile' parameters }
  PAnyFile = ^AnyFile;
{@internal}

{ @@ IO critical } procedure GPC_Initialize_Std_Files; asmname '_p_initialize_std_files';

{ Automatically called at the end of the program }
procedure GPC_Done_Files; asmname '_p_done_files';

type
  PFileAssociation = ^TFileAssociation;
  TFileAssociation = record
    Next: PFileAssociation;
    IntName, ExtName: CString
  end;

procedure FlushAllFiles; asmname '_p_fflush';

type
  InternalIOSelectTypePtr = ^InternalIOSelectType;
  InternalIOSelectType = record
    fi: PAnyFile;
    WantedReadOrEOF,
    WantedRead,
    WantedEOF,
    WantedWrite,
    WantedException,
    WantedAlways,
    OccurredReadOrEOF,
    OccurredRead,
    OccurredEOF,
    OccurredWrite,
    OccurredException: Boolean
  end;

var
  { True if the EOLn hack is wanted.

    If False: EOLn will validate the file buffer if tst_UND

    If True, when EOLn is tested when all of the following are true
      - tst_UND
      - tst_UNREAD (nothing has been read after reset)
      - tst_TXT
      - tst_TTY
      - tst_LGET,
    then the EOLn test returns True.

    If the EOLn is *not tested*, it is False. This is to make the
    program with `if EOLn then ReadLn;' in the very beginning work,
    they skip the EOLn when they test it, if you don't test, you
    don't have to skip it. }
  EOLnResetHack: Boolean; asmname '_p_EOLnResetHack'; external;

  { True if direct access routines should work only for direct access files. }
  ForceDirectFiles: Boolean; asmname '_p_ForceDirectFiles'; external;

  FileAssociation: PFileAssociation; asmname '_p_FileAssociation'; external;

  CurrentStdIn: ^Text; asmname '_p_CurrentStdin'; external;

function  GPC_GetSize      (          var aFile: AnyFile): FileSizeType;  asmname '_p_getsize';
procedure GPC_Truncate     (          var aFile: AnyFile);                asmname '_p_truncate';
procedure GPC_DefineSize   (          var aFile: AnyFile; NewSize : FileSizeType); asmname '_p_definesize';
procedure GPC_SeekAll      (          var aFile: AnyFile; NewPlace: FileSizeType); asmname '_p_seekall';
procedure GPC_SeekRead     (          var aFile: AnyFile; NewPlace: FileSizeType); asmname '_p_seekread';
procedure GPC_SeekWrite    (          var aFile: AnyFile; NewPlace: FileSizeType); asmname '_p_seekwrite';
procedure GPC_SeekUpdate   (          var aFile: AnyFile; NewPlace: FileSizeType); asmname '_p_seekupdate';
function  GPC_Empty        (protected var aFile: AnyFile): Boolean;       asmname '_p_empty';
procedure GPC_Update       (          var aFile: AnyFile);                asmname '_p_update';
function  GPC_LastPosition (          var aFile: AnyFile): FileSizeType;  asmname '_p_lastposition';
function  GPC_Position     (          var aFile: AnyFile): FileSizeType;  asmname '_p_position';

{ Versions with only 3 parameters are still overloaded magically }
{ @@ } procedure GPC_BlockRead  (var aFile: File;           var Buf: Void; Count: Cardinal; var BytesRead   : Cardinal); asmname '_p_blockread';
{ @@ } procedure GPC_BlockWrite (var aFile: File; protected var Buf: Void; Count: Cardinal; var BytesWritten: Cardinal); asmname '_p_blockwrite';

function  FileName_CString (protected var aFile: AnyFile): CString; asmname '_p_filename';

function  InternalIOSelect (Events: InternalIOSelectTypePtr; EventsLow, Count: Integer; MicroSeconds: MicroSecondTimeType): Integer; asmname '_p_select';
procedure GPC_InitFDR (var aFile: AnyFile; Name: CString; Size, Flags: Integer); asmname '_p_initfdr';
procedure GPC_DoneFDR (var aFile: AnyFile);                                        asmname '_p_donefdr';

function  GPC_LazyTryGet (var aFile: AnyFile): Pointer;                    asmname '_p_lazytryget';
function  GPC_LazyGet    (var aFile: AnyFile): Pointer;                    asmname '_p_lazyget';
function  GPC_LazyUnget  (var aFile: AnyFile): Pointer;                    asmname '_p_lazyunget';

{ If an error occurs or remaining characters (including whitespace!) are left,
  the position of the error, not the error code, is returned (BP compatibility!) }
function  GPC_Val_ByteInt_NoCheck   (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ByteInt  ): Integer; asmname '_p_val_byteint_nocheck';
function  GPC_Val_ShortInt_NoCheck  (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ShortInt ): Integer; asmname '_p_val_shortint_nocheck';
function  GPC_Val_Integer_NoCheck   (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: Integer  ): Integer; asmname '_p_val_integer_nocheck';
function  GPC_Val_MedInt_NoCheck    (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: MedInt   ): Integer; asmname '_p_val_medint_nocheck';
function  GPC_Val_LongInt_NoCheck   (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: LongInt  ): Integer; asmname '_p_val_longint_nocheck';
function  GPC_Val_ByteCard_NoCheck  (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ByteCard ): Integer; asmname '_p_val_bytecard_nocheck';
function  GPC_Val_ShortCard_NoCheck (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ShortCard): Integer; asmname '_p_val_shortcard_nocheck';
function  GPC_Val_Cardinal_NoCheck  (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: Cardinal ): Integer; asmname '_p_val_cardinal_nocheck';
function  GPC_Val_MedCard_NoCheck   (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: MedCard  ): Integer; asmname '_p_val_medcard_nocheck';
function  GPC_Val_LongCard_NoCheck  (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: LongCard ): Integer; asmname '_p_val_longcard_nocheck';
{$if 0}  { Not yet built-in }
function  GPC_Val_ByteInt_Check     (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ByteInt;   MinRange, MaxRange: ByteInt  ): Integer; asmname '_p_val_byteint_check';
function  GPC_Val_ShortInt_Check    (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ShortInt;  MinRange, MaxRange: ShortInt ): Integer; asmname '_p_val_shortint_check';
function  GPC_Val_Integer_Check     (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: Integer;   MinRange, MaxRange: Integer  ): Integer; asmname '_p_val_integer_check';
function  GPC_Val_MedInt_Check      (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: MedInt;    MinRange, MaxRange: MedInt   ): Integer; asmname '_p_val_medint_check';
function  GPC_Val_LongInt_Check     (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: LongInt;   MinRange, MaxRange: LongInt  ): Integer; asmname '_p_val_longint_check';
function  GPC_Val_ByteCard_Check    (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ByteCard;  MinRange, MaxRange: ByteCard ): Integer; asmname '_p_val_bytecard_check';
function  GPC_Val_ShortCard_Check   (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ShortCard; MinRange, MaxRange: ShortCard): Integer; asmname '_p_val_shortcard_check';
function  GPC_Val_Cardinal_Check    (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: Cardinal;  MinRange, MaxRange: Cardinal ): Integer; asmname '_p_val_cardinal_check';
function  GPC_Val_MedCard_Check     (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: MedCard;   MinRange, MaxRange: MedCard  ): Integer; asmname '_p_val_medcard_check';
function  GPC_Val_LongCard_Check    (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: LongCard;  MinRange, MaxRange: LongCard ): Integer; asmname '_p_val_longcard_check';
{$endif}
function  GPC_Val_ShortReal         (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: ShortReal): Integer; asmname '_p_val_shortreal';
function  GPC_Val_Real              (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: Real     ): Integer; asmname '_p_val_real';
function  GPC_Val_LongReal          (Source: GPC_PChars; StrLength, Flags: Integer; var Dest: LongReal ): Integer; asmname '_p_val_longreal';

procedure GPC_Page      (var aFile: Text);    asmname '_p_page';
procedure GPC_Put       (var aFile: AnyFile); asmname '_p_put';

{ The result of the following function is a pointer to a *static*
  buffer! }
function  GetErrorMessageFileName (protected var f: AnyFile): CString; asmname '_p_get_file_name';

const  { from constants.h }
  Binding_Name_Length = 255;

type
  { The standard fields are Bound and Name. The others are extensions. }
  GPC_BindingType = { @@packed } record
    Bound            : Boolean;
    Force            : Boolean;       { Can be set to allow binding to
                                        directories or inaccessible files }
    Extensions_Valid : Boolean;
    Readable         : Boolean;
    Writable         : Boolean;
    Executable       : Boolean;
    Existing         : Boolean;       { Binding points to an existing file }
    Directory        : Boolean;       { Binding points to an existing
                                        directory; Existing is False then }
    Special          : Boolean;       { Binding points to an existing
                                        special file (device, pipe, socket,
                                        etc.); `Existing' is False then }
    SymLink          : Boolean;       { Binding points to a symbolic link }
    Size             : FileSizeType;  { Size of file, or -1 if unknown }
    AccessTime,                       { Time of last access }
    ModificationTime,                 { Time of last modification }
    ChangeTime       : UnixTimeType;  { Time of last change }
    User,                             { User ID of owner }
    Group,                            { Group ID of owner }
    Mode,                             { Access permissions, cf. ChMod }
    Device,                           { Device the file is on }
    INode            : Integer;       { Unix INode number }
    TextBinary       : Boolean;       { Open a Text file in binary mode }
    Handle           : Integer;       { Can be set to bind a Pascal file to
                                        a given file handle }
    CloseFlag        : Boolean;       { If Handle is used, tell whether to
                                        close it when file is closed }
    Name             : String (Binding_Name_Length)
  end;

procedure GPC_Bind   (var aFile: AnyFile; protected var aBinding: BindingType); asmname '_p_bind';
procedure GPC_Unbind (var aFile: AnyFile);                                      asmname '_p_unbind';

var
  GPC_FileMode: Integer; asmname '_p_filemode'; external;

procedure GPC_Internal_Open (var aFile: AnyFile; aFileName: CString; aLength, BufferSize: Integer; Mode: TOpenMode); asmname '_p_c_internal_open';
procedure GPC_Flush (var aFile: AnyFile); asmname '_p_flush';
procedure GPC_Erase (var aFile: AnyFile); asmname '_p_erase';

{@endinternal}

procedure GetBinding   (protected var aFile: AnyFile; var aBinding: BindingType); asmname '_p_binding';
procedure ClearBinding (var aBinding: BindingType);                               asmname '_p_clearbinding';

{ TFDD interface @@ Subject to change! Use with caution! }

type
  TOpenProc   = procedure (var PrivateData; Mode: TOpenMode);
  TSelectFunc = function  (var PrivateData; Writing: Boolean): Integer;  { called before SelectHandle, must return a file handle }
  TSelectProc = procedure (var PrivateData; var ReadSelect, WriteSelect, ExceptSelect: Boolean);  { called before and after SelectHandle }
  TReadFunc   = function  (var PrivateData; var   Buffer; Size: SizeType): SizeType;
  TWriteFunc  = function  (var PrivateData; const Buffer; Size: SizeType): SizeType;
  TFileProc   = procedure (var PrivateData);
  TFlushProc  = TFileProc;
  TCloseProc  = TFileProc;
  TDoneProc   = TFileProc;

procedure AssignTFDD (var f: AnyFile;
                      OpenProc   : TOpenProc;
                      SelectFunc : TSelectFunc;
                      SelectProc : TSelectProc;
                      ReadFunc   : TReadFunc;
                      WriteFunc  : TWriteFunc;
                      FlushProc  : TFlushProc;
                      CloseProc  : TCloseProc;
                      DoneProc   : TDoneProc;
                      PrivateData: Pointer);       asmname '_p_assign_tfdd';

procedure SetTFDD    (var f: AnyFile;
                      OpenProc   : TOpenProc;
                      SelectFunc : TSelectFunc;
                      SelectProc : TSelectProc;
                      ReadFunc   : TReadFunc;
                      WriteFunc  : TWriteFunc;
                      FlushProc  : TFlushProc;
                      CloseProc  : TCloseProc;
                      DoneProc   : TDoneProc;
                      PrivateData: Pointer);       asmname '_p_set_tfdd';

{ Any parameter except f may be Null }
procedure GetTFDD    (var f: AnyFile;
                      var OpenProc   : TOpenProc;
                      var SelectFunc : TSelectFunc;
                      var SelectProc : TSelectProc;
                      var ReadFunc   : TReadFunc;
                      var WriteFunc  : TWriteFunc;
                      var FlushProc  : TFlushProc;
                      var CloseProc  : TCloseProc;
                      var DoneProc   : TDoneProc;
                      var PrivateData: Pointer);   asmname '_p_get_tfdd';

{ @@ iocritical } procedure FileMove (var f: AnyFile; NewName: CString; Overwrite: Boolean); asmname '_p_mv';

{ Flags that can be ORed into FileMode. The default value of
  FileMode is FileMode_Reset_ReadWrite. The somewhat confusing
  values are meant to be compatible to BP (as far as BP supports
  them). }
const
  { Allow writing to binary files opened with Reset }
  FileMode_Reset_ReadWrite      = 2;

  { Do not allow reading from files opened with Rewrite }
  FileMode_Rewrite_WriteOnly    = 4;

  { Do not allow reading from files opened with Extend }
  FileMode_Extend_WriteOnly     = 8;

  { Allow writing to text files opened with Reset }
  FileMode_Text_Reset_ReadWrite = $100;

type
  TextFile = Text;

const
  NoChange = -1;  { can be passed to ChOwn for Owner and/or Group to not change that value }

procedure CloseFile (var aFile: { @@ AnyFile } File); asmname '_p_close';
{ @@ IO critical } procedure ChMod (var aFile: AnyFile; Mode: Integer); asmname '_p_chmod';
{ @@ IO critical } procedure ChOwn (var aFile: AnyFile; Owner, Group: Integer); asmname '_p_chown';

{ Checks if data are available to be read from aFile. This is
  similar to `not EOF (aFile)', but does not block on "files" that
  can grow, like TTYs or pipes. }
function  CanRead      (var aFile: AnyFile): Boolean; asmname '_p_canread';

{ Get the file handle. }
function  FileHandle   (protected var aFile: AnyFile): Integer; asmname '_p_filehandle';

{ Lock files }
function  FileLock   (var aFile: AnyFile; WriteLock, Block: Boolean): Boolean; asmname '_p_filelock';
function  FileUnlock (var aFile: AnyFile): Boolean; asmname '_p_fileunlock';

{ Try to map (a part of) a file to memory. }
function  MemoryMap (Start: Pointer; Length: SizeType; Access: Integer; Shared: Boolean;
                     var aFile: AnyFile; Offset: FileSizeType): Pointer; asmname '_p_mmap';

{ Unmap a previous memory mapping. }
procedure MemoryUnMap (Start: Pointer; Length: SizeType); asmname '_p_munmap';

implementation

{ This file is always compiled with debug information (see
  Makefile.in), but the file name of the following routine is set to
  a magic name, so a debugger can recognize it automatically and
  step over it into the finalizers themselves. }
{$ifndef DEBUG}
#line 1 "<implicit code>"
{$endif}
procedure RunFinalizers (var AtExitProcs: PProcList);
var
  p: PProcList;
  Proc: PProcedure;
begin
  while AtExitProcs <> nil do
    begin
      p := AtExitProcs;
      AtExitProcs := AtExitProcs^.Next;
      Proc := p^.Proc;
      Dispose (p);
      Proc^
    end
end;

begin
  GPC_Initialize_Std_Files; { @@ iocritical } GPC_CheckInOutRes;
  InitMisc;
  InitTime
end.
