path: root/nim/ccgstmts.pas

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

const
  RangeExpandLimit = 256;     // do not generate ranges
  // over 'RangeExpandLimit' elements

procedure genLineDir(p: BProc; t: PNode);
var
  line: int;
begin
  line := toLinenumber(t.info); // BUGFIX
  if line < 0 then line := 0; // negative numbers are not allowed in #line
  if optLineDir in p.Options then
    appff(p.s[cpsStmts], 
      '#line $2 "$1"$n',
      '; line $2 "$1"$n',
      [toRope(toFilename(t.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.module, 'endb');      // new: endb support
    appff(p.s[cpsStmts], 'endb($1);$n', 
         'call void @endb(%NI $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 begin
    inc(p.labels);
    appff(p.s[cpsStmts], 'F.line = $1;$n', 
         '%LOC$2 = getelementptr %TF %F, %NI 2$n' +
         'store %NI $1, %NI* %LOC$2$n',
         [toRope(line), toRope(p.labels)])
  end
end;

procedure finishTryStmt(p: BProc; howMany: int);
var
  i: int;
begin
  for i := 1 to howMany do begin
    inc(p.labels, 3);
    appff(p.s[cpsStmts], 'excHandler = excHandler->prev;$n',
          '%LOC$1 = load %TSafePoint** @excHandler$n' +
          '%LOC$2 = getelementptr %TSafePoint* %LOC$1, %NI 0$n' +
          '%LOC$3 = load %TSafePoint** %LOC$2$n' +
          'store %TSafePoint* %LOC$3, %TSafePoint** @excHandler$n', 
          [toRope(p.labels), toRope(p.labels-1), toRope(p.labels-2)]);
  end
end;

procedure genReturnStmt(p: BProc; t: PNode);
begin
  p.beforeRetNeeded := true;
  genLineDir(p, t);
  if (t.sons[0] <> nil) then genStmts(p, t.sons[0]);
  finishTryStmt(p, p.nestedTryStmts);
  appff(p.s[cpsStmts], 'goto BeforeRet;$n', 'br label %BeforeRet$n', [])
end;

procedure initVariable(p: BProc; v: PSym);
begin
  if containsGarbageCollectedRef(v.typ) or (v.ast = nil) then
    // Language change: always initialize variables if v.ast == nil!
    if not (skipTypes(v.typ, abstractVarRange).Kind in [tyArray, 
            tyArrayConstr, tySet, tyTuple, tyObject]) then begin
      if gCmd = cmdCompileToLLVM then
        appf(p.s[cpsStmts], 'store $2 0, $2* $1$n', 
             [addrLoc(v.loc), getTypeDesc(p.module, v.loc.t)])
      else
        appf(p.s[cpsStmts], '$1 = 0;$n', [rdLoc(v.loc)])
    end
    else begin
      if gCmd = cmdCompileToLLVM then begin
        app(p.module.s[cfsProcHeaders], 
            'declare void @llvm.memset.i32(i8*, i8, i32, i32)' + tnl);
        inc(p.labels, 2);
        appf(p.s[cpsStmts], 
            '%LOC$3 = getelementptr $2* null, %NI 1$n' +
            '%LOC$4 = cast $2* %LOC$3 to i32$n' +
            'call void @llvm.memset.i32(i8* $1, i8 0, i32 %LOC$4, i32 0)$n', 
            [addrLoc(v.loc), getTypeDesc(p.module, v.loc.t), 
            toRope(p.labels), toRope(p.labels-1)])
      end
      else
        appf(p.s[cpsStmts], 'memset((void*)$1, 0, sizeof($2));$n',
          [addrLoc(v.loc), rdLoc(v.loc)])
   end
end;

procedure genVarTuple(p: BProc; n: PNode);
var
  i, L: int;
  v: PSym;
  tup, field: TLoc;
  t: PType;
begin
  if n.kind <> nkVarTuple then InternalError(n.info, 'genVarTuple');
  L := sonsLen(n);
  genLineDir(p, n);
  initLocExpr(p, n.sons[L-1], tup);
  t := tup.t;
  for i := 0 to L-3 do begin
    v := n.sons[i].sym;
    if sfGlobal in v.flags then
      assignGlobalVar(p, v)
    else begin
      assignLocalVar(p, v);
      initVariable(p, v)
    end;
    // generate assignment:
    initLoc(field, locExpr, t.sons[i], tup.s);
    if t.n = nil then begin
      field.r := ropef('$1.Field$2', [rdLoc(tup), toRope(i)]);
    end
    else begin
      if (t.n.sons[i].kind <> nkSym) then
        InternalError(n.info, 'genVarTuple');
      field.r := ropef('$1.$2', [rdLoc(tup), 
        mangleRecFieldName(t.n.sons[i].sym, t)]);
    end;
    putLocIntoDest(p, v.loc, field);
    genObjectInit(p, v.typ, v.loc, true);
  end
end;

procedure genVarStmt(p: BProc; n: PNode);
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;
    if a.kind = nkIdentDefs then begin
      assert(a.sons[0].kind = nkSym);
      v := a.sons[0].sym;
      if sfGlobal in v.flags then
        assignGlobalVar(p, v)
      else begin
        assignLocalVar(p, v);
        initVariable(p, v) // XXX: this is not required if a.sons[2] != nil,
                           // unless it is a GC'ed pointer
      end;
      // generate assignment:
      if a.sons[2] <> nil then begin
        genLineDir(p, a);
        expr(p, a.sons[2], v.loc);
      end;
      genObjectInit(p, v.typ, v.loc, true); // correct position
    end
    else
      genVarTuple(p, a);
  end
end;

procedure genConstStmt(p: BProc; t: PNode);
var
  c: PSym;
  i: int;
begin
  for i := 0 to sonsLen(t)-1 do begin
    if t.sons[i].kind = nkCommentStmt then continue;
    if t.sons[i].kind <> nkConstDef then InternalError(t.info, 'genConstStmt');
    c := t.sons[i].sons[0].sym;
    // This can happen for forward consts:
    if (c.ast <> nil) and (c.typ.kind in ConstantDataTypes) and
           not (lfNoDecl in c.loc.flags) then begin
      // generate the data:
      fillLoc(c.loc, locData, c.typ, mangleName(c), OnUnknown);
      if sfImportc in c.flags then
        appf(p.module.s[cfsData], 'extern NIM_CONST $1 $2;$n',
          [getTypeDesc(p.module, c.typ), c.loc.r])
      else
        appf(p.module.s[cfsData], 'NIM_CONST $1 $2 = $3;$n',
          [getTypeDesc(p.module, c.typ), c.loc.r,
          genConstExpr(p, c.ast)])
    end
  end
end;

procedure genIfStmt(p: BProc; n: PNode);
(*
  if (!expr1) goto L1;
  thenPart
  goto LEnd
  L1:
  if (!expr2) goto L2;
  thenPart2
  goto LEnd
  L2:
  elsePart
  Lend:
*)
var
  i: int;
  it: PNode;
  a: TLoc;
  Lend, Lelse: TLabel;
begin
  genLineDir(p, n);
  Lend := getLabel(p);
  for i := 0 to sonsLen(n)-1 do begin
    it := n.sons[i];
    case it.kind of
      nkElifBranch: begin
        initLocExpr(p, it.sons[0], a);
        Lelse := getLabel(p);
        inc(p.labels);
        appff(p.s[cpsStmts], 'if (!$1) goto $2;$n', 
                             'br i1 $1, label %LOC$3, label %$2$n' +
                             'LOC$3: $n', 
                             [rdLoc(a), Lelse, toRope(p.labels)]);
        genStmts(p, it.sons[1]);
        if sonsLen(n) > 1 then
          appff(p.s[cpsStmts], 'goto $1;$n', 'br label %$1$n', [Lend]);
        fixLabel(p, Lelse);
      end;
      nkElse: begin
        genStmts(p, it.sons[0]);
      end;
      else internalError(n.info, 'genIfStmt()');
    end
  end;
  if sonsLen(n) > 1 then
    fixLabel(p, Lend);
end;

procedure genWhileStmt(p: BProc; t: PNode);
// we don't generate labels here as for example GCC would produce
// significantly worse code
var
  a: TLoc;
  Labl: TLabel;
  len: int;
begin
  genLineDir(p, t);
  assert(sonsLen(t) = 2);
  inc(p.labels);
  Labl := con('LA', toRope(p.labels));
  len := length(p.blocks);
  setLength(p.blocks, len+1);
  p.blocks[len].id := -p.labels; // negative because it isn't used yet
  p.blocks[len].nestedTryStmts := p.nestedTryStmts;
  app(p.s[cpsStmts], 'while (1) {' + tnl);
  initLocExpr(p, t.sons[0], a);
  if (t.sons[0].kind <> nkIntLit) or (t.sons[0].intVal = 0) then begin
    p.blocks[len].id := abs(p.blocks[len].id);
    appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Labl]);
  end;
  genStmts(p, t.sons[1]);
  if p.blocks[len].id > 0 then
    appf(p.s[cpsStmts], '} $1: ;$n', [Labl])
  else
    app(p.s[cpsStmts], '}'+tnl);
  setLength(p.blocks, length(p.blocks)-1)
end;

procedure genBlock(p: BProc; t: PNode; var d: TLoc);
var
  idx: int;
  sym: PSym;
begin
  inc(p.labels);
  idx := length(p.blocks);
  if t.sons[0] <> nil then begin // named block?
    assert(t.sons[0].kind = nkSym);
    sym := t.sons[0].sym;
    sym.loc.k := locOther;
    sym.loc.a := idx
  end;
  setLength(p.blocks, idx+1);
  p.blocks[idx].id := -p.labels; // negative because it isn't used yet
  p.blocks[idx].nestedTryStmts := p.nestedTryStmts;
  if t.kind = nkBlockExpr then genStmtListExpr(p, t.sons[1], d)
  else genStmts(p, t.sons[1]);
  if p.blocks[idx].id > 0 then // label has been used:
    appf(p.s[cpsStmts], 'LA$1: ;$n', [toRope(p.blocks[idx].id)]);
  setLength(p.blocks, idx)
end;

// try:
//   while:
//     try:
//       if ...:
//         break # we need to finish only one try statement here!
// finally:

procedure genBreakStmt(p: BProc; t: PNode);
var
  idx: int;
  sym: PSym;
begin
  genLineDir(p, t);
  idx := length(p.blocks)-1;
  if t.sons[0] <> nil then begin // named break?
    assert(t.sons[0].kind = nkSym);
    sym := t.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, p.nestedTryStmts - p.blocks[idx].nestedTryStmts);
  appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.blocks[idx].id)])
end;

procedure genAsmStmt(p: BProc; t: PNode);
var
  i: int;
  sym: PSym;
  r, s: PRope;
  a: TLoc;
begin
  genLineDir(p, t);
  assert(t.kind = nkAsmStmt);
  s := nil;
  for i := 0 to sonsLen(t) - 1 do begin
    case t.sons[i].Kind of
      nkStrLit..nkTripleStrLit: app(s, t.sons[i].strVal);
      nkSym: begin
        sym := t.sons[i].sym;
        if sym.kind in [skProc, skMethod] then begin
          initLocExpr(p, t.sons[i], a);
          app(s, rdLoc(a));
        end
        else begin
          r := sym.loc.r;
          if r = nil then begin // if no name has already been given,
                                // it doesn't matter much:
            r := mangleName(sym);
            sym.loc.r := r; // but be consequent!
          end;
          app(s, r)
        end
      end
      else
        InternalError(t.sons[i].info, 'genAsmStmt()')
    end
  end;
  appf(p.s[cpsStmts], CC[ccompiler].asmStmtFrmt, [s]);
end;

function getRaiseFrmt(p: BProc): string;
begin
  if gCmd = cmdCompileToCpp then
    result := 'throw nimException($1, $2);$n'
  else begin
    useMagic(p.module, 'E_Base');
    result := 'raiseException((E_Base*)$1, $2);$n'
  end
end;

procedure genRaiseStmt(p: BProc; t: PNode);
var
  e: PRope;
  a: TLoc;
  typ: PType;
begin
  genLineDir(p, t);
  if t.sons[0] <> nil then begin
    if gCmd <> cmdCompileToCpp then useMagic(p.module, 'raiseException');
    InitLocExpr(p, t.sons[0], a);
    e := rdLoc(a);
    typ := t.sons[0].typ;
    while typ.kind in [tyVar, tyRef, tyPtr] do typ := typ.sons[0];
    appf(p.s[cpsStmts], getRaiseFrmt(p),
      [e, makeCString(typ.sym.name.s)])
  end
  else begin
    // reraise the last exception:
    if gCmd = cmdCompileToCpp then
      app(p.s[cpsStmts], 'throw;' + tnl)
    else begin
      useMagic(p.module, 'reraiseException');
      app(p.s[cpsStmts], 'reraiseException();' + tnl)
    end
  end
end;

// ---------------- case statement generation -----------------------------

const
  stringCaseThreshold = 100000; 
  // above X strings a hash-switch for strings is generated
  // this version sets it too high to avoid hashing, because this has not
  // been tested for a long time
  // XXX test and enable this optimization!

procedure genCaseGenericBranch(p: BProc; b: PNode; const e: TLoc;
                               const rangeFormat, eqFormat: TFormatStr;
                               labl: TLabel);
var
  len, i: int;
  x, y: TLoc;
begin
  len := sonsLen(b);
  for i := 0 to len - 2 do begin
    if b.sons[i].kind = nkRange then begin
      initLocExpr(p, b.sons[i].sons[0], x);
      initLocExpr(p, b.sons[i].sons[1], y);
      appf(p.s[cpsStmts], rangeFormat,
        [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl])
    end
    else begin
      initLocExpr(p, b.sons[i], x);
      appf(p.s[cpsStmts], eqFormat,
        [rdCharLoc(e), rdCharLoc(x), labl])
    end
  end
end;

procedure genCaseSecondPass(p: BProc; t: PNode; labId: int);
var
  Lend: TLabel;
  i, len: int;
begin
  Lend := getLabel(p);
  for i := 1 to sonsLen(t) - 1 do begin
    appf(p.s[cpsStmts], 'LA$1: ;$n', [toRope(labId+i)]);
    if t.sons[i].kind = nkOfBranch then begin
      len := sonsLen(t.sons[i]);
      genStmts(p, t.sons[i].sons[len-1]);
      appf(p.s[cpsStmts], 'goto $1;$n', [Lend])
    end
    else // else statement
      genStmts(p, t.sons[i].sons[0])
  end;
  fixLabel(p, Lend);
end;

procedure genCaseGeneric(p: BProc; t: PNode; const rangeFormat,
                         eqFormat: TFormatStr);
  // generate a C-if statement for a Nimrod case statement
var
  a: TLoc;
  i, labId: int;
begin
  initLocExpr(p, t.sons[0], a);
  // fist pass: gnerate ifs+goto:
  labId := p.labels;
  for i := 1 to sonsLen(t) - 1 do begin
    inc(p.labels);
    if t.sons[i].kind = nkOfBranch then
      genCaseGenericBranch(p, t.sons[i], a, rangeFormat, eqFormat,
        con('LA', toRope(p.labels)))
    else
      // else statement
      appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.labels)]);
  end;
  // second pass: generate statements
  genCaseSecondPass(p, t, labId);
end;

{@ignore}
{$ifopt Q+} { we need Q- here! }
  {$define Q_on}
  {$Q-}
{$endif}

{$ifopt R+}
  {$define R_on}
  {$R-}
{$endif}
{@emit}
function hashString(const s: string): biggestInt;
var
  a: int32;
  b: int64;
  i: int;
begin
  if CPU[targetCPU].bit = 64 then begin // we have to use the same bitwidth
    // as the target CPU
    b := 0;
    for i := 0 to Length(s)-1 do begin
      b := b +{%} Ord(s[i]);
      b := b +{%} shlu(b, 10);
      b := b xor shru(b, 6)
    end;
    b := b +{%} shlu(b, 3);
    b := b xor shru(b, 11);
    b := b +{%} shlu(b, 15);
    result := b
  end
  else begin
    a := 0;
    for i := 0 to Length(s)-1 do begin
      a := a +{%} int32(Ord(s[i]));
      a := a +{%} shlu(a, int32(10));
      a := a xor shru(a, int32(6));
    end;
    a := a +{%} shlu(a, int32(3));
    a := a xor shru(a, int32(11));
    a := a +{%} shlu(a, int32(15));
    result := a
  end
end;
{@ignore}
{$ifdef Q_on}
  {$undef Q_on}
  {$Q+}
{$endif}

{$ifdef R_on}
  {$undef R_on}
  {$R+}
{$endif}
{@emit}

type
  TRopeSeq = array of PRope;

procedure genCaseStringBranch(p: BProc; b: PNode; const e: TLoc;
                              labl: TLabel; var branches: TRopeSeq);
var
  len, i, j: int;
  x: TLoc;
begin
  len := sonsLen(b);
  for i := 0 to len - 2 do begin
    assert(b.sons[i].kind <> nkRange);
    initLocExpr(p, b.sons[i], x);
    assert(b.sons[i].kind in [nkStrLit..nkTripleStrLit]);
    j := int(hashString(b.sons[i].strVal) and high(branches));
    appf(branches[j], 'if (eqStrings($1, $2)) goto $3;$n',
      [rdLoc(e), rdLoc(x), labl])
  end
end;

procedure genStringCase(p: BProc; t: PNode);
var
  strings, i, j, bitMask, labId: int;
  a: TLoc;
  branches: TRopeSeq;
begin
  useMagic(p.module, 'eqStrings');
  // count how many constant strings there are in the case:
  strings := 0;
  for i := 1 to sonsLen(t)-1 do
    if t.sons[i].kind = nkOfBranch then inc(strings, sonsLen(t.sons[i])-1);
  if strings > stringCaseThreshold then begin
    useMagic(p.module, 'hashString');
    bitMask := nmath.nextPowerOfTwo(strings)-1;
  {@ignore}
    setLength(branches, bitMask+1);
  {@emit newSeq(branches, bitMask+1);}
    initLocExpr(p, t.sons[0], a);
    // fist pass: gnerate ifs+goto:
    labId := p.labels;
    for i := 1 to sonsLen(t) - 1 do begin
      inc(p.labels);
      if t.sons[i].kind = nkOfBranch then
        genCaseStringBranch(p, t.sons[i], a, con('LA', toRope(p.labels)),
                            branches)
      else begin
        // else statement: nothing to do yet
        // but we reserved a label, which we use later
      end
    end;
    // second pass: generate switch statement based on hash of string:
    appf(p.s[cpsStmts], 'switch (hashString($1) & $2) {$n',
      [rdLoc(a), toRope(bitMask)]);
    for j := 0 to high(branches) do
      if branches[j] <> nil then
        appf(p.s[cpsStmts], 'case $1: $n$2break;$n',
          [intLiteral(j), branches[j]]);
    app(p.s[cpsStmts], '}' + tnl);
    // else statement:
    if t.sons[sonsLen(t)-1].kind <> nkOfBranch then
      appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.labels)]);
    // third pass: generate statements
    genCaseSecondPass(p, t, labId);
  end
  else
    genCaseGeneric(p, t, '', 'if (eqStrings($1, $2)) goto $3;$n')
end;

function branchHasTooBigRange(b: PNode): bool;
var
  i: int;
begin
  for i := 0 to sonsLen(b)-2 do begin  // last son is block
    if (b.sons[i].Kind = nkRange) and
        (b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal >
        RangeExpandLimit) then begin
      result := true; exit
    end;
  end;
  result := false
end;

procedure genOrdinalCase(p: BProc; t: PNode);
// We analyse if we have a too big switch range. If this is the case,
// we generate an ordinary if statement and rely on the C compiler
// to produce good code.
var
  canGenerateSwitch, hasDefault: bool;
  i, j, len: int;
  a: TLoc;
  v: PNode;
begin
  canGenerateSwitch := true;
  if not (hasSwitchRange in CC[ccompiler].props) then
    // if the C compiler supports switch ranges, no analysis is necessary
    for i := 1 to sonsLen(t)-1 do
      if (t.sons[i].kind = nkOfBranch) and branchHasTooBigRange(t.sons[i]) then
      begin
        canGenerateSwitch := false;
        break
      end;
  if canGenerateSwitch then begin
    initLocExpr(p, t.sons[0], a);
    appf(p.s[cpsStmts], 'switch ($1) {$n', [rdCharLoc(a)]);
    hasDefault := false;
    for i := 1 to sonsLen(t)-1 do begin
      if t.sons[i].kind = nkOfBranch then begin
        len := sonsLen(t.sons[i]);
        for j := 0 to len-2 do begin
          if t.sons[i].sons[j].kind = nkRange then begin // a range
            if hasSwitchRange in CC[ccompiler].props then
              appf(p.s[cpsStmts], 'case $1 ... $2:$n',
                [genLiteral(p, t.sons[i].sons[j].sons[0]),
                 genLiteral(p, t.sons[i].sons[j].sons[1])])
            else begin
              v := copyNode(t.sons[i].sons[j].sons[0]);
              while (v.intVal <= t.sons[i].sons[j].sons[1].intVal) do begin
                appf(p.s[cpsStmts], 'case $1:$n', [genLiteral(p, v)]);
                Inc(v.intVal)
              end
            end;
          end
          else
            appf(p.s[cpsStmts], 'case $1:$n',
              [genLiteral(p, t.sons[i].sons[j])]);
        end;
        genStmts(p, t.sons[i].sons[len-1])
      end
      else begin // else part of case statement:
        app(p.s[cpsStmts], 'default:' + tnl);
        genStmts(p, t.sons[i].sons[0]);
        hasDefault := true;
      end;
      app(p.s[cpsStmts], 'break;' + tnl);
    end;
    if (hasAssume in CC[ccompiler].props) and not hasDefault then 
      app(p.s[cpsStmts], 'default: __assume(0);' + tnl);      
    app(p.s[cpsStmts], '}' + tnl);
  end
  else
    genCaseGeneric(p, t,
      'if ($1 >= $2 && $1 <= $3) goto $4;$n',
      'if ($1 == $2) goto $3;$n')
end;

procedure genCaseStmt(p: BProc; t: PNode);
begin
  genLineDir(p, t);
  case skipTypes(t.sons[0].typ, abstractVarRange).kind of
    tyString: genStringCase(p, t);
    tyFloat..tyFloat128:
      genCaseGeneric(p, t, 'if ($1 >= $2 && $1 <= $3) goto $4;$n',
                           'if ($1 == $2) goto $3;$n');
  // ordinal type: generate a switch statement
    else genOrdinalCase(p, t)
  end
end;

// ----------------------- end of case statement generation ---------------

function hasGeneralExceptSection(t: PNode): bool;
var
  len, i, blen: int;
begin
  len := sonsLen(t);
  i := 1;
  while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin
    blen := sonsLen(t.sons[i]);
    if blen = 1 then begin result := true; exit end;
    inc(i)
  end;
  result := false
end;

procedure genTryStmtCpp(p: BProc; t: PNode);
  // code to generate:
(*
   bool tmpRethrow = false;
   try
   {
      myDiv(4, 9);
   } catch (NimException& tmp) {
      tmpRethrow = true;
      switch (tmp.exc)
      {
         case DIVIDE_BY_ZERO:
           tmpRethrow = false;
           printf('Division by Zero\n');
         break;
      default: // used for general except!
         generalExceptPart();
         tmpRethrow = false;
      }
  }
  excHandler = excHandler->prev; // we handled the exception
  finallyPart();
  if (tmpRethrow) throw; *)
var
  rethrowFlag: PRope;
  exc: PRope;
  i, len, blen, j: int;
begin
  genLineDir(p, t);
  rethrowFlag := nil;
  exc := getTempName();
  if not hasGeneralExceptSection(t) then begin
    rethrowFlag := getTempName();
    appf(p.s[cpsLocals], 'volatile NIM_BOOL $1 = NIM_FALSE;$n',
      [rethrowFlag])
  end;
  if optStackTrace in p.Options then
    app(p.s[cpsStmts], 'framePtr = (TFrame*)&F;' + tnl);
  app(p.s[cpsStmts], 'try {' + tnl);
  inc(p.nestedTryStmts);
  genStmts(p, t.sons[0]);
  len := sonsLen(t);
  if t.sons[1].kind = nkExceptBranch then begin
    appf(p.s[cpsStmts], '} catch (NimException& $1) {$n', [exc]);
    if rethrowFlag <> nil then
      appf(p.s[cpsStmts], '$1 = NIM_TRUE;$n', [rethrowFlag]);
    appf(p.s[cpsStmts], 'if ($1.sp.exc) {$n', [exc])
  end; // XXX: this is not correct!
  i := 1;
  while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin
    blen := sonsLen(t.sons[i]);
    if blen = 1 then begin      // general except section:
      app(p.s[cpsStmts], 'default: ' + tnl);
      genStmts(p, t.sons[i].sons[0])
    end
    else begin
      for j := 0 to blen - 2 do begin
        assert(t.sons[i].sons[j].kind = nkType);
        appf(p.s[cpsStmts], 'case $1:$n',
          [toRope(t.sons[i].sons[j].typ.id)])
      end;
      genStmts(p, t.sons[i].sons[blen - 1])
    end;
    // code to clear the exception:
    if rethrowFlag <> nil then
      appf(p.s[cpsStmts], '$1 = NIM_FALSE;  ', [rethrowFlag]);
    app(p.s[cpsStmts], 'break;' + tnl);
    inc(i);
  end;
  if t.sons[1].kind = nkExceptBranch then // BUGFIX
    app(p.s[cpsStmts], '}}' + tnl); // end of catch-switch statement
  dec(p.nestedTryStmts);
  app(p.s[cpsStmts], 'excHandler = excHandler->prev;' + tnl);
  if (i < len) and (t.sons[i].kind = nkFinally) then begin
    genStmts(p, t.sons[i].sons[0]);
    if rethrowFlag <> nil then
      appf(p.s[cpsStmts], 'if ($1) { throw; }$n', [rethrowFlag])
  end
end;

procedure genTryStmt(p: BProc; t: PNode);
  // code to generate:
(*
  sp.prev = excHandler;
  excHandler = &sp;
  sp.status = setjmp(sp.context);
  if (sp.status == 0) {
    myDiv(4, 9);
  } else {
    /* except DivisionByZero: */
    if (sp.status == DivisionByZero) {
      printf('Division by Zero\n');

      /* longjmp(excHandler->context, RangeError); /* raise rangeError */
      sp.status = RangeError; /* if raise; else 0 */
    }
  }
  /* finally: */
  printf('fin!\n');
  if (sp.status != 0)
    longjmp(excHandler->context, sp.status);
  excHandler = excHandler->prev; /* deactivate this safe point */ *)
var
  i, j, len, blen: int;
  safePoint, orExpr: PRope;
begin
  genLineDir(p, t);

  safePoint := getTempName();
  useMagic(p.module, 'TSafePoint');
  useMagic(p.module, 'E_Base');
  useMagic(p.module, 'excHandler');
  appf(p.s[cpsLocals], 'TSafePoint $1;$n', [safePoint]);
  appf(p.s[cpsStmts], '$1.prev = excHandler;$n' +
                      'excHandler = &$1;$n' +
                      '$1.status = setjmp($1.context);$n',
                      [safePoint]);
  if optStackTrace in p.Options then
    app(p.s[cpsStmts], 'framePtr = (TFrame*)&F;' + tnl);
  appf(p.s[cpsStmts], 'if ($1.status == 0) {$n', [safePoint]);
  len := sonsLen(t);
  inc(p.nestedTryStmts);
  genStmts(p, t.sons[0]);
  app(p.s[cpsStmts], '} else {' + tnl);
  i := 1;
  while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin
    blen := sonsLen(t.sons[i]);
    if blen = 1 then begin
      // general except section:
      if i > 1 then app(p.s[cpsStmts], 'else {' + tnl);
      genStmts(p, t.sons[i].sons[0]);
      appf(p.s[cpsStmts], '$1.status = 0;$n', [safePoint]);
      if i > 1 then app(p.s[cpsStmts], '}' + tnl);
    end
    else begin
      orExpr := nil;
      for j := 0 to blen - 2 do begin
        assert(t.sons[i].sons[j].kind = nkType);
        if orExpr <> nil then app(orExpr, '||');
        appf(orExpr, '($1.exc->Sup.m_type == $2)',
          [safePoint, genTypeInfo(p.module, t.sons[i].sons[j].typ)])
      end;
      if i > 1 then app(p.s[cpsStmts], 'else ');
      appf(p.s[cpsStmts], 'if ($1) {$n', [orExpr]);
      genStmts(p, t.sons[i].sons[blen - 1]);
      // code to clear the exception:
      appf(p.s[cpsStmts], '$1.status = 0;}$n', [safePoint]);
    end;
    inc(i)
  end;
  app(p.s[cpsStmts], '}' + tnl); // end of if statement
  finishTryStmt(p, p.nestedTryStmts);
  dec(p.nestedTryStmts);
  if (i < len) and (t.sons[i].kind = nkFinally) then begin
    genStmts(p, t.sons[i].sons[0]);
    useMagic(p.module, 'raiseException');
    appf(p.s[cpsStmts], 'if ($1.status != 0) { ' +
      'raiseException($1.exc, $1.exc->name); }$n', [safePoint])
  end
end;

var
  breakPointId: int = 0;
  gBreakpoints: PRope; // later the breakpoints are inserted into the main proc

procedure genBreakPoint(p: BProc; t: PNode);
var
  name: string;
begin
  if optEndb in p.Options then begin
    if t.kind = nkExprColonExpr then begin
      assert(t.sons[1].kind in [nkStrLit..nkTripleStrLit]);
      name := normalize(t.sons[1].strVal)
    end
    else begin
      inc(breakPointId);
      name := 'bp' + toString(breakPointId)
    end;
    genLineDir(p, t); // BUGFIX
    appf(gBreakpoints,
      'dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n',
      [toRope(toLinenumber(t.info)), makeCString(toFilename(t.info)),
      makeCString(name)])
  end
end;

procedure genPragma(p: BProc; n: PNode);
var
  i: int;
  it, key: PNode;
begin
  for i := 0 to sonsLen(n)-1 do begin
    it := n.sons[i];
    if it.kind = nkExprColonExpr then begin
      key := it.sons[0];
    end
    else begin
      key := it;
    end;
    if key.kind = nkIdent then
      case whichKeyword(key.ident) of
        wBreakpoint: genBreakPoint(p, it);
        wDeadCodeElim: begin
          if not (optDeadCodeElim in gGlobalOptions) then begin
            // we need to keep track of ``deadCodeElim`` pragma
            if (sfDeadCodeElim in p.module.module.flags) then
              addPendingModule(p.module)
          end            
        end
        else begin end
      end
  end
end;

procedure genAsgn(p: BProc; e: PNode);
var
  a: TLoc;
begin
  genLineDir(p, e); // BUGFIX
  InitLocExpr(p, e.sons[0], a);
  assert(a.t <> nil);
  expr(p, e.sons[1], a);
end;

procedure genFastAsgn(p: BProc; e: PNode);
var
  a: TLoc;
begin
  genLineDir(p, e); // BUGFIX
  InitLocExpr(p, e.sons[0], a);
  include(a.flags, lfNoDeepCopy);
  assert(a.t <> nil);
  expr(p, e.sons[1], a);
end;

procedure genStmts(p: BProc; t: PNode);
var
  a: TLoc;
  i: int;
  prc: PSym;
begin
  //assert(t <> nil);
  if inCheckpoint(t.info) then
    MessageOut(renderTree(t));
  case t.kind of
    nkEmpty: begin end; // nothing to do!
    nkStmtList: begin
      for i := 0 to sonsLen(t)-1 do genStmts(p, t.sons[i]);
    end;
    nkBlockStmt:   genBlock(p, t, a);
    nkIfStmt:      genIfStmt(p, t);
    nkWhileStmt:   genWhileStmt(p, t);
    nkVarSection:  genVarStmt(p, t);
    nkConstSection: genConstStmt(p, t);
    nkForStmt:     internalError(t.info, 'for statement not eliminated');
    nkCaseStmt:    genCaseStmt(p, t);
    nkReturnStmt:  genReturnStmt(p, t);
    nkBreakStmt:   genBreakStmt(p, t);
    nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand,
    nkCallStrLit: begin
      genLineDir(p, t);
      initLocExpr(p, t, a);
    end;
    nkAsgn: genAsgn(p, t);
    nkFastAsgn: genFastAsgn(p, t);
    nkDiscardStmt: begin
      genLineDir(p, t);
      initLocExpr(p, t.sons[0], a);
    end;
    nkAsmStmt: genAsmStmt(p, t);
    nkTryStmt: begin
      if gCmd = cmdCompileToCpp then genTryStmtCpp(p, t)
      else genTryStmt(p, t);
    end;
    nkRaiseStmt: genRaiseStmt(p, t);
    nkTypeSection: begin
      // we have to emit the type information for object types here to support
      // separate compilation:
      genTypeSection(p.module, t);
    end;
    nkCommentStmt, nkNilLit, nkIteratorDef, nkIncludeStmt, nkImportStmt,
    nkFromStmt, nkTemplateDef, nkMacroDef: begin end;
    nkPragma: genPragma(p, t);
    nkProcDef, nkMethodDef, nkConverterDef: begin
      if (t.sons[genericParamsPos] = nil) then begin
        prc := t.sons[namePos].sym;
        if not (optDeadCodeElim in gGlobalOptions) and
            not (sfDeadCodeElim in getModule(prc).flags)
        or ([sfExportc, sfCompilerProc] * prc.flags = [sfExportc])
        or (prc.kind = skMethod) then begin
          if (t.sons[codePos] <> nil) or (lfDynamicLib in prc.loc.flags) then begin
            genProc(p.module, prc)
          end
        end
      end
    end;
    else
      internalError(t.info, 'genStmts(' +{&} nodeKindToStr[t.kind] +{&} ')')
  end
end;