From 7564bbb647e828f206f6fd7b9a1d8a4fcc595574 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 19 Apr 2009 22:49:41 +0200 Subject: [PATCH] ports: Prepare to factorize custom binary input/output ports. * src/ports.c (SCM_R6RS_CBIP_GET_POSITION_PROC, SCM_R6RS_CBIP_SET_POSITION_PROC, SCM_R6RS_CBIP_CLOSE_PROC): Rename to `SCM_R6RS_CBP_*'. (cbip_mark, cbip_seek, cbip_close): Rename to `cbp_*'. (SCM_R6RS_CBIP_BYTEVECTOR): Shifted to slot 4 of the "method vector". (make_cbip): Shift BV to slot 4 and methods to slots 0-3. --- src/ports.c | 182 +++++++++++++++++++++++++++++++----------------------------- 1 file changed, 93 insertions(+), 89 deletions(-) diff --git a/src/ports.c b/src/ports.c index 28d73c6..db78198 100644 --- a/src/ports.c +++ b/src/ports.c @@ -210,6 +210,89 @@ SCM_DEFINE (scm_r6rs_open_bytevector_input_port, } #undef FUNC_NAME + +/* Custom binary ports. The following routines are shared by input and + output custom binary ports. */ + +#define SCM_R6RS_CBP_GET_POSITION_PROC(_port) \ + SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 1) +#define SCM_R6RS_CBP_SET_POSITION_PROC(_port) \ + SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 2) +#define SCM_R6RS_CBP_CLOSE_PROC(_port) \ + SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3) + +static SCM +cbp_mark (SCM port) +{ + /* Mark the underlying method and object vector. */ + return (SCM_PACK (SCM_STREAM (port))); +} + +static off_t +cbp_seek (SCM port, off_t offset, int whence) +#define FUNC_NAME "cbp_seek" +{ + SCM result; + off_t c_result = 0; + + switch (whence) + { + case SEEK_CUR: + { + SCM get_position_proc; + + get_position_proc = SCM_R6RS_CBP_GET_POSITION_PROC (port); + if (SCM_LIKELY (scm_is_true (get_position_proc))) + result = scm_call_0 (get_position_proc); + else + scm_wrong_type_arg_msg (FUNC_NAME, 0, port, + "R6RS custom binary port does not " + "support `port-position'"); + + offset += scm_to_int (result); + /* Fall through. */ + } + + case SEEK_SET: + { + SCM set_position_proc; + + set_position_proc = SCM_R6RS_CBP_SET_POSITION_PROC (port); + if (SCM_LIKELY (scm_is_true (set_position_proc))) + result = scm_call_1 (set_position_proc, scm_from_int (offset)); + else + scm_wrong_type_arg_msg (FUNC_NAME, 0, port, + "R6RS custom binary port does not " + "support `set-port-position!'"); + + /* 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 int +cbp_close (SCM port) +{ + SCM close_proc; + + close_proc = SCM_R6RS_CBP_CLOSE_PROC (port); + if (scm_is_true (close_proc)) + /* Invoke the `close' thunk. */ + scm_call_0 (close_proc); + + return 1; +} /* Custom binary input port ("cbip" for short). */ @@ -221,17 +304,11 @@ static scm_t_bits custom_binary_input_port_type = 0; /* Return the bytevector associated with PORT. */ #define SCM_R6RS_CBIP_BYTEVECTOR(_port) \ - SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0) + SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4) /* Return the various procedures of PORT. */ #define SCM_R6RS_CBIP_READ_PROC(_port) \ - SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 1) -#define SCM_R6RS_CBIP_GET_POSITION_PROC(_port) \ - SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 2) -#define SCM_R6RS_CBIP_SET_POSITION_PROC(_port) \ - SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3) -#define SCM_R6RS_CBIP_CLOSE_PROC(_port) \ - SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4) + SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0) static inline SCM @@ -251,11 +328,11 @@ make_cbip (SCM read_proc, SCM get_position_proc, /* Store the various methods and bytevector in a vector. */ method_vector = scm_c_make_vector (5, SCM_BOOL_F); - SCM_SIMPLE_VECTOR_SET (method_vector, 0, bv); - SCM_SIMPLE_VECTOR_SET (method_vector, 1, read_proc); - SCM_SIMPLE_VECTOR_SET (method_vector, 2, get_position_proc); - SCM_SIMPLE_VECTOR_SET (method_vector, 3, set_position_proc); - SCM_SIMPLE_VECTOR_SET (method_vector, 4, close_proc); + SCM_SIMPLE_VECTOR_SET (method_vector, 4, bv); + SCM_SIMPLE_VECTOR_SET (method_vector, 0, read_proc); + SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc); + SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc); + SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc); port = scm_new_port_table_entry (custom_binary_input_port_type); @@ -274,13 +351,6 @@ make_cbip (SCM read_proc, SCM get_position_proc, return port; } -static SCM -cbip_mark (SCM port) -{ - /* Mark the underlying bytevector and methods. */ - return (SCM_PACK (SCM_STREAM (port))); -} - static int cbip_fill_input (SCM port) #define FUNC_NAME "cbip_fill_input" @@ -325,72 +395,6 @@ cbip_fill_input (SCM port) } #undef FUNC_NAME -static off_t -cbip_seek (SCM port, off_t offset, int whence) -#define FUNC_NAME "cbip_seek" -{ - SCM result; - off_t c_result = 0; - - switch (whence) - { - case SEEK_CUR: - { - SCM get_position_proc; - - get_position_proc = SCM_R6RS_CBIP_GET_POSITION_PROC (port); - if (SCM_LIKELY (scm_is_true (get_position_proc))) - result = scm_call_0 (get_position_proc); - else - scm_wrong_type_arg_msg (FUNC_NAME, 0, port, - "R6RS custom binary input port does not " - "support `port-position'"); - - offset += scm_to_int (result); - /* Fall through. */ - } - - case SEEK_SET: - { - SCM set_position_proc; - - set_position_proc = SCM_R6RS_CBIP_SET_POSITION_PROC (port); - if (SCM_LIKELY (scm_is_true (set_position_proc))) - result = scm_call_1 (set_position_proc, scm_from_int (offset)); - else - scm_wrong_type_arg_msg (FUNC_NAME, 0, port, - "R6RS custom binary input port does not " - "support `set-port-position!'"); - - /* 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 input ports do not " - "support `SEEK_END'"); - } - - return c_result; -} -#undef FUNC_NAME - -static int -cbip_close (SCM port) -{ - SCM close_proc; - - close_proc = SCM_R6RS_CBIP_CLOSE_PROC (port); - if (scm_is_true (close_proc)) - /* Invoke the `close' thunk. */ - scm_call_0 (close_proc); - - return 1; -} - SCM_DEFINE (scm_r6rs_make_custom_binary_input_port, "make-custom-binary-input-port", 5, 0, 0, @@ -427,9 +431,9 @@ initialize_custom_binary_input_ports (void) scm_make_port_type ("r6rs-custom-binary-input-port", cbip_fill_input, NULL); - scm_set_port_mark (custom_binary_input_port_type, cbip_mark); - scm_set_port_seek (custom_binary_input_port_type, cbip_seek); - scm_set_port_close (custom_binary_input_port_type, cbip_close); + scm_set_port_mark (custom_binary_input_port_type, cbp_mark); + scm_set_port_seek (custom_binary_input_port_type, cbp_seek); + scm_set_port_close (custom_binary_input_port_type, cbp_close); } -- 2.11.4.GIT