From ae648e1c592836a42cc36f8d03ac94efa7f9808d Mon Sep 17 00:00:00 2001 From: marting Date: Thu, 4 Nov 1999 16:06:25 +0000 Subject: [PATCH] added extract/enter_bytevector --- c/external.c | 16 ++++++++++++++++ c/scheme48.h | 6 ++++++ c/scheme48.h.in | 3 +++ scheme/link/generate-c-header.scm | 2 +- 4 files changed, 26 insertions(+), 1 deletion(-) diff --git a/c/external.c b/c/external.c index ffc0037..acad561 100644 --- a/c/external.c +++ b/c/external.c @@ -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) { diff --git a/c/scheme48.h b/c/scheme48.h index cc4e88d..d59bc0c 100644 --- a/c/scheme48.h +++ b/c/scheme48.h @@ -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) diff --git a/c/scheme48.h.in b/c/scheme48.h.in index 2d3e533..560786f 100644 --- a/c/scheme48.h.in +++ b/c/scheme48.h.in @@ -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) diff --git a/scheme/link/generate-c-header.scm b/scheme/link/generate-c-header.scm index b8e13a1..4fb441a 100644 --- a/scheme/link/generate-c-header.scm +++ b/scheme/link/generate-c-header.scm @@ -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))"))))