Slate VM: /home/briantrice/src/slate-language/src/vm/external-library.cpp Source File

00001 #include "slate.hpp"
00002 
00003 #if defined(WIN32) || defined(__CYGWIN__)
00004 #define DLL_FILE_NAME_EXTENSION ".dll"
00005 #else
00006 #define DLL_FILE_NAME_EXTENSION ".so"
00007 #endif 
00008 
00009 #ifdef WIN32
00010 #define SLATE_LIB_HANDLE HMODULE
00011 #else
00012 #include <dlfcn.h>
00013 #define SLATE_LIB_HANDLE void*
00014 #endif
00015 
00016 static char *safe_string(struct ByteArray *s, char const *suffix) {
00017   size_t len = byte_array_size(s);
00018   char *result = (char*)malloc(strlen(suffix) + len + 1);
00019   if (result == NULL)
00020     return NULL;
00021   memcpy(result, s->elements, len);
00022   strcpy(result + len, suffix);
00023   return result;
00024 }
00025 
00026 bool_t openExternalLibrary(struct object_heap* oh, struct ByteArray *libname, struct ByteArray *handle) {
00027   char *fullname;
00028   SLATE_LIB_HANDLE h;
00029 
00030   assert((unsigned)byte_array_size(handle) >= sizeof(h));
00031 
00032   fullname = safe_string(libname, DLL_FILE_NAME_EXTENSION);
00033   if (fullname == NULL)
00034     return FALSE;
00035 
00036 #ifdef WIN32
00037   h = LoadLibrary(fullname);
00038 #else
00039   h = dlopen(fullname, RTLD_NOW);
00040 
00041   char *message = dlerror();
00042   if (message != NULL) {
00043     fprintf (stderr, "openExternalLibrary '%s' error: %s\n", fullname, message);
00044   }
00045 #endif
00046   free(fullname);
00047 
00048   if (h == NULL) {
00049     return FALSE;
00050   } else {
00051     memcpy(handle->elements, &h, sizeof(h));
00052     return TRUE;
00053   }
00054 }
00055 
00056 bool_t closeExternalLibrary(struct object_heap* oh, struct ByteArray *handle) {
00057   SLATE_LIB_HANDLE h;
00058 
00059   assert((unsigned)byte_array_size(handle) >= sizeof(h));
00060   memcpy(&h, handle->elements, sizeof(h));
00061 
00062 #ifdef WIN32
00063   return FreeLibrary(h) ? TRUE : FALSE;
00064 #else
00065   return (dlclose(h) == 0) ? TRUE : FALSE;
00066 #endif
00067 }
00068 
00069 bool_t lookupExternalLibraryPrimitive(struct object_heap* oh, struct ByteArray *handle, struct ByteArray *symname, struct ByteArray *ptr) {
00070   SLATE_LIB_HANDLE h;
00071   void *fn;
00072   char *symbol;
00073 
00074   assert((unsigned)byte_array_size(handle) >= sizeof(h));
00075   assert((unsigned)byte_array_size(ptr) >= sizeof(fn));
00076 
00077   symbol = safe_string(symname, "");
00078   if (symbol == NULL)
00079     return FALSE;
00080 
00081   memcpy(&h, handle->elements, sizeof(h));
00082 #ifdef WIN32
00083   fn = (void *) GetProcAddress(h, symbol);
00084 #else
00085   fn = (void *) dlsym(h, symbol);
00086 #endif
00087   free(symbol);
00088 
00089   if (fn == NULL) {
00090     return FALSE;
00091   } else {
00092     memcpy(ptr->elements, &fn, sizeof(fn));
00093     return TRUE;
00094   }
00095 }
00096 
00097 int readExternalLibraryError(struct ByteArray *messageBuffer) {
00098   char *message;
00099   int len;
00100 #ifdef WIN32
00101   //TODO: do the equivalent of dlerror() on unix and write the string into
00102   // the buffer, returning the length.
00103   DWORD dw = GetLastError();
00104   FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
00105                 NULL,
00106                 dw,
00107                 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
00108                 (LPTSTR) &message,
00109                 0, NULL);
00110 #else
00111   message = dlerror();
00112 #endif
00113   if (message == NULL)
00114     return 0;
00115   len = strlen(message);
00116   assert(byte_array_size(messageBuffer) >= len);
00117   memcpy(messageBuffer->elements, message, len);
00118 #ifdef WIN32
00119   LocalFree(message);
00120 #endif
00121   return len;
00122 }
00123 
00124 
00125 
00126 
00127 #ifndef WINDOWS
00128 #  define __stdcall
00129 #endif
00130 
00131 enum ArgFormat
00132 {
00133   ARG_FORMAT_VOID = (0 << 1) | 1,
00134   ARG_FORMAT_INT = (1 << 1) | 1,
00135   ARG_FORMAT_FLOAT = (2 << 1) | 1,
00136   ARG_FORMAT_POINTER = (3 << 1) | 1,
00137   ARG_FORMAT_BYTES = (4 << 1) | 1,
00138   ARG_FORMAT_BOOLEAN = (5 << 1) | 1,
00139   ARG_FORMAT_CSTRING = (6 << 1) | 1,
00140   ARG_FORMAT_C_STRUCT_VALUE = (7 << 1) | 1,
00141   ARG_FORMAT_DOUBLE = (8 << 1) | 1,
00142 };
00143 
00144 enum CallFormat
00145 {
00146   CALL_FORMAT_C = (0 << 1) | 1,
00147   CALL_FORMAT_STD = (1 << 1) | 1,
00148 };
00149 
00150 typedef word_t (* ext_fn0_t) (void);
00151 typedef word_t (* ext_fn1_t) (word_t);
00152 typedef word_t (* ext_fn2_t) (word_t, word_t);
00153 typedef word_t (* ext_fn3_t) (word_t, word_t, word_t);
00154 typedef word_t (* ext_fn4_t) (word_t, word_t, word_t, word_t);
00155 typedef word_t (* ext_fn5_t) (word_t, word_t, word_t, word_t, word_t);
00156 typedef word_t (* ext_fn6_t) (word_t, word_t, word_t, word_t, word_t, word_t);
00157 typedef word_t (* ext_fn7_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00158 typedef word_t (* ext_fn8_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00159 typedef word_t (* ext_fn9_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00160 typedef word_t (* ext_fn10_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00161 typedef word_t (* ext_fn11_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00162 typedef word_t (* ext_fn12_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00163 typedef word_t (* ext_fn13_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00164 typedef word_t (* ext_fn14_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00165 typedef word_t (* ext_fn15_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00166 typedef word_t (* ext_fn16_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00167 
00168 typedef word_t (__stdcall * ext_std_fn0_t) (void);
00169 typedef word_t (__stdcall * ext_std_fn1_t) (word_t);
00170 typedef word_t (__stdcall * ext_std_fn2_t) (word_t, word_t);
00171 typedef word_t (__stdcall * ext_std_fn3_t) (word_t, word_t, word_t);
00172 typedef word_t (__stdcall * ext_std_fn4_t) (word_t, word_t, word_t, word_t);
00173 typedef word_t (__stdcall * ext_std_fn5_t) (word_t, word_t, word_t, word_t, word_t);
00174 typedef word_t (__stdcall * ext_std_fn6_t) (word_t, word_t, word_t, word_t, word_t, word_t);
00175 typedef word_t (__stdcall * ext_std_fn7_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00176 typedef word_t (__stdcall * ext_std_fn8_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00177 typedef word_t (__stdcall * ext_std_fn9_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00178 typedef word_t (__stdcall * ext_std_fn10_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00179 typedef word_t (__stdcall * ext_std_fn11_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00180 typedef word_t (__stdcall * ext_std_fn12_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00181 typedef word_t (__stdcall * ext_std_fn13_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00182 typedef word_t (__stdcall * ext_std_fn14_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00183 typedef word_t (__stdcall * ext_std_fn15_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00184 typedef word_t (__stdcall * ext_std_fn16_t) (word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t, word_t);
00185 
00186 word_t extractBigInteger(struct ByteArray* bigInt) {
00187   byte_t *bytes = (byte_t *) byte_array_elements(bigInt);
00188 #if __WORDSIZE == 64
00189   assert(payload_size((struct Object*)bigInt) >= 8);
00190   return ((word_t) bytes[0]) |
00191     (((word_t) bytes[1]) << 8) |
00192     (((word_t) bytes[2]) << 16) |
00193     (((word_t) bytes[3]) << 24) |
00194     (((word_t) bytes[4]) << 32) |
00195     (((word_t) bytes[5]) << 40) |
00196     (((word_t) bytes[6]) << 48) |
00197     (((word_t) bytes[7]) << 56);
00198 #else
00199   assert(payload_size((struct Object*)bigInt) >= 4);
00200   return ((word_t) bytes[0]) |
00201     (((word_t) bytes[1]) << 8) |
00202     (((word_t) bytes[2]) << 16) |
00203     (((word_t) bytes[3]) << 24);
00204 #endif
00205 
00206 }
00207 
00208 struct Object* injectBigInteger(struct object_heap* oh, word_t value) {
00209 #if __WORDSIZE == 64
00210   byte_t bytes[8];
00211   bytes[0] = (byte_t) (value & 0xFF);
00212   bytes[1] = (byte_t) ((value >> 8) & 0xFF);
00213   bytes[2] = (byte_t) ((value >> 16) & 0xFF);
00214   bytes[3] = (byte_t) ((value >> 24) & 0xFF);
00215   bytes[4] = (byte_t) ((value >> 32) & 0xFF);
00216   bytes[5] = (byte_t) ((value >> 40) & 0xFF);
00217   bytes[6] = (byte_t) ((value >> 48) & 0xFF);
00218   bytes[7] = (byte_t) ((value >> 56) & 0xFF);
00219   return (struct Object*)heap_new_byte_array_with(oh, sizeof(bytes), bytes);
00220 #else
00221   byte_t bytes[4];
00222   bytes[0] = (byte_t) (value & 0xFF);
00223   bytes[1] = (byte_t) ((value >> 8) & 0xFF);
00224   bytes[2] = (byte_t) ((value >> 16) & 0xFF);
00225   bytes[3] = (byte_t) ((value >> 24) & 0xFF);
00226   return (struct Object*)heap_new_byte_array_with(oh, sizeof(bytes), bytes);
00227 #endif
00228 }
00229 
00230 #define MAX_ARG_COUNT 16
00231 
00232 struct Object* heap_new_cstring(struct object_heap* oh, byte_t *input) {
00233   return (input ? (struct Object*)heap_new_string_with(oh, strlen((char*)input), (byte_t*) input) : oh->cached.nil);
00234 }
00235 
00236 struct Object* applyExternalLibraryPrimitive(struct object_heap* oh, struct ByteArray * fnHandle, struct OopArray * argsFormat, struct Object* callFormat, struct Object* resultFormat, struct OopArray * argsArr) {
00237   ext_fn0_t fn;
00238   word_t args[MAX_ARG_COUNT];
00239   std::vector<Pinned<struct Object> > fixedArgs(MAX_ARG_COUNT, Pinned<struct Object>(oh));;
00240   word_t result;
00241   word_t arg, argCount, outArgIndex = 0, outArgCount;
00242 
00243   assert ((unsigned)payload_size((struct Object *) fnHandle) >= sizeof (fn));
00244   memcpy (& fn, fnHandle -> elements, sizeof (fn));
00245 
00246   argCount = object_array_size((struct Object *) argsArr);
00247   outArgCount = argCount;
00248   if (argCount > MAX_ARG_COUNT || argCount != object_array_size((struct Object *) argsFormat))
00249     return oh->cached.nil;
00250 
00251   for (arg = 0; arg < argCount; ++arg) {
00252     struct Object* element = argsArr -> elements [arg];
00253 
00254     switch ((word_t)argsFormat->elements [arg]) { /*smallint conversion already done in enum values*/
00255     case ARG_FORMAT_INT:
00256       if (object_is_smallint(element))
00257         args[outArgIndex++] = object_to_smallint(element);
00258       else
00259         args[outArgIndex++] = extractBigInteger((struct ByteArray*) element);
00260       break;
00261     case ARG_FORMAT_BOOLEAN:
00262       if (element == oh->cached.true_object) {
00263         args[outArgIndex++] = TRUE;
00264       } else if (element == oh->cached.false_object) {
00265         args[outArgIndex++] = FALSE;
00266       } else {
00267         /*fix assert(0)?*/
00268         args[outArgIndex++] = -1;
00269       }
00270       break;
00271     case ARG_FORMAT_FLOAT:
00272       {
00273         union {
00274           float_type f;
00275           word_t u;
00276         } convert;
00277 
00278         if (object_is_smallint(element)) {
00279           convert.f = (float_type) object_to_smallint(element);
00280         } else {
00281           convert.f = * (float_type *) byte_array_elements((struct ByteArray*)element);
00282         }
00283         /*fixme this is broken probably*/
00284         /*assert(0);*/
00285         args[outArgIndex++] = convert.u;
00286       }
00287 
00288       break;
00289     case ARG_FORMAT_DOUBLE:
00290       {
00291         union {
00292           double d;
00293           word_t u[2];
00294         } convert;
00295         if (object_is_smallint(element)) {
00296           convert.d = (double) object_to_smallint(element);
00297         } else {
00298           /*TODO, support for real doubles*/
00299           convert.d = (double) * (float_type *) byte_array_elements((struct ByteArray*)element);
00300         }
00301         args[outArgIndex++] = convert.u[0];
00302         args[outArgIndex++] = convert.u[1];
00303         outArgCount++;
00304       }
00305       break;
00306     case ARG_FORMAT_POINTER:
00307       if (element == oh->cached.nil)
00308         args[outArgIndex++] = 0;
00309       else
00310         args[outArgIndex++] = * (word_t*) object_array_elements(element);
00311       break;
00312     case ARG_FORMAT_CSTRING:
00313       if (element == oh->cached.nil)
00314         args[outArgIndex++] = 0;
00315       else {
00316         word_t len = payload_size(element) + 1;
00317         struct ByteArray *bufferObject = heap_clone_byte_array_sized(oh, get_special(oh, SPECIAL_OOP_BYTE_ARRAY_PROTO), len);
00318         char *buffer = (char *) byte_array_elements(bufferObject);
00319         memcpy(buffer, (char *) byte_array_elements((struct ByteArray*) element), len-1);
00320         buffer[len-1] = '\0';
00321         args[outArgIndex++] = (word_t) buffer;
00322       }
00323       break;
00324     case ARG_FORMAT_BYTES:
00325       if (element == oh->cached.nil) {
00326         args[outArgIndex++] = 0;
00327       } else {
00328         args[outArgIndex++] = (word_t) object_array_elements(element);
00329       }
00330       break;
00331     case ARG_FORMAT_C_STRUCT_VALUE:
00332       {
00333         word_t length = payload_size(element) / sizeof(word_t);
00334         word_t *source = (word_t *) object_array_elements(element);
00335         int i;
00336         /* make sure we have enough space */
00337         if (argCount - arg + length > MAX_ARG_COUNT)
00338           return oh->cached.nil;
00339         for(i = 0; i < length; ++i)
00340           args[outArgIndex++] = source[i];
00341         outArgCount += length - 1;
00342       }
00343       break;
00344     default:
00345       return oh->cached.nil;
00346     }
00347   }
00348 
00349   if (callFormat == (struct Object*)CALL_FORMAT_C) {
00350     switch(outArgCount) {
00351     case 0:
00352       result = (* (ext_fn0_t) fn) ();
00353       break;
00354     case 1:
00355       result = (* (ext_fn1_t) fn) (args [0]);
00356       break;
00357     case 2:
00358       result = (* (ext_fn2_t) fn) (args [0], args [1]);
00359       break;
00360     case 3:
00361       result = (* (ext_fn3_t) fn) (args [0], args [1], args [2]);
00362       break;
00363     case 4:
00364       result = (* (ext_fn4_t) fn) (args [0], args [1], args [2], args [3]);
00365       break;
00366     case 5:
00367       result = (* (ext_fn5_t) fn) (args [0], args [1], args [2], args [3], args [4]);
00368       break;
00369     case 6:
00370       result = (* (ext_fn6_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5]);
00371       break;
00372     case 7:
00373       result = (* (ext_fn7_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6]);
00374       break;
00375     case 8:
00376       result = (* (ext_fn8_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7]);
00377       break;
00378     case 9:
00379       result = (* (ext_fn9_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8]);
00380       break;
00381     case 10:
00382       result = (* (ext_fn10_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9]);
00383       break;
00384     case 11:
00385       result = (* (ext_fn11_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10]);
00386       break;
00387     case 12:
00388       result = (* (ext_fn12_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11]);
00389       break;
00390     case 13:
00391       result = (* (ext_fn13_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12]);
00392       break;
00393     case 14:
00394       result = (* (ext_fn14_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12], args [13]);
00395       break;
00396     case 15:
00397       result = (* (ext_fn15_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12], args [13], args [14]);
00398       break;
00399     case 16:
00400       result = (* (ext_fn16_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12], args [13], args [14], args [15]);
00401       break;
00402     default:
00403       return oh->cached.nil;
00404     }
00405   } else if (callFormat == (struct Object*)CALL_FORMAT_STD) {
00406     switch(outArgCount) {
00407     case 0:
00408       result = (* (ext_std_fn0_t) fn) ();
00409       break;
00410     case 1:
00411       result = (* (ext_std_fn1_t) fn) (args [0]);
00412       break;
00413     case 2:
00414       result = (* (ext_std_fn2_t) fn) (args [0], args [1]);
00415       break;
00416     case 3:
00417       result = (* (ext_std_fn3_t) fn) (args [0], args [1], args [2]);
00418       break;
00419     case 4:
00420       result = (* (ext_std_fn4_t) fn) (args [0], args [1], args [2], args [3]);
00421       break;
00422     case 5:
00423       result = (* (ext_std_fn5_t) fn) (args [0], args [1], args [2], args [3], args [4]);
00424       break;
00425     case 6:
00426       result = (* (ext_std_fn6_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5]);
00427       break;
00428     case 7:
00429       result = (* (ext_std_fn7_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6]);
00430       break;
00431     case 8:
00432       result = (* (ext_std_fn8_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7]);
00433       break;
00434     case 9:
00435       result = (* (ext_std_fn9_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8]);
00436       break;
00437     case 10:
00438       result = (* (ext_std_fn10_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9]);
00439       break;
00440     case 11:
00441       result = (* (ext_std_fn11_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10]);
00442       break;
00443     case 12:
00444       result = (* (ext_std_fn12_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11]);
00445       break;
00446     case 13:
00447       result = (* (ext_std_fn13_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12]);
00448     case 14:
00449       result = (* (ext_std_fn14_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12], args [13]);
00450     case 15:
00451       result = (* (ext_std_fn15_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12], args [13], args [14]);
00452     case 16:
00453       result = (* (ext_std_fn16_t) fn) (args [0], args [1], args [2], args [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10], args [11], args [12], args [13], args [14], args [15]);
00454       break;
00455     default:
00456       return oh->cached.nil;
00457     }
00458   } else {
00459     return oh->cached.nil;
00460   }
00461 
00462 
00463 
00464   switch ((word_t)resultFormat) { /*preconverted smallint*/
00465   case ARG_FORMAT_INT:
00466     if (smallint_fits_object(result))
00467       return smallint_to_object(result);
00468     else
00469       return injectBigInteger(oh, (word_t)result);
00470   case ARG_FORMAT_BOOLEAN:
00471     if (result)
00472       return oh->cached.true_object;
00473     else
00474       return oh->cached.false_object;
00475   case ARG_FORMAT_POINTER:
00476     if (result == 0)
00477       return oh->cached.nil;
00478     else
00479       return (struct Object *) heap_new_byte_array_with(oh, sizeof(result), (byte_t*) &result);
00480   case ARG_FORMAT_CSTRING:
00481     return heap_new_cstring(oh, (byte_t*) result);
00482   default:
00483     return oh->cached.nil;
00484   }
00485 }
00486