path: root/nim/ecmasgen.pas

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

// This is the EMCAScript (also known as JavaScript) code generator.
// **Invariant: each expression only occurs once in the generated
// code!**

interface

{$include 'config.inc'}

uses
  nsystem, ast, astalgo, strutils, nhashes, trees, platform, magicsys,
  extccomp, options, nversion, nimsets, msgs, crc, bitsets, idents,
  lists, types, nos, ntime, ropes, nmath, passes, ccgutils, wordrecg, rnimsyn,
  rodread;

function ecmasgenPass(): TPass;

implementation

type
  TEcmasGen = object(TPassContext)
    filename: string;
    module: PSym;
  end;
  BModule = ^TEcmasGen;

  TEcmasTypeKind = (
    etyNone,         // no type
    etyNull,         // null type
    etyProc,         // proc type
    etyBool,         // bool type
    etyInt,          // Ecmascript's int
    etyFloat,        // Ecmascript's float
    etyString,       // Ecmascript's string
    etyObject,       // Ecmascript's reference to an object
    etyBaseIndex     // base + index needed
  );

  TCompRes = record
    kind: TEcmasTypeKind;
    com: PRope; // computation part
                // address if this is a (address, index)-tuple
    res: PRope; // result part; index if this is a (address, index)-tuple
  end;

  TBlock = record
    id: int;  // the ID of the label; positive means that it
              // has been used (i.e. the label should be emitted)
    nestedTryStmts: int; // how many try statements is it nested into
  end;

  TGlobals = record
    typeInfo, code: PRope;
    typeInfoGenerated: TIntSet;
  end;
  PGlobals = ^TGlobals;

  TProc = record
    procDef: PNode;
    prc: PSym;
    data: PRope;
    options: TOptions;
    module: BModule;
    globals: PGlobals;
    BeforeRetNeeded: bool;
    nestedTryStmts: int;
    unique: int;
    blocks: array of TBlock;
  end;

function newGlobals(): PGlobals;
begin
  new(result);
{@ignore} fillChar(result^, sizeof(result^), 0); {@emit}
  IntSetInit(result.typeInfoGenerated);
end;

procedure initCompRes(var r: TCompRes);
begin
  r.com := nil; r.res := nil; r.kind := etyNone;
end;

procedure initProc(var p: TProc; globals: PGlobals; module: BModule;
                   procDef: PNode; options: TOptions);
begin
{@ignore}
  fillChar(p, sizeof(p), 0);
{@emit
  p.blocks := @[];}
  p.options := options;
  p.module := module;
  p.procDef := procDef;
  p.globals := globals;
  if procDef <> nil then p.prc := procDef.sons[namePos].sym;
end;

const
  MappedToObject = {@set}[tyObject, tyArray, tyArrayConstr, tyTuple,
                          tyOpenArray, tySet, tyVar, tyRef, tyPtr];

function mapType(typ: PType): TEcmasTypeKind;
var
  t: PType;
begin
  t := skipTypes(typ, abstractInst);
  case t.kind of
    tyVar, tyRef, tyPtr: begin
      if skipTypes(t.sons[0], abstractInst).kind in mappedToObject then
        result := etyObject
      else
        result := etyBaseIndex
    end;
    tyPointer: begin
      // treat a tyPointer like a typed pointer to an array of bytes
      result := etyInt;
    end;
    tyRange, tyDistinct, tyOrdinal: result := mapType(t.sons[0]);
    tyInt..tyInt64, tyEnum, tyChar:
      result := etyInt;
    tyBool: result := etyBool;
    tyFloat..tyFloat128: result := etyFloat;
    tySet: begin
      result := etyObject // map a set to a table
    end;
    tyString, tySequence:
      result := etyInt; // little hack to get the right semantics
    tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray:
      result := etyObject;
    tyNil: result := etyNull;
    tyGenericInst, tyGenericParam, tyGenericBody, tyGenericInvokation,
    tyNone, tyForward, tyEmpty, tyExpr, tyStmt, tyTypeDesc:
      result := etyNone;
    tyProc: result := etyProc;
    tyCString: result := etyString;
  end
end;

function mangle(const name: string): string;
var
  i: int;
begin
  result := '';
  for i := strStart to length(name) + strStart-1 do begin
    case name[i] of
      'A'..'Z': addChar(result, chr(ord(name[i]) - ord('A') + ord('a')));
      '_': begin end;
      'a'..'z', '0'..'9': addChar(result, name[i]);
      else result := result +{&} 'X' +{&} toHex(ord(name[i]), 2);
    end
  end
end;

function mangleName(s: PSym): PRope;
begin
  result := s.loc.r;
  if result = nil then begin
    result := toRope(mangle(s.name.s));
    app(result, '_'+'');
    app(result, toRope(s.id));
    s.loc.r := result;
  end
end;

// ----------------------- type information ----------------------------------

function genTypeInfo(var p: TProc; typ: PType): PRope; forward;

function genObjectFields(var p: TProc; typ: PType; n: PNode): PRope;
var
  s, u: PRope;
  len, i, j: int;
  field: PSym;
  b: PNode;
begin
  result := nil;
  case n.kind of
    nkRecList: begin
      len := sonsLen(n);
      if len = 1 then  // generates more compact code!
        result := genObjectFields(p, typ, n.sons[0])
      else begin
        s := nil;
        for i := 0 to len-1 do begin
          if i > 0 then app(s, ', ' + tnl);
          app(s, genObjectFields(p, typ, n.sons[i]));
        end;
        result := ropef('{kind: 2, len: $1, offset: 0, ' +
                        'typ: null, name: null, sons: [$2]}', [toRope(len), s]);
      end
    end;
    nkSym: begin
      field := n.sym;
      s := genTypeInfo(p, field.typ);
      result := ropef('{kind: 1, offset: "$1", len: 0, ' +
                      'typ: $2, name: $3, sons: null}', [
                      mangleName(field), s, makeCString(field.name.s)]);
    end;
    nkRecCase: begin
      len := sonsLen(n);
      if (n.sons[0].kind <> nkSym) then
        InternalError(n.info, 'genObjectFields');
      field := n.sons[0].sym;
      s := genTypeInfo(p, field.typ);
      for i := 1 to len-1 do begin
        b := n.sons[i]; // branch
        u := nil;
        case b.kind of
          nkOfBranch: begin
            if sonsLen(b) < 2 then
              internalError(b.info, 'genObjectFields; nkOfBranch broken');
            for j := 0 to sonsLen(b)-2 do begin
              if u <> nil then app(u, ', ');
              if b.sons[j].kind = nkRange then begin
                appf(u, '[$1, $2]', [toRope(getOrdValue(b.sons[j].sons[0])),
                                     toRope(getOrdValue(b.sons[j].sons[1]))]);
              end
              else
                app(u, toRope(getOrdValue(b.sons[j])))
            end
          end;
          nkElse: u := toRope(lengthOrd(field.typ));
          else internalError(n.info, 'genObjectFields(nkRecCase)');
        end;
        if result <> nil then app(result, ', ' + tnl);
        appf(result, '[SetConstr($1), $2]',
             [u, genObjectFields(p, typ, lastSon(b))]);
      end;
      result := ropef('{kind: 3, offset: "$1", len: $3, ' +
                      'typ: $2, name: $4, sons: [$5]}', [mangleName(field), s,
                      toRope(lengthOrd(field.typ)),
                      makeCString(field.name.s),
                      result]);
    end;
    else internalError(n.info, 'genObjectFields');
  end
end;

procedure genObjectInfo(var p: TProc; typ: PType; name: PRope);
var
  s: PRope;
begin
  s := ropef('var $1 = {size: 0, kind: $2, base: null, node: null, ' +
             'finalizer: null};$n', [name, toRope(ord(typ.kind))]);
  prepend(p.globals.typeInfo, s);

  appf(p.globals.typeInfo, 'var NNI$1 = $2;$n',
      [toRope(typ.id), genObjectFields(p, typ, typ.n)]);
  appf(p.globals.typeInfo, '$1.node = NNI$2;$n', [name, toRope(typ.id)]);
  if (typ.kind = tyObject) and (typ.sons[0] <> nil) then begin
    appf(p.globals.typeInfo, '$1.base = $2;$n',
        [name, genTypeInfo(p, typ.sons[0])]);
  end
end;

procedure genEnumInfo(var p: TProc; typ: PType; name: PRope);
var
  s, n: PRope;
  len, i: int;
  field: PSym;
begin
  len := sonsLen(typ.n);
  s := nil;
  for i := 0 to len-1 do begin
    if (typ.n.sons[i].kind <> nkSym) then
      InternalError(typ.n.info, 'genEnumInfo');
    field := typ.n.sons[i].sym;
    if i > 0 then app(s, ', '+tnl);
    appf(s, '{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}',
            [toRope(field.position), name, makeCString(field.name.s)]);
  end;
  n := ropef('var NNI$1 = {kind: 2, offset: 0, typ: null, ' +
             'name: null, len: $2, sons: [$3]};$n',
             [toRope(typ.id), toRope(len), s]);

  s := ropef('var $1 = {size: 0, kind: $2, base: null, node: null, ' +
             'finalizer: null};$n', [name, toRope(ord(typ.kind))]);
  prepend(p.globals.typeInfo, s);

  app(p.globals.typeInfo, n);
  appf(p.globals.typeInfo, '$1.node = NNI$2;$n', [name, toRope(typ.id)]);
  if typ.sons[0] <> nil then begin
    appf(p.globals.typeInfo, '$1.base = $2;$n',
        [name, genTypeInfo(p, typ.sons[0])]);
  end;
end;

function genTypeInfo(var p: TProc; typ: PType): PRope;
var
  t: PType;
  s: PRope;
begin
  t := typ;
  if t.kind = tyGenericInst then t := lastSon(t);
  result := ropef('NTI$1', [toRope(t.id)]);
  if IntSetContainsOrIncl(p.globals.TypeInfoGenerated, t.id) then exit;
  case t.kind of 
    tyDistinct: result := genTypeInfo(p, typ.sons[0]);
    tyPointer, tyProc, tyBool, tyChar, tyCString, tyString,
    tyInt..tyFloat128: begin
      s := ropef(
        'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n',
        [result, toRope(ord(t.kind))]);
      prepend(p.globals.typeInfo, s);
    end;
    tyVar, tyRef, tyPtr, tySequence, tyRange, tySet: begin
      s := ropef(
        'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n',
        [result, toRope(ord(t.kind))]);
      prepend(p.globals.typeInfo, s);
      appf(p.globals.typeInfo, '$1.base = $2;$n',
          [result, genTypeInfo(p, typ.sons[0])]);
    end;
    tyArrayConstr, tyArray: begin
      s := ropef(
        'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n',
        [result, toRope(ord(t.kind))]);
      prepend(p.globals.typeInfo, s);
      appf(p.globals.typeInfo, '$1.base = $2;$n',
          [result, genTypeInfo(p, typ.sons[1])]);
    end;
    tyEnum: genEnumInfo(p, t, result);
    tyObject, tyTuple: genObjectInfo(p, t, result);
    else InternalError('genTypeInfo(' + typekindToStr[t.kind] + ')');
  end
end;

// ---------------------------------------------------------------------------

procedure gen(var p: TProc; n: PNode; var r: TCompRes); forward;
procedure genStmt(var p: TProc; n: PNode; var r: TCompRes); forward;

procedure useMagic(var p: TProc; const ident: string);
begin
  // to implement
end;

function mergeExpr(a, b: PRope): PRope; overload;
begin
  if (a <> nil) then begin
    if b <> nil then result := ropef('($1, $2)', [a, b])
    else result := a
  end
  else result := b
end;

function mergeExpr(const r: TCompRes): PRope; overload;
begin
  result := mergeExpr(r.com, r.res);
end;

function mergeStmt(const r: TCompRes): PRope;
begin
  if r.res = nil then result := r.com
  else if r.com = nil then result := r.res
  else result := ropef('$1$2', [r.com, r.res])
end;

procedure genAnd(var p: TProc; a, b: PNode; var r: TCompRes);
var
  x, y: TCompRes;
begin
  gen(p, a, x);
  gen(p, b, y);
  r.res := ropef('($1 && $2)', [mergeExpr(x), mergeExpr(y)])
end;

procedure genOr(var p: TProc; a, b: PNode; var r: TCompRes);
var
  x, y: TCompRes;
begin
  gen(p, a, x);
  gen(p, b, y);
  r.res := ropef('($1 || $2)', [mergeExpr(x), mergeExpr(y)])
end;

type
  TMagicFrmt = array [0..3] of string;

const
  // magic checked op; magic unchecked op; checked op; unchecked op
  ops: array [mAddi..mStrToStr] of TMagicFrmt = (
    ('addInt', '',   'addInt($1, $2)',    '($1 + $2)'), // AddI
    ('subInt', '',   'subInt($1, $2)',    '($1 - $2)'), // SubI
    ('mulInt', '',   'mulInt($1, $2)',    '($1 * $2)'), // MulI
    ('divInt', '',   'divInt($1, $2)',    'Math.floor($1 / $2)'), // DivI
    ('modInt', '',   'modInt($1, $2)',    'Math.floor($1 % $2)'), // ModI
    ('addInt64', '',   'addInt64($1, $2)',  '($1 + $2)'), // AddI64
    ('subInt64', '',   'subInt64($1, $2)',  '($1 - $2)'), // SubI64
    ('mulInt64', '',   'mulInt64($1, $2)',  '($1 * $2)'), // MulI64
    ('divInt64', '',   'divInt64($1, $2)',  'Math.floor($1 / $2)'), // DivI64
    ('modInt64', '',   'modInt64($1, $2)',  'Math.floor($1 % $2)'), // ModI64
    ('',   '',   '($1 >>> $2)',       '($1 >>> $2)'), // ShrI
    ('',   '',   '($1 << $2)',        '($1 << $2)'), // ShlI
    ('',   '',   '($1 & $2)',         '($1 & $2)'), // BitandI
    ('',   '',   '($1 | $2)',         '($1 | $2)'), // BitorI
    ('',   '',   '($1 ^ $2)',         '($1 ^ $2)'), // BitxorI
    ('nimMin', 'nimMin', 'nimMin($1, $2)',    'nimMin($1, $2)'), // MinI
    ('nimMax', 'nimMax', 'nimMax($1, $2)',    'nimMax($1, $2)'), // MaxI
    ('',   '',   '($1 >>> $2)',       '($1 >>> $2)'), // ShrI64
    ('',   '',   '($1 << $2)',        '($1 << $2)'), // ShlI64
    ('',   '',   '($1 & $2)',         '($1 & $2)'), // BitandI64
    ('',   '',   '($1 | $2)',         '($1 | $2)'), // BitorI64
    ('',   '',   '($1 ^ $2)',         '($1 ^ $2)'), // BitxorI64
    ('nimMin', 'nimMin', 'nimMin($1, $2)',    'nimMin($1, $2)'), // MinI64
    ('nimMax', 'nimMax', 'nimMax($1, $2)',    'nimMax($1, $2)'), // MaxI64
    ('',   '',   '($1 + $2)',         '($1 + $2)'), // AddF64
    ('',   '',   '($1 - $2)',         '($1 - $2)'), // SubF64
    ('',   '',   '($1 * $2)',         '($1 * $2)'), // MulF64
    ('',   '',   '($1 / $2)',         '($1 / $2)'), // DivF64
    ('nimMin', 'nimMin', 'nimMin($1, $2)',    'nimMin($1, $2)'), // MinF64
    ('nimMax', 'nimMax', 'nimMax($1, $2)',    'nimMax($1, $2)'), // MaxF64
    ('AddU', 'AddU', 'AddU($1, $2)',      'AddU($1, $2)'), // AddU
    ('SubU', 'SubU', 'SubU($1, $2)',      'SubU($1, $2)'), // SubU
    ('MulU', 'MulU', 'MulU($1, $2)',      'MulU($1, $2)'), // MulU
    ('DivU', 'DivU', 'DivU($1, $2)',      'DivU($1, $2)'), // DivU
    ('ModU', 'ModU', 'ModU($1, $2)',      'ModU($1, $2)'), // ModU
    ('AddU64', 'AddU64', 'AddU64($1, $2)',    'AddU64($1, $2)'), // AddU64
    ('SubU64', 'SubU64', 'SubU64($1, $2)',    'SubU64($1, $2)'), // SubU64
    ('MulU64', 'MulU64', 'MulU64($1, $2)',    'MulU64($1, $2)'), // MulU64
    ('DivU64', 'DivU64', 'DivU64($1, $2)',    'DivU64($1, $2)'), // DivU64
    ('ModU64', 'ModU64', 'ModU64($1, $2)',    'ModU64($1, $2)'), // ModU64
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqI
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LeI
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtI
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqI64
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LeI64
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtI64
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqF64
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LeF64
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtF64
    ('LeU', 'LeU', 'LeU($1, $2)',       'LeU($1, $2)'), // LeU
    ('LtU', 'LtU', 'LtU($1, $2)',       'LtU($1, $2)'), // LtU
    ('LeU64', 'LeU64', 'LeU64($1, $2)',     'LeU64($1, $2)'), // LeU64
    ('LtU64', 'LtU64', 'LtU64($1, $2)',     'LtU64($1, $2)'), // LtU64
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqEnum
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LeEnum
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtEnum
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqCh
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LeCh
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtCh
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqB
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LeB
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtB
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqRef
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqProc
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqUntracedRef
    ('',   '',   '($1 <= $2)',        '($1 <= $2)'), // LePtr
    ('',   '',   '($1 < $2)',         '($1 < $2)'), // LtPtr
    ('',   '',   '($1 == $2)',        '($1 == $2)'), // EqCString
    ('',   '',   '($1 != $2)',        '($1 != $2)'), // Xor
    ('NegInt', '',   'NegInt($1)',        '-($1)'), // UnaryMinusI
    ('NegInt64', '',   'NegInt64($1)',      '-($1)'), // UnaryMinusI64
    ('AbsInt', '',   'AbsInt($1)',        'Math.abs($1)'), // AbsI
    ('AbsInt64', '', 'AbsInt64($1)',      'Math.abs($1)'), // AbsI64
    ('',   '',   '!($1)',             '!($1)'), // Not
    ('',   '',   '+($1)',             '+($1)'), // UnaryPlusI
    ('',   '',   '~($1)',             '~($1)'), // BitnotI
    ('',   '',   '+($1)',             '+($1)'), // UnaryPlusI64
    ('',   '',   '~($1)',             '~($1)'), // BitnotI64
    ('',   '',   '+($1)',             '+($1)'), // UnaryPlusF64
    ('',   '',   '-($1)',             '-($1)'), // UnaryMinusF64
    ('',   '',   'Math.abs($1)',      'Math.abs($1)'), // AbsF64

    ('Ze8ToI', 'Ze8ToI', 'Ze8ToI($1)', 'Ze8ToI($1)'),  // mZe8ToI
    ('Ze8ToI64', 'Ze8ToI64', 'Ze8ToI64($1)', 'Ze8ToI64($1)'),  // mZe8ToI64
    ('Ze16ToI', 'Ze16ToI', 'Ze16ToI($1)', 'Ze16ToI($1)'),  // mZe16ToI
    ('Ze16ToI64', 'Ze16ToI64', 'Ze16ToI64($1)', 'Ze16ToI64($1)'),  // mZe16ToI64
    ('Ze32ToI64', 'Ze32ToI64', 'Ze32ToI64($1)', 'Ze32ToI64($1)'),  // mZe32ToI64
    ('ZeIToI64', 'ZeIToI64', 'ZeIToI64($1)', 'ZeIToI64($1)'),  // mZeIToI64

    ('ToU8', 'ToU8', 'ToU8($1)',          'ToU8($1)'), // ToU8
    ('ToU16', 'ToU16', 'ToU16($1)',         'ToU16($1)'), // ToU16
    ('ToU32', 'ToU32', 'ToU32($1)',         'ToU32($1)'), // ToU32
    ('',   '',   '$1',                '$1'), // ToFloat
    ('',   '',   '$1',                '$1'), // ToBiggestFloat
    ('',   '',   'Math.floor($1)',    'Math.floor($1)'), // ToInt
    ('',   '',   'Math.floor($1)',    'Math.floor($1)'), // ToBiggestInt

    ('nimCharToStr', 'nimCharToStr', 'nimCharToStr($1)', 'nimCharToStr($1)'),
    ('nimBoolToStr', 'nimBoolToStr', 'nimBoolToStr($1)', 'nimBoolToStr($1)'),
    ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'),
    ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'),
    ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'),
    ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr($1)', 'cstrToNimStr($1)'),
    ('', '', '$1', '$1')
  );

procedure binaryExpr(var p: TProc; n: PNode; var r: TCompRes;
                     const magic, frmt: string);
var
  x, y: TCompRes;
begin
  if magic <> '' then useMagic(p, magic);
  gen(p, n.sons[1], x);
  gen(p, n.sons[2], y);
  r.res := ropef(frmt, [x.res, y.res]);
  r.com := mergeExpr(x.com, y.com);
end;

procedure binaryStmt(var p: TProc; n: PNode; var r: TCompRes;
                     const magic, frmt: string);
var
  x, y: TCompRes;
begin
  if magic <> '' then useMagic(p, magic);
  gen(p, n.sons[1], x);
  gen(p, n.sons[2], y);
  if x.com <> nil then appf(r.com, '$1;$n', [x.com]);
  if y.com <> nil then appf(r.com, '$1;$n', [y.com]);
  appf(r.com, frmt, [x.res, y.res]);
end;

procedure unaryExpr(var p: TProc; n: PNode; var r: TCompRes;
                    const magic, frmt: string);
begin
  if magic <> '' then useMagic(p, magic);
  gen(p, n.sons[1], r);
  r.res := ropef(frmt, [r.res]);
end;

procedure arith(var p: TProc; n: PNode; var r: TCompRes; op: TMagic);
var
  x, y: TCompRes;
  i: int;
begin
  if optOverflowCheck in p.options then i := 0 else i := 1;
  useMagic(p, ops[op][i]);
  if sonsLen(n) > 2 then begin
    gen(p, n.sons[1], x);
    gen(p, n.sons[2], y);
    r.res := ropef(ops[op][i+2], [x.res, y.res]);
    r.com := mergeExpr(x.com, y.com);
  end
  else begin
    gen(p, n.sons[1], r);
    r.res := ropef(ops[op][i+2], [r.res])
  end
end;

procedure genLineDir(var p: TProc; n: PNode; var r: TCompRes);
var
  line: int;
begin
  line := toLinenumber(n.info);
  if optLineDir in p.Options then // pretty useless, but better than nothing
    appf(r.com, '// line $2 "$1"$n',
      [toRope(toFilename(n.info)), toRope(line)]);
  if ([optStackTrace, optEndb] * p.Options = [optStackTrace, optEndb]) and
      ((p.prc = nil) or not (sfPure in p.prc.flags)) then begin
    useMagic(p, 'endb');
    appf(r.com, 'endb($1);$n', [toRope(line)])
  end
  else if ([optLineTrace, optStackTrace] * p.Options =
        [optLineTrace, optStackTrace]) and ((p.prc = nil) or
      not (sfPure in p.prc.flags)) then
    appf(r.com, 'F.line = $1;$n', [toRope(line)])
end;

procedure finishTryStmt(var p: TProc; var r: TCompRes; howMany: int);
var
  i: int;
begin
  for i := 1 to howMany do
    app(r.com, 'excHandler = excHandler.prev;' + tnl);
end;

procedure genWhileStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  cond, stmt: TCompRes;
  len, labl: int;
begin
  genLineDir(p, n, r);
  inc(p.unique);
  len := length(p.blocks);
  setLength(p.blocks, len+1);
  p.blocks[len].id := -p.unique;
  p.blocks[len].nestedTryStmts := p.nestedTryStmts;
  labl := p.unique;
  gen(p, n.sons[0], cond);
  genStmt(p, n.sons[1], stmt);
  if p.blocks[len].id > 0 then
    appf(r.com, 'L$3: while ($1) {$n$2}$n',
      [mergeExpr(cond), mergeStmt(stmt), toRope(labl)])
  else
    appf(r.com, 'while ($1) {$n$2}$n',
      [mergeExpr(cond), mergeStmt(stmt)]);
  setLength(p.blocks, len);
end;

procedure genTryStmt(var p: TProc; n: PNode; var r: TCompRes);
  // code to generate:
(*
  var sp = {prev: excHandler, exc: null};
  excHandler = sp;
  try {
    stmts;
  } catch (e) {
    if (e.typ && e.typ == NTI433 || e.typ == NTI2321) {
      stmts;
    } else if (e.typ && e.typ == NTI32342) {
      stmts;
    } else {
      stmts;
    }
  } finally {
    stmts;
    excHandler = excHandler.prev;
  }
*)
var
  i, j, len, blen: int;
  safePoint, orExpr, epart: PRope;
  a: TCompRes;
begin
  genLineDir(p, n, r);
  inc(p.unique);
  safePoint := ropef('Tmp$1', [toRope(p.unique)]);
  appf(r.com, 'var $1 = {prev: excHandler, exc: null};$n' +
              'excHandler = $1;$n', [safePoint]);
  if optStackTrace in p.Options then
    app(r.com, 'framePtr = F;' + tnl);
  app(r.com, 'try {' + tnl);
  len := sonsLen(n);
  inc(p.nestedTryStmts);
  genStmt(p, n.sons[0], a);
  app(r.com, mergeStmt(a));
  i := 1;
  epart := nil;
  while (i < len) and (n.sons[i].kind = nkExceptBranch) do begin
    blen := sonsLen(n.sons[i]);
    if blen = 1 then begin
      // general except section:
      if i > 1 then app(epart, 'else {' + tnl);
      genStmt(p, n.sons[i].sons[0], a);
      app(epart, mergeStmt(a));
      if i > 1 then app(epart, '}' + tnl);
    end
    else begin
      orExpr := nil;
      for j := 0 to blen-2 do begin
        if (n.sons[i].sons[j].kind <> nkType) then
          InternalError(n.info, 'genTryStmt');
        if orExpr <> nil then app(orExpr, '||');
        appf(orExpr, '($1.exc.m_type == $2)',
          [safePoint, genTypeInfo(p, n.sons[i].sons[j].typ)])
      end;
      if i > 1 then app(epart, 'else ');
      appf(epart, 'if ($1.exc && $2) {$n', [safePoint, orExpr]);
      genStmt(p, n.sons[i].sons[blen - 1], a);
      appf(epart, '$1}$n', [mergeStmt(a)]);
    end;
    inc(i)
  end;
  if epart <> nil then
    appf(r.com, '} catch (EXC) {$n$1', [epart]);
  finishTryStmt(p, r, p.nestedTryStmts);
  dec(p.nestedTryStmts);
  app(r.com, '} finally {' + tnl + 'excHandler = excHandler.prev;' +{&} tnl);
  if (i < len) and (n.sons[i].kind = nkFinally) then begin
    genStmt(p, n.sons[i].sons[0], a);
    app(r.com, mergeStmt(a));
  end;
  app(r.com, '}' + tnl);
end;

procedure genRaiseStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  typ: PType;
begin
  genLineDir(p, n, r);
  if n.sons[0] <> nil then begin
    gen(p, n.sons[0], a);
    if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
    typ := skipTypes(n.sons[0].typ, abstractPtrs);
    useMagic(p, 'raiseException');
    appf(r.com, 'raiseException($1, $2);$n',
      [a.res, makeCString(typ.sym.name.s)]);
  end
  else begin
    useMagic(p, 'reraiseException');
    app(r.com, 'reraiseException();' + tnl);
  end
end;

procedure genCaseStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  cond, stmt: TCompRes;
  i, j: int;
  it, e, v: PNode;
  stringSwitch: bool;
begin
  genLineDir(p, n, r);
  gen(p, n.sons[0], cond);
  if cond.com <> nil then
    appf(r.com, '$1;$n', [cond.com]);
  stringSwitch := skipTypes(n.sons[0].typ, abstractVar).kind = tyString;
  if stringSwitch then begin
    useMagic(p, 'toEcmaStr');
    appf(r.com, 'switch (toEcmaStr($1)) {$n', [cond.res])
  end
  else
    appf(r.com, 'switch ($1) {$n', [cond.res]);
  for i := 1 to sonsLen(n)-1 do begin
    it := n.sons[i];
    case it.kind of
      nkOfBranch: begin
        for j := 0 to sonsLen(it)-2 do begin
          e := it.sons[j];
          if e.kind = nkRange then begin
            v := copyNode(e.sons[0]);
            while (v.intVal <= e.sons[1].intVal) do begin
              gen(p, v, cond);
              if cond.com <> nil then
                internalError(v.info, 'ecmasgen.genCaseStmt');
              appf(r.com, 'case $1: ', [cond.res]);
              Inc(v.intVal)
            end
          end
          else begin
            gen(p, e, cond);
            if cond.com <> nil then
              internalError(e.info, 'ecmasgen.genCaseStmt');
            if stringSwitch then begin
              case e.kind of
                nkStrLit..nkTripleStrLit:
                  appf(r.com, 'case $1: ', [makeCString(e.strVal)]);
                else InternalError(e.info, 'ecmasgen.genCaseStmt: 2');
              end
            end
            else
              appf(r.com, 'case $1: ', [cond.res]);
          end
        end;
        genStmt(p, lastSon(it), stmt);
        appf(r.com, '$n$1break;$n', [mergeStmt(stmt)]);
      end;
      nkElse: begin
        genStmt(p, it.sons[0], stmt);
        appf(r.com, 'default: $n$1break;$n', [mergeStmt(stmt)]);
      end
      else internalError(it.info, 'ecmasgen.genCaseStmt')
    end
  end;
  appf(r.com, '}$n', []);
end;

procedure genStmtListExpr(var p: TProc; n: PNode; var r: TCompRes); forward;

procedure genBlock(var p: TProc; n: PNode; var r: TCompRes);
var
  idx, labl: int;
  sym: PSym;
begin
  inc(p.unique);
  idx := length(p.blocks);
  if n.sons[0] <> nil then begin // named block?
    if (n.sons[0].kind <> nkSym) then InternalError(n.info, 'genBlock');
    sym := n.sons[0].sym;
    sym.loc.k := locOther;
    sym.loc.a := idx
  end;
  setLength(p.blocks, idx+1);
  p.blocks[idx].id := -p.unique; // negative because it isn't used yet
  p.blocks[idx].nestedTryStmts := p.nestedTryStmts;
  labl := p.unique;
  if n.kind = nkBlockExpr then genStmtListExpr(p, n.sons[1], r)
  else genStmt(p, n.sons[1], r);
  if p.blocks[idx].id > 0 then begin // label has been used:
    r.com := ropef('L$1: do {$n$2} while(false);$n',
                   [toRope(labl), r.com]);
  end;
  setLength(p.blocks, idx)
end;

procedure genBreakStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  idx: int;
  sym: PSym;
begin
  genLineDir(p, n, r);
  idx := length(p.blocks)-1;
  if n.sons[0] <> nil then begin // named break?
    assert(n.sons[0].kind = nkSym);
    sym := n.sons[0].sym;
    assert(sym.loc.k = locOther);
    idx := sym.loc.a
  end;
  p.blocks[idx].id := abs(p.blocks[idx].id); // label is used
  finishTryStmt(p, r, p.nestedTryStmts - p.blocks[idx].nestedTryStmts);
  appf(r.com, 'break L$1;$n', [toRope(p.blocks[idx].id)])
end;

procedure genAsmStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  i: int;
begin
  genLineDir(p, n, r);
  assert(n.kind = nkAsmStmt);
  for i := 0 to sonsLen(n)-1 do begin
    case n.sons[i].Kind of
      nkStrLit..nkTripleStrLit: app(r.com, n.sons[i].strVal);
      nkSym: app(r.com, mangleName(n.sons[i].sym));
      else InternalError(n.sons[i].info, 'ecmasgen: genAsmStmt()')
    end
  end
end;

procedure genIfStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  i, toClose: int;
  cond, stmt: TCompRes;
  it: PNode;
begin
  toClose := 0;
  for i := 0 to sonsLen(n)-1 do begin
    it := n.sons[i];
    if sonsLen(it) <> 1 then begin
      gen(p, it.sons[0], cond);
      genStmt(p, it.sons[1], stmt);
      if i > 0 then begin appf(r.com, 'else {$n', []); inc(toClose) end;
      if cond.com <> nil then appf(r.com, '$1;$n', [cond.com]);
      appf(r.com, 'if ($1) {$n$2}', [cond.res, mergeStmt(stmt)]);
    end
    else begin
      // else part:
      genStmt(p, it.sons[0], stmt);
      appf(r.com, 'else {$n$1}$n', [mergeStmt(stmt)]);
    end
  end;
  app(r.com, repeatChar(toClose, '}')+{&}tnl);
end;

procedure genIfExpr(var p: TProc; n: PNode; var r: TCompRes);
var
  i, toClose: int;
  cond, stmt: TCompRes;
  it: PNode;
begin
  toClose := 0;
  for i := 0 to sonsLen(n)-1 do begin
    it := n.sons[i];
    if sonsLen(it) <> 1 then begin
      gen(p, it.sons[0], cond);
      gen(p, it.sons[1], stmt);
      if i > 0 then begin app(r.res, ': ('); inc(toClose); end;
      r.com := mergeExpr(r.com, cond.com);
      r.com := mergeExpr(r.com, stmt.com);
      appf(r.res, '($1) ? ($2)', [cond.res, stmt.res]);
    end
    else begin
      // else part:
      gen(p, it.sons[0], stmt);
      r.com := mergeExpr(r.com, stmt.com);
      appf(r.res, ': ($1)', [stmt.res]);
    end
  end;
  app(r.res, repeatChar(toClose, ')'));
end;

function generateHeader(var p: TProc; typ: PType): PRope;
var
  i: int;
  param: PSym;
  name: PRope;
begin
  result := nil;
  for i := 1 to sonsLen(typ.n)-1 do begin
    if result <> nil then app(result, ', ');
    assert(typ.n.sons[i].kind = nkSym);
    param := typ.n.sons[i].sym;
    name := mangleName(param);
    app(result, name);
    if mapType(param.typ) = etyBaseIndex then begin
      app(result, ', ');
      app(result, name);
      app(result, '_Idx');
    end
  end
end;

const
  nodeKindsNeedNoCopy = {@set}[nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit,
                               nkFloatLit..nkFloat64Lit,
                               nkCurly, nkPar, 
                               nkStringToCString, nkCStringToString,
                               nkCall, nkCommand, nkHiddenCallConv,
                               nkCallStrLit];

function needsNoCopy(y: PNode): bool;
begin
  result := (y.kind in nodeKindsNeedNoCopy)
      or (skipTypes(y.typ, abstractInst).kind in [tyRef, tyPtr, tyVar])
end;

procedure genAsgnAux(var p: TProc; x, y: PNode; var r: TCompRes;
                     noCopyNeeded: bool);
var
  a, b: TCompRes;
begin
  gen(p, x, a);
  gen(p, y, b);
  case mapType(x.typ) of
    etyObject: begin
      if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
      if b.com <> nil then appf(r.com, '$1;$n', [b.com]);
      if needsNoCopy(y) or noCopyNeeded then
        appf(r.com, '$1 = $2;$n', [a.res, b.res])
      else begin
        useMagic(p, 'NimCopy');
        appf(r.com, '$1 = NimCopy($2, $3);$n',
            [a.res, b.res, genTypeInfo(p, y.typ)]);
      end
    end;
    etyBaseIndex: begin
      if (a.kind <> etyBaseIndex) or (b.kind <> etyBaseIndex) then
        internalError(x.info, 'genAsgn');
      appf(r.com, '$1 = $2; $3 = $4;$n', [a.com, b.com, a.res, b.res]);
    end
    else begin
      if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
      if b.com <> nil then appf(r.com, '$1;$n', [b.com]);
      appf(r.com, '$1 = $2;$n', [a.res, b.res]);
    end
  end
end;

procedure genAsgn(var p: TProc; n: PNode; var r: TCompRes);
begin
  genLineDir(p, n, r);
  genAsgnAux(p, n.sons[0], n.sons[1], r, false);
end;

procedure genFastAsgn(var p: TProc; n: PNode; var r: TCompRes);
begin
  genLineDir(p, n, r);
  genAsgnAux(p, n.sons[0], n.sons[1], r, true);
end;

procedure genSwap(var p: TProc; n: PNode; var r: TCompRes);
var
  a, b: TCompRes;
  tmp, tmp2: PRope;
begin
  gen(p, n.sons[1], a);
  gen(p, n.sons[2], b);
  inc(p.unique);
  tmp := ropef('Tmp$1', [toRope(p.unique)]);
  case mapType(n.sons[1].typ) of
    etyBaseIndex: begin
      inc(p.unique);
      tmp2 := ropef('Tmp$1', [toRope(p.unique)]);
      if (a.kind <> etyBaseIndex) or (b.kind <> etyBaseIndex) then
        internalError(n.info, 'genSwap');
      appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1;$n', [tmp, a.com, b.com]);
      appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1', [tmp2, a.res, b.res]);
    end
    else begin
      if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
      if b.com <> nil then appf(r.com, '$1;$n', [b.com]);
      appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1', [tmp, a.res, b.res]);
    end
  end
end;

procedure genFieldAddr(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  f: PSym;
begin
  r.kind := etyBaseIndex;
  gen(p, n.sons[0], a);
  if n.sons[1].kind <> nkSym then
    InternalError(n.sons[1].info, 'genFieldAddr');
  f := n.sons[1].sym;
  if f.loc.r = nil then f.loc.r := mangleName(f);
  r.res := makeCString(ropeToStr(f.loc.r));
  r.com := mergeExpr(a);
end;

procedure genFieldAccess(var p: TProc; n: PNode; var r: TCompRes);
var
  f: PSym;
begin
  r.kind := etyNone;
  gen(p, n.sons[0], r);
  if n.sons[1].kind <> nkSym then
    InternalError(n.sons[1].info, 'genFieldAddr');
  f := n.sons[1].sym;
  if f.loc.r = nil then f.loc.r := mangleName(f);
  r.res := ropef('$1.$2', [r.res, f.loc.r]);
end;

procedure genCheckedFieldAddr(var p: TProc; n: PNode; var r: TCompRes);
begin
  genFieldAddr(p, n.sons[0], r); // XXX
end;

procedure genCheckedFieldAccess(var p: TProc; n: PNode; var r: TCompRes);
begin
  genFieldAccess(p, n.sons[0], r); // XXX
end;

procedure genArrayAddr(var p: TProc; n: PNode; var r: TCompRes);
var
  a, b: TCompRes;
  first: biggestInt;
  typ: PType;
begin
  r.kind := etyBaseIndex;
  gen(p, n.sons[0], a);
  gen(p, n.sons[1], b);
  r.com := mergeExpr(a);
  typ := skipTypes(n.sons[0].typ, abstractPtrs);
  if typ.kind in [tyArray, tyArrayConstr] then first := FirstOrd(typ.sons[0])
  else first := 0;
  if (optBoundsCheck in p.options) and not isConstExpr(n.sons[1]) then begin
    useMagic(p, 'chckIndx');
    b.res := ropef('chckIndx($1, $2, $3.length)-$2',
                  [b.res, toRope(first), a.res]);
    // XXX: BUG: a.res evaluated twice!
  end
  else if first <> 0 then begin
    b.res := ropef('($1)-$2', [b.res, toRope(first)]);
  end;
  r.res := mergeExpr(b);
end;

procedure genArrayAccess(var p: TProc; n: PNode; var r: TCompRes);
begin
  genArrayAddr(p, n, r);
  r.kind := etyNone;
  r.res := ropef('$1[$2]', [r.com, r.res]);
  r.com := nil;
end;

(*
type
  TMyList = record
    x: seq[ptr ptr int]
    L: int
    next: ptr TMyList

proc myAdd(head: var ptr TMyList, item: ptr TMyList) =
  item.next = head
  head = item

proc changeInt(i: var int) = inc(i)

proc f(p: ptr TMyList, x: ptr ptr int) =
  add p.x, x
  p.next = nil
  changeInt(p.L)

*)

procedure genAddr(var p: TProc; n: PNode; var r: TCompRes);
var
  s: PSym;
begin
  case n.sons[0].kind of
    nkSym: begin
      s := n.sons[0].sym;
      if s.loc.r = nil then InternalError(n.info, 'genAddr: 3');
      case s.kind of
        skVar: begin
          if mapType(n.typ) = etyObject then begin
            // make addr() a no-op:
            r.kind := etyNone;
            r.res := s.loc.r;
            r.com := nil;
          end
          else if sfGlobal in s.flags then begin
            // globals are always indirect accessible
            r.kind := etyBaseIndex;
            r.com := toRope('Globals');
            r.res := makeCString(ropeToStr(s.loc.r));
          end
          else if sfAddrTaken in s.flags then begin
            r.kind := etyBaseIndex;
            r.com := s.loc.r;
            r.res := toRope('0'+'');
          end
          else InternalError(n.info, 'genAddr: 4');
        end;
        else InternalError(n.info, 'genAddr: 2');
      end;
    end;
    nkCheckedFieldExpr: genCheckedFieldAddr(p, n, r);
    nkDotExpr: genFieldAddr(p, n, r);
    nkBracketExpr: genArrayAddr(p, n, r);
    else InternalError(n.info, 'genAddr');
  end
end;

procedure genSym(var p: TProc; n: PNode; var r: TCompRes);
var
  s: PSym;
  k: TEcmasTypeKind;
begin
  s := n.sym;
  if s.loc.r = nil then
    InternalError(n.info, 'symbol has no generated name: ' + s.name.s);
  case s.kind of
    skVar, skParam, skTemp: begin
      k := mapType(s.typ);
      if k = etyBaseIndex then begin
        r.kind := etyBaseIndex;
        if [sfAddrTaken, sfGlobal] * s.flags <> [] then begin
          r.com := ropef('$1[0]', [s.loc.r]);
          r.res := ropef('$1[1]', [s.loc.r]);
        end
        else begin
          r.com := s.loc.r;
          r.res := con(s.loc.r, '_Idx');
        end
      end
      else if (k <> etyObject) and (sfAddrTaken in s.flags) then
        r.res := ropef('$1[0]', [s.loc.r])
      else
        r.res := s.loc.r
    end
    else r.res := s.loc.r;
  end
end;

procedure genDeref(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
begin
  if mapType(n.sons[0].typ) = etyObject then
    gen(p, n.sons[0], r)
  else begin
    gen(p, n.sons[0], a);
    if a.kind <> etyBaseIndex then InternalError(n.info, 'genDeref');
    r.res := ropef('$1[$2]', [a.com, a.res])
  end
end;

procedure genCall(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  i: int;
begin
  gen(p, n.sons[0], r);
  app(r.res, '('+'');
  for i := 1 to sonsLen(n)-1 do begin
    if i > 1 then app(r.res, ', ');
    gen(p, n.sons[i], a);
    if a.kind = etyBaseIndex then begin
      app(r.res, a.com);
      app(r.res, ', ');
      app(r.res, a.res);
    end
    else
      app(r.res, mergeExpr(a));
  end;
  app(r.res, ')'+'');
end;

function putToSeq(const s: string; indirect: bool): PRope;
begin
  result := toRope(s);
  if indirect then result := ropef('[$1]', [result])
end;

function createVar(var p: TProc; typ: PType;
                   indirect: bool): PRope; forward;

function createRecordVarAux(var p: TProc; rec: PNode; var c: int): PRope;
var
  i: int;
begin
  result := nil;
  case rec.kind of
    nkRecList: begin
      for i := 0 to sonsLen(rec)-1 do
        app(result, createRecordVarAux(p, rec.sons[i], c))
    end;
    nkRecCase: begin
      app(result, createRecordVarAux(p, rec.sons[0], c));
      for i := 1 to sonsLen(rec)-1 do
        app(result, createRecordVarAux(p, lastSon(rec.sons[i]), c));
    end;
    nkSym: begin
      if c > 0 then app(result, ', ');
      app(result, mangleName(rec.sym));
      app(result, ': ');
      app(result, createVar(p, rec.sym.typ, false));
      inc(c);
    end;
    else InternalError(rec.info, 'createRecordVarAux')
  end
end;

function createVar(var p: TProc; typ: PType; indirect: bool): PRope;
var
  i, len, c: int;
  t, e: PType;
begin
  t := skipTypes(typ, abstractInst);
  case t.kind of
    tyInt..tyInt64, tyEnum, tyChar: begin
      result := putToSeq('0'+'', indirect)
    end;
    tyFloat..tyFloat128: result := putToSeq('0.0', indirect);
    tyRange: result := createVar(p, typ.sons[0], indirect);
    tySet: result := toRope('{}');
    tyBool: result := putToSeq('false', indirect);
    tyArray, tyArrayConstr: begin
      len := int(lengthOrd(t));
      e := elemType(t);
      if len > 32 then begin
        useMagic(p, 'ArrayConstr');
        result := ropef('ArrayConstr($1, $2, $3)',
                        [toRope(len), createVar(p, e, false),
                        genTypeInfo(p, e)])
      end
      else begin
        result := toRope('['+'');
        i := 0;
        while i < len do begin
          if i > 0 then app(result, ', ');
          app(result, createVar(p, e, false));
          inc(i);
        end;
        app(result, ']'+'');
      end
    end;
    tyTuple: begin
      result := toRope('{'+'');
      c := 0;
      app(result, createRecordVarAux(p, t.n, c));
      app(result, '}'+'');
    end;
    tyObject: begin
      result := toRope('{'+'');
      c := 0;
      if not (tfFinal in t.flags) or (t.sons[0] <> nil) then begin
        inc(c);
        appf(result, 'm_type: $1', [genTypeInfo(p, t)]);
      end;
      while t <> nil do begin
        app(result, createRecordVarAux(p, t.n, c));
        t := t.sons[0];
      end;
      app(result, '}'+'');
    end;
    tyVar, tyPtr, tyRef: begin
      if mapType(t) = etyBaseIndex then
        result := putToSeq('[null, 0]', indirect)
      else
        result := putToSeq('null', indirect);
    end;
    tySequence, tyString, tyCString, tyPointer: begin
      result := putToSeq('null', indirect);
    end
    else begin
      internalError('createVar: ' + typekindtoStr[t.kind]);
      result := nil;
    end
  end
end;

function isIndirect(v: PSym): bool;
begin
  result := (sfAddrTaken in v.flags) and (mapType(v.typ) <> etyObject);
end;

procedure genVarInit(var p: TProc; v: PSym; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  s: PRope;
begin
  if n = nil then begin
    appf(r.com, 'var $1 = $2;$n',
        [mangleName(v), createVar(p, v.typ, isIndirect(v))])
  end
  else begin
    {@discard} mangleName(v);
    gen(p, n, a);
    case mapType(v.typ) of
      etyObject: begin
        if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
        if needsNoCopy(n) then s := a.res
        else begin
          useMagic(p, 'NimCopy');
          s := ropef('NimCopy($1, $2)', [a.res, genTypeInfo(p, n.typ)]);
        end
      end;
      etyBaseIndex: begin
        if (a.kind <> etyBaseIndex) then InternalError(n.info, 'genVarInit');
        if [sfAddrTaken, sfGlobal] * v.flags <> [] then
          appf(r.com, 'var $1 = [$2, $3];$n', [v.loc.r, a.com, a.res])
        else
          appf(r.com, 'var $1 = $2; var $1_Idx = $3;$n',
               [v.loc.r, a.com, a.res]);
        exit
      end
      else begin
        if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
        s := a.res;
      end
    end;
    if isIndirect(v) then
      appf(r.com, 'var $1 = [$2];$n', [v.loc.r, s])
    else
      appf(r.com, 'var $1 = $2;$n', [v.loc.r, s])
  end;
end;

procedure genVarStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  i: int;
  v: PSym;
  a: PNode;
begin
  for i := 0 to sonsLen(n)-1 do begin
    a := n.sons[i];
    if a.kind = nkCommentStmt then continue;
    assert(a.kind = nkIdentDefs);
    assert(a.sons[0].kind = nkSym);
    v := a.sons[0].sym;
    if lfNoDecl in v.loc.flags then continue;
    genLineDir(p, a, r);
    genVarInit(p, v, a.sons[2], r);
  end
end;

procedure genConstStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  c: PSym;
  i: int;
begin
  genLineDir(p, n, r);
  for i := 0 to sonsLen(n)-1 do begin
    if n.sons[i].kind = nkCommentStmt then continue;
    assert(n.sons[i].kind = nkConstDef);
    c := n.sons[i].sons[0].sym;
    if (c.ast <> nil) and (c.typ.kind in ConstantDataTypes) and
           not (lfNoDecl in c.loc.flags) then begin
      genLineDir(p, n.sons[i], r);
      genVarInit(p, c, c.ast, r);
    end
  end
end;

procedure genNew(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  t: Ptype;
begin
  gen(p, n.sons[1], a);
  t := skipTypes(n.sons[1].typ, abstractVar).sons[0];
  if a.com <> nil then appf(r.com, '$1;$n', [a.com]);
  appf(r.com, '$1 = $2;$n', [a.res, createVar(p, t, true)]);
end;

procedure genOrd(var p: TProc; n: PNode; var r: TCompRes);
begin
  case skipTypes(n.sons[1].typ, abstractVar).kind of
    tyEnum, tyInt..tyInt64, tyChar: gen(p, n.sons[1], r);
    tyBool: unaryExpr(p, n, r, '', '($1 ? 1:0)');
    else InternalError(n.info, 'genOrd');
  end
end;

procedure genConStrStr(var p: TProc; n: PNode; var r: TCompRes);
var
  a, b: TCompRes;
begin
  gen(p, n.sons[1], a);
  gen(p, n.sons[2], b);
  r.com := mergeExpr(a.com, b.com);
  if skipTypes(n.sons[1].typ, abstractVarRange).kind = tyChar then
    a.res := ropef('[$1, 0]', [a.res]);
  if skipTypes(n.sons[2].typ, abstractVarRange).kind = tyChar then
    b.res := ropef('[$1, 0]', [b.res]);
  r.res := ropef('($1.slice(0,-1)).concat($2)', [a.res, b.res]);
end;

procedure genMagic(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  line, filen: PRope;
  op: TMagic;
begin
  op := n.sons[0].sym.magic;
  case op of
    mOr: genOr(p, n.sons[1], n.sons[2], r);
    mAnd: genAnd(p, n.sons[1], n.sons[2], r);
    mAddi..mStrToStr: arith(p, n, r, op);
    //mRepr: genRepr(p, n, r);
    mSwap: genSwap(p, n, r);
    mPred: begin // XXX: range checking?
      if not (optOverflowCheck in p.Options) then
        binaryExpr(p, n, r, '', '$1 - $2')
      else
        binaryExpr(p, n, r, 'subInt', 'subInt($1, $2)')
    end;
    mSucc: begin // XXX: range checking?
      if not (optOverflowCheck in p.Options) then
        binaryExpr(p, n, r, '', '$1 - $2')
      else
        binaryExpr(p, n, r, 'addInt', 'addInt($1, $2)')
    end;
    mAppendStrCh: binaryStmt(p, n, r, 'addChar', '$1 = addChar($1, $2)');
    mAppendStrStr:
      binaryStmt(p, n, r, '', '$1 = ($1.slice(0,-1)).concat($2)');
      // XXX: make a copy of $2, because of EMCAScript's sucking semantics
    mAppendSeqElem: binaryStmt(p, n, r, '', '$1.push($2)');
    mConStrStr: genConStrStr(p, n, r);
    mEqStr: binaryExpr(p, n, r, 'eqStrings', 'eqStrings($1, $2)');
    mLeStr: binaryExpr(p, n, r, 'cmpStrings', '(cmpStrings($1, $2) <= 0)');
    mLtStr: binaryExpr(p, n, r, 'cmpStrings', '(cmpStrings($1, $2) < 0)');
    mIsNil: unaryExpr(p, n, r, '', '$1 == null');
    mAssert: begin
      if (optAssert in p.Options) then begin
        useMagic(p, 'internalAssert');
        gen(p, n.sons[1], a);
        line := toRope(toLinenumber(n.info));
        filen := makeCString(ToFilename(n.info));
        appf(r.com, 'if (!($3)) internalAssert($1, $2)',
                      [filen, line, mergeExpr(a)])
      end
    end;
    mNew, mNewFinalize: genNew(p, n, r);
    mSizeOf: r.res := toRope(getSize(n.sons[1].typ));
    mChr: gen(p, n.sons[1], r); // nothing to do
    mOrd: genOrd(p, n, r);
    mLengthStr: unaryExpr(p, n, r, '', '($1.length-1)');
    mLengthSeq, mLengthOpenArray, mLengthArray:
      unaryExpr(p, n, r, '', '$1.length');
    mHigh: begin
      if skipTypes(n.sons[0].typ, abstractVar).kind = tyString then
        unaryExpr(p, n, r, '', '($1.length-2)')
      else
        unaryExpr(p, n, r, '', '($1.length-1)');
    end;
    mInc: begin
      if not (optOverflowCheck in p.Options) then
        binaryStmt(p, n, r, '', '$1 += $2')
      else
        binaryStmt(p, n, r, 'addInt', '$1 = addInt($1, $2)')
    end;
    ast.mDec: begin
      if not (optOverflowCheck in p.Options) then
        binaryStmt(p, n, r, '', '$1 -= $2')
      else
        binaryStmt(p, n, r, 'subInt', '$1 = subInt($1, $2)')
    end;
    mSetLengthStr: binaryStmt(p, n, r, '', '$1.length = ($2)-1');
    mSetLengthSeq: binaryStmt(p, n, r, '', '$1.length = $2');
    mCard: unaryExpr(p, n, r, 'SetCard', 'SetCard($1)');
    mLtSet: binaryExpr(p, n, r, 'SetLt', 'SetLt($1, $2)');
    mLeSet: binaryExpr(p, n, r, 'SetLe', 'SetLe($1, $2)');
    mEqSet: binaryExpr(p, n, r, 'SetEq', 'SetEq($1, $2)');
    mMulSet: binaryExpr(p, n, r, 'SetMul', 'SetMul($1, $2)');
    mPlusSet: binaryExpr(p, n, r, 'SetPlus', 'SetPlus($1, $2)');
    mMinusSet: binaryExpr(p, n, r, 'SetMinus', 'SetMinus($1, $2)');
    mIncl: binaryStmt(p, n, r, '', '$1[$2] = true');
    mExcl: binaryStmt(p, n, r, '', 'delete $1[$2]');
    mInSet: binaryExpr(p, n, r, '', '($1[$2] != undefined)');
    mNLen..mNError:
      liMessage(n.info, errCannotGenerateCodeForX, n.sons[0].sym.name.s);
    else genCall(p, n, r);
    //else internalError(e.info, 'genMagic: ' + magicToStr[op]);
  end
end;

procedure genSetConstr(var p: TProc; n: PNode; var r: TCompRes);
var
  a, b: TCompRes;
  i: int;
  it: PNode;
begin
  useMagic(p, 'SetConstr');
  r.res := toRope('SetConstr(');
  for i := 0 to sonsLen(n)-1 do begin
    if i > 0 then app(r.res, ', ');
    it := n.sons[i];
    if it.kind = nkRange then begin
      gen(p, it.sons[0], a);
      gen(p, it.sons[1], b);
      r.com := mergeExpr(r.com, mergeExpr(a.com, b.com));
      appf(r.res, '[$1, $2]', [a.res, b.res]);
    end
    else begin
      gen(p, it, a);
      r.com := mergeExpr(r.com, a.com);
      app(r.res, a.res);
    end
  end;
  app(r.res, ')'+'');
end;

procedure genArrayConstr(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  i: int;
begin
  r.res := toRope('['+'');
  for i := 0 to sonsLen(n)-1 do begin
    if i > 0 then app(r.res, ', ');
    gen(p, n.sons[i], a);
    r.com := mergeExpr(r.com, a.com);
    app(r.res, a.res);
  end;
  app(r.res, ']'+'');
end;

procedure genRecordConstr(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
  i, len: int;
begin
  i := 0;
  len := sonsLen(n);
  r.res := toRope('{'+'');
  while i < len do begin
    if i > 0 then app(r.res, ', ');
    if (n.sons[i].kind <> nkSym) then
      internalError(n.sons[i].info, 'genRecordConstr');
    gen(p, n.sons[i+1], a);
    r.com := mergeExpr(r.com, a.com);
    appf(r.res, '$1: $2', [mangleName(n.sons[i].sym), a.res]);
    inc(i, 2)
  end
end;

procedure genConv(var p: TProc; n: PNode; var r: TCompRes);
var
  src, dest: PType;
begin
  dest := skipTypes(n.typ, abstractVarRange);
  src := skipTypes(n.sons[1].typ, abstractVarRange);
  gen(p, n.sons[1], r);
  if (dest.kind <> src.kind) and (src.kind = tyBool) then
    r.res := ropef('(($1)? 1:0)', [r.res])
end;

procedure upConv(var p: TProc; n: PNode; var r: TCompRes);
begin
  gen(p, n.sons[0], r); // XXX
end;

procedure genRangeChck(var p: TProc; n: PNode; var r: TCompRes;
                       const magic: string);
var
  a, b: TCompRes;
begin
  gen(p, n.sons[0], r);
  if optRangeCheck in p.options then begin
    gen(p, n.sons[1], a);
    gen(p, n.sons[2], b);
    r.com := mergeExpr(r.com, mergeExpr(a.com, b.com));
    useMagic(p, 'chckRange');
    r.res := ropef('chckRange($1, $2, $3)', [r.res, a.res, b.res]);
  end
end;

procedure convStrToCStr(var p: TProc; n: PNode; var r: TCompRes);
begin
  // we do an optimization here as this is likely to slow down
  // much of the code otherwise:
  if n.sons[0].kind = nkCStringToString then
    gen(p, n.sons[0].sons[0], r)
  else begin
    gen(p, n.sons[0], r);
    if r.res = nil then InternalError(n.info, 'convStrToCStr');
    useMagic(p, 'toEcmaStr');
    r.res := ropef('toEcmaStr($1)', [r.res]);
  end;
end;

procedure convCStrToStr(var p: TProc; n: PNode; var r: TCompRes);
begin
  // we do an optimization here as this is likely to slow down
  // much of the code otherwise:
  if n.sons[0].kind = nkStringToCString then
    gen(p, n.sons[0].sons[0], r)
  else begin
    gen(p, n.sons[0], r);
    if r.res = nil then InternalError(n.info, 'convCStrToStr');
    useMagic(p, 'cstrToNimstr');
    r.res := ropef('cstrToNimstr($1)', [r.res]);
  end;
end;

procedure genReturnStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  a: TCompRes;
begin
  if p.procDef = nil then InternalError(n.info, 'genReturnStmt');
  p.BeforeRetNeeded := true;
  if (n.sons[0] <> nil) then begin
    genStmt(p, n.sons[0], a);
    if a.com <> nil then appf(r.com, '$1;$n', mergeStmt(a));
  end
  else genLineDir(p, n, r);
  finishTryStmt(p, r, p.nestedTryStmts);
  app(r.com, 'break BeforeRet;' + tnl);
end;

function genProcBody(var p: TProc; prc: PSym; const r: TCompRes): PRope;
begin
  if optStackTrace in prc.options then begin
    result := ropef(
      'var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n' +
      'framePtr = F;$n',
      [makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s),
      makeCString(toFilename(prc.info))]);
  end
  else
    result := nil;
  if p.beforeRetNeeded then
    appf(result, 'BeforeRet: do {$n$1} while (false); $n', [mergeStmt(r)])
  else
    app(result, mergeStmt(r));
  if prc.typ.callConv = ccSysCall then begin
    result := ropef('try {$n$1} catch (e) {$n'+
                    ' alert("Unhandled exception:\n" + e.message + "\n"$n}',
                    [result]);
  end;
  if optStackTrace in prc.options then
    app(result, 'framePtr = framePtr.prev;' + tnl);
end;

procedure genProc(var oldProc: TProc; n: PNode; var r: TCompRes);
var
  p: TProc;
  prc, resultSym: PSym;
  name, returnStmt, resultAsgn, header: PRope;
  a: TCompRes;
begin
  prc := n.sons[namePos].sym;
  initProc(p, oldProc.globals, oldProc.module, n, prc.options);
  returnStmt := nil;
  resultAsgn := nil;
  name := mangleName(prc);
  header := generateHeader(p, prc.typ);
  if (prc.typ.sons[0] <> nil) and not (sfPure in prc.flags) then begin
    resultSym := n.sons[resultPos].sym;
    resultAsgn := ropef('var $1 = $2;$n', [mangleName(resultSym),
      createVar(p, resultSym.typ, isIndirect(resultSym))]);
    gen(p, n.sons[resultPos], a);
    if a.com <> nil then appf(returnStmt, '$1;$n', [a.com]);
    returnStmt := ropef('return $1;$n', [a.res]);
  end;
  genStmt(p, n.sons[codePos], r);
  r.com := ropef('function $1($2) {$n$3$4$5}$n',
           [name, header, resultAsgn, genProcBody(p, prc, r), returnStmt]);
  r.res := nil;
end;

procedure genStmtListExpr(var p: TProc; n: PNode; var r: TCompRes);
var
  i: int;
  a: TCompRes;
begin
  // watch out this trick: ``function () { stmtList; return expr; }()``
  r.res := toRope('function () {');
  for i := 0 to sonsLen(n)-2 do begin
    genStmt(p, n.sons[i], a);
    app(r.res, mergeStmt(a));
  end;
  gen(p, lastSon(n), a);
  if a.com <> nil then appf(r.res, '$1;$n', [a.com]);
  appf(r.res, 'return $1; }()', [a.res]);
end;

procedure genStmt(var p: TProc; n: PNode; var r: TCompRes);
var
  prc: PSym;
  i: int;
  a: TCompRes;
begin
  r.kind := etyNone;
  r.com := nil;
  r.res := nil;
  case n.kind of
    nkNilLit: begin end;
    nkStmtList: begin
      for i := 0 to sonsLen(n)-1 do begin
        genStmt(p, n.sons[i], a);
        app(r.com, mergeStmt(a));
      end
    end;
    nkBlockStmt:   genBlock(p, n, r);
    nkIfStmt:      genIfStmt(p, n, r);
    nkWhileStmt:   genWhileStmt(p, n, r);
    nkVarSection:  genVarStmt(p, n, r);
    nkConstSection: genConstStmt(p, n, r);
    nkForStmt:     internalError(n.info, 'for statement not eliminated');
    nkCaseStmt:    genCaseStmt(p, n, r);
    nkReturnStmt:  genReturnStmt(p, n, r);
    nkBreakStmt:   genBreakStmt(p, n, r);
    nkAsgn:        genAsgn(p, n, r);
    nkFastAsgn:    genFastAsgn(p, n, r);
    nkDiscardStmt: begin
      genLineDir(p, n, r);
      gen(p, n.sons[0], r);
      app(r.res, ';'+ tnl);
    end;
    nkAsmStmt: genAsmStmt(p, n, r);
    nkTryStmt: genTryStmt(p, n, r);
    nkRaiseStmt: genRaiseStmt(p, n, r);
    nkTypeSection, nkCommentStmt, nkIteratorDef,
    nkIncludeStmt, nkImportStmt,
    nkFromStmt, nkTemplateDef, nkMacroDef, nkPragma: begin end;
    nkProcDef, nkMethodDef, nkConverterDef: begin
      if (n.sons[genericParamsPos] = nil) then begin
        prc := n.sons[namePos].sym;
        if (n.sons[codePos] <> nil) and not (lfNoDecl in prc.loc.flags) then
          genProc(p, n, r)
        else
          {@discard} mangleName(prc);
      end
    end;
    else begin
      genLineDir(p, n, r);
      gen(p, n, r);
      app(r.res, ';'+ tnl);
    end
  end
end;

procedure gen(var p: TProc; n: PNode; var r: TCompRes);
var
  f: BiggestFloat;
begin
  r.kind := etyNone;
  r.com := nil;
  r.res := nil;
  case n.kind of
    nkSym: genSym(p, n, r);
    nkCharLit..nkInt64Lit: begin
      r.res := toRope(n.intVal);
    end;
    nkNilLit: begin
      if mapType(n.typ) = etyBaseIndex then begin
        r.kind := etyBaseIndex;
        r.com := toRope('null');
        r.res := toRope('0'+'');
      end
      else
        r.res := toRope('null');
    end;
    nkStrLit..nkTripleStrLit: begin
      if skipTypes(n.typ, abstractVarRange).kind = tyString then begin
        useMagic(p, 'cstrToNimstr');
        r.res := ropef('cstrToNimstr($1)', [makeCString(n.strVal)])
      end
      else
        r.res := makeCString(n.strVal)
    end;
    nkFloatLit..nkFloat64Lit: begin
      f := n.floatVal;
      if f <> f then
        r.res := toRope('NaN')
      else if f = 0.0 then
        r.res := toRopeF(f)
      else if f = 0.5 * f then
        if f > 0.0 then r.res := toRope('Infinity')
        else r.res := toRope('-Infinity')
      else
        r.res := toRopeF(f);
    end;
    nkBlockExpr: genBlock(p, n, r);
    nkIfExpr: genIfExpr(p, n, r);
    nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit: begin
      if (n.sons[0].kind = nkSym) and (n.sons[0].sym.magic <> mNone) then
        genMagic(p, n, r)
      else
        genCall(p, n, r)
    end;
    nkCurly: genSetConstr(p, n, r);
    nkBracket: genArrayConstr(p, n, r);
    nkPar: genRecordConstr(p, n, r);
    nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, r);
    nkAddr, nkHiddenAddr: genAddr(p, n, r);
    nkDerefExpr, nkHiddenDeref: genDeref(p, n, r);
    nkBracketExpr: genArrayAccess(p, n, r);
    nkDotExpr: genFieldAccess(p, n, r);
    nkCheckedFieldExpr: genCheckedFieldAccess(p, n, r);
    nkObjDownConv: gen(p, n.sons[0], r);
    nkObjUpConv: upConv(p, n, r);
    nkChckRangeF: genRangeChck(p, n, r, 'chckRangeF');
    nkChckRange64: genRangeChck(p, n, r, 'chckRange64');
    nkChckRange: genRangeChck(p, n, r, 'chckRange');
    nkStringToCString: convStrToCStr(p, n, r);
    nkCStringToString: convCStrToStr(p, n, r);
    nkPassAsOpenArray: gen(p, n.sons[0], r);
    nkStmtListExpr: genStmtListExpr(p, n, r);
    else
      InternalError(n.info, 'gen: unknown node type: ' + nodekindToStr[n.kind])
  end
end;

// ------------------------------------------------------------------------

var
  globals: PGlobals;

function newModule(module: PSym; const filename: string): BModule;
begin
  new(result);
{@ignore}
  fillChar(result^, sizeof(result^), 0);
{@emit}
  result.filename := filename;
  result.module := module;
  if globals = nil then globals := newGlobals();
end;

function genHeader(): PRope;
begin
  result := ropef(
    '/* Generated by the Nimrod Compiler v$1 */$n' +
    '/*   (c) 2008 Andreas Rumpf */$n$n' +
    '$nvar Globals = this;$n' +
    'var framePtr = null;$n' +
    'var excHandler = null;$n',
    [toRope(versionAsString)])
end;

procedure genModule(var p: TProc; n: PNode; var r: TCompRes);
begin
  genStmt(p, n, r);
  if optStackTrace in p.options then begin
    r.com := ropef(
      'var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n' +
      'framePtr = F;$n' +
      '$3' +
      'framePtr = framePtr.prev;$n',
      [makeCString('module ' + p.module.module.name.s),
      makeCString(toFilename(p.module.module.info)), r.com])
  end
end;

function myProcess(b: PPassContext; n: PNode): PNode;
var
  m: BModule;
  p: TProc;
  r: TCompRes;
begin
  result := n;
  m := BModule(b);
  if m.module = nil then InternalError(n.info, 'myProcess');
  initProc(p, globals, m, nil, m.module.options);
  genModule(p, n, r);
  app(p.globals.code, p.data);
  app(p.globals.code, mergeStmt(r));
end;

function myClose(b: PPassContext; n: PNode): PNode;
var
  m: BModule;
  code: PRope;
  outfile: string;
begin
  result := myProcess(b, n);
  m := BModule(b);
  if sfMainModule in m.module.flags then begin
    // write the file:
    code := con(globals.typeInfo, globals.code);
    outfile := changeFileExt(completeCFilePath(m.filename), 'js');
    {@discard} writeRopeIfNotEqual(con(genHeader(), code), outfile);
  end
end;

function myOpenCached(s: PSym; const filename: string;
                      rd: PRodReader): PPassContext;
begin
  InternalError('symbol files are not possible with the Ecmas code generator');
  result := nil;
end;

function myOpen(s: PSym; const filename: string): PPassContext;
begin
  result := newModule(s, filename);
end;

function ecmasgenPass(): TPass;
begin
  InitPass(result);
  result.open := myOpen;
  result.close := myClose;
  result.openCached := myOpenCached;
  result.process := myProcess;
end;

end.