conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add port-close procedure

This commit is contained in:
Yuichi Nishiwaki 2013-12-03 08:16:13 -08:00
parent afffa20785
commit 7e69ae1878
1 changed files with 24 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/port.c
View File

@ -297,6 +297,27 @@ pic_port_eof_object(pic_state *pic)
return v; 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 void
pic_init_port(pic_state *pic) 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, "newline", pic_port_newline);
pic_defun(pic, "eof-object?", pic_port_eof_object_p); pic_defun(pic, "eof-object?", pic_port_eof_object_p);
pic_defun(pic, "eof-object", pic_port_eof_object); 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);
} }