From 9ef367db62e6b0acff8d6c845375830080d0d77d Mon Sep 17 00:00:00 2001
From: Araq <rumpf_a@web.de>
Date: Mon, 31 Dec 2012 17:53:37 +0100
Subject: [PATCH] fixed a newly introduced c2nim bug; many untested
 improvements to the FFI at compile time

---
 compiler/c2nim/cpp.nim         |   2 +
 compiler/c2nim/tests/systest.c |   2 +
 compiler/evalffi.nim           | 230 +++++++++++++++++++++++++++------
 compiler/evals.nim             |  29 ++++-
 compiler/msgs.nim              |   3 +
 todo.txt                       |   6 +-
 6 files changed, 225 insertions(+), 47 deletions(-)

diff --git a/compiler/c2nim/cpp.nim b/compiler/c2nim/cpp.nim
index 3b7f58fcc8..c210eca3a1 100755
--- a/compiler/c2nim/cpp.nim
+++ b/compiler/c2nim/cpp.nim
@@ -42,6 +42,7 @@ proc parseDefine(p: var TParser): PNode =
     result = newNodeP(nkTemplateDef, p)
     getTok(p)
     addSon(result, skipIdentExport(p))
+    addSon(result, ast.emptyNode)
     eat(p, pxParLe)
     var params = newNodeP(nkFormalParams, p)
     # return type; not known yet:
@@ -60,6 +61,7 @@ proc parseDefine(p: var TParser): PNode =
     addSon(result, ast.emptyNode) # no generic parameters
     addSon(result, params)
     addSon(result, ast.emptyNode) # no pragmas
+    addSon(result, ast.emptyNode)
     var kind = parseDefineBody(p, result)
     params.sons[0] = newIdentNodeP(kind, p)
     eatNewLine(p, result)
diff --git a/compiler/c2nim/tests/systest.c b/compiler/c2nim/tests/systest.c
index 241526e077..2a9dd6c287 100755
--- a/compiler/c2nim/tests/systest.c
+++ b/compiler/c2nim/tests/systest.c
@@ -17,6 +17,8 @@ int   aw_instance_callback_set (AW_CALLBACK c, callback_t callback);
 
 unsigned long int wawa;
 
+#define MAX(x, y) ((x) < (y)? (y) : (x))
+
 #define AW_BUILD 85 // AW 5.0
 // Limits
 #define AW_MAX_AVCHANGE_PER_SECOND 10
diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim
index 5a2f71042a..8f708b76ca 100644
--- a/compiler/evalffi.nim
+++ b/compiler/evalffi.nim
@@ -31,7 +31,7 @@ proc getDll(cache: var TDllCache; dll: string; info: TLineInfo): pointer =
       result = LoadLib(c)
       if not result.isNil: break
     if result.isNil:
-      GlobalError(info, errGenerated, "cannot load: " & dll)
+      GlobalError(info, "cannot load: " & dll)
     cache[dll] = result
 
 const
@@ -50,8 +50,7 @@ proc importcSymbol*(sym: PSym): PNode =
   else:
     let lib = sym.annex
     if lib != nil and lib.path.kind notin {nkStrLit..nkTripleStrLit}:
-      GlobalError(sym.info, errGenerated,
-        "dynlib needs to be a string lit for the REPL")
+      GlobalError(sym.info, "dynlib needs to be a string lit for the REPL")
     var theAddr: pointer
     if lib.isNil and not gExehandle.isNil:
       # first try this exe itself:
@@ -75,8 +74,7 @@ proc mapType(t: ast.PType): ptr libffi.TType =
     of 2: result = addr libffi.type_sint16
     of 4: result = addr libffi.type_sint32
     of 8: result = addr libffi.type_sint64
-    else:
-      InternalError("cannot map type to FFI")
+    else: result = nil
   of tyFloat, tyFloat64: result = addr libffi.type_double
   of tyFloat32: result = addr libffi.type_float
   of tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr,
@@ -85,22 +83,80 @@ proc mapType(t: ast.PType): ptr libffi.TType =
   of tyDistinct:
     result = mapType(t.sons[0])
   else:
-    InternalError("cannot map type to FFI")
+    result = nil
   # too risky:
   #of tyFloat128: result = addr libffi.type_longdouble
 
-proc mapCallConv(cc: TCallingConvention): TABI =
+proc mapCallConv(cc: TCallingConvention, info: TLineInfo): TABI =
   case cc
   of ccDefault: result = DEFAULT_ABI
   of ccStdCall: result = when defined(windows): STDCALL else: DEFAULT_ABI
   of ccCDecl: result = DEFAULT_ABI
-  else: InternalError("cannot map calling convention to FFI")
+  else:
+    GlobalError(info, "cannot map calling convention to FFI")
 
 template rd(T, p: expr): expr {.immediate.} = (cast[ptr T](p))[]
 template wr(T, p, v: expr) {.immediate.} = (cast[ptr T](p))[] = v
 template `+!`(x, y: expr): expr {.immediate.} =
   cast[pointer](cast[TAddress](x) + y)
 
+proc packSize(v: PNode, typ: PType): int =
+  ## computes the size of the blob
+  case typ.kind
+  of tyPtr, tyRef, tyVar:
+    if v.kind in {nkNilLit, nkPtrLit}:
+      result = sizeof(pointer)
+    else:
+      result = sizeof(pointer) + packSize(v.sons[0], typ.sons[0])
+  of tyDistinct, tyGenericInst:
+    result = packSize(v, typ.sons[0])
+  of tyArray, tyArrayConstr:
+    # consider: ptr array[0..1000_000, int] which is common for interfacing;
+    # we use the real length here instead
+    if v.kind in {nkNilLit, nkPtrLit}:
+      result = sizeof(pointer)
+    elif v.len != 0:
+      result = v.len * packSize(v.sons[0], typ.sons[1])
+  else:
+    result = typ.getSize.int
+
+proc pack(v: PNode, typ: PType, res: pointer)
+
+proc getField(n: PNode; position: int): PSym =
+  case n.kind
+  of nkRecList:
+    for i in countup(0, sonsLen(n) - 1):
+      result = getField(n.sons[i], position)
+      if result != nil: return 
+  of nkRecCase:
+    result = getField(n.sons[0], position)
+    if result != nil: return
+    for i in countup(1, sonsLen(n) - 1):
+      case n.sons[i].kind
+      of nkOfBranch, nkElse:
+        result = getField(lastSon(n.sons[i]), position)
+        if result != nil: return
+      else: internalError(n.info, "getField(record case branch)")
+  of nkSym:
+    if n.sym.position == position: result = n.sym
+  else: nil
+
+proc packObject(x: PNode, typ: PType, res: pointer) =
+  InternalAssert x.kind == nkPar
+  # compute the field's offsets:
+  discard typ.getSize
+  for i in countup(0, sonsLen(x) - 1):
+    var it = x.sons[i]
+    if it.kind == nkExprColonExpr:
+      internalAssert it.sons[0].kind == nkSym
+      let field = it.sons[0].sym
+      pack(it.sons[1], field.typ, res +! field.offset)
+    elif typ.n != nil:
+      let field = getField(typ.n, i)
+      pack(it, field.typ, res +! field.offset)
+    else:
+      GlobalError(x.info, "cannot pack unnamed tuple")
+      
 proc pack(v: PNode, typ: PType, res: pointer) =
   template awr(T, v: expr) {.immediate, dirty.} =
     wr(T, res, v)
@@ -125,8 +181,7 @@ proc pack(v: PNode, typ: PType, res: pointer) =
     of 4: awr(int32, v.intVal.int32)
     of 8: awr(int64, v.intVal.int64)
     else:
-      GlobalError(v.info, errGenerated,
-         "cannot map value to FFI (tyEnum, tySet)")
+      GlobalError(v.info, "cannot map value to FFI (tyEnum, tySet)")
   of tyFloat: awr(float, v.floatVal)
   of tyFloat32: awr(float32, v.floatVal)
   of tyFloat64: awr(float64, v.floatVal)
@@ -138,7 +193,7 @@ proc pack(v: PNode, typ: PType, res: pointer) =
     elif v.kind == nkPtrLit:
       awr(pointer, cast[pointer](v.intVal))
     else:
-      GlobalError(v.info, errGenerated, "cannot map pointer/proc value to FFI")
+      GlobalError(v.info, "cannot map pointer/proc value to FFI")
   of tyPtr, tyRef, tyVar:
     if v.kind == nkNilLit:
       # nothing to do since the memory is 0 initialized anyway
@@ -146,33 +201,106 @@ proc pack(v: PNode, typ: PType, res: pointer) =
     elif v.kind == nkPtrLit:
       awr(pointer, cast[pointer](v.intVal))
     else:
-      # XXX this is pretty hard: we need to allocate a new buffer and store it
-      # somewhere to be freed; we also need to write back any changes to the
-      # data!
-      GlobalError(v.info, errGenerated, "cannot map pointer/proc value to FFI")
+      pack(v.sons[0], typ.sons[0], res +! sizeof(pointer))
+      awr(pointer, res +! sizeof(pointer))
   of tyCString, tyString:
     if v.kind == nkNilLit:
       nil
-    else:
+    elif v.kind in {nkStrLit..nkTripleStrLit}:
       awr(cstring, cstring(v.strVal))
+    else:
+      GlobalError(v.info, "cannot map string value to FFI")
   of tyArray, tyArrayConstr:
     let baseSize = typ.sons[1].getSize
-    assert(v.len == lengthOrd(typ.sons[0]))
     for i in 0 .. <v.len:
       pack(v.sons[i], typ.sons[1], res +! i * baseSize)
+  of tyObject, tyTuple:
+    packObject(v, typ, res)
   of tyNil:
     nil
   of tyDistinct, tyGenericInst:
     pack(v, typ.sons[0], res)
   else:
-    GlobalError(v.info, errGenerated, "cannot map value to FFI " & 
-      typeToString(v.typ))
+    GlobalError(v.info, "cannot map value to FFI " & typeToString(v.typ))
 
-proc unpack(x: pointer, typ: PType, info: TLineInfo): PNode =
-  template aw(kind, v, field: expr) {.immediate, dirty.} =
-    result = newNodeIT(kind, info, typ)
+proc unpack(x: pointer, typ: PType, n: PNode): PNode
+
+proc unpackObjectAdd(x: pointer, n, result: PNode) =
+  case n.kind
+  of nkRecList:
+    for i in countup(0, sonsLen(n) - 1):
+      unpackObjectAdd(x, n.sons[i], result)
+  of nkRecCase:
+    GlobalError(result.info, "case objects cannot be unpacked")
+  of nkSym:
+    var pair = newNodeI(nkExprColonExpr, result.info, 2)
+    pair.sons[0] = n
+    pair.sons[1] = unpack(x +! n.sym.offset, n.sym.typ, nil)
+  else: nil
+
+proc unpackObject(x: pointer, typ: PType, n: PNode): PNode =
+  # compute the field's offsets:
+  discard typ.getSize
+  
+  # iterate over any actual field of 'n' ... if n is nil we need to create
+  # the nkPar node:
+  if n.isNil:
+    result = newNode(nkPar)
+    result.typ = typ
+    if typ.n.isNil:
+      InternalError("cannot unpack unnamed tuple")
+    unpackObjectAdd(x, typ.n, result)
+  else:
+    result = n
+    if result.kind != nkPar:
+      GlobalError(n.info, "cannot map value from FFI")
+    if typ.n.isNil:
+      GlobalError(n.info, "cannot unpack unnamed tuple")
+    for i in countup(0, sonsLen(n) - 1):
+      var it = n.sons[i]
+      if it.kind == nkExprColonExpr:
+        internalAssert it.sons[0].kind == nkSym
+        let field = it.sons[0].sym
+        it.sons[1] = unpack(x +! field.offset, field.typ, it.sons[1])
+      else:
+        let field = getField(typ.n, i)
+        n.sons[i] = unpack(x +! field.offset, field.typ, it)
+
+proc unpackArray(x: pointer, typ: PType, n: PNode): PNode =
+  if n.isNil:
+    result = newNode(nkBracket)
+    result.typ = typ
+    newSeq(result.sons, lengthOrd(typ).int)
+  else:
+    result = n
+    if result.kind != nkBracket:
+      GlobalError(n.info, "cannot map value from FFI")
+  let baseSize = typ.sons[1].getSize
+  for i in 0 .. < result.len:
+    result.sons[i] = unpack(x +! i * baseSize, typ.sons[1], result.sons[i])
+
+proc unpack(x: pointer, typ: PType, n: PNode): PNode =
+  template aw(k, v, field: expr) {.immediate, dirty.} =
+    if n.isNil:
+      result = newNode(k)
+      result.typ = typ
+    else:
+      # check we have the right field:
+      result = n
+      if result.kind != k:
+        GlobalError(n.info, "cannot map value from FFI")
     result.field = v
 
+  template setNil() =
+    if n.isNil:
+      result = newNode(nkNilLit)
+      result.typ = typ
+    else:
+      reset n[]
+      result = n
+      result.kind = nkNilLit
+      result.typ = typ
+
   template awi(kind, v: expr) {.immediate, dirty.} = aw(kind, v, intVal)
   template awf(kind, v: expr) {.immediate, dirty.} = aw(kind, v, floatVal)
   template aws(kind, v: expr) {.immediate, dirty.} = aw(kind, v, strVal)
@@ -197,56 +325,78 @@ proc unpack(x: pointer, typ: PType, info: TLineInfo): PNode =
     of 4: awi(nkIntLit, rd(int32, x).biggestInt)
     of 8: awi(nkIntLit, rd(int64, x).biggestInt)
     else:
-      GlobalError(info, errGenerated, 
-        "cannot map value from FFI (tyEnum, tySet)")
+      GlobalError(n.info, "cannot map value from FFI (tyEnum, tySet)")
   of tyFloat: awf(nkFloatLit, rd(float, x))
   of tyFloat32: awf(nkFloatLit, rd(float32, x))
   of tyFloat64: awf(nkFloatLit, rd(float64, x))
-  of tyPointer, tyProc, tyPtr:
+  of tyPointer, tyProc:
     let p = rd(pointer, x)
     if p.isNil:
-      result = newNodeIT(nkNilLit, info, typ)
+      setNil()
     else:
-      awi(nkIntLit, cast[TAddress](p))
+      awi(nkPtrLit, cast[TAddress](p))
+  of tyPtr, tyRef, tyVar:
+    let p = rd(pointer, x)
+    if p.isNil:
+      setNil()
+    elif n != nil and n.kind == nkPtrLit:
+      awi(nkPtrLit, cast[TAddress](p))
+    elif n != nil and n.len == 1:
+      n.sons[0] = unpack(rd(pointer, x), typ.sons[0], n.sons[0])
+    else:
+      GlobalError(n.info, "cannot map value from FFI " & typeToString(typ))
+  of tyObject, tyTuple:
+    result = unpackObject(x, typ, n)
+  of tyArray, tyArrayConstr:
+    result = unpackArray(x, typ, n)
   of tyCString, tyString:
     let p = rd(cstring, x)
     if p.isNil:
-      result = newNodeIT(nkNilLit, info, typ)
+      setNil()
     else:
       aws(nkStrLit, $p)
-  of tyNil: result = newNodeIT(nkNilLit, info, typ)
+  of tyNil:
+    setNil()
   of tyDistinct, tyGenericInst:
-    result = unpack(x, typ.sons[0], info)
+    result = unpack(x, typ.sons[0], n)
   else:
-    GlobalError(info, errGenerated, "cannot map value from FFI " & 
-      typeToString(typ))
+    # XXX what to do with 'array' here?
+    GlobalError(n.info, "cannot map value from FFI " & typeToString(typ))
 
 proc callForeignFunction*(call: PNode): PNode =
-  InternalAssert call.sons[0].kind == nkIntLit
+  InternalAssert call.sons[0].kind == nkPtrLit
   
   var cif: TCif
   var sig: TParamList
   # use the arguments' types for varargs support:
-  for i in 1..call.len-1: sig[i-1] = mapType(call.sons[i].typ)
+  for i in 1..call.len-1:
+    sig[i-1] = mapType(call.sons[i].typ)
+    if sig[i-1].isNil:
+      GlobalError(call.info, "cannot map FFI type")
   
   let typ = call.sons[0].typ
-  if prep_cif(cif, mapCallConv(typ.callConv), cuint(call.len-1), 
+  if prep_cif(cif, mapCallConv(typ.callConv, call.info), cuint(call.len-1),
               mapType(typ.sons[0]), sig) != OK:
-    GlobalError(call.info, errGenerated, "error in FFI call")
+    GlobalError(call.info, "error in FFI call")
   
   var args: TArgList
   let fn = cast[pointer](call.sons[0].intVal)
   for i in 1 .. call.len-1:
     var t = call.sons[i].typ
-    args[i-1] = alloc0(typ.sons[0].getSize.int)
+    args[i-1] = alloc0(packSize(call.sons[i], t))
     pack(call.sons[i], t, args[i-1])
   let retVal = if isEmptyType(typ.sons[0]): pointer(nil)
                else: alloc(typ.sons[0].getSize.int)
 
   libffi.call(cif, fn, retVal, args)
   
-  if retVal.isNil: result = emptyNode
-  else: result = unpack(retVal, typ.sons[0], call.info)
+  if retVal.isNil: 
+    result = emptyNode
+  else:
+    result = unpack(retVal, typ.sons[0], nil)
+    result.info = call.info
 
   if retVal != nil: dealloc retVal
-  for i in countdown(call.len-2, 0): dealloc args[i]
+  for i in countdown(call.len-2, 0):
+    call.sons[i+1] = unpack(args[i], typ.sons[i+1], call[i+1])
+    dealloc args[i]
diff --git a/compiler/evals.nim b/compiler/evals.nim
index ab6218be03..f0a09fff37 100755
--- a/compiler/evals.nim
+++ b/compiler/evals.nim
@@ -37,12 +37,20 @@ type
                               ## emConst?)
     emStatic                  ## evaluate for enforced compile time eval
                               ## ('static' context)
+
+  TSandboxFlag* = enum        ## what the evaluation engine should allow
+    allowCast,                ## allow unsafe language feature: 'cast'
+    allowFFI,                 ## allow the FFI
+    allowInfiniteLoops        ## allow endless loops
+  TSandboxFlags* = set[TSandboxFlag]
+
   TEvalContext* = object of passes.TPassContext
     module*: PSym
     tos*: PStackFrame         # top of stack
     lastException*: PNode
     callsite: PNode           # for 'callsite' magic
     mode*: TEvalMode
+    features: TSandboxFlags
     globals*: TIdNodeTable    # state of global vars
     getType*: proc(n: PNode): PNode {.closure.}
   
@@ -166,9 +174,12 @@ proc evalWhile(c: PEvalContext, n: PNode): PNode =
     of nkExceptBranch, nkReturnToken: break 
     else: nil
     dec(gWhileCounter)
-    if gWhileCounter <= 0: 
-      stackTrace(c, n, errTooManyIterations)
-      break 
+    if gWhileCounter <= 0:
+      if allowInfiniteLoops in c.features:
+        gWhileCounter = 0
+      else:
+        stackTrace(c, n, errTooManyIterations)
+        break
 
 proc evalBlock(c: PEvalContext, n: PNode): PNode =
   result = evalAux(c, n.sons[1], {})
@@ -637,6 +648,14 @@ proc evalConv(c: PEvalContext, n: PNode): PNode =
       # foldConv() cannot deal with everything that we want to do here:
       result = a
 
+proc evalCast(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode =
+  if allowCast in c.features:
+    # XXX we need better checking here and the new pack/unpack stuff should
+    # be useful for some casts too:
+    result = evalConv(c, n)
+  else:
+    result = raiseCannotEval(c, n.info)
+
 proc evalCheckedFieldAccess(c: PEvalContext, n: PNode, 
                             flags: TEvalFlags): PNode = 
   result = evalAux(c, n.sons[0], flags)
@@ -1383,7 +1402,9 @@ proc evalAux(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode =
     result.typ = n.typ
   of nkPragmaBlock:
     result = evalAux(c, n.sons[1], flags)
-  of nkIdentDefs, nkCast, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, 
+  of nkCast:
+    result = evalCast(c, n, flags)
+  of nkIdentDefs, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, 
      nkLambdaKinds, nkContinueStmt, nkIdent, nkParForStmt, nkBindStmt:
     result = raiseCannotEval(c, n.info)
   of nkRefTy:
diff --git a/compiler/msgs.nim b/compiler/msgs.nim
index d88e4a5133..16603a9a87 100755
--- a/compiler/msgs.nim
+++ b/compiler/msgs.nim
@@ -696,6 +696,9 @@ proc Fatal*(info: TLineInfo, msg: TMsgKind, arg = "") =
 proc GlobalError*(info: TLineInfo, msg: TMsgKind, arg = "") = 
   liMessage(info, msg, arg, doRaise)
 
+proc GlobalError*(info: TLineInfo, arg: string) =
+  liMessage(info, errGenerated, arg, doRaise)
+
 proc LocalError*(info: TLineInfo, msg: TMsgKind, arg = "") =
   liMessage(info, msg, arg, doNothing)
 
diff --git a/todo.txt b/todo.txt
index 2a6a45370c..caecc9b709 100755
--- a/todo.txt
+++ b/todo.txt
@@ -2,10 +2,10 @@ version 0.9.2
 =============
 
 - FFI:
-  * proper byte buffers
-  * support for arrays
-  * support for tuples/objects
   * make system.nim aware of nimffi
+  * test libffi on windows
+  * test: SDL with the FFI
+  * test: times.format with the FFI
 - fix closure bug finally
 - fix marshal bug
 - investigate nimgame bug