1 /******************************** -*- C -*- ****************************
2 *
3 * C - Smalltalk Interface module
4 *
5 *
6 ***********************************************************************/
7
8 /***********************************************************************
9 *
10 * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2005,2006,2007,2008,2009,2011
11 * Free Software Foundation, Inc.
12 * Written by Steve Byrne.
13 *
14 * This file is part of GNU Smalltalk.
15 *
16 * GNU Smalltalk is free software; you can redistribute it and/or modify it
17 * under the terms of the GNU General Public License as published by the Free
18 * Software Foundation; either version 2, or (at your option) any later
19 * version.
20 *
21 * Linking GNU Smalltalk statically or dynamically with other modules is
22 * making a combined work based on GNU Smalltalk. Thus, the terms and
23 * conditions of the GNU General Public License cover the whole
24 * combination.
25 *
26 * In addition, as a special exception, the Free Software Foundation
27 * give you permission to combine GNU Smalltalk with free software
28 * programs or libraries that are released under the GNU LGPL and with
29 * independent programs running under the GNU Smalltalk virtual machine.
30 *
31 * You may copy and distribute such a system following the terms of the
32 * GNU GPL for GNU Smalltalk and the licenses of the other code
33 * concerned, provided that you include the source code of that other
34 * code when and as the GNU GPL requires distribution of source code.
35 *
36 * Note that people who make modified versions of GNU Smalltalk are not
37 * obligated to grant this special exception for their modified
38 * versions; it is their choice whether to do so. The GNU General
39 * Public License gives permission to release a modified version without
40 * this exception; this exception also makes it possible to release a
41 * modified version which carries forward this exception.
42 *
43 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
44 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
45 * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
46 * more details.
47 *
48 * You should have received a copy of the GNU General Public License along with
49 * GNU Smalltalk; see the file COPYING. If not, write to the Free Software
50 * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
51 *
52 ***********************************************************************/
53
54
55 #include "gstpriv.h"
56 #include "re.h"
57 #include "pointer-set.h"
58
59 #include "ffi.h"
60 #include <ltdl.h>
61
62 #ifdef HAVE_GETGRNAM
63 #include <grp.h>
64 #endif
65 #ifdef HAVE_GETPWNAM
66 #include <pwd.h>
67 #endif
68
69 typedef struct cparam
70 {
71 union {
72 long longVal;
73 PTR ptrVal;
74 float floatVal;
75 double doubleVal;
76 long double longDoubleVal;
77 long long longLongVal;
78 struct {
79 PTR pPtrVal;
80 PTR ptrVal;
81 } cObjectPtrVal;
82 } u;
83 OOP oop;
84 cdata_type cType;
85 }
86 cparam;
87
88 /* Holds onto the pointer to a C function and caches data about its calling
89 interface. Used in _gst_invoke_croutine and push_smalltalk_obj. */
90
91 typedef struct cfunc_info
92 {
93 avl_node_t avl;
94 const char *funcName;
95 void (*funcAddr) ();
96 } cfunc_info;
97
98 typedef struct cfunc_cif_cache
99 {
100 unsigned cacheGeneration; /* Is the function called with variadic parms? */
101 ffi_cif cacheCif; /* cached ffi_cif representation */
102
103 int types_size;
104 int arg_idx;
105 cparam *args;
106 ffi_type **types;
107 }
108 cfunc_cif_cache;
109
110 typedef struct gst_ffi_closure
111 {
112 // This field must come first, since the address of this field will
113 // be the same as the address of the overall structure. This is due
114 // to disabling interior pointers in the GC.
115 ffi_closure closure;
116 void *address;
117 OOP callbackOOP;
118 ffi_cif cif;
119 ffi_type *return_type;
120 ffi_type *arg_types[1];
121 }
122 gst_ffi_closure;
123
124 struct gst_stat_struct
125 {
126 unsigned short st_mode; /* protection */
127 long st_size; /* total size, in bytes */
128 long st_aTime; /* time of last access */
129 long st_mTime; /* time of last modification */
130 long st_cTime; /* time of last change */
131 };
132
133 typedef struct gst_stat
134 {
135 OBJ_HEADER;
136 OOP st_mode; /* protection */
137 OOP st_size; /* total size, in bytes */
138 OOP st_aTime; /* time of last access */
139 OOP st_mTime; /* time of last modification */
140 OOP st_cTime; /* time of last change */
141 }
142 *gst_stat;
143
144
145
146 /* Test/example C function and tribute to the original author :-) */
147 static void marli (int n);
148
149 /* Prints an error message... this should really make the primitive
150 fail so that a WrongClass exception is generated (FIXME) */
151 static void bad_type (OOP class_oop,
152 cdata_type cType);
153
154 /* Determines the appropriate C mapping for OOP and stores it. This
155 returns 1 in case the type could not be converted. */
156 static mst_Boolean push_smalltalk_obj (OOP oop,
157 cdata_type cType);
158
159 /* Converts the return type as stored in RESULT to an OOP, based
160 on the RETURNTYPEOOP that is stored in the descriptor. #void is
161 converted to RECEIVEROOP. */
162 static OOP c_to_smalltalk (cparam *result, OOP receiverOOP, OOP returnTypeOOP);
163
164 /* Converts the return type CTYPE, stored in a descriptor to a
165 libffi type. */
166 static ffi_type *get_ffi_type (OOP returnTypeOOP);
167
168 /* Initializes libltdl and defines the functions to access it. */
169 static void init_dld (void);
170
171 /* Wrapper around lt_dlopenext that invokes gst_initModule if it is found
172 in the library. */
173 static PTR dld_open (const char *filename);
174
175 /* Callout to tests callins and callbacks. */
176 static void test_callin (OOP oop, int(*callback)(const char *));
177
178 /* Callout to test the CString class */
179 static void test_cstring (char **string);
180
181 /* Callout to test #cObjectPtr parameters */
182 static void test_cobject_ptr (const void **string);
183
184 /* Return the errno on output from the last callout. */
185 static int get_errno (void);
186
187 /* Encapsulate binary incompatibilities between various C libraries. */
188 static int my_stat_old (const char *name,
189 struct gst_stat_struct * out);
190 static int my_stat (const char *name,
191 OOP out);
192 #ifdef HAVE_LSTAT
193 static int my_lstat_old (const char *name,
194 struct gst_stat_struct * out);
195 static int my_lstat (const char *name,
196 OOP out);
197 #endif
198 static int my_putenv (const char *str);
199 static char **get_environ (void);
200 static int my_chdir (const char *str);
201 static int my_chown (const char *file, const char *owner, const char *group);
202 static int my_symlink (const char* oldpath, const char* newpath);
203 static char *my_mkdtemp (char* template);
204 static int my_mkdir (const char* name, int mode);
205 static DIR *my_opendir (const char *str);
206 static char *extract_dirent_name (struct dirent *dir);
207
208 /* Provide access to the arguments passed via -a. */
209 static int get_argc (void);
210 static const char *get_argv (int n);
211
212 /* The binary tree of function names vs. function addresses. */
213 static cfunc_info *c_func_root = NULL;
214
215 /* The binary tree of function names vs. function addresses. */
216 static struct pointer_map_t *cif_cache = NULL;
217
218 /* Used to invalidate the cache upon GC. */
219 static unsigned cif_cache_generation = 1;
220
221 /* The cfunc_cif_cache that's being filled in. */
222 static cfunc_cif_cache *c_func_cur = NULL;
223
224 /* printable names for corresponding C types */
225 static const char *c_type_name[] = {
226 "char", /* CDATA_CHAR */
227 "unsigned char", /* CDATA_UCHAR */
228 "short", /* CDATA_SHORT */
229 "unsigned short", /* CDATA_USHORT */
230 "long", /* CDATA_LONG */
231 "unsigned long", /* CDATA_ULONG */
232 "float", /* CDATA_FLOAT */
233 "double", /* CDATA_DOUBLE */
234 "char *", /* CDATA_STRING */
235 "OOP", /* CDATA_OOP */
236 "int", /* CDATA_INT */
237 "unsigned int", /* CDATA_UINT */
238 "long double", /* CDATA_LONG_DOUBLE */
239
240 "void?", /* CDATA_UNKNOWN */
241 "char *", /* CDATA_STRING_OUT */
242 "char *", /* CDATA_SYMBOL */
243 "char *", /* CDATA_BYTEARRAY */
244 "char *", /* CDATA_BYTEARRAY_OUT */
245 "int", /* CDATA_BOOLEAN */
246 "void?", /* CDATA_VOID */
247 "...", /* CDATA_VARIADIC */
248 "...", /* CDATA_VARIADIC_OOP */
249 "void *", /* CDATA_COBJECT -- this is misleading */
250 "void **", /* CDATA_COBJECT_PTR */
251 "void?", /* CDATA_SELF */
252 "OOP", /* CDATA_SELF_OOP */
253 "wchar_t", /* CDATA_WCHAR */
254 "wchar_t *", /* CDATA_WSTRING */
255 "wchar_t *", /* CDATA_WSTRING_OUT */
256 "char *", /* CDATA_SYMBOL_OUT */
257 "long long", /* CDATA_LONGLONG */
258 "unsigned long long", /* CDATA_ULONGLONG */
259 };
260
261 /* The errno on output from a callout */
262 int _gst_errno = 0;
263
264
265
266
267 void
marli(int n)268 marli (int n)
269 {
270 int i;
271
272 for (i = 0; i < n; i++)
273 printf ("Marli loves Steve!!!\n");
274 }
275
276 int
get_errno(void)277 get_errno (void)
278 {
279 int old;
280 old = _gst_errno;
281 _gst_errno = 0;
282
283 /* When we get one of these, we don't return an error. However,
284 the primitive still fails and the file/socket is closed by the
285 Smalltalk code. */
286 if (old == ESHUTDOWN || old == ECONNRESET
287 || old == ECONNABORTED || old == ENETRESET
288 || old == EPIPE)
289 return 0;
290 else
291 return (old);
292 }
293
294 static inline int
adjust_time(time_t t)295 adjust_time (time_t t)
296 {
297 return _gst_adjust_time_zone (t) - 86400 * 10957;
298 }
299
300 static inline int
my_stat_old(const char * name,struct gst_stat_struct * out)301 my_stat_old (const char *name,
302 struct gst_stat_struct * out)
303 {
304 int result;
305 struct stat statOut;
306
307 result = stat (name, &statOut);
308 if (!result)
309 {
310 errno = 0;
311 out->st_mode = statOut.st_mode;
312 out->st_size = statOut.st_size;
313 out->st_aTime = adjust_time (statOut.st_atime);
314 out->st_mTime = adjust_time (statOut.st_mtime);
315 out->st_cTime = adjust_time (statOut.st_ctime);
316 }
317 return (result);
318 }
319
320 int
my_stat(const char * name,OOP out)321 my_stat (const char *name,
322 OOP out)
323 {
324 int result;
325 struct stat statOut;
326
327 result = stat (name, &statOut);
328 if (!result)
329 {
330 gst_stat obj = (gst_stat) OOP_TO_OBJ (out);
331 errno = 0;
332 obj->st_mode = FROM_INT (statOut.st_mode);
333 obj->st_aTime = FROM_INT (adjust_time (statOut.st_atime));
334 obj->st_mTime = FROM_INT (adjust_time (statOut.st_mtime));
335 obj->st_cTime = FROM_INT (adjust_time (statOut.st_ctime));
336 obj->st_size = FROM_OFF_T (statOut.st_size);
337 }
338 return (result);
339 }
340
341 #ifdef HAVE_LSTAT
342 static inline int
my_lstat_old(const char * name,struct gst_stat_struct * out)343 my_lstat_old (const char *name,
344 struct gst_stat_struct * out)
345 {
346 int result;
347 struct stat statOut;
348
349 result = lstat (name, &statOut);
350 if (!result)
351 {
352 errno = 0;
353 out->st_mode = statOut.st_mode;
354 out->st_size = statOut.st_size;
355 out->st_aTime = adjust_time (statOut.st_atime);
356 out->st_mTime = adjust_time (statOut.st_mtime);
357 out->st_cTime = adjust_time (statOut.st_ctime);
358 }
359 return (result);
360 }
361
362 int
my_lstat(const char * name,OOP out)363 my_lstat (const char *name,
364 OOP out)
365 {
366 int result;
367 struct stat statOut;
368
369 result = lstat (name, &statOut);
370 if (!result)
371 {
372 gst_stat obj = (gst_stat) OOP_TO_OBJ (out);
373 errno = 0;
374 obj->st_mode = FROM_INT (statOut.st_mode);
375 obj->st_aTime = FROM_INT (adjust_time (statOut.st_atime));
376 obj->st_mTime = FROM_INT (adjust_time (statOut.st_mtime));
377 obj->st_cTime = FROM_INT (adjust_time (statOut.st_ctime));
378 obj->st_size = FROM_OFF_T (statOut.st_size);
379 }
380 return (result);
381 }
382 #else
383 #define my_lstat my_stat
384 #define my_lstat_old my_stat_old
385 #endif
386
387 int
my_putenv(const char * str)388 my_putenv (const char *str)
389 {
390 char *clone;
391 int len;
392
393 len = strlen (str) + 1; /* hold the null */
394 clone = (char *) xmalloc (len);
395 strcpy (clone, str);
396 return (putenv (clone));
397 }
398
399 static char **
get_environ(void)400 get_environ (void)
401 {
402 extern char **environ;
403 return environ;
404 }
405
406
407 int
my_chdir(const char * dir)408 my_chdir (const char *dir)
409 {
410 int status;
411
412 status = chdir (dir);
413
414 if (status == 0)
415 errno = 0;
416 return (status);
417 }
418
419 static int
my_mkdir(const char * name,int mode)420 my_mkdir (const char* name,
421 int mode)
422 {
423 int retstat;
424 #ifdef __MSVCRT__
425 retstat = mkdir (name);
426 if (retstat == 0)
427 retstat = chmod (name, mode);
428 #else
429 retstat = mkdir (name, mode);
430 #endif
431 return retstat;
432 }
433
434 DIR *
my_opendir(const char * dir)435 my_opendir (const char *dir)
436 {
437 DIR *result;
438
439 result = opendir (dir);
440
441 if (result != 0)
442 errno = 0;
443 return (result);
444 }
445
446 long long
test_longlong(long long aVerylongInt)447 test_longlong (long long aVerylongInt)
448 {
449 printf ("Getting a long long 0x%llx\n", aVerylongInt);
450 return aVerylongInt;
451 }
452
453 void
test_callin(OOP oop,int (* callback)(const char *))454 test_callin (OOP oop, int(*callback)(const char *))
455 {
456 OOP o;
457 double f;
458 int i;
459 _gst_str_msg_send (oop, "printNl", NULL);
460
461 o = _gst_string_to_oop ("abc");
462 _gst_str_msg_send (_gst_str_msg_send (o, ",", o, NULL), "printNl",
463 NULL);
464 i = callback ("this is a test");
465 _gst_msg_sendf (&f, "%f %i + %f", i, 4.7);
466 printf ("result = %f\n", f);
467 }
468
469 void
test_cstring(char ** string)470 test_cstring (char **string)
471 {
472 printf ("The string is %s\n", *string);
473 }
474
475 void
test_cobject_ptr(const void ** string)476 test_cobject_ptr (const void **string)
477 {
478 *string = "this is a test";
479 }
480
481 char *
extract_dirent_name(struct dirent * dir)482 extract_dirent_name (struct dirent *dir)
483 {
484 return (dir->d_name);
485 }
486
487 int
get_argc(void)488 get_argc (void)
489 {
490 return (_gst_smalltalk_passed_argc);
491 }
492
493 const char *
get_argv(int n)494 get_argv (int n)
495 {
496 return (n >= 1 && n <= _gst_smalltalk_passed_argc
497 ? _gst_smalltalk_passed_argv[n - 1]
498 : NULL);
499 }
500
501 PTR
dld_open(const char * filename)502 dld_open (const char *filename)
503 {
504 #ifdef ENABLE_DLD
505 lt_dlhandle handle;
506 void (*initModule) (struct VMProxy *);
507
508 /* Not all shared libraries have .xyz extensions! */
509 handle = lt_dlopen (filename);
510 if (!handle)
511 handle = lt_dlopenext (filename);
512 #ifdef __APPLE__
513 if (!handle)
514 {
515 /* For some reason, lt_dlopenext on OS X doesn't try ".dylib" as
516 a possible extension, so we're left with trying it here. */
517 char *full_filename;
518 asprintf(&full_filename, "%s.dylib", filename);
519 handle = lt_dlopen (full_filename);
520 free (full_filename);
521 }
522 #endif
523 if (handle)
524 {
525 initModule = lt_dlsym (handle, "gst_initModule");
526 if (initModule)
527 initModule (_gst_get_vmproxy ());
528 }
529
530 return (handle);
531 #else
532 return (NULL);
533 #endif
534 }
535
536 struct search_path_stack {
537 char *saved_search_path;
538 struct search_path_stack *next;
539 };
540
541 struct search_path_stack *search_paths;
542
543 mst_Boolean
_gst_dlopen(const char * path,mst_Boolean module)544 _gst_dlopen (const char *path, mst_Boolean module)
545 {
546 PTR h = dld_open (path);
547 if (h && !module)
548 _gst_msg_sendf (NULL, "%v %o addLibraryHandle: %C",
549 _gst_class_name_to_oop ("DLD"), h);
550 return !!h;
551 }
552
553 void
_gst_dladdsearchdir(const char * dir)554 _gst_dladdsearchdir (const char *dir)
555 {
556 lt_dlinsertsearchdir (lt_dlgetsearchpath (), dir);
557 }
558
559 void
_gst_dlpushsearchpath(void)560 _gst_dlpushsearchpath (void)
561 {
562 struct search_path_stack *entry = xmalloc (sizeof (struct search_path_stack));
563 const char *path = lt_dlgetsearchpath ();
564 entry->saved_search_path = path ? strdup (path) : NULL;
565 entry->next = search_paths;
566 search_paths = entry;
567 }
568
569 void
_gst_dlpopsearchpath(void)570 _gst_dlpopsearchpath (void)
571 {
572 struct search_path_stack *path = search_paths;
573 if (!path)
574 return;
575
576 lt_dlsetsearchpath (path->saved_search_path);
577 search_paths = path->next;
578 free (path->saved_search_path);
579 free (path);
580 }
581
582
583
584 void
init_dld(void)585 init_dld (void)
586 {
587 char *modules;
588 lt_dlinit ();
589
590 modules = _gst_relocate_path (MODULE_PATH);
591 lt_dladdsearchdir (modules);
592 free (modules);
593
594 if ((modules = getenv ("SMALLTALK_MODULES")))
595 lt_dladdsearchdir (modules);
596
597 /* Too hard to support dlpreopen... LTDL_SET_PRELOADED_SYMBOLS(); */
598
599 _gst_define_cfunc ("defineCFunc", _gst_define_cfunc);
600 _gst_define_cfunc ("dldLink", dld_open);
601 _gst_define_cfunc ("dldGetFunc", lt_dlsym);
602 _gst_define_cfunc ("dldError", lt_dlerror);
603 }
604
605 void
_gst_init_cfuncs(void)606 _gst_init_cfuncs (void)
607 {
608 extern char *getenv (const char *);
609
610 cif_cache = pointer_map_create ();
611
612 /* Access to command line args */
613 _gst_define_cfunc ("getArgc", get_argc);
614 _gst_define_cfunc ("getArgv", get_argv);
615
616 /* Test functions */
617 _gst_define_cfunc ("testLongLong", test_longlong);
618 _gst_define_cfunc ("testCallin", test_callin);
619 _gst_define_cfunc ("testCString", test_cstring);
620 _gst_define_cfunc ("testCObjectPtr", test_cobject_ptr);
621
622 /* Access to C library */
623 _gst_define_cfunc ("system", system);
624 _gst_define_cfunc ("getenv", getenv);
625 _gst_define_cfunc ("environ", get_environ);
626 _gst_define_cfunc ("putenv", my_putenv);
627 _gst_define_cfunc ("printf", printf);
628
629 _gst_define_cfunc ("errno", get_errno);
630 _gst_define_cfunc ("strerror", strerror);
631 _gst_define_cfunc ("stat", my_stat_old);
632 _gst_define_cfunc ("lstat", my_lstat_old);
633 _gst_define_cfunc ("stat_obj", my_stat);
634 _gst_define_cfunc ("lstat_obj", my_lstat);
635 _gst_define_cfunc ("utime", _gst_set_file_access_times);
636 _gst_define_cfunc ("chmod", chmod);
637 _gst_define_cfunc ("chown", my_chown);
638
639 _gst_define_cfunc ("opendir", my_opendir);
640 _gst_define_cfunc ("closedir", closedir);
641 _gst_define_cfunc ("readdir", readdir);
642 _gst_define_cfunc ("rewinddir", rewinddir);
643 _gst_define_cfunc ("extractDirentName", extract_dirent_name);
644
645 _gst_define_cfunc ("symlink", my_symlink);
646 _gst_define_cfunc ("unlink", unlink);
647 _gst_define_cfunc ("rename", rename);
648 _gst_define_cfunc ("rmdir", rmdir);
649 _gst_define_cfunc ("chdir", my_chdir);
650 _gst_define_cfunc ("mkdir", my_mkdir);
651 _gst_define_cfunc ("mkdtemp", my_mkdtemp);
652 _gst_define_cfunc ("getCurDirName", _gst_get_cur_dir_name);
653
654 _gst_define_cfunc ("fileIsReadable", _gst_file_is_readable);
655 _gst_define_cfunc ("fileIsWriteable", _gst_file_is_writeable);
656 _gst_define_cfunc ("fileIsExecutable", _gst_file_is_executable);
657
658 init_dld ();
659
660 /* regex routines */
661 _gst_define_cfunc ("reh_search", _gst_re_search);
662 _gst_define_cfunc ("reh_match", _gst_re_match);
663 _gst_define_cfunc ("reh_make_cacheable", _gst_re_make_cacheable);
664
665 /* Non standard routines */
666 _gst_define_cfunc ("marli", marli);
667 }
668
669
670
671 void
_gst_define_cfunc(const char * funcName,PTR funcAddr)672 _gst_define_cfunc (const char *funcName,
673 PTR funcAddr)
674 {
675 avl_node_t **p = (avl_node_t **) &c_func_root;
676 cfunc_info *node;
677 cfunc_info *cfi = NULL;
678
679 while (*p)
680 {
681 int cmp;
682 cfi = (cfunc_info *) *p;
683
684 cmp = strcmp(funcName, cfi->funcName);
685 if (cmp < 0)
686 p = &(*p)->avl_left;
687 else if (cmp > 0)
688 p = &(*p)->avl_right;
689 else
690 {
691 cfi->funcAddr = funcAddr;
692 return;
693 }
694 }
695
696 node = (cfunc_info *) xcalloc(sizeof(cfunc_info), 1);
697 node->avl.avl_parent = (avl_node_t *) cfi;
698 node->avl.avl_left = node->avl.avl_right = NULL;
699 node->funcName = strdup (funcName);
700 node->funcAddr = funcAddr;
701 *p = &(node->avl);
702
703 avl_rebalance(&node->avl, (avl_node_t **) &c_func_root);
704 }
705
706
707
708 PTR
_gst_lookup_function(const char * funcName)709 _gst_lookup_function (const char *funcName)
710 {
711 cfunc_info *cfi = c_func_root;
712
713 while (cfi)
714 {
715 int cmp;
716
717 cmp = strcmp(funcName, cfi->funcName);
718 if (cmp == 0)
719 return (PTR) cfi->funcAddr;
720
721 cfi = (cfunc_info *) (cmp < 0 ? cfi->avl.avl_left : cfi->avl.avl_right);
722 }
723
724 return NULL;
725 }
726
727
728 int
_gst_c_type_size(int type)729 _gst_c_type_size (int type)
730 {
731 switch (type)
732 {
733 case CDATA_CHAR:
734 return sizeof (char);
735 case CDATA_UCHAR:
736 return sizeof (unsigned char);
737
738 case CDATA_SHORT:
739 return sizeof (short);
740 case CDATA_USHORT:
741 return sizeof (unsigned short);
742
743 case CDATA_INT:
744 return sizeof (int);
745 case CDATA_UINT:
746 return sizeof (unsigned int);
747
748 case CDATA_LONG:
749 return sizeof (long);
750 case CDATA_ULONG:
751 return sizeof (unsigned long);
752
753 case CDATA_LONGLONG:
754 return sizeof (long long);
755 case CDATA_ULONGLONG:
756 return sizeof (unsigned long long);
757
758 case CDATA_FLOAT:
759 return sizeof (float);
760 case CDATA_DOUBLE:
761 return sizeof (double);
762 case CDATA_LONG_DOUBLE:
763 return sizeof (long double);
764
765 case CDATA_OOP:
766 return sizeof (OOP);
767
768 case CDATA_WCHAR:
769 return sizeof (wchar_t);
770
771 case CDATA_WSTRING:
772 return sizeof (wchar_t *);
773
774 case CDATA_STRING:
775 case CDATA_STRING_OUT:
776 case CDATA_SYMBOL:
777 case CDATA_BYTEARRAY:
778 case CDATA_BYTEARRAY_OUT:
779 case CDATA_SYMBOL_OUT:
780 return sizeof (char *);
781
782 case CDATA_COBJECT:
783 return sizeof (void *);
784
785 case CDATA_COBJECT_PTR:
786 return sizeof (void **);
787
788 default:
789 return 0;
790 }
791 }
792
793 void
_gst_invalidate_croutine_cache(void)794 _gst_invalidate_croutine_cache (void)
795 {
796 /* May want to delete and recreate completely upon global GC,
797 and do the cheap invalidation only for scavenging? For now,
798 we do the simplest thing. Incrementing by 2 makes sure that
799 the generation number is never 0. */
800 cif_cache_generation += 2;
801 }
802
803 OOP
_gst_invoke_croutine(OOP cFuncOOP,OOP receiver,OOP * args)804 _gst_invoke_croutine (OOP cFuncOOP,
805 OOP receiver,
806 OOP *args)
807 {
808 gst_c_callable desc;
809 cdata_type cType;
810 cparam result, *local_arg_vec, *arg;
811 void *funcAddr, **p_slot, **ffi_arg_vec;
812 OOP *argTypes, oop;
813 int i, si, fixedArgs, totalArgs, filledArgs;
814 mst_Boolean haveVariadic, needPostprocessing;
815 inc_ptr incPtr;
816
817 incPtr = INC_SAVE_POINTER ();
818
819 /* Make sure the parameters do not die. */
820 INC_ADD_OOP (cFuncOOP);
821 INC_ADD_OOP (receiver);
822
823 funcAddr = cobject_value (cFuncOOP);
824 if (!funcAddr)
825 return (NULL);
826
827 p_slot = pointer_map_insert (cif_cache, cFuncOOP);
828 if (!*p_slot)
829 *p_slot = xcalloc (1, sizeof (cfunc_cif_cache));
830
831 desc = (gst_c_callable) OOP_TO_OBJ (cFuncOOP);
832 argTypes = OOP_TO_OBJ (desc->argTypesOOP)->data;
833
834 c_func_cur = *p_slot;
835 fixedArgs = NUM_INDEXABLE_FIELDS (desc->argTypesOOP);
836 totalArgs = 0;
837 haveVariadic = needPostprocessing = false;
838 for (si = i = 0; i < fixedArgs; i++)
839 {
840 cType = IS_OOP (argTypes[i]) ? CDATA_COBJECT : TO_INT (argTypes[i]);
841 switch (cType)
842 {
843 case CDATA_VOID:
844 break;
845
846 case CDATA_VARIADIC:
847 case CDATA_VARIADIC_OOP:
848 oop = args[si++];
849 totalArgs += NUM_WORDS (OOP_TO_OBJ (oop));
850 haveVariadic = true;
851 break;
852
853 case CDATA_SELF:
854 case CDATA_SELF_OOP:
855 totalArgs++;
856 break;
857
858 case CDATA_COBJECT_PTR:
859 case CDATA_WSTRING_OUT:
860 case CDATA_STRING_OUT:
861 case CDATA_BYTEARRAY_OUT:
862 case CDATA_SYMBOL_OUT:
863 case CDATA_STRING:
864 case CDATA_BYTEARRAY:
865 case CDATA_SYMBOL:
866 case CDATA_WSTRING:
867 needPostprocessing = true;
868 /* fall through */
869
870 default:
871 totalArgs++;
872 si++;
873 break;
874 }
875 }
876
877 ffi_arg_vec = (void **) alloca (totalArgs * sizeof (void *));
878 c_func_cur->args = local_arg_vec = (cparam *)
879 alloca (totalArgs * sizeof (cparam));
880
881 /* The ffi_cif holds a pointer to this, so we must malloc it. */
882 if (c_func_cur->types_size < totalArgs)
883 {
884 c_func_cur->types = (ffi_type **) realloc (c_func_cur->types,
885 totalArgs * sizeof (ffi_type *));
886 c_func_cur->types_size = totalArgs;
887 }
888
889 c_func_cur->arg_idx = 0;
890
891 for (i = 0; i < totalArgs; i++)
892 ffi_arg_vec[i] = &local_arg_vec[i].u;
893
894 /* Push the arguments */
895 for (si = i = 0; i < fixedArgs; i++)
896 {
897 mst_Boolean res;
898
899 cType = IS_OOP (argTypes[i]) ? CDATA_COBJECT : TO_INT (argTypes[i]);
900 if (cType == CDATA_VOID)
901 continue;
902
903 else if (cType == CDATA_SELF || cType == CDATA_SELF_OOP)
904 res = push_smalltalk_obj (receiver,
905 cType == CDATA_SELF ? CDATA_UNKNOWN : CDATA_OOP);
906 else
907 /* Do nothing if it is a void */
908 res = push_smalltalk_obj (args[si++], cType);
909
910 if (!res)
911 {
912 oop = NULL;
913 filledArgs = c_func_cur->arg_idx;
914 goto out;
915 }
916 }
917
918 /* If the previous call was done through the same function descriptor,
919 the ffi_cif is already ok. */
920 if (c_func_cur->cacheGeneration != cif_cache_generation)
921 {
922 ffi_prep_cif (&c_func_cur->cacheCif, FFI_DEFAULT_ABI, totalArgs,
923 get_ffi_type (desc->returnTypeOOP),
924 c_func_cur->types);
925
926 /* For variadic functions, we cannot cache the ffi_cif because
927 the argument types change every time. */
928 if (!haveVariadic)
929 c_func_cur->cacheGeneration = cif_cache_generation;
930 }
931
932 errno = 0;
933 filledArgs = c_func_cur->arg_idx;
934 assert (filledArgs == totalArgs);
935 ffi_call (&c_func_cur->cacheCif, FFI_FN (funcAddr), &result.u, ffi_arg_vec);
936
937 _gst_set_errno (errno);
938 desc = (gst_c_callable) OOP_TO_OBJ (cFuncOOP);
939 oop = c_to_smalltalk (&result, receiver, desc->returnTypeOOP);
940 INC_ADD_OOP (oop);
941
942 out:
943 /* Fixup all returned string variables */
944 if (needPostprocessing)
945 for (i = 0, arg = local_arg_vec; i < filledArgs; i++, arg++)
946 {
947 if (!arg->oop)
948 continue;
949
950 switch (arg->cType)
951 {
952 case CDATA_COBJECT_PTR:
953 if (oop)
954 set_cobject_value (arg->oop, arg->u.cObjectPtrVal.ptrVal);
955 continue;
956
957 case CDATA_WSTRING_OUT:
958 if (oop)
959 _gst_set_oop_unicode_string (arg->oop, arg->u.ptrVal);
960 break;
961
962 case CDATA_STRING_OUT:
963 if (oop)
964 _gst_set_oopstring (arg->oop, arg->u.ptrVal);
965 break;
966
967 case CDATA_BYTEARRAY_OUT:
968 if (oop)
969 _gst_set_oop_bytes (arg->oop, arg->u.ptrVal);
970 break;
971
972 default:
973 break;
974 }
975
976 xfree (arg->u.ptrVal);
977 }
978
979 INC_RESTORE_POINTER (incPtr);
980 return (oop);
981 }
982
983 ffi_type *
get_ffi_type(OOP returnTypeOOP)984 get_ffi_type (OOP returnTypeOOP)
985 {
986 if (!IS_INT (returnTypeOOP))
987 return &ffi_type_pointer;
988
989 switch (TO_INT (returnTypeOOP))
990 {
991 case CDATA_OOP:
992 case CDATA_COBJECT:
993 case CDATA_COBJECT_PTR:
994 case CDATA_SYMBOL:
995 case CDATA_SYMBOL_OUT:
996 case CDATA_WSTRING:
997 case CDATA_WSTRING_OUT:
998 case CDATA_STRING:
999 case CDATA_STRING_OUT:
1000 case CDATA_BYTEARRAY:
1001 case CDATA_BYTEARRAY_OUT:
1002 default:
1003 return &ffi_type_pointer;
1004
1005 case CDATA_LONG:
1006 case CDATA_ULONG:
1007 #if LONG_MAX == 2147483647
1008 return &ffi_type_sint32;
1009 #else
1010 return &ffi_type_sint64;
1011 #endif
1012 case CDATA_LONGLONG:
1013 case CDATA_ULONGLONG:
1014 return &ffi_type_sint64;
1015
1016 case CDATA_VOID:
1017 case CDATA_INT:
1018 case CDATA_CHAR:
1019 case CDATA_SHORT:
1020 case CDATA_WCHAR:
1021 case CDATA_BOOLEAN:
1022 return &ffi_type_sint;
1023
1024 case CDATA_UINT:
1025 case CDATA_UCHAR:
1026 case CDATA_USHORT:
1027 return &ffi_type_uint;
1028
1029 case CDATA_FLOAT:
1030 return &ffi_type_float;
1031
1032 case CDATA_DOUBLE:
1033 return &ffi_type_double;
1034
1035 case CDATA_LONG_DOUBLE:
1036 return &ffi_type_longdouble;
1037
1038 case CDATA_VARIADIC:
1039 case CDATA_VARIADIC_OOP:
1040 case CDATA_SELF:
1041 case CDATA_SELF_OOP:
1042 case CDATA_UNKNOWN:
1043 /* TODO: less brutal */
1044 abort ();
1045 }
1046 }
1047
1048 ffi_type *
smalltalk_to_c(OOP oop,cparam * cp,cdata_type cType)1049 smalltalk_to_c (OOP oop,
1050 cparam *cp,
1051 cdata_type cType)
1052 {
1053 OOP class = OOP_INT_CLASS (oop);
1054
1055 if (cType == CDATA_UNKNOWN)
1056 cType =
1057 (oop == _gst_true_oop || oop == _gst_false_oop) ? CDATA_BOOLEAN :
1058 oop == _gst_nil_oop ? CDATA_COBJECT :
1059 class == _gst_char_class ? CDATA_CHAR :
1060 class == _gst_unicode_character_class ? CDATA_WCHAR :
1061 class == _gst_byte_array_class ? CDATA_BYTEARRAY :
1062 is_a_kind_of (class, _gst_integer_class) ? CDATA_LONG :
1063 is_a_kind_of (class, _gst_string_class) ? CDATA_STRING :
1064 is_a_kind_of (class, _gst_unicode_string_class) ? CDATA_WSTRING :
1065 is_a_kind_of (class, _gst_c_object_class) ? CDATA_COBJECT :
1066 is_a_kind_of (class, _gst_float_class) ? CDATA_DOUBLE :
1067 CDATA_OOP;
1068
1069 memset (cp, 0, sizeof (cparam));
1070 cp->cType = cType;
1071
1072 if (cType == CDATA_OOP)
1073 {
1074 cp->u.ptrVal = (PTR) oop;
1075 INC_ADD_OOP (oop); /* make sure it doesn't get gc'd */
1076 return &ffi_type_pointer;
1077 }
1078
1079 else if (is_a_kind_of (class, _gst_integer_class))
1080 {
1081 switch (cType)
1082 {
1083 case CDATA_LONGLONG:
1084 case CDATA_ULONGLONG:
1085 cp->u.longLongVal = to_c_int_64 (oop);
1086 return &ffi_type_sint64;
1087 case CDATA_LONG:
1088 case CDATA_ULONG:
1089 cp->u.longVal = TO_C_LONG (oop);
1090 #if LONG_MAX == 2147483647
1091 return &ffi_type_sint32;
1092 #else
1093 return &ffi_type_sint64;
1094 #endif
1095
1096 case CDATA_INT:
1097 cp->u.longVal = (int) TO_C_INT (oop);
1098 return &ffi_type_sint;
1099
1100 case CDATA_UINT:
1101 cp->u.longVal = (unsigned int) TO_C_INT (oop);
1102 return &ffi_type_sint;
1103
1104 case CDATA_CHAR:
1105 cp->u.longVal = (char) TO_C_INT (oop);
1106 return &ffi_type_sint;
1107
1108 case CDATA_UCHAR:
1109 cp->u.longVal = (unsigned char) TO_C_INT (oop);
1110 return &ffi_type_sint;
1111
1112 case CDATA_SHORT:
1113 cp->u.longVal = (short) TO_C_INT (oop);
1114 return &ffi_type_sint;
1115
1116 case CDATA_USHORT:
1117 cp->u.longVal = (unsigned short) TO_C_INT (oop);
1118 return &ffi_type_sint;
1119
1120 case CDATA_DOUBLE:
1121 cp->u.doubleVal = (double) TO_C_LONG (oop);
1122 return &ffi_type_double;
1123
1124 case CDATA_FLOAT:
1125 cp->u.floatVal = (float) TO_C_LONG (oop);
1126 return &ffi_type_float;
1127 }
1128 }
1129
1130 else if (oop == _gst_true_oop || oop == _gst_false_oop)
1131 {
1132 switch (cType)
1133 {
1134 case CDATA_LONGLONG:
1135 case CDATA_ULONGLONG:
1136 cp->u.longLongVal = (long long)(oop == _gst_true_oop);
1137 return &ffi_type_sint64;
1138 case CDATA_LONG:
1139 case CDATA_ULONG:
1140 cp->u.longVal = (oop == _gst_true_oop);
1141 #if LONG_MAX == 2147483647
1142 return &ffi_type_sint32;
1143 #else
1144 return &ffi_type_sint64;
1145 #endif
1146
1147 case CDATA_INT:
1148 case CDATA_UINT:
1149 case CDATA_CHAR:
1150 case CDATA_UCHAR:
1151 case CDATA_SHORT:
1152 case CDATA_USHORT:
1153 case CDATA_BOOLEAN:
1154 cp->u.longVal = (oop == _gst_true_oop);
1155 return &ffi_type_sint;
1156 }
1157 }
1158
1159 else if ((class == _gst_char_class
1160 && (cType == CDATA_CHAR || cType == CDATA_UCHAR || cType == CDATA_WCHAR))
1161 || (class == _gst_unicode_character_class && cType == CDATA_WCHAR))
1162 {
1163 cp->u.longVal = CHAR_OOP_VALUE (oop);
1164 return &ffi_type_sint;
1165 }
1166
1167 else if (((class == _gst_string_class || class == _gst_byte_array_class)
1168 && (cType == CDATA_STRING || cType == CDATA_STRING_OUT
1169 || cType == CDATA_BYTEARRAY || cType == CDATA_BYTEARRAY_OUT))
1170 || (class == _gst_symbol_class
1171 && (cType == CDATA_SYMBOL || cType == CDATA_STRING)))
1172 {
1173 cp->oop = oop;
1174
1175 if (cp->cType == CDATA_BYTEARRAY || cp->cType == CDATA_BYTEARRAY_OUT)
1176 cp->u.ptrVal = _gst_to_byte_array (oop);
1177 else
1178 cp->u.ptrVal = (gst_uchar *) _gst_to_cstring (oop);
1179
1180 return &ffi_type_pointer;
1181 }
1182
1183 else if (class == _gst_unicode_string_class
1184 && (cType == CDATA_WSTRING || cType == CDATA_WSTRING_OUT))
1185 {
1186 cp->oop = oop;
1187 cp->u.ptrVal = (gst_uchar *) _gst_to_wide_cstring (oop);
1188
1189 return &ffi_type_pointer;
1190 }
1191
1192 else if (is_a_kind_of (class, _gst_float_class))
1193 {
1194 switch (cType)
1195 {
1196 case CDATA_LONG_DOUBLE:
1197 cp->u.longDoubleVal = _gst_oop_to_float (oop);
1198 return &ffi_type_longdouble;
1199
1200 case CDATA_DOUBLE:
1201 cp->u.doubleVal = _gst_oop_to_float (oop);
1202 return &ffi_type_double;
1203
1204 case CDATA_FLOAT:
1205 cp->u.floatVal = (float) _gst_oop_to_float (oop);
1206 return &ffi_type_float;
1207 }
1208 }
1209
1210 else if (is_a_kind_of (class, _gst_c_object_class))
1211 {
1212 switch (cType)
1213 {
1214 case CDATA_COBJECT_PTR:
1215
1216 /* Set up an indirect pointer to protect against the OOP
1217 moving during the call-out. */
1218 cp->u.cObjectPtrVal.pPtrVal = &cp->u.cObjectPtrVal.ptrVal;
1219 cp->u.cObjectPtrVal.ptrVal = cobject_value (oop);
1220 cp->oop = oop;
1221 return &ffi_type_pointer;
1222
1223 case CDATA_COBJECT:
1224 cp->u.ptrVal = cobject_value (oop);
1225 return &ffi_type_pointer;
1226 }
1227 }
1228
1229 else if (class == _gst_undefined_object_class)
1230 { /* how to encode nil */
1231 switch (cType)
1232 {
1233 case CDATA_COBJECT_PTR:
1234 case CDATA_COBJECT:
1235 case CDATA_BYTEARRAY:
1236 case CDATA_BYTEARRAY_OUT:
1237 case CDATA_STRING:
1238 case CDATA_STRING_OUT:
1239 case CDATA_SYMBOL:
1240 cp->u.ptrVal = NULL;
1241 return &ffi_type_pointer;
1242 }
1243 }
1244
1245 /* #cObject can pass every object with non-pointer indexed instance
1246 variables. */
1247 if (cType == CDATA_COBJECT)
1248 {
1249 switch (CLASS_INSTANCE_SPEC (class) & ISP_INDEXEDVARS)
1250 {
1251 case GST_ISP_FIXED:
1252 case GST_ISP_POINTER:
1253 break;
1254
1255 default:
1256 /* Byte indexed variables, pass the pointer through. */
1257 cp->u.ptrVal = OOP_TO_OBJ (oop)->data + CLASS_FIXED_FIELDS (class);
1258 return &ffi_type_pointer;
1259 }
1260 }
1261
1262 bad_type (class, cType);
1263 return NULL;
1264 }
1265
1266 mst_Boolean
push_smalltalk_obj(OOP oop,cdata_type cType)1267 push_smalltalk_obj (OOP oop,
1268 cdata_type cType)
1269 {
1270 if (cType == CDATA_VARIADIC || cType == CDATA_VARIADIC_OOP)
1271 {
1272 int i;
1273 if (OOP_INT_CLASS (oop) != _gst_array_class)
1274 {
1275 bad_type (OOP_INT_CLASS (oop), cType);
1276 return false;
1277 }
1278
1279 cType = (cType == CDATA_VARIADIC) ? CDATA_UNKNOWN : CDATA_OOP;
1280 for (i = 1; i <= NUM_WORDS (OOP_TO_OBJ (oop)); i++)
1281 if (!push_smalltalk_obj (ARRAY_AT (oop, i), cType))
1282 return false;
1283 }
1284 else
1285 {
1286 cparam *cp = &c_func_cur->args[c_func_cur->arg_idx];
1287 ffi_type *type = smalltalk_to_c (oop, cp, cType);
1288 if (cp->oop && !IS_NIL (cp->oop))
1289 INC_ADD_OOP (cp->oop);
1290 if (type)
1291 c_func_cur->types[c_func_cur->arg_idx++] = type;
1292 else
1293 return false;
1294 }
1295
1296 return true;
1297 }
1298
1299 OOP
c_to_smalltalk(cparam * result,OOP receiverOOP,OOP returnTypeOOP)1300 c_to_smalltalk (cparam *result, OOP receiverOOP, OOP returnTypeOOP)
1301 {
1302 cdata_type returnType;
1303 OOP resultOOP;
1304
1305 if (IS_INT (returnTypeOOP))
1306 returnType = (cdata_type) TO_INT (returnTypeOOP);
1307 else
1308 returnType = CDATA_COBJECT;
1309
1310 switch (returnType)
1311 {
1312 case CDATA_VOID:
1313 resultOOP = receiverOOP;
1314 break;
1315
1316 case CDATA_CHAR:
1317 case CDATA_UCHAR:
1318 resultOOP = CHAR_OOP_AT ((gst_uchar) result->u.longVal);
1319 break;
1320
1321 case CDATA_WCHAR:
1322 resultOOP = char_new ((wchar_t) result->u.longVal);
1323 break;
1324
1325 case CDATA_BOOLEAN:
1326 resultOOP = result->u.longVal ? _gst_true_oop : _gst_false_oop;
1327 break;
1328
1329 case CDATA_INT:
1330 resultOOP = FROM_C_INT ((int) result->u.longVal);
1331 break;
1332
1333 case CDATA_UINT:
1334 resultOOP = FROM_C_UINT ((unsigned int) result->u.longVal);
1335 break;
1336
1337 case CDATA_SHORT:
1338 resultOOP = FROM_INT ((short) result->u.longVal);
1339 break;
1340
1341 case CDATA_USHORT:
1342 resultOOP = FROM_INT ((unsigned short) result->u.longVal);
1343 break;
1344
1345 case CDATA_LONG:
1346 resultOOP = FROM_C_LONG (result->u.longVal);
1347 break;
1348
1349 case CDATA_ULONG:
1350 resultOOP = FROM_C_ULONG (result->u.longVal);
1351 break;
1352
1353 case CDATA_LONGLONG:
1354 resultOOP = FROM_C_LONGLONG (result->u.longLongVal);
1355 break;
1356
1357 case CDATA_ULONGLONG:
1358 resultOOP = FROM_C_ULONGLONG (result->u.longLongVal);
1359 break;
1360
1361 case CDATA_STRING:
1362 case CDATA_STRING_OUT:
1363 case CDATA_WSTRING:
1364 case CDATA_WSTRING_OUT:
1365 case CDATA_SYMBOL:
1366 case CDATA_SYMBOL_OUT:
1367 case CDATA_COBJECT:
1368 case CDATA_OOP:
1369 if (!result->u.ptrVal)
1370 resultOOP = _gst_nil_oop;
1371 else if (returnType == CDATA_OOP)
1372 resultOOP = (OOP) result->u.ptrVal;
1373
1374 else if (returnType == CDATA_SYMBOL || returnType == CDATA_SYMBOL_OUT)
1375 {
1376 resultOOP = _gst_intern_string ((char *) result->u.ptrVal);
1377 if (returnType == CDATA_SYMBOL_OUT)
1378 xfree (result->u.ptrVal);
1379 }
1380 else if (returnType == CDATA_COBJECT)
1381 {
1382 if (IS_INT (returnTypeOOP))
1383 returnTypeOOP = _gst_nil_oop;
1384 resultOOP = COBJECT_NEW (result->u.ptrVal, returnTypeOOP,
1385 _gst_c_object_class);
1386 }
1387 else if (returnType == CDATA_STRING || returnType == CDATA_STRING_OUT)
1388 {
1389 resultOOP = _gst_string_new ((char *) result->u.ptrVal);
1390 if (returnType == CDATA_STRING_OUT)
1391 xfree (result->u.ptrVal);
1392 }
1393 else if (returnType == CDATA_WSTRING || returnType == CDATA_WSTRING_OUT)
1394 {
1395 resultOOP = _gst_unicode_string_new ((wchar_t *) result->u.ptrVal);
1396 if (returnType == CDATA_WSTRING_OUT)
1397 xfree (result->u.ptrVal);
1398 }
1399 else
1400 abort ();
1401 break;
1402
1403 case CDATA_DOUBLE:
1404 resultOOP = floatd_new (result->u.doubleVal);
1405 break;
1406
1407 case CDATA_FLOAT:
1408 resultOOP = floate_new (result->u.doubleVal);
1409 break;
1410
1411 default:
1412 _gst_errorf
1413 ("Invalid C function return type specified, index %d\n",
1414 returnType);
1415
1416 resultOOP = _gst_nil_oop;
1417 break;
1418 }
1419
1420 return resultOOP;
1421 }
1422
1423 void
bad_type(OOP class_oop,cdata_type cType)1424 bad_type (OOP class_oop,
1425 cdata_type cType)
1426 {
1427 if (IS_A_METACLASS (class_oop))
1428 _gst_errorf ("Attempt to pass the %O object as a %s", class_oop,
1429 c_type_name[cType]);
1430 else
1431 _gst_errorf ("Attempt to pass an instance of %O as a %s", class_oop,
1432 c_type_name[cType]);
1433 }
1434
1435
1436 /* This function does the unmarshaling of the libffi arguments to Smalltalk,
1437 and calls the block that is stored in the CCallbackDescriptor. */
1438
1439 static void
closure_msg_send(ffi_cif * cif,void * result,void ** args,void * userdata)1440 closure_msg_send (ffi_cif* cif, void* result, void** args, void* userdata)
1441 {
1442 gst_ffi_closure *closure = userdata;
1443 OOP callbackOOP = closure->callbackOOP;
1444 gst_c_callable desc;
1445 int numArgs, i;
1446 OOP *argsOOP, *argTypes, resultOOP;
1447 cdata_type cType;
1448 cparam cp;
1449
1450 desc = (gst_c_callable) OOP_TO_OBJ (callbackOOP);
1451 numArgs = NUM_INDEXABLE_FIELDS (desc->argTypesOOP);
1452 argsOOP = alloca (sizeof (OOP) * numArgs);
1453
1454 for (i = 0; i < numArgs; i++)
1455 {
1456 memcpy (&cp.u, args[i], sizeof (ffi_arg));
1457 desc = (gst_c_callable) OOP_TO_OBJ (callbackOOP);
1458 argTypes = OOP_TO_OBJ (desc->argTypesOOP)->data;
1459 argsOOP[i] = c_to_smalltalk (&cp, _gst_nil_oop, argTypes[i]);
1460 }
1461
1462 desc = (gst_c_callable) OOP_TO_OBJ (callbackOOP);
1463 resultOOP = _gst_nvmsg_send (desc->blockOOP, NULL, argsOOP, numArgs);
1464
1465 desc = (gst_c_callable) OOP_TO_OBJ (callbackOOP);
1466 cType = IS_OOP (desc->returnTypeOOP) ? CDATA_COBJECT : TO_INT (desc->returnTypeOOP);
1467 if (cType != CDATA_VOID && smalltalk_to_c (resultOOP, &cp, cType))
1468 memcpy (result, &cp.u, sizeof (ffi_arg));
1469 else
1470 memset (result, 0, sizeof (ffi_arg));
1471 }
1472
1473 void
_gst_make_closure(OOP callbackOOP)1474 _gst_make_closure (OOP callbackOOP)
1475 {
1476 gst_c_callable desc;
1477 OOP *argTypes;
1478 void *code;
1479 gst_ffi_closure *closure;
1480 int numArgs, i;
1481
1482 if (cobject_value (callbackOOP))
1483 return;
1484
1485 desc = (gst_c_callable) OOP_TO_OBJ (callbackOOP);
1486 numArgs = NUM_INDEXABLE_FIELDS (desc->argTypesOOP);
1487 argTypes = OOP_TO_OBJ (desc->argTypesOOP)->data;
1488 closure = (gst_ffi_closure *) ffi_closure_alloc (
1489 sizeof (gst_ffi_closure) + sizeof(ffi_type *) * (numArgs - 1), &code);
1490
1491 closure->address = closure;
1492 closure->callbackOOP = callbackOOP;
1493 closure->return_type = get_ffi_type (desc->returnTypeOOP);
1494 for (i = 0; i < numArgs; i++)
1495 closure->arg_types[i] = get_ffi_type (argTypes[i]);
1496
1497 ffi_prep_cif (&closure->cif, FFI_DEFAULT_ABI,
1498 numArgs, closure->return_type, closure->arg_types);
1499
1500 ffi_prep_closure_loc (&closure->closure, &closure->cif, closure_msg_send,
1501 closure, code);
1502 set_cobject_value (callbackOOP, code);
1503 }
1504
1505 void
_gst_free_closure(OOP callbackOOP)1506 _gst_free_closure (OOP callbackOOP)
1507 {
1508 gst_ffi_closure *exec_closure = cobject_value (callbackOOP);
1509 ffi_closure_free (exec_closure->address);
1510 set_cobject_value (callbackOOP, NULL);
1511 }
1512
1513 void
_gst_set_errno(int errnum)1514 _gst_set_errno(int errnum)
1515 {
1516 /* ENOTEMPTY and EEXIST are synonymous; some systems use one, and
1517 some use the other. We always uses EEXIST which is provided by all
1518 systems. */
1519
1520 #ifdef ENOTEMPTY
1521 _gst_errno = (errnum == ENOTEMPTY) ? EEXIST : errnum;
1522 #else
1523 _gst_errno = errnum;
1524 #endif
1525 }
1526
1527
1528 int
my_chown(const char * file,const char * user,const char * group)1529 my_chown (const char *file, const char *user, const char *group)
1530 {
1531 #if defined HAVE_CHOWN && defined HAVE_GETGRNAM && defined HAVE_GETPWNAM
1532 static char *save_user, *save_group;
1533 static uid_t save_uid;
1534 static gid_t save_gid;
1535 static int recursive_depth;
1536
1537 uid_t uid, gid;
1538 if (!file && !user && !group)
1539 {
1540 recursive_depth--;
1541 if (recursive_depth == 0)
1542 {
1543 #if defined HAVE_SETGROUPENT && defined HAVE_ENDGRENT
1544 endgrent ();
1545 #endif
1546 #if defined HAVE_SETPASSENT && defined HAVE_ENDPWENT
1547 endpwent ();
1548 #endif
1549 }
1550
1551 free (save_user);
1552 free (save_group);
1553 save_user = save_group = NULL;
1554 return 0;
1555 }
1556
1557 if (!file)
1558 {
1559 recursive_depth++;
1560 if (recursive_depth == 1)
1561 {
1562 #if defined HAVE_SETGROUPENT && defined HAVE_ENDGRENT
1563 setgroupent (1);
1564 #endif
1565 #if defined HAVE_SETPASSENT && defined HAVE_ENDPWENT
1566 setpassent (1);
1567 #endif
1568 }
1569 }
1570
1571 if (!user)
1572 uid = -1;
1573 else if (save_user && !strcmp (save_user, user))
1574 uid = save_uid;
1575 else
1576 {
1577 struct passwd *pw;
1578 pw = getpwnam (user);
1579 if (!pw)
1580 {
1581 errno = EINVAL;
1582 return -1;
1583 }
1584
1585 uid = pw->pw_uid;
1586 if (recursive_depth)
1587 {
1588 if (save_user)
1589 free (save_user);
1590 save_user = strdup (user);
1591 save_uid = uid;
1592 }
1593 }
1594
1595 if (!group)
1596 gid = -1;
1597 else if (save_group && !strcmp (save_group, group))
1598 gid = save_gid;
1599 else
1600 {
1601 struct group *gr;
1602 gr = getgrnam (group);
1603 if (!gr)
1604 {
1605 errno = EINVAL;
1606 return -1;
1607 }
1608
1609 gid = gr->gr_gid;
1610 if (recursive_depth)
1611 {
1612 if (save_group)
1613 free (save_group);
1614 save_group = strdup (group);
1615 save_gid = gid;
1616 }
1617 }
1618
1619 if (!file)
1620 return 0;
1621 else
1622 return chown (file, uid, gid);
1623 #else
1624 return 0;
1625 #endif
1626 }
1627
1628 /* TODO: check if this can be changed to an extern declaration and/or
1629 an AC_CHECK_DECLS test. */
1630
1631 int
my_symlink(const char * oldpath,const char * newpath)1632 my_symlink (const char* oldpath, const char* newpath)
1633 {
1634 return symlink (oldpath, newpath);
1635 }
1636
1637 char*
my_mkdtemp(char * template)1638 my_mkdtemp(char* template)
1639 {
1640 return mkdtemp(template);
1641 }
1642