suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

yet more formattings

Browse Source 
svn: r14078
This commit is contained in:
Eli Barzilay 2009-03-12 18:59:37 +00:00
parent 3537435564
commit c20a9ab7a8
1 changed files with 41 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
src/foreign/foreign.c
View File

@ -1741,9 +1741,9 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[])
case 1: RETSIZE(long int); break;
# ifdef INT64_AS_LONG_LONG
case 2: RETSIZE(_int64); break; /* MSVC doesn't allow long long */
#else
# else /* INT64_AS_LONG_LONG undefined */
case 2: RETSIZE(long long int); break;
#endif
# endif /* INT64_AS_LONG_LONG */
case -1: RETSIZE(short int); break;
}
break;
@ -2139,7 +2139,7 @@ static Scheme_Object *abs_sym;
/* (ptr-ref cpointer type [['abs] n]) -> the object at the given location */
/* n defaults to 0 which is the only value that should be used with ffi_objs */
/* if n is given, an 'abs flag can precede it to make n be a byte offset rather
* than some multiple of sizeof(type). */
/* than some multiple of sizeof(type). */
/* WARNING: there are *NO* checks at all, this is raw C level code. */
#define MYNAME "ptr-ref"
static Scheme_Object *foreign_ptr_ref(int argc, Scheme_Object *argv[])
@ -2192,7 +2192,7 @@ static Scheme_Object *foreign_ptr_ref(int argc, Scheme_Object *argv[])
/* (ptr-set! cpointer type [['abs] n] value) -> void */
/* n defaults to 0 which is the only value that should be used with ffi_objs */
/* if n is given, an 'abs flag can precede it to make n be a byte offset rather
* than some multiple of sizeof(type). */
/* than some multiple of sizeof(type). */
/* WARNING: there are *NO* checks at all, this is raw C level code. */
#define MYNAME "ptr-set!"
static Scheme_Object *foreign_ptr_set_bang(int argc, Scheme_Object *argv[])
@ -2253,11 +2253,11 @@ static Scheme_Object *foreign_ptr_equal_p(int argc, Scheme_Object *argv[])
/* (make-sized-byte-string cpointer len) */
#define MYNAME "make-sized-byte-string"
static Scheme_Object *foreign_make_sized_byte_string(int argc, Scheme_Object *argv[])
{
/* Warning: no copying is done so it is possible to share string contents. */
/* Warning: if source ptr has a offset, resulting string object uses shifted
* pointer.
* (Should use real byte-strings with new version.) */
{
long len;
if (!SCHEME_FFIANYPTRP(argv[0]))
scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv);
@ -2302,30 +2302,28 @@ void do_ptr_finalizer(void *p, void *finalizer)
/* unreachable, and it will get a new cpointer object that points to it. */
/* (Only needed in cases where pointer aliases might be created.) */
/*
(defsymbols pointer)
(cdefine register-finalizer 2 3)
{
void *ptr, *old = NULL;
int ptrsym = (argc == 3 && argv[2] == pointer_sym);
if (ptrsym) {
if (!SCHEME_FFIANYPTRP(argv[0]))
scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv);
ptr = SCHEME_FFIANYPTR_VAL(argv[0]);
if (ptr == NULL)
scheme_wrong_type(MYNAME, "non-null-cpointer", 0, argc, argv);
} else {
if (argc == 3)
scheme_wrong_type(MYNAME, "pointer-mode", 2, argc, argv);
ptr = argv[0];
}
if (!(SCHEME_FALSEP(argv[1]) || SCHEME_PROCP(argv[1])))
scheme_wrong_type(MYNAME, "procedure-or-false", 1, argc, argv);
scheme_register_finalizer
(ptr, (ptrsym ? do_ptr_finalizer : do_scm_finalizer),
argv[1], NULL, &old);
return (old == NULL) ? scheme_false : (Scheme_Object*)old;
}
* defsymbols[pointer]
* cdefine[register-finalizer 2 3]{
* void *ptr, *old = NULL;
* int ptrsym = (argc == 3 && argv[2] == pointer_sym);
* if (ptrsym) {
* if (!SCHEME_FFIANYPTRP(argv[0]))
* scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv);
* ptr = SCHEME_FFIANYPTR_VAL(argv[0]);
* if (ptr == NULL)
* scheme_wrong_type(MYNAME, "non-null-cpointer", 0, argc, argv);
* } else {
* if (argc == 3)
* scheme_wrong_type(MYNAME, "pointer-mode", 2, argc, argv);
* ptr = argv[0];
* }
* if (!(SCHEME_FALSEP(argv[1]) || SCHEME_PROCP(argv[1])))
* scheme_wrong_type(MYNAME, "procedure-or-false", 1, argc, argv);
* scheme_register_finalizer
* (ptr, (ptrsym ? do_ptr_finalizer : do_scm_finalizer),
* argv[1], NULL, &old);
* return (old == NULL) ? scheme_false : (Scheme_Object*)old;
* }
*/
/*****************************************************************************/
@ -2650,9 +2648,9 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
tmp = GC_malloc_immobile_box(GC_malloc_weak_box(data, NULL, 0));
cl_cif_args->data = (struct immobile_box*)tmp;
}
#else
# else /* MZ_PRECISE_GC undefined */
cl_cif_args->data = (void*)data;
#endif
# endif /* MZ_PRECISE_GC */
if (ffi_prep_closure(cl, cif, &ffi_do_callback, (void*)(cl_cif_args->data))
!= FFI_OK)
scheme_signal_error
@ -2702,7 +2700,7 @@ void scheme_init_foreign(Scheme_Env *env)
GC_register_traversers(ffi_obj_tag, ffi_obj_SIZE, ffi_obj_MARK, ffi_obj_FIXUP, 1, 0);
GC_register_traversers(ctype_tag, ctype_SIZE, ctype_MARK, ctype_FIXUP, 1, 0);
GC_register_traversers(ffi_callback_tag, ffi_callback_SIZE, ffi_callback_MARK, ffi_callback_FIXUP, 1, 0);
#endif
# endif /* MZ_PRECISE_GC */
scheme_set_type_printer(ctype_tag, ctype_printer);
MZ_REGISTER_STATIC(opened_libs);
opened_libs = scheme_make_hash_table(SCHEME_hash_string);
@ -2757,7 +2755,7 @@ void scheme_init_foreign(Scheme_Env *env)
scheme_add_global("make-ctype",
scheme_make_prim_w_arity(foreign_make_ctype, "make-ctype", 3, 3), menv);
scheme_add_global("make-cstruct-type",
scheme_make_prim_w_arity(foreign_make_cstruct_type, "make-cstruct-type", 1, 1), menv);
scheme_make_prim_w_arity(foreign_make_cstruct_type, "make-cstruct-type", 1, 2), menv);
scheme_add_global("ffi-callback?",
scheme_make_prim_w_arity(foreign_ffi_callback_p, "ffi-callback?", 1, 1), menv);
scheme_add_global("cpointer?",