From 414206177f6478c3a396999e135dc8cd2f0bf6a6 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 24 Feb 2017 13:37:11 -0700 Subject: [PATCH] ffi: Require bytevectors instead of strings. --- doc/ffi/ffi.texinfo | 5 +- src/microcode/pruxffi.c | 156 +++++++++++++++++++--------------------- src/runtime/ffi.scm | 32 +++++---- 3 files changed, 95 insertions(+), 98 deletions(-) diff --git a/doc/ffi/ffi.texinfo b/doc/ffi/ffi.texinfo index fe232f9e3..aefe2b64e 100644 --- a/doc/ffi/ffi.texinfo +++ b/doc/ffi/ffi.texinfo @@ -196,8 +196,9 @@ evaluated in the syntax environment of such code. The @strong{@code{C-call}} syntax arranges to invoke a callout trampoline. Arguments to the trampoline can be integers, floats, -strings or aliens (non-heap pointers, to C data structures, -@pxref{Alien Data}). +bytevectors or aliens (non-heap pointers, to C data structures, +@pxref{Alien Data}). Note the Scheme strings must be converted to +bytevectors via the appropriate encoding procedure. @smallexample (let ((alien (make-alien '|GtkWidget|))) diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c index ec3a5994b..067b82c99 100644 --- a/src/microcode/pruxffi.c +++ b/src/microcode/pruxffi.c @@ -154,32 +154,43 @@ DEFINE_PRIMITIVE ("C-PEEK-POINTER", Prim_peek_pointer, 3, 3, 0) } } +SCM +char_pointer_to_bytevector (char *ptr) +{ + unsigned long n_bytes = strlen (ptr); + return (memory_to_bytevector ((n_bytes), (ptr))); +} + DEFINE_PRIMITIVE ("C-PEEK-CSTRING", Prim_peek_cstring, 2, 2, 0) { + /* Return a bytevector containing the bytes in a C (null-terminated) + string that starts at the address ALIEN+OFFSET. */ + PRIMITIVE_HEADER (2); - PRIMITIVE_RETURN (char_pointer_to_string (ALIEN_ADDRESS_LOC (char))); + PRIMITIVE_RETURN (char_pointer_to_bytevector (ALIEN_ADDRESS_LOC (char))); } DEFINE_PRIMITIVE ("C-PEEK-CSTRING!", Prim_peek_cstring_bang, 2, 2, 0) { - /* Return a Scheme string containing the characters in a C string - that starts at the address ALIEN+OFFSET. Set ALIEN to the - address of the C char after the string's null terminator. */ + /* Return a bytevector containing the bytes in a C (null-terminated) + string that starts at the address ALIEN+OFFSET. Set ALIEN to the + address of the char after the string's null terminator. */ PRIMITIVE_HEADER (2); { char * ptr = (ALIEN_ADDRESS_LOC (char)); - SCM string = (char_pointer_to_string (ptr)); - set_alien_address ((ARG_REF (1)), (ptr + strlen (ptr) + 1)); - PRIMITIVE_RETURN (string); + unsigned long n_bytes = (strlen (ptr)); + SCM v = (memory_to_bytevector (n_bytes, ptr)); + set_alien_address ((ARG_REF (1)), (ptr + n_bytes + 1)); + PRIMITIVE_RETURN (v); } } DEFINE_PRIMITIVE ("C-PEEK-CSTRINGP", Prim_peek_cstringp, 2, 2, 0) { /* Follow the pointer at the address ALIEN+OFFSET to a C string. - Copy the C string into the heap and return the new Scheme - string. If the pointer is null, return (). */ + Return a bytevector containing the bytes in the C (null- + terminated) string. If the pointer is null, return (). */ PRIMITIVE_HEADER (2); { @@ -190,7 +201,7 @@ DEFINE_PRIMITIVE ("C-PEEK-CSTRINGP", Prim_peek_cstringp, 2, 2, 0) } else { - PRIMITIVE_RETURN (char_pointer_to_string (*ptr)); + PRIMITIVE_RETURN (char_pointer_to_bytevector (*ptr)); } } } @@ -198,10 +209,10 @@ DEFINE_PRIMITIVE ("C-PEEK-CSTRINGP", Prim_peek_cstringp, 2, 2, 0) DEFINE_PRIMITIVE ("C-PEEK-CSTRINGP!", Prim_peek_cstringp_bang, 2, 2, 0) { /* Follow the pointer at the address ALIEN+OFFSET to a C string. - Set ALIEN to the address of the char pointer after ALIEN+OFFSET. - Copy the C string into the heap and return the new Scheme - string. If the pointer is null, return (). */ - + Return a bytevector containing the bytes in the C (null- + terminated) string. If the pointer is null, return (). If the + pointer is not null, set ALIEN to the address of the char pointer + after ALIEN+OFFSET. */ PRIMITIVE_HEADER (2); { char ** ptr = (ALIEN_ADDRESS_LOC (char *)); @@ -211,26 +222,25 @@ DEFINE_PRIMITIVE ("C-PEEK-CSTRINGP!", Prim_peek_cstringp_bang, 2, 2, 0) } else { - SCM string = char_pointer_to_string (*ptr); + SCM v = char_pointer_to_bytevector (*ptr); set_alien_address ((ARG_REF (1)), (ptr + 1)); /* No more aborts! */ - PRIMITIVE_RETURN (string); + PRIMITIVE_RETURN (v); } } } DEFINE_PRIMITIVE ("C-PEEK-BYTES", Prim_peek_bytes, 5, 5, 0) { - /* Copy, from ALIEN+OFFSET, COUNT bytes to STRING[START..]. */ + /* Copy, from ALIEN+OFFSET, COUNT bytes to BYTEVECTOR[START]. */ PRIMITIVE_HEADER (5); - CHECK_ARG (4, STRING_P); { - const void * src = (ALIEN_ADDRESS_LOC (void *)); + const void * src = (ALIEN_ADDRESS_LOC (void)); int count = (UNSIGNED_FIXNUM_ARG (3)); - SCM string = (ARG_REF (4)); - int index = arg_index_integer (5, (STRING_LENGTH (string))); - void * dest = STRING_LOC (string, index); - memcpy (dest, src, count); + unsigned long length; + uint8_t * dst = (arg_bytevector (4, (&length))); + int index = (arg_index_integer (5, (length - (count - 1)))); + memcpy ((dst + index), src, count); } PRIMITIVE_RETURN (UNSPECIFIC); } @@ -279,9 +289,9 @@ DEFINE_PRIMITIVE ("C-POKE-POINTER", Prim_poke_pointer, 3, 3, 0) DEFINE_PRIMITIVE ("C-POKE-POINTER!", Prim_poke_pointer_bang, 3, 3, 0) { - /* Set the pointer at address ALIEN+OFFSET to ADDRESS (an alien, - string, xstring or 0 for NULL). Set ALIEN to the address of the - pointer after ALIEN+OFFSET. */ + /* Set the pointer at address ALIEN+OFFSET to ADDRESS (an alien, or + 0 for NULL). Set ALIEN to the address of the pointer after + ALIEN+OFFSET. */ PRIMITIVE_HEADER (3); { @@ -294,51 +304,52 @@ DEFINE_PRIMITIVE ("C-POKE-POINTER!", Prim_poke_pointer_bang, 3, 3, 0) DEFINE_PRIMITIVE ("C-POKE-STRING", Prim_poke_string, 3, 3, 0) { - /* Copy into the C string at address ALIEN+OFFSET the Scheme STRING. - Assume STRING fits. Null terminate the C string. */ + /* Copy into the C string at address ALIEN+OFFSET the Scheme + BYTEVECTOR. Assume BYTEVECTOR fits. Null terminate the C + string. */ PRIMITIVE_HEADER (3); - CHECK_ARG (3, STRING_P); { - SCM string = (ARG_REF (3)); - strncpy ((ALIEN_ADDRESS_LOC (char)), - (STRING_POINTER (string)), - ((STRING_LENGTH (string)) + 1)); + char * dst = (ALIEN_ADDRESS_LOC (char)); + unsigned long len; + uint8_t * src = (arg_bytevector (3, (&len))); + memcpy (dst, src, len); + dst[len] = '\0'; } PRIMITIVE_RETURN (UNSPECIFIC); } DEFINE_PRIMITIVE ("C-POKE-STRING!", Prim_poke_string_bang, 3, 3, 0) { - /* Copy into the C string at address ALIEN+OFFSET the Scheme STRING. - Assume STRING fits. Null terminate the C string. Set ALIEN to - the address of the C char following the NULL terminator. */ + /* Copy into the C string at address ALIEN+OFFSET the Scheme + BYTEVECTOR. Assume BYTEVECTOR fits. Null terminate the C + string. Set ALIEN to the address of the C char following the + NULL terminator. */ PRIMITIVE_HEADER (3); - CHECK_ARG (3, STRING_P); { - char * ptr = (ALIEN_ADDRESS_LOC (char)); - SCM string = (ARG_REF (3)); - unsigned long n_chars = ((STRING_LENGTH (string)) + 1); - strncpy (ptr, (STRING_POINTER (string)), n_chars); - set_alien_address ((ARG_REF (1)), (ptr + n_chars)); + uint8_t * dst = (ALIEN_ADDRESS_LOC (uint8_t)); + unsigned long len; + uint8_t * src = (arg_bytevector (3, (&len))); + memcpy (dst, src, len); + dst[len] = '\0'; + set_alien_address ((ARG_REF (1)), (dst + len + 1)); } PRIMITIVE_RETURN (UNSPECIFIC); } DEFINE_PRIMITIVE ("C-POKE-BYTES", Prim_poke_bytes, 5, 5, 0) { - /* Copy to ALIEN+OFFSET COUNT bytes from STRING[START]. */ + /* Copy to ALIEN+OFFSET COUNT bytes from BYTEVECTOR[START]. */ PRIMITIVE_HEADER (5); - CHECK_ARG (4, STRING_P); { - void * dest = (ALIEN_ADDRESS_LOC (void *)); + uint8_t * dst = (ALIEN_ADDRESS_LOC (uint8_t)); int count = (UNSIGNED_FIXNUM_ARG (3)); - SCM string = (ARG_REF (4)); - int index = arg_index_integer (5, (STRING_LENGTH (string))); - const void * src = STRING_LOC (string, index); - memcpy (dest, src, count); + unsigned long length; + uint8_t * src = (arg_bytevector (4, (&length))); + int index = (arg_index_integer (5, (length - (count - 1)))); + memcpy ((dst + index), src, count); } PRIMITIVE_RETURN (UNSPECIFIC); } @@ -742,10 +753,10 @@ callback_run_handler (long callback_id, SCM arglist) stop_history (); Will_Push (STACK_ENV_EXTRA_SLOTS + 3); - STACK_PUSH (arglist); - STACK_PUSH (fixnum_id); - STACK_PUSH (handler); - PUSH_APPLY_FRAME_HEADER (2); + STACK_PUSH (arglist); + STACK_PUSH (fixnum_id); + STACK_PUSH (handler); + PUSH_APPLY_FRAME_HEADER (2); Pushed (); } @@ -824,20 +835,15 @@ arg_alien_entry (int argn) void * arg_pointer (int argn) { - /* Accept an alien, string, flovec, xstring handle (positive - integer), or zero (for a NULL pointer). */ + /* Accept an alien, bytevector, flovec, or zero (for a NULL pointer). */ SCM arg = ARG_REF (argn); if ((INTEGER_P (arg)) && (integer_zero_p (arg))) return ((void *)0); - if (STRING_P (arg)) - return ((void *) (STRING_POINTER (arg))); - if ((INTEGER_P (arg)) && (integer_to_ulong_p (arg))) + if (BYTEVECTOR_P (arg)) { - unsigned char * result = lookup_external_string (arg, NULL); - if (result == 0) - error_wrong_type_arg (argn); - return ((void *) result); + unsigned long len; + return ((void *) (arg_bytevector (argn, (&len)))); } if (is_alien (arg)) return (alien_address (arg)); @@ -1009,17 +1015,6 @@ pointer_value (void) if (integer_zero_p (value)) return (NULL); - /* NOT allowing a Scheme string (heap pointer!) into the toolkit. */ - if ((INTEGER_P (value)) && (integer_to_ulong_p (value))) - { - unsigned char * result = lookup_external_string (value, NULL); - if (result == 0) - { - outf_error_line ("\nWarning: Callback returned a bogus xstring."); - return (NULL); - } - return ((void *) result); - } if (is_alien (value)) return (alien_address (value)); @@ -1065,17 +1060,10 @@ DEFINE_PRIMITIVE ("OUTF-ERROR", Prim_outf_error, 1, 1, 0) PRIMITIVE_HEADER (1); { - SCM arg = ARG_REF (1); - if (STRING_P (arg)) - { - char * string = ((char *) STRING_LOC (arg, 0)); - outf_error ("%s", string); - outf_flush_error (); - } - else - { - error_wrong_type_arg (1); - } + unsigned long length; + char * string = ((char *)(arg_bytevector (1, (&length)))); + outf_error ("%.*s", ((int)length), string); + outf_flush_error (); PRIMITIVE_RETURN (UNSPECIFIC); } } diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm index 7c82be900..d03c93cf7 100644 --- a/src/runtime/ffi.scm +++ b/src/runtime/ffi.scm @@ -322,18 +322,20 @@ USA. ;; Like c-poke-pointer, but increments DEST by a pointer width. ((ucode-primitive c-poke-pointer! 3) dest 0 alien)) -(define (c-poke-string alien string) - ;; Copy STRING to the bytes at the ALIEN address. - (guarantee-string string 'C-POKE-STRING) - ((ucode-primitive c-poke-string 3) alien 0 string)) +(define (c-poke-string alien bytevector) + ;; Copy BYTEVECTOR and a terminating null byte to the ALIEN address. + (guarantee bytevector? bytevector 'C-POKE-STRING) + ((ucode-primitive c-poke-string 3) alien 0 bytevector)) -(define (c-poke-string! alien string) - ;; Like c-poke-string, but increments ALIEN by the null-terminated - ;; STRING length. - (guarantee-string string 'C-POKE-STRING) - ((ucode-primitive c-poke-string! 3) alien 0 string)) +(define (c-poke-string! alien bytevector) + ;; Like c-poke-string, but increments ALIEN past the terminating null byte. + (guarantee-string bytevector 'C-POKE-STRING!) + ((ucode-primitive c-poke-string! 3) alien 0 bytevector)) (define-integrable (c-poke-bytes alien offset count buffer start) + ;; Like c-poke-string, but does not add a terminating null byte, copying only + ;; COUNT bytes from BUFFER and starting at START. START+COUNT-1 must be a + ;; valid index into BUFFER. ((ucode-primitive c-poke-bytes 5) alien offset count buffer start)) (define (c-enum-name value enum-name constants) @@ -559,8 +561,14 @@ USA. (define (outf-error . objects) ((ucode-primitive outf-error 1) - (apply string-append - (map (lambda (o) (if (string? o) o (write-to-string o))) + (apply bytevector-append + (map (lambda (o) + (if (bytevector? o) + 0 + (string->utf8 + (if (string? o) + o + (write-to-string o))))) objects)))) (define (registered-callback-count) @@ -646,7 +654,7 @@ USA. (if %trace? (%outf-error . MSG))))) (define (tindent) - (make-legacy-string (* 2 (length calloutback-stack)) #\space)) + (make-string (* 2 (length calloutback-stack)) #\space)) (define (%outf-error . msg) (apply outf-error `("; ",@msg"\n"))) \ No newline at end of file -- 2.25.1