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

added extract/enter_bytevector

This commit is contained in:
marting 1999-11-04 16:06:25 +00:00
parent 88b21d81b5
commit ae648e1c59
4 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
c/external.c
View File

@ -877,6 +877,22 @@ s48_make_vector(int length, s48_value init)
return obj;
}
s48_value
s48_enter_byte_vector(char *bvec, int length)
{
s48_value obj = s48_allocate_stob(S48_STOBTYPE_BYTE_VECTOR, length);
memcpy(S48_UNSAFE_EXTRACT_BYTE_VECTOR(obj), bvec, length);
return obj;
}
char *
s48_extract_byte_vector(s48_value bvec)
{
S48_CHECK_BYTE_VECTOR(bvec);
return S48_UNSAFE_EXTRACT_BYTE_VECTOR(bvec);
}
s48_value
s48_make_byte_vector(int length)
{

6
c/scheme48.h
View File

@ -47,6 +47,8 @@ extern char * s48_extract_string(s48_value);
extern s48_value s48_enter_substring(char *, int);
extern s48_value s48_make_string(int, char);
extern s48_value s48_make_vector(int, s48_value);
extern s48_value s48_enter_byte_vector(char *, int);
extern char * s48_extract_byte_vector(s48_value);
extern s48_value s48_make_byte_vector(int);
extern s48_value s48_make_record(s48_value);
extern s48_value s48_make_weak_pointer(s48_value);
@ -192,6 +194,7 @@ extern void s48_raise_out_of_memory_error();
#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_BYTE_VECTOR(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argtype_error(v); } while (0)
@ -335,6 +338,8 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_PORT_HANDLER_OFFSET 0
#define S48_PORT_HANDLER(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 0))
#define S48_UNSAFE_PORT_HANDLER(x) (S48_STOB_REF((x), 0))
#define S48_SET_PORT_HANDLER(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 0, (v)))
#define S48_UNSAFE_SET_PORT_HANDLER(x, v) S48_STOB_SET((x), 0, (v))
#define S48_PORT_STATUS_OFFSET 1
#define S48_PORT_STATUS(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 1))
#define S48_UNSAFE_PORT_STATUS(x) (S48_STOB_REF((x), 1))
@ -412,6 +417,7 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_UNSAFE_BYTE_VECTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x))
#define S48_UNSAFE_STRING_LENGTH(x) (S48_STOB_BYTE_LENGTH(x) - 1)
#define S48_UNSAFE_EXTRACT_STRING(x) (S48_ADDRESS_AFTER_HEADER((x), char))
#define S48_UNSAFE_EXTRACT_BYTE_VECTOR(x) (S48_ADDRESS_AFTER_HEADER((x), char))
#define S48_EXTRACT_EXTERNAL_OBJECT(x, type) ((type *)(S48_ADDRESS_AFTER_HEADER(x, long)+1))
#define S48_RECORD_TYPE_RESUMER(x) S48_RECORD_REF((x), 0)

3
c/scheme48.h.in
View File

@ -41,6 +41,8 @@ extern char * s48_extract_string(s48_value);
extern s48_value s48_enter_substring(char *, int);
extern s48_value s48_make_string(int, char);
extern s48_value s48_make_vector(int, s48_value);
extern s48_value s48_enter_byte_vector(char *, int);
extern char * s48_extract_byte_vector(s48_value);
extern s48_value s48_make_byte_vector(int);
extern s48_value s48_make_record(s48_value);
extern s48_value s48_make_weak_pointer(s48_value);
@ -186,6 +188,7 @@ extern void s48_raise_out_of_memory_error();
#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_BYTE_VECTOR(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argtype_error(v); } while (0)

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

@ -194,7 +194,7 @@
(c-define "S48_UNSAFE_BYTE_VECTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x))")
(c-define "S48_UNSAFE_STRING_LENGTH(x) (S48_STOB_BYTE_LENGTH(x) - 1)")
(c-define "S48_UNSAFE_EXTRACT_STRING(x) (S48_ADDRESS_AFTER_HEADER((x), char))")
(c-define "S48_UNSAFE_EXTRACT_BYTE_VECTOR(x) (S48_ADDRESS_AFTER_HEADER((x), char))")
(c-define (string-append "S48_EXTRACT_EXTERNAL_OBJECT(x, type) "
"((type *)(S48_ADDRESS_AFTER_HEADER(x, long)+1))"))))