- void *ptr;
-
- fun = Fcar(cbk_info);
- rtype = Fcar(Fcdr(cbk_info));
- argtypes = Fcar(Fcdr(Fcdr(cbk_info)));
-
- CHECK_LIST(argtypes);
-
- arg_buffer += 4; /* Skip return address */
- while (!NILP(argtypes)) {
- Lisp_Object result, ctype;
- int size;
-
- ctype = ffi_canonicalise_type(XCAR(argtypes));
- size = XINT(Fffi_size_of_type(ctype));
- if (EQ(ctype, Q_c_string)) {
- char *aptr = *(char**)arg_buffer;
- if (aptr)
- result = ffi_fetch_foreign(aptr, ctype);
- else
- result = Qnil;
- } else
- result = ffi_fetch_foreign(arg_buffer, ctype);
- /* Apply translators and put the result into alist */
- result = apply1(Findirect_function(Qffi_translate_from_foreign),
- list2(result, XCAR(argtypes)));
- alist = Fcons(result, alist);
- {
- int mask = 3;
- int sp = (size + mask) & ~mask;
- arg_buffer += (sp);
- }
- argtypes = XCDR(argtypes);
- }
- alist = Fnreverse(alist);
-
- /* Special case, we have no return value */
- if (EQ(rtype, Q_void)) {
- GCPRO3(fun, alist, rtype);
- apply1(fun, alist);
- UNGCPRO;
- return;
- }
-
- GCPRO5(fun, alist, rtype, retlo, foret);
- retlo = apply1(fun, alist);
- 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)) {
- UNGCPRO;
- {
- asm volatile ("fldl (%0)" :: "a" (ptr));
- }
- return;
- } else if (EQ(rtype, Q_float)) {
- UNGCPRO;
- {
- asm volatile ("flds (%0)" :: "a" (ptr));
- }
- return;
- } else {
- int iv;
-
- if (EQ(rtype, Q_byte) || EQ(rtype, Q_char))
- iv = *(char*)ptr;
- else if (EQ(rtype, Q_unsigned_byte) || EQ(rtype, Q_unsigned_char))
- iv = *(char unsigned*)ptr;
- else if (EQ(rtype, Q_short))
- iv = *(short*)ptr;
- else if (EQ(rtype, Q_unsigned_short))
- iv = *(unsigned short*)ptr;
- else
- iv = *(int*)ptr;
- UNGCPRO;
- {
- asm volatile ("movl %0,%%eax;" :: "r" (iv) : "%eax");
- }
- return;
- }
+ void *ptr;
+
+ fun = Fcar(cbk_info);
+ rtype = Fcar(Fcdr(cbk_info));
+ argtypes = Fcar(Fcdr(Fcdr(cbk_info)));
+
+ CHECK_LIST(argtypes);
+
+ arg_buffer += 4; /* Skip return address */
+ while (!NILP(argtypes)) {
+ Lisp_Object result, ctype;
+ int size;
+
+ ctype = ffi_canonicalise_type(XCAR(argtypes));
+ size = XINT(Fffi_size_of_type(ctype));
+ if (EQ(ctype, Qc_string)) {
+ char *aptr = *(char**)arg_buffer;
+ if (aptr)
+ result = ffi_fetch_foreign(aptr, ctype);
+ else
+ result = Qnil;
+ } else
+ result = ffi_fetch_foreign(arg_buffer, ctype);
+ /* Apply translators and put the result into alist */
+ result = apply1(Findirect_function(Qffi_translate_from_foreign),
+ list2(result, XCAR(argtypes)));
+ alist = Fcons(result, alist);
+ {
+ int mask = 3;
+ int sp = (size + mask) & ~mask;
+ arg_buffer += (sp);
+ }
+ argtypes = XCDR(argtypes);
+ }
+ alist = Fnreverse(alist);
+
+ /* Special case, we have no return value */
+ if (EQ(rtype, Qvoid)) {
+ GCPRO3(fun, alist, rtype);
+ apply1(fun, alist);
+ UNGCPRO;
+ return;
+ }
+
+ GCPRO5(fun, alist, rtype, retlo, foret);
+ retlo = apply1(fun, alist);
+ foret = Fmake_ffi_object(rtype, Qnil);
+ Fffi_store(foret, make_int(0), rtype, retlo);
+ ptr = (void*)XEFFIO(foret)->fop.ptr;
+ if (EQ(rtype, Qdouble)) {
+ UNGCPRO;
+ {
+ asm volatile ("fldl (%0)" :: "a" (ptr));
+ }
+ return;
+ } else if (EQ(rtype, Qfloat)) {
+ UNGCPRO;
+ {
+ asm volatile ("flds (%0)" :: "a" (ptr));
+ }
+ return;
+ } else {
+ int iv;
+
+ if (EQ(rtype, Qbyte) || EQ(rtype, Qchar))
+ iv = *(char*)ptr;
+ else if (EQ(rtype, Qunsigned_byte) || EQ(rtype, Qunsigned_char))
+ iv = *(char unsigned*)ptr;
+ else if (EQ(rtype, Qshort))
+ iv = *(short*)ptr;
+ else if (EQ(rtype, Qunsigned_short))
+ iv = *(unsigned short*)ptr;
+ else
+ iv = *(int*)ptr;
+ UNGCPRO;
+ {
+ asm volatile ("movl %0,%%eax;" :: "r" (iv) : "%eax");
+ }
+ return;
+ }