mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
Rewrite custom binary ports in Scheme, in terms of custom ports
* libguile/r6rs-ports.c: Call out to Scheme instead of defining here. * libguile/r6rs-ports.h: Put custom binary port decls together, to deprecate later. * module/ice-9/binary-ports.scm: Re-implement custom binary ports in terms of custom ports.
This commit is contained in:
Andy Wingo
parent
1852fbfef9
commit
0e305e6bfd
3 changed files with 142 additions and 340 deletions
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 2009-2011,2013-2015,2018-2019
|
||||
/* Copyright 2009-2011,2013-2015,2018-2019,2023
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -32,6 +32,7 @@
|
|||
#include "eval.h"
|
||||
#include "extensions.h"
|
||||
#include "gsubr.h"
|
||||
#include "modules.h"
|
||||
#include "numbers.h"
|
||||
#include "ports-internal.h"
|
||||
#include "procs.h"
|
||||
|
|
@ -194,179 +195,6 @@ SCM_DEFINE (scm_open_bytevector_input_port,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
|
||||
/* Custom binary ports. The following routines are shared by input and
|
||||
output custom binary ports. */
|
||||
|
||||
struct custom_binary_port {
|
||||
SCM read;
|
||||
SCM write;
|
||||
SCM get_position;
|
||||
SCM set_position_x;
|
||||
SCM close;
|
||||
};
|
||||
|
||||
static int
|
||||
custom_binary_port_random_access_p (SCM port)
|
||||
{
|
||||
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
|
||||
|
||||
return scm_is_true (stream->set_position_x);
|
||||
}
|
||||
|
||||
static scm_t_off
|
||||
custom_binary_port_seek (SCM port, scm_t_off offset, int whence)
|
||||
#define FUNC_NAME "custom_binary_port_seek"
|
||||
{
|
||||
SCM result;
|
||||
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
|
||||
scm_t_off c_result = 0;
|
||||
|
||||
switch (whence)
|
||||
{
|
||||
case SEEK_CUR:
|
||||
{
|
||||
if (SCM_LIKELY (scm_is_true (stream->get_position)))
|
||||
result = scm_call_0 (stream->get_position);
|
||||
else
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
|
||||
"R6RS custom binary port with "
|
||||
"`port-position' support");
|
||||
c_result = scm_to_off_t (result);
|
||||
if (offset == 0)
|
||||
/* We just want to know the current position. */
|
||||
break;
|
||||
|
||||
if (INT_ADD_OVERFLOW (offset, c_result))
|
||||
scm_num_overflow (FUNC_NAME);
|
||||
|
||||
offset += c_result;
|
||||
/* Fall through. */
|
||||
}
|
||||
|
||||
case SEEK_SET:
|
||||
{
|
||||
if (SCM_LIKELY (scm_is_true (stream->set_position_x)))
|
||||
result = scm_call_1 (stream->set_position_x, scm_from_off_t (offset));
|
||||
else
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
|
||||
"seekable R6RS custom binary port");
|
||||
|
||||
/* Assuming setting the position succeeded. */
|
||||
c_result = offset;
|
||||
break;
|
||||
}
|
||||
|
||||
default:
|
||||
/* `SEEK_END' cannot be supported. */
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
|
||||
"R6RS custom binary ports do not "
|
||||
"support `SEEK_END'");
|
||||
}
|
||||
|
||||
return c_result;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static void
|
||||
custom_binary_port_close (SCM port)
|
||||
{
|
||||
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
|
||||
|
||||
if (scm_is_true (stream->close))
|
||||
/* Invoke the `close' thunk. */
|
||||
scm_call_0 (stream->close);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/* Custom binary input ports. */
|
||||
|
||||
static scm_t_port_type *custom_binary_input_port_type = 0;
|
||||
|
||||
static inline SCM
|
||||
make_custom_binary_input_port (SCM read_proc, SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc)
|
||||
{
|
||||
struct custom_binary_port *stream;
|
||||
const unsigned long mode_bits = SCM_RDNG;
|
||||
|
||||
stream = scm_gc_typed_calloc (struct custom_binary_port);
|
||||
stream->read = read_proc;
|
||||
stream->write = SCM_BOOL_F;
|
||||
stream->get_position = get_position_proc;
|
||||
stream->set_position_x = set_position_proc;
|
||||
stream->close = close_proc;
|
||||
|
||||
return scm_c_make_port_with_encoding (custom_binary_input_port_type,
|
||||
mode_bits,
|
||||
sym_ISO_8859_1, sym_error,
|
||||
(scm_t_bits) stream);
|
||||
}
|
||||
|
||||
static size_t
|
||||
custom_binary_input_port_read (SCM port, SCM dst, size_t start, size_t count)
|
||||
#define FUNC_NAME "custom_binary_input_port_read"
|
||||
{
|
||||
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
|
||||
SCM octets;
|
||||
size_t c_octets;
|
||||
|
||||
octets = scm_call_3 (stream->read, dst, scm_from_size_t (start),
|
||||
scm_from_size_t (count));
|
||||
c_octets = scm_to_size_t (octets);
|
||||
if (c_octets > count)
|
||||
scm_out_of_range (FUNC_NAME, octets);
|
||||
|
||||
return c_octets;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_make_custom_binary_input_port,
|
||||
"make-custom-binary-input-port", 5, 0, 0,
|
||||
(SCM id, SCM read_proc, SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc),
|
||||
"Return a new custom binary input port whose input is drained "
|
||||
"by invoking @var{read_proc} and passing it a bytevector, an "
|
||||
"index where octets should be written, and an octet count.")
|
||||
#define FUNC_NAME s_scm_make_custom_binary_input_port
|
||||
{
|
||||
SCM_VALIDATE_STRING (1, id);
|
||||
SCM_VALIDATE_PROC (2, read_proc);
|
||||
|
||||
if (!scm_is_false (get_position_proc))
|
||||
SCM_VALIDATE_PROC (3, get_position_proc);
|
||||
|
||||
if (!scm_is_false (set_position_proc))
|
||||
SCM_VALIDATE_PROC (4, set_position_proc);
|
||||
|
||||
if (!scm_is_false (close_proc))
|
||||
SCM_VALIDATE_PROC (5, close_proc);
|
||||
|
||||
return make_custom_binary_input_port (read_proc, get_position_proc,
|
||||
set_position_proc, close_proc);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
/* Instantiate the custom binary input port type. */
|
||||
static inline void
|
||||
initialize_custom_binary_input_ports (void)
|
||||
{
|
||||
custom_binary_input_port_type =
|
||||
scm_make_port_type ("r6rs-custom-binary-input-port",
|
||||
custom_binary_input_port_read, NULL);
|
||||
|
||||
scm_set_port_seek (custom_binary_input_port_type, custom_binary_port_seek);
|
||||
scm_set_port_random_access_p (custom_binary_input_port_type,
|
||||
custom_binary_port_random_access_p);
|
||||
scm_set_port_close (custom_binary_input_port_type, custom_binary_port_close);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/* Binary input. */
|
||||
|
|
@ -941,169 +769,35 @@ initialize_bytevector_output_ports (void)
|
|||
|
||||
|
||||
|
||||
/* Custom binary output ports. */
|
||||
/* Custom ports. */
|
||||
|
||||
static scm_t_port_type *custom_binary_output_port_type;
|
||||
|
||||
|
||||
static inline SCM
|
||||
make_custom_binary_output_port (SCM write_proc, SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc)
|
||||
{
|
||||
struct custom_binary_port *stream;
|
||||
const unsigned long mode_bits = SCM_WRTNG;
|
||||
|
||||
stream = scm_gc_typed_calloc (struct custom_binary_port);
|
||||
stream->read = SCM_BOOL_F;
|
||||
stream->write = write_proc;
|
||||
stream->get_position = get_position_proc;
|
||||
stream->set_position_x = set_position_proc;
|
||||
stream->close = close_proc;
|
||||
|
||||
return scm_c_make_port_with_encoding (custom_binary_output_port_type,
|
||||
mode_bits,
|
||||
sym_ISO_8859_1, sym_error,
|
||||
(scm_t_bits) stream);
|
||||
SCM scm_make_custom_binary_input_port (SCM id, SCM read_proc,
|
||||
SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc) {
|
||||
return scm_call_5 (scm_c_public_ref ("ice-9 binary-ports",
|
||||
"make-custom-binary-input-port"),
|
||||
id, read_proc, get_position_proc, set_position_proc,
|
||||
close_proc);
|
||||
}
|
||||
|
||||
/* Flush octets from BUF to the backing store. */
|
||||
static size_t
|
||||
custom_binary_output_port_write (SCM port, SCM src, size_t start, size_t count)
|
||||
#define FUNC_NAME "custom_binary_output_port_write"
|
||||
{
|
||||
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
|
||||
size_t written;
|
||||
SCM result;
|
||||
|
||||
result = scm_call_3 (stream->write, src, scm_from_size_t (start),
|
||||
scm_from_size_t (count));
|
||||
|
||||
written = scm_to_size_t (result);
|
||||
if (written > count)
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
|
||||
"R6RS custom binary output port `write!' "
|
||||
"returned a incorrect integer");
|
||||
|
||||
return written;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_make_custom_binary_output_port,
|
||||
"make-custom-binary-output-port", 5, 0, 0,
|
||||
(SCM id, SCM write_proc, SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc),
|
||||
"Return a new custom binary output port whose output is drained "
|
||||
"by invoking @var{write_proc} and passing it a bytevector, an "
|
||||
"index where octets should be written, and an octet count.")
|
||||
#define FUNC_NAME s_scm_make_custom_binary_output_port
|
||||
{
|
||||
SCM_VALIDATE_STRING (1, id);
|
||||
SCM_VALIDATE_PROC (2, write_proc);
|
||||
|
||||
if (!scm_is_false (get_position_proc))
|
||||
SCM_VALIDATE_PROC (3, get_position_proc);
|
||||
|
||||
if (!scm_is_false (set_position_proc))
|
||||
SCM_VALIDATE_PROC (4, set_position_proc);
|
||||
|
||||
if (!scm_is_false (close_proc))
|
||||
SCM_VALIDATE_PROC (5, close_proc);
|
||||
|
||||
return make_custom_binary_output_port (write_proc, get_position_proc,
|
||||
set_position_proc, close_proc);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
/* Instantiate the custom binary output port type. */
|
||||
static inline void
|
||||
initialize_custom_binary_output_ports (void)
|
||||
{
|
||||
custom_binary_output_port_type =
|
||||
scm_make_port_type ("r6rs-custom-binary-output-port",
|
||||
NULL, custom_binary_output_port_write);
|
||||
|
||||
scm_set_port_seek (custom_binary_output_port_type, custom_binary_port_seek);
|
||||
scm_set_port_random_access_p (custom_binary_output_port_type,
|
||||
custom_binary_port_random_access_p);
|
||||
scm_set_port_close (custom_binary_output_port_type, custom_binary_port_close);
|
||||
SCM scm_make_custom_binary_output_port (SCM id, SCM write_proc,
|
||||
SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc) {
|
||||
return scm_call_5 (scm_c_public_ref ("ice-9 binary-ports",
|
||||
"make-custom-binary-output-port"),
|
||||
id, write_proc, get_position_proc, set_position_proc,
|
||||
close_proc);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/* Custom binary input_output ports. */
|
||||
|
||||
static scm_t_port_type *custom_binary_input_output_port_type;
|
||||
|
||||
|
||||
static inline SCM
|
||||
make_custom_binary_input_output_port (SCM read_proc, SCM write_proc,
|
||||
SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc)
|
||||
{
|
||||
struct custom_binary_port *stream;
|
||||
const unsigned long mode_bits = SCM_WRTNG | SCM_RDNG;
|
||||
|
||||
stream = scm_gc_typed_calloc (struct custom_binary_port);
|
||||
stream->read = read_proc;
|
||||
stream->write = write_proc;
|
||||
stream->get_position = get_position_proc;
|
||||
stream->set_position_x = set_position_proc;
|
||||
stream->close = close_proc;
|
||||
|
||||
return scm_c_make_port_with_encoding (custom_binary_input_output_port_type,
|
||||
mode_bits, sym_ISO_8859_1, sym_error,
|
||||
(scm_t_bits) stream);
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_make_custom_binary_input_output_port,
|
||||
"make-custom-binary-input/output-port", 6, 0, 0,
|
||||
(SCM id, SCM read_proc, SCM write_proc, SCM get_position_proc,
|
||||
SCM set_position_proc, SCM close_proc),
|
||||
"Return a new custom binary input/output port. The port's input\n"
|
||||
"is drained by invoking @var{read_proc} and passing it a\n"
|
||||
"bytevector, an index where octets should be written, and an\n"
|
||||
"octet count. The output is drained by invoking @var{write_proc}\n"
|
||||
"and passing it a bytevector, an index where octets should be\n"
|
||||
"written, and an octet count.")
|
||||
#define FUNC_NAME s_scm_make_custom_binary_input_output_port
|
||||
{
|
||||
SCM_VALIDATE_STRING (1, id);
|
||||
SCM_VALIDATE_PROC (2, read_proc);
|
||||
SCM_VALIDATE_PROC (3, write_proc);
|
||||
|
||||
if (!scm_is_false (get_position_proc))
|
||||
SCM_VALIDATE_PROC (4, get_position_proc);
|
||||
|
||||
if (!scm_is_false (set_position_proc))
|
||||
SCM_VALIDATE_PROC (5, set_position_proc);
|
||||
|
||||
if (!scm_is_false (close_proc))
|
||||
SCM_VALIDATE_PROC (6, close_proc);
|
||||
|
||||
return make_custom_binary_input_output_port
|
||||
(read_proc, write_proc, get_position_proc, set_position_proc, close_proc);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
/* Instantiate the custom binary input_output port type. */
|
||||
static inline void
|
||||
initialize_custom_binary_input_output_ports (void)
|
||||
{
|
||||
custom_binary_input_output_port_type =
|
||||
scm_make_port_type ("r6rs-custom-binary-input/output-port",
|
||||
custom_binary_input_port_read,
|
||||
custom_binary_output_port_write);
|
||||
|
||||
scm_set_port_seek (custom_binary_input_output_port_type,
|
||||
custom_binary_port_seek);
|
||||
scm_set_port_random_access_p (custom_binary_input_output_port_type,
|
||||
custom_binary_port_random_access_p);
|
||||
scm_set_port_close (custom_binary_input_output_port_type,
|
||||
custom_binary_port_close);
|
||||
SCM scm_make_custom_binary_input_output_port (SCM id, SCM read_proc,
|
||||
SCM write_proc,
|
||||
SCM get_position_proc,
|
||||
SCM set_position_proc,
|
||||
SCM close_proc) {
|
||||
return scm_call_6 (scm_c_public_ref ("ice-9 binary-ports",
|
||||
"make-custom-binary-input/output-port"),
|
||||
id, read_proc, write_proc, get_position_proc,
|
||||
set_position_proc, close_proc);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1234,10 +928,7 @@ scm_register_r6rs_ports (void)
|
|||
NULL);
|
||||
|
||||
initialize_bytevector_input_ports ();
|
||||
initialize_custom_binary_input_ports ();
|
||||
initialize_bytevector_output_ports ();
|
||||
initialize_custom_binary_output_ports ();
|
||||
initialize_custom_binary_input_output_ports ();
|
||||
initialize_transcoded_ports ();
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_R6RS_PORTS_H
|
||||
#define SCM_R6RS_PORTS_H
|
||||
|
||||
/* Copyright 2009-2011,2013,2018-2019
|
||||
/* Copyright 2009-2011,2013,2018-2019,2023
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -28,7 +28,6 @@
|
|||
|
||||
SCM_API SCM scm_eof_object (void);
|
||||
SCM_API SCM scm_open_bytevector_input_port (SCM, SCM);
|
||||
SCM_API SCM scm_make_custom_binary_input_port (SCM, SCM, SCM, SCM, SCM);
|
||||
SCM_API SCM scm_get_u8 (SCM);
|
||||
SCM_API SCM scm_lookahead_u8 (SCM);
|
||||
SCM_API SCM scm_get_bytevector_n (SCM, SCM);
|
||||
|
|
@ -38,9 +37,12 @@ SCM_API SCM scm_get_bytevector_all (SCM);
|
|||
SCM_API SCM scm_put_u8 (SCM, SCM);
|
||||
SCM_API SCM scm_put_bytevector (SCM, SCM, SCM, SCM);
|
||||
SCM_API SCM scm_open_bytevector_output_port (SCM);
|
||||
|
||||
SCM_API SCM scm_make_custom_binary_input_port (SCM, SCM, SCM, SCM, SCM);
|
||||
SCM_API SCM scm_make_custom_binary_output_port (SCM, SCM, SCM, SCM, SCM);
|
||||
SCM_API SCM scm_make_custom_binary_input_output_port (SCM, SCM, SCM,
|
||||
SCM, SCM, SCM);
|
||||
|
||||
SCM_API SCM scm_get_string_n_x (SCM, SCM, SCM, SCM);
|
||||
|
||||
SCM_API void scm_init_r6rs_ports (void);
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; binary-ports.scm --- Binary IO on ports
|
||||
;;; Copyright (C) 2009-2011,2013,2016,2019,2021 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2009-2011,2013,2016,2019,2021,2023 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software: you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU Lesser General Public License as
|
||||
|
|
@ -27,9 +27,11 @@
|
|||
|
||||
(define-module (ice-9 binary-ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 custom-ports)
|
||||
#:export (eof-object
|
||||
open-bytevector-input-port
|
||||
make-custom-binary-input-port
|
||||
open-bytevector-output-port
|
||||
get-u8
|
||||
lookahead-u8
|
||||
get-bytevector-n
|
||||
|
|
@ -41,7 +43,7 @@
|
|||
put-u8
|
||||
put-bytevector
|
||||
unget-bytevector
|
||||
open-bytevector-output-port
|
||||
make-custom-binary-input-port
|
||||
make-custom-binary-output-port
|
||||
make-custom-binary-input/output-port
|
||||
call-with-input-bytevector
|
||||
|
|
@ -71,3 +73,110 @@ bytevector composed of the bytes written into the port is returned."
|
|||
(let ((bv (get-bytevector)))
|
||||
(close-port port)
|
||||
bv))))
|
||||
|
||||
(define (type-error proc expecting val)
|
||||
(scm-error 'wrong-type-arg proc "Wrong type (expecting `~S'): ~S"
|
||||
(list expecting val) (list val)))
|
||||
|
||||
(define (custom-binary-port-read read)
|
||||
(unless (procedure? read)
|
||||
(type-error "custom-binary-port-read" "procedure" read))
|
||||
(lambda (port bv start count)
|
||||
(let ((ret (read bv start count)))
|
||||
(unless (and (exact-integer? ret) (<= 0 ret count))
|
||||
(scm-error 'out-of-range "custom-binary-port-read"
|
||||
"Value out of range: ~S" (list ret) (list ret)))
|
||||
ret)))
|
||||
|
||||
(define (custom-binary-port-write write)
|
||||
(unless (procedure? write)
|
||||
(type-error "custom-binary-port-write" "procedure" write))
|
||||
(lambda (port bv start count)
|
||||
(let ((ret (write bv start count)))
|
||||
(unless (and (exact-integer? ret) (<= 0 ret count))
|
||||
(scm-error 'out-of-range "custom-binary-port-write"
|
||||
"Value out of range: ~S" (list ret) (list ret)))
|
||||
ret)))
|
||||
|
||||
(define (custom-binary-port-seek get-position set-position!)
|
||||
(when get-position
|
||||
(unless (procedure? get-position)
|
||||
(type-error "custom-binary-port-seek" "procedure" get-position)))
|
||||
(when set-position!
|
||||
(unless (procedure? set-position!)
|
||||
(type-error "custom-binary-port-seek" "procedure" set-position!)))
|
||||
|
||||
(define (seek port offset whence)
|
||||
(cond
|
||||
((eqv? whence SEEK_CUR)
|
||||
(unless get-position
|
||||
(type-error "custom-binary-port-seek"
|
||||
"R6RS custom binary port with `port-position` support"
|
||||
port))
|
||||
(if (zero? offset)
|
||||
(get-position)
|
||||
(seek port (+ (get-position) offset) SEEK_SET)))
|
||||
((eqv? whence SEEK_SET)
|
||||
(unless set-position!
|
||||
(type-error "custom-binary-port-seek"
|
||||
"Seekable R6RS custom binary port"
|
||||
port))
|
||||
(set-position! offset)
|
||||
;; Assume setting the position succeeds.
|
||||
offset)
|
||||
((eqv? whence SEEK_END)
|
||||
(error "R6RS custom binary ports do not support `SEEK_END'"))))
|
||||
seek)
|
||||
|
||||
(define (custom-binary-port-close close)
|
||||
(match close
|
||||
(#f (lambda (port) #t))
|
||||
((? procedure?) (lambda (port) (close)))
|
||||
(_ (type-error "custom-binary-port-close" "procedure" close))))
|
||||
|
||||
(define (custom-binary-port-random-access? set-position!)
|
||||
(if set-position!
|
||||
(lambda (port) #t)
|
||||
(lambda (port) #f)))
|
||||
|
||||
(define (make-custom-binary-input-port id read get-position set-position! close)
|
||||
(unless (string? id)
|
||||
(type-error "make-custom-binary-input-port" "string" id))
|
||||
(make-custom-port #:id id
|
||||
#:read (custom-binary-port-read read)
|
||||
#:seek (custom-binary-port-seek get-position set-position!)
|
||||
#:close (custom-binary-port-close close)
|
||||
#:random-access?
|
||||
(custom-binary-port-random-access? set-position!)
|
||||
;; FIXME: Instead default to current encoding, if
|
||||
;; someone reads text from this port.
|
||||
#:encoding 'ISO-8859-1 #:conversion-strategy 'error))
|
||||
|
||||
(define (make-custom-binary-output-port id write get-position set-position!
|
||||
close)
|
||||
(unless (string? id)
|
||||
(type-error "make-custom-binary-output-port" "string" id))
|
||||
(make-custom-port #:id id
|
||||
#:write (custom-binary-port-write write)
|
||||
#:seek (custom-binary-port-seek get-position set-position!)
|
||||
#:close (custom-binary-port-close close)
|
||||
#:random-access?
|
||||
(custom-binary-port-random-access? set-position!)
|
||||
;; FIXME: Instead default to current encoding, if
|
||||
;; someone reads text from this port.
|
||||
#:encoding 'ISO-8859-1 #:conversion-strategy 'error))
|
||||
|
||||
(define (make-custom-binary-input/output-port id read write get-position
|
||||
set-position! close)
|
||||
(unless (string? id)
|
||||
(type-error "make-custom-binary-input/output-port" "string" id))
|
||||
(make-custom-port #:id id
|
||||
#:read (custom-binary-port-read read)
|
||||
#:write (custom-binary-port-write write)
|
||||
#:seek (custom-binary-port-seek get-position set-position!)
|
||||
#:close (custom-binary-port-close close)
|
||||
#:random-access?
|
||||
(custom-binary-port-random-access? set-position!)
|
||||
;; FIXME: Instead default to current encoding, if
|
||||
;; someone reads text from this port.
|
||||
#:encoding 'ISO-8859-1 #:conversion-strategy 'error))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue