From 7e69ae18788b31267484bee470cdc137488fe67a Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 3 Dec 2013 08:16:13 -0800 Subject: [PATCH] add port-close procedure --- src/port.c | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/port.c b/src/port.c index 0cbe8a3e..ea8fde9b 100644 --- a/src/port.c +++ b/src/port.c @@ -297,6 +297,27 @@ pic_port_eof_object(pic_state *pic) return v; } +pic_value +pic_port_close_port(pic_state *pic) +{ + pic_value v; + struct pic_port *port; + + pic_get_args(pic, "o", &v); + + if (! pic_port_p(v)) { + pic_error(pic, "close-port: expected port"); + } + port = pic_port_ptr(v); + + if (fclose(port->file) == EOF) { + pic_error(pic, "close-port: failure"); + } + port->status = PIC_PORT_CLOSE; + + return pic_false_value(); +} + void pic_init_port(pic_state *pic) { @@ -311,4 +332,7 @@ pic_init_port(pic_state *pic) pic_defun(pic, "newline", pic_port_newline); pic_defun(pic, "eof-object?", pic_port_eof_object_p); pic_defun(pic, "eof-object", pic_port_eof_object); + pic_defun(pic, "close-port", pic_port_close_port); + pic_defun(pic, "close-input-port", pic_port_close_port); + pic_defun(pic, "close-output-port", pic_port_close_port); }