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

82
src/foreign/foreign.c
View File

@ -1733,17 +1733,17 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[])
if (basetype == 0) basetype = 1; /* int is the default type */ if (basetype == 0) basetype = 1; /* int is the default type */
/* don't assume anything, so it can be used to verify compiler assumptions */ /* don't assume anything, so it can be used to verify compiler assumptions */
/* (only forbid stuff that the compiler doesn't allow) */ /* (only forbid stuff that the compiler doesn't allow) */
#define RETSIZE(t) res=((stars==0)?sizeof(t):sizeof(t *)) # define RETSIZE(t) res=((stars==0)?sizeof(t):sizeof(t *))
switch (basetype) { switch (basetype) {
case 1: /* int */ case 1: /* int */
switch (intsize) { switch (intsize) {
case 0: RETSIZE(int); break; case 0: RETSIZE(int); break;
case 1: RETSIZE(long int); break; case 1: RETSIZE(long int); break;
#ifdef INT64_AS_LONG_LONG # ifdef INT64_AS_LONG_LONG
case 2: RETSIZE(_int64); break; /* MSVC doesn't allow 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; case 2: RETSIZE(long long int); break;
#endif # endif /* INT64_AS_LONG_LONG */
case -1: RETSIZE(short int); break; case -1: RETSIZE(short int); break;
} }
break; break;
@ -1768,7 +1768,7 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[])
scheme_signal_error(MYNAME": internal error (unexpected type %d)", scheme_signal_error(MYNAME": internal error (unexpected type %d)",
basetype); basetype);
} }
#undef RETSIZE # undef RETSIZE
return scheme_make_integer(res); return scheme_make_integer(res);
} }
#undef MYNAME #undef MYNAME
@ -2139,7 +2139,7 @@ static Scheme_Object *abs_sym;
/* (ptr-ref cpointer type [['abs] n]) -> the object at the given location */ /* (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 */ /* 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 /* 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. */ /* WARNING: there are *NO* checks at all, this is raw C level code. */
#define MYNAME "ptr-ref" #define MYNAME "ptr-ref"
static Scheme_Object *foreign_ptr_ref(int argc, Scheme_Object *argv[]) 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 */ /* (ptr-set! cpointer type [['abs] n] value) -> void */
/* n defaults to 0 which is the only value that should be used with ffi_objs */ /* 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 /* 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. */ /* WARNING: there are *NO* checks at all, this is raw C level code. */
#define MYNAME "ptr-set!" #define MYNAME "ptr-set!"
static Scheme_Object *foreign_ptr_set_bang(int argc, Scheme_Object *argv[]) 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) */ /* (make-sized-byte-string cpointer len) */
#define MYNAME "make-sized-byte-string" #define MYNAME "make-sized-byte-string"
static Scheme_Object *foreign_make_sized_byte_string(int argc, Scheme_Object *argv[]) 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.) */
{ {
/* 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; long len;
if (!SCHEME_FFIANYPTRP(argv[0])) if (!SCHEME_FFIANYPTRP(argv[0]))
scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv); scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv);
@ -2302,31 +2302,29 @@ void do_ptr_finalizer(void *p, void *finalizer)
/* unreachable, and it will get a new cpointer object that points to it. */ /* unreachable, and it will get a new cpointer object that points to it. */
/* (Only needed in cases where pointer aliases might be created.) */ /* (Only needed in cases where pointer aliases might be created.) */
/* /*
* defsymbols[pointer]
(defsymbols pointer) * cdefine[register-finalizer 2 3]{
(cdefine register-finalizer 2 3) * void *ptr, *old = NULL;
{ * int ptrsym = (argc == 3 && argv[2] == pointer_sym);
void *ptr, *old = NULL; * if (ptrsym) {
int ptrsym = (argc == 3 && argv[2] == pointer_sym); * if (!SCHEME_FFIANYPTRP(argv[0]))
if (ptrsym) { * scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv);
if (!SCHEME_FFIANYPTRP(argv[0])) * ptr = SCHEME_FFIANYPTR_VAL(argv[0]);
scheme_wrong_type(MYNAME, "cpointer", 0, argc, argv); * if (ptr == NULL)
ptr = SCHEME_FFIANYPTR_VAL(argv[0]); * scheme_wrong_type(MYNAME, "non-null-cpointer", 0, argc, argv);
if (ptr == NULL) * } else {
scheme_wrong_type(MYNAME, "non-null-cpointer", 0, argc, argv); * if (argc == 3)
} else { * scheme_wrong_type(MYNAME, "pointer-mode", 2, argc, argv);
if (argc == 3) * ptr = argv[0];
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);
if (!(SCHEME_FALSEP(argv[1]) || SCHEME_PROCP(argv[1]))) * scheme_register_finalizer
scheme_wrong_type(MYNAME, "procedure-or-false", 1, argc, argv); * (ptr, (ptrsym ? do_ptr_finalizer : do_scm_finalizer),
scheme_register_finalizer * argv[1], NULL, &old);
(ptr, (ptrsym ? do_ptr_finalizer : do_scm_finalizer), * return (old == NULL) ? scheme_false : (Scheme_Object*)old;
argv[1], NULL, &old); * }
return (old == NULL) ? scheme_false : (Scheme_Object*)old; */
}
*/
/*****************************************************************************/ /*****************************************************************************/
/* Calling foreign function objects */ /* Calling foreign function objects */
@ -2643,16 +2641,16 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
data->itypes = (argv[1]); data->itypes = (argv[1]);
data->otype = (argv[2]); data->otype = (argv[2]);
data->call_in_scheduler = (((argc > 4) && SCHEME_TRUEP(argv[4]))); data->call_in_scheduler = (((argc > 4) && SCHEME_TRUEP(argv[4])));
#ifdef MZ_PRECISE_GC # ifdef MZ_PRECISE_GC
{ {
/* put data in immobile, weak box */ /* put data in immobile, weak box */
void **tmp; void **tmp;
tmp = GC_malloc_immobile_box(GC_malloc_weak_box(data, NULL, 0)); tmp = GC_malloc_immobile_box(GC_malloc_weak_box(data, NULL, 0));
cl_cif_args->data = (struct immobile_box*)tmp; cl_cif_args->data = (struct immobile_box*)tmp;
} }
#else # else /* MZ_PRECISE_GC undefined */
cl_cif_args->data = (void*)data; 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)) if (ffi_prep_closure(cl, cif, &ffi_do_callback, (void*)(cl_cif_args->data))
!= FFI_OK) != FFI_OK)
scheme_signal_error scheme_signal_error
@ -2697,12 +2695,12 @@ void scheme_init_foreign(Scheme_Env *env)
ffi_obj_tag = scheme_make_type("<ffi-obj>"); ffi_obj_tag = scheme_make_type("<ffi-obj>");
ctype_tag = scheme_make_type("<ctype>"); ctype_tag = scheme_make_type("<ctype>");
ffi_callback_tag = scheme_make_type("<ffi-callback>"); ffi_callback_tag = scheme_make_type("<ffi-callback>");
#ifdef MZ_PRECISE_GC # ifdef MZ_PRECISE_GC
GC_register_traversers(ffi_lib_tag, ffi_lib_SIZE, ffi_lib_MARK, ffi_lib_FIXUP, 1, 0); GC_register_traversers(ffi_lib_tag, ffi_lib_SIZE, ffi_lib_MARK, ffi_lib_FIXUP, 1, 0);
GC_register_traversers(ffi_obj_tag, ffi_obj_SIZE, ffi_obj_MARK, ffi_obj_FIXUP, 1, 0); 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(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); 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); scheme_set_type_printer(ctype_tag, ctype_printer);
MZ_REGISTER_STATIC(opened_libs); MZ_REGISTER_STATIC(opened_libs);
opened_libs = scheme_make_hash_table(SCHEME_hash_string); 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_add_global("make-ctype",
scheme_make_prim_w_arity(foreign_make_ctype, "make-ctype", 3, 3), menv); scheme_make_prim_w_arity(foreign_make_ctype, "make-ctype", 3, 3), menv);
scheme_add_global("make-cstruct-type", 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_add_global("ffi-callback?",
scheme_make_prim_w_arity(foreign_ffi_callback_p, "ffi-callback?", 1, 1), menv); scheme_make_prim_w_arity(foreign_ffi_callback_p, "ffi-callback?", 1, 1), menv);
scheme_add_global("cpointer?", scheme_add_global("cpointer?",