The Programmer's Guide to GPC

Integer Types with Specified Size

In some situations you will need an integer type of a well-defined size. For this purpose, GNU Pascal provides three families of signed and unsinged integer types. The type

Integer (42)

is guaranteed to have a precision of 42 bits. In a realistic context, you will most often give a power of two as the number of bits, and the machine you will need it on will support variables of that size. If this is the case, the specified precision will simultaneously be the amount of storage needed for variables of this type.

In short: If you want to be sure that you have a signed integer with 32 bits width, write `Integer (32)', not just `Integer' which might be bigger. The same works with `Cardinal' and `Word' if you need unsigned integer types of well-known size.

This way, you can't get a higher precision than that of `LongestInt' or `LongestCard' (see section The Main Branch of Integer Types). If you need higher precision, you can look at the `GMP' unit (see section Arithmetic with unlimited size and precision) which provides integer types with arbitrary precision, but their usage is different from normal integer types.

Integer Types and Compatibility

If you care about ISO compliance, only use `Integer' and subranges of `Integer'.

Some of GPC's non-ISO integer types exist in Borland Pascal, too: `Byte', `ShortInt', `Word', and `LongInt'. The sizes of these types, however, are not the same as in Borland Pascal. Even for `Byte' this is not guaranteed (while probable, though).

When designing GNU Pascal, we thought about compatibility to Borland Pascal. Since GNU Pascal is (at least) a 32-bit compiler, `Integer' must have (at least) 32 bits. But what to do with `Word'? Same size as `Integer' (like in BP) or 16 bits (like in BP)? We decided to make `Word' the "natural-sized" unsigned integer type, thus making it (at least) 32 bits wide. Similarly, we decided to give `LongInt' twice the size of `Integer' (like in BP) rather than making it 32 bits wide (like in BP). So `LongInt' has 64 bits, and `ShortInt' has 16 bits on the Intel x86 platforms.

On the other hand, to increase compatibility to Borland Pascal and Delphi, GPC provides the alias name `Comp' for `LongInt' (64 bits on Intel x86) and `SmallInt' for `ShortInt' (16 bits on Intel x86). Note that BP treats `Comp' as a "real" type and allows assignments like `MyCompVar := 42.0'. Since we don't consider this a feature, GPC does not copy this behaviour.

Summary of Integer Types

Here is a summary of all integer types defined in GPC. The sizes and ranges are only typical values, valid on some, but not all platforms. Compatibility to GNU C however is guaranteed.

section ByteInt

signed 8-bit integer type, `-128..128',
compatible to `signed char' in GNU C.

section ByteCard

unsigned 8-bit integer type, `0..255',
compatible to `unsigned char' in GNU C.

section ShortInt

signed 16-bit integer type, `-32768..32767',
compatible to `short int' in GNU C.

section ShortCard

unsigned 16-bit integer type, `0..65535',
compatible to `unsigned short int' in GNU C.

section Integer

signed 32-bit integer type, `-2147483648..2147483647',
compatible to `int' in GNU C.

section Cardinal

unsigned 32-bit integer type, `0..4294967295',
compatible to `unsigned int' in GNU C.

section MedInt

signed 32-bit integer type, `-2147483648..2147483647',
compatible to `long int' in GNU C.

section MedCard

unsigned 32-bit integer type, `0..4294967295',
compatible to `unsigned long int' in GNU C.

section LongInt

signed 64-bit integer type, `-9223372036854775808..9223372036854775807',
compatible to `long long int' in GNU C.

section LongCard

unsigned 64-bit integer type, `0..18446744073709551615',
compatible to `unsigned long long int' in GNU C.

section LongestInt

signed 64-bit integer type, `-9223372036854775808..9223372036854775807'.

section LongestCard

unsigned 64-bit integer type, `0..18446744073709551615'.

section Comp

signed 64-bit integer type, `-9223372036854775808..9223372036854775807'.

section SmallInt

signed 16-bit integer type, `-32768..32767'.

To specify the number of bits, use

`Integer (n)'

signed n-bit integer type.

`Cardinal (n)'

unsigned n-bit integer type.

`Word (n)'

unsigned n-bit integer type.

program IntegerTypesDemo (Output);

var
  ByteVar : Byte;
  ShortIntVar : ShortInt;
  Foo : MedCard;
  Big : LongestInt;

begin
  ShortIntVar := 1000;
  Big := MaxInt * ShortIntVar;
  ByteVar := 127;
  Foo := 16#deadbeef
end.

See also: section Subrange Types.

Built-in Real (Floating Point) Types

GPC has three built-in floating point types to represent real numbers. Each of them is available under two names (for compatibility to other compilers and languages).

For most purposes, you will always use `Real' which is the only one of them that is part of Standard and Extended Pascal. If memory constraints apply, you might want to choose `ShortReal' for larger arrays. On the other hand, if high precision is needed, you can use `LongReal'. When interfacing with libraries written in other languages such as C, you will need the equivalents for their real types.

Note that not all machines support longer floating point types, so `LongReal' is the same as `Real' on these machines. Also, some machines may support a longer type, but not do all arithmetic operations (e.g. the `Sin' function, section Sin) in a precision higher than that of `Real'. If you need higher precision, you can look at the `GMP' unit (see section Arithmetic with unlimited size and precision) which provides rational and real numbers with arbitrary precision, but their usage is different from normal real types.

The following real types are guaranteed to be compatible to the real types of GNU C. The sizes given, however, are not guaranteed. They are just typical values used on any IEEE compatible floating point hardware, but they may be different on some machines.

Strings Types

There are several ways to use strings in GNU Pascal. One of them is the use of the intrinsic string type `String' which is a predefined schema type. The schema discriminant of this type holds the maximal length, which is of type Integer, so values up to MaxInt can be specified. For `String', an assignment is defined. There are many built-in functions and procedures for comfortable strings handling.

@@ ???? String procedures and functions.

Another way to use strings is to use arrays of type `Char'. For these, an intrinsic assignment is defined as well. Besides, `String' and `Char' are assignment compatible. The preferred way, however, is `String' because of the numerous possibilities for string handling.

Character Types

Character types are a special case of ordinal types. See section Ordinal Types

File Types

@@ ???? I think that's something for someone who might know what he is doing

Boolean (Intrinsic)

The intrinsic Boolean represents boolean values, i.e. it can only assume true and false (which are predefined constants). This type corresponds to the enumerated type

type
  Boolean = (False, True);

Since it is declared this way, it follows:

Ord (False) = 0
Ord (True) = 1
False < True

There are four intrinsic logical operators. The logical and, or and not. In Borland Pascal and GNU Pascal, there is a logical "exclusive or" xor.

See also section Enumerated Types, section and, section or, section not, section xor

Pointer (Intrinsic)

The intrinsic Pointer Type is a so-called unspecified or typeless pointer (i.e. a pointer which does not point to any type but holds simply a memory address).

See also section Pointer Types, section nil

Type Definition Possibilities

Subrange Types

GNU Pascal supports Standard Pascal's subrange types:

program SubrangeDemo;
type
  MonthInt = 1 .. 12;
  Capital = 'A' .. 'Z';
  ControlChar = ^A .. ^Z;  { `^A' = `Chr (1)' is a BP extension }
begin
end.

Also possible: Subranges of enumerated types:

program EnumSubrangeDemo;
type
  { This is an enumerated type. }
  Days = (Mon, Tue, Wed, Thu, Fri, Sat, Sun);

  { This is a subrange of `Days'. }
  Working = Mon .. Fri;

begin
end.

To increase performance, variables of such a type are aligned in a way which makes them fastest to access by the CPU. As a result, `1 .. 12' occupies 4 bytes of storage on an Intel x86 compatible CPU.

For the case you want to save storage at the expense of speed, GPC provides a `packed' variant of these as an extension:

program PackedSubrangeDemo;
type
  MonthInt = packed 1 .. 12;
begin
end.

A variable of this type occupies the shortest possible (i.e., addressable) space in memory -- one byte on an Intel x86 compatible CPU.

See also: section packed.

Enumerated Types

type
  enum type identifier = (name identifier, ..., name identifier);

An enumerated type defines a range of elements which are referred to by identifiers. Enumerated types are ordered by occurence in the identifier list. So, they can be used as index types in an array definition, and it is possible to define subranges of them. Since they are ordered, they can be compared to one another. The intrinsic function Ord applied to name identifier returns the number of occurence in the identifier list (beginning with zero), Pred and Succ return the predecessor and successor of name identifier.

See also section Array Types, section Subrange Types, section Ord, section Pred, section Succ

Array Types

type
  array type identifier = array [index type] of element type

or

type
  array type identifier = array [index type, ..., index type] of element type

The reserved word array defines an array type. index type has to be an ordinal type, subrange type or an enumerated type, where several index types, separated by commata, are allowed. element type is an arbitrary type. An element of an array is accessed by array type variable [ index number ]. The upper and lower index bounds can be determined by the intrinsic functions High and Low.

type
  IntArray = array [1 .. 20] of Integer;
  Foo      = array [(Mo, Tu, We, Th, Fr, Sa, Su)] of Char;
  Bar      = array [0 .. 9, 'a' .. 'z', (Qux, Glork1, Fred)] of Real;
  Baz1     = array [1..10] of IntArray;
  { equal (but declared differently): }
  Baz2     = array [1 .. 10, 1 .. 20] of Integer;

See also section High, section Low

Record Types

type
  record type identifier = record
    field identifier : type definition;
    ...
    field identifier : type definition;
  end;

or, with a variant part,

type
  record type identifier = record
    field identifier : type definition;
    ...
    field identifier : type definition;
  case bar: variant type of
    selector: (field declarations);
    selector: (field declarations);
    ...
  end;

or, without a variant selector field,

type
  record type identifier = record
    field identifier : type definition;
    ...
    field identifier : type definition;
  case variant type of
    selector: (field declarations);
    selector: (field declarations);
    ...
  end;

The reserved word record defines a structure of fields. Records can be `packed' to save memory usage at the expense of speed.

The variants of a variant record share one location in memory (inside the record) and thus can be used to emulate type casting without violating ISO-7185 Standard Pascal.

The reserved word `record' and record types are defined in ISO-7185 Standard Pascal. According to ISO Pascal, the variant type must be an identifier. GNU Pascal, like UCSD and Borland Pascal, also allows a subrange here.

A record field is accessed by record type variable . field identifier

See also: section packed, section case Statement.

Variant Records

GPC supports variant records like in EP and BP. The following construction is not allowed in Extended Pascal, but in BP and GPC:

program BPVariantRecordDemo;

type
  PersonRec = record
    Age : Integer;
  case EyeColor : (Red, Green, Blue, Brown) of
    Red, Green  : (WearsGlasses : Boolean);
    Blue, Brown : (LengthOfLashes : Integer);
  end;

begin
end.

In EP, the variant field needs a type identifier, which, of course, also works in GPC:

program EPVariantRecordDemo;

type
  EyeColorType = (Red, Green, Blue, Brown);

  PersonRec = record
    Age : Integer;
  case EyeColor : EyeColorType of
    Red, Green  : (WearsGlasses : Boolean);
    Blue, Brown : (LengthOfLashes : Integer);
  end;

begin
end.

EP's Schema Types including `String'

Schemata are types that depend on one or more variables, called discriminants. They are an ISO-10206 Extended Pascal feature.

type
  RealArray (n: Integer) = array [1 .. n] of Real;
  Matrix (n, m: PositiveInteger) = array [1 .. n, 1 .. m] of Integer;

The type `RealArray' in this example is called a Schema with the discriminant `n'.

To declare a variable of such a type, write:

var
  Foo: RealArray (42);

The discriminants of every global or local schema variable are initialized at the beginning of the procedure, function or program where the schema variable is declared.

Schema-typed variables "know" about their discriminants. Discriminants can be accessed just like record fields:

program Schema1Demo;
type
  PositiveInteger = (*@@ 1 .. MaxInt *) Integer;
  RealArray (n: Integer) = array [1 .. n] of Real;
  Matrix (n, m: PositiveInteger) = array [1 .. n, 1 .. m] of Integer;

var
  Foo: RealArray (42);

begin
  WriteLn (Foo.n)  { yields 42 }
end.

Schemata may be passed as parameters. While types of schema variables must always have specified discriminants (which may be other variables), formal parameters (by reference or by value) may be of a schema type without specified discriminant. In this, the actual parameter may posses any discriminant. The discriminants of the parameters get their values from the actual parameters.

Also, pointers to schema variables may be declared without a discriminant:

program Schema2Demo;
type
  RealArray (n: Integer) = array [1 .. n] of Real;
  RealArrayPtr = ^RealArray;
var
  Bar: RealArrayPtr;
begin
end.

When applying `New' to such a pointer, you must specify the intended value of the discriminant as a parameter:

New (Bar, 137)

As a GNU Pascal extension, the above can also be written as

Bar := New (RealArrayPtr, 137)

The allocated variable behaves like any other schema variable:

program Schema3Demo;
type
  RealArray (n: Integer) = array [1 .. n] of Real;
  RealArrayPtr = ^RealArray;
var
  Bar: RealArrayPtr;
  i: Integer;
begin
  Bar := New (RealArrayPtr, 137);
  for i := 1 to Bar^.n do
    Bar^ [i] := 42
end.

Since the schema variable "knows" its size, pointers to schemata can be disposed just like other pointers:

Dispose (Bar)

Schemata are not limited to arrays. They can be of any type that normally requires constant values in its definition, for instance subrange types, or records containing arrays etc. (Sets do not yet work.)

References to the schema discriminants are allowed, and the with statement is also allowed, so one can say:

program SchemaWithDemo;
type
  RealArray (n : Integer) = array [1 .. n] of Real;
var
  MyArray : RealArray (42);
begin
  WriteLn (MyArray.n);  { writes 42 }
  with MyArray do
    WriteLn (n);        { writes 42 }
end.

Finally, here is a somewhat exotic example. Here, a `ColoredInteger' behaves just like an ordinary integer, but it has an additional property `Color' which can be accessed like a record field.

program SchemaExoticDemo;

type
  ColorType = (Red, Green, Blue);
  ColoredInteger (Color : ColorType) = Integer;

var
  Foo : ColoredInteger (Green);

begin
  Foo := 7;
  if Foo.Color = red then
    Inc (Foo, 2)
  else
    Foo := Foo div 3
end.

An important schema is the predefined `String' schema (according to Extended Pascal). It has one predefined discriminant identifier Capacity. GPC implements the String schema as follows:

type
  String (Capacity : Cardinal) = record
    Length : 0 .. Capacity;
    Chars  : packed array [1 .. Capacity + 1] of Char
  end;

The Capacity field may be directly referenced by the user, the Length field is referenced by a predefined string function Length (Str) and contains the current string length. Chars contains the chars in the string. The Chars and Length fields cannot be directly referenced by a user program.

If a formal value parameter is of type `String' (with or without discriminant), the actual parameter may be either a String schema, a fixed string (character array), a single character, a string literal or a string expression. If the actual parameter is a `String' schema, it is copied for the parameter in the usual way. If it is not a schema, a `String' schema is created automatically, the actual parameter is copied to the new variable and the Capacity field of the new variable is set to the length of the actual parameter.

Actual parameters to `var' parameters of type `String' must be `String' schemata, not string literals or character arrays.

program StringDemo (Output);

type
  SType = String (10);
  SPtr  = ^String;

var
  Str  : SType;
  Str2 : String (100000);
  Str3 : String (20) value 'string expression';
  DStr : ^String;
  ZStr : SPtr;
  Len  : Integer value 256;
  Ch   : Char value 'R';

{ `String' accepts any length of strings }
procedure foo (z : String);
begin
  WriteLn ('Capacity : ', z.Capacity);
  WriteLn ('Length   : ', Length (z));
  WriteLn ('Contents : ', z);
end;

{ Another way to use dynamic strings }
procedure Bar (SLen : Integer);
var
  LString : String (SLen);
  FooStr  : type of LString;
begin
  LString := 'Hello world!';
  Foo (LString);
  FooStr := 'How are you?';
  Foo (FooStr);
end;

begin
  Str  := 'KUKKUU';
  Str2 := 'A longer string variable';
  New (DStr, 1000);  { Select the string Capacity with `New' }
  DStr^ := 'The maximum length of this is 1000 chars';
  New (ZStr, Len);
  ZStr^ := 'This should fit here';
  Foo (Str);
  Foo (Str2);
  Foo ('This is a constant string');
  Foo ('This is a ' + Str3);
  Foo (Ch);  { A char parameter to string routine }
  Foo ('');  { An empty string }
  Foo (DStr^);
  Foo (ZStr^);
  Bar (10000);
end.

In the above example, the predefined procedure New was used to select the capacity of the strings. Procedure Bar also has a string whose size depends of the parameter passed to it and another string whose type will be the same as the type of the first string, using the type of construct.

All string and character types are compatible as long as the destination string is long enough to hold the source in assignments. If the source string is shorter than the destination, the destination is automatically blank padded if the destination string is not of string schema type.

Set Types

set type identifier = set of set element type;

set type identifier is a set of elements from set element type which is either an ordinal type, an enumerated type or a subrange type. Set element representatives are joined together into a set by brackets:

[set element, ..., set element]

`[]' indicates the empty set, which is compatible with all set types. Note: Borland Pascal restricts the maximal set size (i.e. the range of the set element type) to 256, GNU Pascal has no such restriction. The number of elements a set variable is holding can be determined by the intrinsic set function Card (which is a GNU Pascal extension, in Extended Pascal and Borland Pascal you can use SizeOf instead but note the element type size in bytes, then) to the set. There are four intrinsic binary set operations: the union `+', the intersection `*' and the difference `-'. The symmetric difference `><' is an Extended Pascal extension.

See also section Card, section SizeOf

Pointer Types

pointer type identifier = ^type identifier;

A pointer of the type pointer type identifier holds the address at which data of the type type identifier is situated. Unlike other identifier declarations, where all identifiers in definition part have to be declared before, in a pointer type declaration type identifier may be declared after pointer type identifier. The data pointed to is accessed by pointer type variable ^ . To mark an unassigned pointer, the "nil" constant (which stands for "not in list") has to be assigned to it, which is compatible with all pointer types.

type
  ItselfFoo = ^ItselfFoo;  { possible but senseless }

  PInt      = ^Integer;    { Pointer to an Integer }

  PNode     = ^TNode;      { Linked list }
  TNode     = record
    Key      : Integer;
    NextNode : PNode;
  end;

var
  Foo, Bar : PInt;

begin
  Foo := Bar;  { Modify address which foo is holding }
  Foo^ := 5;   { Access data foo is pointing to }
end.

GPC also suports pointers to procedures or function and calls through them. This is a non-standard feature.

program ProcPtrDemo (Output);

type
  ProcPtr = ^procedure (Integer);

var
  PVar : ProcPtr;

procedure WriteInt (i : Integer);
begin
  WriteLn ('Integer: ', i : 1)
end;

begin
  { Let PVar point to function WriteInt }
  PVar := @WriteInt;

  { Call the function by dereferencing the function pointer }
  PVar^ (12345)
end.

See also: section Pointer (Intrinsic).

Procedural and Functional Types

For procedures without a parameter list:

procedure type identifier = procedure name identifier;

or functions:

function type identifier =
       function name identifier: function result type;

For procedures with a parameter list:

procedure type identifier =
       procedure name identifier (parameter list);

or functions:

function type identifier =
       function name identifier (parameter list): function result type;

Procedural types can be used as procedures or functions respectively, but also a value can be assigned to them. Procedural types are a Borland Pascal extension. In Borland Pascal, function result type can only be one of these types: ordinal types, enumerated types, real types, pointer types, the intrinsic Boolean, or the intrinsic String. In GNU Pascal every function result type for procedural types is allowed.

BP has procedural and functional types:

type
  CompareFunction = function (Key1, Key2 : String) : Integer;

function Sort (Compare : CompareFunction);
begin
  ...
end;

Standard Pascal has procedural and functional parameters:

function Sort (function Compare (Key1, Key2 : String) : Integer);
begin
  ...
end;

Both ways have pros and cons, e.g. in BP you can save, compare, trade, etc. procedural values, or build arrays of them, while the SP way does not require a type declaration and prevents problems with uninitialized or invalid pointers (which in BP will usually crash the program).

GPC supports both ways. An important feature of Standard Pascal (but not BP) that GPC also supports is the possibility to pass local routines as procedural or functional parameters, even if the called routine is declared far remote. The called routine can then call the passed local routine and it will have access to the original caller's local variables.

program LocalProceduralParameterDemo;

procedure CallProcedure (procedure Proc);
begin
  Proc
end;

procedure MainProcedure;
var LocalVariable : Integer;

  procedure LocalProcedure;
  begin
    WriteLn (LocalVariable)
  end;

begin
  LocalVariable := 42;
  CallProcedure (LocalProcedure)
end;

begin
  MainProcedure
end.

See also: section The Procedure, section The Function, section Subroutine Parameter List Declaration, section Procedure Call.

Object Types

Under construction.

See also section Object-Orientated Programming

Initial values to type denoters

A type may be initialized to a value of expression when it is declared, like a variable, as in:

program TypeVarInitDemo;
type
  Int10   = Integer value 10;
  FooType = Real;
  MyType  = Char value Pred ('A');
  EType   = (a, b, c, d, e, f, g) value d;

const
  Answer = 42;

var
  ii  : Int10;                    { Value of ii set to 10 }
  ch  : MyType  value Pred ('z');
  aa  : Integer value Answer + 10;
  foo : FooType value Sqr (Answer);
  e1  : EType;                    { value set to d }
  e2  : EType value g;            { value set to g }
begin
end.

Extended Pascal requires the type initializers to be constant expressions. GPC allows any valid expression.

Note, however, that the expressions that affect the size of storage allocated for objects (e.g. the length of arrays) may contain variables only inside functions or procedures.

GPC evaluates the initial values used for the type when an identifier is declared for that type. If a variable is declared with a type-denoter that uses a type-name which already has an initial value the latter initialization has precedence.

@@ GPC does not know how to calculate constant values for math functions in the runtime library at compile time, e.g. `Exp (Sin (2.4567))', so you should not use these kind of expressions in object size expressions. (Extended Pascal allows this.)

Restricted Types

GPC supports `restricted' types, defined in Extended Pascal. A value of a restricted type may be passed as a value parameter to a formal parameter possessing its underlying type, or returned as the result of a function. A variable of a restricted type may be passed as a variable parameter to a formal parameter possessing the same type or its underlying type. No other operations, such as accessing a component of a restricted type value or performing arithmetic, are possible.

program RestrictedDemo;

type
  UnrestrictedRecord = record
    a : Integer;
  end;
  RestrictedRecord = restricted UnrestrictedRecord;

var
  r1 : UnrestrictedRecord;
  r2 : RestrictedRecord;
  i : restricted Integer;
  k : Integer;

  function AccessRestricted (p : UnrestrictedRecord) : RestrictedRecord;
  var URes : UnrestrictedRecord;
  begin
    { The parameter is treated as unrestricted, even though the actual
      parameter may be a restricted object }
    URes.a := p.a;
    { It is legal to assign a return value }
    AccessRestricted := URes;
  end;

begin
  r1.a := 354;

  { Assigning a restricted return value to a restricted object }
  { @@ Verify if this should really be allowed????? }
  r2 := AccessRestricted (r1);

  { Passing a restricted object to unrestericted formal parameter is ok }
  r2 := AccessRestricted (r2);

  {$ifdef BUG}
  { *** The following statements are illegal *** }
  r2.a := 100;    { field access }
  r1 := r2;       { assignment source is restricted }
  r2 := r1;       { assignment target is restricted }
  r1 := AccessRestricted (r2); { assigning a restricted return
                                  value to an unrestricted object }
  i  := 16#ffff;  { assignment target is restricted }
  k  := i + 2;    { arithmetic with restricted value }
  {$endif}
end.

Machine-dependent Type Implementation

Endianness

Endianness means the order in which the bytes of a value larger than one byte are stored in memory. This affects, e.g., integer values and pointers while, e.g., arrays of single-byte characters are not affected. The GPC `String' schema, however, contains `Capacity' and `Length' fields before the character array. These fields are integer values larger than one byte, so the `String' schema is affected by endianness.

Endianness depends on the hardware, especially the CPU. The most common forms are:

• Little-endian Little-endian machines store the least significant byte on the lowest memory address (the word is stored little-end-first). E.g., if the 32 bit value $deadbeef is stored on memory address $1234 on a little-endian machine, the following bytes will occupy the memory positions:
• Address Value
• $1234 $ef
• $1235 $be
• $1236 $ad
• $1237 $de Examples for little-endian machines are Intel and compatible microprocessors and Alpha processors.
• Big-endian Big-endian machines store the most significant byte on the lowest memory address (the word is stored big-end-first). E.g., if the 32 bit value $deadbeef is stored on memory address $1234 on a big-endian machine, the following bytes will occupy the memory positions:
• Address Value
• $1234 $de
• $1235 $ad
• $1236 $be
• $1237 $ef Examples for big-endian machines are the Sparc and Motorola m68k CPU families and most RISC processors. Big-endian byte order is also used in the Internet protocols.

Note: There are processors which can run in both little-endian and big-endian mode, e.g. the MIPS processors. A single program, however, (unless it uses special machine code instructions) will always run in one endianness.

Under normal circumstances, programs do not need to worry about endianness, the CPU handles it by itself. Endianness becomes important when exchanging data between different machines, e.g. via binary files or over a network. To avoid problems, one has to choose the endianness to use for the data exchange. E.g., the Internet uses big-endian data, and most known data formats have a specified endianness (usually that of the CPU on which the format was originally created). If you define your own binary data format, you're free to choose the endianness to use.

To deal with endianness, GPC predefines the symbol `__BYTES_LITTLE_ENDIAN__' on little-endian machines and `__BYTES_BIG_ENDIAN__' on big-endian machines. Besides, the Run Time System defines the constant `BytesBigEndian' as False on little-endian machines and True on big-endian machines.

There are also the symbols `__BITS_LITTLE_ENDIAN__', `__BITS_BIG_ENDIAN__', `__WORDS_LITTLE_ENDIAN__', `__WORDS_BIG_ENDIAN__' and the constants `BitsBigEndian' and `WordsBigEndian' which concern the order of bits within a byte (e.g., in packed records) or of words within multiword-numbers, but these are usually less important.

The Run Time System also contains a number of routines to convert endianness and to read or write data from/to binary files in a given endianness, independent of the CPU's endianness. These routines are described in the RTS reference (see section Pascal declarations for GPC's Run Time System), under `endianness'. The demo program `endiandemo.pas' contains an example on how to use these routines.

Alignment

(Under construction.) @@ ????

Operators

GNU Pascal supports all operators of ISO Pascal and Borland Pascal. In addition, you can define your own operators according to the Pascal-SC (PXSC) syntax.

Built-in Operators

The following table lists all built-in GNU Pascal operators, ordered by precedence: `<' etc. have the lowest precedence, `not' etc. the highest. As usual, the precedence of operators can be superseded with parentheses.

In an assignment statement, `:=' has lower precedence than all operators. (This is rather obvious from the syntax of assignment statements, and is merely noted for programmers familiar with C where `=' is an operator.)

<    =    >    in   <>   >=   <=
+    -    or   +<   -<   +>   ->
*    /    div  mod  and  shl  shr  xor  *<   /<   *>   />
pow  **   ><
not  &    @

The Pascal-SC (PXSC) operators `+<', `-<', `+>', `->', `*<', `/<', `*>', and `/>' are not yet implemented into GNU Pascal but may be defined by the user (see below).

User-defined Operators

GNU Pascal allows the (re-)definition of binary operators according to the Pascal-SC (PXSC) syntax. The following vector addition example illustrates how to do this:

program OperatorDemo;

type
  Vector3 = record
    x, y, z: Real;
  end;

var
  a, b, c: Vector3 = (1, 2, 3);

operator + (u, v: Vector3) w: Vector3;
begin
  w.x := u.x + v.x;
  w.y := u.y + v.y;
  w.z := u.z + v.z;
end;

begin
  c := a + b
end.

Between the closing parenthesis of the argument list and the result variable (`w' in the above example), GPC allows an optional equal sign. This is not allowed in PXSC, but it is consistent with Extended Pascal's function return variable definitions, where the equal sign is obligatory (but also optional in GPC).

The argument types needn't be equal, and the name of the operator may be an identifier instead of a known symbol. You cannot define new symbols in GPC.

The PXSC operators `+>', `+<', etc. for exact numerical calculations currently are not implemented in GPC, but you can define them. Also, the other real-type operators do not meet the requirements of PXSC; a module which fixes that would be a welcome contribution.

Procedure And Function Parameters

Parameters declared as `protected' or `const'

All the following works in GPC:

procedure Foo (protected a, b, c : Integer);    { 3 arguments }
procedure Foo (a, b, c, protected : Integer);   { 4 arguments }
procedure Foo (a, b, protected, c : Integer);   { 4 arguments }
procedure Foo (protected : Integer);            { 1 argument  }
procedure Foo (var protected : Integer);        { 1 argument  }
procedure Foo (protected protected : Integer);  { 1 argument  }

Furthermore, GPC supports const, according to BP, which is equivalent to either protected or protected var, up to the compiler's discretion.

The Standard way to pass arrays of variable size

@@ (Under construction.)

A feature of Standard Pascal level 1.

BP's alternative to Conformant Arrays

Borland Pascal "open array" formal parameters are implemented into GPC. Within the function body, they have integer type index with lower bound 0.

In constrast to conformant arrays (which are not supported by BP), open arrays allow any ordinal type as the index of the actual parameter (which is useful, e.g., if you want to be able to pass values of any enumeration type). However, they lose information about the lower bound (which is a problem, e.g., if you want to return information to the caller that relates to the actual array index, like the function `IOSelect' in the Run Time System does).

Pointer Arithmetics

GPC allows to increment, decrement, compare, and subtract pointers or to use them in `for' loops just like the C language.

GPC implements the address operator @ (a Borland Pascal extension).

program PointerArithmeticDemo;
var
  a: array [1 .. 7] of Char;
  p, q: ^Char;
  i: Integer;

{$X+} { We need extended syntax for pointer arithmetic }

begin
  for p := @A [1] to @A [7] do
    p^ := 'x';

  p := @A [ 7 ];
  q := @A [ 3 ];
  while p > q do
    begin
      p^ := 'y';
      Dec (p)
    end;

  p := @A [7];
  q := @A [3];
  i := q - p;    { yields 4 }
end.

Incrementing a pointer by one means to increment the address it contains by the size of the variable it is pointing to. For typeless pointers (`Pointer'), the address is incremented by one instead.

Similar things hold when decrementing a pointer.

Subtracting two pointers yields the number of variables pointed to between both pointers, i.e. the difference of the addresses divided by the size of the variables pointed to. The pointers must be of the same type.

Type Casts

In some cases, especially when interfacing with other languages, Pascal's strong typing can be an obstacle. To temporarily circumvent this, GPC (and other Pascal compilers) defines explicit "type casts".

There are two kinds of type casts, value type casts and variable type casts.

Value type casts

To convert a value of one data type into another type, you can use the target type like the name of a function that is called. The value to be converted can be a variable or an expression.

An example:

program TypeCastDemo;

var
  Ch: Char;
  i: Integer;

begin
  i := Integer (Ch)
end.

Another, more complicated, example:

program TypeCst2Demo;

type
  CharPtr = ^Char;
  CharArray = array [0 .. 99] of Char;
  CharArrayPtr = ^CharArray;

var
  Foo1, Foo2: CharPtr;
  Bar: CharArrayPtr;

{$X+} { We need extended syntax in order to use ``Succ'' on a pointer }

begin
  Foo1 := CharPtr (Bar);
  Foo2 := CharPtr (Succ (Bar))
end.

However, because of risks involved with type casts, explained below, you should try to avoid type casts whenever possible -- and it should be possible in most cases. For instance, the first example above could use the built-in function "Ord" instead of the type cast:

i := Ord (Ch);

The assignments in the second example could be written in the following way without any type casts:

Foo1 := @Bar^[0];
Foo2 := @Bar^[1];

Value type casting only works between certain types: either between different ordinal types (including integer types), or between different real types, or between different pointer types. In each case, the current value, i.e. the ordinal or numeric value or the address pointed to, respectively, is preserved in the cast.

Note: It is also possible to cast from an integer into a real type. This is a consequence of the fact that integer values are generally automatically converted to real values when needed.

@@ ???? to dereference DOES NOT EXIST Note: In the case of pointers, a warning is issued if the dereferenced target type requires a bigger alignment than the dereferenced source type (see section Alignment).

Variable type casts

It is also possible to temporarily change the type of a variable, without converting its contents in any way. This is called variable type casting.

The syntax is the same as for value type casting. This can be confusing, as the example below shows.

The type-casted variable is still the same variable (memory location) as the original one, just with a different type. Outside of the type cast, the variable keeps its original type.

There are some important differences between value and variable type casting:

• Variable type casting only works on variables, not on expressions.
• The result of a variable type casting is still a variable. Especially, it can be used on the left side of an assignment (as a so-called "lvalue"), or passed by reference to a procedure.
• No values are converted. The contents of the variable, seen as a raw bit pattern, are just interpreted according to the new type. In many cases, this does not make a big difference, e.g. the same ordinal values of different ordinal types have the same bit pattern (provided, the types have the same size), and similarly for different pointer types. However, there are cases where it does make a difference, most notably the completely different internal representation of integer and real types. This is demonstrated in the following example, admittedly a very constructed example, by using an integer and a real type of the same size and trying to cast between them.
• Because bit patterns are just interpreted differently, the source and target type must have the same size. If this is not the case, GPC will give a warning. (@error? see below)
• Beware: Variable type casts might have unexpected effects on different platforms since you cannot rely on a specific way the data is stored (e.g. see section Endianness).

program TrapsOfTypeCastsDemo;

{ Declare a real type and an integer type of the same size, and some
  variables of these types we will need. }

type
  RealType = ShortReal;
  IntegerType = Integer (BitSizeOf (RealType));

var
  i, i1, i2, i3, i4, i5: IntegerType;
  r, r1, r2, r3, r4: RealType;

begin

  { First part: Casting integer into real types. }

  { Start with some integer value }
  i := 42;

  { First attempt to cast. Here, an lvalue is casted, so this must
    be a variable type cast. Therefore, the bit pattern of the value
    of i is transferred unchanged into r1 which results in a silly
    value of r1. }
  IntegerType (r1) := i;

  { Second try. Here we cast an expression -- though a trivial one --,
    rather than a variable. So this can only be a value type cast.
    Therefore, the numeric value is preserved, i.e. r2 = 42.0 . }
  r2 := RealType (i + 0);

  { Third way. In this last example, a variable is casted, and the
    result is used as an expression, not as an lvalue. So this
    could be either a value or variable type cast. However, there
    is a rule that value type casting is preferred if possible.
    So r3 will contain the correct numeric value, too. }
  r3 := RealType (i);

  { Of course, you do not need any casts at all here. A simple
    assignment will work because of the automatic conversion from
    integer to real types. So r4 will also get the correct result. }
  r4 := i;

  { Now the more difficult part: Casting real into integer types. }

  { Start with some real value. }
  r := 41.9;

  { Like the first attempt above, this one does a variable type cast,
    preserving bit patterns, and leaving a silly value in i1. }
  { RealType (i1) := r; }

  { The second try from above does not work, because an expression of
    type real is to be casted into an integer which is not allowed. }
  { i2 := IntegerType (r + 0); }

  { Third way. This looks just like the third way in the first part
    which was a value type cast.
    But -- surprise! Since value type casting is not possible from
    real into integer, this really does a variable type casting,
    and the value of i3 is silly again! This difference in behaviour
    shows some of the hidden traps in type casting. }
  i3 := IntegerType (r);

  { As often, it is possible to avoid type casts altogether and
    convert real types into integers easily by other means, i.e. by
    using the built-in functions ``Round'' or ``Trunc'', depending
    on the mode of rounding one wants. }
  i4 := Round (r); { 42 }
  i5 := Trunc (r); { 41 }

end.

When dealing with objects (see section Object-Orientated Programming), it is often necessary -- and safe -- to cast a pointer to an object into a pointer to a more specialized (derived) object. In future releases, GPC will provide an operator `as' for a safer approach to this problem.

See also: section absolute, section Alignment, section Endianness, section Object-Orientated Programming, section Ord, section Chr, section Round, section Trunc.

Object-Orientated Programming

GNU Pascal follows the object model of Borland Pascal 7.0. The BP object extensions are almost fully implemented into GPC. This includes inheritance, virtual and non-virtual methods, constructors, destructors, pointer compatibility, extended `New' syntax (with constructor call and/or as a Boolean function), extended `Dispose' syntax (with destructor call).

The Borland object model is different from the ISO draft, but it will not be too difficult now to implement that too (plus the Borland Delphi Object Extensions which are quite similar to the ISO draft).

The syntax for an object type declaration is as follows:

program ObjectDemo;

type
  Str100 = String (100);

  FooParentPtr = ^fooParent;
  FooPtr = ^foo;

  FooParent = object
    constructor Init;
    destructor Done; virtual;
    procedure Bar (c: Real); virtual;
    function Baz (b, a, z: Char): Str100;  { not virtual }
  end;

  Foo = object (FooParent)
    x, y: Integer;
    constructor Init (a, b: Integer);
    destructor Done; virtual;
    procedure Bar (c: Real); virtual;  { overrides `FooParent.Bar' }
    z: Real;  { GPC extension: data fields after methods }
    function Baz: Boolean;  { new function }
  end;

constructor FooParent.Init;
begin
  WriteLn ('FooParent.Init')
end;

destructor FooParent.Done;
begin
  WriteLn ('I''m also done.')
end;

procedure FooParent.Bar (c : Real);
begin
  WriteLn ('FooParent.Bar (', c, ')')
end;

function FooParent.Baz (b, a, z : Char) = s : Str100;
begin
  WriteStr (s, 'FooParent.Baz (', b, ', ', a, ', ', z, ')')
end;

constructor Foo.Init (a, b : Integer);
begin
  inherited Init;
  x := a;
  y := b;
  z := 3.4;
  FooParent.Bar (1.7)
end;

destructor Foo.Done;
begin
  WriteLn ('I''m done.');
  inherited Done
end;

procedure Foo.Bar (c: Real);
begin
  WriteLn ('Foo.Bar (', c, ')')
end;

function Foo.Baz: Boolean;
begin
  Baz := True
end;

var
  Ptr: FooParentPtr;

begin
  Ptr := New (FooPtr, Init (2, 3));
  Ptr^.Bar (3);
  Dispose (Ptr, Done);
  New (Ptr, Init);
  with Ptr^ do
    WriteLn (Baz ('b', 'a', 'z'))
end.

Remarks:

• Data fields and methods can be mixed.
• GPC currently does not support `private' declarations and such. These directives are syntactically accepted but ignored.
• Constructors and destructors are ordinary functions, internally. When a constructor is called, GPC creates some inline code to initialize the object; destructors do nothing special.
• Currently, the compiler does not check whether all declared methods are really implemented. Unimplemented methods will produce linking errors when they are called or if they are virtual.

A pointer to `FooParent' may be assigned the address of a `Foo' object. A `FooParent' formal `var' parameter may get a `Foo' object as the actual parameter. In such cases, a call to a `virtual' method calls the child's method, whereas a call to a non-`virtual' method selects the parent's one:

var
  MyFooParent: FooParentPtr;
  SomeFoo: Foo;

[...]

  SomeFoo.Init (4, 2);
  MyFooParent := @SomeFoo;
  MyFooParent^.bar (3.14);  { calls `foo.bar' }
  MyFooParent^.baz ('b', 'a', 'z');  { calls `fooParent.baz' }
  if SomeFoo.baz then  { calls `foo.baz' }
    WriteLn ('Baz!');

In a method, an overwritten method of a parent object can be called either prefixing it with the parent type name, or using the keyword `inherited':

procedure Foo.Bar (c : Real);
begin
  z := c;
  inherited bar (z)  { or: FooParent.Bar (z) }
end;

Use `FooParent.bar (z)' if you want to be sure that this method is called, even if somebody decides not to derive `foo' directly from `fooParent' but to have some intermediate object. If you want to call the method `bar' of the immediate parent -- whether it be `fooParent' or whatever -- use `inherited bar (z)'.

To allocate an object on the heap, use `New' in one of the following manners:

var
  MyFoo: FooPtr;

  [...]

  New (MyFoo, Init (4, 2));

  MyFooParent := New (FooPtr, Init (4, 2))

The second possibility has the advantage that `MyFoo' needn't be a `FooPtr' but can also be a `FooParentPtr', i.e. a pointer to an ancestor of `foo'.

Destructors can and should be called within Dispose:

Dispose (MyFooParent, Fini)

Compiler Directives And The Preprocessor

GPC, like UCSD Pascal and BP, treats comments beginning with a `$' immediately following the opening `{' or `(*' as a compiler directive. As in Borland Pascal, {$...} and (*$...*) are equivalent. When a single character plus a `+' or `-' follows, this is also called a compiler switch. All of these directives are case-insensitive (but some of them have case-sensitive arguments). Directives are local and can be changed during one compilation (except include files etc. where this makes no sense).

In general, compiler directives are compiler-dependent. (E.g., only the include directive {$I FileName} is common to UCSD and BP.) Because of BP's popularity, GPC supports all of BP's compiler directives (and ignores those that are unnecessary on its platforms -- these are those not listed below), but it knows a lot more directives.

Some BP directives are -- of course not by chance -- just an alternative notation for C preprocessor directives. But there are differences: BP's conditional definitions (`{$define Foo}') go into another name space than the program's definitions. Therefore you can define conditionals and check them via {$ifdef Foo}, but the program will not see them as an identifier `Foo', so macros do not exist in Borland Pascal.

GPC does support macros, but disables this feature when the `--no-macros' option or the dialect option `--borland-pascal' or `--delphi' is given, to mimic BP's behaviour. Therefore, the following program will react differently when compiled with GPC either without special options or with, e.g., the `--borland-pascal' option (and in the latter case, it behaves the same as when compiled with BP).

program MacroDemo;

const Foo = 'Borland Pascal';

{$define Foo 'Default'}

begin
  WriteLn (Foo)
end.

Of course, you should not rely on such constructs in your programs. To test if the program is compiled with GPC, you can test the `__GPC__' conditional, and to test the dialect used in GPC, you can test conditionals like `__BORLAND_PASCAL__'.

In general, almost every GPC specific command line option (see section GPC options besides those of GCC.) can be turned into a compiler directive (exceptions are those options that contain directory names, such as `--unit-path', because they refer to the installation on a particular system, and therefore should be set system-wide, rather than in a source file):

--foo       {$foo}
--no-foo    {$no-foo}
-Wbar       {$W bar}     { note the space after the `W' }
-Wno-bar    {$W no-bar}

The following table lists some such examples as well as all those directives that do not correspond to command-line options or have syntactical alternatives (for convenience and/or BP compatibility).

--[no-]short-circuit   $B+ $B- like in Borland Pascal:
                               $B- means short-circuit Boolean
                               operators; $B+ complete evaluation

--[no-]io-checking     $I+ $I- like in Borland Pascal:
                               enable/disable I/O checking

--[no-]stack-checking  $S+ $S- like in Borland Pascal:
                               enable/disable stack checking

--[no-]typed-address   $T+ $T- like in Borland Pascal:
                               make the result of the address
                               operator and the Addr function a
                               typed or untyped pointer

-W[no-]warnings        $W+ $W- enable/disable warnings. Note: in
                               `--borland-pascal' mode, the
                               short version is disabled because
                               $W+/$W- has a different meaning in
                               Borland Pascal (which can safely be
                               ignored in GPC), but the long version
                               is still available.

--[no-]extended-syntax $X+ $X- mostly like in Borland Pascal:
                               enable/disable extended syntax
                               (ignore function return values,
                               operator definitions, `PChar',
                               pointer arithmetic, ...)

--borland-pascal               disable or warn about GPC features
--extended-pascal              not supported by the standard or
--pascal-sc                    dialect given, do not warn about its
etc.                           ``dangerous'' features (especially BP).
                               The dialect can be changed during one
                               compilation via directives like,
                               e.g., `{$borland-pascal}'.

{$M Hello!}                    write message `Hello!' to
                               standard error during compilation. In
                               `--borland-pascal' mode, it is
                               ignored it if only numbers follow
                               (for compatibility to Borland
                               Pascal's memory directive)

{$define FOO}                  like in Borland Pascal:
or                             define FOO (for conditional compilation)
{$CIDefine FOO}                (case-insensitively)

--cidefine=FOO                 the same on the command line

{$CSDefine FOO}                define FOO case-sensitively

-D FOO                         the same on the command line
or                             Note: `--define' on the command
--csdefine=FOO                 line is case-sensitive like in GCC,
or                             but `{$define}' in the source code
--define=FOO                   is case-insensitive like in BP

{$define loop while True do}   define `loop' to be `while True do'
or                             as a macro like in C. The name of the
{$CIDefine loop ...}           macro is case-insensitive. Note:
                               Macros are disabled in
                               `--borland-pascal' mode because BP
                               doesn't support macros.

--cidefine="loop=..."          the same on the command line

{$CSDefine loop ...}           define a case-sensitive macro

--csdefine="loop=..."          the same on the command line
or
--define="loop=..."

{$I FileName}                  like in Borland Pascal:
                               include `filename.pas'
                               (the name is converted to lower case)

{$undef FOO}                   like in Borland Pascal: undefine FOO

{$ifdef FOO}                   conditional compilation
  ...                          (like in Borland Pascal).
{$else}                        Note: GPC predefines the symbol
  ...                          `__GPC__' (with two leading
{$endif}                       and trailing underscores).

{$include "filename.pas"}      include (case-sensitive)

{$include <filename.pas>}      the same, but don't search in the
                               current directory

...and all the other C preprocessor directives.

You also can use the preprocessor directives in C style, e.g. `#include', but this is deprecated because of possible confusion with Borland Pascal style `#42' character constants. Besides, in the Pascal style, e.g. `{$include "foo.bar"}', there may be more than one directive in the same line.

Routines Built-in or in the Run Time System

In this section we describe the routines and other declarations that are built into the compiler or part of the Run Time System, sorted by topics.

File Routines

Extended Pascal treats files quite differently from Borland Pascal. GPC supports both forms, even in mixed ways, and provides many extensions.

@@ A lot missing here

• An example of getting the size of a file (though a `FileSize' function is already built-in).

  function FileSize(filename : String) : LongInt;
  var
    f : bindable file [0..MaxInt] of char;
    b : BindingType;
  begin
    unbind(f);
    b := binding (f);
    b.Name := filename;
    bind(f, b);
    b := binding(f);
    SeekRead(f, 0);
    if empty(f)
      then  file_size := 0
      else  file_size := LastPosition(f) + 1;
    unbind(f);
  end;
  

  Prospero's Extended Pascal has a bug in this case. Replace the MaxInt in the type definition of f by a sufficiently large integer. GNU Pascal works correct in this case.
• GPC implements lazy text file I/O, i.e. does a Put as soon as possible and a Get as late as possible. This should avoid most of the problems sometimes considered to be the most stupid feature of Pascal. When passing a file buffer as parameter the buffer is validated when the parameter is passed.
• GPC supports direct access files. E.g., declaring a type for a file that contains 100 integers.

  program DirectAccessFileDemo;
  type
    DFile = file [1 .. 100] of Integer;
  var
    F : DFile;
    P, N : 1 .. 100;
  begin
    Rewrite (F);
    P := 42;
    N := 17;
    SeekWrite (F, P);
    Write (F, N)
  end.
  

  The following direct access routines may be applied to a direct access file:

  SeekRead (F, N); { Open file in inspection mode, seek to record N }

  SeekWrite (F, N); { Open file in generation mode, seek to record N }

  SeekUpdate (F, N); { Open file in update mode, seek to record N }

  Update (F); { Writes F^, position not changed. F^ kept. }

  p := Position (F); { Return current record number }

  p := LastPosition (F); { Return the last record number in file }

  If the file is open for inspection or update, Get may be applied. If the file is open for generation or update, Put may be applied.
• In BP, you can associate file variables with files using the `Assign' procedure which GPC supports.

  program AssignTextDemo;
  var
    t : Text;
    Line : String (4096);
  begin
    Assign (t, 'mytext.txt');
    Reset (t);
    while not EOF (t) do
      begin
        ReadLn (t, Line);
        WriteLn (Line)
      end
  end.
  

• In Extended Pascal, files are considered entities external to your program. External entities, which don't need to be files, need to be bound to a variable your program. Any variable to which external entities can be bound needs to be declared `bindable'. Extended Pascal has the `Bind' function that binds a variable to an external entity as well as `Unbind' to undo a binding and the function `Binding' to return the current binding of a variable. GPC supports these routines when applied to files. The compiler will reject binding of other object types. Only the fields `Bound' and `Name' of the predefined record type `BindingType' are required by Extended Pascal. Additionally, GPC implements some extensions. For the full definition of `BindingType', see section BindingType. The following is an example of binding:

  program BindingDemo (Input, Output, f);
  
  var
    f : bindable Text;
    b : BindingType;
  
  procedure BindFile (var f : Text);
  var
    b : BindingType;
  begin
    Unbind (f);
    b := Binding (f);
    repeat
      Write ('Enter a file name: ');
      ReadLn (b.Name);
      Bind (f, b);
      b := Binding (f);
      if not b.Bound then
        WriteLn ('File not bound -- try again.')
    until b.Bound
  end;
  
  begin
    BindFile (f);
    { Now the file f is bound to an external file. We can use the
      implementation defined fields of BindingType to check if the
      file exists and is readable, writable or executable. }
    b := Binding (f);
    Write ('The file ');
    if b.Existing then
      WriteLn ('exists.')
    else
      WriteLn ('does not exist.');
    Write ('It is ');
    if not b.Readable then Write ('not ');
    Write ('readable, ');
    if not b.Writable then Write ('not ');
    Write ('writable and ');
    if not b.Executable then Write ('not ');
    WriteLn ('executable.')
  end.
  

Note that Prospero's Pascal defaults to creating the file if it does not exists! You need to use Prospero's local addition of setting b.Existing to True to work-around this. GPC does not behave like this.

String Operations

In the following description, s1 and s2 may be arbitrary string expressions, s is a variable of string type.

WriteStr (s, write-parameter-list)

ReadStr (s1, read-parameter-list)

Write to a string and read from a string. The parameter lists are identical to `Write'/`Read' from Text files. The semantics is closely modeled after file I/O.

Index (s1, s2)

If s2 is empty, return 1 else if s1 is empty return 0 else returns the position of s2 in s1 (an integer).

Length (s1)

Return the length of s1 (an integer from 0 .. s1.Capacity).

Trim (s1)

Returns a new string with spaces stripped of the end of s.

SubStr (s1, i)

SubStr (s1, i, j)

Return a new substring of s1 that contains j characters starting from i. If j is missing, return all the characters starting from i.

EQ (s1, s2)

NE (s1, s2)

LT (s1, s2)

LE (s1, s2)

GT (s1, s2)

GE (s1, s2)

Lexicographic comparisons of s1 and s2. Returns a boolean result. Strings are not padded with spaces.

s1 = s2

s1 <> s2

s1 < s2

s1 <= s2

s1 > s2

s1 >= s2

Lexicographic comparisons of s1 and s2. Returns a boolean result. The shorter string is blank padded to length of the longer one, but only in `--extended-pascal' mode.

GPC supports string catenation with the + operator or the `Concat' function. All string-types are compatible, so you may catenate any chars, fixed length strings and variable length strings.

program ConcatDemo (Input, Output);

var
  Ch   : Char;
  Str  : String (100);
  Str2 : String (50);
  FStr : packed array [1 .. 20] of Char;

begin
   Ch := '$';
   FStr := 'demo';  { padded with blanks }
   Write ('Give me some chars to play with: ');
   ReadLn (Str);
   Str := '^' + 'prefix:' + Str + ':suffix:' + FStr + Ch;
   WriteLn (Concat ('Le', 'ng', 'th'), ' = ', Length (Str));
   WriteLn (Str)
end.

Note: The length of strings in GPC is limited only by the range of `Integer' (at least 32 bits, i.e., 2 GB), or the available memory, whichever is smaller. :-)

When trying to write programs portable to other EP compilers, it is however save to assume a limit of about 32 KB. At least Prospero's Extended Pascal compiler limits strings to 32760 bytes. DEC Pascal limits strings to 65535 bytes.

Accessing Command Line Arguments

GPC supports access to the command line arguments with the BP compatible ParamStr and ParamCount functions.

• ParamStr [0] is the program name,
• ParamStr [1] .. ParamStr [ParamCount] are the arguments.

The program below accesses the command line arguments.

program CommandLineArgumentsDemo (Output);

var
  Counter : Integer;

begin
  WriteLn ('This program displays command line arguments one per line.');
  for Counter := 0 to ParamCount do
    WriteLn ('Command line argument #', Counter, ' is `',
             ParamStr (Counter), '''')
end.

Memory Management Routines

Besides the standard `New' and `Dispose' routines, GPC also allows BP style dynamic memory management with GetMem and FreeMem:

GetMem (MyPtr, 1024);
FreeMem (MyPtr, 1024);

GPC also supports function style call to GetMem:

MyPtr := GetMem (1024);

(see also: New in context of Object Orientated Programming)

One somehow strange feature of Borland is not supported: You cannot free parts of a variable with FreeMem, while the rest is still used and can be freed later by another FreeMem call:

program PartialFreeMemDemo;

type
  Vector = array [0 .. 1023] of Integer;
  VecPtr = ^Vector;

var
  p, q : VecPtr;

begin
  GetMem (p, 1024 * SizeOf (Integer));
  q := VecPtr (@p^ [512]);

  { ... }

  FreeMem (p, 512 * SizeOf (Integer));

  { ... }

  FreeMem (q, 512 * SizeOf (Integer));
end.

Operations for Integer and Ordinal Types

• Bit manipulations: The BP style bit shift operators shl and shr exist in GPC as well as bitwise and, or, xor and not for integer values.

  2#100101 and (1 shl 5) = 2#100000
  

  GPC also supports and, or, xor and not as procedures:

  program BitOperatorProcedureDemo;
  var x : Integer;
  begin
    x := 7;
    and (x, 14);  { sets x to 6 }
    xor (x, 3);   { sets x to 5 }
  end.
  

• Succ, Pred: The standard functions `Succ' and `Pred' exist in GPC and accept a second parameter.
• Increment, decrement: The BP built-in Procedures Inc and Dec exist in GPC.

  program IncDecDemo;
  var
    i : Integer;
    c : Char;
  begin
    Inc (i);     { i := i + 1; }
    Dec (i, 7);  { i := i - 7; }
    Inc (c, 3);  { c := Succ (c, 3); }
  end.
  

• Min, Max: These are a GNU extension and work for reals as well as for ordinal types. Mixing reals and integers is okay, the result is real then.

Complex Number Operations

@@ A lot of details missing here

• binary operators +, -, *, / and unary -, +
• exponentiation operators (pow and **)
• functions (Sqr, ArcTan, SqRt, Exp, Ln, Sin, Cos)
• number info with Re, Im and Arg functions
• numbers constructed by Cmplx or Polar

The following sample programs illustrates most of the Complex type operations.

program ComplexOperationsDemo (Output);

var
  z1, z2 : Complex;
  Len, Angle : Real;

begin
  z1 := Cmplx (2, 1);
  WriteLn;
  WriteLn ('Complex number z1 is: (', Re (z1) : 1, ',', Im (z1) : 1, ')');
  WriteLn;
  z2 := Conjugate(z1); { GPC extension }
  WriteLn ('Conjugate of z1 is: (', Re (z2) : 1, ',', Im (z2) : 1, ')');
  WriteLn;
  Len   := Abs (z1);
  Angle := Arg (z1);
  WriteLn ('The polar representation of z1 is: Length=', Len : 1,
           ', Angle=', Angle : 1);
  WriteLn;
  z2 := Polar (Len, Angle);
  WriteLn ('Converting (Length, Angle) back to (x, y) gives: (',
           Re (z2) : 1, ',', Im (z2) : 1, ')');
  WriteLn;
  WriteLn ('The following operations operate on the complex number z1');
  WriteLn;
  z2 := ArcTan (z1);
  WriteLn ('arctan (z1) = (', Re (z2), ', ', Im (z2), ')');
  WriteLn;
  z2 := z1 ** 3.141;
  WriteLn ('z1 ** 3.141 =', Re (z2), ', ', Im (z2), ')');
  WriteLn;
  z2 := Sin (z1);
  WriteLn ('Sin (z1) = (', Re (z2), ', ', Im (z2), ')');
  WriteLn ('(Cos, Ln, Exp, SqRt and Sqr exist also.)');
  WriteLn;
  z2 := z1 pow 8;
  WriteLn ('z1 pow 8 = (', Re (z2), ', ', Im (z2), ')');
  WriteLn;
  z2 := z1 pow (-8);
  WriteLn ('z1 pow (-8) = (', Re (z2), ', ', Im (z2), ')');
end.

Set Operations

@@ A lot missing here

GPC supports Standard Pascal set operations. In addition it supports the Extended Pascal set operation symmetric difference

(set1 >< set2) operation whose result consists of those elements which are in exactly one of the operannds.

It also has a function that counts the elements in the set: `a := Card (set1)'.

Date And Time Routines

procedure GetTimeStamp (var t : TimeStamp);

function Date (t : TimeStamp) : packed array [1 .. DateLength] of Char;

function Time (t : TimeStamp) : packed array [1 .. TimeLength] of Char;

DateLength and TimeLength are implementation dependent constants.

GetTimeStamp (t) fills the record `t' with values. If they are valid, the Boolean flags are set to True.

TimeStamp is a predefined type in the Extended Pascal standard. It may be extended in an implementation, and is indeed extended in GPC. For the full definition of `TimeStamp', see section TimeStamp.

Interfacing with Other Languages

The standardized GNU compiler back-end makes it relatively easy to share libraries between GNU Pascal and other GNU compilers. On Unix-like platforms (not on Dos-like platforms), the GNU compiler back-end usually complies to the standards defined for that system, so communication with other compilers should be easy, too.

In this chapter we discuss how to import libraries written in other languages, and how to import libraries written in GNU Pascal from other languages. While the examples will specialize to compatibility to GNU C, generalization is straightforward if you are familiar with the other language in question.

Importing Libraries from Other Languages

To use a function written in another language, you need to provide an external declaration for it -- either in the program, or in the interface part of a unit, or an interface module.

Let's say you want to use the following C library from Pascal:

File `callc.c':

#include <unistd.h>
#include "callc.h"

int foo = 1;

void bar (void)
{
  sleep (foo);
}

File `callc.h':

/* Actually, we wouldn't need this header file, and could instead
   put these prototypes into callc.c, unless we want to use callc.c
   also from other C source files. */

extern int foo;
extern void bar (void);

Then your program can look like this:

program CallCDemo;

{$L callc.c}  { Or: `callc.o' if you don't have the source }

var
  foo : Integer; asmname 'foo'; external;

procedure Bar; asmname 'bar';

begin
  foo := 42;
  Bar
end.

Or, if you want to provide a `CallCUnit' unit:

unit CallCUnit;

interface

var
  foo : Integer; asmname 'foo'; external;

procedure Bar; asmname 'bar';

implementation

{$L callc.c}  { Or: `callc.o' if you don't have the source }

end.

program CallCUDemo;

uses CallCUnit;

begin
  foo := 42;
  Bar
end.

You can either link your program manually with `callc.o' or put a compiler directive `{$L callc.o}' into your program or unit, and then GPC takes care of correct linking. If you have the source of the C library (you always have it if it is Free Software), you can even write `{$L callc.c}' in the program (like above). Then GPC will also link with `callc.o', but in addition GPC will run the C compiler whenever `callc.c' has changed if `--automake' is given, too.

While it is convenient for most applications, there is no must to give the C function `bar' the name `Bar' in Pascal; you can name it as you like.

For external functions completely written in lowercase there is the shortcut `C' or `C_language' for `asmname 'bar''. For external functions written with one uppercase letter and the others in lowercase, you can use `external' or `extern' instead of `asmname 'Bar''. Since GPC internally converts all identifiers to this notation, `external' is the natural choice when importing other Pascal functions.

Caution: This syntax (`C', `asmname' and such) is subject to change.

It is important that data types of both languages are mapped correctly onto each other. C's `int', for instance, translates to GPC's `Integer', and C's `unsigned long' to `MedCard'. For a complete list of integer types with their C counterparts, see section Integer Types.

In some cases it can be reasonable to translate a C pointer parameter to a Pascal `var' parameter. Since const parameters in GPC can be passed by value or by reference internally, possibly depending on the system, `const foo *' parameters to C functions cannot reliably declared as `const' in Pascal. However, Extended Pascal's `protected var' can be used since this guarantees passing by reference.

Some libraries provide a `main' function and require your program's "main" to be named differently. To achive this with GPC, invoke it with an option `--gpc-main="GPCmain"' (where `GPCmain' is an example how you might want to name the program). You can also write it into your source as a directive `{$gpc-main="GPCmain"}'.

Exporting GPC Libraries to Other Languages

The `.o' files produced by GPC are in the same format as those of all other GNU compilers, so there is no problem in writing libraries for other languages in Pascal. To use them, you will need to write kind of interface -- a header file in C. However there are some things to take into account, especially if your Pascal unit exports objects:

• By default, GPC capitalizes the first letter (only) of each identifier, so `procedure FooBAR' must be imported as `extern void Foobar()' from C.
• If you want to specify the external name explicitly, use `asmname':

  procedure FooBAR; asmname 'FooBAR';
  { Works like a `forward' declaration }
  
  procedure FooBAR;
  begin
    WriteLn ('FooBAR')
  end;
  

  This one can be imported from C with `extern void FooBar()'.
• Objects are "records" internally. They have an implicit `vmt' field which contains a pointer to the "virtual method table". This table is another record of the following structure:

  type
    VMT = record
      ObjectSize: PtrInt;     { Size of object in bytes }
      NegObjectSize: PtrInt;  { Negated size }
      Methods: array [1 .. n] of procedure;
        { Pointers to the virtual methods. The entries are of the
           repective procedure or function types. }
    end;
  

  You can call a virtual method of an object from C if you explicitly declare this `struct' and explicitly dereference the `Fun' array. The VMT of an object `FooBAR' is an external (in C sense) variable `vmt_Foobar' internally.
• Methods of objects are named `Myobject_Mymethod' (with exactly two capital letters) internally.
• If you want to put a program in a library for some reason, and you want to give the `main' program an internal name different from `main', call GPC with the command-line option `--gpc-main="GPCmain"' (see the previous subsection).

Notes for Debugging

• The GNU debugger, `gdb', does not yet understand Pascal sets, files or subranges. Now `gdb' allows you to debug these things, even though it does not yet understand some stabs.
• Forward referencing pointers generate debug info that appears as generic pointers.
• No information of `with' statements is currently given to the debugger.
• When debugging, please note that the Initial Letter In Each Identifier Is In Upper Case And The Rest Are In Lower Case, unless explicitly overriden with `asmname' (see section asmname) or a similar directive. This is to reduce name clashes with `libc.a' and other possible libraries.
• All visible GPC Run Time System routines have linker names starting with `_p_'.
• The linker name of the main program is `pascal_main_program'. This is done because ISO Standard wants to have the program name in a separate name space.

Pascal declarations for GPC's Run Time System

Below is a Pascal source of the declarations in GPC's Run Time System (RTS). A file `gpc.pas' with the same contents is included in the GPC distribution in a `units' subdirectory of the directory containing `libgcc.a'. (To find out the correct directory for your installation, type `gpc --print-file-name=units' on the command line.)

{
Pascal declarations of the GPC Run Time System that are visible to
each program.

This unit contains Pascal declarations of many RTS routines which
are not built into the compiler and can be called from programs.
Don't copy the declarations from this unit into your programs, but
rather include this unit with a `uses' statement. The reason is that
the internal declarations, e.g. the `asmnames', may change, and this
unit will be changed accordingly. @@In the future, this unit might
be included into every program automatically, so there will be no
need for a `uses' statement to make the declarations here available.

Note about `protected var' parameters:
Since const parameters in GPC may be passed by value *or* by
reference internally, possibly depending on the system, `const foo*'
parameters to C functions *cannot* reliably declared as `const' in
Pascal. However, Extended Pascal's `protected var' can be used since
this guarantees passing by reference.

Copyright (C) 1998-2001 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-}

module GPC interface;

export
  GPC = all;
  GPC_SP = (eread (*@@not really, but an empty export doesn't
  work*));
  GPC_EP = (eread (*@@not really, but an empty export doesn't
  work*));
  GPC_BP = (MaxLongInt, ExitCode, ErrorAddr, Pos);
  GPC_Delphi = (MaxLongInt, Int64, InitProc, EConvertError,
                ExitCode, ErrorAddr, Pos, SetString, StringOfChar,
                TextFile, AssignFile, CloseFile);

const
  MaxLongInt = High (LongInt);

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

type
  Int64 = Integer (64);

var
  InitProc : ^procedure; external; asmname '_p_initproc';

{ ====================== MEMORY MANAGEMENT ======================= }

{ Heap manipulation, from heap.c }

{ GPC implements both Mark/Release and Dispose. Both can be mixed
  freely
  in the same program. Dispose should be preferred, since it's
  faster. }

{ C heap management routines. NOTE: if Release is used anywhere in
  the program, CFreeMem and CReAllocMem may not be used for pointers
  that were not allocated with CGetMem. }
function  CGetMem     (Size : SizeType) : Pointer; asmname 'malloc';
procedure CFreeMem    (aPointer : Pointer); asmname 'free';
function  CReAllocMem (aPointer : Pointer; NewSize : SizeType) :
  Pointer; asmname 'realloc';

type
  GetMemType     = ^function (Size : SizeType) : Pointer;
  FreeMemType    = ^procedure (aPointer : Pointer);
  ReAllocMemType = ^function (aPointer : Pointer; NewSize :
  SizeType) : Pointer;

{ These variables can be set to user-defined routines for memory
  allocation/deallocation. GetMemPtr may return nil when
  insufficient memory is available. GetMem/New will produce a
  runtime error then. }
var
  GetMemPtr     : GetMemType; asmname '_p_getmem_ptr'; external;
  FreeMemPtr    : FreeMemType; asmname '_p_freemem_ptr'; external;
  ReAllocMemPtr : ReAllocMemType; asmname '_p_reallocmem_ptr';
  external;

  { Points to the lowest byte of heap used }
  HeapBegin : Pointer; asmname '_p_heap_begin'; external;

  { Points to the highest byte of heap used }
  HeapHigh  : Pointer; asmname '_p_heap_high'; external;

const
  UndocumentedReturnNil = Pointer (- 1);

{ Calls the procedure Proc for each block that would be released
  with `Release (aMark)'. aMark must have been marked with Mark. For
  an example of its usage, see the HeapMon unit. }
procedure ForEachMarkedBlock (aMark : Pointer; procedure Proc
  (aPointer : Pointer; aSize : SizeType));
  asmname '_p_foreachmarkedblock';

procedure ReAllocMem (var aPointer : Pointer; NewSize : SizeType);
  asmname '_p_reallocmem';

{ Routines to handle endianness, from endian.pas }

{ Boolean constants about endianness and alignment }

const
  BitsBigEndian  = {$ifdef __BITS_LITTLE_ENDIAN__} False
                   {$else}{$ifdef __BITS_BIG_ENDIAN__} True
                   {$else}{$error Bit endianness is not defined!}
                   {$endif}{$endif};

  BytesBigEndian = {$ifdef __BYTES_LITTLE_ENDIAN__} False
                   {$else}{$ifdef __BYTES_BIG_ENDIAN__} True
                   {$else}{$error Byte endianness is not defined!}
                   {$endif}{$endif};

  WordsBigEndian = {$ifdef __WORDS_LITTLE_ENDIAN__} False
                   {$else}{$ifdef __WORDS_BIG_ENDIAN__} True
                   {$else}{$error Word endianness is not defined!}
                   {$endif}{$endif};

  NeedAlignment  = {$ifdef __NEED_ALIGNMENT__} True
                   {$else} False {$endif};

{ Convert single variables from or to little or big endian format.
  This only works for a single variable or a plain array of a simple
  type. For more complicated structures, this has to be done for
  each component separately! Currently, ConvertFromFooEndian and
  ConvertToFooEndian are the same, but this might not be the case on
  middle-endian machines. Therefore, we provide different names. }
procedure ReverseBytes            (var Buf; ElementSize, Count :
  SizeType); asmname '_p_reversebytes';
procedure ConvertFromLittleEndian (var Buf; ElementSize, Count :
  SizeType); asmname '_p_convertlittleendian';
procedure ConvertFromBigEndian    (var Buf; ElementSize, Count :
  SizeType); asmname '_p_convertbigendian';
procedure ConvertToLittleEndian   (var Buf; ElementSize, Count :
  SizeType); asmname '_p_convertlittleendian';
procedure ConvertToBigEndian      (var Buf; ElementSize, Count :
  SizeType); asmname '_p_convertbigendian';

{ Read a block from a file and convert it from little or
  big endian format. This only works for a single variable or a
  plain array of a simple type, note the comment for
  `ConvertFromLittleEndian' and `ConvertFromBigEndian'. }
(*@@iocritical*)procedure BlockReadLittleEndian   (var aFile : File;
  var   Buf; ElementSize, Count : SizeType);
  asmname '_p_blockread_littleendian';
(*@@iocritical*)procedure BlockReadBigEndian      (var aFile : File;
  var   Buf; ElementSize, Count : SizeType);
  asmname '_p_blockread_bigendian';

{ Write a block variable to a file and convert it to little or big
  endian format before. This only works for a single variable or a
  plain array of a simple type. Apart from this, note the comment
  for `ConvertToLittleEndian' and `ConvertToBigEndian'. }
(*@@iocritical*)procedure BlockWriteLittleEndian  (var aFile : File;
  const Buf; ElementSize, Count : SizeType);
  asmname '_p_blockwrite_littleendian';
(*@@iocritical*)procedure BlockWriteBigEndian     (var aFile : File;
  const Buf; ElementSize, Count : SizeType);
  asmname '_p_blockwrite_bigendian';

{ Read and write strings from/to binary files, where the length is
  stored in the given endianness and with a fixed size (64 bits),
  and therefore is independent of the system. }
(*@@iocritical*)procedure ReadStringLittleEndian  (var f : File; var
  s : String); asmname '_p_ReadStringLittleEndian';
(*@@iocritical*)procedure ReadStringBigEndian     (var f : File; var
  s : String); asmname '_p_ReadStringBigEndian';
(*@@iocritical*)procedure WriteStringLittleEndian (var f : File;
  const s : String); asmname '_p_WriteStringLittleEndian';
(*@@iocritical*)procedure WriteStringBigEndian    (var f : File;
  const s : String); asmname '_p_WriteStringBigEndian';

{ =================== STRING HANDLING ROUTINES =================== }

{ String handling routines, from string.pas }

type
  AnyFile = Text; (*@@ create `AnyFile' parameters*)
  PAnyFile = ^AnyFile;

{ TString is a string type that is used for function results and
  local variables, as long as undiscriminated strings are not
  allowed there. The default size of 2048 characters should be
  enough for file names on any system, but can be changed when
  necessary. It should be at least as big as MAXPATHLEN. }

const
  TStringSize = 2048;
  SpaceCharacters = [' ', #9];
  NewLine = "\n"; { the separator of lines within a string }
  LineBreak = {$ifdef __OS_DOS__} "\r\n" {$else} "\n" {$endif};
  { the separator of lines within a file }

type
  TString    = String (TStringSize);
  TStringBuf = packed array [0 .. TStringSize] of Char;
  PString    = ^String;
  CharSet    = set of Char;
  PCStrings  = ^TCStrings;
  TCStrings  = array [0 .. MaxVarSize div SizeOf (CString)] of
  CString;

var
  CParamCount : Integer; asmname '_p_argc'; external;
  CParameters : PCStrings; asmname '_p_argv'; external;

function  MemCmp      (const s1, s2; Size : SizeType) : Integer;
  asmname 'memcmp';
function  MemComp     (const s1, s2; Size : SizeType) : Integer;
  asmname 'memcmp';
function  MemCompCase (const s1, s2; Size : SizeType) : Boolean;
  asmname '_p_memcmpcase';

procedure UpCaseString    (var s : String);
  asmname '_p_upcase_string';
procedure LoCaseString    (var s : String);
  asmname '_p_locase_string';
function  UpCaseStr       (const s : String) : TString;
  asmname '_p_upcase_str';
function  LoCaseStr       (const s : String) : TString;
  asmname '_p_locase_str';

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';

function  StrEqualCase    (const s1, s2 : String) : Boolean;
  asmname '_p_strequalcase';

function  Pos             (const SubString, aString : String) :
  Integer; asmname '_p_pos';
function  LastPos         (const SubString, aString : String) :
  Integer; asmname '_p_lastpos';
function  PosCase         (const SubString, aString : String) :
  Integer; asmname '_p_poscase';
function  LastPosCase     (const SubString, aString : String) :
  Integer; asmname '_p_lastposcase';
function  CharPos         (const Chars : CharSet; const aString :
  String) : Integer; asmname '_p_charpos';
function  LastCharPos     (const Chars : CharSet; const aString :
  String) : Integer; asmname '_p_lastcharpos';

function  PosFrom         (const SubString, aString : String; From :
  Integer) : Integer; asmname '_p_posfrom';
function  LastPosTill     (const SubString, aString : String; Till :
  Integer) : Integer; asmname '_p_lastpostill';
function  PosFromCase     (const SubString, aString : String; From :
  Integer) : Integer; asmname '_p_posfromcase';
function  LastPosTillCase (const SubString, aString : String; Till :
  Integer) : Integer; asmname '_p_lastpostillcase';
function  CharPosFrom     (const Chars : CharSet; const aString :
  String; From : Integer) : Integer; asmname '_p_charposfrom';
function  LastCharPosTill (const Chars : CharSet; const aString :
  String; Till : Integer) : Integer; asmname '_p_lastcharpostill';

function  IsPrefix        (const Prefix, s : String) : Boolean;
  asmname '_p_isprefix';
function  IsSuffix        (const Suffix, s : String) : Boolean;
  asmname '_p_issuffix';
function  IsPrefixCase    (const Prefix, s : String) : Boolean;
  asmname '_p_isprefixcase';
function  IsSuffixCase    (const Suffix, s : String) : Boolean;
  asmname '_p_issuffixcase';

function  CStringLength      (Src : CString) : SizeType;
  asmname '_p_strlen';
function  CStringEnd         (Src : CString) : CString;
  asmname '_p_strend';
function  CStringNew         (Src : CString) : CString;
  asmname '_p_strdup';
function  CStringComp        (s1, s2 : CString) : Integer;
  asmname '_p_strcmp';
function  CStringCaseComp    (s1, s2 : CString) : Integer;
  asmname '_p_strcasecmp';
function  CStringLComp       (s1, s2 : CString; MaxLen : SizeType) :
  Integer; asmname '_p_strlcmp';
function  CStringLCaseComp   (s1, s2 : CString; MaxLen : SizeType) :
  Integer; asmname '_p_strlcasecmp';
function  CStringCopy        (Dest, Source : CString) : CString;
  asmname '_p_strcpy';
function  CStringCopyEnd     (Dest, Source : CString) : CString;
  asmname '_p_strecpy';
function  CStringLCopy       (Dest, Source : CString; MaxLen :
  SizeType) : CString; asmname '_p_strlcpy';
function  CStringMove        (Dest, Source : CString; Count :
  SizeType) : CString; asmname '_p_strmove';
function  CStringCat         (Dest, Source : CString) : CString;
  asmname '_p_strcat';
function  CStringLCat        (Dest, Source : CString; MaxLen :
  SizeType) : CString; asmname '_p_strlcat';
function  CStringChPos       (Src : CString; Ch : Char) : CString;
  asmname '_p_strscan';
function  CStringLastChPos   (Src : CString; Ch : Char) : CString;
  asmname '_p_strrscan';
function  CStringPos         (aString, SubString : CString) :
  CString; asmname '_p_strpos';
function  CStringLastPos     (aString, SubString : CString) :
  CString; asmname '_p_strrpos';
function  CStringCasePos     (aString, SubString : CString) :
  CString; asmname '_p_strcasepos';
function  CStringLastCasePos (aString, SubString : CString) :
  CString; asmname '_p_strrcasepos';
function  CStringUpCase      (s : CString) : CString;
  asmname '_p_strupper';
function  CStringLoCase      (s : CString) : CString;
  asmname '_p_strlower';
function  CStringIsEmpty     (s : CString) : Boolean;
  asmname '_p_strempty';
function  NewCString         (const Source : String) : CString;
  asmname '_p_newcstring';
function  CStringCopyString  (Dest : CString; const Source :
  String) : CString; asmname '_p_cstringcopystring';
procedure CopyCString        (Source : CString; var Dest : String);
  asmname '_p_copycstring';

function  NewString       (const s : String) : PString;
  asmname '_p_newstring';
procedure DisposeString   (p : PString); asmname '_p_dispose';

procedure SetString       (var s : String; Buffer : PChar; Count :
  Integer); asmname '_p_set_string';
function  StringOfChar    (Ch : Char; Count : Integer) = s :
  TString; asmname '_p_string_of_char';

procedure TrimLeft        (var s : String); asmname '_p_trimleft';
procedure TrimRight       (var s : String); asmname '_p_trimright';
procedure TrimBoth        (var s : String); asmname '_p_trimboth';
function  TrimLeftStr     (const s : String) : TString;
  asmname '_p_trimleft_str';
function  TrimRightStr    (const s : String) : TString;
  asmname '_p_trimright_str';
function  TrimBothStr     (const s : String) : TString;
  asmname '_p_trimboth_str';

function  GetStringCapacity (const s : String) : Integer;
  asmname '_p_get_string_capacity';

{ A shortcut for a common use of WriteStr as a function }
function  Integer2String (i : Integer) : TString;
  asmname '_p_Integer2String';

type
  TChars = packed array [1 .. 1] of Char;
  PChars = ^TChars;

  { Under development. Interface subject to change.
    Use with caution. }
  { When a const or var AnyString parameter is passed, internally
    these records are passed as const parameters. Value AnyString
    parameters are passed like value string parameters. }
  ConstAnyString = record
    Length : Integer;
    Chars  : PChars
  end;

  { Capacity is the allocated space (used internally). Count is the
    actual number of environment strings. The CStrings array
    contains the environment strings, terminated by a nil pointer,
    which is not counted in Count. @CStrings can be passed to libc
    routines like execve which expect an environment (see
    GetCEnvironment). }
  PEnvironment = ^TEnvironment;
  TEnvironment (Capacity : Integer) = record
    Count : Integer;
    CStrings : array [1 .. Capacity + 1] of CString
  end;

var
  Environment : PEnvironment; asmname '_p_environment'; external;

{ Get an environment variable. If it does not exist, GetEnv returns
  the empty string, which can't be distinguished from a variable
  with an empty value, while CStringGetEnv returns nil then. Note,
  Dos doesn't know empty environment variables, but treats them as
  non-existing, and does not distinguish case in the names of
  environment variables. However, even under Dos, empty environment
  variables and variable names with different case can now be set
  and used within GPC programs. }
function  GetEnv (const EnvVar : String) : TString;
  asmname '_p_getenv';
function  CStringGetEnv (EnvVar : CString) : CString;
  asmname '_p_cstringgetenv';

{ Sets an environment variable with the name given in VarName to the
  value
  Value. A previous value, if any, is overwritten. }
procedure SetEnv (const VarName, Value : String);
  asmname '_p_setenv';

{ Un-sets an environment variable with the name given in VarName. }
procedure UnSetEnv (const VarName : String); asmname '_p_unsetenv';

{ Returns @Environment^.CStrings, converted to PCStrings, to be
  passed to
  libc routines like execve which expect an environment. }
function  GetCEnvironment : PCStrings; asmname '_p_getcenvironment';

{ ================= RUNTIME ERROR HANDLING ETC. ================== }

{ Error handling functions, from error.pas }

const
  EAssert = 381;
  EOpen = 405;
  EOpenRead = 442;
  EOpenWrite = 443;
  EOpenUpdate = 444;
  EReading = 464;
  EWriting = 466;
  ERead = 413;
  EWrite = 414;
  EWriteReadOnly = 422;
  EMMap = 408;
  EIOCtl = 630;
  EConvertError = 875;
  ELibraryFunction = 952;

var
  { Error number (after runtime error) or exit status (after Halt)
  or
    0 (during program run and after succesful termination). }
  ExitCode : Integer; asmname '_p_exitcode'; external;

  { Contains the address of the code where a runtime occurred, nil
    if no runtime error occurred. }
  ErrorAddr : Pointer; asmname '_p_erroraddr'; external;

  { Error message }
  ErrorMessageString : TString; asmname '_p_errormessagestring';
  external;

function  GetErrorMessage                 (n : Integer) : CString;
  asmname '_p_errmsg';
procedure RuntimeError                    (n : Integer);            
  attribute (noreturn); asmname '_p_error';
procedure RuntimeErrorInteger             (n : Integer; i : MedInt);
  attribute (noreturn); asmname '_p_error_integer';
procedure RuntimeErrorCString             (n : Integer; s :
  CString);                attribute (noreturn);
  asmname '_p_error_string';
procedure InternalError                   (n : Integer);            
  attribute (noreturn); asmname '_p_internal_error';
procedure InternalErrorInteger            (n : Integer; i : MedInt);
  attribute (noreturn); asmname '_p_internal_error_integer';
procedure RuntimeWarning                  (Message : CString);
  asmname '_p_warning';
procedure RuntimeWarningInteger           (Message : CString; i :
  MedInt); asmname '_p_warning_integer';
procedure RuntimeWarningCString           (Message : CString; s :
  CString); asmname '_p_warning_string';
procedure DebugStatement                  (const FileName : String;
  Line : Integer); asmname '_p_debug_statement';

(*iocritical*)procedure IOError                         (n :
  Integer); asmname '_p_io_error';
(*iocritical*)procedure IOErrorInteger                  (n :
  Integer; i : MedInt); asmname '_p_io_error_integer';
(*iocritical*)procedure IOErrorCString                  (n :
  Integer; s : CString); asmname '_p_io_error_string';
(*iocritical*)procedure IOErrorFile                     (n :
  Integer; protected var f : AnyFile); asmname '_p_io_error_file';
function  GetIOErrorMessage : TString;
  asmname '_p_get_io_error_message';
procedure CheckInOutRes; asmname '_p_check_inoutres';

{ Registers a procedure to be called to restore the terminal for
  another process that accesses the terminal, or back for the
  program itself. Used e.g. by the CRT unit. The procedures must
  allow for being called multiple times in any order, even at the
  end of the program (see the comment for RestoreTerminal). }
procedure RegisterRestoreTerminal (ForAnotherProcess : Boolean;
  procedure Proc); asmname '_p_RegisterRestoreTerminal';

{ Unregisters a procedure registered with RegisterRestoreTerminal.
  Returns False if the procedure had not been registered, and True
  if it had been registered and was unregistered successfully. }
function UnregisterRestoreTerminal (ForAnotherProcess : Boolean;
  procedure Proc) : Boolean; asmname '_p_UnregisterRestoreTerminal';

{ Calls the procedures registered by RegisterRestoreTerminal. When
  restoring the terminal for another process, the procedures are
  called in the opposite order of registration. When restoring back
  for the program, they are called in the order of registration.

  `RestoreTerminal (True)' will also be called at the end of the
  program, before outputting any runtime error message. It can also
  be used if you want to write an error message and exit the program
  (especially when using e.g. the CRT unit). For this purpose, to
  avoid side effects, call RestoreTerminal immediately before
  writing the error message (to StdErr, not to Output!), and then
  exit the program (e.g. with Halt). }
procedure RestoreTerminal (ForAnotherProcess : Boolean);
  asmname '_p_RestoreTerminal';

{ Executes a command line. Reports execution errors via the IOResult
  mechanism and returns the exit status of the executed program.
  Execute calls RestoreTerminal with the argument True before and
  False after executing the process, ExecuteNoTerminal does not. }
(*@@IO critical*)function  Execute (const CmdLine : String) :
  Integer; asmname '_p_execute';
(*@@IO critical*)function  ExecuteNoTerminal (const CmdLine :
  String) : Integer; asmname '_p_executenoterminal';

procedure AtExit (procedure Proc); asmname '_p_atexit';

procedure SetReturnAddress (Address : Pointer);
  asmname '_p_SetReturnAddress';
procedure RestoreReturnAddress; asmname '_p_RestoreReturnAddress';

{ ==================== SIGNALS AND PROCESSES ===================== }

function  ProcessID : Integer; asmname '_p_pid';

{ Extract information from the status returned by PWait }
function StatusExited     (Status : Integer) : Boolean; attribute
  (const); asmname '_p_WIfExited';
function StatusExitCode   (Status : Integer) : Integer; attribute
  (const); asmname '_p_WExitStatus';
function StatusSignaled   (Status : Integer) : Boolean; attribute
  (const); asmname '_p_WIfSignaled';
function StatusTermSignal (Status : Integer) : Integer; attribute
  (const); asmname '_p_WTermSig';
function StatusStopped    (Status : Integer) : Boolean; attribute
  (const); asmname '_p_WIfStopped';
function StatusStopSignal (Status : Integer) : Integer; attribute
  (const); asmname '_p_WStopSig';

type
  TSignalHandler = procedure (Signal : Integer);

{ OldHandler and OldRestart may be null }
function InstallSignalHandler (Signal : Integer; Handler :
  TSignalHandler;
                               Restart, UnlessIgnored : Boolean;
                               var OldHandler : TSignalHandler; var
  OldRestart : Boolean) : Boolean; asmname '_p_sigaction';
procedure BlockSignal   (Signal : Integer; Block : Boolean);
  asmname '_p_BlockSignal';
function  SignalBlocked (Signal : Integer) : Boolean;
  asmname '_p_SignalBlocked';

var
  { Signal actions }
  SignalDefault : TSignalHandler; asmname '_p_SIG_DFL'; external;
  SignalIgnore  : TSignalHandler; asmname '_p_SIG_IGN'; external;
  SignalError   : TSignalHandler; asmname '_p_SIG_ERR'; external;

  { Signals. The constants are set to the signal numbers, and
    are 0 for signals not defined. }
  { POSIX signals }
  SigHUp    : Integer; asmname '_p_SIGHUP'; external;
  SigInt    : Integer; asmname '_p_SIGINT'; external;
  SigQuit   : Integer; asmname '_p_SIGQUIT'; external;
  SigIll    : Integer; asmname '_p_SIGILL'; external;
  SigAbrt   : Integer; asmname '_p_SIGABRT'; external;
  SigFPE    : Integer; asmname '_p_SIGFPE'; external;
  SigKill   : Integer; asmname '_p_SIGKILL'; external;
  SigSegV   : Integer; asmname '_p_SIGSEGV'; external;
  SigPipe   : Integer; asmname '_p_SIGPIPE'; external;
  SigAlrm   : Integer; asmname '_p_SIGALRM'; external;
  SigTerm   : Integer; asmname '_p_SIGTERM'; external;
  SigUsr1   : Integer; asmname '_p_SIGUSR1'; external;
  SigUsr2   : Integer; asmname '_p_SIGUSR2'; external;
  SigChld   : Integer; asmname '_p_SIGCHLD'; external;
  SigCont   : Integer; asmname '_p_SIGCONT'; external;
  SigStop   : Integer; asmname '_p_SIGSTOP'; external;
  SigTStp   : Integer; asmname '_p_SIGTSTP'; external;
  SigTTIn   : Integer; asmname '_p_SIGTTIN'; external;
  SigTTOu   : Integer; asmname '_p_SIGTTOU'; external;

  { Non-POSIX signals }
  SigTrap   : Integer; asmname '_p_SIGTRAP'; external;
  SigIOT    : Integer; asmname '_p_SIGIOT'; external;
  SigEMT    : Integer; asmname '_p_SIGEMT'; external;
  SigBus    : Integer; asmname '_p_SIGBUS'; external;
  SigSys    : Integer; asmname '_p_SIGSYS'; external;
  SigStkFlt : Integer; asmname '_p_SIGSTKFLT'; external;
  SigUrg    : Integer; asmname '_p_SIGURG'; external;
  SigIO     : Integer; asmname '_p_SIGIO'; external;
  SigPoll   : Integer; asmname '_p_SIGPOLL'; external;
  SigXCPU   : Integer; asmname '_p_SIGXCPU'; external;
  SigXFSz   : Integer; asmname '_p_SIGXFSZ'; external;
  SigVTAlrm : Integer; asmname '_p_SIGVTALRM'; external;
  SigProf   : Integer; asmname '_p_SIGPROF'; external;
  SigPwr    : Integer; asmname '_p_SIGPWR'; external;
  SigInfo   : Integer; asmname '_p_SIGINFO'; external;
  SigLost   : Integer; asmname '_p_SIGLOST'; external;
  SigWinCh  : Integer; asmname '_p_SIGWINCH'; external;

  { Signal subcodes (only used on some systems, -1 if not used) }
  FPEIntegerOverflow        : Integer; asmname '_p_FPE_INTOVF_TRAP';
  external;
  FPEIntegerDivisionByZero  : Integer; asmname '_p_FPE_INTDIV_TRAP';
  external;
  FPESubscriptRange         : Integer; asmname '_p_FPE_SUBRNG_TRAP';
  external;
  FPERealOverflow           : Integer; asmname '_p_FPE_FLTOVF_TRAP';
  external;
  FPERealDivisionByZero     : Integer; asmname '_p_FPE_FLTDIV_TRAP';
  external;
  FPERealUnderflow          : Integer; asmname '_p_FPE_FLTUND_TRAP';
  external;
  FPEDecimalOverflow        : Integer; asmname '_p_FPE_DECOVF_TRAP';
  external;

{ Returns a description for a signal }
function  StrSignal (Signal : Integer) : TString;
  asmname '_p_strsignal';

{ 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, Signal : Integer) : Boolean; asmname '_p_kill';

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';

{ 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, ProcessGroup : Integer) :
  Boolean; asmname '_p_setpgid';

{ 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 (Terminal, ProcessGroup :
  Integer) : Boolean; asmname '_p_tcsetpgrp';

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

{ Returns the file name of the terminal device that is open on the
  file f. Returns nil if (and only if) f is not open or not
  connected to a terminal. }
function  GetTerminalName (protected var f : AnyFile) : CString;
  asmname '_p_ttyname';

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

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

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

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

{ ================= COMMAND LINE OPTION PARSING ================== }

const
  EndOfOptions      = #255;
  NoOption          = #1;
  UnknownOption     = '?';
  LongOption        = #0;
  UnknownLongOption = '?';

var
  FirstNonOption         : Integer; asmname '_p_first_non_option';  
  external;
  HasOptionArgument      : Boolean;
  asmname '_p_has_option_argument';      external;
  OptionArgument         : TString; asmname '_p_option_argument';   
  external;
  UnknownOptionCharacter : Char;
  asmname '_p_unknown_option_character'; external;
  GetOptErrorFlag        : Boolean; asmname '_p_getopt_error_flag'; 
  external;

{
  Parses command line arguments for options and returns the next
  one.

  If a command line argument starts with `-', and is not exactly `-'
  or `--', then it is an option element. The characters of this
  element (aside from the initial `-') are option characters. If
  `GetOpt' is called repeatedly, it returns successively each of the
  option characters from each of the option elements.

  If `GetOpt' finds another option character, it returns that
  character, updating `FirstNonOption' and internal variables so
  that the next call to `GetOpt' can resume the scan with the
  following option character or command line argument.

  If there are no more option characters, `GetOpt' returns
  EndOfOptions. Then `FirstNonOption' is the index of the first
  command line argument that is not an option. (The command line
  arguments have been permuted so that those that are not options
  now come last.)

  OptString must be of the form `[+|-]abcd:e:f:g::h::i::'.

  a, b, c are options without arguments
  d, e, f are options with required arguments
  g, h, i are options with optional arguments

  Arguments are text following the option character in the same
  command line argument, or the text of the following command line
  argument. They are returned in OptionArgument. If an option has no
  argument, OptionArgument is empty. The variable HasOptionArgument
  tells whether an option has an argument. This is mostly useful for
  options with optional arguments, if one wants to distinguish an
  empty argument from no argument.

  If the first character of OptString is `+', GetOpt stops at the
  first non-option argument.

  If it is `-', GetOpt treats non-option arguments as options and
  return NoOption for them.

  Otherwise, GetOpt permutes arguments and handles all options,
  leaving all non-options at the end. However, if the environment
  variable POSIXLY_CORRECT is set, the default behaviour is to stop
  at the first non-option argument, as with `+'.

  The special argument `--' forces an end of option-scanning
  regardless of the first character of OptString. In the case of
  `-', only `--' can cause GetOpt to return EndOfOptions with
  FirstNonOption <= ParamCount.

  If an option character is seen that is not listed in OptString,
  UnknownOption is returned. The unrecognized option character is
  stored in UnknownOptionCharacter. Unless GetOptErrorFlag is set to
  False, an error message is printed to StdErr automatically.
}
function GetOpt (const OptString : String) : Char;
  asmname '_p_getopt';

type
  OptArgType = (NoArgument, RequiredArgument, OptionalArgument);

  OptionType = record
    Name     : CString;
    Argument : OptArgType;
    Flag     : ^Char; { if nil, V is returned. Otherwise, Flag^ is }
    V        : Char   { set to V, and LongOption is returned }
  end;

{
  Recognize short options, described by OptString as above, and long
  options, described by LongOptions.

  Long-named options begin with `--' instead of `-'. Their names may
  be abbreviated as long as the abbreviation is unique or is an
  exact match for some defined option. If they have an argument, it
  follows the option name in the same argument, separated from the
  option name by a `=', or else the in next argument. When GetOpt
  finds a long-named option, it returns LongOption if that option's
  `Flag' field is non-nil, and the value of the option's `V' field
  if the `Flag' field is nil.

  LongIndex, if not null, returns the index in LongOptions of the
  long-named option found. It is only valid when a long-named option
  has been found by the most recent call.

  If LongOnly is set, `-' as well as `--' can indicate a long
  option. If an option that starts with `-' (not `--') doesn't match
  a long option, but does match a short option, it is parsed as a
  short option instead. If an argument has the form `-f', where f is
  a valid short option, don't consider it an abbreviated form of a
  long option that starts with `f'. Otherwise there would be no way
  to give the `-f' short option. On the other hand, if there's a
  long option `fubar' and the argument is `-fu', do consider that an
  abbreviation of the long option, just like `--fu', and not `-f'
  with argument `u'. This distinction seems to be the most useful
  approach.

  As an additional feature (not present in the C counterpart), if
  the last character of OptString is `-' (after a possible starting
  `+' or `-' character), or OptString is empty, all long options
  with a nil `Flag' field will automatically be recognized as short
  options with the character given by the `V' field. This means, in
  the common (and recommended) case that all short options have long
  equivalents, you can simply pass an empty OptString (or pass `+-'
  or `--' as OptString if you want this behaviour, see the comment
  for GetOpt), and you will only have to maintain the LongOptions
  array when you add or change options.
}
function GetOptLong (const OptString : String; var LongOptions :
  array [m .. n : Integer] of OptionType { can be null };
                     var LongIndex : Integer { can be null };
  LongOnly : Boolean) : Char; asmname '_p_getopt_long';

{ Reset GetOpt's state and make the next GetOpt or GetOptLong start
  (again) with the StartArgument'th argument (may be 1). This is
  useful for special purposes only. It is *necessary* to do this
  after altering the contents of CParamCount/CParameters (which is
  not usually done, either). }
procedure ResetGetOpt (StartArgument : Integer);
  asmname '_p_ResetGetOpt';

{ =========================== PEXECUTE =========================== }

const
  PExecute_First   = 1;
  PExecute_Last    = 2;
  PExecute_One     = PExecute_First or PExecute_Last;
  PExecute_Search  = 4;
  PExecute_Verbose = 8;

{
  PExecute: execute a program.

  Program and Arguments are the arguments to execv/execvp.

  Flags and PExecute_Search is non-zero if $PATH should be searched
  (It's not clear that GCC passes this flag correctly). Flags and
  PExecute_First is nonzero for the first process in chain. Flags
  and PExecute_Last is nonzero for the last process in chain.

  The result is the pid on systems like Unix where we fork/exec and
  on systems like MS-Windows and OS2 where we use spawn. It is up to
  the caller to wait for the child.

  The result is the exit code on systems like MSDOS where we spawn
  and wait for the child here.

  Upon failure, ErrMsg is set to the text of the error message,
  and -1 is returned. `errno' is available to the caller to use.

  PWait: cover function for wait.

  PID is the process id of the task to wait for. Status is the
  `status' argument to wait. Flags is currently unused (allows
  future enhancement without breaking upward compatibility). Pass 0
  for now.

  The result is the process ID of the child reaped, or -1 for
  failure.

  On systems that don't support waiting for a particular child, PID
  is ignored. On systems like MSDOS that don't really multitask
  PWait is just a mechanism to provide a consistent interface for
  the caller.
}
function PExecute (ProgramName : CString; Arguments : PCStrings; var
  ErrMsg : String; Flags : Integer) : Integer;
  asmname '_p_pexecute';
function PWait (PID : Integer; var Status : Integer; Flags :
  Integer) : Integer; asmname 'pwait';

{ ==================== TIME HANDLING ROUTINES ==================== }

{ Time and date routines for Extended Pascal, from time.pas }

const
  DateLength = 11; { from types.h }
  TimeLength = 8;  { from types.h }
  InvalidYear = - MaxInt;

type
  UnixTimeType = LongInt; { This is hard-coded in the compiler. Do
  not change here. }
  MicroSecondTimeType = LongInt;

  DateString = packed array [1 .. DateLength] of Char;
  TimeString = packed array [1 .. TimeLength] of Char;

var
  { DayOfWeekName is a constant and therefore does not respect the
    locale. Therefore, it's recommended to use FormatTime instead. }
  DayOfWeekName : array [0 .. 6] of String [9];
  asmname '_p_downame'; external;

  { MonthName is a constant and therefore does not respect the
    locale. Therefore, it's recommended to use FormatTime instead. }
  MonthName : array [1 .. 12] of String [9]; asmname '_p_monthname';
  external;

function  GetDayOfWeek (Day, Month, Year : Integer) : Integer;
  asmname '_p_dayofweek';
procedure UnixTimeToTimeStamp (UnixTime : UnixTimeType; var
  aTimeStamp : TimeStamp); asmname '_p_unix_time_to_time_stamp';
function  TimeStampToUnixTime (protected var aTimeStamp :
  TimeStamp) : UnixTimeType; asmname '_p_time_stamp_to_unix_time';
function  GetMicroSecondTime : MicroSecondTimeType;
  asmname '_p_get_micro_second_time';

{ Is the year a leap year? }
function  IsLeapYear (Year : Integer) : Boolean;
  asmname '_p_is_leap_year';

{ Returns the length of the month, taking leap years into account. }
function  MonthLength (Month, Year : Integer) : Integer;
  asmname '_p_month_length';

procedure Sleep (Seconds : Integer); asmname '_p_sleep';
procedure SleepMicroSeconds (MicroSeconds : Integer);
  asmname '_p_sleep_microseconds';
function  Alarm (Seconds : Integer) : Integer; asmname '_p_alarm';
procedure UnixTimeToTime (UnixTime : UnixTimeType; var Year, Month,
  Day, Hour, Minute, Second : Integer);
  asmname '_p_unix_time_to_time';
function  TimeToUnixTime (Year, Month, Day, Hour, Minute, Second :
  Integer) : UnixTimeType; asmname '_p_time_to_unix_time';

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

{ 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_get_cpu_time';

{
  Formats a TimeStamp value according to a Format string. The format
  string can contain date/time items consisting of `%', followed by
  the specifiers listed below. All characters outside of these items
  are copied to the result unmodified. The specifiers correspond to
  those of the C function strftime(), including POSIX.2 and glibc
  extensions and some more extensions. The extensions are also
  available on systems whose strftime() doesn't support them.

  The following modifiers may appear after the `%':

  `_'  The item is left padded with spaces to the given or default
       width.

  `-'  The item is not padded at all.

  `0'  The item is left padded with zeros to the given or default
       width.

  `/'  The item is right trimmed if it is longer than the given
       width.

  `^'  The item is converted to upper case.

  `~'  The item is converted to lower case.

  After zero or more of these flags, an optional width may be
  specified for padding and trimming. It must be given as a decimal
  number (not starting with `0' since `0' has a meaning of its own,
  see above).

  Afterwards, the following optional modifiers may follow. Their
  meaning is locale-dependent, and many systems and locales just
  ignore them.

  `E'  Use the locale's alternate representation for date and time.
       In a Japanese locale, for example, `%Ex' might yield a date
       format based on the Japanese Emperors' reigns.

  `O'  Use the locale's alternate numeric symbols for numbers. This
       modifier applies only to numeric format specifiers.

  Finally, exactly one of the following specifiers must appear. The
  padding rules listed here are the defaults that can be overriden
  with the modifiers listed above.

  `a'  The abbreviated weekday name according to the current locale.

  `A'  The full weekday name according to the current locale.

  `b'  The abbreviated month name according to the current locale.

  `B'  The full month name according to the current locale.

  `c'  The preferred date and time representation for the current
       locale.

  `C'  The century of the year. This is equivalent to the greatest
       integer not greater than the year divided by 100.

  `d'  The day of the month as a decimal number (`01' .. `31').

  `D'  The date using the format `%m/%d/%y'. NOTE: Don't use this
       format if it can be avoided. Things like this caused Y2K
       bugs!

  `e'  The day of the month like with `%d', but padded with blanks
       (` 1' .. `31').

  `F'  The date using the format `%Y-%m-%d'. This is the form
       specified in the ISO 8601 standard and is the preferred form
       for all uses.

  `g'  The year corresponding to the ISO week number, but without
       the century (`00' .. `99'). This has the same format and
       value as `y', except that if the ISO week number (see `V')
       belongs to the previous or next year, that year is used
       instead. NOTE: Don't use this format if it can be avoided.
       Things like this caused Y2K bugs!

  `G'  The year corresponding to the ISO week number. This has the
       same format and value as `Y', except that if the ISO week
       number (see `V') belongs to the previous or next year, that
       year is used instead.

  `h'  The abbreviated month name according to the current locale.
       This is the same as `b'.

  `H'  The hour as a decimal number, using a 24-hour clock
       (`00' .. `23').

  `I'  The hour as a decimal number, using a 12-hour clock
       (`01' .. `12').

  `j'  The day of the year as a decimal number (`001' .. `366').

  `k'  The hour as a decimal number, using a 24-hour clock like `H',
       but padded with blanks (` 0' .. `23').

  `l'  The hour as a decimal number, using a 12-hour clock like `I',
       but padded with blanks (` 1' .. `12').

  `m'  The month as a decimal number (`01' .. `12').

  `M'  The minute as a decimal number (`00' .. `59').

  `n'  A single newline character.

  `p'  Either `AM' or `PM', according to the given time value; or
       the corresponding strings for the current locale. Noon is
       treated as `PM' and midnight as `AM'.

  `P'  Either `am' or `pm', according to the given time value; or
       the corresponding strings for the current locale, printed in
       lowercase characters. Noon is treated as `pm' and midnight as
       `am'.

  `Q'  The fractional part of the second. This format has special
       effects on the modifiers. The width, if given, determines the
       number of digits to output. Therefore, no actual clipping or
       trimming is done. However, if padding with spaces is
       specified, any trailing (i.e., right!) zeros are converted to
       spaces, and if "no padding" is specified, they are removed.
       The default is "padding with zeros", i.e. trailing zeros are
       left unchanged. The digits are cut when necessary without
       rounding (otherwise, the value would not be consistent with
       the seconds given by `S' and `s'). Note that GPC's TimeStamp
       currently provides for microsecond resolution, so there are
       at most 6 valid digits (which is also the default width), any
       further digits will be 0 (but if TimeStamp will ever change,
       this format will be adjusted). However, the actual resolution
       provided by the operating system via GetTimeStamp etc. may be
       far lower (e.g., ~1/18s under Dos).

  `r'  The complete time using the AM/PM format of the current
       locale.

  `R'  The hour and minute in decimal numbers using the format
       `%H:%M'.

  `s'  Unix time, i.e. the number of seconds since the epoch, i.e.,
       since 1970-01-01 00:00:00 UTC. Leap seconds are not counted
       unless leap second support is available.

  `S'  The seconds as a decimal number (`00' .. `60').

  `t'  A single tab character.

  `T'  The time using decimal numbers using the format `%H:%M:%S'.

  `u'  The day of the week as a decimal number (`1' .. `7'), Monday
       being `1'.

  `U'  The week number of the current year as a decimal number
       (`00' .. `53'), starting with the first Sunday as the first
       day of the first week. Days preceding the first Sunday in the
       year are considered to be in week `00'.

  `V'  The ISO 8601:1988 week number as a decimal number
       (`01' .. `53'). ISO weeks start with Monday and end with
       Sunday. Week `01' of a year is the first week which has the
       majority of its days in that year; this is equivalent to the
       week containing the year's first Thursday, and it is also
       equivalent to the week containing January 4. Week `01' of a
       year can contain days from the previous year. The week before
       week `01' of a year is the last week (`52' or `53') of the
       previous year even if it contains days from the new year.

  `w'  The day of the week as a decimal number (`0' .. `6'), Sunday
       being `0'.

  `W'  The week number of the current year as a decimal number
       (`00' .. `53'), starting with the first Monday as the first
       day of the first week. All days preceding the first Monday in
       the year are considered to be in week `00'.

  `x'  The preferred date representation for the current locale, but
       without the time.

  `X'  The preferred time representation for the current locale, but
       with no date.

  `y'  The year without a century as a decimal number
       (`00' .. `99'). This is equivalent to the year modulo 100.
       NOTE: Don't use this format if it can be avoided. Things like
       this caused Y2K bugs!

  `Y'  The year as a decimal number, using the Gregorian calendar.
       Years before the year `1' are numbered `0', `-1', and so on.

  `z'  RFC 822/ISO 8601:1988 style numeric time zone (e.g., `-0600'
       or `+0100'), or nothing if no time zone is determinable.

  `Z'  The time zone abbreviation (empty if the time zone can't be
       determined).

  `%'  (i.e., an item `%%') A literal `%' character.
}
function  FormatTime (const Time : TimeStamp; const Format :
  String) : TString; asmname '_p_format_time';

{ ==================== FILE HANDLING ROUTINES ==================== }

{ File handling routines and their support, mostly from files.pas
  and file.c }

type
  FileSizeType = LongInt;

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
  TOpenMode   = (foNone, foReset, foRewrite, foAppend, foSeekRead,
  foSeekWrite, foSeekUpdate);
  TOpenProc   = procedure (var PrivateData; Mode : TOpenMode);
  TSelectFunc = function  (var PrivateData; Writing : Boolean) :
  Integer; { called before select(), must return a handle }
  TSelectProc = procedure (var PrivateData; var ReadSelect,
  WriteSelect, ExceptSelect : Boolean); { called before and after
  select() }
  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';

type
  Natural = 1 .. MaxInt;
  IOSelectEvents = (SelectReadOrEOF, SelectRead, SelectEOF,
  SelectWrite, SelectException, SelectAlways);

const
  IOSelectEventMin = (*Low (IOSelectEvents);*)SelectReadOrEOF;
  IOSelectEventMax = Pred (SelectAlways);

type
  IOSelectType = record
    f : PAnyFile;
    Wanted : set of IOSelectEvents;
    Occurred : set of IOSelectEventMin .. IOSelectEventMax
  end;

{ Waits for one of several events to happen. Returns when one or
  more of the wanted events for one of the files occur. If they have
  already occurred before calling the function, it returns
  immediately. MicroSeconds can specify a timeout. If it is 0, the
  function will return immediately, whether or not an event has
  occurred. If it is negative, the function will wait forever until
  an event occurs. The Events parameter can be null, in which case
  the function only waits for the timeout. If any of the file
  pointers (f) in Events are nil or the files pointed to are closed,
  they are simply ignored for convenience.

  It returns the index of one of the files for which any event has
  occurred. If events have occurred for several files, is it
  undefined which of these file's index is returned. If no event
  occurs until the timeout, 0 is returned. If an error occurs or the
  target system does not have a select() system call and Events is
  not null, a negative value is returned. In the Occurred field of
  the elements of Events, events that have occurred are set. The
  state of events not wanted is undefined.

  The possible events are:
  SelectReadOrEOF: the file is at EOF or data can be read now.
  SelectRead:      data can be read now.
  SelectEOF:       the file is at EOF.
  SelectWrite:     data can be written now.
  SelectException: an exception occurred on the file.
  SelectAlways:    if this is set, *all* requested events will be
                   checked for this file in any case. Otherwise,
                   checks may be skipped if already another event
                   for this or another file was found.

  Notes:
  Checking for EOF requires some reading ahead internally (just like
  the EOF function) which can be avoided by setting SelectReadOrEOF
  instead of SelectRead and SelectEOF. If this is followed by, e.g.,
  a BlockRead with 4 parameters, the last parameter will be 0 if and
  only the file is at EOF, and otherwise, data will be read directly
  from the file without reading ahead and buffering.

  SelectAlways should be set for files for which events are
  considered to be of higher priority than others. Otherwise, if one
  is interested in just any event, not setting SelectAlways may be a
  little faster. }
function IOSelect (var Events : array [m .. n : Natural] of
  IOSelectType; MicroSeconds : MicroSecondTimeType) : Integer;
  asmname '_p_ioselect';

{ A simpler interface to SelectIO for the most common use. Waits for
  SelectReadOrEOF on all files and returns an index. }
function IOSelectRead (const Files : array [m .. n : Natural] of
  PAnyFile; MicroSeconds : MicroSecondTimeType) : Integer;
  asmname '_p_ioselectread';

procedure AssignFile   (var T : AnyFile; const Name : String);
  asmname '_p_assign';
procedure AssignBinary (var T : Text; const Name : String);
  asmname '_p_assign_binary';
procedure AssignHandle (var T : AnyFile; Handle : Integer);
  asmname '_p_assign_handle';

{ BP compatible seeking routines }
function  SeekEOF  (var f : Text) : Boolean; asmname '_p_seekeof';
function  SeekEOLn (var f : Text) : Boolean; asmname '_p_seekeoln';

{ Under development }
procedure AnyStringTFDD_Reset (var f : AnyFile; var Buf :
  ConstAnyString); asmname '_p_anystring_tfdd_reset';
(*procedure AnyStringTFDD_Rewrite (var f : AnyFile; var Buf :
  VarAnyString); asmname '_p_anystring_tfdd_rewrite';*)
procedure StringTFDD_Reset (var f : AnyFile; var Buf :
  ConstAnyString; const s : String); asmname '_p_string_tfdd_reset';
(*procedure StringTFDD_Rewrite (var f : AnyFile; var Buf :
  VarAnyString; var s : String); asmname '_p_string_tfdd_rewrite';*)

(*@@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;

{ File mode constants that are ORed for BindingType.Mode and ChMod.
  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;

type
  TextFile = Text;

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

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

procedure CloseFile    (          var aFile : (*@@Any*)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';
(*@@IO critical*) procedure StatFS       (Path : CString; var Buf :
  StatFSBuffer); asmname '_p_statfs';

{ 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';

const
  mm_Readable   = 1;
  mm_Writable   = 2;
  mm_Executable = 4;

function MemoryMap (Start : Pointer; Length : SizeType; Access :
  Integer; Shared : Boolean;
                    var aFile : AnyFile; Offset : FileSizeType) :
  Pointer; asmname '_p_mmap';
procedure MemoryUnMap (Start : Pointer; Length : SizeType);
  asmname '_p_munmap';

{ File name routines, from filename.pas }

{
  Define constants for different systems:

  OSDosFlag:         flag to indicate whether the target system is
                     Dos

  QuotingCharacter:  the character used to quote wild cards and
                     other special characters (#0 if not available)

  PathSeparator:     the separator of multiple paths, e.g. in the
                     PATH environment variable

  DirSeparator:      the separator of the directories within a full
                     file name

  DirSeparators:     a set of all possible directory and drive name
                     separators

  ExtSeparator:      the separator of a file name extension

  DirRoot:           the name of the root directory

  DirSelf:           the name of a directory in itself

  DirParent:         the name of the parent directory

  MaskNoStdDir:      a file name mask that matches all names except
                     the standard directories DirSelf and DirParent

  NullDeviceName:    the full file name of the null device

  TTYDeviceName:     the full file name of the current TTY

  ConsoleDeviceName: the full file name of the system console. On
                     Dos systems, this is the same as the TTY, but
                     on systems that allow remote login, this is a
                     different thing and may reach a completely
                     different user than the one running the
                     program, so use with care.

  EnvVarCharsFirst:  the characters accepted at the beginning of the
                     name of an environment variable without quoting

  EnvVarChars:       the characters accepted in the name of an
                     environment variable without quoting

  PathEnvVar:        the name of the environment variable which
                     (usually) contains the executable search path

  ShellEnvVar:       the name of the environment variable which
                     (usually) contains the path of the shell
                     executable (see GetShellPath)

  ShellExecCommand:  the option to the (default) shell to execute
                     the command specified in the following argument
                     (see GetShellPath)

  ConfigFileMask:    a mask for the option file name as returned by
                     ConfigFileName

  FileNamesCaseSensitive:
                     flag to indicate whether file names are case
                     sensitive
}

const
  UnixShellEnvVar        = 'SHELL';
  UnixShellExecCommand   = '-c';

{$ifdef __OS_DOS__}

const
  OSDosFlag              = True;
  QuotingCharacter       = #0;
  PathSeparator          = {$ifdef __CYGWIN32__} ':' {$else} ';'
  {$endif};
  DirSeparator           = '\';
  DirSeparators          = [':', '\', '/'];
  ExtSeparator           = '.';
  DirRoot                = '\';
  DirSelf                = '.';
  DirParent              = '..';
  MaskNoStdDir           = '{*,.[^.],..?*}';
  NullDeviceName         = 'nul';
  TTYDeviceName          = 'con';
  ConsoleDeviceName      = 'con';
  EnvVarCharsFirst       = ['A' .. 'Z', 'a' .. 'z', '_'];
  EnvVarChars            = EnvVarCharsFirst + ['0' .. '9'];
  PathEnvVar             = 'PATH';
  ShellEnvVar            = 'COMSPEC';
  ShellExecCommand       = '/c';
  ConfigFileMask         = '*.cfg';
  FileNamesCaseSensitive = False;

{$else}

const
  OSDosFlag              = False;
  QuotingCharacter       = '\';
  PathSeparator          = ':';
  DirSeparator           = '/';
  DirSeparators          = ['/'];
  ExtSeparator           = '.';
  DirRoot                = '/';
  DirSelf                = '.';
  DirParent              = '..';
  MaskNoStdDir           = '{*,.[^.],..?*}';
  NullDeviceName         = '/dev/null';
  TTYDeviceName          = '/dev/tty';
  ConsoleDeviceName      = '/dev/console';
  EnvVarCharsFirst       = ['A' .. 'Z', 'a' .. 'z', '_'];
  EnvVarChars            = EnvVarCharsFirst + ['0' .. '9'];
  PathEnvVar             = 'PATH';
  ShellEnvVar            = UnixShellEnvVar;
  ShellExecCommand       = UnixShellExecCommand;
  ConfigFileMask         = '.*';
  FileNamesCaseSensitive = True;

{$endif}

const
  WildCardChars = ['*', '?', '[', ']'];
  FileNameSpecialChars = (WildCardChars + SpaceCharacters +
  ['{', '}', '$', QuotingCharacter]) - DirSeparators;

type
  DirPtr = Pointer;

  { `+ 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;

{ Convert ch to lower case if FileNamesCaseSensitive is False, leave
  it unchanged otherwise. }
function  FileNameLoCase (ch : Char) : Char;
  asmname '_p_filenamelocase';

{ Change a file name to use the OS dependent directory separator }
function  Slash2OSDirSeparator (const s : String) : TString;
  asmname '_p_slash2osdirseparator';

{ Change a file name to use '/' as directory separator }
function  OSDirSeparator2Slash (const s : String) : TString;
  asmname '_p_osdirseparator2slash';

{ Like Slash2OSDirSeparator for CStrings -- NOTE: overwrites the
  CString }
function  Slash2OSDirSeparator_CString (s : CString) : CString;
  asmname '_p_slash2osdirseparator_cstring';

{ Like OSDirSeparator2Slash for CStrings -- NOTE: overwrites the
  CString }
function  OSDirSeparator2Slash_CString (s : CString) : CString;
  asmname '_p_osdirseparator2slash_cstring';

{ Add a DirSeparator to the end of s, if there is not already one
  and s denotes an existing directory }
function  AddDirSeparator (const s : String) : TString;
  asmname '_p_adddirseparator';

{ Like AddDirSeparator, but also if the directory does not exist }
function  ForceAddDirSeparator (const s : String) : TString;
  asmname '_p_forceadddirseparator';

{ Remove all trailing DirSeparators from s, if there are any, as
  long as removing them doesn't change the meaning (i.e., they don't
  denote the root directory. }
function  RemoveDirSeparator (const s : String) : TString;
  asmname '_p_removedirseparator';

{ Returns the current directory using OS dependent directory
  separators }
function  GetCurrentDirectory     : TString;
  asmname '_p_get_current_directory';

{ Returns a directory suitable for storing temporary files using OS
  dependent directory separators. If found, the result always ends
  in DirSeparator. If no suitable directory is found, an empty
  string is returned. }
function  GetTempDirectory        : TString;
  asmname '_p_get_temp_directory';

{ Returns a non-existing file name in the directory given. If the
  directory doesn't exist or the Directory name is empty, a runtime
  error is raised, and GetTempFileNameInDirectory returns the empty
  string. }
(*@@iocritical*)function  GetTempFileNameInDirectory (const
  Directory : String) : TString;
  asmname '_p_get_temp_file_name_in_directory';

{ Returns a non-existing file name in GetTempDirectory. If no temp
  directory is found, i.e. GetTempDirectory returns the empty
  string, a runtime error is raised, and GetTempFileName returns the
  empty string as well. }
(*@@iocritical*)function  GetTempFileName         : TString;
  asmname '_p_get_temp_file_name';

{ The same as GetTempFileName, but returns a CString allocated from
  the heap. }
(*@@iocritical*)function  GetTempFileName_CString : CString;
  asmname '_p_get_temp_file_name_cstring';

{ Get the external name of a file }
function  FileName (protected var f : AnyFile) : TString;
  asmname '_p_file_name';

{ Returns true if the given file name is an existing plain file }
function  FileExists      (const aFileName : String) : Boolean;
  asmname '_p_file_exists';

{ Returns True if the given file name is an existing directory }
function  DirectoryExists (const aFileName : String) : Boolean;
  asmname '_p_directory_exists';

{ Returns True if the given file name is an existing file, directory
  or special file (device, pipe, socket, etc.) }
function  PathExists      (const aFileName : String) : Boolean;
  asmname '_p_path_exists';

{ If a file of the given name exists in one of the directories given
  in DirList (separated by PathSeparator), returns the full path,
  otherwise returns an empty string. If aFileName already contains
  an element of DirSeparators, returns Slash2OSDirSeparator
  (aFileName) if it exists. }
function  FSearch (const aFileName, DirList : String) : TString;
  asmname '_p_fsearch';

{ Like FSearch, but only find executable files. Under Dos, if not
  found, the function tries appending '.com', '.exe', '.bat' and
  `.cmd' (the last one only if $COMSPEC points to a `cmd.exe'), so
  you don't have to specify these extensions in aFileName (and with
  respect to portability, it might be preferable not to do so). }
function  FSearchExecutable (const aFileName, DirList : String) :
  TString; asmname '_p_fsearch_executable';

{ Replaces all occurrences of `$FOO' and `~' in s by the value of
  the environment variables FOO or HOME, respectively. If a variable
  is not defined, the function returns False, and s contains the
  name of the undefined variable (or the empty string if the
  variable name is invalid, i.e., doesn't start with a character
  from EnvVarCharsFirst). Otherwise, if all variables are found, s
  contains the replaced string, and True is returned. }
function  ExpandEnvironment (var s : String) : Boolean;
  asmname '_p_expand_environment';

{ Expands the given path name to a full path name. Relative paths
  are expanded using the current directory, and occurrences of
  DirSelf and DirParent are resolved. Under Dos, the result is
  converted to lower case and a trailing ExtSeparator (except in a
  trailing DirSelf or DirParent) is removed, like Dos does. If the
  directory, i.e. the path without the file name, is invalid, the
  empty string is returned. }
function  FExpand       (const Path : String) : TString;
  asmname '_p_fexpand';

{ Like FExpand, but unquotes the directory before expanding it, and
  quotes WildCardChars again afterwards. Does not check if the
  directory is valid (because it may contain wild card characters).
  Symlinks are expanded only in the directory part, not the file
  name. }
function  FExpandQuoted (const Path : String) : TString;
  asmname '_p_fexpandquoted';

{ FExpands Path, and then removes the current directory from it, if
  it is a prefix of it. If OnlyCurDir is set, the current directory
  will be removed only if Path denotes a file in, not below, it. }
function  RelativePath (const Path : String; OnlyCurDir, Quoted :
  Boolean) : TString; asmname '_p_relative_path';

{ Is aFileName a UNC filename? (Always returns False on non-Dos
  systems.) }
function  IsUNC (const aFileName : String) : Boolean;
  asmname '_p_IsUNC';

{ Splits a file name into directory, name and extension. Each of
  Dir, Name and Ext may be null. }
procedure FSplit (const Path : String; var Dir, Name, Ext : String);
  asmname '_p_fsplit';

{ Functions that extract one or two of the parts from FSplit.
  DirFromPath returns DirSelf + DirSeparator if the path contains no
  directory. }
function  DirFromPath     (const Path : String) : TString;
  asmname '_p_dir_from_path';
function  NameFromPath    (const Path : String) : TString;
  asmname '_p_name_from_path';
function  ExtFromPath     (const Path : String) : TString;
  asmname '_p_ext_from_path';
function  NameExtFromPath (const Path : String) : TString;
  asmname '_p_name_ext_from_path';

{ Start reading a directory. If successful, a pointer is returned
  that can be used for subsequent calls to ReadDir and finally
  CloseDir. On failure, an I/O error is raised and (in case it is
  ignored) nil is returned. }
(*@@iocritical*)function  OpenDir  (const Name : String) : DirPtr;
  asmname '_p_opendir';

{ Reads one entry from the directory Dir, and returns the file name.
  On errors or end of directory, the empty string is returned. }
function  ReadDir  (Dir : DirPtr) : TString; asmname '_p_readdir';

{ Closes a directory opened with OpenDir. }
(*@@iocritical*)procedure CloseDir (Dir : DirPtr);
  asmname '_p_closedir';

{ Returns the first position of a non-quoted character of CharSet in
  s, or 0 if no such character exists. }
function  FindNonQuotedChar (Chars : CharSet; const s : String;
  From : Integer) : Integer; asmname '_p_findnonquotedchar';

{ Returns the first occurence of SubString in s that is not quoted
  at the beginning, or 0 if no such occurence exists. }
function  FindNonQuotedStr (const SubString, s : String; From :
  Integer) : Integer; asmname '_p_findnonquotedstr';

{ Does a string contain non-quoted wildcard characters? }
function  HasWildCards (const s : String) : Boolean;
  asmname '_p_haswildcards';

{ Does a string contain non-quoted wildcard characters, braces or
  spaces? }
function  HasWildCardsOrBraces (const s : String) : Boolean;
  asmname '_p_haswildcardsorbraces';

{ Insert QuotingCharacter into s before any special characters }
function  QuoteFileName (const s : String; const SpecialCharacters :
  CharSet) : TString; asmname '_p_quote_filename';

{ Remove QuotingCharacter from s }
function  UnQuoteFileName (const s : String) : TString;
  asmname '_p_unquote_filename';

{ Splits s at non-quoted spaces and expands non-quoted braces like
  bash does. The result and its entries should be disposed after
  usage, e.g. with DisposePPStrings. }
function  BraceExpand (const s : String) : PPStrings;
  asmname '_p_braceexpand';

{ Dispose of a PPStrings array as well as the strings it contains.
  If you want to keep the strings (by assigning them to other string
  pointers), you should instead free the PPStrings array with
  `Dispose'. }
procedure DisposePPStrings (Strings : PPStrings);
  asmname '_p_DisposePPStrings';

{ Tests if a file name matches a shell wildcard pattern (?, *, []) }
function  FileNameMatch (const Pattern, Name : String) : Boolean;
  asmname '_p_filenamematch';

{ FileNameMatch with BraceExpand }
function  MultiFileNameMatch (const Pattern, Name : String) :
  Boolean; asmname '_p_multifilenamematch';

{ File name globbing }
{ GlobInit is implied by Glob and MultiGlob, not by GlobOn and
  MultiGlobOn. GlobOn and MultiGlobOn must be called after GlobInit,
  Glob or MultiGlob. MultiGlob and MultiGlobOn do brace expansion,
  Glob and GlobOn do not. GlobFree frees the memory allocated by the
  globbing functions and invalidates the results in Buf. It should
  be called after globbing. }
procedure GlobInit    (var Buf : GlobBuffer); asmname '_p_globinit';
procedure Glob        (var Buf : GlobBuffer; const Pattern :
  String); asmname '_p_glob';
procedure GlobOn      (var Buf : GlobBuffer; const Pattern :
  String); asmname '_p_globon';
procedure MultiGlob   (var Buf : GlobBuffer; const Pattern :
  String); asmname '_p_multiglob';
procedure MultiGlobOn (var Buf : GlobBuffer; const Pattern :
  String); asmname '_p_multiglobon';
procedure GlobFree    (var Buf : GlobBuffer); asmname '_p_globfree';

type
  TPasswordEntry = record
    UserName, RealName, Password, HomeDirectory, Shell : TString;
    UID, GID : Integer
  end;

  PPasswordEntries = ^TPasswordEntries;
  TPasswordEntries (Count : Integer) = array [1 .. Count] of
  TPasswordEntry;

{ Finds a password entry by user name. Returns True if found, False
  otherwise. }
function  GetPasswordEntryByName (const UserName : String; var
  Entry : TPasswordEntry) : Boolean;
  asmname '_p_getpasswordentrybyname';

{ Finds a password entry by UID. Returns True if found, False
  otherwise. }
function  GetPasswordEntryByUID  (UID : Integer; var Entry :
  TPasswordEntry) : Boolean; asmname '_p_getpasswordentrybyuid';

{ Returns all password entries, or nil if none found. }
function  GetPasswordEntries : PPasswordEntries;
  asmname '_p_getpasswordentries';

{ Returns the mount point (Unix) or drive (Dos) which is part of the
  given path. If the path does not contain any (i.e., is a relative
  path), an empty string is returned. Therefore, if you want to get
  the mount point or drive in any case, apply `FExpand' or
  `RealPath' to the argument. }
function  GetMountPoint (const Path : String) = Result : TString;
  asmname '_p_GetMountPoint';

type
  TSystemInfo = record
    OSName,
    OSRelease,
    OSVersion,
    MachineType,
    HostName,
    DomainName : TString
  end;

{ Returns system information if available. Fields not available will
  be empty. }
function  SystemInfo : TSystemInfo; asmname '_p_SystemInfo';

{ Returns the path to the shell (as the return value) and the option
  that makes it execute the command specified in the following
  argument (in `Option'). Usually these are the environment value of
  ShellEnvVar, and ShellExecCommand, but on Dos systems, the
  function will first try UnixShellEnvVar, and UnixShellExecCommand
  because ShellEnvVar will usually point to command.com, but
  UnixShellEnvVar can point to bash which is usually a better choice
  when present. If UnixShellEnvVar is not set, or the shell given
  does not exist, it will use ShellEnvVar, and ShellExecCommand.
  Option may be null (in case you want to invoke the shell
  interactively). }
function  GetShellPath (var Option : String) : TString;
  asmname '_p_GetShellPath';

{ Returns the path of the running executable. NOTE: On most systems,
  this is *not* guaranteed to be the full path, but often just the
  same as `ParamStr (0)' which usually is the name given on the
  command line. Only on some systems with special support, it
  returns the full path when `ParamStr (0)' doesn't. }
function  ExecutablePath : TString; asmname '_p_executable_path';

{ Returns a file name suitable for a global (system-wide) or local
  (user-specific) configuration file, depending on the Global
  parameter. The function does not guarantee that the file name
  returned exists or is readable or writable.

  In the following table, the base name `<base>' is given with the
  Name parameter. If it is empty, the base name is the name of the
  running program (as returned by ExecutablePath, without directory
  and extension. `<prefix>' (Unix only) stands for the value of the
  Prefix parameter (usual values include '', '/usr' and
  '/usr/local'). `<dir>' (Dos only) stands for the directory where
  the running program resides. `$foo' stands for the value of the
  environment variable `foo'.

         Global                    Local
  Unix:  <prefix>/etc/<base>.conf  $HOME/.<base>

  Dos:   $DJDIR\etc\<base>.ini     $HOME\<base>.cfg
         <dir>\<base>.ini          <dir>\<base>.cfg

  As you see, there are two possibilities under Dos. If the first
  file exists, it is returned. Otherwise, if the second file exists,
  that is returned. If none of them exists (but the program might
  want to create a file), if the environment variable (DJDIR or
  HOME, respectively) is set, the first file name is returned,
  otherwise the second one. This rather complicated scheme should
  give the most reasonable results for systems with or without DJGPP
  installed, and with or without already existing config files. Note
  that DJDIR is always set on systems with DJGPP installed, while
  HOME is not. However, it is easy for users to set it if they want
  their config files in a certain directory rather than with the
  executables. }
function  ConfigFileName (const Prefix, Name : String; Global :
  Boolean) : TString; asmname '_p_config_file_name';

{ Returns a directory name suitable for global, machine-independent
  data. The function garantees that the name returned ends with a
  DirSeparator, but does not guarantee that it exists or is
  readable or writable.

  Note: If the prefix is empty, it is assumed to be '/usr'. (If you
  really want /share, you could pass '/' as the prefix, but that's
  very uncommon.)

  Unix: <prefix>/share/<base>/

  Dos:  $DJDIR\share\<base>\
        <dir>\

  About the symbols used above, and the two possibilities under Dos,
  see the comments for ConfigFileName. }
function  DataDirectoryName (const Prefix, Name : String) : TString;
  asmname '_p_data_directory_name';

{ ==================== MATHEMATICAL ROUTINES ===================== }

function  IsInfinity   (x : Extended) : Boolean; attribute (const);
  asmname '_p_isinf';
function  IsNotANumber (x : Extended) : Boolean; attribute (const);
  asmname '_p_isnan';
procedure SplitReal    (x : Extended; var Exponent : Integer; var
  Mantissa : Extended); asmname '_p_frexp';
function  SinH         (x : Double)    : Double; asmname '_p_sinh';
function  CosH         (x : Double)    : Double; asmname '_p_cosh';
function  Arctan2      (y, x : Double) : Double;
  asmname '_p_arctan2';

type
  RandomSeedType = Cardinal (32);
  RandomizeType  = ^procedure;
  SeedRandomType = ^procedure (Seed : RandomSeedType);
  RandRealType   = ^function : LongestReal;
  RandIntType    = ^function (MaxValue : LongestCard) : LongestCard;

var
  RandomizePtr  : RandomizeType; asmname '_p_randomize_ptr';
  external;
  SeedRandomPtr : SeedRandomType; asmname '_p_seedrandom_ptr';
  external;
  RandRealPtr   : RandRealType; asmname '_p_randreal_ptr'; external;
  RandIntPtr    : RandIntType; asmname '_p_randint_ptr'; external;

procedure SeedRandom (Seed : RandomSeedType);
  asmname '_p_seedrandom';

end.

Units included with GPC

GPC distributions now include a number of useful Pascal units and a complete set of BP compatibility units -- except for the `Graph' unit (which is currently distributed separately due to its license) and the OOP stuff. The main use of these units is to provide a way to port BP programs to GPC as easily as possible. Some of the units also implement functionaliy not available otherwise.

Most of the BP compatibility units -- except `CRT' and `Printer' -- are merely meant to let programs written for BP compile with GPC as easily as possible. They should not be used in newly written code, and for code ported from BP to GPC, it is suggested to replace them successively with the more powerful -- and often easier to use -- alternatives that GPC's Run Time System (see section Pascal declarations for GPC's Run Time System) offers.

The following sections describe all units included with GPC (besides the `GPC' module which describes the interface to the Run Time System, section Pascal declarations for GPC's Run Time System).

BP compatibility: CRT & WinCRT, portable, with many extensions

The following listing contains the interface of the CRT unit.

`CRT' is a `curses' based unit for text screen handling. It is compatible to BP's `CRT' unit, even in a lot of minor details like the values of function key codes and includes some routines for compatibility with TP5's `Win' unit as well as BP's `WinCrt' and Turbo Power's `TPCrt' units, and some extensions.

The unit has been extended by many functions that were lacking in BP's unit and required assembler code or direct memory/port access to be implemented under BP. The GPC version is now fully suited for portable, real-world programming without any dirty tricks.

The unit is also available as `WinCRT', completely identical to `CRT'. The only purpose of this "feature" is to let programs written for TPW or BP, with a `uses WinCRT' directive, compile without changes. Unlike TPW/BP's `WinCRT' unit, GPC's unit is not crippled, compared to `CRT'.

To use this unit, you will need the `ncurses' (version 5.0 or newer) or `PDCurses' library which can be found in ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/.

{
CRT (Crt Replacement Tool)
Portable BP compatible CRT unit for GPC with many extensions

This unit is aware of terminal types. This means programs using this
unit will work whether run locally or while being logged in remotely
from a system with a completely different terminal type (as long as
the appropriate terminfo entry is present on the system where the
program is run).

NOTES:

- The CRT unit needs the ncurses and panel libraries which should be
  available for almost any system. For Dos systems, where ncurses is
  not available, it is configured to use the PDCurses and its panel
  library instead. On Unix systems with X11, it can also use
  PDCurses (xcurses) and xpanel to produce X11 programs. The
  advantage is that the program won't need an xterm with a valid
  terminfo entry, the output may look a little nicer and function
  keys work better than in an xterm, but the disadvantage is that it
  will only run under X. The ncurses and PDCurses libraries
  (including panel and xpanel, resp.) can be found in
  ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/
  (Note that ncurses is already installed on many Unix systems.) For
  ncurses, version 5.0 or newer is strongly recommended because
  older versions contain a bug that severely affects CRT programs.

  When an X11 version under Unix is wanted, give `-DX11' when
  compiling crt.pas and crtc.c (or when compiling crt.pas or a
  program that uses CRT with `--automake'). On pre-X11R6 systems,
  give `-DNOX11R6' additionally. You might also have to give the
  path to the X11 libraries with `-L', e.g. `-L /usr/X11/lib'.

- A few features cannot be implemented in a portable way and are
  only available on some systems:

      Sound, NoSound 1)                  -----------------------.
      GetShiftState                      ------------------.    |
      TextMode etc. 2)                   -------------.    |    |
      CRTSavePreviousScreen              --------.    |    |    |
      Interrupt signal (Ctrl-C) handling ---.    |    |    |    |
                                            |    |    |    |    |
  Linux/x86 3) (terminal)                   X    X 4) X 5) X 6) X 6)
  Other Unix (terminal)                     X    X 7) X 5) -    -
  Unix (X11 version)                        X    X    - 8) X    -
  Dos (DJGPP)                               X    X    X    X    X
  MS-Windows (Cygwin or mingw)              X    -    X 9) X    -

  Notes:

  1) If you define NO_CRT_DUMMY_SOUND while compiling CRT, you will
     get linking errors when your program tries to use Sound/NoSound
     on a platform where it's not supported (which is useful to
     detect at compile time if playing sound is a major task of your
     program). Otherwise, Sound/NoSound will simply do nothing
     (which is usually acceptable if the program uses these routines
     just for an occasional beep).

  2) Changing to monochrome modes works on all platforms. Changing
     the screen size only works on those indicated. However, even on
     the platforms not supported, the program will react to screen
     size changes by external means (e.g. changing the window size
     with the mouse if running in a GUI window or resizing a console
     or virtual terminal).

  3) Probably also on other processors, but I've had no chance to
     test this yet.

  4) Only on a local console with access permissions to the
     corresponding virtual console memory device or using the
     `crtscreen' utility (see crtscreen.c in the demos directory).

  5) Only if supported by an external command (e.g., in xterms and
     on local Linux consoles). The command to be called can be
     defined in the environment variable `RESIZETERM' (where the
     variables `columns' and `lines' in the command are set to the
     size wanted). If not set, the code will try `resize -s' in an
     xterm and otherwise `SVGATextMode' and `setfont'. For this to
     work, these utilities need to be present in the PATH or
     `/usr/sbin' or `/usr/local/sbin'. Furthermore, SVGATextMode and
     setfont require root permissions, either to the executable of
     the program compiled with CRT or to resizecons (called by
     setfont) or SVGATextMode. To allow the latter, do
     "chmod u+s `which resizecons`" and/or
     "chmod u+s `which SVGATextMode`", as root once, but only if you
     really want each user to be allowed to change the text mode.

  6) Only on local consoles.

  7) Some terminals only. Most xterms etc. support it as well as
     other terminals that support an "alternate screen" in the
     smcup/rmcup terminal capabilities.

  8) But the user can resize the window.

  9) Only with PDCurses, not with ncurses. Changing the number of
     screen *columns* doesn't work in a full-screen session.

- When CRT is initialized (automatically or explicitly; see the
  comments for CRTInit), the screen is cleared, and at the end of
  the program, the cursor is placed at the bottom of the screen
  (curses behaviour).

- All the other things (including most details like color and
  function key constants) are compatible with BP's CRT unit, and
  there are many extensions that BP's unit does not have.

- When the screen size is changed by an external event (e.g.,
  resizing an xterm or changing the screen size from another VC
  under Linux), the virtual "function key" kbScreenSizeChanged is
  returned. Applications can use the virtual key to resize their
  windows. kbScreenSizeChanged will not be returned if the screen
  size change was initiated by the program itself (by using TextMode
  or SetScreenSize). Note that TextMode sets the current panel to
  the full screen size, sets the text attribute to the default and
  clears the window (BP compatibility), while SetScreenSize does
  not.

- After the screen size has been changed, whether by using TextMode,
  SetScreenSize or by an external event, ScreenSize will return the
  new screen size. The current window and all panels will have been
  adjusted to the new screen size. This means, if their right or
  lower ends are outside the new screen size, the windows are moved
  to the left and/or top as far as necessary. If this is not enough,
  i.e., if they are wider/higher than the new screen size, they are
  shrinked to the total screen width/height. When the screen size is
  enlarged, window sizes are not changed, with one exception:
  Windows that extend through the whole screen width/height are
  enlarged to the whole new screen width/height (in particular,
  full-screen windows remain full-screen). This behaviour might not
  be optimal for all purposes, but you can always resize your
  windows in your application after the screen size change.

- (ncurses only) The environment variable `ESCDELAY' specifies the
  number of milliseconds allowed between an `Esc' character and the
  rest of an escape sequence (default 1000). Setting it to a value
  too small can cause problems with programs not recognizing escape
  sequences such as function keys, especially over slow network
  connections. Setting it to a value too large can delay the
  recognition of an `ESC' key press notably. On local Linux
  consoles, e.g., 10 seems to be a good value.

- When trying to write portable programs, don't rely on exactly the
  same look of your output and the availability of all the key
  combinations. Some kinds of terminals support only some of the
  display attributes and special characters, and usually not all of
  the keys declared are really available. Therefore, it's safer to
  provide the same function on different key combinations and to not
  use the more exotic ones.

Copyright (C) 1998-2001 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.

Please also note the license of the curses library used.
}

{$gnu-pascal,I-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit {$ifdef THIS_IS_WINCRT} WinCRT {$else} CRT {$endif};

interface

uses GPC;

const
  { CRT modes }
  BW40          = 0;            { 40x25 Black/White }
  CO40          = 1;            { 40x25 Color }
  BW80          = 2;            { 80x25 Black/White }
  CO80          = 3;            { 80x25 Color }
  Mono          = 7;            { 80x25 Black/White }
  Font8x8       = 256;          { Add-in for 80x43 or 80x50 mode }

  { Mode constants for Turbo Pascal 3.0 compatibility }
  C40           = CO40;
  C80           = CO80;

  { Foreground and background color constants }
  Black         = 0;
  Blue          = 1;
  Green         = 2;
  Cyan          = 3;
  Red           = 4;
  Magenta       = 5;
  Brown         = 6;
  LightGray     = 7;

  { Foreground color constants }
  DarkGray      = 8;
  LightBlue     = 9;
  LightGreen    = 10;
  LightCyan     = 11;
  LightRed      = 12;
  LightMagenta  = 13;
  Yellow        = 14;
  White         = 15;

  { Add-in for blinking }
  Blink         = 128;

type
  TTextAttr = Byte;

var
  { If False (default: True), catch interrupt signals (SIGINT;
    Ctrl-C), and other flow control characters as well as SIGTERM,
    SIGHUP and perhaps other signals }
  CheckBreak  : Boolean = True; asmname 'crt_CheckBreak';

  { If True (default : False), replace Ctrl-Z by #0 in input }
  CheckEOF    : Boolean = False; asmname 'crt_CheckEOF';

  { Ignored -- meaningless in this context }
  DirectVideo : Boolean = True;

  { Ignored -- curses or the terminal driver will take care of that
    when necessary }
  CheckSnow   : Boolean = False;

  { Current (sic!) text mode }
  LastMode    : Word = 3; asmname 'crt_LastMode';

  { Current text attribute }
  TextAttr    : TTextAttr = 7; asmname 'crt_TextAttr';

  { Window upper left coordinates. *Obsolete*! Please see WindowMin
    below. }
  WindMin     : Word = not Word (0); asmname 'crt_WindMin';

  { Window lower right coordinates. *Obsolete*! Please see WindowMax
    below. }
  WindMax     : Word = not Word (0); asmname 'crt_WindMax';

procedure AssignCRT (var F : Text);
function  KeyPressed : Boolean; asmname 'crt_keypressed';
function  ReadKey : Char; asmname 'crt_readkey';

{ Not effective on all platforms, see above. See also SetScreenSize
  and SetMonochrome. }
procedure TextMode (Mode : Integer);

procedure Window (x1, y1, x2, y2 : Integer); asmname 'crt_window';
procedure GotoXY (x, y : Integer); asmname 'crt_gotoxy';
function  WhereX : Integer; asmname 'crt_wherex';
function  WhereY : Integer; asmname 'crt_wherey';
procedure ClrScr; asmname 'crt_clrscr';
procedure ClrEOL; asmname 'crt_clreol';
procedure InsLine; asmname 'crt_insline';
procedure DelLine; asmname 'crt_delline';
procedure TextColor (Color : TTextAttr);
procedure TextBackground (Color : TTextAttr);
procedure LowVideo;
procedure HighVideo;
procedure NormVideo;
procedure Delay (MS : Word); asmname 'crt_delay';

{ Not available on all platforms, see above }
procedure Sound (Hz : Word); asmname 'crt_sound';
procedure NoSound; asmname 'crt_nosound';

{ =================== Extensions over BP's CRT =================== }

{
  Initializes the CRT unit. Should be called before using any of
  CRT's routines.

  Note: For BP compatibility, CRT is initizalized automatically when
  (almost) any of its routines are used for the first time. In this
  case, some defaults are set to match BP more closely. In
  particular, the PC charset (see SetPCCharSet) is enabled then
  (disabled otherwise), and the update level (see SetCRTUpdate) is
  set to UpdateRegularly (UpdateWaitInput otherwise). This feature
  is meant for BP compatibility *only*. Don't rely on it when
  writing a new program. Use CRTInit then, and set the defaults to
  the values you want explicitly.

  SetCRTUpdate is one of those few routines which will not cause CRT
  to be initialized immediately, and a value set with it will
  survive both automatic and explicit initialization, so you can use
  it to set the update level without caring which way CRT will be
  initialized. (This does not apply to SetPCCharSet. Since it works
  on a per-panel basis, it has to initialize CRT first, so there is
  a panel to start with.)

  If you terminate the program before calling CRTInit or any routine
  that causes automatic initialization, curses will never be
  initialized, so e.g., the screen won't be cleared. This can be
  useful, e.g., to check the command line arguments (or anything
  else) and if there's a problem, write an error and abort. Just be
  sure to write the error to StdErr, not Output (because Output will
  be assigned to CRT, and therefore writing to Output will cause CRT
  to be initialized, and because errors belong to StdErr, anyway),
  and to call `RestoreTerminal (True)' before (just to be sure, in
  case some code -- perhaps added later, or hidden in the
  initialization of some unit -- does initialize CRT).
}
procedure CRTInit; asmname 'crt_init';

{ Changes the input and output file and the terminal description CRT
  uses. Only effective with ncurses, and only if called before CRT
  is initialized (automatically or explicitly; see the comments for
  CRTInit). If TerminalType is nil, the default will be used. If
  InputFile and/or OutputFile are null, they remain unchanged. }
procedure CRTSetTerminal (TerminalType : CString; var InputFile,
  OutputFile : AnyFile); asmname 'crt_SetTerminal';

{ If called, causes CRT to save the previous screen contents if
  possible (see the comments at the beginning of the unit), and
  restore them when calling RestoreTerminal (True). After
  RestoreTerminal (False), they're saved again, and at the end of
  the program, they're restored. Should be called before
  initializing CRT (using CRTInit or automatically), otherwise the
  previous screen contents may already have been overwritten. Note
  that on some terminals (e.g., xterms and similar), this is the
  default behaviour. Ignored under XCurses, because the program it
  uses its own window, anyway. }
procedure CRTSavePreviousScreen; asmname 'crt_save_previous_screen';

{ Returns True if CRTSavePreviousScreen was called and is available.
  Note that CRTSavePreviousScreenWorks does not work reliably until
  CRT is initialized, while CRTSavePreviousScreen should be called
  before CRT is initialized. That's why they are two separate
  routines. }
function  CRTSavePreviousScreenWorks : Boolean;
  asmname 'crt_save_previous_screen_works';

{ If CRT is initialized automatically, not via CRTInit, and
  CRTAutoInitProc is not nil, it will be called before actually
  initializing CRT. }
var
  CRTAutoInitProc : procedure = nil; asmname 'crt_auto_init_proc';

{ Aborts with a runtime error saying that CRT was not initialized.
  If you set CRTAutoInitProc to this procedure, you can effectively
  disable CRT's automatic initialization. }
procedure CRTNotInitialized; asmname 'crt_not_initialized';

{ Set terminal to shell or curses mode. An internal procedure
  registered by CRT via RegisterRestoreTerminal does this as well,
  so CRTSetCursesMode has to be called only in unusual situations,
  e.g. after executing a process that changes terminal modes, but
  does not restore them (e.g. because it crashed or was killed), and
  the process was not executed with the Execute routine, and
  RestoreTerminal was not called otherwise. If you set it to False
  temporarily, be sure to set it back to True before doing any
  further CRT operations, otherwise the result may be strange. }
procedure CRTSetCursesMode (On : Boolean);
  asmname 'crt_set_curses_mode';

{ Do the same as `RestoreTerminal (True)', but also clear the screen
  after restoring the terminal (except for XCurses, because the
  program uses its own window, anyway). Does not restore and save
  again the previous screen contents if CRTSavePreviousScreen was
  called. }
procedure RestoreTerminalClearCRT;
  asmname 'crt_RestoreTerminalClearCRT';

{ Keyboard and character graphics constants -- BP compatible! =:-}
{$i crt.inc}

var
  { Tells whether the XCurses version of CRT is used }
  XCRT : Boolean = {$ifdef XCURSES} True {$else} False {$endif};
  asmname 'crt_XCRT';

  { If True (default: False), the Beep procedure and writing #7 do a
    Flash instead }
  VisualBell : Boolean = False; asmname 'crt_VisualBell';

type
  TKey = Word;

  TCursorShape = (CursorIgnored, CursorHidden, CursorNormal,
  CursorFat, CursorBlock);

  TCRTUpdate = (UpdateNever, UpdateWaitInput, UpdateInput,
                UpdateRegularly, UpdateAlways);

  TPoint = record
    X, Y : Integer
  end;

  PCharAttr = ^TCharAttr;
  TCharAttr = record
    Ch        : Char;
    Attr      : TTextAttr;
    PCCharSet : Boolean
  end;

  PCharAttrs = ^TCharAttrs;
  TCharAttrs = array [1 .. MaxVarSize div SizeOf (TCharAttr)] of
  TCharAttr;

  TWindowXY = packed record
    {$ifdef __BYTES_BIG_ENDIAN__}
    Fill : Integer (BitSizeOf (Word) - 16);
    Y, X : Word (8)
    {$else}
    X, Y : Word (8);
    Fill : Integer (BitSizeOf (Word) - 16)
    {$endif}
  end;

{ Make sure TWindowXY really has the same size as WindMin and
  WindMax. If not, compilation will abort here with `division by
  zero'. Otherwise, the value of the constant will always be 1, and
  is of no further interest. }
const
  AssertTWindowXYSize = 1 / Ord ((SizeOf (TWindowXY) = SizeOf
  (WindMin)) and
                                 (SizeOf (TWindowXY) = SizeOf
  (WindMax)));

var
  { Window upper and left coordinates. More comfortable to access
    than WindMin, but also *obsolete*. WindMin and WindowMin still
    work, but have the problem that they implicitly limit the window
    size to 255x255 characters. Though that's not really small for a
    text window, it's easily possible to create bigger ones (e.g. in
    an xterm with a small font, on a high resolution screen and/or
    extending over several virutal desktops). When using coordinates
    greater than 254, the corresponding bytes in WindowMin/WindowMax
    will be set to 254, so, e.g., programs which do
    `Inc (WindowMin.X)' will not fail quite as badly (but probably
    still fail). The routines Window and GetWindow use Integer
    coordinates, and don't suffer from any of these problems, so
    they should be used instead. }
  WindowMin : TWindowXY absolute WindMin;

  { Window lower right coordinates. More comfortable to access than
    WindMax, but also *obsolete* (see the comments for WindowMin).
    Use Window and GetWindow instead. }
  WindowMax : TWindowXY absolute WindMax;

  { The attribute set by NormVideo }
  NormAttr : TTextAttr = 7; asmname 'crt_NormAttr';

  { Tells whether the current mode is monochrome }
  IsMonochrome : Boolean = False; asmname 'crt_IsMonochrome';

  { This value can be set to a combination of the shFoo constants
    and will be ORed to the actual shift state returned by
    GetShiftState. This can be used to easily simulate shift keys on
    systems where they can't be accessed. }
  VirtualShiftState : Integer = 0; asmname 'crt_VirtualShiftState';

{ Returns the size of the screen. Note: In BP's WinCRT unit,
  ScreenSize is a variable. But since writing to it from a program
  is pointless, anyway, providing a function here should not cause
  any incompatibility. }
function  ScreenSize : TPoint; asmname 'crt_GetScreenSize';

{ Change the screen size if possible. }
procedure SetScreenSize (x, y : Integer);
  asmname 'crt_SetScreenSize';

{ Turns colors off or on. }
procedure SetMonochrome (Monochrome : Boolean);
  asmname 'crt_SetMonochrome';

{ Tell which modifier keys are currently pressed. The result is a
  combination of the shFoo constants defined in crt.inc, or 0 on
  systems where this function is not supported -- but note
  VirtualShiftState. If supported, ReadKey automatically converts
  kbIns and kbDel keys to kbShIns and kbShDel, resp., if shift is
  pressed. }
function  GetShiftState : Integer; asmname 'crt_getshiftstate';

{ Get the extent of the current window. Use this procedure rather
  than reading WindMin and WindMax or WindowMin and WindowMax, since
  this routine allows for window sizes larger than 255. The
  resulting coordinates are 1-based (like in Window, unlike WindMin,
  WindMax, WindowMin and WindowMax). Any of the parameters may be
  null in case you're interested in only some of the coordinates. }
procedure GetWindow (var x1, y1, x2, y2 : Integer);
  asmname 'crt_getwindow';

{
  Determine when to update the screen. The possible values are the
  following. The given conditions *guarantee* updates. However,
  updates may occur more frequently (even if the update level is set
  to UpdateNever). About the default value, see the comments for
  CRTInit.

  UpdateNever     : never (unless explicitly requested with
                    CRTUpdate)
  UpdateWaitInput : before Delay and CRT input, unless typeahead is
                    detected
  UpdateInput     : before Delay and CRT input
  UpdateRegularly : before Delay and CRT input and otherwise in
                    regular intervals without causing too much
                    refresh. This uses a timer on some systems
                    (currently, Unix with ncurses). This was created
                    for BP compatibility, but for many applications,
                    a lower value causes less flickering in the
                    output, and additionally, timer signals won't
                    disturb other operations. Under DJGPP, this
                    always updates immediately, but this fact should
                    not mislead DJGPP users into thinking this is
                    always so.
  UpdateAlways    : after each output. This can be very slow. (Not
                    so under DJGPP, but this fact should not mislead
                    DJGPP users...)
}
procedure SetCRTUpdate (UpdateLevel : TCRTUpdate);
  asmname 'crt_setupdatelevel';

{ Do an update now, independently of the update level }
procedure CRTUpdate; asmname 'crt_update_immediately';

{ Do an update now and completely redraw the screen }
procedure CRTRedraw; asmname 'crt_redraw';

{ Return Ord (key) for normal keys and $100 * Ord (fkey) for
  function keys }
function  ReadKeyWord : TKey; asmname 'crt_readkeyword';

{ Extract the character and scan code from a TKey value }
function  Key2Char (k : TKey) : Char;
function  Key2Scan (k : TKey) : Char;

{ Convert a key to upper/lower case if it is a letter, leave it
  unchanged otherwise }
function  UpCaseKey (k : TKey) : TKey;
function  LoCaseKey (k : TKey) : TKey;

{ Return key codes for the combination of the given key with Ctrl,
  Alt, AltGr or Extra, resp. Returns 0 if the combination is
  unknown. }
function  CtrlKey  (ch : Char) : TKey; asmname 'crt_ctrlkey';
function  AltKey   (ch : Char) : TKey; asmname 'crt_altkey';
function  AltGrKey (ch : Char) : TKey; asmname 'crt_altgrkey';
function  ExtraKey (ch : Char) : TKey; asmname 'crt_extrakey';

{ Check if k is a pseudo key generated by a deadly signal trapped }
function  IsDeadlySignal (k : TKey) : Boolean;

{ Produce a beep or a screen flash }
procedure Beep; asmname 'crt_beep';
procedure Flash; asmname 'crt_flash';

{ Get size of current window (calculated using GetWindow) }
function  GetXMax : Integer;
function  GetYMax : Integer;

{ Get/goto an absolute position }
function  WhereXAbs : Integer;
function  WhereYAbs : Integer;
procedure GotoXYAbs (X, Y : Integer);

{ Turn scrolling on or off }
procedure SetScroll (State : Boolean); asmname 'crt_setscroll';

{ Read back whether scrolling is enabled }
function  GetScroll : Boolean; asmname 'crt_getscroll';

{ Determine whether to interpret non-ASCII characters as PC ROM
  characters (True), or in a system dependent way (False). About the
  default, see the comments for CRTInit. }
procedure SetPCCharSet (PCCharSet : Boolean);
  asmname 'crt_setpccharset';

{ Read back the value set by SetPCCharSet }
function  GetPCCharSet : Boolean; asmname 'crt_getpccharset';

{ Determine whether to interpret #7, #8, #10, #13 as control
  characters (True, default), or as graphics characters (False) }
procedure SetControlChars (UseControlChars : Boolean);
  asmname 'crt_setcontrolchars';

{ Read back the value set by SetControlChars }
function  GetControlChars : Boolean; asmname 'crt_getcontrolchars';

procedure SetCursorShape (Shape : TCursorShape);
  asmname 'crt_setcursorshape';
function  GetCursorShape : TCursorShape;
  asmname 'crt_getcursorshape';

procedure HideCursor;
procedure HiddenCursor;
procedure NormalCursor;
procedure FatCursor;
procedure BlockCursor;
procedure IgnoreCursor;

{ Simulates a block cursor by writing a block character onto the
  cursor position. The procedure automatically finds the topmost
  visible panel whose shape is not CursorIgnored and places the
  simulated cursor there (just like the hardware cursor), with
  matching attributes, if the cursor shape is CursorFat or
  CursorBlock (otherwise, no simulated cursor is shown).

  Calling this procedure again makes the simulated cursor disappear.
  In particular, to get the effect of a blinking cursor, you have to
  call the procedure repeatedly (say, 8 times a second). CRT will
  not do this for you, since it does not intend to be your main
  event loop. }
procedure SimulateBlockCursor; asmname 'crt_SimulateBlockCursor';

{ Makes the cursor simulated by SimulateBlockCursor disappear if it
  is active. Does nothing otherwise. You should call this procedure
  after using SimulateBlockCursor before doing any further CRT
  output (though failing to do so should not hurt except for
  possibly leaving the simulated cursor in its old position longer
  than it should). }
procedure SimulateBlockCursorOff;
  asmname 'crt_SimulateBlockCursorOff';

function  GetTextColor : Integer;
function  GetTextBackground : Integer;

{ Write string at the given position without moving the cursor.
  Truncated at the right margin. }
procedure WriteStrAt (x, y : Integer; s : String; Attr : TTextAttr);

{ Write (several copies of) a char at then given position without
  moving the cursor. Truncated at the right margin. }
procedure WriteCharAt (x, y, Count : Integer; Ch : Char; Attr :
  TTextAttr);

{ Write characters with specified attributes at the given position
  without moving the cursor. Truncated at the right margin. }
procedure WriteCharAttrAt (x, y, Count : Integer; CharAttr :
  PCharAttrs); asmname 'crt_writecharattrat';

{ Write a char while moving the cursor }
procedure WriteChar (Ch : Char);

{ Read a character from a screen position }
procedure ReadChar (x, y : Integer; var Ch : Char; var Attr :
  TTextAttr); asmname 'crt_readchar';

{ Change only text attributes, leave characters. Truncated at the
  right margin. }
procedure ChangeTextAttr (x, y, Count : Integer; NewAttr :
  TTextAttr);

{ Fill current window }
procedure FillWin (Ch : Char; Attr : TTextAttr);
  asmname 'crt_fillwin';

{ Calculate size of memory required for ReadWin in current window. }
function  WinSize : SizeType; asmname 'crt_winsize';

{ Save window contents. Buf must be WinSize bytes large. }
procedure ReadWin (var Buf); asmname 'crt_readwin';

{ Restore window contents saved by ReadWin. The size of the current
  window must match the size of the window from which ReadWin was
  used, but the position may be different. }
procedure WriteWin (const Buf); asmname 'crt_writewin';

type
  WinState = record
    x1, y1, x2, y2, WhereX, WhereY, NewX1, NewY1, NewX2, NewY2 :
  Integer;
    TextAttr : TTextAttr;
    CursorShape : TCursorShape;
    ScreenSize : TPoint;
    Buffer : ^Byte
  end;

{ Save window position and size, cursor position, text attribute and
  cursor shape -- *not* the window contents. }
procedure SaveWin (var State : WinState);

{ Make a new window (like Window), and save the contents of the
  screen below the window as well as the position and size, cursor
  position, text attribute and cursor shape of the old window. }
procedure MakeWin (var State : WinState; x1, y1, x2, y2 : Integer);

{ Create window in full size, save previous text mode and all values
  that MakeWin does. }
procedure SaveScreen (var State : WinState);

{ Restore the data saved by SaveWin, MakeWin or SaveScreen. }
procedure RestoreWin (var State : WinState);

{ Panels }

type
  TPanel = Pointer;

function  GetActivePanel : TPanel; asmname 'crt_GetActivePanel';
procedure PanelNew                 (x1, y1, x2, y2 : Integer;
  BindToBackground : Boolean); asmname 'crt_PanelNew';
procedure PanelDelete              (Panel : TPanel);
  asmname 'crt_PanelDelete';
procedure PanelBindToBackground    (Panel : TPanel; Bind : Boolean);
  asmname 'crt_PanelBindToBackground';
function  PanelIsBoundToBackground (Panel : TPanel) : Boolean;
  asmname 'crt_PanelIsBoundToBackground';
procedure PanelActivate            (Panel : TPanel);
  asmname 'crt_PanelActivate';
procedure PanelHide                (Panel : TPanel);
  asmname 'crt_PanelHide';
procedure PanelShow                (Panel : TPanel);
  asmname 'crt_PanelShow';
function  PanelHidden              (Panel : TPanel) : Boolean;
  asmname 'crt_PanelHidden';
procedure PanelTop                 (Panel : TPanel);
  asmname 'crt_PanelTop';
procedure PanelBottom              (Panel : TPanel);
  asmname 'crt_PanelBottom';
procedure PanelMoveAbove           (Panel, Above : TPanel);
  asmname 'crt_PanelMoveAbove';
procedure PanelMoveBelow           (Panel, Below : TPanel);
  asmname 'crt_PanelMoveBelow';
function  PanelAbove               (Panel : TPanel) : TPanel;
  asmname 'crt_PanelAbove';
function  PanelBelow               (Panel : TPanel) : TPanel;
  asmname 'crt_PanelBelow';

{ TPCRT compatibility }

{ Write a string at the given position without moving the cursor.
  Truncated at the right margin. }
procedure WriteString (const s : String; y, x : Integer);

{ Write a string at the given position with the given attribute
  without moving the cursor. Truncated at the right margin. }
procedure FastWriteWindow (const s : String; y, x : Integer; Attr :
  TTextAttr);

{ Write a string at the given absolute position with the given
  attribute without moving the cursor. Truncated at the right
  margin. }
procedure FastWrite       (const s : String; y, x : Integer; Attr :
  TTextAttr);

{ WinCrt compatibility }

const
  cw_UseDefault = Integer ($8000);

var
  WindowOrg  : TPoint = (cw_UseDefault, cw_UseDefault); { Ignored }
  WindowSize : TPoint = (cw_UseDefault, cw_UseDefault); { Ignored }
  Cursor     : TPoint = (0, 0); { Cursor location, 0-based }
  asmname 'crt_cursor_pos';
  Origin     : TPoint = (0, 0); { Ignored }
  InactiveTitle : PChar = '(Inactive %s)'; { Ignored }
  AutoTracking : Boolean = True; { Ignored }
  WindowTitle : {$ifdef __BP_TYPE_SIZES__}
                array [0 .. 79] of Char
                {$else}
                TStringBuf
                {$endif}; { CRT window title, ignored }

procedure InitWinCrt; asmname 'crt_initwincrt';

{ Halts the program }
procedure DoneWinCrt; attribute (noreturn);
  asmname 'crt_donewincrt';

procedure WriteBuf (Buffer : PChar; Count : SizeType);
  asmname 'crt_writebuf';

function  ReadBuf (Buffer : PChar; Count : SizeType) : SizeType;
  asmname 'crt_readbuf';

{ 0-based coordinates! }
procedure CursorTo (x, y : Integer); asmname 'crt_cursorto';

{ Dummy }
procedure ScrollTo (x, y : Integer); asmname 'crt_scrollto';

{ Dummy }
procedure TrackCursor; asmname 'crt_trackcursor';

BP compatibility: Dos

The following listing contains the interface of the Dos unit.

This is a portable implementation of most routines from BP's `Dos' unit. A few routines that are Dos -- or even x86 real mode -- specific, are only available if `__BP_UNPORTABLE_ROUTINES__' is defined, section BP Incompatibilities.

The same functionality and much more is available in the Run Time System, section Pascal declarations for GPC's Run Time System. In some cases, the RTS routines have the same interface as the routines in this unit (e.g. `GetEnv', `FSplit', `FExpand', `FSearch'), in other cases, they have different names and/or easier and less limiting interfaces (e.g. `ReadDir' etc. vs. `FindFirst' etc.), and are often more efficient.

Therefore, using this unit is not recommended in newly written programs.

{
Portable BP compatible Dos unit

This unit supports most of the routines and declarations of BP's Dos
unit.

NOTES:

- The procedures Keep, GetIntVec, SetIntVec are not supported since
  they make only sense for Dos real-mode programs (and GPC compiled
  programs do not run in real-mode, even on x86 under Dos). The
  procedures Intr and MsDos are only supported under DJGPP if
  `__BP_UNPORTABLE_ROUTINES__' is defined (with the
  `-D__BP_UNPORTABLE_ROUTINES__' option). A few other routines are
  also only supported with this define, but on all platforms (but
  they are crude hacks, that's why they are not supported without
  this define).

- The internal structure of file variables (FileRec and TextRec) is
  different in GPC. However, as far as TFDDs are concerned, there
  are other ways to achieve the same in GPC, see the GPC unit.

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

Authors: Frank Heckenbach <frank@pascal.gnu.de>
         Prof. Abimbola A. Olowofoyeku <African_Chief@bigfoot.com>

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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit Dos;

interface

uses GPC, System;

type
  Byte8 = Cardinal (8);
  TDosAttr = Word;
  GPC_AnyFile = AnyFile; { in order to have AnyFile parameters,
                           while AnyFile is redefined below }

const
  { File attribute constants }
  ReadOnly      = $01;
  Hidden        = $02; { set for dot files except '.' and '..' }
  SysFile       = $04; { not supported }
  VolumeID      = $08; { not supported }
  Directory     = $10;
  Archive       = $20; { means: not executable }
  {$local W-} AnyFile = $3f; {$endlocal}

  { Flag bit masks -- only used by the unportable Dos routines }
  FCarry     = 1;
  FParity    = 4;
  FAuxiliary = $10;
  FZero      = $40;
  FSign      = $80;
  FOverflow  = $800;

  { DosError codes }
  DosError_FileNotFound = 2;
  DosError_PathNotFound = 3;
  DosError_AccessDenied = 5;
  DosError_InvalidMem   = 9;
  DosErorr_InvalidEnv   = 10;
  DosError_NoMoreFiles  = 18;
  DosError_IOError      = 29;
  DosError_ReadFault    = 30;

type
  { String types. Not used in this unit, but declared for
    compatibility. }
  ComStr  = String [127];        { Command line string }
  PathStr = String [79];         { File pathname string }
  DirStr  = String [67];         { Drive and directory string }
  NameStr = String [8];          { File name string }
  ExtStr  = String [4];          { File extension string }

  TextBuf = array [0 .. 127] of Char;

  { Search record used by FindFirst and FindNext }
  SearchRecFill = packed array [1 .. 21] of Byte8;
  SearchRec = {$ifdef __BP_TYPE_SIZES__} packed {$endif} record
    Fill : SearchRecFill;
    Attr : Byte8;
    Time, Size : LongInt;
    Name : {$ifdef __BP_TYPE_SIZES__}
           String [12]
           {$else}
           TString
           {$endif}
  end;

  { Date and time record used by PackTime and UnpackTime }
  DateTime = record
    Year, Month, Day, Hour, Min, Sec : Word
  end;

  { 8086 CPU registers -- only used by the unportable Dos routines }
  Registers = record
  case Boolean of
    False : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Word16);
    True  : (AL, AH, BL, BH, CL, CH, DL, DH : Byte8)
  end;

var
  { Error status variable }
  DosError : Integer = 0;

procedure GetDate (var Year, Month, Day, DayOfWeek : Word);
  asmname '_p_getdate';
procedure GetTime (var Hour, Minute, Second, Sec100 : Word);
  asmname '_p_gettime';
procedure GetCBreak (var BreakOn : Boolean); asmname '_p_getcbreak';
procedure SetCBreak (BreakOn : Boolean); asmname '_p_setcbreak';
{ GetVerify and SetVerify are dummies except for DJGPP (in the
  assumption that any real OS knows by itself when and how to verify
  its disks). }
procedure GetVerify (var VerifyOn : Boolean);
  asmname '_p_getverify';
procedure SetVerify (VerifyOn : Boolean); asmname '_p_setverify';
function  DiskFree (Drive : Byte) : LongInt; asmname '_p_diskfree';
function  DiskSize (Drive : Byte) : LongInt; asmname '_p_disksize';
procedure GetFAttr (var F (*@@anyfile : GPC_AnyFile*); var Attr :
  TDosAttr); asmname '_p_getfattr';
procedure SetFAttr (var F (*@@anyfile : GPC_AnyFile*); Attr :
  TDosAttr); asmname '_p_setfattr';
procedure GetFTime (var F (*@@anyfile : GPC_AnyFile*); var aTime :
  LongInt); asmname '_p_getftime';
procedure SetFTime (var F (*@@anyfile : GPC_AnyFile*); aTime :
  LongInt); asmname '_p_setftime';

{ FindFirst and FindNext are quite inefficient since they emulate
  all the brain-dead Dos stuff. If at all possible, the standard
  routines OpenDir, ReadDir and CloseDir (in the GPC unit) should be
  used instead. }
procedure FindFirst (const Path : String; Attr : TDosAttr; var SR :
  SearchRec); asmname '_p_findfirst';
procedure FindNext  (var SR : SearchRec); asmname '_p_findnext';

procedure FindClose (var SR : SearchRec); asmname '_p_findclose';
procedure UnpackTime (P : LongInt; var T : DateTime);
  asmname '_p_unpacktime';
procedure PackTime (const T : DateTime; var P : LongInt);
  asmname '_p_packtime';
function  FSearch (const aFileName, DirList : String) : TString;
  asmname '_p_fsearch';
function  FExpand (const Path : String) : TString;
  asmname '_p_fexpand';
procedure FSplit  (const Path : String; var Dir, Name, Ext :
  String); asmname '_p_fsplit';
function  EnvCount : Integer;
function  EnvStr (EnvIndex : Integer) : TString;
function  GetEnv (const EnvVar : String) : TString;
  asmname '_p_getenv';
procedure SwapVectors;
{ Exec executes a process via Execute, so RestoreTerminal is called
  with
  the argument True before and False after executing the process. }
procedure Exec (const Path, Params : String);
function  DosExitCode : Word;

{ Unportable Dos-only routines and declarations }

{$ifdef __BP_UNPORTABLE_ROUTINES__}
{$ifdef DJGPP}
{ These are unportable Dos-only declarations and routines, since
  interrupts are Dos and CPU specific (and have no place in a
  high-level program, anyway). }
procedure Intr (IntNo : Byte; var Regs : Registers);
  asmname '_p_intr';
procedure MsDos (var Regs : Registers); asmname '_p_msdos';
{$endif}

{ Though probably all non-Dos system have versions numbers as well,
  returning them here would usually not do what is expected, e.g.
  testing if certain Dos features are present by comparing the
  version number. Therefore, this routine always returns 7 (i.e.,
  version 7.0) on non-Dos systems, in the assumption that any real
  OS has at least the features of Dos 7. }
function  DosVersion : Word; asmname '_p_dosversion';

{ Changing the system date and time is a system administration task,
  not allowed to a normal process. On non-Dos systems, these
  routines emulate the changed date/time, but only for GetTime and
  GetDate (not the RTS date/time routines), and only for this
  process, not for child processes or even the parent process or
  system-wide. }
procedure SetDate (Year, Month, Day : Word); asmname '_p_setdate';
procedure SetTime (Hour, Minute, Second, Sec100 : Word);
  asmname '_p_settime';
{$endif}

Overcome some differences between Dos and Unix

The following listing contains the interface of the DosUnix unit.

This unit is there to overcome some of those differences between Dos and Unix systems that are not automatically hidden by GPC and the Run Time System. Currently features translation of bash style input/output redirections (`foo 2>&1') into `redir' calls for DJGPP (`redir -eo foo') and a way to read files with Dos CR/LF pairs on any system.

When necessary, new features will be added to the unit in future releases.

{
Some routines to support writing programs portable between Dos and
Unix. Perhaps it would be a good idea not to put features to make
Dos programs Unix-compatible (shell redirections) and vice versa
(reading Dos files from Unix) together into one unit, but rather
into two units, DosCompat and UnixCompat or so -- let's wait and
see, perhaps when more routines suited for this/these unit(s) will
be found, the design will become clearer...

Copyright (C) 1998-2001 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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit DosUnix;

interface

uses GPC;

{
  This function is meant to be used when you want to invoke a system
  shell command (e.g. via Execute or Exec from the Dos unit) and
  want to specify input/output redirections for the command invoked.
  It caters for the different syntax between DJGPP (with the `redir'
  utility) and other systems.

  To use it, code your redirections in bash style (see the table
  below) in your command line string, pass this string to this
  function, and the function's result to Execute or the other
  routines.

  The function translates the following bash style redirections
  (characters in brackets are optional) into a redir call under Dos
  systems except EMX, and leave them unchanged under other systems.
  Note: `redir' comes with DJGPP, but it should be possible to
  install it on other Dos systems as well. OS/2's shell, however,
  supports bash style redirections, I was told, so we don't
  translate on EMX.

  [0]<     file      redirect standard input from file
  [1]>[|]  file      redirect standard output to file
  [1]>>    file      append standard output to file
  [1]>&2             redirect standard output to standard error
  2>[|]    file      redirect standard error to file
  2>>      file      append standard error to file
  2>&1               redirect standard error to standard output
  &> file            redirect both standard output and standard
                     error to file
}
function TranslateRedirections (const Command : String) : TString;

{ Under Unix, translates CR/LF pairs to single LF characters when
  reading from f, and back when writing to f. Under Dos, does
  nothing because the run time system alrady does this job. In the
  result, you can read both Dos and Unix files, and files written
  will be Dos. }
procedure AssignDos (var f : AnyFile; const Name : String);

Higher level file and directory handling

The following listing contains the interface of the FileUtils unit.

This unit provides some routines for file and directory handling on a higher level than those provided by the RTS.

{
Some routines for file and directory handling on a higher level than
those provided by the RTS.

Copyright (C) 2000-2001 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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit FileUtils;

interface

uses GPC;

type
  TStringProc = procedure (const Name : String);

{
  Finds all files matching the given Mask in the given Directory and
  all subdirectories of it. The matching is done using all wildcards
  and brace expansion, like MultiFileNameMatch does. For each file
  found, FileAction is executed. For each directory found (including
  `.' and `..' if they match the Mask!), DirAction is executed. If
  MainDirFirst is True, this happens before processing the files in
  the directory and below, otherwise afterwards. (The former is
  useful, e.g., if this is used to copy a directory tree and
  DirAction does a MkDir, while the latter behaviour is required
  when removing a directory tree and DirAction does a RmDir.) Both
  FileAction and DirAction can be nil in which case nothing is done
  for files or directories found, respectively. (If DirAction is
  nil, the value of DirsFirst does not matter.) Of course,
  FileAction and DirAction may also be identical. The procedure
  leaves InOutRes set in case of any error. If FileAction or
  DirAction return with InOutRes set, FindFiles recognizes this and
  returns immediately.
}
(*@@iocritical*)procedure FindFiles (const Directory, Mask : String;
  MainDirFirst : Boolean;
                     FileAction, DirAction : TStringProc);
  asmname '_p_findfiles';

{
  Creates the directory given by Path and all directories in between
  that are necessary. Does not report an error if Path already
  exists and is a directory, but, of course, if it cannot be created
  because of missing permissions or because Path already exists as a
  file.
}
(*@@iocritical*)procedure MkDirs (const Path : String);
  asmname '_p_mkdirs';

{
  Removes Path if empty as well as any empty parent directories.
  Does not report an error if Path is not empty.
}
(*@@iocritical*)procedure RmDirs (const Path : String);
  asmname '_p_rmdirs';

{
  Copies the file Source to Dest, overwriting Dest if it exists and
  can be written to. Returns any errors in IOResult. If Mode >= 0,
  it will change the permissions of Dest to Mode immediately after
  creating it and before writing any data to it. That's useful,
  e.g., if Dest is not meant to be world-readable, because if you'd
  do a ChMod after FileCopy, you would leave the data readable
  (depending on the umask) during the copying. If Mode < 0, Dest
  will be set to the same permissions Source has. In any case, Dest
  will be set to the modification time of Source after coyping.
}
(*@@iocritical*)procedure FileCopy (const Source, Dest : String;
  Mode : Integer); asmname '_p_filecopy';

{
  Creates a backup of FileName in the directory BackupDirectory or,
  if BackupDirectory is empty, in the directory of FileName. Errors
  are returned in IOResult, but if FileName does not exist, this
  does *not* count as an error (i.e., BackupFile will just return
  without setting IOResult then). If OnlyUserReadable is True, the
  backup file will be given only user-read permissions, nothing
  else.

  The name chosen for the backup depends on the Simple and Short
  parameters. The short names will fit into 8+3 characters (whenever
  possible), while the long ones conform to the conventions used by
  most GNU tools. If Simple is True, a simple backup file name will
  be used, and previous backups under the same name will be
  overwritten (if possible). Otherwise, backups will be numbered,
  where the number is chosen to be larger than all existing backups,
  so it will be unique and increasing in chronological order. In
  particular:

  Simple  Short  Backup name
  True    True   Base name of FileName plus '.bak'
  False   True   Base name of FileName plus '.b' plus a number
  True    False  Base name plus extension of FileName plus '~'
  False   False  Base name plus extension of FileName plus '.~', a
                 number and '~'
}
(*@@iocritical*)procedure BackupFile (const FileName,
  BackupDirectory : String; Simple, Short, OnlyUserReadable :
  Boolean); asmname '_p_backupfile';

Arithmetic with unlimited size and precision

The following listing contains the interface of the GMP unit.

This unit provides an interface to the GNU Multiprecision Library to perform arithmetic on integer, rational and real numbers of unlimited size and precision.

To use this unit, you will need the `gmp' library which can be found in ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/.

{
Definitions for GNU multiple precision functions: arithmetic with
integer, rational and real numbers of arbitrary size and precision.

Translation of the C header (gmp.h) of the GMP library. Tested with
GMP 2.0.2 and 3.0.1.

To use the GMP unit, you will need the GMP library which can be
found in ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/ .

Copyright (C) 1998-2001 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.

Please also note the license of the GMP library.
}

{$gnu-pascal,I-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}
{$nested-comments}

{ If this define is set, routines new in GMP 3.x will be made
  available. The define will have no effect on the other interface
  changes between GMP 2.x and 3.x, i.e. the other routines will work
  correctly even if this define is set incorrectly, except on 64 bit
  machines, Crays and other systems where the types are different
  between the GMP versions. Otherwise, the only possible problem if
  setting the define while using GMP 2.x are linking errors if you
  actually use any of the new routines. }
{$ifndef HAVE_GMP2}
{$define HAVE_GMP3}
{$endif}

unit gmp;

interface

uses GPC;

{$if defined (__mips) && defined (_ABIN32) && defined (HAVE_GMP3)}
{ Force the use of 64-bit limbs for all 64-bit MIPS CPUs if ABI
  permits. }
{$define _LONG_LONG_LIMB}
{$endif}

type
  {$ifdef _SHORT_LIMB}
  mp_limb_t        = Cardinal;
  mp_limb_signed_t = Integer;
  {$elif defined (_LONG_LONG_LIMB)}
  mp_limb_t        = LongCard;
  mp_limb_signed_t = LongInt;
  {$else}
  mp_limb_t        = MedCard;
  mp_limb_signed_t = MedInt;
  {$endif}

  mp_ptr           = ^mp_limb_t;

  {$if defined (_CRAY) && !defined (_CRAYMPP) && defined
  (HAVE_GMP3)}
  mp_size_t        = Integer;
  mp_exp_t         = Integer;
  {$else}
  mp_size_t        = MedInt;
  mp_exp_t         = MedInt;
  {$endif}

  mpz_t = record
    mp_alloc,
    mp_size  : {$if defined (__MP_SMALL__) && defined (HAVE_GMP3)}
               ShortInt
               {$else}
               Integer
               {$endif};
    mp_d     : mp_ptr
  end;

  mpz_array_ptr = ^mpz_array;
  mpz_array = array [0 .. MaxVarSize div SizeOf (mpz_t)] of mpz_t;

  mpq_t = record
    mp_num,
    mp_den : mpz_t
  end;

  mpf_t = record
    mp_prec,
    mp_size : Integer;
    mp_exp  : mp_exp_t;
    mp_d    : mp_ptr
  end;

  TAllocFunction    = function (Size : SizeType) : Pointer;
  TReAllocFunction  = function (var Dest : Pointer; OldSize,
  NewSize : SizeType) : Pointer;
  TDeAllocProcedure = procedure (Src : Pointer; Size : SizeType);

procedure mp_set_memory_functions (AllocFunction : TAllocFunction;
                                   ReAllocFunction :
  TReAllocFunction;
                                   DeAllocProcedure :
  TDeAllocProcedure); asmname '__gmp_set_memory_functions';

function mp_bits_per_limb : Integer; asmname '_p_mp_bits_per_limb';

{**************** Integer (i.e. Z) routines.  ****************}

procedure mpz_init             (var Dest : mpz_t);
  asmname '__gmpz_init';
procedure mpz_clear            (var Dest : mpz_t);
  asmname '__gmpz_clear';
function  mpz_realloc          (var Dest : mpz_t; NewAlloc :
  mp_size_t) : Pointer; asmname '__gmpz_realloc';
procedure mpz_array_init       (Dest : mpz_array_ptr; ArraySize,
  FixedNumBits : mp_size_t); asmname '__gmpz_array_init';

procedure mpz_set              (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_set';
procedure mpz_set_ui           (var Dest : mpz_t; Src : MedCard);
  asmname '__gmpz_set_ui';
procedure mpz_set_si           (var Dest : mpz_t; Src : MedInt);
  asmname '__gmpz_set_si';
procedure mpz_set_d            (var Dest : mpz_t; Src : Double);
  asmname '__gmpz_set_d';
procedure mpz_set_q            (var Dest : mpz_t; Src : mpq_t);
  asmname '__gmpz_set_q';
procedure mpz_set_f            (var Dest : mpz_t; Src : mpf_t);
  asmname '__gmpz_set_f';
function  mpz_set_str          (var Dest : mpz_t; Src : CString;
  Base : Integer) : Integer; asmname '__gmpz_set_str';

procedure mpz_init_set         (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_init_set';
procedure mpz_init_set_ui      (var Dest : mpz_t; Src : MedCard);
  asmname '__gmpz_init_set_ui';
procedure mpz_init_set_si      (var Dest : mpz_t; Src : MedInt);
  asmname '__gmpz_init_set_si';
procedure mpz_init_set_d       (var Dest : mpz_t; Src : Double);
  asmname '__gmpz_init_set_d';
function  mpz_init_set_str     (var Dest : mpz_t; Src : CString;
  Base : Integer) : Integer; asmname '__gmpz_init_set_str';

function  mpz_get_ui           (protected var Src : mpz_t) :
  MedCard; asmname '__gmpz_get_ui';
function  mpz_get_si           (protected var Src : mpz_t) : MedInt;
  asmname '__gmpz_get_si';
function  mpz_get_d            (protected var Src : mpz_t) : Double;
  asmname '__gmpz_get_d';
{ Pass nil for Dest to let the function allocate memory for it }
function  mpz_get_str          (Dest : CString; Base : Integer;
  protected var Src : mpz_t) : CString; asmname '__gmpz_get_str';

procedure mpz_add              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_add';
procedure mpz_add_ui           (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_add_ui';
procedure mpz_sub              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_sub';
procedure mpz_sub_ui           (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_sub_ui';
procedure mpz_mul              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_mul';
procedure mpz_mul_ui           (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_mul_ui';
procedure mpz_mul_2exp         (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_mul_2exp';
procedure mpz_neg              (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_neg';
procedure mpz_abs              (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_abs';
procedure mpz_fac_ui           (var Dest : mpz_t; Src : MedCard);
  asmname '__gmpz_fac_ui';

procedure mpz_tdiv_q           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_tdiv_q';
procedure mpz_tdiv_q_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_tdiv_q_ui';
procedure mpz_tdiv_r           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_tdiv_r';
procedure mpz_tdiv_r_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_tdiv_r_ui';
procedure mpz_tdiv_qr          (var DestQ, DestR : mpz_t; protected
  var Src1, Src2 : mpz_t); asmname '__gmpz_tdiv_qr';
procedure mpz_tdiv_qr_ui       (var DestQ, DestR : mpz_t; protected
  var Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_tdiv_qr_ui';

procedure mpz_fdiv_q           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_fdiv_q';
function  mpz_fdiv_q_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard) : MedCard;
  asmname '__gmpz_fdiv_q_ui';
procedure mpz_fdiv_r           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_fdiv_r';
function  mpz_fdiv_r_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard) : MedCard;
  asmname '__gmpz_fdiv_r_ui';
procedure mpz_fdiv_qr          (var DestQ, DestR : mpz_t; protected
  var Src1, Src2 : mpz_t); asmname '__gmpz_fdiv_qr';
function  mpz_fdiv_qr_ui       (var DestQ, DestR : mpz_t; protected
  var Src1 : mpz_t; Src2 : MedCard) : MedCard;
  asmname '__gmpz_fdiv_qr_ui';
function  mpz_fdiv_ui          (protected var Src1 : mpz_t; Src2 :
  MedCard) : MedCard; asmname '__gmpz_fdiv_ui';

procedure mpz_cdiv_q           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_cdiv_q';
function  mpz_cdiv_q_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard) : MedCard;
  asmname '__gmpz_cdiv_q_ui';
procedure mpz_cdiv_r           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_cdiv_r';
function  mpz_cdiv_r_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard) : MedCard;
  asmname '__gmpz_cdiv_r_ui';
procedure mpz_cdiv_qr          (var DestQ, DestR : mpz_t; protected
  var Src1,Src2 : mpz_t); asmname '__gmpz_cdiv_qr';
function  mpz_cdiv_qr_ui       (var DestQ, DestR : mpz_t; protected
  var Src1 : mpz_t; Src2 : MedCard) : MedCard;
  asmname '__gmpz_cdiv_qr_ui';
function  mpz_cdiv_ui          (protected var Src1 : mpz_t;
  Src2:MedCard) : MedCard; asmname '__gmpz_cdiv_ui';

procedure mpz_mod              (var Dest : mpz_t; protected var
  Src1,Src2 : mpz_t); asmname '__gmpz_mod';
procedure mpz_divexact         (var Dest : mpz_t; protected var
  Src1,Src2 : mpz_t); asmname '__gmpz_divexact';

procedure mpz_tdiv_q_2exp      (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_tdiv_q_2exp';
procedure mpz_tdiv_r_2exp      (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_tdiv_r_2exp';
procedure mpz_fdiv_q_2exp      (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_fdiv_q_2exp';
procedure mpz_fdiv_r_2exp      (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_fdiv_r_2exp';

procedure mpz_powm             (var Dest : mpz_t; protected var
  Base, Exponent, Modulus : mpz_t); asmname '__gmpz_powm';
procedure mpz_powm_ui          (var Dest : mpz_t; protected var
  Base : mpz_t; Exponent : MedCard; protected var Modulus : mpz_t);
  asmname '__gmpz_powm_ui';
procedure mpz_pow_ui           (var Dest : mpz_t; protected var
  Base : mpz_t; Exponent : MedCard); asmname '__gmpz_pow_ui';
procedure mpz_ui_pow_ui        (var Dest : mpz_t; Base, Exponent :
  MedCard); asmname '__gmpz_ui_pow_ui';

procedure mpz_sqrt             (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_sqrt';
procedure mpz_sqrtrem          (var Dest, DestR : mpz_t; protected
  var Src : mpz_t); asmname '__gmpz_sqrtrem';
function  mpz_perfect_square_p (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_perfect_square_p';

function  mpz_probab_prime_p   (protected var Src : mpz_t;
  Repetitions : Integer) : Integer; asmname '__gmpz_probab_prime_p';
procedure mpz_gcd              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_gcd';
function  mpz_gcd_ui           (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard) : MedCard; asmname '__gmpz_gcd_ui';
procedure mpz_gcdext           (var Dest, DestA, DestB : mpz_t;
  protected var SrcA, SrcB : mpz_t); asmname '__gmpz_gcdext';
function  mpz_invert           (var Dest : mpz_t; protected var Src,
  Modulus : mpz_t) : Integer; asmname '__gmpz_invert';
function  mpz_jacobi           (protected var Src1, Src2 : mpz_t) :
  Integer; asmname '__gmpz_jacobi';
function  mpz_legendre         (protected var Src1, Src2 : mpz_t) :
  Integer; asmname '__gmpz_legendre';

function  mpz_cmp              (protected var Src1, Src2 : mpz_t) :
  Integer; asmname '__gmpz_cmp';
function  mpz_cmp_ui           (protected var Src1 : mpz_t; Src2 :
  MedCard) : Integer; asmname '__gmpz_cmp_ui';
function  mpz_cmp_si           (protected var Src1 : mpz_t; Src2 :
  MedInt) : Integer; asmname '__gmpz_cmp_si';
function  mpz_sgn              (protected var Src : mpz_t) :
  Integer;

procedure mpz_and              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_and';
procedure mpz_ior              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_ior';
procedure mpz_com              (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_com';
function  mpz_popcount         (protected var Src : mpz_t) :
  MedCard; asmname '__gmpz_popcount';
function  mpz_hamdist          (protected var Src1, Src2 : mpz_t) :
  MedCard; asmname '__gmpz_hamdist';
function  mpz_scan0            (protected var Src : mpz_t;
  StartingBit : MedCard) : MedCard; asmname '__gmpz_scan0';
function  mpz_scan1            (protected var Src : mpz_t;
  StartingBit : MedCard) : MedCard; asmname '__gmpz_scan1';
procedure mpz_setbit           (var Dest : mpz_t; BitIndex :
  MedCard); asmname '__gmpz_setbit';
procedure mpz_clrbit           (var Dest : mpz_t; BitIndex :
  MedCard); asmname '__gmpz_clrbit';

procedure mpz_random           (var Dest : mpz_t; MaxSize :
  mp_size_t); asmname '__gmpz_random';
procedure mpz_random2          (var Dest : mpz_t; MaxSize :
  mp_size_t); asmname '__gmpz_random2';
function  mpz_sizeinbase       (protected var Src : mpz_t; Base :
  Integer) : SizeType; asmname '__gmpz_sizeinbase';

{**************** Rational (i.e. Q) routines.  ****************}

procedure mpq_canonicalize     (var Dest : mpq_t);
  asmname '__gmpq_canonicalize';

procedure mpq_init             (var Dest : mpq_t);
  asmname '__gmpq_init';
procedure mpq_clear            (var Dest : mpq_t);
  asmname '__gmpq_clear';
procedure mpq_set              (var Dest : mpq_t; protected var
  Src : mpq_t); asmname '__gmpq_set';
procedure mpq_set_z            (var Dest : mpq_t; protected var
  Src : mpz_t); asmname '__gmpq_set_z';
procedure mpq_set_ui           (var Dest : mpq_t; Nom, Den :
  MedCard); asmname '__gmpq_set_ui';
procedure mpq_set_si           (var Dest : mpq_t; Nom : MedInt;
  Den : MedCard); asmname '__gmpq_set_si';

procedure mpq_add              (var Dest : mpq_t; protected var
  Src1, Src2 : mpq_t); asmname '__gmpq_add';
procedure mpq_sub              (var Dest : mpq_t; protected var
  Src1, Src2 : mpq_t); asmname '__gmpq_sub';
procedure mpq_mul              (var Dest : mpq_t; protected var
  Src1, Src2 : mpq_t); asmname '__gmpq_mul';
procedure mpq_div              (var Dest : mpq_t; protected var
  Src1, Src2 : mpq_t); asmname '__gmpq_div';
procedure mpq_neg              (var Dest : mpq_t; protected var
  Src : mpq_t); asmname '__gmpq_neg';
procedure mpq_inv              (var Dest : mpq_t; protected var
  Src : mpq_t); asmname '__gmpq_inv';

function  mpq_cmp              (protected var Src1, Src2 : mpq_t) :
  Integer; asmname '__gmpq_cmp';
function  mpq_cmp_ui           (protected var Src1 : mpq_t; Nom2,
  Den2 : MedCard) : Integer; asmname '__gmpq_cmp_ui';
function  mpq_sgn              (protected var Src : mpq_t) :
  Integer;
function  mpq_equal            (protected var Src1, Src2 : mpq_t) :
  Integer; asmname '__gmpq_equal';

function  mpq_get_d            (protected var Src : mpq_t) : Double;
  asmname '__gmpq_get_d';
procedure mpq_set_num          (var Dest : mpq_t; protected var
  Src : mpz_t); asmname '__gmpq_set_num';
procedure mpq_set_den          (var Dest : mpq_t; protected var
  Src : mpz_t); asmname '__gmpq_set_den';
procedure mpq_get_num          (var Dest : mpz_t; protected var
  Src : mpq_t); asmname '__gmpq_get_num';
procedure mpq_get_den          (var Dest : mpz_t; protected var
  Src : mpq_t); asmname '__gmpq_get_den';

{**************** Float (i.e. R) routines.  ****************}

procedure mpf_set_default_prec (Precision : MedCard);
  asmname '__gmpf_set_default_prec';
procedure mpf_init             (var Dest : mpf_t);
  asmname '__gmpf_init';
procedure mpf_init2            (var Dest : mpf_t; Precision :
  MedCard); asmname '__gmpf_init2';
procedure mpf_clear            (var Dest : mpf_t);
  asmname '__gmpf_clear';
procedure mpf_set_prec         (var Dest : mpf_t; Precision :
  MedCard); asmname '__gmpf_set_prec';
function  mpf_get_prec         (protected var Src : mpf_t) :
  MedCard; asmname '__gmpf_get_prec';
procedure mpf_set_prec_raw     (var Dest : mpf_t; Precision :
  MedCard); asmname '__gmpf_set_prec_raw';

procedure mpf_set              (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_set';
procedure mpf_set_ui           (var Dest : mpf_t; Src : MedCard);
  asmname '__gmpf_set_ui';
procedure mpf_set_si           (var Dest : mpf_t; Src : MedInt);
  asmname '__gmpf_set_si';
procedure mpf_set_d            (var Dest : mpf_t; Src : Double);
  asmname '__gmpf_set_d';
procedure mpf_set_z            (var Dest : mpf_t; protected var
  Src : mpz_t); asmname '__gmpf_set_z';
procedure mpf_set_q            (var Dest : mpf_t; protected var
  Src : mpq_t); asmname '__gmpf_set_q';
function  mpf_set_str          (var Dest : mpf_t; Src : CString;
  Base : Integer) : Integer; asmname '__gmpf_set_str';

procedure mpf_init_set         (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_init_set';
procedure mpf_init_set_ui      (var Dest : mpf_t; Src : MedCard);
  asmname '__gmpf_init_set_ui';
procedure mpf_init_set_si      (var Dest : mpf_t; Src : MedInt);
  asmname '__gmpf_init_set_si';
procedure mpf_init_set_d       (var Dest : mpf_t; Src : Double);
  asmname '__gmpf_init_set_d';
function  mpf_init_set_str     (var Dest : mpf_t; Src : CString;
  Base : Integer) : Integer; asmname '__gmpf_init_set_str';

function  mpf_get_d            (protected var Src : mpf_t) : Double;
  asmname '__gmpf_get_d';
{ Pass nil for Dest to let the function allocate memory for it }
function  mpf_get_str          (Dest : CString; var Exponent :
  mp_exp_t; Base : Integer;
                                NumberOfDigits : SizeType; protected
  var Src : mpf_t) : CString; asmname '__gmpf_get_str';

procedure mpf_add              (var Dest : mpf_t; protected var
  Src1, Src2 : mpf_t); asmname '__gmpf_add';
procedure mpf_add_ui           (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_add_ui';
procedure mpf_sub              (var Dest : mpf_t; protected var
  Src1, Src2 : mpf_t); asmname '__gmpf_sub';
procedure mpf_ui_sub           (var Dest : mpf_t; Src1 : MedCard;
  protected var Src2 : mpf_t); asmname '__gmpf_ui_sub';
procedure mpf_sub_ui           (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_sub_ui';
procedure mpf_mul              (var Dest : mpf_t; protected var
  Src1, Src2 : mpf_t); asmname '__gmpf_mul';
procedure mpf_mul_ui           (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_mul_ui';
procedure mpf_div              (var Dest : mpf_t; protected var
  Src1, Src2 : mpf_t); asmname '__gmpf_div';
procedure mpf_ui_div           (var Dest : mpf_t; Src1 : MedCard;
  protected var Src2 : mpf_t); asmname '__gmpf_ui_div';
procedure mpf_div_ui           (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_div_ui';
procedure mpf_sqrt             (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_sqrt';
procedure mpf_sqrt_ui          (var Dest : mpf_t; Src : MedCard);
  asmname '__gmpf_sqrt_ui';
procedure mpf_neg              (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_neg';
procedure mpf_abs              (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_abs';
procedure mpf_mul_2exp         (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_mul_2exp';
procedure mpf_div_2exp         (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_div_2exp';

function  mpf_cmp              (protected var Src1, Src2 : mpf_t) :
  Integer; asmname '__gmpf_cmp';
function  mpf_cmp_si           (protected var Src1 : mpf_t; Src2 :
  MedInt) : Integer;
function  mpf_cmp_ui           (protected var Src1 : mpf_t; Src2 :
  MedCard) : Integer;
function  mpf_eq               (protected var Src1, Src2 : mpf_t;
  NumberOfBits : MedCard) : Integer; asmname '__gmpf_eq';
procedure mpf_reldiff          (var Dest : mpf_t; protected var
  Src1, Src2 : mpf_t); asmname '__gmpf_reldiff';
function  mpf_sgn              (protected var Src : mpf_t)  :
  Integer;

procedure mpf_random2          (var Dest : mpf_t; MaxSize :
  mp_size_t; MaxExp : mp_exp_t); asmname '__gmpf_random2';

{$if 0} (*@@ commented out because they use C file pointers *)
function  mpz_inp_str          (var Dest : mpz_t; Src : CFilePtr;
  Base : Integer) : SizeType; asmname '__gmpz_inp_str';
function  mpz_inp_raw          (var Dest : mpz_t; Src : CFilePtr) :
  SizeType ; asmname '__gmpz_inp_raw';
function  mpz_out_str          (Dest : CFilePtr; Base : Integer;
  protected var Src : mpz_t) : SizeType; asmname '__gmpz_out_str';
function  mpz_out_raw          (Dest : CFilePtr; protected var Src :
  mpz_t) : SizeType ; asmname '__gmpz_out_raw';
(*@@ mpf_out_str has a bug in GMP 2.0.2: it writes a spurious #0
  before the exponent for negative numbers*)
function  mpf_out_str          (Dest : CFilePtr; Base : Integer;
  NumberOfDigits : SizeType; protected var Src : mpf_t) : SizeType;
  asmname '__gmpf_out_str';
function  mpf_inp_str          (var Dest : mpf_t; Src : CFilePtr;
  Base : Integer) : SizeType; asmname '__gmpf_inp_str';
{$endif}

{ New declarations in GMP 3.x. @@ Mostly untested! }
{$ifdef HAVE_GMP3}

{ Available random number generation algorithms. }
type
  gmp_randalg_t = (GMPRandAlgLC { Linear congruential. });

const
  GMPRandAlgDefault = GMPRandAlgLC;

{ Linear congruential data struct. }
type
  gmp_randata_lc = record
    a : mpz_t; { Multiplier. }
    c : MedCard; { Adder. }
    m : mpz_t; { Modulus (valid only if m2exp = 0). }
    m2exp : MedCard; { If <> 0, modulus is 2 ^ m2exp. }
  end;

type
  gmp_randstate_t = record
    Seed : mpz_t; { Current seed. }
    Alg : gmp_randalg_t;  { Algorithm used. }
    AlgData : record { Algorithm specific data. }
    case gmp_randalg_t of
      GMPRandAlgLC : (lc : ^gmp_randata_lc); { Linear congruential.
  }
    end
  end;

procedure gmp_randinit         (var State : gmp_randstate_t; Alg :
  gmp_randalg_t; ...); asmname '__gmp_randinit';
procedure gmp_randinit_lc      (var State : gmp_randstate_t; A :
  mpz_t; C : MedCard; M : mpz_t); asmname '__gmp_randinit_lc';
procedure gmp_randinit_lc_2exp (var State : gmp_randstate_t; A :
  mpz_t; C : MedCard; M2Exp : MedCard);
  asmname '__gmp_randinit_lc_2exp';
procedure gmp_randseed         (var State : gmp_randstate_t; Seed :
  mpz_t); asmname '__gmp_randseed';
procedure gmp_randseed_ui      (var State : gmp_randstate_t; Seed :
  MedCard); asmname '__gmp_randseed_ui';
procedure gmp_randclear        (var State : gmp_randstate_t);
  asmname '__gmp_randclear';

procedure mpz_addmul_ui        (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_addmul_ui';
procedure mpz_bin_ui           (var Dest : mpz_t; protected var
  Src1 : mpz_t; Src2 : MedCard); asmname '__gmpz_bin_ui';
procedure mpz_bin_uiui         (var Dest : mpz_t; Src1, Src2 :
  MedCard); asmname '__gmpz_bin_uiui';
function  mpz_cmpabs           (protected var Src1, Src2 : mpz_t) :
  Integer; asmname '__gmpz_cmpabs';
function  mpz_cmpabs_ui        (protected var Src1 : mpz_t; Src2 :
  MedCard) : Integer; asmname '__gmpz_cmpabs_ui';
procedure mpz_dump             (protected var Src : mpz_t);
  asmname '__gmpz_dump';
procedure mpz_fib_ui           (var Dest : mpz_t; Src : MedCard);
  asmname '__gmpz_fib_ui';
function  mpz_fits_sint_p      (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_fits_sint_p';
function  mpz_fits_slong_p     (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_fits_slong_p';
function  mpz_fits_sshort_p    (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_fits_sshort_p';
function  mpz_fits_uint_p      (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_fits_uint_p';
function  mpz_fits_ulong_p     (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_fits_ulong_p';
function  mpz_fits_ushort_p    (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_fits_ushort_p';
procedure mpz_lcm              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_lcm';
procedure mpz_nextprime        (var Dest : mpz_t; protected var
  Src : mpz_t); asmname '__gmpz_nextprime';
function  mpz_perfect_power_p  (protected var Src : mpz_t) :
  Integer; asmname '__gmpz_perfect_power_p';
function  mpz_remove           (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t) : MedCard; asmname '__gmpz_remove';
function  mpz_root             (var Dest : mpz_t; protected var
  Src : mpz_t; N : MedCard) : Integer; asmname '__gmpz_root';
procedure mpz_rrandomb         (var ROP : mpz_t; var State :
  gmp_randstate_t; N : MedCard); asmname '__gmpz_rrandomb';
procedure mpz_swap             (var v1, v2 : mpz_t);
  asmname '__gmpz_swap';
function  mpz_tdiv_ui          (protected var Src1 : mpz_t; Src2 :
  MedCard) : MedCard; asmname '__gmpz_tdiv_ui';
function  mpz_tstbit           (protected var Src1 : mpz_t; Src2 :
  MedCard) : Integer; asmname '__gmpz_tstbit';
procedure mpz_urandomb         (ROP : mpz_t; var State :
  gmp_randstate_t; N : MedCard); asmname '__gmpz_urandomb';
procedure mpz_urandomm         (ROP : mpz_t; var State :
  gmp_randstate_t; N : mpz_t); asmname '__gmpz_urandomm';
procedure mpz_xor              (var Dest : mpz_t; protected var
  Src1, Src2 : mpz_t); asmname '__gmpz_xor';

procedure mpq_set_d            (var Dest : mpq_t; Src : Double);
  asmname '__gmpq_set_d';

procedure mpf_ceil             (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_ceil';
procedure mpf_floor            (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_floor';
procedure mpf_pow_ui           (var Dest : mpf_t; protected var
  Src1 : mpf_t; Src2 : MedCard); asmname '__gmpf_pow_ui';
procedure mpf_trunc            (var Dest : mpf_t; protected var
  Src : mpf_t); asmname '__gmpf_trunc';
procedure mpf_urandomb         (ROP : mpf_t; var State :
  gmp_randstate_t; N : MedCard); asmname '__gmpf_urandomb';

const
  GMPErrorNone = 0;
  GMPErrorUnsupportedArgument = 1;
  GMPErrorDivisionByZero = 2;
  GMPErrorSqrtOfNegative = 4;
  GMPErrorInvalidArgument = 8;
  GMPErrorAllocate = 16;

var
  gmp_errno : Integer; asmname '__gmp_errno'; external;

{$endif}

{ Extensions to the GMP library, implemented in this unit }

procedure mpf_exp    (var Dest : mpf_t; protected var Src : mpf_t);
procedure mpf_ln     (var Dest : mpf_t; protected var Src : mpf_t);
procedure mpf_pow    (var Dest : mpf_t; protected var Src1, Src2 :
  mpf_t);
procedure mpf_arctan (var c : mpf_t; protected var x : mpf_t);
procedure mpf_pi     (var c : mpf_t);

Turbo Power compatibility, etc.

The following listing contains the interface of the GPCUtil unit.

This unit provides some utility routines for compatibility to some units available for BP, like some Turbo Power units.

{
Some utility routines for compatibility to some units available for
BP, like some `Turbo Power' units.

@@NOTE - SOME OF THE ROUTINES IN THIS UNIT MAY NOT WORK CORRECTLY.
TEST CAREFULLY AND USE WITH CARE!

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

Authors: Prof. Abimbola A. Olowofoyeku <African_Chief@bigfoot.com>
         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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit GPCUtil;

interface

uses GPC;

{ Replace all occurences of OldC with NewC in s and return the
  result }
function  ReplaceChar (const s : String; OldC, NewC : Char) :
  TString;

{ Return the current working directory }
function  ThisDirectory : TString;
  asmname '_p_get_current_directory';

{ Does a directory exist? }
function  IsDirectory (const aFileName : String) : Boolean;
  asmname '_p_directory_exists';

{ Break a string into 2 parts, using Ch as a marker }
function  BreakStr (const Src : String; var Dest1, Dest2 : String;
  Ch : Char) : Boolean;

{ Convert a CString to an Integer }
function  PChar2Int (s : CString) : Integer;

{ Convert a CString to a LongInt }
function  PChar2Long (s : CString) : LongInt;

{ Convert a CString to a Double }
function  PChar2Double (s : CString) : Double;

{ Search for s as an executable in the path and return its location
  (full pathname) }
function  PathLocate (const s : String) : TString;

{ Copy file Src to Dest and return the number of bytes written }
function  CopyFile (const Src, Dest : String; BufSize : Integer) :
  LongInt;

{ Copy file Src to Dest and return the number of bytes written;
  report the number of bytes written versus total size of the source
  file }
function  CopyFileEx (const Src, Dest : String; BufSize : Integer;
  function Report (Reached, Total : LongInt) : LongInt) : LongInt;

{ Turbo Power compatibility }

{ Execute the program prog. Dummy1 and Dummy2 are for compatibility
  only; they are ignored. }
function  ExecDos (const Prog : String; Dummy1 : Boolean; Dummy2 :
  Pointer) : Integer;

{ Return whether Src exists in the path as an executable -- if so
  return its full location in Dest }
function  ExistOnPath (const Src : String; var Dest : String) :
  Boolean;

{ Does file name s exist? }
function  ExistFile (const aFileName : String) : Boolean;
  asmname '_p_file_exists';

{ Return just the directory path of Path. Returns DirSelf +
  DirSeparator if Path contains no directory. }
function  JustPathName (const Path : String) : TString;
  asmname '_p_dir_from_path';

{ Return just the file name part without extension of Path. Empty if
  Path contains no file name. }
function  JustFileName (const Path : String) : TString;
  asmname '_p_name_from_path';

{ Return just the extension of Path. Empty if Path contains no
  extension. }
function  JustExtension (const Path : String) : TString;
  asmname '_p_ext_from_path';

{ Change the extension of s to Ext (do not include the dot!) }
function  ForceExtension (const s, Ext : String) : TString;

{ Return the full pathname of Path }
function  FullPathName (const Path : String) : TString;
  asmname '_p_fexpand';

{ Add a DirSeparator to the end of s if there is not already one }
function  AddBackSlash (const s : String) : TString;
  asmname '_p_forceadddirseparator';

{ Convert Integer to PChar; uses CStringNew to allocate memory for
  the result, so you must call StrDispose to free the memory later }
function  Int2PChar (i : Integer) : PChar;

{ Convert Integer to string }
function  Int2Str (i : Integer) : TString;

{ Convert string to Integer }
function  Str2Int (const s : String; var i : Integer) : Boolean;

{ Convert string to LongInt }
function  Str2Long (const s : String; var i : LongInt) : Boolean;

{ Convert string to Double }
function  Str2Real (const s : String; var i : Double) : Boolean;

{ Return a string stripped of leading spaces }
function  TrimLead (const s : String) : TString;
  asmname '_p_trimleft_str';

{ Return a string stripped of trailing spaces }
function  TrimTrail (const s : String) : TString;
  asmname '_p_trimright_str';

{ Return a string stripped of leading and trailing spaces }
function  Trim (const s : String) : TString;
  asmname '_p_trimboth_str';

{ Return a string right-padded to length Len with ch }
function  PadCh (const s : String; ch : Char; Len : Integer) :
  TString;

{ Return a string right-padded to length Len with spaces }
function  Pad (const s : String; Len : Integer) : TString;

{ Return a string left-padded to length Len with ch }
function  LeftPadCh (const s : String; ch : Char; Len : Byte) :
  TString;

{ Return a string left-padded to length Len with blanks }
function  LeftPad (const s : String; Len : Integer) : TString;

{ Convert a string to lowercase }
function  StLoCase (const s : String) : TString;
  asmname '_p_locase_str';

{ Convert a string to uppercase }
function  StUpCase (const s : String) : TString;
  asmname '_p_upcase_str';

{ Uniform access to big memory blocks for GPC and BP. Of course, for
  programs that are meant only for GPC, you can use the usual
  New/Dispose
  routines. But for programs that should compile with GPC and BP,
  you can
  use the following routines for GPC. In the GPC unit for BP
  (gpc-bp.pas),
  you can find emulations for BP that try to provide access to as
  much
  memory as possible, despite the limitations of BP. The backdraw is
  that
  this memory cannot be used freely, but only with the following
  moving
  routines. }

type
  PBigMem = ^TBigMem;
  TBigMem (MaxNumber : Integer) = record
    { Public fields }
    Number, BlockSize : SizeType;
    Mappable : Boolean;
    { Private fields }
    Pointers : array [1 .. MaxNumber] of ^Byte
  end;

{ Note: the number of blocks actually allocated may be smaller than
  WantedNumber. Check the Number field of the result. }
function  AllocateBigMem (WantedNumber, aBlockSize : SizeType;
  WantMappable : Boolean) : PBigMem;
procedure DisposeBigMem (p : PBigMem);
procedure MoveToBigMem (var Source; p : PBigMem; BlockNumber :
  SizeType);
procedure MoveFromBigMem (p : PBigMem; BlockNumber : SizeType; var
  Dest);
{ Maps a big memory block into normal addressable memory and returns
  its address. The memory must have been allocated with
  WantMappable = True. The mapping is only valid until the next
  MapBigMem call. }
function  MapBigMem (p : PBigMem; BlockNumber : SizeType) : Pointer;

Primitive heap checking

The following listing contains the interface of the HeapMon unit.

This unit provide a rather primitive means to watch the heap, i.e. check if all pointers that were allocated are released again. This is meant as a debugging help for avoiding memory leaks.

More extensive heap checking is provided by libraries like `efence' which can be used in GPC programs without special provisions.

{
A unit to watch the heap, i.e. check if all pointers that were
allocated are released again. This is meant as a debugging help
for avoiding memory leaks.

Use it in the main program before all other units. When, at the
end of the program, some pointers that were allocated, have not
been released, the unit prints a message to StdErr. Only pointers
allocated via the Pascal mechanisms (New, GetMem) are tracked, not
pointers allocated with direct libc calls or from C code. After a
runtime error, pointers are not checked.

Note that many units and libraries allocate memory for their own
purposes and don't always release it at the end. Therefore, the
usefulness of this unit is rather limited.

Copyright (C) 1998-2001 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 HeapMon;

interface

uses GPC;

{ This unit has an empty interface. It is automatically activated
  when used. }

`MD5' Message Digests

The following listing contains the interface of the MD5 unit.

This unit provides functions to compute `MD5' message digest of files or memory blocks, according to the definition of `MD5' in RFC 1321 from April 1992.

{
Functions to compute MD5 message digest of files or memory blocks,
according to the definition of MD5 in RFC 1321 from April 1992.

IMPORTANT NOTE: This unit is distributed under the GNU GPL, NOT
under the GNU LGPL under which most of the other GPC units are
distributed. This means that you must distribute any code that
uses this unit under the GPL as well, which means that you have to
make the source code available whenever you distribute a binary of
the code, and that you must allow recipients to modify the code
and redistribute it under the GPL.

Copyright (C) 1995, 1996, 2000-2001 Free Software Foundation, Inc.

Based on the C code written by Ulrich Drepper
<drepper@gnu.ai.mit.edu>, 1995 as part of the GNU C Library.

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.
}

{$gnu-pascal,I-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit MD5;

interface

uses GPC;

{ Representation of a MD5 value. It is always in little endian byte
  order and therefore portable. }
type
  Card8 = Cardinal (8);
  TMD5 = array [1 .. 16] of Card8;

{ Computes MD5 message digest for Length bytes in Buffer. }
procedure MD5Buffer (const Buffer; Length : SizeType; var MD5 :
  TMD5); asmname '_p_md5_buffer';

{ Computes MD5 message digest for the contents of the file f. }
(*@@iocritical*)procedure MD5File (var f : File; var MD5 : TMD5);
  asmname '_p_md5_file';

{ Initializes a MD5 value with zeros. }
procedure MD5Clear (var MD5 : TMD5); asmname '_p_md5_clear';

{ Compares two MD5 values for equality. }
function MD5Compare (const Value1, Value2 : TMD5) : Boolean;
  asmname '_p_md5_compare';

{ Converts an MD5 value to a string. }
function MD5Str ((*@@fjf382 const*) MD5 : TMD5) = s : TString;
  asmname '_p_md5_str';

{ Converts a string to an MD5 value. Returns True if successful. }
function MD5Val (const s : String; var MD5 : TMD5) : Boolean;
  asmname '_p_md5_val';

{ Composes two MD5 values to a single one. }
function MD5Compose (const Value1, Value2 : TMD5) = Dest : TMD5;
  asmname '_p_md5_compose';

BP compatibility: Overlay

The following listing contains the interface of the Overlay unit.

This is just a dummy replacement for BP's `Overlay' unit, since GPC doesn't need overlays.

{
Dummy BP compatible overlay unit for GPC

Copyright (C) 1998-2001 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 Overlay;

interface

const
  ovrOk = 0;
  ovrError = - 1;
  ovrNotFound = - 2;
  ovrNoMemory = - 3;
  ovrIOError = - 4;
  ovrNoEMSDriver = - 5;
  ovrNoEMSMemory = - 6;

const
  OvrEmsPages  : Word = 0;
  OvrTrapCount : Word = 0;
  OvrLoadCount : Word = 0;
  OvrFileMode  : Byte = 0;

type
  OvrReadFunc = function (OvrSeg : Word) : Integer;

var
  OvrReadBuf : OvrReadFunc;
  OvrResult  : Integer = 0;

procedure OvrInit (aFileName : String);
procedure OvrInitEMS;
procedure OvrSetBuf (Size : LongInt);
function  OvrGetBuf : LongInt;
procedure OvrSetRetry (Size : LongInt);
function  OvrGetRetry : LongInt;
procedure OvrClearBuf;

Start a child process, connected with pipes, also on Dos

The following listing contains the interface of the Pipe unit.

This unit provides routines to start a child process and write to/read from its Input/Output/StdErr via pipes. All of this is emulated transparently under Dos as far as possible.

{
Piping data from and to processes and process signaling

Copyright (C) 1998-2001 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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

{ Keep this consistent with the one in pipec.c }
{$if defined (MSDOS) or defined (__MINGW32__)}
{$define NOFORK}
{$endif}

unit Pipe;

interface

uses GPC;

(*$local W-*)type PPStrings = ^TPStrings;TPStrings (Count: Cardinal)
  = array [1 .. Count] of ^String; (*@@two unit bug with definition
  in gpc.pas in programs using these two units*) (*$endlocal*)

const
  PipeForking = {$ifdef NOFORK} False {$else} True {$endif};

type
  TProcedure = procedure;

  PWaitPIDResult = ^TWaitPIDResult;
  TWaitPIDResult = (PIDNothing, PIDExited, PIDSignaled, PIDStopped,
  PIDUnknown);

  PPipeProcess = ^TPipeProcess;
  TPipeProcess = record
    PID       : Integer;        { Process ID of process forked }
    SignalPID : Integer;        { Process ID to send the signal to.
                                  Equals PID by default }
    OpenPipes : Integer;        { Number of pipes to/from the
                                  process, for internal use }
    Signal    : Integer;        { Send this signal (if not 0) to the
                                  process after all pipes have been
                                  closed after some time }
    Seconds   : Integer;        { Wait so many seconds before
                                  sending the signal if the process
                                  has not terminated by itself }
    Wait      : Boolean;        { Wait for the process, even longer
                                  than Seconds seconds, after
                                  sending the signal (if any) }
    Result    : PWaitPIDResult; { Default nil. If a pointer to a
                                  variable is stored here, its
                                  destination will contain the
                                  information whether the process
                                  terminated by itself, or was
                                  terminated or stopped by a signal,
                                  when waiting after closing the
                                  pipes }
    Status    : ^Integer;       { Default nil. If a pointer to a
                                  variable is stored here, its
                                  destination will contain the exit
                                  status if the process terminated
                                  by itself, or the number of the
                                  signal otherwise, when waiting
                                  after closing the pipes }
  end;

const
  EFork  = 600; { cannot fork `%s'' }
  ESpawn = 601; { cannot spawn `%s'' }

var
  { Default values for TPipeProcess records created by Pipe }
  DefaultPipeSignal  : Integer = 0;
  DefaultPipeSeconds : Integer = 0;
  DefaultPipeWait    : Boolean = True;

{
  The procedure Pipe starts a process whose name is given by
  ProcessName, with the given parameters (can be null if no
  parameters) and environment, and create pipes from and/or to the
  process' standard input/output/error. ProcessName is searched for
  in the PATH with FSearchExecutable. Any of ToInputFile,
  FromOutputFile and FromStdErrFile can be null if the corresponding
  pipe is not wanted. FromOutputFile and FromStdErrFile may be
  identical, in which case standard output and standard error are
  redirected to the same pipe. The behaviour of other pairs of files
  being identical is undefined, and useless, anyway. The files are
  Assigned and Reset or Rewritten as appropriate. Errors are
  returned in IOResult. If Process is not null, a pointer to a
  record is stored there, from which the PID of the process created
  can be read, and by writing to which the action after all pipes
  have been closed can be changed. (The record is automatically
  Dispose'd of after all pipes have been closed.) If automatic
  waiting is turned off, the caller should get the PID from the
  record before it's Dispose'd of, and wait for the process sometime
  in order to avoid zombies. If no redirections are performed (i.e.,
  all 3 files are null), the caller should wait for the process with
  WaitPipeProcess. When an error occurs, Process is not assigned to,
  and the state of the files is undefined, so be sure to check
  IOResult before going on.

  ChildProc, if not nil, is called in the child process after
  forking and redirecting I/O, but before executing the new process.
  It can even be called instead of executing a new process
  (ProcessName can be empty then).

  The procedure even works under Dos, but, of course, in a limited
  sense: if ToInputFile is used, the process will not actually be
  started until ToInputFile is closed. Signal, Seconds and Wait of
  TPipeProcess are ignored, and PID and SignalPID do not contain a
  Process ID, but an internal value without any meaning to the
  caller. Result will always be PIDExited. So, Status is the only
  interesting field (but Result should also be checked). Since there
  is no forking under Dos, ChildProc, if not nil, is called in the
  main process before spawning the program. So, to be portable, it
  should not do any things that would influence the process after
  the return of the Pipe function.

  The only portable way to use "pipes" in both directions is to call
  `Pipe', write all the Input data to ToInputFile, close
  ToInputFile, and then read the Output and StdErr data from
  FromOutputFile and FromStdErrFile. However, since the capacity of
  pipes is limited, one should also check for Data from
  FromOutputFile and FromStdErrFile (using CanRead, IOSelect or
  IOSelectRead) while writing the Input data (under Dos, there
  simply won't be any data then, but checking for data doesn't do
  any harm). Please see pipedemo.pas for an example.
}
(*@@IO critical*) procedure Pipe (var ToInputFile, FromOutputFile,
  FromStdErrFile : AnyFile; (*@@fjf265 const*) ProcessName : String;
  protected var Parameters : TPStrings; ProcessEnvironment :
  PCStrings; var Process : PPipeProcess; ChildProc : TProcedure);

{
  Waits for a process created by Pipe as determined in the Process
  record. (Process is Dispose'd of afterwards.) Returns True if
  successful.
}
function WaitPipeProcess (Process : PPipeProcess) : Boolean;

BP compatibility (partly): `Port', `PortW' arrays

The following listing contains the interface of the Ports unit.

This unit provides access routines for the hardware ports on the x86, as a partial replacement for BP's `Port' and `PortW' pseudo arrays.

Since port access is platform-specific, this unit cannot be used in code intended to be portable. Even on the x86, its use can often be avoided -- e.g. Linux provides a number of `ioctl' functions, and DJGPP provides some routines to achieve things that would require port access under BP. Therefore, it is recommended to avoid using this unit whenever possible.

{
Access functions for I/O ports for GPC on an x86 platform. This unit
is *not* portable. It works only on x86 platforms (tested under
Linux and DJGPP). It is provided here only to serve as a replacement
for BP's Port and PortW pseudo arrays.

Copyright (C) 1998-2001 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-}
{$ifndef __i386__}
{$error The Ports unit is only for the x86 platform}
{$endif}

unit Ports;

interface

{ Port access functions }
function  InPortB  (PortNumber : ShortWord) : Byte;
function  InPortW  (PortNumber : ShortWord) : ShortWord;
procedure OutPortB (PortNumber : ShortWord; aValue : Byte);
procedure OutPortW (PortNumber, aValue : ShortWord);

{ libc functions for getting access to the ports -- only for root
  processes, of course -- and to give up root privileges after
  getting access to the ports for setuid root programs. Dummies
  under DJGPP. }
function  IOPerm (From, Num : MedCard; On : Integer) : Integer;
  asmname 'ioperm';
function  IOPL (Level : Integer) : Integer; asmname 'iopl';
function  SetEUID (EUID : Integer) : Integer; asmname 'seteuid';

BP compatibility: Printer, portable

The following listing contains the interface of the Printer unit.

This unit provides printer access, compatible to BP's `Printer' unit, for Dos (using printer devices) and Unix systems (using printer utilities).

For BP compatibility, the variable `Lst' is provided, but for newly written programs, it is recommended to use the `AssignPrinter' procedure on a text file, and close the file when done (thereby committing the printer job). This method allows for sending multiple printer jobs in the same program.

{
BP compatible printer unit with extensions

Copyright (C) 1998-2001 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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit Printer;

interface

{$ifdef __OS_DOS__}

{ Dos-like systems: writing to a printer device }

uses GPC;

var
  { The file name to write printer output into }
  PrinterDeviceName : ^String = @'prn';

{$else}

{ Unix-like systems: printing via a printer program }

uses GPC, Pipe;

const
  EPrinterRead = 610; { printer can only be opened for writing }

var
  { The file name of the printer program. If it contains a '/', it
    will be taken as a complete path, otherwise the file name will
    be searched for in the PATH with FSearchExecutable. }
  PrinterCommand : ^String = @'lpr';

  { Optional command line parameters for the printer program.
    Ignored when nil. }
  PrinterArguments : ^TPStrings = nil;

  { How to deal with the printer spooler after the printer pipe is
    closed, cf. the Pipe unit. }
  PrinterPipeSignal  : Integer = 0;
  PrinterPipeSeconds : Integer = 0;
  PrinterPipeWait    : Boolean = True;

{$endif}

{ Text file opened to default printer }
var
  Lst : Text;

{ Assign a file to the printer. Lst will be assigned to the default
  printer at program start, but other files can be assigned to the
  same or other printers (possibly after changing the variables
  above). SpoolerOutput, if not null, will be redirected from the
  printer spooler's standard output and error. If you use this, note
  that a deadlock might arise when trying to write data to the
  spooler while its output is not being read, though this seems
  quite unlikely, since most printer spoolers don't write so much
  output that could fill a pipe. Under Dos, where no spooler is
  involved, SpoolerOutput, if not null, will be reset to an empty
  file for compatibility. }
procedure AssignPrinter (var f : AnyFile; var SpoolerOutput :
  AnyFile);

Regular Expression matching and substituting

The following listing contains the interface of the RegEx unit.

This unit provides routines to match strings against regular expressions and perform substitutions using matched subexpressions. Regular expressions are strings with some characters having special meanings. They describe (match) a class of strings. They are similar to wild cards used in file name matching, but much more powerful.

To use this unit, you will need the `rx' library which can be found in ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/.

{$nested-comments}
{
Regular expression matching and replacement

The RegEx unit provides routines to match strings against regular
expressions and perform substitutions using matched subexpressions.

To use the RegEx unit, you will need the rx library which can be
found in ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/ .

Regular expressions are strings with some characters having special
meanings. They describe (match) a class of strings. They are similar
to wild cards used in file name matching, but much more powerful.

There are two kinds of regular expressions supported by this unit,
basic and extended regular expressions. The difference between them
is not functionality, but only syntax. The following is a short
overview of regular expressions. For a more thorough explanation see
the literature, or the documentation of the rx library, or man pages
of programs like grep(1) and sed(1).

Basic           Extended        Meaning
`.'             `.'             matches any single character
`[aei-z]'       `[aei-z]'       matches either `a', `e', or any
                                character from `i' to `z'
`[^aei-z]'      `[^aei-z]'      matches any character but `a', `e',
                                or `i' .. `z'
                                To include in such a list the the
                                characters `]', `^', or `-', put
                                them first, anywhere but first, or
                                first or last, resp.
`[[:alnum:]]'   `[[:alnum:]]'   matches any alphanumeric character
`[^[:digit:]]'  `[^[:digit:]]'  matches anything but a digit
`[a[:space:]]'  `[a[:space:]]'  matches the letter `a' or a space
                                character (space, tab)
...                             (there are more classes available)
`\w'            `\w'            = [[:alnum:]]
`\W'            `\W'            = [^[:alnum:]]
`^'             `^'             matches the empty string at the
                                beginning of a line
`$'             `$'             matches the empty string at the end
                                of a line
`*'             `*'             matches zero or more occurences of
                                the preceding expression
`\+'            `+'             matches one or more occurences of
                                the preceding expression
`\?'            `?'             matches zero or one occurence of the
                                preceding expression
`\{N\}'         `{N}'           matches exactly N occurences of the
                                preceding expression (N is an
                                integer number)
`\{M,N\}'       `{M,N}'         matches M to N occurences of the
                                preceding expression (M and N are
                                integer numbers, M <= N)
`AB'            `AB'            matches A followed by B (A and B are
                                regular expressions)
`A\|B'          `A|B'           matches A or B (A and B are regular
                                expressions)
`\( \)'         `( )'           forms a subexpression, to override
                                precedence, and for subexpression
                                references
`\7'            `\7'            matches the 7'th parenthesized
                                subexpression (counted by their
                                start in the regex), where 7 is a
                                number from 1 to 9 ;-).
                                *Please note:* using this feature
                                can be *very* slow or take very much
                                memory (exponential time and space
                                in the worst case, if you know what
                                that means...).
`\'             `\'             quotes the following character if
                                it's special (i.e. listed above)
rest            rest            any other character matches itself

Precedence, from highest to lowest:
* parentheses (`()')
* repetition (`*', `+', `?', `{}')
* concatenation
* alternation (`|')

When performing substitutions using matched subexpressions of a
regular expression (see `ReplaceSubExpressionReferences'), the
replacement string can reference the whole matched expression with
`&' or `\0', the 7th subexpression with `\7' (just like in the regex
itself, but using it in replacements is not slow), and the 7th
subexpression converted to upper/lower case with `\u7' or `\l7',
resp. (which also works for the whole matched expression with `\u0'
or `\l0'). A verbatim `&' or `\' can be specified with `\&' or `\\',
resp.

Copyright (C) 1998-2001 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.

Please also note the license of the rx library.
}

{$gnu-pascal,I-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit RegEx;

interface

uses GPC;

const
  { `BasicRegExSpecialChars' contains all characters that have
    special meanings in basic regular expressions.
    `ExtRegExSpecialChars' contains those that have special meanings
    in extended regular expressions. }
  BasicRegExSpecialChars = ['.', '[', ']', '^', '$', '*', '\'];
  ExtRegExSpecialChars   =
  ['.', '[', ']', '^', '$', '*', '+', '?', '{', '}', '|', '(', ')', '\'];

type
  { The type used by the routines of the `RegEx' unit to store
    regular expressions in an internal format. The fields RegEx,
    RegMatch, ErrorInternal, From and Length are only used
    internally. SubExpressions can be read after `NewRegEx' and will
    contain the number of parenthesized subexpressions. Error should
    be checked after `NewRegEx'. It will be `nil' when it succeeded,
    and contain an error message otherwise. }
  RegExType = record
    RegEx, RegMatch : Pointer;  { Internal }
    ErrorInternal : CString;    { Internal }
    From, Length : Integer;     { Internal }
    SubExpressions : Integer;
    Error : PString
  end;

{ Simple interface to regular expression mathing. Matches a regular
  expression against a string starting from a specified position.
  Returns the position of the first match, or 0 if it does not
  match, or the regular expression is invalid. }
function  RegExPosFrom (const Expression : String; ExtendedRegEx,
  CaseInsensitive : Boolean; const s : String; From : Integer) :
  Integer; asmname '_p_regexposfrom';

{ Creates the internal format of a regular expression. If
  ExtendedRegEx is True, Expression is assumed to denote an extended
  regular expression, otherwise a basic regular expression.
  CaseInsensitive determines if the case of letters will be ignored
  when mathing the expression. If NewLines is True, `NewLine'
  characters in a string matched against the expression will be
  treated as dividing the string in multiple lines, so that `$' can
  match before the NewLine and `^' can match after. Also, `.' and
  `[^...]' will not match a NewLine then.}
procedure NewRegEx (var RegEx : RegExType; const Expression :
  String; ExtendedRegEx, CaseInsensitive, NewLines : Boolean);
  asmname '_p_newregex';

{ Disposes of a regular expression created with `NewRegEx'. *Must*
  be used after `NewRegEx' before the RegEx variable becomes invalid
  (i.e., goes out of scope or a pointer pointing to it is Dispose'd
  of). }
procedure DisposeRegEx (var RegEx : RegExType);
  asmname '_p_dispose_regex';

{ Matches a regular expression created with `NewRegEx' against a
  string. }
function  MatchRegEx (var RegEx : RegExType; const s : String;
  NotBeginningOfLine, NotEndOfLine : Boolean) : Boolean;
  asmname '_p_matchregex';

{ Matches a regular expression created with `NewRegEx' against a
  string, starting from a specified position. }
function  MatchRegExFrom (var RegEx : RegExType; const s : String;
  NotBeginningOfLine, NotEndOfLine : Boolean; From : Integer) :
  Boolean; asmname '_p_matchregexfrom';

{ Finds out where the regular expression matched, if `MatchRegEx' or
  `MatchRegExFrom' were successful. If n = 0, it returns the
  position of the whole match, otherwise the position of the n'th
  parenthesized subexpression. MatchPosition and MatchLength will
  contain the position (counted from 1) and length of the match, or
  0 if it didn't match. (Note: MatchLength can also be 0 for a
  successful empty match, so check MatchPosition for 0 to find out
  if it matched at all.) MatchPosition or MatchLength may be null
  and is ignored then. }
procedure GetMatchRegEx (var RegEx : RegExType; n : Integer; var
  MatchPosition, MatchLength : Integer);
  asmname '_p_getmatch_regex';

{ Checks if the string s contains any quoted characters or
  (sub)expression references to the regular expression RegEx created
  with `NewRegEx'. These are `&' or `\0' for the whole matched
  expression (if OnlySub is not set) and `\1' .. `\9' for the n'th
  parenthesized subexpression. Returns 0 if it does not contain any,
  and the number of references and quoted characters if it does. If
  an invalid reference (i.e. a number bigger than the number of
  subexpressions in RegEx) is found, it returns the negative value
  of the (first) invalid reference. }
function  FindSubExpressionReferences (var RegEx : RegExType; const
  s : String; OnlySub : Boolean) : Integer;
  asmname '_p_find_subexpressionreferences_regex';

{ Replaces (sub)expression references in ReplaceStr by the actual
  (sub)expressions and unquotes quoted characters. To be used after
  the regular expression RegEx created with `NewRegEx' was matched
  against s successfully with `MatchRegEx' or `MatchRegExFrom'. }
function  ReplaceSubExpressionReferences (var RegEx : RegExType;
  const s, ReplaceStr : String) : TString;
  asmname '_p_replace_subexpressionreferences_regex';

{ Returns the string for a regular expression that matches exactly
  one character out of the given set. It can be combined with the
  usual operators to form more complex expressions. }
function  CharSet2RegEx (const Characters : CharSet) : TString;
  asmname '_p_CharSet2RegEx';

BP compatibility: Strings

The following listing contains the interface of the Strings unit.

This is a compatibility unit to BP's `Strings' unit to handle C style `#0'-terminated strings.

The same functionality and much more is available in the Run Time System, section Pascal declarations for GPC's Run Time System, under clearer names (starting with a `CString' prefix),

Moreover, the use of `#0'-terminated C-style strings (`PChar' or `CString') is generally not recommended in GPC, since GPC provides ways to deal with Pascal-style strings of arbitrary and dynamic size in a comfortable way, as well as automatic conversion to C-style strings in order to call external C functions.

Therefore, using this unit is not recommended in newly written programs.

{
BP compatible Strings unit

Copyright (C) 1999-2001 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 Strings;

interface

uses GPC;

function  StrLen     (Src : CString) : SizeType;
  asmname '_p_strlen';
function  StrEnd     (Src : CString) : CString; asmname '_p_strend';
function  StrMove    (Dest, Source : CString; Count : SizeType) :
  CString; asmname '_p_strmove';
function  StrCopy    (Dest, Source : CString) : CString;
  asmname '_p_strcpy';
function  StrECopy   (Dest, Source : CString) : CString;
  asmname '_p_strecpy';
function  StrLCopy   (Dest, Source : CString; MaxLen : SizeType) :
  CString; asmname '_p_strlcpy';
function  StrPCopy   (Dest : CString; const Source : String) :
  CString; asmname '_p_cstringcopystring';
function  StrCat     (Dest, Source : CString) : CString;
  asmname '_p_strcat';
function  StrLCat    (Dest, Source : CString; MaxLen : SizeType) :
  CString; asmname '_p_strlcat';
function  StrComp    (s1, s2 : CString) : Integer;
  asmname '_p_strcmp';
function  StrIComp   (s1, s2 : CString) : Integer;
  asmname '_p_strcasecmp';
function  StrLComp   (s1, s2 : CString; MaxLen : SizeType) :
  Integer; asmname '_p_strlcmp';
function  StrLIComp  (s1, s2 : CString; MaxLen : SizeType) :
  Integer; asmname '_p_strlcasecmp';
function  StrScan    (Src : CString; Ch : Char) : CString;
  asmname '_p_strscan';
function  StrRScan   (Src : CString; Ch : Char) : CString;
  asmname '_p_strrscan';
function  StrPos     (aString, SubString : CString) : CString;
  asmname '_p_strpos';
function  StrRPos    (aString, SubString : CString) : CString;
  asmname '_p_strrpos';
function  StrUpper   (s : CString) : CString; asmname '_p_strupper';
function  StrLower   (s : CString) : CString; asmname '_p_strlower';
function  StrPas     (aString : CString) : TString;
  asmname '_p_strpas';
function  StrEmpty   (s : CString) : Boolean; asmname '_p_strempty';
function  StrNew     (Src : CString) : CString; asmname '_p_strdup';
procedure StrDispose (s : CString); asmname '_p_dispose';

Higher level string handling

The following listing contains the interface of the StringUtils unit.

This unit provides some routines for string handling on a higher level than those provided by the RTS.

{
Some routines for string handling on a higher level than those
provided by the RTS.

Copyright (C) 1999-2001 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-}
{$if __GPC_RELEASE__ < 20000814}
{$error This unit requires GPC release 20000814 or newer.}
{$endif}

unit StringUtils;

interface

uses GPC;

{ Appends Source to s, truncating the result if necessary. }
procedure AppendStr (var s : String; const Source : String);

{ Cuts s to MaxLength characters. If s is already MaxLength
  characters or shorter, it doesn't change anything. }
procedure StrCut (var s : String; MaxLength : Integer);

{ Returns the number of disjoint occurences of SubStr in s. Returns
  0 if SubStr is empty. }
function  StrCount (const SubStr : String; s : String) : Integer;

{ Returns s, with all disjoint occurences of Source replaced by
  Dest. }
function  StrReplace (const s, Source, Dest : String) : TString;

{ Sets of characters accepted for `True' and `False' by
  Char2Boolean and StrReadBoolean. }
var
  CharactersTrue  : CharSet = ['Y', 'y'];
  CharactersFalse : CharSet = ['N', 'n'];

{ If ch is an element of CharactersTrue, Dest is set to True,
  otherwise if it is an element of CharactersFalse, Dest is set to
  False. In both cases True is returned. If ch is not an element of
  either set, Dest is set to False and False is returned. }
function  Char2Boolean (ch : Char; var Dest : Boolean) : Boolean;

{ Converts a digit character to its numeric value. Handles every
  base up to 36 (0 .. 9, a .. z, upper and lower case recognized).
  Returns -1 if the character is not a digit at all. If you want to
  use it for a base < 36, you have to check if the result is smaller
  than the base and not equal to -1. }
function  Char2Digit (ch : Char) : Integer;

{ Encode a string in a printable format (quoted printable and
  surrounded with `"'). All occurences of `"' within the string are
  encoded, so the result string contains exactly two `"' characters
  (at the beginning and ending). This is useful to store arbitrary
  strings in text files while keeping them as readable as possible
  (which is the goal of the quoted printable encoding in general,
  RFC 1521, section 5.1) and being able to read them back losslessly
  (with UnQuoteString). }
function  QuoteString (const s : String) : TString;

{ Decode a string encoded by QuoteString (removing the `"' and
  expanding quoted printable encoded characters). Returns True if
  successful and False if the string has an invalid form. A string
  returned by QuoteString is always valid. }
function  UnQuoteString (var s : String) : Boolean;

{ Decode a quoted-printable string (not enclosed in `"', unlike for
  UnQuoteString). Returns True if successful and False if the string
  has an invalid form. }
function  UnQPString (var s : String) : Boolean;

{ Replaces all tab characters in s with the appropriate amount of
  spaces, assuming tab stops at every TabSize columns. Returns True
  if successful and False if the expanded string would exceed the
  capacity of s. In the latter case, some, but not all of the tabs
  in s may have been expanded. }
function  ExpandTabs (var s : String; TabSize : Integer) : Boolean;

{ Returns s, with all occurences of C style escape sequences (e.g.
  `\n') replaced by the characters they mean. If AllowOctal is True,
  also octal character specifications (e.g. `\007') are replaced. If
  RemoveQuoteChars is True, any other backslashes are removed (e.g.
  `\*' -> `*' and `\\' -> `\'), otherwise they are kept, and also
  `\\' is left as two backslashes then. }
function  ExpandCEscapeSequences (const s : String;
  RemoveQuoteChars, AllowOctal : Boolean) : TString;

{ String parsing routines }

{
  All the following StrReadFoo functions behave similarly. They read
  items from a string s, starting at index i, to a variable Dest.
  They skip any space characters (spaces and tabs) by incrementing i
  first. They return True if successful, False otherwise. i is
  incremented accordingly if successful, otherwise i is left
  unchanged, apart from the skipping of space characters, and Dest
  is undefined. This behaviour makes it easy to use the functions in
  a row like this:

    i := 1;
    if StrReadInt    (s, i, Size)  and StrReadComma (s, i) and
       StrReadQuoted (s, i, Name)  and StrReadComma (s, i) and
       ...
       StrReadReal   (s, i, Angle) and (i > Length (s)) then ...

  (The check `i > Length (s)' is in case you don't want to accept
  trailing "garbage".)
}

{ Just skip any space characters as described above. }
procedure StrSkipSpaces (const s : String; var i : Integer);

{ Read a quoted string (as produced by QuoteString) from a string
  and unquote the result using UnQuoteString. It is considered
  failure if the result (unquoted) would be longer than the capacity
  of Dest.}
function  StrReadQuoted (const s : String; var i : Integer; var
  Dest : String) : Boolean;

{ Read a string delimited with Delimiter from a string and return
  the result with the delimiters removed. It is considered failure
  if the result (without delimiters) would be longer than the
  capacity of Dest. }
function  StrReadDelimited (const s : String; var i : Integer; var
  Dest : String; Delimiter : Char) : Boolean;

{ Read a word (consisting of anything but space characters and
  commas) from a string. It is considered failure if the result
  would be longer than the capacity of Dest. }
function  StrReadWord (const s : String; var i : Integer; var Dest :
  String) : Boolean;

{ Check that a certain string is contained in s (after possible
  space characters). }
function  StrReadConst (const s : String; var i : Integer; const
  Expected : String) : Boolean;

{ A simpler to use version of StrReadConst that expects a `,'. }
function  StrReadComma (const s : String; var i : Integer) :
  Boolean;

{ Read an integer number from a string. }
function  StrReadInt (const s : String; var i : Integer; var Dest :
  Integer) : Boolean;

{ Read a real number from a string. }
function  StrReadReal (const s : String; var i : Integer; var Dest :
  Real) : Boolean;

{ Read a Boolean value, represented by a single character
  from CharactersTrue or CharactersFalse (cf. Char2Boolean), from a
  string. }
function  StrReadBoolean (const s : String; var i : Integer; var
  Dest : Boolean) : Boolean;

{ Read an enumerated value, i.e., one of the entries of IDs, from a
  string, and stores the ordinal value, i.e., the index in IDs
  (always zero-based) in Dest. }
function  StrReadEnum (const s : String; var i : Integer; var Dest :
  Integer; var IDs : array of PString) : Boolean;

{ String hash table }

const
  DefaultHashSize = 1403;

type
  THash = Cardinal;

  PStrHashList = ^TStrHashList;
  TStrHashList = record
    Next : PStrHashList;
    s : PString;
    i : Integer;
    p : Pointer
  end;

  PStrHashTable = ^TStrHashTable;
  TStrHashTable (Size : Cardinal) = record
    CaseSensitive : Boolean;
    Table : array [0 .. Size - 1] of PStrHashList
  end;

function  HashString          (const s : String) : THash;
function  NewStrHashTable     (Size : Cardinal; CaseSensitive :
  Boolean) : PStrHashTable;
procedure AddStrHashTable     (HashTable : PStrHashTable; s :
  String; i : Integer; p : Pointer);
procedure DeleteStrHashTable  (HashTable : PStrHashTable; s :
  String);
function  SearchStrHashTable  (HashTable : PStrHashTable; const s :
  String; var p : Pointer) : Integer; { p may be null }
procedure DisposeStrHashTable (HashTable : PStrHashTable);

BP compatibility: System

The following listing contains the interface of the System unit.

This unit contains only BP's more exotic routines which are not recommended to be used in new programs. Most of their functionality can be achieved by more standard means already.

Note: `MemAvail' and `MaxAvail', provided in this unit, cannot easily be achieved by other means. However, it is not recommended to use them on any multi-tasking system at all, where memory is a shared resource. The notes in the unit give some hints about how to avoid using them.

On special request, i.e., by defining the conditionals `__BP_TYPE_SIZES__', `__BP_RANDOM__' and/or `__BP_PARAMSTR_0__', the unit also provides BP compatible integer type sizes, a 100% BP compatible pseudo random number generator and/or BP compatible `ParamStr (0)' behaviour (the latter, however, only on some systems).

{
BP compatible System unit for GPC

This unit is released as part of the GNU Pascal project. It
implements some rather exotic BP compatibility features. Even many
BP programs don't need them, but they're here for maximum
compatibility. Most of BP's System unit's features are built into
the compiler or the RTS.

The unit depends on the conditional defines `__BP_TYPE_SIZES__',
`__BP_RANDOM__' and `__BP_PARAMSTR_0__'.

If `__BP_TYPE_SIZES__' is defined (with the `-D__BP_TYPE_SIZES__'
option), the integer data types will be redefined to the sizes they
have in BP or Delphi. Note that this might cause problems, e.g. when
passing var parameters of integer types between units that do and
don't use System. However, of the BP compatibility units, only Dos
and WinDos use such parameters, and they have been taken care of so
they work.

If `__BP_RANDOM__' is defined (`-D__BP_RANDOM__'), this unit will
provide an exactly BP compatible pseudo random number generator. In
particular, the range for integer randoms will be truncated to 16
bits like in BP. The RandSeed variable is provided, and if it's set
to the same value as BP's RandSeed, it produces exactly the same
sequence of pseudo random numbers that BP's pseudo random number
generator does (whoever might need this... ;-). Even the Randomize
function will behave exactly like in BP. However, this will not be
noted unless one explicitly tests for it.

If `__BP_PARAMSTR_0__' is defined (`-D__BP_PARAMSTR_0__'), this unit
will change the value of `ParamStr (0)' to that of `ExecutablePath',
overwriting the value actually passed by the caller, to imitate
BP's/Dos's behaviour. However NOTE: On most systems,
`ExecutablePath' is *not* guaranteed to return the full path, so
defining this symbol doesn't change anything. In general, you
*cannot* expect to find the full executable path, so better don't
even try it, or your program will (at best) run on some systems. For
most cases where BP programs access their own executable, there are
cleaner alternatives available.

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

Authors: Peter Gerwinski <peter@gerwinski.de>
         Prof. Abimbola A. Olowofoyeku <African_Chief@bigfoot.com>
         Frank Heckenbach <frank@pascal.gnu.de>
         Dominik Freche <dominik.freche@gmx.net>

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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit System;

interface

uses GPC;

var
  { Chain of procedures to be executed at the end of the program }
  ExitProc : ^procedure = nil;

  { Contains all the command line arguments passed to the program,
    concatenated, with spaces between them }
  CmdLine : CString;

  {$ifdef __BP_RANDOM__}
  { Random seed, initialized by Randomize, but can also be set
    explicitly }
  RandSeed : Integer (32) = 0;
  {$endif}

type
  OrigInt = Integer;
  OrigWord = Word;

  { needed in the Dos unit }
  Int7 = Integer (7);
  Word16 = Word (16);
  Word32 = Word (32);

  { Delphi }
  SmallInt = Integer  (16);
  DWord    = Cardinal (32);

  { Short BP compatible type sizes if wanted }
  {$ifdef __BP_TYPE_SIZES__}
  ByteBool = Boolean  (8);
  WordBool = Boolean  (16);
  LongBool = Boolean  (32);
  Boolean  = ByteBool;      { important in packed records and arrays
  }
  ShortInt = Integer  (8);
  Byte     = Cardinal (8);
  Word     = Cardinal (16);
  LongInt  = Integer  (32);
  Comp     = Integer  (64);
  LongWord = Cardinal (32); { Delphi }
  Integer  = Integer  (16);
  {$endif}

  (*@@ doesn't work well (dialec3.pas) -- when GPC gets short
       strings, it will be unnecessary
  {$ifdef __BORLAND_PASCAL__}
  String = String [255];
  {$endif} *)

const
  MaxInt     = High (Integer);
  MaxLongInt = High (LongInt);

{ Return the lowest-order byte of x }
function  Lo (x : LongestInt) : Byte;

{ Return the lowest-but-one-order byte of x }
function  Hi (x : LongestInt) : Byte;

{ Swap the lowest- and lowest-but-one-order bytes, mask out the
  higher ones }
function  Swap (x : LongestInt) : Word;

{ Store the current directory name (on the given drive number if
  drive <> 0) in s }
procedure GetDir (Drive : Byte; var s : String);

{ Dummy routine for compatibility. @@Use two overloaded versions
  rather than varargs when possible. }
procedure SetTextBuf (var f : Text; var Buf; ...);

{ Mostly useless BP compatible variables }
var
  SelectorInc : Word = $1000;
  Seg0040 : Word = $40;
  SegA000 : Word = $a000;
  SegB000 : Word = $b000;
  SegB800 : Word = $b800;
  Test8086 : Byte = 2;
  Test8087 : Byte = 3; { floating-point arithmetic is emulated
                         transparently by the OS if not present
                         in hardware }
  OvrCodeList : Word = 0;
  OvrHeapSize : Word = 0;
  OvrDebugPtr : Pointer = nil;
  OvrHeapOrg : Word = 0;
  OvrHeapPtr : Word = 0;
  OvrHeapEnd : Word = 0;
  OvrLoadList : Word = 0;
  OvrDosHandle : Word = 0;
  OvrEmsHandle : Word = $ffff;
  HeapOrg : Pointer absolute HeapBegin;
  HeapPtr : Pointer absolute HeapHigh;
  HeapEnd : Pointer = Pointer (High (PtrCard));
  FreeList : Pointer = nil;
  FreeZero : Pointer = nil;
  StackLimit : Word = 0;
  HeapList : Word = 0;
  HeapLimit : Word = 1024;
  HeapBlock : Word = 8192;
  HeapAllocFlags : Word = 2;
  CmdShow : Integer = 0;
  SaveInt00 : Pointer = nil;
  SaveInt02 : Pointer = nil;
  SaveInt0C : Pointer = nil;
  SaveInt0D : Pointer = nil;
  SaveInt1B : Pointer = nil;
  SaveInt21 : Pointer = nil;
  SaveInt23 : Pointer = nil;
  SaveInt24 : Pointer = nil;
  SaveInt34 : Pointer = nil;
  SaveInt35 : Pointer = nil;
  SaveInt36 : Pointer = nil;
  SaveInt37 : Pointer = nil;
  SaveInt38 : Pointer = nil;
  SaveInt39 : Pointer = nil;
  SaveInt3A : Pointer = nil;
  SaveInt3B : Pointer = nil;
  SaveInt3C : Pointer = nil;
  SaveInt3D : Pointer = nil;
  SaveInt3E : Pointer = nil;
  SaveInt3F : Pointer = nil;
  SaveInt75 : Pointer = nil;
  RealModeRegs : array [0 .. 49] of Byte =
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     0, 0, 0, 0, 0, 0, 0, 0);

{ Mostly useless BP compatible pointer functions }
function  Ofs (const X) : PtrWord;
function  Seg (const X) : PtrWord;
function  Ptr (Seg, Ofs : PtrWord) : Pointer;
function  CSeg : PtrWord;
function  DSeg : PtrWord;
function  SSeg : PtrWord;
function  SPtr : PtrWord;

{
  Routines to handle BP's 6 byte `Real' type which is formatted like
  this:

  47                                                   0
  -|------- -------- -------- -------- --------|--------
   |                                           |
   +----------+                   +------------+
  47 Sign Bit |  8..46 Mantissa   | 0..7 Biased Exponent

  This format does not support infinities, NaNs and denormalized
  numbers. The first digit after the binary point is not stored and
  assumed to be 1. (This is called the normalized representation of
  a binary floating point number.)

  In GPC, this type is represented by the type `BPReal' which is
  binary compatible to BP's type, and can therefore be used in
  connection with binary files used by BP programs.

  The functions `RealToBPReal' and `BPRealToReal' convert between
  this type and GPC's `Real' type. Apart from that, `BPReal' should
  be treated as opaque.

  The variables `BPRealIgnoreOverflow' and `BPRealIgnoreUnderflow'
  determine what to do in the case of overflows and underflows. The
  default values are BP compatible.
}

var
  { Ignore overflows, and use the highest possible value instead. }
  BPRealIgnoreOverflow  : Boolean = False;

  { Ignore underflows, and use 0 instead. This is BP's behaviour,
    but has the disadvantage of diminishing computation precision. }
  BPRealIgnoreUnderflow : Boolean = True;

type
  BPReal = record
    Format : array [1 .. 6] of Cardinal (8)
  end;

function RealToBPReal (R : Real) : BPReal;
function BPRealToReal (const BR : BPReal) : Real;

{ Heap management stuff }

const
  { Possible return values for HeapError }
  HeapErrorRunError = 0;
  HeapErrorNil      = 1;
  HeapErrorRetry    = 2;

var
  { If assigned to a function, it will be called when memory
    allocations do not find enough free memory. Its return value
    determines if a run time error should be raised (the default),
    or nil should be returned, or the allocation should be retried
    (causing the routine to be called again if the allocation still
    doesn't succeed).

    Notes:

    - Returning nil can cause some routines of the RTS and units
      (shipped with GPC or third-party) to crash when they don't
      expect nil, so better don't use this mechanism, but rather
      CGetMem where needed.

    - Letting the allocation be retried, of course, only makes sense
      if the routine freed some memory before -- otherwise it will
      cause an infinite loop! So, a meaningful HeapError routine
      should dispose of some temporary objects, if available, and
      return HeapErrorRetry, and return HeapErrorRunError when no
      (more) of them are available.
  }
  HeapError : ^function (Size : Word) : Integer = nil;

{ Just returns HeapErrorNil. When this function is assigned to
  HeapError, GetMem and New will return a nil pointer instead of
  causing a runtime error when the allocation fails. See the comment
  for HeapError above. }
function  HeapErrorNilReturn (Size : Word) : Integer;

{ Return the total free memory/biggest free memory block. Except
  under Win32 and DJGPP, these are expensive routines -- try to
  avoid them. Under Win32, MaxAvail returns the same as MemAvail, so
  don't rely on being able to allocate a block of memory as big as
  MaxAvail indicates. Generally it's preferable to not use these
  functions at all in order to do a safe allocation, but just try to
  allocate the memory needed using CGetMem, and check for a nil
  result. What makes these routines unrealiable is, e.g., that on
  multi-tasking systems, another process may allocate memory after
  you've called MemAvail/MaxAvail and before you get to do the next
  allocation. Also, please note that some systems over-commit
  virtual memory which may cause MemAvail to return a value larger
  than the actual (physical plus swap) memory available. Therefore,
  if you want to be "sure" (modulo the above restrictions) that the
  memory is actually available, use MaxAvail. }
function  MemAvail : Cardinal;
function  MaxAvail : Cardinal;

{ Delphi compatibility }

function  CompToDouble (x : Comp) : Double;
function  DoubleToComp (x : Double) : Comp;
function  AllocMemCount : Integer;
function  AllocMemSize : SizeType;
procedure Assert (Condition : Boolean);
procedure DefaultAssertErrorProc (const Message, FileName: String;
  LineNumber: Integer; ErrorAddr: Pointer);

var
  AssertErrorProc: ^procedure (const Message, FileName: String;
  LineNumber: Integer; ErrorAddr: Pointer) =
  @DefaultAssertErrorProc;
  NoErrMsg: Boolean = False;

Trap runtime errors

The following listing contains the interface of the Trap unit.

This unit allows you to trap runtime errors, so a runtime error will not abort the program, but pass the control back to a point within the program. Use with care, and read the notes in the interface, please.

{
Trapping runtime errors

The Trap unit allows you to trap runtime errors, so a runtime error
will not abort the program, but pass the control back to a point
within the program.

The usage is simple. The TrapExec procedure can be called with a
function (p) as an argument. p must take a Boolean argument. p will
immediately be called with False given as its argument. When a
runtime error would otherwise be caused while p is active, p will
instead be called again with True as its argument. After p returns,
runtime errors will not be trapped.

When the program terminates (e.g. by reaching its end or by a Halt
statement) and a runtime error was trapped during the run, Trap will
set the ExitCode and ErrorAddr variables to indicate the trapped
error.

Notes:

- After trapping a runtime error, your program might not be in a
  stable state. If the runtime error was a "minor" one (such as a
  range checking or arithmetic error), it should not be a problem.
  But if you, e.g., write a larger application and use Trap to
  prevent a sudden abort caused by an unexpected runtime error, you
  should make the program terminate regularly as soon as possible
  after a trapped error (perhaps by telling the user to save the
  data, then terminate the program and report the bug to you).

- Since the trapping mechanism *jumps* back, it has all the negative
  effects that a (non-local!) `goto' can have! You should be aware
  of the consequences of all active procedures being terminated at
  an arbitrary point!

- Nested traps are supported, i.e. you can call TrapExec again
  within a routine called by another TrapExec instance. Runtime
  errors trapped within the inner TrapExec invocation will be
  trapped by the inner TrapExec, while runtime errors trapped after
  its termination will be trapped by the outer TrapExec again.

Copyright (C) 1996-2001 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 Trap;

interface

uses GPC;

var
  TrappedExitCode : Integer = 0;
  TrappedErrorAddr : Pointer = nil;
  TrappedErrorMessageString : TString = '';

{ Trap runtime errors. See the comment at the top. }
procedure TrapExec (procedure p (Trapped : Boolean));
  asmname '_p_trapexec';

{ Forget about saved errors from the innermost TrapExec instance. }
procedure TrapReset; asmname '_p_trapreset';

BP compatibility: Turbo3

The following listing contains the interface of the Turbo3 unit.

This is a compatibility unit to BP's `Turbo3' compatibility unit to TP3. ;-) It is not meant to be used in any newly written code.

{
Turbo Pascal 3.0 compatibility unit

Copyright (C) 1998-2001 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-}
{$if __GPC_RELEASE__ < 20000412}
{$error This unit requires GPC release 20000412 or newer.}
{$endif}

unit Turbo3;

interface

uses GPC, System, CRT;

var
  Kbd : Text;
  CBreak : Boolean absolute CheckBreak;

procedure AssignKbd (var F : (*AnyFile*)Text);
function  (*@@fjf260*)MemAvail3 : Integer;
function  (*@@fjf260*)MaxAvail3 : Integer;
function  LongFileSize (var F : AnyFile) : Real;
function  LongFilePos  (var F : AnyFile) : Real;
procedure LongSeek     (var F : AnyFile; aPosition : Real);
procedure (*@@fjf260*)LowVideo3;
procedure (*@@fjf260*)HighVideo3;

BP compatibility: WinDos

The following listing contains the interface of the WinDos unit.

This is a portable implementation of most routines from BP's `WinDos' unit. A few routines that are Dos -- or even x86 real mode -- specific, are only available if `__BP_UNPORTABLE_ROUTINES__' is defined, section BP Incompatibilities.

The same functionality and much more is available in the Run Time System, section Pascal declarations for GPC's Run Time System. The RTS routines usually have different names and/or easier and less limiting interfaces (e.g. `ReadDir' etc. vs. `FindFirst' etc.), and are often more efficient.

Therefore, using this unit is not recommended in newly written programs.

{
Mostly BP compatible portable WinDos unit

This unit supports most, but not all, of the routines and
declarations of BP's WinDos unit.

NOTES:

- The procedures GetIntVec and SetIntVec are not supported since
  they make only sense for Dos real-mode programs (and GPC compiled
  programs do not run in real-mode, even on x86 under Dos). The
  procedures Intr and MsDos are only supported under DJGPP if
  `__BP_UNPORTABLE_ROUTINES__' is defined (with the
  `-D__BP_UNPORTABLE_ROUTINES__' option). A few other routines are
  also only supported with this define, but on all platforms (but
  they are crude hacks, that's why they are not supported without
  this define).

- The internal structure of file variables (TFileRec and TTextRec)
  is different in GPC. However, as far as TFDDs are concerned, there
  are other ways to achieve the same in GPC, see the GPC unit.

Copyright (C) 1998-2001 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 WinDos;

interface

uses GPC, System, Dos;

const
  { File attribute constants }
  faReadOnly  = ReadOnly;
  faHidden    = Hidden;    { set for dot files except `.' and `..' }
  faSysFile   = SysFile;   { not supported }
  faVolumeID  = VolumeID;  { not supported }
  faDirectory = Directory;
  faArchive   = Archive;   { means: not executable }
  faAnyFile   = AnyFile;

  { Maximum file name component string lengths }
  fsPathName  = 79;
  fsDirectory = 67;
  fsFileName  = 8;
  fsExtension = 4;

  { FileSplit return flags }
  fcExtension = 1;
  fcFileName  = 2;
  fcDirectory = 4;
  fcWildcards = 8;

  { Flag bit masks -- only used by the unportable Dos routines }
  FCarry     = 1;
  FParity    = 4;
  FAuxiliary = $10;
  FZero      = $40;
  FSign      = $80;
  FOverflow  = $800;

type
  PTextBuf = ^TTextBuf;
  TTextBuf = TextBuf;

  { Search record used by FindFirst and FindNext }
  TSearchRec = {$ifdef __BP_TYPE_SIZES__} packed {$endif} record
     Fill : SearchRecFill;
     Attr : Byte8;
     Time, Size : LongInt;
     Name : {$ifdef __BP_TYPE_SIZES__}
            packed array [0 .. 12] of Char
            {$else}
            TStringBuf
            {$endif};
     Reserved : SearchRec
  end;

  { Date and time record used by PackTime and UnpackTime }
  TDateTime = DateTime;

  { 8086 CPU registers -- only used by the unportable Dos routines }
  TRegisters = Registers;

var
  { Error status variable }
  DosError : Integer; external;

procedure GetDate (var Year, Month, Day, DayOfWeek : Word);
  asmname '_p_getdate';
procedure GetTime (var Hour, Minute, Second, Sec100 : Word);
  asmname '_p_gettime';
procedure (*@@fjf260*)WGetCBreak (var BreakOn : Boolean);
  asmname '_p_getcbreak';
procedure (*@@fjf260*)WSetCBreak (BreakOn : Boolean);
  asmname '_p_setcbreak';
procedure (*@@fjf260*)WGetVerify (var VerifyOn : Boolean);
  asmname '_p_getverify';
procedure (*@@fjf260*)WSetVerify (VerifyOn : Boolean);
  asmname '_p_setverify';
function  DiskFree (Drive : Byte) : LongInt; asmname '_p_diskfree';
function  DiskSize (Drive : Byte) : LongInt; asmname '_p_disksize';
procedure GetFAttr (var F (*@@anyfile : GPC_AnyFile*); var Attr :
  TDosAttr); asmname '_p_getfattr';
procedure SetFAttr (var F (*@@anyfile : GPC_AnyFile*); Attr :
  TDosAttr); asmname '_p_setfattr';
procedure GetFTime (var F (*@@anyfile : GPC_AnyFile*); var aTime :
  LongInt); asmname '_p_getftime';
procedure SetFTime (var F (*@@anyfile : GPC_AnyFile*); aTime :
  LongInt); asmname '_p_setftime';

{ FindFirst and FindNext are quite inefficient since they emulate
  all the brain-dead Dos stuff. If at all possible, the standard
  routines OpenDir, ReadDir and CloseDir (in the GPC unit) should be
  used instead. }
procedure (*@@fjf260*)WFindFirst (Path : PChar; Attr : Word; var
  SR : TSearchRec);
procedure (*@@fjf260*)WFindNext  (var SR : TSearchRec);

procedure (*@@fjf260*)WFindClose (var SR : TSearchRec);
procedure UnpackTime (P : LongInt; var T : TDateTime);
  asmname '_p_unpacktime';
procedure PackTime (const T : TDateTime; var P : LongInt);
  asmname '_p_packtime';
function  FileSearch (Dest, Name, List : PChar) : PChar;
function  FileExpand (Dest, Name : PChar) : PChar;
function  FileSplit (Path, Dir, Name, Ext : PChar) : Word;
function  GetCurDir (Dir : PChar; Drive : Byte) : PChar;
procedure SetCurDir (Dir : PChar);
procedure CreateDir (Dir : PChar);
procedure RemoveDir (Dir : PChar);
function  GetArgCount : Integer;
function  GetArgStr (Dest : PChar; ArgIndex : Integer; MaxLen :
  Word) : PChar;
function  GetEnvVar (VarName : PChar) : PChar;
  asmname '_p_cstringgetenv';

{$ifdef __BP_UNPORTABLE_ROUTINES__}
{$ifdef DJGPP}
procedure (*@@fjf260*)WIntr (IntNo : Byte; var Regs : Registers);
  asmname '_p_intr';
procedure (*@@fjf260*)WMsDos (var Regs : Registers);
  asmname '_p_msdos';
{$endif}
function  (*@@fjf260*)WDosVersion : Word; asmname '_p_dosversion';
procedure (*@@fjf260*)WSetDate (Year, Month, Day : Word);
  asmname '_p_setdate';
procedure (*@@fjf260*)WSetTime (Hour, Minute, Second, Sec100 :
  Word); asmname '_p_settime';
{$endif}

Go to the first, previous, next, last section, table of contents.