mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

make C system primitives throw exceptions

Browse source
This commit is contained in:
Gary Houston 1996-08-02 23:26:33 +00:00
parent cb0016401f
commit 02b754d3a6
10 changed files with 415 additions and 454 deletions
Download patch file Download diff file Expand all files Collapse all files

91
libguile/ioext.c
View file

@ -48,7 +48,7 @@
SCM_PROC (s_sys_ftell, "%ftell", 1, 0, 0, scm_sys_ftell);
SCM_PROC (s_sys_ftell, "ftell", 1, 0, 0, scm_sys_ftell);
#ifdef __STDC__
SCM
scm_sys_ftell (SCM port)
@ -62,7 +62,7 @@ scm_sys_ftell (port)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_ftell);
SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
if (pos < 0)
return SCM_BOOL_F;
SCM_SYSERROR (s_sys_ftell);
if (pos > 0 && SCM_CRDYP (port))
pos--;
return SCM_MAKINUM (pos);
@ -70,7 +70,7 @@ scm_sys_ftell (port)
SCM_PROC (s_sys_fseek, "%fseek", 3, 0, 0, scm_sys_fseek);
SCM_PROC (s_sys_fseek, "fseek", 3, 0, 0, scm_sys_fseek);
#ifdef __STDC__
SCM
scm_sys_fseek (SCM port, SCM offset, SCM whence)
@ -90,12 +90,14 @@ scm_sys_fseek (port, offset, whence)
SCM_CLRDY (port); /* Clear ungetted char */
/* Values of whence are interned in scm_init_ioext. */
rv = fseek ((FILE *)SCM_STREAM (port), SCM_INUM (offset), SCM_INUM (whence));
return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
if (rv != 0)
SCM_SYSERROR (s_sys_fseek);
return SCM_UNSPECIFIED;
}
SCM_PROC (s_sys_freopen, "%freopen", 3, 0, 0, scm_sys_freopen);
SCM_PROC (s_sys_freopen, "freopen", 3, 0, 0, scm_sys_freopen);
#ifdef __STDC__
SCM
scm_sys_freopen (SCM filename, SCM modes, SCM port)
@ -134,7 +136,7 @@ scm_sys_freopen (filename, modes, port)
SCM_PROC (s_sys_duplicate_port, "%duplicate-port", 2, 0, 0, scm_sys_duplicate_port);
SCM_PROC (s_sys_duplicate_port, "duplicate-port", 2, 0, 0, scm_sys_duplicate_port);
#ifdef __STDC__
SCM
scm_sys_duplicate_port (SCM oldpt, SCM modes)
@ -155,22 +157,15 @@ scm_sys_duplicate_port (oldpt, modes)
SCM_DEFER_INTS;
oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
if (oldfd == -1)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
};
SCM_SYSERROR (s_sys_duplicate_port);
SCM_SYSCALL (newfd = dup (oldfd));
if (newfd == -1)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
};
SCM_SYSERROR (s_sys_duplicate_port);
f = fdopen (newfd, SCM_CHARS (modes));
if (!f)
{
SCM_SYSCALL (close (newfd));
SCM_ALLOW_INTS;
return SCM_BOOL_F;
SCM_SYSERROR (s_sys_duplicate_port);
}
{
struct scm_port_table * pt;
@ -187,7 +182,7 @@ scm_sys_duplicate_port (oldpt, modes)
SCM_PROC (s_sys_redirect_port, "%redirect-port", 2, 0, 0, scm_sys_redirect_port);
SCM_PROC (s_sys_redirect_port, "redirect-port", 2, 0, 0, scm_sys_redirect_port);
#ifdef __STDC__
SCM
scm_sys_redirect_port (SCM into_pt, SCM from_pt)
@ -203,13 +198,16 @@ scm_sys_redirect_port (into_pt, from_pt)
SCM_ASSERT (SCM_NIMP (into_pt) && SCM_OPPORTP (into_pt), into_pt, SCM_ARG1, s_sys_redirect_port);
SCM_ASSERT (SCM_NIMP (from_pt) && SCM_OPPORTP (from_pt), from_pt, SCM_ARG2, s_sys_redirect_port);
oldfd = fileno ((FILE *)SCM_STREAM (into_pt));
if (oldfd == -1)
SCM_SYSERROR (s_sys_redirect_port);
newfd = fileno ((FILE *)SCM_STREAM (from_pt));
if (oldfd == -1 || newfd == -1)
ans = -1;
else
SCM_SYSCALL (ans = dup2 (oldfd, newfd));
if (newfd == -1)
SCM_SYSERROR (s_sys_redirect_port);
SCM_SYSCALL (ans = dup2 (oldfd, newfd));
if (ans == -1)
SCM_SYSERROR (s_sys_redirect_port);
SCM_ALLOW_INTS;
return (ans == -1) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
return SCM_UNSPECIFIED;
}
SCM_PROC (s_sys_fileno, "%fileno", 1, 0, 0, scm_sys_fileno);
@ -225,11 +223,12 @@ scm_sys_fileno (port)
int fd;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
fd = fileno ((FILE *)SCM_STREAM (port));
return (fd == -1) ? SCM_BOOL_F : SCM_MAKINUM (fd);
if (fd == -1)
SCM_SYSERROR (s_sys_fileno);
return SCM_MAKINUM (fd);
}
SCM_PROC (s_sys_soft_fileno, "%soft-fileno", 1, 0, 0, scm_sys_soft_fileno);
SCM_PROC (s_sys_soft_fileno, "soft-fileno", 1, 0, 0, scm_sys_soft_fileno);
#ifdef __STDC__
SCM
scm_sys_soft_fileno (SCM port)
@ -240,18 +239,17 @@ scm_sys_soft_fileno (port)
#endif
{
int fd;
SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_sys_fileno);
if (!SCM_OPFPORTP (port))
return SCM_BOOL_F;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
fd = fileno ((FILE *)SCM_STREAM (port));
return (fd == -1) ? SCM_BOOL_F : SCM_MAKINUM (fd);
if (fd == -1)
SCM_SYSERROR (s_sys_soft_fileno);
return SCM_MAKINUM (fd);
}
SCM_PROC (s_sys_isatty, "%isatty?", 1, 0, 0, scm_sys_isatty_p);
SCM_PROC (s_sys_isatty, "isatty?", 1, 0, 0, scm_sys_isatty_p);
#ifdef __STDC__
SCM
scm_sys_isatty_p (SCM port)
@ -265,17 +263,14 @@ scm_sys_isatty_p (port)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_isatty);
rv = fileno ((FILE *)SCM_STREAM (port));
if (rv == -1)
return SCM_MAKINUM (errno);
else
{
rv = isatty (rv);
return rv ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_SYSERROR (s_sys_isatty);
rv = isatty (rv);
return rv ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC (s_sys_fdopen, "%fdopen", 2, 0, 0, scm_sys_fdopen);
SCM_PROC (s_sys_fdopen, "fdopen", 2, 0, 0, scm_sys_fdopen);
#ifdef __STDC__
SCM
scm_sys_fdopen (SCM fdes, SCM modes)
@ -294,10 +289,7 @@ scm_sys_fdopen (fdes, modes)
SCM_DEFER_INTS;
f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes));
if (f == NULL)
{
SCM_ALLOW_INTS;
return SCM_MAKINUM (errno);
}
SCM_SYSERROR (s_sys_fdopen);
SCM_NEWCELL (port);
SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes));
SCM_SETSTREAM (port,(SCM)f);
@ -309,12 +301,11 @@ scm_sys_fdopen (fdes, modes)
/* Move a port's underlying file descriptor to a given value.
* Returns: #f for error.
* 0 if fdes is already the given value.
* 1 if fdes moved.
* Returns 0 if fdes is already the given value.
* 1 if fdes moved.
* MOVE->FDES is implemented in Scheme and calls this primitive.
*/
SCM_PROC (s_sys_primitive_move_to_fdes, "%primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
SCM_PROC (s_sys_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
#ifdef __STDC__
SCM
scm_sys_primitive_move_to_fdes (SCM port, SCM fd)
@ -344,19 +335,13 @@ scm_sys_primitive_move_to_fdes (port, fd)
scm_evict_ports (new_fd);
rv = dup2 (old_fd, new_fd);
if (rv == -1)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
}
SCM_SYSERROR (s_sys_primitive_move_to_fdes);
scm_setfileno (stream, new_fd);
SCM_SYSCALL (close (old_fd));
SCM_ALLOW_INTS;
return SCM_MAKINUM (1);
}
/* FIXME */
#ifdef __STDC__
void
scm_setfileno (FILE *fs, int fd)