From 2fb8dc632b4c007033d9a40c6d6ab060d1ea1fe3 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Sun, 31 Jan 2016 14:46:55 +0100 Subject: Working version --- CleanC.dcl | 60 +++++++++++++++++++++++++++ CleanC.icl | 123 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ Makefile | 28 +++++++++---- cleanc.c | 129 ---------------------------------------------------------- cleanc.dcl | 10 ----- cleanc.icl | 17 -------- cleanstring.c | 23 +++++++++++ cleanstring.h | 5 +++ hacking.c | 106 +++++++++++++++++++++++++++++++++++++++++++++++ hacking.h | 10 +++++ interface.c | 87 +++++++++++++++++++++++++++++++++++++++ test.c | 25 ++++++++++++ test.icl | 34 +++++++++++++--- 13 files changed, 488 insertions(+), 169 deletions(-) create mode 100644 CleanC.dcl create mode 100644 CleanC.icl delete mode 100644 cleanc.c delete mode 100644 cleanc.dcl delete mode 100644 cleanc.icl create mode 100644 cleanstring.c create mode 100644 cleanstring.h create mode 100644 hacking.c create mode 100644 hacking.h create mode 100644 interface.c create mode 100644 test.c 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.c b/cleanc.c deleted file mode 100644 index bc73574..0000000 --- a/cleanc.c +++ /dev/null @@ -1,129 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#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; -} - -void call(CleanString fname) { - char*f = cleantocstring(fname); - call_funcname(f); - param_ptr = 0; - // todo -} - -long geti(void) { - printf("geti %d\n", param_ptr); - return (long)*((long*)parameters[param_ptr++]); -} - -void call_funcname(char* fname) { - // http://stackoverflow.com/a/1118808/1544337 - Elf64_Shdr * shdr; - Elf64_Ehdr * ehdr; - Elf * elf; - Elf_Scn * scn; - Elf_Data * data; - int cnt; - void (*fp)() = NULL; - - int fd = 0; - - /* This is probably Linux specific - Read in our own executable*/ - if ((fd = open("/proc/self/exe", O_RDONLY)) == -1) - exit(1); - - elf_version(EV_CURRENT); - - if ((elf = elf_begin(fd, ELF_C_READ, NULL)) == NULL) { - fprintf(stderr, "file is not an ELF binary\n"); - exit(1); - } - /* Let's get the elf sections */ - if (((ehdr = elf64_getehdr(elf)) == NULL) || - ((scn = elf_getscn(elf, ehdr->e_shstrndx)) == NULL) || - ((data = elf_getdata(scn, NULL)) == NULL)) { - fprintf(stderr, "Failed to get SOMETHING\n"); - exit(1); - } - - /* Let's go through each elf section looking for the symbol table */ - 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"); - continue; - } - - Elf64_Sym *esym = (Elf64_Sym*) data->d_buf; - Elf64_Sym *lastsym = (Elf64_Sym*) ((char*) data->d_buf + data->d_size); - - /* Look through all symbols */ - for (; esym < lastsym; esym++) { - if ((esym->st_value == 0) || - (ELF64_ST_BIND(esym->st_info)== STB_WEAK) || - (ELF64_ST_BIND(esym->st_info)== STB_NUM) || - (ELF64_ST_TYPE(esym->st_info)!= STT_FUNC)) - continue; - - name = elf_strptr(elf,shdr->sh_link , (size_t)esym->st_name); - - if(!name){ - fprintf(stderr,"%s\n",elf_errmsg(elf_errno())); - //exit(-1); - } else if(strcmp(fname, name) == 0 ) { - fp = (void(*)(void)) esym->st_value; - } - } - - /* Call and hope we don't segfault!*/ - if (fp != NULL) { - fp(); - return; - } - } - } - - elf_end(elf); - - fprintf(stderr, "done, nothing found\n"); -} - 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 +#include + +#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/hacking.c b/hacking.c new file mode 100644 index 0000000..3b42819 --- /dev/null +++ b/hacking.c @@ -0,0 +1,106 @@ +#include +#include +#include +#include + +#include +#include +#include + +#include "hacking.h" + +Callable* newCallable() { + Callable* c = malloc(sizeof(Callable)); + c->cif = malloc(sizeof(ffi_cif)); + c->fp = NULL; + return c; +} + +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; + Elf * elf; + Elf_Scn * scn; + Elf_Data * data; + int cnt; + void (*fp)() = NULL; + Callable* callable = newCallable(); + if (callable == NULL) return NULL; + + int fd = 0; + + /* This is probably Linux specific - Read in our own executable*/ + if ((fd = open("/proc/self/exe", O_RDONLY)) == -1) + exit(1); + + elf_version(EV_CURRENT); + + if ((elf = elf_begin(fd, ELF_C_READ, NULL)) == NULL) { + fprintf(stderr, "file is not an ELF binary\n"); + exit(1); + } + /* Let's get the elf sections */ + if (((ehdr = elf64_getehdr(elf)) == NULL) || + ((scn = elf_getscn(elf, ehdr->e_shstrndx)) == NULL) || + ((data = elf_getdata(scn, NULL)) == NULL)) { + fprintf(stderr, "Failed to get SOMETHING\n"); + exit(1); + } + + /* Let's go through each elf section looking for the symbol table */ + 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; + data = 0; + if ((data = elf_getdata(scn, data)) == 0 || data->d_size == 0) { + fprintf(stderr, "No data in symbol table\n"); + continue; + } + + Elf64_Sym *esym = (Elf64_Sym*) data->d_buf; + Elf64_Sym *lastsym = (Elf64_Sym*) ((char*) data->d_buf + data->d_size); + + /* Look through all symbols */ + for (; esym < lastsym; esym++) { + if ((esym->st_value == 0) || + (ELF64_ST_BIND(esym->st_info)== STB_WEAK) || + (ELF64_ST_BIND(esym->st_info)== STB_NUM) || + (ELF64_ST_TYPE(esym->st_info)!= STT_FUNC)) + continue; + + name = elf_strptr(elf,shdr->sh_link , (size_t)esym->st_name); + + if(!name){ + fprintf(stderr,"%s\n",elf_errmsg(elf_errno())); + } else if(strcmp(fname, name) == 0 ) { + fp = (void(*)(void)) esym->st_value; + } + } + + /* Call and hope we don't segfault!*/ + if (fp != NULL) { + 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, "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 +#include +#include +#include + +#include +#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 +#include + +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 (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) -- cgit v1.2.3