scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Various bug fixes for byte-vectors.

This commit is contained in:
marting 2000-08-28 12:45:00 +00:00
parent 99ab68d3d9
commit dabbe8ca90
3 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
c/external.c
View File

@ -301,7 +301,7 @@ s48_call_scheme(s48_value proc, long nargs, ...)
/* It would be nice to push a list of the arguments, but we have no way /* It would be nice to push a list of the arguments, but we have no way
of preserving them across a cons. */ of preserving them across a cons. */
if (nargs < 0 || 10 < nargs) { /* DO NOT INCREASE THIS NUMBER */ if (nargs < 0 || 12 < nargs) { /* DO NOT INCREASE THIS NUMBER */
s48_value sch_nargs = s48_enter_integer(nargs); /* `proc' is protected */ s48_value sch_nargs = s48_enter_integer(nargs); /* `proc' is protected */
s48_raise_scheme_exception(S48_EXCEPTION_TOO_MANY_ARGUMENTS_IN_CALLBACK, s48_raise_scheme_exception(S48_EXCEPTION_TOO_MANY_ARGUMENTS_IN_CALLBACK,
2, proc, sch_nargs); 2, proc, sch_nargs);
@ -585,7 +585,7 @@ s48_stob_set(s48_value thing, int type, long offset, s48_value value)
} }
char char
s48_byte_ref(s48_value thing, int type, long offset) s48_stob_byte_ref(s48_value thing, int type, long offset)
{ {
long length; long length;
@ -605,7 +605,7 @@ s48_byte_ref(s48_value thing, int type, long offset)
} }
void void
s48_byte_set(s48_value thing, int type, long offset, char value) s48_stob_byte_set(s48_value thing, int type, long offset, char value)
{ {
long length; long length;
@ -894,9 +894,15 @@ s48_extract_byte_vector(s48_value bvec)
} }
s48_value s48_value
s48_make_byte_vector(int length) s48_make_byte_vector(int length, int init)
{ {
return s48_allocate_stob(S48_STOBTYPE_BYTE_VECTOR, length); int i;
s48_value obj = s48_allocate_stob(S48_STOBTYPE_BYTE_VECTOR, length);
for (i = 0; i < length; i++)
S48_BYTE_VECTOR_SET(obj, i, init);
return obj;
} }
s48_value s48_value

4
c/scheme48.h.in
View File

@ -43,7 +43,7 @@ extern s48_value s48_make_string(int, char);
extern s48_value s48_make_vector(int, s48_value); extern s48_value s48_make_vector(int, s48_value);
extern s48_value s48_enter_byte_vector(char *, int); extern s48_value s48_enter_byte_vector(char *, int);
extern char * s48_extract_byte_vector(s48_value); extern char * s48_extract_byte_vector(s48_value);
extern s48_value s48_make_byte_vector(int); extern s48_value s48_make_byte_vector(int, int);
extern s48_value s48_make_record(s48_value); extern s48_value s48_make_record(s48_value);
extern s48_value s48_make_weak_pointer(s48_value); extern s48_value s48_make_weak_pointer(s48_value);
extern void s48_check_record_type(s48_value, s48_value); extern void s48_check_record_type(s48_value, s48_value);
@ -60,7 +60,7 @@ extern s48_value s48_call_scheme(s48_value proc, long nargs, ...);
#define S48_EXPORT_FUNCTION(p) (s48_define_exported_binding(#p, s48_enter_pointer(p))) #define S48_EXPORT_FUNCTION(p) (s48_define_exported_binding(#p, s48_enter_pointer(p)))
#define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type))) #define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type),0))
extern void * s48_value_pointer(s48_value); extern void * s48_value_pointer(s48_value);
#define S48_EXTRACT_VALUE_POINTER(x, type) ((type *) s48_value_pointer(x)) #define S48_EXTRACT_VALUE_POINTER(x, type) ((type *) s48_value_pointer(x))

6
scheme/link/generate-c-header.scm
View File

@ -122,9 +122,9 @@
(c-define (string-append (c-define (string-append
"S48_STOB_BYTE_SET(x, i, v) " "S48_STOB_BYTE_SET(x, i, v) "
"do { " "do { "
"char __stob_set_x = (x); " "s48_value __stob_set_x = (x); "
"long __stob_set_i = (i); " "long __stob_set_i = (i); "
"s48_value __stob_set_v = (v); " "char __stob_set_v = (v); "
"if (S48_STOB_IMMUTABLEP(__stob_set_x)) " "if (S48_STOB_IMMUTABLEP(__stob_set_x)) "
"s48_raise_argtype_error(__stob_set_x); " "s48_raise_argtype_error(__stob_set_x); "
"else " "else "
@ -188,7 +188,7 @@
type type) type type)
(c-define "S48_UNSAFE_~A_REF(x, i) (S48_STOB_BYTE_REF((x), (i)))" (c-define "S48_UNSAFE_~A_REF(x, i) (S48_STOB_BYTE_REF((x), (i)))"
type) type)
(c-define "S48_UNSAFE_~A_SET(x, i, v) S48_BYTE_STOB_SET((x), (i), (v))" (c-define "S48_UNSAFE_~A_SET(x, i, v) S48_STOB_BYTE_SET((x), (i), (v))"
type)) type))
'("BYTE_VECTOR" "STRING")) '("BYTE_VECTOR" "STRING"))
(c-define "S48_UNSAFE_BYTE_VECTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x))") (c-define "S48_UNSAFE_BYTE_VECTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x))")