}
}
+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);
{
}
else
{
- PRIMITIVE_RETURN (char_pointer_to_string (*ptr));
+ PRIMITIVE_RETURN (char_pointer_to_bytevector (*ptr));
}
}
}
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 *));
}
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);
}
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);
{
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);
}
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 ();
}
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));
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));
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);
}
}
;; 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)
(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)
(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
projects / mit-scheme.git / commitdiff