pre { line-height: 125%; }
td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
.highlight .hll { background-color: #ffffcc }
.highlight .c { color: #888888 } /* Comment */
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
.highlight .k { color: #008800; font-weight: bold } /* Keyword */
.highlight .ch { color: #888888 } /* Comment.Hashbang */
.highlight .cm { color: #888888 } /* Comment.Multiline */
.highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */
.highlight .cpf { color: #888888 } /* Comment.PreprocFile */
.highlight .c1 { color: #888888 } /* Comment.Single */
.highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
.highlight .ge { font-style: italic } /* Generic.Emph */
.highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */
.highlight .gr { color: #aa0000 } /* Generic.Error */
.highlight .gh { color: #333333 } /* Generic.Heading */
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
.highlight .go { color: #888888 } /* Generic.Output */
.highlight .gp { color: #555555 } /* Generic.Prompt */
.highlight .gs { font-weight: bold } /* Generic.Strong */
.highlight .gu { color: #666666 } /* Generic.Subheading */
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
.highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */
.highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */
.highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */
.highlight .kp { color: #008800 } /* Keyword.Pseudo */
.highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */
.highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */
.highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */
.highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */
.highlight .na { color: #336699 } /* Name.Attribute */
.highlight .nb { color: #003388 } /* Name.Builtin */
.highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */
.highlight .no { color: #003366; font-weight: bold } /* Name.Constant */
.highlight .nd { color: #555555 } /* Name.Decorator */
.highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */
.highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */
.highlight .nl { color: #336699; font-style: italic } /* Name.Label */
.highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */
.highlight .py { color: #336699; font-weight: bold } /* Name.Property */
.highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */
.highlight .nv { color: #336699 } /* Name.Variable */
.highlight .ow { color: #008800 } /* Operator.Word */
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
.highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */
.highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */
.highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */
.highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */
.highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */
.highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */
.highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */
.highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */
.highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */
.highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */
.highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */
.highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */
.highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */
.highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */
.highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */
.highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */
.highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */
.highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */
.highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */
.highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */
.highlight .vc { color: #336699 } /* Name.Variable.Class */
.highlight .vg { color: #dd7700 } /* Name.Variable.Global */
.highlight .vi { color: #3333bb } /* Name.Variable.Instance */
.highlight .vm { color: #336699 } /* Name.Variable.Magic */
.highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */
#ifndef __TLV_H__
#define __TLV_H__

/* Helpers for working with the .tlv file format */

extern void teliva_load_definition (lua_State* L, FILE* in);
int is_special_history_key(const char* key);

extern void emit_multiline_string(FILE* out, const char* value);

#endif

//
//
//           The Nimrod Compiler
//        (c) Copyright 2008 Andreas Rumpf
//
//    See the file "copying.txt", included in this
//    distribution, for details about the copyright.
//
unit nsystem;

// This module provides things that are in Nimrod's system
// module and not available in Pascal.

interface

{$include 'config.inc'}

uses
  sysutils
{$ifdef fpc}
  , math
{$endif}
  ;

type
  // Generic int like in Nimrod:
  // well, no, because of FPC's bugs...
{$ifdef cpu64}
  int = int64;
  uint = qword;
{$else}
  int = longint;
  uint = cardinal;
{$endif}

  TResult = Boolean;
  EInvalidValue = class(Exception)
  end;

{$ifndef fpc}
  EOverflow = class(Exception)
  end;
{$endif}
  EOutOfRange = class(Exception)
  end;
  EOS = class(Exception) end;

  float32 = single;
  float64 = double;
  PFloat32 = ^float32;
  PFloat64 = ^float64;
const
  Failure = False;
  Success = True;

  snil = '';

type
  TStringSeq = array of string;
  TCharSet = set of Char;


type
  Natural = 0..high(int);
  Positive = 1..high(int);
  NObject = object // base type for all objects, cannot use
  // TObject here, as it would overwrite System.TObject which is
  // a class in Object pascal. Anyway, pas2mor has no problems
  // to replace NObject by TObject
  end;
  PObject = ^NObject;

  int16 = smallint;
  int8 = shortint;
  int32 = longint;
  uint16 = word;
  uint32 = longword;
  uint8 = byte;

  TByteArray = array [0..1024 * 1024] of Byte;
  PByteArray = ^TByteArray;
  PByte = ^Byte;
  cstring = pchar;
  bool = boolean;
  PInt32 = ^int32;

{$ifdef bit64clean} // BUGIX: was $ifdef fpc
  BiggestUInt = QWord;
  BiggestInt = Int64; // biggest integer type available
{$else}
  BiggestUInt = Cardinal; // Delphi's Int64 is broken seriously
  BiggestInt = Integer;   // ditto
{$endif}
  BiggestFloat = Double; // biggest floating point type
{$ifdef cpu64}
  TAddress = Int64;
{$else}
  TAddress = longint;
{$endif}

var
  NaN: float;
  inf: float;
  NegInf: float;
{$ifdef fpc}
{$else}
  {$ifopt Q+}
    {$define Q_on}
    {$Q-}
  {$endif}
  {$ifopt R+}
    {$define R_on}
    {$R-}
  {$endif}
  const
    Inf = 1.0/0.0;
    NegInf = (-1.0) / 0.0;
  {$ifdef Q_on}
    {$Q+}
    {$undef Q_on}
  {$endif}
  {$ifdef R_on}
    {$R+}
    {$undef R_on}
  {$endif}
{$endif}

function toFloat(i: biggestInt): biggestFloat;
function toInt(r: biggestFloat): biggestInt;

function min(a, b: int): int; overload;
function max(a, b: int): int; overload;
{$ifndef fpc} // fpc cannot handle these overloads (bug in 64bit version?)
// the Nimrod compiler does not use them anyway, so it does not matter
function max(a, b: real): real; overload;
function min(a, b: real): real; overload;
{$endif}

procedure zeroMem(p: Pointer; size: int);
procedure copyMem(dest, source: Pointer; size: int);
procedure moveMem(dest, source: Pointer; size: int);
function equalMem(a, b: Pointer; size: int): Boolean;

function ncopy(s: string; a: int = 1): string; overload;
function ncopy(s: string; a, b: int): string; overload;
// will be replaced by "copy"

function newString(len: int): string;

procedure addChar(var s: string; c: Char);

{@ignore}
function addU(a, b: biggestInt): biggestInt;
function subU(a, b: biggestInt): biggestInt;
function mulU(a, b: biggestInt): biggestInt;
function divU(a, b: biggestInt): biggestInt;
function modU(a, b: biggestInt): biggestInt;
function shlU(a, b: biggestInt): biggestInt; overload;
function shrU(a, b: biggestInt): biggestInt; overload;

function shlU(a, b: Int32): Int32;overload;
function shrU(a, b: int32): int32;overload;

function ltU(a, b: biggestInt): bool;
function leU(a, b: biggestInt): bool;

function toU8(a: biggestInt): byte;
function toU16(a: biggestInt): int16;
function toU32(a: biggestInt): int32;
function ze64(a: byte): biggestInt;
function ze(a: byte): int;
{@emit}

function alloc(size: int): Pointer;
function realloc(p: Pointer; newsize: int): Pointer;
procedure dealloc(p: Pointer);

type
  TTextFile = record
    buf: PChar;
    sysFile: system.textFile;
  end;

  TBinaryFile = file;

  TFileMode = (fmRead, fmWrite, fmReadWrite, fmReadWriteExisting, fmAppend);

function OpenFile(out f: tTextFile; const filename: string;
                  mode: TFileMode = fmRead): Boolean; overload;
function endofFile(var f: tBinaryFile): boolean; overload;
function endofFile(var f: textFile): boolean; overload;

function readChar(var f: tTextFile): char;
function readLine(var f: tTextFile): string; overload;
function readLine(var f: tBinaryFile): string; overload;
function readLine(var f: textFile): string; overload;

procedure nimWrite(var f: tTextFile; const str: string); overload;
procedure nimCloseFile(var f: tTextFile); overload;

// binary file handling:
function OpenFile(var f: tBinaryFile; const filename: string;
                  mode: TFileMode = fmRead): Boolean; overload;
procedure nimCloseFile(var f: tBinaryFile); overload;

function ReadBytes(var f: tBinaryFile; out a: array of byte;
                   start, len: int): int;
function ReadChars(var f: tBinaryFile; out a: array of char;
                   start, len: int): int;

function writeBuffer(var f: TBinaryFile; buffer: pointer; len: int): int;
function readBuffer(var f: tBinaryFile; buffer: pointer; len: int): int;
overload;
function readBuffer(var f: tBinaryFile): string; overload;
function getFilePos(var f: tBinaryFile): int;
procedure setFilePos(var f: tBinaryFile; pos: int64);

function readFile(const filename: string): string;

procedure nimWrite(var f: tBinaryFile; const str: string); overload;

procedure add(var x: string; const y: string); overload;
// Pascal version of string appending. Terminating zero is ignored.

procedure add(var s: TStringSeq; const y: string); overload;

function isNil(s: string): bool;

implementation

function isNil(s: string): bool;
begin
  result := s = '';
end;

{@ignore}
procedure add(var x: string; const y: string);
// Pascal version of string appending. Terminating zero is ignored.
var
  L: int;
begin
  L := length(y);
  if L > 0 then begin
    if y[L] = #0 then x := x + copy(y, 1, L-1)
    else x := x + y;
  end
end;

procedure add(var s: TStringSeq; const y: string); overload;
var
  L: int;
begin
  L := length(s);
  setLength(s, L+1);
  s[L] := y;
end;
{@emit}

function alloc(size: int): Pointer;
begin
  getMem(result, size); // use standard allocator
  FillChar(result^, size, 0);
end;

function realloc(p: Pointer; newsize: int): Pointer;
begin
  reallocMem(p, newsize); // use standard allocator
  result := p;
end;

procedure dealloc(p: pointer);
begin
  freeMem(p);
end;

{@ignore}
function addU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) + biggestUInt(b));
end;

function subU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) - biggestUInt(b));
end;

function mulU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) * biggestUInt(b));
end;

function divU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) div biggestUInt(b));
end;

function modU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) mod biggestUInt(b));
end;

function shlU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) shl biggestUInt(b));
end;

function shrU(a, b: biggestInt): biggestInt;
begin
  result := biggestInt(biggestUInt(a) shr biggestUInt(b));
end;

function shlU(a, b: Int32): Int32;
begin
  result := Int32(UInt32(a) shl UInt32(b));
end;

function shrU(a, b: int32): int32;
begin
  result := Int32(UInt32(a) shr UInt32(b));
end;

function ltU(a, b: biggestInt): bool;
begin
  result := biggestUInt(a) < biggestUInt(b);
end;

function leU(a, b: biggestInt): bool;
begin
  result := biggestUInt(a) < biggestUInt(b);
end;

function toU8(a: biggestInt): byte;
begin
  assert(a >= 0);
  assert(a <= 255);
  result := a;
end;

function toU32(a: biggestInt): int32;
begin
  result := int32(a and $ffffffff);
end;

function toU16(a: biggestInt): int16;
begin
  result := int16(a and $ffff);  
end;

function ze64(a: byte): biggestInt;
begin
  result := a
end;

function ze(a: byte): int;
begin
  result := a
end;
{@emit}

procedure addChar(var s: string; c: Char);
{@ignore}
// delphi produces suboptimal code for "s := s + c"
{$ifndef fpc}
var
  len: int;
{$endif}
{@emit}
begin
{@ignore}
{$ifdef fpc}
  s := s + c
{$else}
  {$ifopt H+}
  len := length(s);
  setLength(s, len + 1);
  PChar(Pointer(s))[len] := c
  {$else}
  s := s + c
  {$endif}
{$endif}
{@emit
  s &= c
}
end;

function newString(len: int): string;
begin
  setLength(result, len);
  if len > 0 then begin
  {@ignore}
    fillChar(result[1], length(result), 0);
  {@emit}
  end
end;

function toFloat(i: BiggestInt): BiggestFloat;
begin
  result := i // conversion automatically in Pascal
end;

function toInt(r: BiggestFloat): BiggestInt;
begin
  result := round(r);
end;

procedure zeroMem(p: Pointer; size: int);
begin
  fillChar(p^, size, 0);
end;

procedure copyMem(dest, source: Pointer; size: int);
begin
  if size > 0 then
    move(source^, dest^, size);
end;

procedure moveMem(dest, source: Pointer; size: int);
begin
  if size > 0 then
    move(source^, dest^, size); // move handles overlapping regions
end;

function equalMem(a, b: Pointer; size: int): Boolean;
begin
  result := compareMem(a, b, size);
end;

{$ifndef fpc}
function min(a, b: real): real; overload;
begin
  if a < b then result := a else result := b
end;

function max(a, b: real): real; overload;
begin
  if a > b then result := a else result := b
end;
{$endif}

function min(a, b: int): int; overload;
begin
  if a < b then result := a else result := b
end;

function max(a, b: int): int; overload;
begin
  if a > b then result := a else result := b
end;

function ncopy(s: string; a, b: int): string;
begin
  result := copy(s, a, b-a+1);
end;

function ncopy(s: string; a: int = 1): string;
begin
  result := copy(s, a, length(s))
end;


{$ifopt I+} {$define I_on} {$I-} {$endif}
function OpenFile(out f: tTextFile; const filename: string;
                  mode: TFileMode = fmRead): Boolean; overload;
begin
  AssignFile(f.sysFile, filename);
  f.buf := alloc(4096);
  SetTextBuf(f.sysFile, f.buf^, 4096);
  case mode of
    fmRead: Reset(f.sysFile);
    fmWrite: Rewrite(f.sysFile);
    fmReadWrite: Reset(f.sysFile);
    fmAppend: Append(f.sysFile);
  end;
  result := (IOResult = 0);
end;

function readChar(var f: tTextFile): char;
begin
  Read(f.sysFile, result);
end;

procedure nimWrite(var f: tTextFile; const str: string);
begin
  system.write(f.sysFile, str)
end;

function readLine(var f: tTextFile): string;
begin
  Readln(f.sysFile, result);
end;

function endofFile(var f: tBinaryFile): boolean;
begin
  result := eof(f)
end;

function endofFile(var f: textFile): boolean;
begin
  result := eof(f)
end;

procedure nimCloseFile(var f: tTextFile);
begin
  closeFile(f.sysFile);
  dealloc(f.buf)
end;

procedure nimCloseFile(var f: tBinaryFile);
begin
  closeFile(f);
end;

function OpenFile(var f: TBinaryFile; const filename: string;
                  mode: TFileMode = fmRead): Boolean;
begin
  AssignFile(f, filename);
  case mode of
    fmRead: Reset(f, 1);
    fmWrite: Rewrite(f, 1);
    fmReadWrite: Reset(f, 1);
    fmAppend: assert(false);
  end;
  result := (IOResult = 0);
end;

function ReadBytes(var f: tBinaryFile; out a: array of byte;
                   start, len: int): int;
begin
  result := 0;
  BlockRead(f, a[0], len, result)
end;

function ReadChars(var f: tBinaryFile; out a: array of char;
                   start, len: int): int;
begin
  result := 0;
  BlockRead(f, a[0], len, result)
end;

function readBuffer(var f: tBinaryFile; buffer: pointer; len: int): int;
begin
  result := 0;
  BlockRead(f, buffer^, len, result)
end;

procedure nimWrite(var f: tBinaryFile; const str: string); overload;
begin
  writeBuffer(f, addr(str[1]), length(str));
end;

function readLine(var f: tBinaryFile): string; overload;
var
  c: char;
begin
  result := '';
  while readBuffer(f, addr(c), 1) = 1 do begin
    case c of
      #13: begin
        readBuffer(f, addr(c), 1); // skip #10
        break;
      end;
      #10: break;
      else begin end
    end;
    addChar(result, c);
  end
end;

function readLine(var f: textFile): string; overload;
begin
  result := '';
  readln(f, result);
end;

function readBuffer(var f: tBinaryFile): string; overload;
const
  bufSize = 4096;
var
  bytesRead, len, cap: int;
begin
  // read the file in 4K chunks
  result := newString(bufSize);
  cap := bufSize;
  len := 0;
  while true do begin
    bytesRead := readBuffer(f, addr(result[len+1]), bufSize);
    inc(len, bytesRead);
    if bytesRead <> bufSize then break;
    inc(cap, bufSize);
    setLength(result, cap);
  end;
  setLength(result, len);
end;

function readFile(const filename: string): string;
var
  f: tBinaryFile;
begin
  if openFile(f, filename) then begin
    result := readBuffer(f);
    nimCloseFile(f)
  end
  else
    result := '';
end;

function writeBuffer(var f: TBinaryFile; buffer: pointer;
                     len: int): int;
begin
  result := 0;
  BlockWrite(f, buffer^, len, result);
end;

function getFilePos(var f: tBinaryFile): int;
begin
  result := filePos(f);
end;

procedure setFilePos(var f: tBinaryFile; pos: int64);
begin
  Seek(f, pos);
end;

{$ifdef I_on} {$undef I_on} {$I+} {$endif}

{$ifopt R+} {$R-,Q-} {$define R_on} {$endif}
var
  zero: float;
  Saved8087CW: Word;
  savedExcMask: TFPUExceptionMask;
initialization
{$ifdef cpu64}
  savedExcMask := SetExceptionMask([exInvalidOp,
	exDenormalized,
	exPrecision,
	exZeroDivide,
	exOverflow,
	exUnderflow
	]);
{$else}
  Saved8087CW := Default8087CW;
  Set8087CW($133f); // Disable all fpu exceptions
{$endif}
  zero := 0.0;
  NaN := 0.0 / zero;
  inf := 1.0 / zero;
  NegInf := -inf;
finalization
{$ifdef cpu64}
  SetExceptionMask(savedExcMask); // set back exception mask
{$else}
  Set8087CW(Saved8087CW);
{$endif}
{$ifdef R_on}
  {$R+,Q+}
{$endif}
end.