nl-import.c

   1 /* nl-import.c --- shared library interface for newLISP
   2
   3     Copyright (C) 2008 Lutz Mueller
   4
   5     This program is free software: you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation, either version 3 of the License, or
   8     (at your option) any later version.
   9
  10     This program is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 */
  19
  20
  21 #include "newlisp.h"
  22 #include "protos.h"
  23
  24
  25 #ifdef WINCE
  26 #define _stdcall __stdcall
  27 #endif
  28
  29 #ifndef WIN_32
  30 #ifdef MAC_102
  31 #include "osx-dlfcn.h"
  32 #else
  33 #include <dlfcn.h>
  34 #endif
  35 #endif
  36
  37 UINT cdeclFunction(UINT fAddress, UINT * args, int count);
  38
  39 extern int evalCatchFlag;
  40
  41 #ifdef WIN_32
  42
  43
  44 UINT stdcallFunction(UINT fAddress, UINT * args, int count);
  45
  46
  47 CELL * p_importLib(CELL * params)
  48 {
  49 char * libName;
  50 char * funcName;
  51 char * options = NULL;
  52 HINSTANCE hLibrary;
  53 CELL * pCell;
  54 SYMBOL * symbol;
  55 FARPROC initProc;
  56
  57 params = getString(params, &libName);
  58 params = getString(params, &funcName);
  59 if(params != nilCell)
  60         getString(params, &options);
  61
  62 /* hLibrary = NULL; */
  63
  64 if( (UINT)(hLibrary = LoadLibrary(libName)) < 32)
  65         return(errorProcExt2(ERR_IMPORT_LIB_NOT_FOUND, stuffString(libName)));
  66
  67 if(options != NULL && strcmp(options, "cdecl") ==  0)
  68         pCell = getCell(CELL_IMPORT_CDECL);
  69 else
  70         pCell = getCell(CELL_IMPORT_DLL);
  71
  72 symbol = translateCreateSymbol(funcName, pCell->type, currentContext, TRUE);
  73 if(isProtected(symbol->flags))
  74         return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbol)));
  75
  76 deleteList((CELL *)symbol->contents);
  77 symbol->contents = (UINT)pCell;
  78 pCell->contents = (UINT)GetProcAddress(hLibrary, (LPCSTR)funcName);
  79 pCell->aux = (UINT)symbol->name;
  80
  81 /* put name of imported DLL into DLLs space for loadStartup() */
  82 initProc = GetProcAddress(hLibrary, (LPCSTR)"dllName");
  83 if(initProc != 0) (*initProc)(libName);
  84
  85 if(pCell->contents == 0)
  86         return(errorProcExt2(ERR_IMPORT_FUNC_NOT_FOUND, stuffString(funcName)));
  87
  88 return(copyCell(pCell));
  89 }
  90
  91 #else  /* UNIX and compatible operating systems */
  92
  93 CELL * p_importLib(CELL * params)
  94 {
  95 char * libName;
  96 char * funcName;
  97 void * hLibrary;
  98 CELL * pCell;
  99 SYMBOL * symbol;
 100 char * error;
 101
 102 params = getString(params, &libName);
 103 getString(params, &funcName);
 104 hLibrary = 0;
 105
 106 #ifdef TRU64
 107 if((hLibrary = dlopen(libName, RTLD_LAZY)) == 0)
 108 #else
 109 if((hLibrary = dlopen(libName, RTLD_GLOBAL|RTLD_LAZY)) == 0)
 110 #endif
 111         return(errorProcExt2(ERR_IMPORT_LIB_NOT_FOUND, stuffString((char *)dlerror())));
 112
 113 pCell = getCell(CELL_IMPORT_CDECL);
 114 symbol = translateCreateSymbol(funcName, CELL_IMPORT_CDECL, currentContext, TRUE);
 115 if(isProtected(symbol->flags))
 116         return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbol)));
 117
 118 deleteList((CELL *)symbol->contents);
 119 symbol->contents = (UINT)pCell;
 120
 121 pCell->contents = (UINT)dlsym(hLibrary, funcName);
 122
 123 if((error = (char *)dlerror()) != NULL)
 124         return(errorProcExt2(ERR_IMPORT_FUNC_NOT_FOUND, stuffString(error)));
 125
 126 pCell->aux = (UINT)symbol->name;
 127
 128 return(copyCell(pCell));
 129 }
 130
 131 #endif
 132
 133
 134 CELL * executeLibfunction(CELL * pCell, CELL * params)
 135 {
 136 CELL * arg;
 137 UINT args[14];
 138 int count;
 139
 140 count = 0;
 141 while(params->type != CELL_NIL && count < 14)
 142         {
 143         arg = evaluateExpression(params);
 144         switch(arg->type)
 145                 {
 146                 case CELL_LONG:
 147                 case CELL_STRING:
 148                 case CELL_PRIMITIVE:
 149                         args[count++] = arg->contents;
 150                         break;
 151 #ifndef NEWLISP64
 152                 case CELL_INT64:
 153                         args[count++] = *(INT64 *)&arg->aux;
 154                         break;
 155 #endif
 156                 case CELL_FLOAT:
 157 #ifndef NEWLISP64
 158                         args[count++] = arg->aux;
 159 #endif
 160                         args[count++] = arg->contents;
 161                         break;
 162
 163                 default:
 164                         args[count++] = (UINT)arg;
 165                         break;
 166                 }
 167         params = (CELL *)params->next;
 168         }
 169
 170 #ifdef WIN_32
 171 if(pCell->type == CELL_IMPORT_DLL)
 172         return(stuffInteger(stdcallFunction(pCell->contents, args, count)));
 173 else
 174 #endif
 175 return(stuffInteger(cdeclFunction(pCell->contents, args, count)));
 176 }
 177
 178
 179 UINT cdeclFunction(UINT fAddress, UINT * args, int count)
 180 {
 181 UINT (*function)();
 182
 183 function = (UINT (*)())fAddress;
 184
 185 switch(count)
 186         {
 187         case 0:
 188             return (*function)();
 189
 190         case 1:
 191             return  (*function)(args[0]);
 192
 193         case 2:
 194             return  (*function)(args[0], args[1]);
 195
 196         case 3:
 197             return  (*function)(args[0], args[1], args[2]);
 198
 199         case 4:
 200             return  (*function)(args[0], args[1], args[2], args[3]);
 201
 202         case 5:
 203             return  (*function)(args[0], args[1], args[2], args[3],
 204                                      args[4]);
 205         case 6:
 206             return  (*function)(args[0], args[1], args[2], args[3],
 207                                      args[4], args[5]);
 208         case 7:
 209             return  (*function)(args[0], args[1], args[2], args[3],
 210                                      args[4], args[5], args[6]);
 211         case 8:
 212             return  (*function)(args[0], args[1], args[2], args[3],
 213                                      args[4], args[5], args[6], args[7]);
 214
 215         case 9:
 216             return  (*function)(args[0], args[1], args[2], args[3],
 217                                      args[4], args[5], args[6], args[7], args[8]);
 218
 219         case 10:
 220             return  (*function)(args[0], args[1], args[2], args[3],
 221                                      args[4], args[5], args[6], args[7], args[8], args[9]);
 222         case 11:
 223             return  (*function)(args[0], args[1], args[2], args[3],
 224                                 args[4], args[5], args[6], args[7],
 225                                 args[8], args[9], args[10]);
 226         case 12:
 227             return  (*function)(args[0], args[1], args[2], args[3],
 228                                 args[4], args[5], args[6], args[7],
 229                                 args[8], args[9], args[10], args[11]);
 230
 231         case 13:
 232             return  (*function)(args[0], args[1], args[2], args[3],
 233                                 args[4], args[5], args[6], args[7],
 234                                 args[8], args[9], args[10], args[11],
 235                                 args[12]);
 236         case 14:
 237             return  (*function)(args[0], args[1], args[2], args[3],
 238                                 args[4], args[5], args[6], args[7],
 239                                 args[8], args[9], args[10], args[11],
 240                                 args[12], args[13]);
 241         default:
 242             break;
 243         }
 244
 245 return(0);
 246 }
 247
 248
 249 #ifdef WIN_32
 250 UINT stdcallFunction(UINT fAddress, UINT * args, int count)
 251 {
 252 UINT _stdcall (*function)();
 253
 254 function = (UINT _stdcall (*)())fAddress;
 255
 256 switch(count)
 257         {
 258         case 0:
 259             return (*function)();
 260
 261         case 1:
 262             return  (*function)(args[0]);
 263
 264         case 2:
 265             return  (*function)(args[0], args[1]);
 266
 267         case 3:
 268             return  (*function)(args[0], args[1], args[2]);
 269
 270         case 4:
 271             return  (*function)(args[0], args[1], args[2], args[3]);
 272
 273         case 5:
 274             return  (*function)(args[0], args[1], args[2], args[3],
 275                                      args[4]);
 276         case 6:
 277             return  (*function)(args[0], args[1], args[2], args[3],
 278                                      args[4], args[5]);
 279         case 7:
 280             return  (*function)(args[0], args[1], args[2], args[3],
 281                                      args[4], args[5], args[6]);
 282         case 8:
 283             return  (*function)(args[0], args[1], args[2], args[3],
 284                                      args[4], args[5], args[6], args[7]);
 285
 286         case 9:
 287             return  (*function)(args[0], args[1], args[2], args[3],
 288                                      args[4], args[5], args[6], args[7], args[8]);
 289
 290         case 10:
 291             return  (*function)(args[0], args[1], args[2], args[3],
 292                                      args[4], args[5], args[6], args[7], args[8], args[9]);
 293         case 11:
 294             return  (*function)(args[0], args[1], args[2], args[3],
 295                                 args[4], args[5], args[6], args[7],
 296                                 args[8], args[9], args[10]);
 297         case 12:
 298             return  (*function)(args[0], args[1], args[2], args[3],
 299                                 args[4], args[5], args[6], args[7],
 300                                 args[8], args[9], args[10], args[11]);
 301
 302         case 13:
 303             return  (*function)(args[0], args[1], args[2], args[3],
 304                                 args[4], args[5], args[6], args[7],
 305                                 args[8], args[9], args[10], args[11],
 306                                 args[12]);
 307         case 14:
 308             return  (*function)(args[0], args[1], args[2], args[3],
 309                                 args[4], args[5], args[6], args[7],
 310                                 args[8], args[9], args[10], args[11],
 311                                 args[12], args[13]);
 312         default:
 313             break;
 314         }
 315
 316 return(0);
 317 }
 318 #endif
 319
 320
 321 /* used when passing 32bit floats to library routines */
 322 CELL * p_flt(CELL * params)
 323 {
 324 double dfloatV;
 325 float floatV;
 326 unsigned int number;
 327
 328 getFloat(params, &dfloatV);
 329
 330 floatV = dfloatV;
 331 memcpy(&number, &floatV, 4);
 332
 333 return(stuffInteger(number));
 334 }
 335
 336
 337 /* 8 callback functions for up to 4 parameters */
 338
 339 long template(long n, long p1, long p2, long p3, long p4);
 340
 341 long callback0(long p1, long p2, long p3, long p4) {return template(0, p1, p2, p3, p4);}
 342 long callback1(long p1, long p2, long p3, long p4) {return template(1, p1, p2, p3, p4);}
 343 long callback2(long p1, long p2, long p3, long p4) {return template(2, p1, p2, p3, p4);}
 344 long callback3(long p1, long p2, long p3, long p4) {return template(3, p1, p2, p3, p4);}
 345 long callback4(long p1, long p2, long p3, long p4) {return template(4, p1, p2, p3, p4);}
 346 long callback5(long p1, long p2, long p3, long p4) {return template(5, p1, p2, p3, p4);}
 347 long callback6(long p1, long p2, long p3, long p4) {return template(6, p1, p2, p3, p4);}
 348 long callback7(long p1, long p2, long p3, long p4) {return template(7, p1, p2, p3, p4);}
 349
 350 typedef struct {
 351         SYMBOL * sym;
 352         UINT func;
 353         } LIBCALLBACK;
 354
 355 LIBCALLBACK callback[] = {
 356         { NULL, (UINT)callback0 },
 357         { NULL, (UINT)callback1 },
 358         { NULL, (UINT)callback2 },
 359         { NULL, (UINT)callback3 },
 360         { NULL, (UINT)callback4 },
 361         { NULL, (UINT)callback5 },
 362         { NULL, (UINT)callback6 },
 363         { NULL, (UINT)callback7 },
 364 };
 365
 366
 367 long template(long n, long p1, long p2, long p3, long p4)
 368 {
 369 CELL * args;
 370 long result;
 371 jmp_buf errorJumpSave;
 372
 373 memcpy(errorJumpSave, errorJump, sizeof(errorJump));
 374 if(setjmp(errorJump))
 375         {
 376         reset();
 377         initStacks();
 378         result = -1;
 379         goto FINISH_CALLBACK;
 380         }
 381
 382 args = stuffIntegerList(4, p1, p2, p3, p4);
 383 result = executeSymbol(callback[n].sym, (CELL *)args->contents);
 384 args->contents = (UINT)nilCell;
 385 deleteList(args);
 386
 387 FINISH_CALLBACK:
 388 memcpy(errorJump, errorJumpSave, sizeof(errorJump));
 389 return(result);
 390 }
 391
 392 CELL * p_callback(CELL * params)
 393 {
 394 SYMBOL * sPtr;
 395 UINT n;
 396
 397 params = getInteger(params, &n);
 398 if(n > 7) n = 7;
 399 getSymbol(params, &sPtr);
 400
 401 callback[n].sym = sPtr;
 402
 403 return(stuffInteger(callback[n].func));
 404 }
 405
 406 /* end of file */