* 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 */
+
\f
/* Headers. */
#include "keywords.h"
+#include "scm_validate.h"
#include "ports.h"
#ifdef HAVE_MALLOC_H
static void flush_void_port (SCM port);
static void end_input_void_port (SCM port, int offset);
-static void write_void_port (SCM port, void *data, size_t size);
+static void write_void_port (SCM port, const void *data, size_t size);
long
scm_make_port_type (char *name,
int (*fill_input) (SCM port),
- void (*write) (SCM port, void *data, size_t size))
+ void (*write) (SCM port, const void *data, size_t size))
{
char *tmp;
if (255 <= scm_numptob)
\f
-SCM_PROC(s_char_ready_p, "char-ready?", 0, 1, 0, scm_char_ready_p);
-
-SCM
-scm_char_ready_p (SCM port)
+SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
+ (SCM port),
+ "")
+#define FUNC_NAME s_scm_char_ready_p
{
scm_port *pt;
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1,
- s_char_ready_p);
+ SCM_VALIDATE_OPINPORT (1,port);
pt = SCM_PTAB_ENTRY (port);
scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (ptob->input_waiting)
- return (ptob->input_waiting (port)) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(ptob->input_waiting (port));
else
return SCM_BOOL_T;
}
}
+#undef FUNC_NAME
/* Clear a port's read buffers, returning the contents. */
-SCM_PROC (s_drain_input, "drain-input", 1, 0, 0, scm_drain_input);
-SCM
-scm_drain_input (SCM port)
+SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
+ (SCM port),
+ "Drains @var{PORT}'s read buffers (including any pushed-back characters)\n"
+ "and returns the contents as a single string.")
+#define FUNC_NAME s_scm_drain_input
{
SCM result;
scm_port *pt = SCM_PTAB_ENTRY (port);
int count;
char *dst;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1,
- s_drain_input);
+ SCM_VALIDATE_OPINPORT (1,port);
count = pt->read_end - pt->read_pos;
if (pt->read_buf == pt->putback_buf)
return result;
}
+#undef FUNC_NAME
\f
/* Standard ports --- current input, output, error, and more(!). */
-SCM_PROC(s_current_input_port, "current-input-port", 0, 0, 0, scm_current_input_port);
-
-SCM
-scm_current_input_port ()
+SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
+ (),
+ "")
+#define FUNC_NAME s_scm_current_input_port
{
return scm_cur_inp;
}
+#undef FUNC_NAME
-SCM_PROC(s_current_output_port, "current-output-port", 0, 0, 0, scm_current_output_port);
-
-SCM
-scm_current_output_port ()
+SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
+ (),
+ "")
+#define FUNC_NAME s_scm_current_output_port
{
return scm_cur_outp;
}
+#undef FUNC_NAME
-SCM_PROC(s_current_error_port, "current-error-port", 0, 0, 0, scm_current_error_port);
-
-SCM
-scm_current_error_port ()
+SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
+ (),
+ "Return the port to which errors and warnings should be sent (the\n"
+ "@dfn{standard error} in Unix and C terminology).")
+#define FUNC_NAME s_scm_current_error_port
{
return scm_cur_errp;
}
+#undef FUNC_NAME
-SCM_PROC(s_current_load_port, "current-load-port", 0, 0, 0, scm_current_load_port);
-
-SCM
-scm_current_load_port ()
+SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
+ (),
+ "")
+#define FUNC_NAME s_scm_current_load_port
{
return scm_cur_loadp;
}
+#undef FUNC_NAME
-SCM_PROC(s_set_current_input_port, "set-current-input-port", 1, 0, 0, scm_set_current_input_port);
-
-SCM
-scm_set_current_input_port (SCM port)
+SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0,
+ (SCM port),
+ "@deffnx primitive set-current-output-port port\n"
+ "@deffnx primitive set-current-error-port port\n"
+ "Change the ports returned by @code{current-input-port},\n"
+ "@code{current-output-port} and @code{current-error-port}, respectively,\n"
+ "so that they use the supplied @var{port} for input or output.")
+#define FUNC_NAME s_scm_set_current_input_port
{
SCM oinp = scm_cur_inp;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_set_current_input_port);
+ SCM_VALIDATE_OPINPORT (1,port);
scm_cur_inp = port;
return oinp;
}
+#undef FUNC_NAME
-SCM_PROC(s_set_current_output_port, "set-current-output-port", 1, 0, 0, scm_set_current_output_port);
-
-SCM
-scm_set_current_output_port (SCM port)
+SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0,
+ (SCM port),
+ "")
+#define FUNC_NAME s_scm_set_current_output_port
{
SCM ooutp = scm_cur_outp;
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_output_port);
+ SCM_VALIDATE_OPOUTPORT (1,port);
scm_cur_outp = port;
return ooutp;
}
+#undef FUNC_NAME
-SCM_PROC(s_set_current_error_port, "set-current-error-port", 1, 0, 0, scm_set_current_error_port);
-
-SCM
-scm_set_current_error_port (SCM port)
+SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
+ (SCM port),
+ "")
+#define FUNC_NAME s_scm_set_current_error_port
{
SCM oerrp = scm_cur_errp;
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_error_port);
+ SCM_VALIDATE_OPOUTPORT (1,port);
scm_cur_errp = port;
return oerrp;
}
+#undef FUNC_NAME
\f
/* The port table --- an array of pointers to ports. */
/* Undocumented functions for debugging. */
/* Return the number of ports in the table. */
-SCM_PROC(s_pt_size, "pt-size", 0, 0, 0, scm_pt_size);
-SCM
-scm_pt_size ()
+SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
+ (),
+ "")
+#define FUNC_NAME s_scm_pt_size
{
return SCM_MAKINUM (scm_port_table_size);
}
+#undef FUNC_NAME
/* Return the ith member of the port table. */
-SCM_PROC(s_pt_member, "pt-member", 1, 0, 0, scm_pt_member);
-SCM
-scm_pt_member (SCM member)
+SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
+ (SCM member),
+ "")
+#define FUNC_NAME s_scm_pt_member
{
int i;
- SCM_ASSERT (SCM_INUMP (member), member, SCM_ARG1, s_pt_member);
- i = SCM_INUM (member);
+ SCM_VALIDATE_INUM_COPY (1,member,i);
if (i < 0 || i >= scm_port_table_size)
return SCM_BOOL_F;
else
return scm_port_table[i]->port;
}
+#undef FUNC_NAME
#endif
/* Return the revealed count for a port. */
-SCM_PROC(s_port_revealed, "port-revealed", 1, 0, 0, scm_port_revealed);
-
-SCM
-scm_port_revealed (SCM port)
+SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
+ (SCM port),
+ "Returns the revealed count for @var{port}.")
+#define FUNC_NAME s_scm_port_revealed
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
+ SCM_VALIDATE_PORT (1,port);
return SCM_MAKINUM (scm_revealed_count (port));
}
+#undef FUNC_NAME
/* Set the revealed count for a port. */
-SCM_PROC(s_set_port_revealed_x, "set-port-revealed!", 2, 0, 0, scm_set_port_revealed_x);
-
-SCM
-scm_set_port_revealed_x (SCM port, SCM rcount)
+SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
+ (SCM port, SCM rcount),
+ "Sets the revealed count for a port to a given value. \n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_set_port_revealed_x
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port),
- port, SCM_ARG1, s_set_port_revealed_x);
- SCM_ASSERT (SCM_INUMP (rcount), rcount, SCM_ARG2, s_set_port_revealed_x);
+ SCM_VALIDATE_PORT (1,port);
+ SCM_VALIDATE_INUM (2,rcount);
SCM_REVEALED (port) = SCM_INUM (rcount);
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
\f
* Some modes such as "append" are only used when opening
* a file and are not returned here. */
-SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
-
-SCM
-scm_port_mode (SCM port)
+SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
+ (SCM port),
+ "Returns the port modes associated with the open port @var{port}. These\n"
+ "will not necessarily be identical to the modes used when the port was\n"
+ "opened, since modes such as \"append\" which are used only during\n"
+ "port creation are not retained.")
+#define FUNC_NAME s_scm_port_mode
{
char modes[3];
modes[0] = '\0';
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);
+ SCM_VALIDATE_OPPORT (1,port);
if (SCM_CAR (port) & SCM_RDNG) {
if (SCM_CAR (port) & SCM_WRTNG)
strcpy (modes, "r+");
strcat (modes, "0");
return scm_makfromstr (modes, strlen (modes), 0);
}
+#undef FUNC_NAME
\f
* Call the close operation on a port object.
* see also scm_close.
*/
-SCM_PROC(s_close_port, "close-port", 1, 0, 0, scm_close_port);
-
-SCM
-scm_close_port (SCM port)
+SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
+ (SCM port),
+ "Close the specified port object. Returns @code{#t} if it successfully\n"
+ "closes a port or @code{#f} if it was already\n"
+ "closed. An exception may be raised if an error occurs, for example\n"
+ "when flushing buffered output.\n"
+ "See also @ref{Ports and File Descriptors, close}, for a procedure\n"
+ "which can close file descriptors.")
+#define FUNC_NAME s_scm_close_port
{
scm_sizet i;
int rv;
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1,
- s_close_port);
+ SCM_VALIDATE_PORT (1,port);
if (SCM_CLOSEDP (port))
return SCM_BOOL_F;
i = SCM_PTOBNUM (port);
rv = 0;
scm_remove_from_port_table (port);
SCM_SETAND_CAR (port, ~SCM_OPN);
- return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
+ return SCM_NEGATE_BOOL(rv < 0);
}
+#undef FUNC_NAME
-SCM_PROC(s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);
-
-SCM
-scm_close_all_ports_except (SCM ports)
+SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
+ (SCM ports),
+ "Close all open file ports used by the interpreter\n"
+ "except for those supplied as arguments. This procedure\n"
+ "is intended to be used before an exec call to close file descriptors\n"
+ "which are not needed in the new process.Close all open file ports used by the interpreter\n"
+ "except for those supplied as arguments. This procedure\n"
+ "is intended to be used before an exec call to close file descriptors\n"
+ "which are not needed in the new process.")
+#define FUNC_NAME s_scm_close_all_ports_except
{
int i = 0;
- SCM_ASSERT (SCM_NIMP (ports) && SCM_CONSP (ports), ports, SCM_ARG1, s_close_all_ports_except);
+ SCM_VALIDATE_CONS (1,ports);
while (i < scm_port_table_size)
{
SCM thisport = scm_port_table[i]->port;
{
SCM port = SCM_COERCE_OUTPORT (SCM_CAR (ports_ptr));
if (i == 0)
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_close_all_ports_except);
+ SCM_VALIDATE_OPPORT (SCM_ARG1,port);
if (port == thisport)
found = 1;
ports_ptr = SCM_CDR (ports_ptr);
}
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
\f
/* Utter miscellany. Gosh, we should clean this up some time. */
-SCM_PROC(s_input_port_p, "input-port?", 1, 0, 0, scm_input_port_p);
-
-SCM
-scm_input_port_p (SCM x)
+SCM_DEFINE (scm_input_port_p, "input-port?", 1, 0, 0,
+ (SCM x),
+ "")
+#define FUNC_NAME s_scm_input_port_p
{
if (SCM_IMP (x))
return SCM_BOOL_F;
- return SCM_INPORTP (x) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_INPORTP (x));
}
+#undef FUNC_NAME
-SCM_PROC(s_output_port_p, "output-port?", 1, 0, 0, scm_output_port_p);
-
-SCM
-scm_output_port_p (SCM x)
+SCM_DEFINE (scm_output_port_p, "output-port?", 1, 0, 0,
+ (SCM x),
+ "")
+#define FUNC_NAME s_scm_output_port_p
{
if (SCM_IMP (x))
return SCM_BOOL_F;
if (SCM_PORT_WITH_PS_P (x))
x = SCM_PORT_WITH_PS_PORT (x);
- return SCM_OUTPORTP (x) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_OUTPORTP (x));
}
+#undef FUNC_NAME
-
-SCM_PROC(s_eof_object_p, "eof-object?", 1, 0, 0, scm_eof_object_p);
-
-SCM
-scm_eof_object_p (SCM x)
+SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0,
+ (SCM port),
+ "Returns @code{#t} if @var{port} is closed or @code{#f} if it is open.")
+#define FUNC_NAME s_scm_port_closed_p
{
- return SCM_EOF_OBJECT_P (x) ? SCM_BOOL_T : SCM_BOOL_F;
+ SCM_VALIDATE_PORT (1,port);
+ return SCM_NEGATE_BOOL(SCM_OPPORTP (port));
}
+#undef FUNC_NAME
-SCM_PROC(s_force_output, "force-output", 0, 1, 0, scm_force_output);
+SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0,
+ (SCM x),
+ "")
+#define FUNC_NAME s_scm_eof_object_p
+{
+ return SCM_BOOL(SCM_EOF_OBJECT_P (x));
+}
+#undef FUNC_NAME
-SCM
-scm_force_output (SCM port)
+SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
+ (SCM port),
+ "Flush the specified output port, or the current output port if @var{port}\n"
+ "is omitted. The current output buffer contents are passed to the \n"
+ "underlying port implementation (e.g., in the case of fports, the\n"
+ "data will be written to the file and the output buffer will be cleared.)\n"
+ "It has no effect on an unbuffered port.\n\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_force_output
{
if (SCM_UNBNDP (port))
port = scm_cur_outp;
else
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1,
- s_force_output);
+ SCM_VALIDATE_OPOUTPORT (1,port);
}
scm_flush (port);
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_flush_all_ports, "flush-all-ports", 0, 0, 0, scm_flush_all_ports);
-SCM
-scm_flush_all_ports ()
+SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
+ (),
+ "Equivalent to calling @code{force-output} on\n"
+ "all open output ports. The return value is unspecified.")
+#define FUNC_NAME s_scm_flush_all_ports
{
int i;
}
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC(s_read_char, "read-char", 0, 1, 0, scm_read_char);
-
-SCM
-scm_read_char (SCM port)
+SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
+ (SCM port),
+ "")
+#define FUNC_NAME s_scm_read_char
{
int c;
if (SCM_UNBNDP (port))
port = scm_cur_inp;
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_char);
+ SCM_VALIDATE_OPINPORT (1,port);
c = scm_getc (port);
if (EOF == c)
return SCM_EOF_VAL;
return SCM_MAKICHR (c);
}
+#undef FUNC_NAME
/* this should only be called when the read buffer is empty. it
tries to refill the read buffer. it returns the first char from
}
void
-scm_puts (char *s, SCM port)
+scm_puts (const char *s, SCM port)
{
scm_lfwrite (s, strlen (s), port);
}
void
-scm_lfwrite (char *ptr, scm_sizet size, SCM port)
+scm_lfwrite (const char *ptr, scm_sizet size, SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
void
-scm_ungets (char *s, int n, SCM port)
+scm_ungets (const char *s, int n, SCM port)
{
/* This is simple minded and inefficient, but unreading strings is
* probably not a common operation, and remember that line and
}
-SCM_PROC(s_peek_char, "peek-char", 0, 1, 0, scm_peek_char);
-
-SCM
-scm_peek_char (SCM port)
+SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
+ (SCM port),
+ "")
+#define FUNC_NAME s_scm_peek_char
{
int c;
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_peek_char);
+ SCM_VALIDATE_OPINPORT (1,port);
c = scm_getc (port);
if (EOF == c)
return SCM_EOF_VAL;
scm_ungetc (c, port);
return SCM_MAKICHR (c);
}
+#undef FUNC_NAME
-SCM_PROC (s_unread_char, "unread-char", 2, 0, 0, scm_unread_char);
-
-SCM
-scm_unread_char (SCM cobj, SCM port)
+SCM_DEFINE (scm_unread_char, "unread-char", 2, 0, 0,
+ (SCM cobj, SCM port),
+ "Place @var{char} in @var{port} so that it will be read by the\n"
+ "next read operation. If called multiple times, the unread characters\n"
+ "will be read again in last-in first-out order. If @var{port} is\n"
+ "not supplied, the current input port is used.")
+#define FUNC_NAME s_scm_unread_char
{
int c;
- SCM_ASSERT (SCM_ICHRP (cobj), cobj, SCM_ARG1, s_unread_char);
-
+ SCM_VALIDATE_ICHR (1,cobj);
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_unread_char);
-
+ SCM_VALIDATE_OPINPORT (2,port);
c = SCM_ICHR (cobj);
scm_ungetc (c, port);
return cobj;
}
+#undef FUNC_NAME
-SCM_PROC (s_unread_string, "unread-string", 2, 0, 0, scm_unread_string);
-
-SCM
-scm_unread_string (SCM str, SCM port)
+SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
+ (SCM str, SCM port),
+ "Place the string @var{str} in @var{port} so that its characters will be\n"
+ "read in subsequent read operations. If called multiple times, the\n"
+ "unread characters will be read again in last-in first-out order. If\n"
+ "@var{port} is not supplied, the current-input-port is used.")
+#define FUNC_NAME s_scm_unread_string
{
- SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str),
- str, SCM_ARG1, s_unread_string);
-
+ SCM_VALIDATE_STRING (1,str);
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
- port, SCM_ARG2, s_unread_string);
+ SCM_VALIDATE_OPINPORT (2,port);
scm_ungets (SCM_ROUCHARS (str), SCM_LENGTH (str), port);
return str;
}
-
-SCM_PROC (s_seek, "seek", 3, 0, 0, scm_seek);
-SCM
-scm_seek (SCM object, SCM offset, SCM whence)
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
+ (SCM object, SCM offset, SCM whence),
+ "Sets the current position of @var{fd/port} to the integer @var{offset},\n"
+ "which is interpreted according to the value of @var{whence}.\n\n"
+ "One of the following variables should be supplied\n"
+ "for @var{whence}:\n"
+ "@defvar SEEK_SET\n"
+ "Seek from the beginning of the file.\n"
+ "@end defvar\n"
+ "@defvar SEEK_CUR\n"
+ "Seek from the current position.\n"
+ "@end defvar\n"
+ "@defvar SEEK_END\n"
+ "Seek from the end of the file.\n"
+ "@end defvar\n\n"
+ "If @var{fd/port} is a file descriptor, the underlying system call is\n"
+ "@code{lseek}. @var{port} may be a string port.\n\n"
+ "The value returned is the new position in the file. This means that\n"
+ "the current position of a port can be obtained using:\n"
+ "@smalllisp\n"
+ "(seek port 0 SEEK_CUR)\n"
+ "@end smalllisp")
+#define FUNC_NAME s_scm_seek
{
off_t off;
off_t rv;
object = SCM_COERCE_OUTPORT (object);
- off = scm_num2long (offset, (char *)SCM_ARG2, s_seek);
- SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_seek);
- how = SCM_INUM (whence);
+ off = SCM_NUM2LONG (2,offset);
+ SCM_VALIDATE_INUM_COPY (3,whence,how);
if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
- scm_out_of_range (s_seek, whence);
- if (SCM_NIMP (object) && SCM_OPPORTP (object))
+ SCM_OUT_OF_RANGE (3, whence);
+ if (SCM_OPPORTP (object))
{
- scm_port *pt = SCM_PTAB_ENTRY (object);
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object);
if (!ptob->seek)
- scm_misc_error (s_seek, "port is not seekable",
- scm_cons (object, SCM_EOL));
+ SCM_MISC_ERROR ("port is not seekable",
+ scm_cons (object, SCM_EOL));
else
- {
- /* there's no need to worry about what happens to the buffers
- if the port isn't random-access: seek will fail anyway. */
- if (off == 0 && how == SEEK_CUR)
- {
- /* special case to avoid discarding put-back chars when
- reading current position. */
- rv = ptob->seek (object, off, how);
- if (pt->rw_active == SCM_PORT_READ)
- {
- rv -= pt->read_end - pt->read_pos;
- if (pt->read_buf == pt->putback_buf)
- rv -= pt->saved_read_end - pt->saved_read_pos;
- }
- else if (pt->rw_active == SCM_PORT_WRITE)
- rv += pt->write_pos - pt->write_buf;
- }
- else
- {
- if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (object);
- else if (pt->rw_active == SCM_PORT_WRITE)
- ptob->flush (object);
-
- rv = ptob->seek (object, off, how);
- }
- }
+ rv = ptob->seek (object, off, how);
}
else /* file descriptor?. */
{
- SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_seek);
+ SCM_VALIDATE_INUM (1,object);
rv = lseek (SCM_INUM (object), off, how);
if (rv == -1)
- scm_syserror (s_seek);
+ SCM_SYSERROR;
}
return scm_long2num (rv);
}
+#undef FUNC_NAME
-SCM_PROC (s_truncate_file, "truncate-file", 1, 1, 0, scm_truncate_file);
-
-SCM
-scm_truncate_file (SCM object, SCM length)
+SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
+ (SCM object, SCM length),
+ "Truncates the object referred to by @var{obj} to at most @var{size} bytes.\n"
+ "@var{obj} can be a string containing a file name or an integer file\n"
+ "descriptor or a port. @var{size} may be omitted if @var{obj} is not\n"
+ "a file name, in which case the truncation occurs at the current port.\n"
+ "position.\n\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_truncate_file
{
int rv;
off_t c_length;
if (SCM_UNBNDP (length))
{
/* must supply length if object is a filename. */
- if (SCM_NIMP (object) && SCM_ROSTRINGP (object))
- scm_wrong_num_args (scm_makfrom0str (s_truncate_file));
+ if (SCM_ROSTRINGP (object))
+ SCM_MISC_ERROR("must supply length if OBJECT is a filename",SCM_EOL);
length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
}
- c_length = scm_num2long (length, (char *)SCM_ARG2, s_truncate_file);
+ c_length = SCM_NUM2LONG (2,length);
if (c_length < 0)
- scm_misc_error (s_truncate_file, "negative offset", SCM_EOL);
+ SCM_MISC_ERROR ("negative offset", SCM_EOL);
object = SCM_COERCE_OUTPORT (object);
if (SCM_INUMP (object))
{
SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length));
}
- else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object))
+ else if (SCM_OPOUTPORTP (object))
{
scm_port *pt = SCM_PTAB_ENTRY (object);
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object);
if (!ptob->truncate)
- scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL);
+ SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
if (pt->rw_active == SCM_PORT_READ)
scm_end_input (object);
else if (pt->rw_active == SCM_PORT_WRITE)
}
else
{
- SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
- object, SCM_ARG1, s_truncate_file);
+ SCM_VALIDATE_ROSTRING (1,object);
SCM_COERCE_SUBSTR (object);
SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), c_length));
}
if (rv == -1)
- scm_syserror (s_truncate_file);
+ SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line);
-
-SCM
-scm_port_line (SCM port)
+SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0,
+ (SCM port),
+ "")
+#define FUNC_NAME s_scm_port_line
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_port_line);
+ SCM_VALIDATE_OPENPORT (1,port);
return SCM_MAKINUM (SCM_LINUM (port));
}
+#undef FUNC_NAME
-SCM_PROC (s_set_port_line_x, "set-port-line!", 2, 0, 0, scm_set_port_line_x);
-
-SCM
-scm_set_port_line_x (SCM port, SCM line)
+SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0,
+ (SCM port, SCM line),
+ "")
+#define FUNC_NAME s_scm_set_port_line_x
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_set_port_line_x);
- SCM_ASSERT (SCM_INUMP (line), line, SCM_ARG2, s_set_port_line_x);
+ SCM_VALIDATE_OPENPORT (1,port);
+ SCM_VALIDATE_INUM (2,line);
return SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
}
-
-SCM_PROC (s_port_column, "port-column", 1, 0, 0, scm_port_column);
-
-SCM
-scm_port_column (SCM port)
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0,
+ (SCM port),
+ "@deffnx primitive port-line [input-port]\n"
+ "Return the current column number or line number of @var{input-port},\n"
+ "using the current input port if none is specified. If the number is\n"
+ "unknown, the result is #f. Otherwise, the result is a 0-origin integer\n"
+ "- i.e. the first character of the first line is line 0, column 0.\n"
+ "(However, when you display a file position, for example in an error\n"
+ "message, we recommand you add 1 to get 1-origin integers. This is\n"
+ "because lines and column numbers traditionally start with 1, and that is\n"
+ "what non-programmers will find most natural.)")
+#define FUNC_NAME s_scm_port_column
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_port_column);
+ SCM_VALIDATE_OPENPORT (1,port);
return SCM_MAKINUM (SCM_COL (port));
}
+#undef FUNC_NAME
-SCM_PROC (s_set_port_column_x, "set-port-column!", 2, 0, 0, scm_set_port_column_x);
-
-SCM
-scm_set_port_column_x (SCM port, SCM column)
+SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0,
+ (SCM port, SCM column),
+ "@deffnx primitive set-port-line! [input-port] line\n"
+ "Set the current column or line number of @var{input-port}, using the\n"
+ "current input port if none is specified.")
+#define FUNC_NAME s_scm_set_port_column_x
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_set_port_column_x);
- SCM_ASSERT (SCM_INUMP (column), column, SCM_ARG2, s_set_port_column_x);
+ SCM_VALIDATE_OPENPORT (1,port);
+ SCM_VALIDATE_INUM (2,column);
return SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
}
+#undef FUNC_NAME
-SCM_PROC (s_port_filename, "port-filename", 1, 0, 0, scm_port_filename);
-
-SCM
-scm_port_filename (SCM port)
+SCM_DEFINE (scm_port_filename, "port-filename", 1, 0, 0,
+ (SCM port),
+ "Return the filename associated with @var{port}. This function returns\n"
+ "the strings \"standard input\", \"standard output\" and \"standard error\""
+ "when called on the current input, output and error ports respectively.")
+#define FUNC_NAME s_scm_port_filename
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_port_filename);
+ SCM_VALIDATE_OPENPORT (1,port);
return SCM_PTAB_ENTRY (port)->file_name;
}
+#undef FUNC_NAME
-SCM_PROC (s_set_port_filename_x, "set-port-filename!", 2, 0, 0, scm_set_port_filename_x);
-
-SCM
-scm_set_port_filename_x (SCM port, SCM filename)
+SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0,
+ (SCM port, SCM filename),
+ "Change the filename associated with @var{port}, using the current input\n"
+ "port if none is specified. Note that this does not change the port's\n"
+ "source of data, but only the value that is returned by\n"
+ "@code{port-filename} and reported in diagnostic output.")
+#define FUNC_NAME s_scm_set_port_filename_x
{
port = SCM_COERCE_OUTPORT (port);
- SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
- port,
- SCM_ARG1,
- s_set_port_filename_x);
+ SCM_VALIDATE_OPENPORT (1,port);
/* We allow the user to set the filename to whatever he likes. */
return SCM_PTAB_ENTRY (port)->file_name = filename;
}
+#undef FUNC_NAME
#ifndef ttyname
extern char * ttyname();
}
static void
-write_void_port (SCM port, void *data, size_t size)
+write_void_port (SCM port, const void *data, size_t size)
{
}
}
-SCM_PROC (s_sys_make_void_port, "%make-void-port", 1, 0, 0, scm_sys_make_void_port);
-
-SCM
-scm_sys_make_void_port (SCM mode)
+SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0,
+ (SCM mode),
+ "Create and return a new void port. The @var{mode} argument describes\n"
+ "the input/output modes for this port; for a description, see the\n"
+ "documentation for @code{open-file} in @ref{File Ports}.")
+#define FUNC_NAME s_scm_sys_make_void_port
{
- SCM_ASSERT (SCM_NIMP (mode) && SCM_ROSTRINGP (mode), mode,
- SCM_ARG1, s_sys_make_void_port);
-
+ SCM_VALIDATE_ROSTRING (1,mode);
SCM_COERCE_SUBSTR (mode);
return scm_void_port (SCM_ROCHARS (mode));
}
+#undef FUNC_NAME
\f
/* Initialization. */
HCoop / bpt / guile.git / blobdiff