first steps for FFI support at compile time

5 files changed, 270 insertions, 49 deletions

diff --git a/compiler/cgen.nim b/compiler/cgen.nim
index d024f3479..001a6fbee 100755
--- a/compiler/cgen.nim
+++ b/compiler/cgen.nim
@@ -469,17 +469,6 @@ include "ccgexprs.nim", "ccgstmts.nim"
 # ----------------------------- dynamic library handling -----------------
 # We don't finalize dynamic libs as this does the OS for us.
 
-proc libCandidates(s: string, dest: var TStringSeq) = 
-  var le = strutils.find(s, '(')
-  var ri = strutils.find(s, ')', le+1)
-  if le >= 0 and ri > le:
-    var prefix = substr(s, 0, le - 1)
-    var suffix = substr(s, ri + 1)
-    for middle in split(substr(s, le + 1, ri - 1), '|'):
-      libCandidates(prefix & middle & suffix, dest)
-  else: 
-    add(dest, s)
-
 proc isGetProcAddr(lib: PLib): bool =
   let n = lib.path
   result = n.kind in nkCallKinds and n.typ != nil and 
diff --git a/compiler/condsyms.nim b/compiler/condsyms.nim
index 17366f6e9..4cac7c847 100755
--- a/compiler/condsyms.nim
+++ b/compiler/condsyms.nim
@@ -61,6 +61,8 @@ proc InitDefines*() =
   DefineSymbol("nimmixin")
   DefineSymbol("nimeffects")
   DefineSymbol("nimbabel")
+  when defined(useFFI):
+    DefineSymbol("nimffi")
   
   # add platform specific symbols:
   case targetCPU
diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim
new file mode 100644
index 000000000..66ed3a87e
--- /dev/null
+++ b/compiler/evalffi.nim
@@ -0,0 +1,198 @@
+#
+#
+#           The Nimrod Compiler
+#        (c) Copyright 2012 Andreas Rumpf
+#
+#    See the file "copying.txt", included in this
+#    distribution, for details about the copyright.
+#
+
+## This file implements the FFI part of the evaluator for Nimrod code.
+
+import ast, astalgo, ropes, types, options, tables, dynlib, libffi, msgs
+
+when defined(windows):
+  const libcDll = "msvcrt.dll"
+else:
+  const libcDll = "libc.so(.6|.5|)"
+
+type
+  TDllCache* = tables.TTable[string, TLibHandle]
+var
+  gDllCache = initTable[string, TLibHandle]()
+
+proc getDll(cache: var TDllCache; dll: string): pointer =
+  result = cache[dll]
+  if result.isNil:
+    var libs: seq[string] = @[]
+    libCandidates(dll, libs)
+    for c in libs:
+      result = LoadLib(c)
+      if not result.isNil: break
+    if result.isNil:
+      InternalError("cannot load: " & dll)
+    cache[dll] = result
+
+proc importcSymbol*(sym: PSym): PNode =
+  let lib = sym.annex
+  if lib != nil and lib.path.kind notin {nkStrLit..nkTripleStrLit}:
+    InternalError("dynlib needs to be a string literal for the REPL")
+  
+  let dllpath = if lib.isNil: libcDll else: lib.path.strVal
+  let dllhandle = gDllCache.getDll(dllpath)
+  let name = ropeToStr(sym.loc.r)
+  let theAddr = dllhandle.checkedSymAddr(name)
+  
+  # the AST does not support untyped pointers directly, so we use an nkIntLit
+  # that contains the address instead:
+  result = newNodeIT(nkIntLit, sym.info, sym.typ)
+  result.intVal = cast[TAddress](theAddr)
+
+proc mapType(t: ast.PType): ptr libffi.TType =
+  if t == nil: return addr libffi.type_void
+  
+  case t.kind
+  of tyBool, tyEnum, tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tySet:
+    case t.getSize
+    of 1: result = addr libffi.type_uint8
+    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")
+  of tyFloat, tyFloat64: result = addr libffi.type_double
+  of tyFloat32: result = addr libffi.type_float
+  of tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr,
+     tyStmt, tyTypeDesc, tyProc, tyArray, tyArrayConstr:
+    result = addr libffi.type_pointer
+  else:
+    InternalError("cannot map type to FFI")
+  # too risky:
+  #of tyFloat128: result = addr libffi.type_longdouble
+
+proc mapCallConv(cc: TCallingConvention): 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")
+
+template rd(T, p: expr): expr {.immediate.} = (cast[ptr T](p))[]
+template wr(T, p, v: expr) {.immediate.} = (cast[ptr T](p))[] = v
+
+proc pack(v: PNode): pointer =
+  template awr(T, v: expr) {.immediate, dirty.} =
+    result = alloc0(sizeof(T))
+    wr(T, result, v)
+
+  case v.typ.kind
+  of tyBool: awr(bool, v.intVal != 0)
+  of tyChar: awr(char, v.intVal.chr)
+  of tyInt:  awr(int, v.intVal.int)
+  of tyInt8: awr(int8, v.intVal.int8)
+  of tyInt16: awr(int16, v.intVal.int16)
+  of tyInt32: awr(int32, v.intVal.int32)
+  of tyInt64: awr(int64, v.intVal.int64)
+  of tyUInt: awr(uint, v.intVal.uint)
+  of tyUInt8: awr(uint8, v.intVal.uint8)
+  of tyUInt16: awr(uint16, v.intVal.uint16)
+  of tyUInt32: awr(uint32, v.intVal.uint32)
+  of tyUInt64: awr(uint64, v.intVal.uint64)
+  of tyEnum, tySet:
+    case v.typ.getSize
+    of 1: awr(uint8, v.intVal.uint8)
+    of 2: awr(uint16, v.intVal.uint16)
+    of 4: awr(int32, v.intVal.int32)
+    of 8: awr(int64, v.intVal.int64)
+    else:
+      InternalError("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)
+  
+  of tyPointer, tyProc, tyPtr, tyRef:
+    if v.kind == nkNilLit:
+      result = alloc0(sizeof(pointer))
+    else:
+      awr(pointer, cast[pointer](v.intVal))
+  of tyCString, tyString:
+    if v.kind == nkNilLit:
+      result = alloc0(sizeof(pointer))
+    else:
+      awr(cstring, cstring(v.strVal))
+  else:
+    InternalError("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)
+    result.field = v
+
+  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)
+  
+  case typ.kind
+  of tyBool: awi(nkIntLit, rd(bool, x).ord)
+  of tyChar: awi(nkIntLit, rd(char, x).ord)
+  of tyInt:  awi(nkIntLit, rd(int, x))
+  of tyInt8: awi(nkIntLit, rd(int8, x))
+  of tyInt16: awi(nkIntLit, rd(int16, x))
+  of tyInt32: awi(nkIntLit, rd(int32, x))
+  of tyInt64: awi(nkIntLit, rd(int64, x))
+  of tyUInt: awi(nkIntLit, rd(uint, x).biggestInt)
+  of tyUInt8: awi(nkIntLit, rd(uint8, x).biggestInt)
+  of tyUInt16: awi(nkIntLit, rd(uint16, x).biggestInt)
+  of tyUInt32: awi(nkIntLit, rd(uint32, x).biggestInt)
+  of tyUInt64: awi(nkIntLit, rd(uint64, x).biggestInt)
+  of tyEnum:
+    case typ.getSize
+    of 1: awi(nkIntLit, rd(uint8, x).biggestInt)
+    of 2: awi(nkIntLit, rd(uint16, x).biggestInt)
+    of 4: awi(nkIntLit, rd(int32, x).biggestInt)
+    of 8: awi(nkIntLit, rd(int64, x).biggestInt)
+    else:
+      InternalError("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:
+    let p = rd(pointer, x)
+    if p.isNil:
+      result = newNodeIT(nkNilLit, info, typ)
+    else:
+      awi(nkIntLit, cast[TAddress](p))
+  of tyCString, tyString:
+    let p = rd(cstring, x)
+    if p.isNil:
+      result = newNodeIT(nkNilLit, info, typ)
+    else:
+      aws(nkStrLit, $p)
+  else:
+    InternalError("cannot map value from FFI " & typeToString(typ))
+
+proc callForeignFunction*(call: PNode): PNode =
+  InternalAssert call.sons[0].kind == nkIntLit
+  let typ = call.sons[0].typ
+  
+  var cif: TCif
+  var sig: TParamList
+  for i in 1..typ.len-1: sig[i-1] = mapType(typ.sons[i])
+  
+  if prep_cif(cif, mapCallConv(typ.callConv), cuint(typ.len-1), 
+              mapType(typ.sons[0]), sig) != OK:
+    InternalError(call.info, "error in FFI call")
+  
+  var args: TArgList
+  let fn = cast[pointer](call.sons[0].intVal)
+  for i in 0 .. call.len-1:
+    args[i] = pack(call.sons[i+1])
+  let retVal = alloc(typ.sons[0].getSize.int)
+
+  libffi.call(cif, fn, retVal, args)
+  
+  if isEmptyType(typ.sons[0]): result = emptyNode
+  else: result = unpack(retVal, typ.sons[0], call.info)
+
+  dealloc retVal
+  for i in countdown(call.len-1, 0): dealloc args[i]
diff --git a/compiler/evals.nim b/compiler/evals.nim
index 20d354aaf..535d9aebd 100755
--- a/compiler/evals.nim
+++ b/compiler/evals.nim
@@ -18,6 +18,9 @@ import
   msgs, os, condsyms, idents, renderer, types, passes, semfold, transf, 
   parser, ropes, rodread, idgen, osproc, streams, evaltempl
 
+when hasFFI:
+  import evalffi
+
 type 
   PStackFrame* = ref TStackFrame
   TStackFrame*{.final.} = object 
@@ -307,42 +310,6 @@ proc evalVar(c: PEvalContext, n: PNode): PNode =
           for i in countup(0, sonsLen(result) - 1): addSon(x, result.sons[i])
   result = emptyNode
 
-proc evalCall(c: PEvalContext, n: PNode): PNode = 
-  var d = newStackFrame()
-  d.call = n
-  var prc = n.sons[0]
-  let isClosure = prc.kind == nkClosure
-  setlen(d.params, sonsLen(n) + ord(isClosure))
-  if isClosure:
-    #debug prc
-    result = evalAux(c, prc.sons[1], {efLValue})
-    if isSpecial(result): return
-    d.params[sonsLen(n)] = result
-    result = evalAux(c, prc.sons[0], {})
-  else:
-    result = evalAux(c, prc, {})
-
-  if isSpecial(result): return 
-  prc = result
-  # bind the actual params to the local parameter of a new binding
-  if prc.kind != nkSym: 
-    InternalError(n.info, "evalCall " & n.renderTree)
-    return
-  d.prc = prc.sym
-  if prc.sym.kind notin {skProc, skConverter, skMacro}:
-    InternalError(n.info, "evalCall")
-    return
-  for i in countup(1, sonsLen(n) - 1): 
-    result = evalAux(c, n.sons[i], {})
-    if isSpecial(result): return 
-    d.params[i] = result
-  if n.typ != nil: d.params[0] = getNullValue(n.typ, n.info)
-  pushStackFrame(c, d)
-  result = evalAux(c, prc.sym.getBody, {})
-  if result.kind == nkExceptBranch: return 
-  if n.typ != nil: result = d.params[0]
-  popStackFrame(c)
-
 proc aliasNeeded(n: PNode, flags: TEvalFlags): bool = 
   result = efLValue in flags or n.typ == nil or 
     n.typ.kind in {tyExpr, tyStmt, tyTypeDesc}
@@ -374,7 +341,14 @@ proc evalGlobalVar(c: PEvalContext, s: PSym, flags: TEvalFlags): PNode =
     else:
       result = s.ast
       if result == nil or result.kind == nkEmpty:
-        result = getNullValue(s.typ, s.info)
+        when hasFFI:
+          # for 'stdin' etc. we need to support 'importc' for variables:
+          if sfImportc in s.flags:
+            result = importcSymbol(s)
+          else:
+            result = getNullValue(s.typ, s.info)
+        else:
+          result = getNullValue(s.typ, s.info)
       else:
         result = evalAux(c, result, {})
         if isSpecial(result): return
@@ -382,6 +356,51 @@ proc evalGlobalVar(c: PEvalContext, s: PSym, flags: TEvalFlags): PNode =
   else:
     result = raiseCannotEval(nil, s.info)
 
+proc evalCall(c: PEvalContext, n: PNode): PNode = 
+  var d = newStackFrame()
+  d.call = n
+  var prc = n.sons[0]
+  let isClosure = prc.kind == nkClosure
+  setlen(d.params, sonsLen(n) + ord(isClosure))
+  if isClosure:
+    #debug prc
+    result = evalAux(c, prc.sons[1], {efLValue})
+    if isSpecial(result): return
+    d.params[sonsLen(n)] = result
+    result = evalAux(c, prc.sons[0], {})
+  else:
+    result = evalAux(c, prc, {})
+
+  if isSpecial(result): return 
+  prc = result
+  # bind the actual params to the local parameter of a new binding
+  if prc.kind != nkSym: 
+    InternalError(n.info, "evalCall " & n.renderTree)
+    return
+  d.prc = prc.sym
+  if prc.sym.kind notin {skProc, skConverter, skMacro}:
+    InternalError(n.info, "evalCall")
+    return
+  for i in countup(1, sonsLen(n) - 1): 
+    result = evalAux(c, n.sons[i], {})
+    if isSpecial(result): return 
+    d.params[i] = result
+  if n.typ != nil: d.params[0] = getNullValue(n.typ, n.info)
+  
+  when hasFFI:
+    if sfImportc in prc.sym.flags:
+      var newCall = newNodeI(nkCall, n.info, n.len)
+      newCall.sons[0] = evalGlobalVar(c, prc.sym, {})
+      for i in 1 .. <n.len:
+        newCall.sons[i] = d.params[i-1]
+      return callForeignFunction(newCall)
+  
+  pushStackFrame(c, d)
+  result = evalAux(c, prc.sym.getBody, {})
+  if result.kind == nkExceptBranch: return 
+  if n.typ != nil: result = d.params[0]
+  popStackFrame(c)
+
 proc evalArrayAccess(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = 
   result = evalAux(c, n.sons[0], flags)
   if isSpecial(result): return 
@@ -520,7 +539,8 @@ proc evalSym(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode =
   of skConst: result = s.ast
   of skEnumField: result = newIntNodeT(s.position, n)
   else: result = nil
-  if result == nil or {sfImportc, sfForward} * s.flags != {}:
+  const mask = when hasFFI: {sfForward} else: {sfImportc, sfForward}
+  if result == nil or mask * s.flags != {}:
     result = raiseCannotEval(c, n.info)
 
 proc evalIncDec(c: PEvalContext, n: PNode, sign: biggestInt): PNode = 
diff --git a/compiler/options.nim b/compiler/options.nim
index b8e65f8e3..6df29d85f 100755
--- a/compiler/options.nim
+++ b/compiler/options.nim
@@ -13,6 +13,7 @@ import
 const
   hasTinyCBackend* = defined(tinyc)
   useEffectSystem* = true
+  hasFFI* = defined(useFFI)
 
 type                          # please make sure we have under 32 options
                               # (improves code efficiency a lot!)
@@ -230,6 +231,17 @@ proc findModule*(modulename: string): string {.inline.} =
   # returns path to module
   result = FindFile(AddFileExt(modulename, nimExt))
 
+proc libCandidates*(s: string, dest: var seq[string]) = 
+  var le = strutils.find(s, '(')
+  var ri = strutils.find(s, ')', le+1)
+  if le >= 0 and ri > le:
+    var prefix = substr(s, 0, le - 1)
+    var suffix = substr(s, ri + 1)
+    for middle in split(substr(s, le + 1, ri - 1), '|'):
+      libCandidates(prefix & middle & suffix, dest)
+  else: 
+    add(dest, s)
+
 proc binaryStrSearch*(x: openarray[string], y: string): int = 
   var a = 0
   var b = len(x) - 1