# define SIGNAL_ERROR signal_error
# define FFIBYTE Bufbyte
# define WRITE_C_STRING(x,y) write_c_string((x),(y))
+# define WRITE_FMT_STRING(x,y,...) write_fmt_string((x),(y),__VA_ARGS__)
# define LRECORD_DESCRIPTION lrecord_description
#else
# define SIGNAL_ERROR Fsignal
# define FFIBYTE Ibyte
# define WRITE_C_STRING(x,y) write_c_string((y),(x))
+# define WRITE_FMT_STRING(x,y,...) \
+ do { \
+ char wcsb[128]; \
+ int wcss = snprintf(wcsb, sizeof(wcsb), \
+ (y),__VA_ARGS__); \
+ write_c_string((y),wcsb); \
+ } while(0)
# define LRECORD_DESCRIPTION memory_description
#endif /* SXEMACS */
* pointer or (pointer TYPE)
*/
-/* Foreign types */
-Lisp_Object Q_byte, Q_unsigned_byte;
-Lisp_Object Q_char, Q_unsigned_char;
-Lisp_Object Q_short, Q_unsigned_short;
-Lisp_Object Q_int, Q_unsigned_int;
-Lisp_Object Q_long, Q_unsigned_long;
-Lisp_Object Q_float, Q_double;
-Lisp_Object Q_void;
-Lisp_Object Q_array, Q_pointer;
-Lisp_Object Q_union, Q_struct;
-Lisp_Object Q_function;
-Lisp_Object Q_c_string, Q_c_data;
-
-#define FFI_POINTERP(type) (EQ(type, Q_pointer) \
- || (CONSP(type) && EQ(XCAR(type), Q_pointer)))
-
-#define FFI_TPTR(type) (EQ(type, Q_c_string) \
- || EQ(type, Q_c_data) \
- || FFI_POINTERP(type) \
- || (CONSP(type) && ((EQ(XCAR(type), Q_c_data)) \
- || EQ(XCAR(type), Q_array))))
+/* Foreign types, not defined as symbols elsewhere. */
+Lisp_Object Qarray, Qbyte, Qc_data, Qc_string, Qdouble, Qlong, Qstruct;
+Lisp_Object Qunion, Qunsigned_byte, Qunsigned_char, Qunsigned_int;
+Lisp_Object Qunsigned_long, Qunsigned_short;
+
+#define FFI_POINTERP(type) (EQ(type, Qpointer) \
+ || (CONSP(type) && EQ(XCAR(type), Qpointer)))
+#define FFI_TPTR(type) (EQ(type, Qc_string) \
+ || EQ(type, Qc_data) \
+ || FFI_POINTERP(type) \
+ || (CONSP(type) && ((EQ(XCAR(type), Qc_data)) \
+ || EQ(XCAR(type), Qarray))))
Lisp_Object Qffiobjectp;
Lisp_Object Qffi_translate_to_foreign;
Lisp_Object Qffi_translate_from_foreign;
static Lisp_Object Vffi_all_objects;
-Lisp_Object Q_ffi_callback;
+Lisp_Object Qffi_callback;
static Lisp_Object
mark_ffiobject(Lisp_Object obj)
{
/* This function can GC */
Lisp_EffiObject *ffio = XEFFIO(obj);
- char buf[256];
-
escapeflag = escapeflag; /* shutup compiler */
if (print_readably) {
#ifdef SXEMACS
print_internal(ffio->type, printcharfun, 1);
WRITE_C_STRING(" ", printcharfun);
}
- snprintf(buf, 255, "size=%ld fotype=%d foptr=%p>",
- (long)XINT(ffio->size), ffio->fotype, ffio->fop.generic);
- WRITE_C_STRING(buf, printcharfun);
+ WRITE_FMT_STRING(printcharfun,"size=%ld fotype=%d foptr=%p>",
+ (long)XINT(ffio->size), ffio->fotype, ffio->fop.generic);
}
static const struct LRECORD_DESCRIPTION ffiobject_description[] = {
*/
(type))
{
- if (EQ(type, Q_byte) || EQ(type, Q_unsigned_byte) || EQ(type, Q_char)
- || EQ(type, Q_unsigned_char) || EQ(type, Q_short)
- || EQ(type, Q_unsigned_short) || EQ(type, Q_int)
- || EQ(type, Q_unsigned_int) || EQ(type, Q_long)
- || EQ(type, Q_unsigned_long) || EQ(type, Q_float)
- || EQ(type, Q_double) || EQ(type, Q_void)
- || EQ(type, Q_c_string) || EQ(type, Q_c_data)
- || (CONSP(type) && EQ(XCAR(type), Q_c_data)))
+ if (EQ(type, Qbyte) || EQ(type, Qunsigned_byte) || EQ(type, Qchar)
+ || EQ(type, Qunsigned_char) || EQ(type, Qshort)
+ || EQ(type, Qunsigned_short) || EQ(type, Qint)
+ || EQ(type, Qunsigned_int) || EQ(type, Qlong)
+ || EQ(type, Qunsigned_long) || EQ(type, Qfloat)
+ || EQ(type, Qdouble) || EQ(type, Qvoid)
+ || EQ(type, Qc_string) || EQ(type, Qc_data)
+ || (CONSP(type) && EQ(XCAR(type), Qc_data)))
return Qt;
else
return Qnil;
/* this function canNOT GC */
while (!NILP(type) && NILP(Fffi_basic_type_p(type)) && SYMBOLP(type)) {
- if EQ(type, Q_pointer)
+ if EQ(type, Qpointer)
break;
type = Fcdr(Fassq(type, Vffi_named_types));
}
int tsize;
type = ffi_canonicalise_type(type);
- if (EQ(type, Q_void))
+ if (EQ(type, Qvoid))
tsize = 0;
- else if (EQ(type, Q_byte))
+ else if (EQ(type, Qbyte))
tsize = sizeof(int8_t);
- else if (EQ(type, Q_unsigned_byte))
+ else if (EQ(type, Qunsigned_byte))
tsize = sizeof(uint8_t);
- else if (EQ(type, Q_char))
+ else if (EQ(type, Qchar))
tsize = sizeof(char);
- else if (EQ(type, Q_unsigned_char))
+ else if (EQ(type, Qunsigned_char))
tsize = sizeof(unsigned char);
- else if (EQ(type, Q_short))
+ else if (EQ(type, Qshort))
tsize = sizeof(short);
- else if (EQ(type, Q_unsigned_short))
+ else if (EQ(type, Qunsigned_short))
tsize = sizeof(unsigned short);
- else if (EQ(type, Q_int))
+ else if (EQ(type, Qint))
tsize = sizeof(int);
- else if (EQ(type, Q_unsigned_int))
+ else if (EQ(type, Qunsigned_int))
tsize = sizeof(unsigned int);
- else if (EQ(type, Q_long))
+ else if (EQ(type, Qlong))
tsize = sizeof(long);
- else if (EQ(type, Q_unsigned_long))
+ else if (EQ(type, Qunsigned_long))
tsize = sizeof(unsigned long);
- else if (EQ(type, Q_float))
+ else if (EQ(type, Qfloat))
tsize = sizeof(float);
- else if (EQ(type, Q_double))
+ else if (EQ(type, Qdouble))
tsize = sizeof(double);
- else if (EQ(type, Q_c_string))
+ else if (EQ(type, Qc_string))
tsize = sizeof(char *);
else if (FFI_POINTERP(type))
tsize = sizeof(void *);
- else if (EQ(type, Q_c_data))
+ else if (EQ(type, Qc_data))
tsize = sizeof(void *);
- else if (CONSP(type) && EQ(XCAR(type), Q_c_data)) {
+ else if (CONSP(type) && EQ(XCAR(type), Qc_data)) {
Lisp_Object cdsize = XCDR(type);
CHECK_INT(cdsize);
tsize = XINT(cdsize);
- } else if (CONSP(type) && EQ(XCAR(type), Q_function))
+ } else if (CONSP(type) && EQ(XCAR(type), Qfunction))
tsize = sizeof(void(*));
- else if (CONSP(type) && EQ(XCAR(type), Q_array)) {
+ else if (CONSP(type) && EQ(XCAR(type), Qarray)) {
Lisp_Object atype = Fcar(XCDR(type));
Lisp_Object asize = Fcar(Fcdr(XCDR(type)));
CHECK_INT(asize);
tsize = XINT(asize) * XINT(Fffi_size_of_type(atype));
- } else if (CONSP(type) && EQ(XCAR(type), Q_struct)) {
+ } else if (CONSP(type) && EQ(XCAR(type), Qstruct)) {
return Fffi_slot_offset(type, Qnil);
- } else if (CONSP(type) && EQ(XCAR(type), Q_union)) {
+ } else if (CONSP(type) && EQ(XCAR(type), Qunion)) {
Lisp_Object slots = Fcdr(XCDR(type));
CHECK_CONS(slots);
size = Fffi_size_of_type(type);
CHECK_INT(size);
- if (CONSP(ctype) && EQ(XCAR(ctype), Q_c_data) && INTP(XCDR(ctype)))
+ if (CONSP(ctype) && EQ(XCAR(ctype), Qc_data) && INTP(XCDR(ctype)))
size = XCDR(type);
- cs_or_cd = EQ(ctype, Q_c_string) || (EQ(ctype, Q_c_data));
+ cs_or_cd = EQ(ctype, Qc_string) || (EQ(ctype, Qc_data));
if ((cs_or_cd && (XINT(size) < 1))
|| (!(cs_or_cd || FFI_POINTERP(ctype))
&& (XINT(size) < XINT(Fffi_size_of_type(type)))))
#endif /* SXEMACS */
}
- ptr = Fmake_ffi_object(Q_pointer, Qnil);
+ ptr = Fmake_ffi_object(Qpointer, Qnil);
XEFFIO(ptr)->fop.ptr = (void*)addr;
return ptr;
}
return Qnil;
GCPRO1(fo);
- fo = Fmake_ffi_object(Q_pointer, Qnil);
+ fo = Fmake_ffi_object(Qpointer, Qnil);
ffio = XEFFIO(fo);
ffio->fotype = EFFI_FOT_BIND;
{
type = ffi_canonicalise_type(type);
if (SYMBOLP(type)) {
- if (EQ(type, Q_byte) || EQ(type, Q_unsigned_byte)
- || EQ(type, Q_char) || EQ(type, Q_unsigned_char))
+ if (EQ(type, Qbyte) || EQ(type, Qunsigned_byte)
+ || EQ(type, Qchar) || EQ(type, Qunsigned_char))
return 1;
- if (EQ(type, Q_short) || EQ(type, Q_unsigned_short))
+ if (EQ(type, Qshort) || EQ(type, Qunsigned_short))
return 2;
#ifdef FFI_MIPS
- if (EQ(type, Q_double))
+ if (EQ(type, Qdouble))
return 8;
#endif /* FFI_MIPS */
return 4;
/* NOT REACHED */
} else if (CONSP(type)
- && (EQ(XCAR(type), Q_struct) || EQ(XCAR(type), Q_union))) {
+ && (EQ(XCAR(type), Qstruct) || EQ(XCAR(type), Qunion))) {
int al;
for (al = 0, type = Fcdr(Fcdr(type));
/* this function canNOT GC */
Lisp_Object retval = Qnone;
- if (EQ(type, Q_char))
+ if (EQ(type, Qchar))
retval = make_char(*(char*)ptr);
- else if (EQ(type, Q_unsigned_char))
+ else if (EQ(type, Qunsigned_char))
retval = make_char(*(char unsigned*)ptr);
- else if (EQ(type, Q_byte))
+ else if (EQ(type, Qbyte))
retval = make_int(*(char*)ptr);
- else if (EQ(type, Q_unsigned_byte))
+ else if (EQ(type, Qunsigned_byte))
retval = make_int(*(unsigned char*)ptr);
- else if (EQ(type, Q_short))
+ else if (EQ(type, Qshort))
retval = make_int(*(short*)ptr);
- else if (EQ(type, Q_unsigned_short))
+ else if (EQ(type, Qunsigned_short))
retval = make_int(*(unsigned short*)ptr);
- else if (EQ(type, Q_int))
+ else if (EQ(type, Qint))
retval = make_int(*(int*)ptr);
- else if (EQ(type, Q_unsigned_int))
+ else if (EQ(type, Qunsigned_int))
retval = make_int(*(unsigned int*)ptr);
- else if (EQ(type, Q_long))
+ else if (EQ(type, Qlong))
retval = make_int(*(long*)ptr);
- else if (EQ(type, Q_unsigned_long))
+ else if (EQ(type, Qunsigned_long))
retval = make_int(*(unsigned long*)ptr);
- else if (EQ(type, Q_float))
+ else if (EQ(type, Qfloat))
retval = make_float(*(float*)ptr);
- else if (EQ(type, Q_double))
+ else if (EQ(type, Qdouble))
retval = make_float(*(double*)ptr);
- else if (EQ(type, Q_c_string)) {
+ else if (EQ(type, Qc_string)) {
retval = build_ext_string((char*)ptr, Qbinary);
- } else if (EQ(type, Q_void)) {
+ } else if (EQ(type, Qvoid)) {
retval = Qnil;
} else if (FFI_POINTERP(type)) {
retval = Fmake_ffi_object(type, Qnil);
XEFFIO(retval)->fop.ptr = *(void**)ptr;
- } else if (CONSP(type) && EQ(XCAR(type), Q_function)) {
+ } else if (CONSP(type) && EQ(XCAR(type), Qfunction)) {
retval = Fmake_ffi_object(type, Qnil);
XEFFIO(retval)->fop.fun = (void*)ptr;
XEFFIO(retval)->fotype = EFFI_FOT_FUNC;
retval = ffi_fetch_foreign(ptr, type);
if (EQ(retval, Qnone)) {
/* Special case for c-data */
- if (EQ(type, Q_c_data) ||
- (CONSP(type) && EQ(XCAR(type), Q_c_data)))
+ if (EQ(type, Qc_data) ||
+ (CONSP(type) && EQ(XCAR(type), Qc_data)))
{
size_t tlen;
- if (EQ(type, Q_c_data)) {
+ if (EQ(type, Qc_data)) {
tlen = ffio->storage_size - XINT(offset);
} else {
CHECK_INT(XCDR(type));
signal_error(Qinternal_error, "Not an array type", type);
#endif /* SXEMACS */
}
- if (EQ(type, Q_c_string))
- type = Q_char;
+ if (EQ(type, Qc_string))
+ type = Qchar;
else
type = Fcar(XCDR(type));
val = apply1(Findirect_function(Qffi_translate_to_foreign),
list2(val, origtype));
- if (EQ(val_type, Q_char) || EQ(val_type, Q_unsigned_char)) {
+ if (EQ(val_type, Qchar) || EQ(val_type, Qunsigned_char)) {
if (!CHARP(val)) {
SIGNAL_ERROR(Qwrong_type_argument,
list2(Qcharacterp, val));
}
*(char*)ptr = XCHAR(val);
- } else if (EQ(val_type, Q_byte) || EQ(val_type, Q_unsigned_byte)) {
+ } else if (EQ(val_type, Qbyte) || EQ(val_type, Qunsigned_byte)) {
if (!INTP(val)) {
SIGNAL_ERROR(Qwrong_type_argument,
list2(Qintegerp, val));
}
*(char*)ptr = XINT(val);
- } else if (EQ(val_type, Q_short) || EQ(val_type, Q_unsigned_short)) {
+ } else if (EQ(val_type, Qshort) || EQ(val_type, Qunsigned_short)) {
if (!INTP(val)) {
SIGNAL_ERROR(Qwrong_type_argument,
list2(Qintegerp, val));
}
*(short*)ptr = (short)XINT(val);
- } else if (EQ(val_type, Q_int) || EQ(val_type, Q_unsigned_int)) {
+ } else if (EQ(val_type, Qint) || EQ(val_type, Qunsigned_int)) {
if (INTP(val)) {
*(int*)ptr = XINT(val);
} else if (FLOATP(val)) {
SIGNAL_ERROR(Qwrong_type_argument,
list2(Qfloatp, val));
}
- } else if (EQ(val_type, Q_long) || EQ(val_type, Q_unsigned_long)) {
+ } else if (EQ(val_type, Qlong) || EQ(val_type, Qunsigned_long)) {
if (INTP(val)) {
*(long*)ptr = (long)XINT(val);
} else if (FLOATP(val)) {
} else {
SIGNAL_ERROR(Qwrong_type_argument, list2(Qfloatp, val));
}
- } else if (EQ(val_type, Q_float)) {
+ } else if (EQ(val_type, Qfloat)) {
if (!FLOATP(val))
SIGNAL_ERROR(Qwrong_type_argument, list2(Qfloatp, val));
*(float*)ptr = XFLOATINT(val);
- } else if (EQ(val_type, Q_double)) {
+ } else if (EQ(val_type, Qdouble)) {
if (!FLOATP(val))
SIGNAL_ERROR(Qwrong_type_argument, list2(Qfloatp, val));
*(double*)ptr = XFLOAT_DATA(val);
- } else if (EQ(val_type, Q_c_string)) {
- char *tmp;
+ } else if (EQ(val_type, Qc_string)) {
+ char *tmp = NULL;
int tmplen;
if (!STRINGP(val))
SIGNAL_ERROR(Qwrong_type_argument, list2(Qstringp, val));
#if defined(MULE)
TO_EXTERNAL_FORMAT(LISP_STRING, val,
ALLOCA, (tmp, tmplen), Qnil);
- memcpy((char*)ptr, tmp, tmplen + 1);
+ if ( tmp != NULL ) {
+ memcpy((char*)ptr, tmp, tmplen + 1);
+ }
#else
memcpy((char*)ptr,
(const char *)XSTRING_DATA(val),
XSTRING_LENGTH(val) + 1);
#endif
- } else if (EQ(val_type, Q_c_data) ||
+ } else if (EQ(val_type, Qc_data) ||
(CONSP(val_type) &&
- EQ(XCAR(val_type), Q_c_data) && INTP(XCDR(val_type)))) {
- char *val_ext;
+ EQ(XCAR(val_type), Qc_data) && INTP(XCDR(val_type)))) {
+ char *val_ext = NULL;
unsigned int val_ext_len;
if (!STRINGP(val))
SIGNAL_ERROR(Qwrong_type_argument, list2(Qstringp, val));
TO_EXTERNAL_FORMAT(LISP_STRING, val, ALLOCA,
(val_ext, val_ext_len), Qbinary);
- if (CONSP(val_type) && (val_ext_len > XINT(XCDR(val_type)))) {
+ if (val_ext == NULL ||
+ (CONSP(val_type) && (val_ext_len > XINT(XCDR(val_type))))) {
#ifdef SXEMACS
error("storage size too small");
#else
list2(Qstringp,
build_string("storage size too small")));
#endif /* SXEMACS */
+ } else {
+ memcpy((char*)ptr, (const char *)val_ext, val_ext_len);
}
- memcpy((char*)ptr, (const char *)val_ext, val_ext_len);
} else if (FFI_POINTERP(val_type)) {
if (!EFFIOP(val)) {
#ifdef SXEMACS
#endif /* SXEMACS */
}
*(void**)ptr = (void*)XEFFIO(val)->fop.ptr;
- } else if (CONSP(val_type) && EQ(XCAR(val_type), Q_struct)) {
+ } else if (CONSP(val_type) && EQ(XCAR(val_type), Qstruct)) {
if (!EFFIOP(val)) {
#ifdef SXEMACS
signal_simple_error("FFI: Value not FFI object", \
signal_error(Qinternal_error, "Not an array type", type);
#endif /* SXEMACS */
}
- if (EQ(type, Q_c_string))
- type = Q_char;
+ if (EQ(type, Qc_string))
+ type = Qchar;
else
type = Fcar(XCDR(type));
ffio = XEFFIO(fo);
GCPRO1(newfo);
- newfo = Fmake_ffi_object(Q_pointer, Qnil);
+ newfo = Fmake_ffi_object(Qpointer, Qnil);
newffio = XEFFIO(newfo);
newffio->fotype = EFFI_FOT_BIND;
GCPRO1(obj);
- newfo = Fmake_ffi_object(Q_pointer, Qnil);
+ newfo = Fmake_ffi_object(Qpointer, Qnil);
newffio = XEFFIO(newfo);
newffio->fotype = EFFI_FOT_BIND;
newffio->fop.ptr = (void*)obj;
extffi_setup_argument(Lisp_Object type, ffi_type **ft)
{
type = ffi_canonicalise_type(type);
- if (EQ(type, Q_char) || EQ(type, Q_byte))
+ if (EQ(type, Qchar) || EQ(type, Qbyte))
*ft = &ffi_type_schar;
- else if (EQ(type, Q_unsigned_char) || EQ(type, Q_unsigned_byte))
+ else if (EQ(type, Qunsigned_char) || EQ(type, Qunsigned_byte))
*ft = &ffi_type_uchar;
- else if (EQ(type, Q_short))
+ else if (EQ(type, Qshort))
*ft = &ffi_type_sshort;
- else if (EQ(type, Q_unsigned_short))
+ else if (EQ(type, Qunsigned_short))
*ft = &ffi_type_ushort;
- else if (EQ(type, Q_int))
+ else if (EQ(type, Qint))
*ft = &ffi_type_sint;
- else if (EQ(type, Q_unsigned_int))
+ else if (EQ(type, Qunsigned_int))
*ft = &ffi_type_uint;
- else if (EQ(type, Q_unsigned_long))
+ else if (EQ(type, Qunsigned_long))
*ft = &effi_type_ulong;
- else if (EQ(type, Q_long))
+ else if (EQ(type, Qlong))
*ft = &effi_type_slong;
- else if (EQ(type, Q_float))
+ else if (EQ(type, Qfloat))
*ft = &ffi_type_float;
- else if (EQ(type, Q_double))
+ else if (EQ(type, Qdouble))
*ft = &ffi_type_double;
- else if (EQ(type, Q_void))
+ else if (EQ(type, Qvoid))
*ft = &ffi_type_void;
else if (FFI_TPTR(type))
*ft = &ffi_type_pointer;
- else if (CONSP(type) && EQ(XCAR(type), Q_struct)) {
+ else if (CONSP(type) && EQ(XCAR(type), Qstruct)) {
Lisp_Object slots = Fcdr(XCDR(type));
ffi_type **ntypes;
int nt_size, i;
print_ffi_job(worker_job_t job, Lisp_Object pcf)
{
ffi_job_t ffij = ffi_job(job);
- char *str = alloca(64);
SXE_MUTEX_LOCK(&ffij->mtx);
- WRITE_C_STRING(" carrying ", pcf);
- snprintf(str, 63, " #<ffi-job 0x%lx>", (long unsigned int)ffij);
- WRITE_C_STRING(str, pcf);
+ WRITE_FMT_STRING(pcf, " carrying #<ffi-job 0x%lx>",
+ (long unsigned int)ffij);
SXE_MUTEX_UNLOCK(&ffij->mtx);
return;
}
#if HAVE_X_WINDOWS
Lisp_Object fo;
- fo = Fmake_ffi_object(Q_pointer, Qnil);
+ fo = Fmake_ffi_object(Qpointer, Qnil);
XEFFIO(fo)->fotype = EFFI_FOT_BIND;
XEFFIO(fo)->fop.ptr = (void*)DEVICE_X_DISPLAY(decode_x_device(device));
return fo;
ctype = ffi_canonicalise_type(XCAR(argtypes));
size = XINT(Fffi_size_of_type(ctype));
- if (EQ(ctype, Q_c_string)) {
+ if (EQ(ctype, Qc_string)) {
char *aptr = *(char**)arg_buffer;
if (aptr)
result = ffi_fetch_foreign(aptr, ctype);
alist = Fnreverse(alist);
/* Special case, we have no return value */
- if (EQ(rtype, Q_void)) {
+ if (EQ(rtype, Qvoid)) {
GCPRO3(fun, alist, rtype);
apply1(fun, alist);
UNGCPRO;
foret = Fmake_ffi_object(rtype, Qnil);
Fffi_store(foret, make_int(0), rtype, retlo);
ptr = (void*)XEFFIO(foret)->fop.ptr;
- if (EQ(rtype, Q_double)) {
+ if (EQ(rtype, Qdouble)) {
UNGCPRO;
{
asm volatile ("fldl (%0)" :: "a" (ptr));
}
return;
- } else if (EQ(rtype, Q_float)) {
+ } else if (EQ(rtype, Qfloat)) {
UNGCPRO;
{
asm volatile ("flds (%0)" :: "a" (ptr));
} else {
int iv;
- if (EQ(rtype, Q_byte) || EQ(rtype, Q_char))
+ if (EQ(rtype, Qbyte) || EQ(rtype, Qchar))
iv = *(char*)ptr;
- else if (EQ(rtype, Q_unsigned_byte) || EQ(rtype, Q_unsigned_char))
+ else if (EQ(rtype, Qunsigned_byte) || EQ(rtype, Qunsigned_char))
iv = *(char unsigned*)ptr;
- else if (EQ(rtype, Q_short))
+ else if (EQ(rtype, Qshort))
iv = *(short*)ptr;
- else if (EQ(rtype, Q_unsigned_short))
+ else if (EQ(rtype, Qunsigned_short))
iv = *(unsigned short*)ptr;
else
iv = *(int*)ptr;
data = list3(fun, rtype, argtypes);
/* Put data as property of the fun, so it(data) wont be GCed */
- Fput(fun, Q_ffi_callback, data);
- ptr = Fmake_ffi_object(Q_pointer, Qnil);
+ Fput(fun, Qffi_callback, data);
+ ptr = Fmake_ffi_object(Qpointer, Qnil);
#ifdef __i386__
XEFFIO(ptr)->fop.ptr = ffi_make_callback_x86(data, XINT(cctype));
#endif /* __i386__ */
{
INIT_LRECORD_IMPLEMENTATION(ffiobject);
- defsymbol(&Q_byte, "byte");
- defsymbol(&Q_unsigned_byte, "unsigned-byte");
- defsymbol(&Q_char, "char");
- defsymbol(&Q_unsigned_char, "unsigned-char");
- defsymbol(&Q_short, "short");
- defsymbol(&Q_unsigned_short, "unsigned-short");
- defsymbol(&Q_int, "int");
- defsymbol(&Q_unsigned_int, "unsigned-int");
- defsymbol(&Q_long, "long");
- defsymbol(&Q_unsigned_long, "unsigned-long");
- defsymbol(&Q_float, "float");
- defsymbol(&Q_double, "double");
- defsymbol(&Q_void, "void");
- defsymbol(&Q_pointer, "pointer");
- defsymbol(&Q_struct, "struct");
- defsymbol(&Q_union, "union");
- defsymbol(&Q_array, "array");
- defsymbol(&Q_function, "function");
- defsymbol(&Q_c_string, "c-string");
- defsymbol(&Q_c_data, "c-data");
-
- defsymbol(&Qffiobjectp, "ffiobjectp");
-
- defsymbol(&Qffi_translate_to_foreign, "ffi-translate-to-foreign");
- defsymbol(&Qffi_translate_from_foreign, "ffi-translate-from-foreign");
-
- defsymbol(&Q_ffi_callback, "ffi-callback");
+ DEFSYMBOL(Qarray);
+ DEFSYMBOL(Qbyte);
+ DEFSYMBOL(Qc_data);
+ DEFSYMBOL(Qc_string);
+ DEFSYMBOL(Qdouble);
+ DEFSYMBOL(Qlong);
+ DEFSYMBOL(Qstruct);
+ DEFSYMBOL(Qunion);
+ DEFSYMBOL(Qunsigned_byte);
+ DEFSYMBOL(Qunsigned_char);
+ DEFSYMBOL(Qunsigned_int);
+ DEFSYMBOL(Qunsigned_long);
+ DEFSYMBOL(Qunsigned_short);
+
+ /* ### This is broken, the lrecord needs to be called ffi_object,
+ and then this would be a DEFSYMBOL_MULTIWORD_PREDICATE(). Not
+ doing it in this commit, though. */
+ defsymbol(&Qffiobjectp, "ffi-object-p");
+
+ DEFSYMBOL(Qffi_translate_to_foreign);
+ DEFSYMBOL(Qffi_translate_from_foreign);
+
+ DEFSYMBOL(Qffi_callback);
DEFSUBR(Fffi_basic_type_p);
DEFSUBR(Fffi_canonicalise_type);
projects / sxemacs / blobdiff