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