diff options
Diffstat (limited to 'libguile/ioext.c')
-rw-r--r-- | libguile/ioext.c | 221 |
1 files changed, 99 insertions, 122 deletions
diff --git a/libguile/ioext.c b/libguile/ioext.c index 209f85d44..b8c070fe9 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -38,6 +38,10 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + +/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, + gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ + @@ -50,6 +54,7 @@ #include "chars.h" #include "feature.h" +#include "scm_validate.h" #include "ioext.h" #include <fcntl.h> @@ -62,59 +67,36 @@ #endif -SCM_PROC (s_read_delimited_x, "%read-delimited!", 3, 3, 0, scm_read_delimited_x); - -SCM -scm_read_delimited_x (delims, buf, gobble, port, start, end) - SCM delims; - SCM buf; - SCM gobble; - SCM port; - SCM start; - SCM end; +GUILE_PROC (scm_read_delimited_x, "%read-delimited!", 3, 3, 0, + (SCM delims, SCM buf, SCM gobble, SCM port, SCM start, SCM end), +"") +#define FUNC_NAME s_scm_read_delimited_x { long j; char *cbuf; long cstart; - long cend; + long cend, tend; int c; char *cdelims; int num_delims; - SCM_ASSERT (SCM_NIMP (delims) && SCM_ROSTRINGP (delims), - delims, SCM_ARG1, s_read_delimited_x); - cdelims = SCM_ROCHARS (delims); + SCM_VALIDATE_ROSTRING_COPY(1,delims,cdelims); num_delims = SCM_ROLENGTH (delims); - SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), - buf, SCM_ARG2, s_read_delimited_x); - cbuf = SCM_CHARS (buf); + SCM_VALIDATE_STRING_COPY(2,buf,cbuf); cend = SCM_LENGTH (buf); if (SCM_UNBNDP (port)) port = scm_cur_inp; else - { - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), - port, SCM_ARG1, s_read_delimited_x); - } + SCM_VALIDATE_OPINPORT(4,port); - if (SCM_UNBNDP (start)) - cstart = 0; - else - { - cstart = scm_num2long (start, - (char *) SCM_ARG5, s_read_delimited_x); - if (cstart < 0 || cstart >= cend) - scm_out_of_range (s_read_delimited_x, start); + SCM_VALIDATE_INT_DEF_COPY(5,start,0,cstart); + if (cstart < 0 || cstart >= cend) + scm_out_of_range (FUNC_NAME, start); - if (!SCM_UNBNDP (end)) - { - long tend = scm_num2long (end, (char *) SCM_ARG6, - s_read_delimited_x); - if (tend <= cstart || tend > cend) - scm_out_of_range (s_read_delimited_x, end); - cend = tend; - } - } + SCM_VALIDATE_INT_DEF_COPY(6,end,cend,tend); + if (tend <= cstart || tend > cend) + scm_out_of_range (FUNC_NAME, end); + cend = tend; for (j = cstart; j < cend; j++) { @@ -140,6 +122,7 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end) } return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart)); } +#undef FUNC_NAME static unsigned char * scm_do_read_line (SCM port, int *len_p) @@ -233,11 +216,10 @@ scm_do_read_line (SCM port, int *len_p) * efficiently in Scheme. */ -SCM_PROC (s_read_line, "%read-line", 0, 1, 0, scm_read_line); - -SCM -scm_read_line (port) - SCM port; +GUILE_PROC (scm_read_line, "%read-line", 0, 1, 0, + (SCM port), +"") +#define FUNC_NAME s_scm_read_line { scm_port *pt; char *s; @@ -246,8 +228,7 @@ scm_read_line (port) if (SCM_UNBNDP (port)) port = scm_cur_inp; - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), - port, SCM_ARG1, s_read_line); + SCM_VALIDATE_OPINPORT(1,port); pt = SCM_PTAB_ENTRY (port); if (pt->rw_active == SCM_PORT_WRITE) @@ -281,55 +262,50 @@ scm_read_line (port) return scm_cons (line, term); } +#undef FUNC_NAME -SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line); - -SCM -scm_write_line (obj, port) - SCM obj; - SCM port; +GUILE_PROC (scm_write_line, "write-line", 1, 1, 0, + (SCM obj, SCM port), +"") +#define FUNC_NAME s_scm_write_line { scm_display (obj, port); return scm_newline (port); } +#undef FUNC_NAME -SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell); - -SCM -scm_ftell (object) - SCM object; +GUILE_PROC (scm_ftell, "ftell", 1, 0, 0, + (SCM object), +"") +#define FUNC_NAME s_scm_ftell { return scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); } +#undef FUNC_NAME -SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek); - -SCM -scm_fseek (object, offset, whence) - SCM object; - SCM offset; - SCM whence; +GUILE_PROC (scm_fseek, "fseek", 3, 0, 0, + (SCM object, SCM offset, SCM whence), +"") +#define FUNC_NAME s_scm_fseek { scm_seek (object, offset, whence); - return SCM_UNSPECIFIED; } +#undef FUNC_NAME -SCM_PROC (s_redirect_port, "redirect-port", 2, 0, 0, scm_redirect_port); - -SCM -scm_redirect_port (old, new) - SCM old; - SCM new; +GUILE_PROC (scm_redirect_port, "redirect-port", 2, 0, 0, + (SCM old, SCM new), +"") +#define FUNC_NAME s_scm_redirect_port { int ans, oldfd, newfd; struct scm_fport *fp; old = SCM_COERCE_OUTPORT (old); new = SCM_COERCE_OUTPORT (new); - - SCM_ASSERT (SCM_NIMP (old) && SCM_OPFPORTP (old), old, SCM_ARG1, s_redirect_port); - SCM_ASSERT (SCM_NIMP (new) && SCM_OPFPORTP (new), new, SCM_ARG2, s_redirect_port); + + SCM_VALIDATE_OPFPORT(1,old); + SCM_VALIDATE_OPFPORT(2,new); oldfd = SCM_FPORT_FDES (old); fp = SCM_FSTREAM (new); newfd = fp->fdes; @@ -346,16 +322,18 @@ scm_redirect_port (old, new) scm_end_input (new); ans = dup2 (oldfd, newfd); if (ans == -1) - scm_syserror (s_redirect_port); + SCM_SYSERROR; pt->rw_random = old_pt->rw_random; /* continue using existing buffers, even if inappropriate. */ } return SCM_UNSPECIFIED; } +#undef FUNC_NAME -SCM_PROC (s_dup_to_fdes, "dup->fdes", 1, 1, 0, scm_dup_to_fdes); -SCM -scm_dup_to_fdes (SCM fd_or_port, SCM fd) +GUILE_PROC (scm_dup_to_fdes, "dup->fdes", 1, 1, 0, + (SCM fd_or_port, SCM fd), +"") +#define FUNC_NAME s_scm_dup_to_fdes { int oldfd, newfd, rv; @@ -365,8 +343,7 @@ scm_dup_to_fdes (SCM fd_or_port, SCM fd) oldfd = SCM_INUM (fd_or_port); else { - SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPFPORTP (fd_or_port), - fd_or_port, SCM_ARG1, s_dup_to_fdes); + SCM_VALIDATE_OPFPORT(1,fd_or_port); oldfd = SCM_FPORT_FDES (fd_or_port); } @@ -374,41 +351,44 @@ scm_dup_to_fdes (SCM fd_or_port, SCM fd) { newfd = dup (oldfd); if (newfd == -1) - scm_syserror (s_dup_to_fdes); + SCM_SYSERROR; fd = SCM_MAKINUM (newfd); } else { - SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_dup_to_fdes); + SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, FUNC_NAME); newfd = SCM_INUM (fd); if (oldfd != newfd) { scm_evict_ports (newfd); /* see scsh manual. */ rv = dup2 (oldfd, newfd); if (rv == -1) - scm_syserror (s_dup_to_fdes); + SCM_SYSERROR; } } return fd; } +#undef FUNC_NAME -SCM_PROC (s_fileno, "fileno", 1, 0, 0, scm_fileno); - -SCM -scm_fileno (port) - SCM port; +GUILE_PROC (scm_fileno, "fileno", 1, 0, 0, + (SCM port), +"") +#define FUNC_NAME s_scm_fileno { port = SCM_COERCE_OUTPORT (port); - SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, - s_fileno); + SCM_VALIDATE_OPFPORT(1,port); return SCM_MAKINUM (SCM_FPORT_FDES (port)); } - -SCM_PROC (s_isatty, "isatty?", 1, 0, 0, scm_isatty_p); - -SCM -scm_isatty_p (port) - SCM port; +#undef FUNC_NAME + +/* GJB:FIXME:: why does this not throw + an error if the arg is not a port? + This proc as is would be better names isattyport? + if it is not going to assume that the arg is a port */ +GUILE_PROC (scm_isatty_p, "isatty?", 1, 0, 0, + (SCM port), +"") +#define FUNC_NAME s_scm_isatty_p { int rv; @@ -418,27 +398,26 @@ scm_isatty_p (port) return SCM_BOOL_F; rv = isatty (SCM_FPORT_FDES (port)); - return rv ? SCM_BOOL_T : SCM_BOOL_F; + return SCM_BOOL(rv); } +#undef FUNC_NAME -SCM_PROC (s_fdopen, "fdopen", 2, 0, 0, scm_fdopen); - -SCM -scm_fdopen (fdes, modes) - SCM fdes; - SCM modes; +GUILE_PROC (scm_fdopen, "fdopen", 2, 0, 0, + (SCM fdes, SCM modes), +"") +#define FUNC_NAME s_scm_fdopen { SCM port; - SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_fdopen); - SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, - s_fdopen); + SCM_VALIDATE_INT(1,fdes); + SCM_VALIDATE_ROSTRING(2,modes); SCM_COERCE_SUBSTR (modes); port = scm_fdes_to_port (SCM_INUM (fdes), SCM_ROCHARS (modes), SCM_BOOL_F); return port; } +#undef FUNC_NAME @@ -447,12 +426,10 @@ scm_fdopen (fdes, modes) * #t if fdes moved. * MOVE->FDES is implemented in Scheme and calls this primitive. */ -SCM_PROC (s_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, scm_primitive_move_to_fdes); - -SCM -scm_primitive_move_to_fdes (port, fd) - SCM port; - SCM fd; +GUILE_PROC (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, + (SCM port, SCM fd), +"") +#define FUNC_NAME s_scm_primitive_move_to_fdes { struct scm_fport *stream; int old_fd; @@ -461,8 +438,8 @@ scm_primitive_move_to_fdes (port, fd) port = SCM_COERCE_OUTPORT (port); - SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_primitive_move_to_fdes); - SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_move_to_fdes); + SCM_VALIDATE_OPFPORT(1,port); + SCM_VALIDATE_INT(2,fd); stream = SCM_FSTREAM (port); old_fd = stream->fdes; new_fd = SCM_INUM (fd); @@ -473,25 +450,24 @@ scm_primitive_move_to_fdes (port, fd) scm_evict_ports (new_fd); rv = dup2 (old_fd, new_fd); if (rv == -1) - scm_syserror (s_primitive_move_to_fdes); + SCM_SYSERROR; stream->fdes = new_fd; SCM_SYSCALL (close (old_fd)); return SCM_BOOL_T; } +#undef FUNC_NAME /* Return a list of ports using a given file descriptor. */ -SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports); - -SCM -scm_fdes_to_ports (fd) - SCM fd; +GUILE_PROC(scm_fdes_to_ports, "fdes->ports", 1, 0, 0, + (SCM fd), +"") +#define FUNC_NAME s_scm_fdes_to_ports { SCM result = SCM_EOL; int int_fd; int i; - SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG1, s_fdes_to_ports); - int_fd = SCM_INUM (fd); + SCM_VALIDATE_INT_COPY(1,fd,int_fd); for (i = 0; i < scm_port_table_size; i++) { @@ -500,7 +476,8 @@ scm_fdes_to_ports (fd) result = scm_cons (scm_port_table[i]->port, result); } return result; -} +} +#undef FUNC_NAME void |