ref: 1952ac81ff30555457bb003a8abb58a3985f6da0
parent: 07f58958d83c50a4bac1038cbf136e9f4c3d7fbe
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Nov 9 11:44:21 EST 2023
More FFI
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.2
-1545
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _271) ((B _12) _1)) _456))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _455))) ((A :10 (((S' P) _2) (((C' _13) _1) _1284))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _268) _12) _259))) ((A :20 (((S' B) _14) (((C' _271) _12) _260))) ((A :21 _1370) ((A :22 ((B _1413) _21)) ((A :23 (((S' _1413) _21) I)) ((A :24 _1340) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1369) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1383) _170)) ((_258 (_34 _1385)) _169))) ((A :29 ((B ((S _1413) (_34 _1385))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _455)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _456)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1284)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1284))) ((A :46 ((C _43) _259)) ((A :47 ((B _261) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _261) _48)) ((A :50 T) ((A :51 ((_266 ((B (B (_256 _50))) ((B ((C' C) _54)) (B P)))) (_270 _51))) ((A :52 (((((_11 _51) ((B (_256 _50)) P)) (_38 _53)) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_258 _559)) _54)) ((A :56 ((B (_256 _50)) (B (P _1284)))) ((A :57 ((B (_256 _50)) (BK (P _1284)))) ((A :58 ((_256 _50) ((S P) I))) ((A :59 ((B (_256 _50)) ((C (S' P)) I))) ((A :60 ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))) ((B (B (B (B (B (B (B (B (B (B (B C))))))))))) ((B (B (B (B (B (B (B (B (B (B C)))))))))) ((B (B (B (B (B (B (B (B (B C))))))))) ((B (B (B (B (B (B (B (B C)))))))) ((B (B (B (B (B (B (B C))))))) ((B (B (B (B (B (B C)))))) ((B (B (B (B (B C))))) ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P))))))))))))))))))))) ((A :61 (T (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :62 (T (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :63 (T (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :64 (T (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :65 (T (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :66 (T (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :67 (T (K (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK
\ No newline at end of file
+1556
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _271) ((B _12) _1)) _456))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _455))) ((A :10 (((S' P) _2) (((C' _13) _1) _1290))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _268) _12) _259))) ((A :20 (((S' B) _14) (((C' _271) _12) _260))) ((A :21 _1376) ((A :22 ((B _1424) _21)) ((A :23 (((S' _1424) _21) I)) ((A :24 _1346) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1375) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1394) _170)) ((_258 (_34 _1396)) _169))) ((A :29 ((B ((S _1424) (_34 _1396))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _455)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _456)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1290)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1290))) ((A :46 ((C _43) _259)) ((A :47 ((B _261) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _261) _48)) ((A :50 T) ((A :51 ((_266 ((B (B (_256 _50))) ((B ((C' C) _54)) (B P)))) (_270 _51))) ((A :52 (((((_11 _51) ((B (_256 _50)) P)) (_38 _53)) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_258 _559)) _54)) ((A :56 ((B (_256 _50)) (B (P _1290)))) ((A :57 ((B (_256 _50)) (BK (P _1290)))) ((A :58 ((_256 _50) ((S P) I))) ((A :59 ((B (_256 _50)) ((C (S' P)) I))) ((A :60 ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))) ((B (B (B (B (B (B (B (B (B (B (B C))))))))))) ((B (B (B (B (B (B (B (B (B (B C)))))))))) ((B (B (B (B (B (B (B (B (B C))))))))) ((B (B (B (B (B (B (B (B C)))))))) ((B (B (B (B (B (B (B C))))))) ((B (B (B (B (B (B C)))))) ((B (B (B (B (B C))))) ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P))))))))))))))))))))) ((A :61 (T (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :62 (T (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :63 (T (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :64 (T (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :65 (T (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :66 (T (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :67 (T (K (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK
\ No newline at end of file
--- a/lib/Foreign/C/String.hs
+++ b/lib/Foreign/C/String.hs
@@ -1,6 +1,7 @@
module Foreign.C.String(
CChar, CString,
newCAString, withCAString,
+ peekCAString,
) where
import Primitives
import Prelude
@@ -19,3 +20,6 @@
a <- io cs
primFree cs
return a
+
+peekCAString :: CString -> IO String
+peekCAString = primPeekCAString
--- /dev/null
+++ b/lib/Foreign/Ptr.hs
@@ -1,0 +1,13 @@
+module Foreign.Ptr(Ptr, nullPtr) where
+import Primitives
+import Prelude
+import Data.Word
+
+instance forall a . Eq (Ptr a) where
+ p == q = primPtrToWord p == primPtrToWord q
+
+instance forall a . Show (Ptr a) where
+ show p = "PTR#" ++ show (primPtrToWord p)
+
+nullPtr :: forall a . Ptr a
+nullPtr = primWordToPtr 0
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -223,3 +223,12 @@
primFree :: forall a . Ptr a -> IO ()
primFree = primitive "free"
+
+primPeekCAString :: Ptr Char -> IO [Char]
+primPeekCAString = primitive "peekCAString"
+
+primWordToPtr :: forall a . Word -> Ptr a
+primWordToPtr = primitive "wordToPtr"
+
+primPtrToWord :: forall a . Ptr a -> Word
+primPtrToWord = primitive "ptrToWord"
--- a/lib/System/Environment.hs
+++ b/lib/System/Environment.hs
@@ -1,12 +1,23 @@
-- Copyright 2023 Lennart Augustsson
-- See LICENSE file for full license.
module System.Environment(module System.Environment) where
+import Prelude
import Primitives
---import Data.Char -- for String
-import System.IO --Y()
+import Foreign.C.String
+import Foreign.Ptr
-getArgs :: IO [[Char]]
+getArgs :: IO [String]
getArgs = primGetArgs
withDropArgs :: forall a . Int -> IO a -> IO a
withDropArgs = primWithDropArgs
+
+foreign import ccall "getenv" getenvc :: CString -> IO CString
+
+lookupEnv :: String -> IO (Maybe String)
+lookupEnv var = do
+ cptr <- withCAString var getenvc
+ if cptr == nullPtr then
+ return Nothing
+ else
+ Just <$> peekCAString cptr
--- /dev/null
+++ b/lib/System/Process.hs
@@ -1,0 +1,11 @@
+module System.Process(callCommand) where
+import Prelude
+import Foreign.C.String
+
+foreign import ccall "system" systemc :: CString -> IO Int
+
+callCommand :: String -> IO ()
+callCommand cmd = do
+ r <- withCAString cmd systemc
+ when (r /= 0) $
+ error $ "callCommand: failed " ++ show r
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -138,5 +138,8 @@
("IO.catch", primitive "IO.catch"), ("dynsym", primitive "dynsym"), ("newCAString", primitive "newCAString"),- ("free", primitive "free")+ ("peekCAString", primitive "peekCAString"),+ ("free", primitive "free"),+ ("ptrToWord", primitive "ptrToWord"),+ ("wordToPtr", primitive "wordToPtr")]
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -162,7 +162,8 @@
T_IO_PERFORMIO,
T_IO_GETTIMEMILLI, T_IO_PRINT, T_IO_CATCH,
T_IO_CCALL, T_IO_GETRAW, T_IO_FLUSH, T_DYNSYM,
- T_NEWCASTRING, T_FREEPTR,
+ T_NEWCASTRING, T_FREEPTR, T_PEEKCASTRING,
+ T_WORDTOPTR, T_PTRTOWORD,
T_STR,
T_LAST_TAG,
};
@@ -719,6 +720,9 @@
{ "dynsym", T_DYNSYM }, { "free", T_FREEPTR }, { "newCAString", T_NEWCASTRING },+ { "peekCAString", T_PEEKCASTRING },+ { "wordToPtr", T_WORDTOPTR },+ { "ptrToWord", T_PTRTOWORD },};
void
@@ -952,21 +956,22 @@
* (For a more flexible solution use dlopen()/dlsym()/dlclose())
* The table contains the information needed to do the actual call.
* The types are
- * V void name(void)
- * I int name(void)
- * IV void name(int)
- * II int name(int)
- * IIV void name(int, int)
- * III int name(int, int)
+ * V void name(void)
+ * I int name(void)
+ * IV void name(int)
+ * II int name(int)
+ * IIV void name(int, int)
+ * III int name(int, int)
* DD double name(double)
- * PI int name(void*)
- * PPI int name(void*, void*)
+ * PI int name(void*)
+ * PP void* name(void*)
+ * PPI int name(void*, void*)
* more can easily be added.
*/
struct {const char *ffi_name;
const funptr_t ffi_fun;
- enum { FFI_V, FFI_I, FFI_IV, FFI_II, FFI_IIV, FFI_III, FFI_DD, FFI_PI, FFI_PPI } ffi_how;+ enum { FFI_V, FFI_I, FFI_IV, FFI_II, FFI_IIV, FFI_III, FFI_DD, FFI_PI, FFI_PPI, FFI_PP } ffi_how; } ffi_table[] = { { "llabs", (funptr_t)llabs, FFI_II }, { "log", (funptr_t)log, FFI_DD },@@ -979,6 +984,7 @@
{ "acos", (funptr_t)acos, FFI_DD }, { "atan", (funptr_t)atan, FFI_DD }, { "system",(funptr_t)system,FFI_PI },+ { "getenv",(funptr_t)getenv,FFI_PP },};
/* Look up an FFI function by name */
@@ -1062,7 +1068,8 @@
}
NODEPTR mkInt(value_t i);
-NODEPTR mkDouble(double d);
+NODEPTR mkDbl(double d);
+NODEPTR mkPtr(void* p);
/* Table of labelled nodes for sharing during parsing. */
struct shared_entry {@@ -1116,7 +1123,7 @@
return r;
case '&':
d = parse_double(f);
- r = mkDouble(d);
+ r = mkDbl(d);
return r;
case '#':
i = parse_int(f);
@@ -1472,7 +1479,10 @@
case T_IO_CATCH: fprintf(f, "IO.catch"); break;
case T_DYNSYM: fprintf(f, "dynsym"); break;
case T_NEWCASTRING: fprintf(f, "newCAString"); break;
+ case T_PEEKCASTRING: fprintf(f, "peekCAString"); break;
case T_FREEPTR: fprintf(f, "free"); break;
+ case T_PTRTOWORD: fprintf(f, "ptrToWord"); break;
+ case T_WORDTOPTR: fprintf(f, "wordToPtr"); break;
default: ERR("print tag");}
}
@@ -1520,7 +1530,7 @@
}
NODEPTR
-mkDouble(double d)
+mkDbl(double d)
{NODEPTR n;
n = alloc_node(T_DBL);
@@ -1528,6 +1538,15 @@
return n;
}
+NODEPTR
+mkPtr(void* p)
+{+ NODEPTR n;
+ n = alloc_node(T_PTR);
+ PTR(n) = p;
+ return n;
+}
+
static inline NODEPTR
mkNil(void)
{@@ -1916,7 +1935,7 @@
POP(1);
n = TOP(-1);
- GOIND(mkDouble(xd));
+ GOIND(mkDbl(xd));
case T_FSHOW:
// check that the double exists
@@ -1935,6 +1954,7 @@
}
// turn it into a mhs string
+ GCCHECK(strNodes(strlen(str)));
NODEPTR s = mkStringC(str);
// remove the double from the stack
@@ -1962,6 +1982,25 @@
n = TOP(-1);
GOIND(y);
+ case T_PTRTOWORD:
+ CHECK(1);
+ x = evali(ARG(TOP(0)));
+ GCCHECK(1);
+ y = alloc_node(T_INT);
+ SETVALUE(y, GETVALUE(x));
+ POP(1);
+ n = TOP(-1);
+ GOIND(y);
+ case T_WORDTOPTR:
+ CHECK(1);
+ x = evali(ARG(TOP(0)));
+ GCCHECK(1);
+ y = alloc_node(T_PTR);
+ SETVALUE(y, GETVALUE(x));
+ POP(1);
+ n = TOP(-1);
+ GOIND(y);
+
case T_EQ: CMP(==);
case T_NE: CMP(!=);
case T_LT: CMP(<);
@@ -1983,6 +2022,7 @@
char *res = malloc(sz);
snprintf(res, sz, "no match at %s, line %"PRIvalue", col %"PRIvalue, msg, xi, yi);
POP(2);
+ GCCHECK(strNodes(strlen(res)));
ARG(TOP(0)) = mkStringC(res);
free(res);
free(msg);
@@ -1995,6 +2035,7 @@
int sz = strlen(msg) + 100;
char *res = malloc(sz);
snprintf(res, sz, "no default for %s", msg);
+ GCCHECK(strNodes(strlen(res)));
ARG(TOP(0)) = mkStringC(res);
free(res);
free(msg);
@@ -2045,6 +2086,7 @@
case T_IO_CATCH:
case T_FREEPTR:
case T_NEWCASTRING:
+ case T_PEEKCASTRING:
RET;
case T_DYNSYM:
@@ -2258,25 +2300,26 @@
{int a = (int)GETVALUE(n);
funptr_t f = ffi_table[a].ffi_fun;
- value_t r, x, y;
+ value_t ri, xi, yi;
double rd, xd;
- void *xp, *yp;
+ void *xp, *yp, *rp;
#define INTARG(n) evalint(ARG(TOP(n)))
#define PTRARG(n) evalptr(ARG(TOP(n)))
#define DBLARG(n) evaldbl(ARG(TOP(n)))
#define FFIV(n) CHECKIO(n)
-#define FFI(n) CHECKIO(n); GCCHECK(1)
+#define FFI(n) CHECKIO(n); GCCHECK(1)
/* This isn't great, but this is MicroHs, so it's good enough. */
switch (ffi_table[a].ffi_how) {- case FFI_V: FFIV(0); (* f)(); RETIO(combUnit);
- case FFI_I: FFI (0); r = (*(value_t (*)(void ))f)(); n = mkInt(r); RETIO(n);
- case FFI_IV: FFIV(1); x = INTARG(1); (*(void (*)(value_t ))f)(x); RETIO(combUnit);
- case FFI_II: FFI (1); x = INTARG(1); r = (*(value_t (*)(value_t ))f)(x); n = mkInt(r); RETIO(n);
- case FFI_IIV: FFIV(2); x = INTARG(1); y = INTARG(2); (*(void (*)(value_t, value_t))f)(x,y); RETIO(combUnit);
- case FFI_III: FFI (2); x = INTARG(1); y = INTARG(2); r = (*(value_t (*)(value_t, value_t))f)(x,y); n = mkInt(r); RETIO(n);
- case FFI_DD: FFI (1); xd = DBLARG(1); rd= (*(double (*)(double ))f)(xd); n = mkDouble(rd); RETIO(n);
- case FFI_PI: FFI (1); xp = PTRARG(1); r = (*(value_t (*)(void* ))f)(xp); n = mkInt(r); RETIO(n);
- case FFI_PPI: FFI (2); xp = PTRARG(1);yp = PTRARG(2);r = (*(value_t (*)(void*, void* ))f)(xp,yp); n = mkInt(r); RETIO(n);
+ case FFI_V: FFIV(0); (* f)(); RETIO(combUnit);
+ case FFI_I: FFI (0); ri = (*(value_t (*)(void ))f)(); n = mkInt(ri); RETIO(n);
+ case FFI_IV: FFIV(1); xi = INTARG(1); (*(void (*)(value_t ))f)(xi); RETIO(combUnit);
+ case FFI_II: FFI (1); xi = INTARG(1); ri = (*(value_t (*)(value_t ))f)(xi); n = mkInt(ri); RETIO(n);
+ case FFI_IIV: FFIV(2); xi = INTARG(1); yi = INTARG(2); (*(void (*)(value_t, value_t))f)(xi,yi); RETIO(combUnit);
+ case FFI_III: FFI (2); xi = INTARG(1); yi = INTARG(2); ri = (*(value_t (*)(value_t, value_t))f)(xi,yi); n = mkInt(ri); RETIO(n);
+ case FFI_DD: FFI (1); xd = DBLARG(1); rd = (*(double (*)(double ))f)(xd); n = mkDbl(rd); RETIO(n);
+ case FFI_PI: FFI (1); xp = PTRARG(1); ri = (*(value_t (*)(void* ))f)(xp); n = mkInt(ri); RETIO(n);
+ case FFI_PP: FFI (1); xp = PTRARG(1); rp = (*(void* (*)(void* ))f)(xp); n = mkPtr(rp); RETIO(n);
+ case FFI_PPI: FFI (2); xp = PTRARG(1);yp = PTRARG(2); ri = (*(value_t (*)(void*, void* ))f)(xp,yp); n = mkInt(ri); RETIO(n);
default: ERR("T_IO_CCALL");}
}
@@ -2323,6 +2366,12 @@
n = alloc_node(T_PTR);
PTR(n) = name;
RETIO(n);
+
+ case T_PEEKCASTRING:
+ CHECKIO(1);
+ name = evalptr(ARG(TOP(1)));
+ GCCHECK(strNodes(strlen(name)));
+ RETIO(mkStringC(name));
default:
fprintf(stderr, "bad tag %d\n", GETTAG(n));
--
⑨