Working version

12 files changed, 408 insertions, 89 deletions

diff --git a/CleanC.dcl b/CleanC.dcl
new file mode 100644
index 0000000..1a83056
--- /dev/null
+++ b/CleanC.dcl
@@ -0,0 +1,60 @@
+definition module CleanC
+
+from StdClass import class toInt, class toString, class toReal,
+                     class fromInt, class fromString, class fromReal
+
+:: State
+
+:: CType = Int | String | Real
+:: CParam = CI Int | CS String | CR Real
+
+cNewState :: *State
+
+instance toInt CParam
+instance toString CParam
+instance toReal CParam
+
+class fromCParam a :: CParam -> a
+instance fromCParam Int
+instance fromCParam String
+instance fromCParam Real
+
+instance fromInt CParam
+instance fromString CParam
+instance fromReal CParam
+
+class toCParam a :: a -> CParam
+instance toCParam Int
+instance toCParam String
+instance toCParam Real
+
+class toCParamList a :: a -> [CParam]
+instance toCParamList [CParam]
+instance toCParamList Int
+instance toCParamList String
+instance toCParamList Real
+instance toCParamList (a,b) | toCParam a & toCParam b
+instance toCParamList (a,b,c) | toCParam a & toCParam b & toCParam c
+instance toCParamList (a,b,c,d) | toCParam a & toCParam b & toCParam c & toCParam d
+instance toCParamList (a,b,c,d,e) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e
+instance toCParamList (a,b,c,d,e,f) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e & toCParam f
+instance toCParamList (a,b,c,d,e,f,g) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e & toCParam f & toCParam g
+
+cInit :: !*State -> *State
+
+cPuti :: !Int !*State -> *State
+cPuts :: !String !*State -> *State
+cPutr :: !Real !*State -> *State
+
+cPutParam :: !CParam -> *State -> *State
+
+cSetReturnType :: !CType -> *State -> *State
+
+cCall_ :: !String !*State -> *State
+
+cGeti :: !*State -> (!Int, !*State)
+cGets :: !*State -> (!String, !*State)
+cGetr :: !*State -> (!Real, !*State)
+
+cCall :: !CType !String !a !*State -> (!CParam, !*State) | toCParamList a
+
diff --git a/CleanC.icl b/CleanC.icl
new file mode 100644
index 0000000..8b32c65
--- /dev/null
+++ b/CleanC.icl
@@ -0,0 +1,123 @@
+implementation module CleanC
+
+import StdEnv
+from GenEq import generic gEq
+
+:: State :== Int
+
+derive gEq CType
+
+cNewState :: *State
+cNewState = 42
+
+instance toInt CParam where toInt (CI i) = i
+instance toString CParam where toString (CS s) = s
+instance toReal CParam where toReal (CR r) = r
+
+instance fromCParam Int where fromCParam (CI i) = i
+instance fromCParam String where fromCParam (CS s) = s
+instance fromCParam Real where fromCParam (CR r) = r
+
+instance fromInt CParam where fromInt i = CI i
+instance fromString CParam where fromString s = CS s
+instance fromReal CParam where fromReal r = CR r
+
+instance toCParam Int where toCParam i = CI i
+instance toCParam String where toCParam s = CS s
+instance toCParam Real where toCParam r = CR r
+
+instance toCParamList [CParam] where toCParamList ps = ps
+instance toCParamList Int where toCParamList i = [CI i]
+instance toCParamList String where toCParamList s = [CS s]
+instance toCParamList Real where toCParamList r = [CR r]
+instance toCParamList (a,b) | toCParam a & toCParam b
+where toCParamList (x,y) = [toCParam x, toCParam y]
+instance toCParamList (a,b,c) | toCParam a & toCParam b & toCParam c
+where toCParamList (a,b,c) = [toCParam a, toCParam b, toCParam c]
+instance toCParamList (a,b,c,d) | toCParam a & toCParam b & toCParam c & toCParam d
+where toCParamList (a,b,c,d) = [toCParam a, toCParam b, toCParam c, toCParam d]
+instance toCParamList (a,b,c,d,e) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e
+where toCParamList (a,b,c,d,e) = [toCParam a, toCParam b, toCParam c, toCParam d, toCParam e]
+instance toCParamList (a,b,c,d,e,f) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e & toCParam f
+where toCParamList (a,b,c,d,e,f) = [toCParam a, toCParam b, toCParam c, toCParam d, toCParam e, toCParam f]
+instance toCParamList (a,b,c,d,e,f,g) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e & toCParam f & toCParam g
+where toCParamList (a,b,c,d,e,f,g) = [toCParam a, toCParam b, toCParam c, toCParam d, toCParam e, toCParam f, toCParam g]
+
+cInit :: !*State -> *State
+cInit s = code inline {
+    ccall cleanInit ":V:I"
+}
+
+cPuti :: !Int !*State -> *State
+cPuti i s = code inline {
+    ccall cleanPuti "I:V:I"
+}
+
+cPuts :: !String !*State -> *State
+cPuts s st = code inline {
+    ccall cleanPuts "S:V:I"
+}
+
+cPutr :: !Real !*State -> *State
+cPutr r st = code inline {
+    ccall cleanPutr "R:V:I"
+}
+
+cPutParam :: !CParam -> *State -> *State
+cPutParam (CI i) = cPuti i
+cPutParam (CS s) = cPuts s
+cPutParam (CR r) = cPutr r
+
+cSetReturnType_ :: !Int !*State -> *State
+cSetReturnType_ i s = code inline {
+    ccall cleanSetReturnType "I:V:I"
+}
+
+cSetReturnType :: !CType -> *State -> *State
+cSetReturnType Int = cSetReturnType_ 0
+cSetReturnType String = cSetReturnType_ 1
+cSetReturnType Real = cSetReturnType_ 2
+
+cCall_ :: !String !*State -> *State
+cCall_ f s = code inline {
+    ccall cleanCall "S:V:I"
+}
+
+cGeti :: !*State -> (!Int, !*State)
+cGeti s = code inline {
+    ccall cleanGeti ":I:I"
+}
+
+cGets :: !*State -> (!String, !*State)
+cGets s = code inline {
+    ccall cleanGets ":S:I"
+}
+
+cGetr :: !*State -> (!Real, !*State)
+cGetr s = code inline {
+    ccall cleanGetr ":R:I"
+}
+
+cGetParam :: !CType !*State -> (!CParam, !*State)
+cGetParam Int s
+# (i,s)=cGeti s
+= (CI i, s)
+cGetParam String st
+# (s,st) = cGets st
+= (CS s, st)
+cGetParam Real s
+# (r,s)=cGetr s
+= (CR r, s)
+
+cCall :: !CType !String !a !*State -> (!CParam, !*State) | toCParamList a
+cCall t f ps s = cCall` t f (toCParamList ps) s
+where
+    cCall` :: !CType !String ![CParam] !*State -> (!CParam, !*State)
+    cCall` t f [] s
+    # s = cSetReturnType t s
+    # s = cCall_ f s
+    = cGetParam t s
+    cCall` t f [p:ps] s
+    # s = cPutParam p s
+    = cCall` t f ps s
+
diff --git a/Makefile b/Makefile
index 55207f6..fc9e1e6 100644
--- a/Makefile
+++ b/Makefile
@@ -1,18 +1,32 @@
-CFLAGS=-O0
+CFLAGS=-O0 -Wall
+
+NAME=CleanC
+OBJ=$(NAME).o
+INTERMEDIATE=interface.o cleanstring.o hacking.o
+TEST_SCRIPT=test
 
 CLM=clm
-CLMFLAGS=-ns -no-opt-link -l cleanc.o -l /usr/lib/x86_64-linux-gnu/libelf.so.1
+CLMFLAGS=-ns -no-opt-link -l $(OBJ) -l -lelf -l -lffi -I "$$CLEAN_HOME/lib/Generics"
+
+all: $(NAME).o
 
-all: cleanc.o
+$(OBJ): $(INTERMEDIATE)
+	$(LD) -r $^ -o $@
 
 %.o: %.c
 	$(CC) $(CFLAGS) -c $<
 
-test: test.icl cleanc.icl cleanc.dcl cleanc.o
-	$(CLM) $(CLMFLAGS) test -o test
-
 clean:
 	rm -frv *.o test Clean\ System\ Files
 
-.PHONY: all clean
+clean_intermediate:
+	rm -frv $(INTERMEDIATE)
+
+$(TEST_SCRIPT): $(TEST_SCRIPT).icl $(NAME).icl $(NAME).dcl $(OBJ) $(TEST_SCRIPT).o
+	$(CLM) $(CLMFLAGS) -l $(TEST_SCRIPT).o $(TEST_SCRIPT) -o $(TEST_SCRIPT)
+
+run_test: $(TEST_SCRIPT)
+	./$(TEST_SCRIPT) -nt
+
+.PHONY: all clean clean_intermediate run_test
 
diff --git a/cleanc.dcl b/cleanc.dcl
deleted file mode 100644
index df97ffe..0000000
--- a/cleanc.dcl
+++ /dev/null
@@ -1,10 +0,0 @@
-definition module cleanc
-
-:: State :== Int
-
-puti :: !Int !*State -> *State
-
-call :: !String !*State -> *State
-
-geti :: !*State -> (!Int, !*State)
-
diff --git a/cleanc.icl b/cleanc.icl
deleted file mode 100644
index b3f037c..0000000
--- a/cleanc.icl
+++ /dev/null
@@ -1,17 +0,0 @@
-implementation module cleanc
-
-puti :: !Int !*State -> *State
-puti i s = code inline {
-    ccall puti "I:V:I"
-}
-
-call :: !String !*State -> *State
-call f s = code inline {
-    ccall call "S:V:I"
-}
-
-geti :: !*State -> (!Int, !*State)
-geti s = code inline {
-    ccall geti ":I:I"
-}
-
diff --git a/cleanstring.c b/cleanstring.c
new file mode 100644
index 0000000..86be7fa
--- /dev/null
+++ b/cleanstring.c
@@ -0,0 +1,23 @@
+#include <stdlib.h>
+#include <string.h>
+
+#include "cleanstring.h"
+
+char* cleantocstring(CleanString s) {
+    char* cs = malloc(sizeof(char) * CleanStringLength(s) + 1);
+    int i;
+    for (i = 0; i < CleanStringLength(s); i++)
+        cs[i] = CleanStringCharacters(s)[i];
+    cs[i] = 0;
+    return cs;
+}
+
+CleanString* ctocleanstring(char* s) {
+    CleanString* cs = malloc(sizeof(long) + sizeof(char)*strlen(s));
+    *((long*)cs) = (long) strlen(s);
+    int i = 0;
+    for (; s[i]; i++)
+        *((char*)cs + ((int)sizeof(long))+i) = s[i];
+    return cs;
+}
+
diff --git a/cleanstring.h b/cleanstring.h
new file mode 100644
index 0000000..d015c54
--- /dev/null
+++ b/cleanstring.h
@@ -0,0 +1,5 @@
+#include "Clean.h"
+
+char* cleantocstring(CleanString s);
+CleanString* ctocleanstring(char* s);
+
diff --git a/cleanc.c b/hacking.c
index bc73574..3b42819 100644
--- a/cleanc.c
+++ b/hacking.c
@@ -1,55 +1,23 @@
 #include <fcntl.h>
 #include <stdio.h>
-#include <elf.h>
-#include <libelf.h>
 #include <stdlib.h>
 #include <string.h>
-#include <inttypes.h>
-#include "Clean.h"
-
-void call_funcname(char*);
-
-void hello(void) {
-    printf("Hello world!\n");
-}
-
-void* parameters[100];
-uint8_t param_ptr = 0;
-
-void init(void) {
-    parameters[0] = NULL;
-    param_ptr = 0;
-}
-
-void puti(long i) {
-    printf("puti %d %d\n", param_ptr, i);
-    parameters[param_ptr] = malloc(sizeof(long));
-    *((long*)parameters[param_ptr]) = i;
-    param_ptr++;
-}
 
-char* cleantocstring(CleanString s) {
-    char* cs = malloc(sizeof(char) * CleanStringLength(s) + 1);
-    int i;
-    for (i = 0; i < CleanStringLength(s); i++)
-        cs[i] = CleanStringCharacters(s)[i];
-    cs[i] = 0;
-    return cs;
-}
+#include <ffi.h>
+#include <elf.h>
+#include <libelf.h>
 
-void call(CleanString fname) {
-    char*f = cleantocstring(fname);
-    call_funcname(f);
-    param_ptr = 0;
-    // todo
-}
+#include "hacking.h"
 
-long geti(void) {
-    printf("geti %d\n", param_ptr);
-    return (long)*((long*)parameters[param_ptr++]);
+Callable* newCallable() {
+    Callable* c = malloc(sizeof(Callable));
+    c->cif = malloc(sizeof(ffi_cif));
+    c->fp = NULL;
+    return c;
 }
 
-void call_funcname(char* fname) {
+Callable* funcnameToCallable(char* fname, 
+            uint8_t n_params, ffi_type** parameter_types, ffi_type* return_type) {
     // http://stackoverflow.com/a/1118808/1544337
     Elf64_Shdr * shdr;
     Elf64_Ehdr * ehdr;
@@ -58,6 +26,8 @@ void call_funcname(char* fname) {
     Elf_Data *   data;
     int cnt;
     void (*fp)() = NULL;
+    Callable* callable = newCallable();
+    if (callable == NULL) return NULL;
 
     int fd = 0;
 
@@ -80,13 +50,12 @@ void call_funcname(char* fname) {
     }
 
     /* Let's go through each elf section looking for the symbol table */
-    for (cnt = 1, scn = NULL; scn = elf_nextscn(elf, scn); cnt++) {
+    for (cnt = 1, scn = NULL; (scn = elf_nextscn(elf, scn)); cnt++) {
         if ((shdr = elf64_getshdr(scn)) == NULL)
             exit(1);
 
         if (shdr->sh_type == SHT_SYMTAB) {
             char *name;
-            char *strName;
             data = 0;
             if ((data = elf_getdata(scn, data)) == 0 || data->d_size == 0) {
                 fprintf(stderr, "No data in symbol table\n");
@@ -108,7 +77,6 @@ void call_funcname(char* fname) {
 
                 if(!name){
                     fprintf(stderr,"%s\n",elf_errmsg(elf_errno()));
-                    //exit(-1);
                 } else if(strcmp(fname, name) == 0 ) {
                     fp = (void(*)(void)) esym->st_value;
                 }
@@ -116,14 +84,23 @@ void call_funcname(char* fname) {
 
             /* Call and hope we don't segfault!*/
             if (fp != NULL) {
-                fp();
-                return;
+                if (ffi_prep_cif(callable->cif, FFI_DEFAULT_ABI, n_params, return_type, parameter_types) == FFI_OK) {
+                    elf_end(elf);
+                    callable->fp = fp;
+                    return callable;
+                }
             }
         } 
     }
 
     elf_end(elf);
 
-    fprintf(stderr, "done, nothing found\n");
+    fprintf(stderr, "No function %s found\n", fname);
+
+    return NULL;
+}
+
+void call(Callable* callable, void** parameters, void* return_val) {
+    ffi_call(callable->cif, callable->fp, return_val, parameters);
 }
 
diff --git a/hacking.h b/hacking.h
new file mode 100644
index 0000000..5498e03
--- /dev/null
+++ b/hacking.h
@@ -0,0 +1,10 @@
+typedef struct {
+    ffi_cif* cif;
+    void(*fp)(void);
+} Callable;
+
+Callable* funcnameToCallable(char* fname, 
+            uint8_t n_params, ffi_type** parameter_types, ffi_type* return_type);
+
+void call(Callable*, void** parameters, void* return_val);
+
diff --git a/interface.c b/interface.c
new file mode 100644
index 0000000..c520521
--- /dev/null
+++ b/interface.c
@@ -0,0 +1,87 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <inttypes.h>
+
+#include <ffi.h>
+#include "hacking.h"
+
+#include "Clean.h"
+#include "cleanstring.h"
+
+void* parameters[100];
+ffi_type* parameter_types[100];
+uint8_t param_ptr = 0;
+
+ffi_type* return_type;
+void* return_val;
+
+void cleanInit(void) {
+    parameters[0] = NULL;
+    param_ptr = 0;
+}
+
+void cleanPuti(long i) {
+    parameters[param_ptr] = malloc(sizeof(long));
+    *((long*)parameters[param_ptr]) = i;
+    parameter_types[param_ptr] = &ffi_type_slong;
+    param_ptr++;
+}
+
+void cleanPuts(CleanString s) {
+    char** csptr = malloc(sizeof(char**));
+    *csptr = cleantocstring(s);
+    parameters[param_ptr] = csptr;
+    parameter_types[param_ptr] = &ffi_type_pointer;
+    param_ptr++;
+}
+
+void cleanPutr(double r) {
+    parameters[param_ptr] = malloc(sizeof(double));
+    *((double*)parameters[param_ptr]) = r;
+    parameter_types[param_ptr] = &ffi_type_double;
+    param_ptr++;
+}
+
+void cleanSetReturnType(long i) {
+    switch (i) {
+        case 0: 
+            return_type = &ffi_type_slong; 
+            return_val = calloc(sizeof(long), 1);
+            break;
+        case 1: 
+            return_type = &ffi_type_pointer; 
+            return_val = calloc(sizeof(char*), 1);
+            break;
+        case 2: 
+            return_type = &ffi_type_double; 
+            return_val = calloc(sizeof(double), 1);
+            break;
+    }
+}
+
+void cleanCall(CleanString fname) {
+    char*cfname = cleantocstring(fname);
+    
+    Callable *callable = funcnameToCallable(cfname,
+            param_ptr, parameter_types, return_type);
+
+    if (callable != NULL)
+        call(callable, parameters, return_val);
+
+    for (; param_ptr != 0; param_ptr--)
+        free(parameters[param_ptr - 1]);
+}
+
+CleanString* cleanGets(void) {
+    return (CleanString*) ctocleanstring(*((char**)return_val));
+}
+
+long cleanGeti(void) {
+    return (long) *((long*) return_val);
+}
+
+double cleanGetr(void) {
+    return (double) *((double*) return_val);
+}
+
diff --git a/test.c b/test.c
new file mode 100644
index 0000000..64c3e04
--- /dev/null
+++ b/test.c
@@ -0,0 +1,25 @@
+#include <stdlib.h>
+#include <string.h>
+
+double test_double(double x) {
+    return x * 0.5;
+}
+
+char* test_string(char* s) {
+    int l = strlen(s);
+    char* r = malloc(sizeof(char) * (l + 1));
+    int i = 0;
+    for (; i<l; i++)
+        r[l-i-1] = s[i];
+    r[l] = '\0';
+    return r;
+}
+
+int test_int(int i) {
+    return i * 2;
+}
+
+int test_two_params(int a, int b) {
+    return a + b;
+}
+
diff --git a/test.icl b/test.icl
index e154d5c..22f7a8b 100644
--- a/test.icl
+++ b/test.icl
@@ -1,12 +1,34 @@
 module test
 
 import StdEnv
-import cleanc
+import CleanC
 
 Start
-# s = 10
-# s = puti 50 s
-# s = call "hello" s
-# (i, s) = geti s
-= i
+# s = cNewState
+# s = cInit s
+# (r0,s) = test_int s
+# (r1,s) = test_string s
+# (r2,s) = test_double s
+# (r3,s) = test_two_params s
+= and [r0,r1,r2,r3]
+
+test_int :: *State -> (Bool, *State)
+test_int s
+# (i, s) = cCall Int "test_int" 15 s
+= (fromCParam i == 30, s)
+
+test_string :: *State -> (Bool, *State)
+test_string st
+# (s, st) = cCall String "test_string" "!dlroW ,olleH" st
+= (fromCParam s == "Hello, World!", st)
+
+test_double :: *State -> (Bool, *State)
+test_double s
+# (r, s) = cCall Real "test_double" 17.0 s
+= (fromCParam r == 8.5, s)
+
+test_two_params :: *State -> (Bool, *State)
+test_two_params s
+# (i, s) = cCall Int "test_two_params" (13,29) s
+= (fromCParam i == 42, s)