mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

* debug.c, unif.c: use scm_out_of_range instead of

Browse source 
wta for range errors (ASSERT still needs work).

* error.c, error.h (scm_out_of_range): new procedure.

* error.c, error.h (scm_out_of_range_key): new key.

* posix.c (scm_sync): #else was missing.

* error.c, error.h: append _key to names scm_num_overflow and
scm_system_error.

* __scm.h (SCM_SYSMISSING, SCM_NUM_OVERFLOW): use SCM_BOOL_F instead
of consing an empty list.
(SCM_SYSERROR etc.): move into error.c, make them procedures instead
of macros, saves code and string space.
error.c, fports.c, numbers.c, posix.c, ioext.c, filesys.c, socket.c,
fdsocket.c, simpos.c: change names of SCM_SYSERROR etc., to
lower case.  Rename scm_syserror_m to scm_syserror_msg.
error.h: prototypes for new procedures.
This commit is contained in:
Gary Houston 1996-09-15 06:41:31 +00:00
parent 234f2da620
commit 52859adfb9
13 changed files with 234 additions and 170 deletions
Download patch file Download diff file Expand all files Collapse all files

23
libguile/ChangeLog
View file

@ -1,3 +1,26 @@
Sun Sep 15 03:58:29 1996 Gary Houston <ghouston@actrix.gen.nz>
* debug.c, unif.c: use scm_out_of_range instead of
wta for range errors (ASSERT still needs work).
* error.c, error.h (scm_out_of_range): new procedure.
* error.c, error.h (scm_out_of_range_key): new key.
* posix.c (scm_sync): #else was missing.
* error.c, error.h: append _key to names scm_num_overflow and
scm_system_error.
* __scm.h (SCM_SYSMISSING, SCM_NUM_OVERFLOW): use SCM_BOOL_F instead
of consing an empty list.
(SCM_SYSERROR etc.): move into error.c, make them procedures instead
of macros, saves code and string space.
error.c, fports.c, numbers.c, posix.c, ioext.c, filesys.c, socket.c,
fdsocket.c, simpos.c: change names of SCM_SYSERROR etc., to
lower case. Rename scm_syserror_m to scm_syserror_msg.
error.h: prototypes for new procedures.
Sat Sep 14 03:35:41 1996 Gary Houston <ghouston@actrix.gen.nz> Sat Sep 14 03:35:41 1996 Gary Houston <ghouston@actrix.gen.nz>
* numbers.c: use SCM_NUM_OVERFLOW instead of scm_wta or ASSERT. * numbers.c: use SCM_NUM_OVERFLOW instead of scm_wta or ASSERT.

39
libguile/__scm.h
View file

@ -315,45 +315,6 @@ extern unsigned int scm_async_clock;
#define lgh_error(_key, _subr, _message, _args, _rest) \ #define lgh_error(_key, _subr, _message, _args, _rest) \
scm_error (_key, _subr, _message, _args, _rest) scm_error (_key, _subr, _message, _args, _rest)
#define SCM_SYSERROR(_subr) \
lgh_error (scm_system_error, \
_subr, \
"%S", \
scm_listify (scm_makfrom0str (strerror (errno)), \
SCM_UNDEFINED), \
scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED));
#define SCM_SYSERROR_M(_subr, _message, _args) \
lgh_error (scm_system_error, \
_subr, \
_message, \
_args, \
scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED));
#ifdef ENOSYS
# define SCM_SYSMISSING(_subr) \
lgh_error (scm_system_error, \
_subr, \
"%S", \
scm_listify (scm_makfrom0str (strerror (ENOSYS)), \
SCM_UNDEFINED), \
scm_listify (SCM_MAKINUM (ENOSYS), SCM_UNDEFINED));
#else
# define SCM_SYSMISSING(_subr) \
lgh_error (scm_system_error, \
_subr, \
"missing function", \
scm_listify (SCM_UNDEFINED), \
scm_listify (SCM_MAKINUM (0), SCM_UNDEFINED));
#endif
#define SCM_NUM_OVERFLOW(_subr) \
lgh_error (scm_num_overflow, \
_subr, \
"numerical overflow", \
scm_listify (SCM_UNDEFINED), \
scm_listify (SCM_UNDEFINED));
#define SCM_ARGn 0 #define SCM_ARGn 0
#define SCM_ARG1 1 #define SCM_ARG1 1
#define SCM_ARG2 2 #define SCM_ARG2 2

3
libguile/debug.c
View file

@ -83,8 +83,7 @@ scm_debug_options (setting)
if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE)) if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
{ {
scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, s_debug_options); scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, s_debug_options);
/* *fixme* Should SCM_ALLOW_INTS be called here? */ scm_out_of_range (s_debug_options, setting);
scm_wta (setting, (char *) SCM_OUTOFRANGE, "frames");
} }
#endif #endif
SCM_RESET_DEBUG_MODE; SCM_RESET_DEBUG_MODE;

83
libguile/error.c
View file

@ -166,13 +166,13 @@ scm_everr (exp, env, arg, pos, s_subr)
args = scm_listify (desc, sym, arg, SCM_UNDEFINED); args = scm_listify (desc, sym, arg, SCM_UNDEFINED);
} }
/* (throw (quote system-error) <desc> <proc-name> arg) /* (throw (quote scm_system-error_key) <desc> <proc-name> arg)
* *
* <desc> is a string or an integer (see %%system-errors). * <desc> is a string or an integer (see %%system-errors).
* <proc-name> is a symbol or #f in some annoying cases (e.g. cddr). * <proc-name> is a symbol or #f in some annoying cases (e.g. cddr).
*/ */
scm_ithrow (scm_system_error, args, 1); scm_ithrow (scm_system_error_key, args, 1);
/* No return, but just in case: */ /* No return, but just in case: */
@ -224,8 +224,77 @@ scm_error (key, subr, message, args, rest)
/* error keys: defined here, initialized below, prototyped in error.h, /* error keys: defined here, initialized below, prototyped in error.h,
associated with handler procedures in boot-9.scm. */ associated with handler procedures in boot-9.scm. */
SCM scm_system_error; SCM scm_system_error_key;
SCM scm_num_overflow; SCM scm_num_overflow_key;
SCM scm_out_of_range_key;
/* various convenient interfaces to lgh_error. */
void
scm_syserror (subr)
char *subr;
{
lgh_error (scm_system_error_key,
subr,
"%S",
scm_listify (scm_makfrom0str (strerror (errno)),
SCM_UNDEFINED),
scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED));
}
void
scm_syserror_msg (subr, message, args)
char *subr;
char *message;
SCM args;
{
lgh_error (scm_system_error_key,
subr,
message,
args,
scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED));
}
void
scm_sysmissing (subr)
char *subr;
{
#ifdef ENOSYS
lgh_error (scm_system_error_key,
subr,
"%S",
scm_listify (scm_makfrom0str (strerror (ENOSYS)), SCM_UNDEFINED),
scm_listify (SCM_MAKINUM (ENOSYS), SCM_UNDEFINED));
#else
lgh_error (scm_system_error_key,
subr,
"Missing function",
SCM_BOOL_F,
scm_listify (SCM_MAKINUM (0), SCM_UNDEFINED));
#endif
}
void
scm_num_overflow (subr)
char *subr;
{
lgh_error (scm_num_overflow_key,
subr,
"Numerical overflow",
SCM_BOOL_F,
SCM_BOOL_F);
}
void
scm_out_of_range (subr, bad_value)
char *subr;
SCM bad_value;
{
lgh_error (scm_out_of_range_key,
subr,
"Argument out of range: %S",
scm_listify (bad_value, SCM_UNDEFINED),
SCM_BOOL_F);
}
#ifdef __STDC__ #ifdef __STDC__
void void
@ -235,10 +304,12 @@ void
scm_init_error () scm_init_error ()
#endif #endif
{ {
scm_system_error scm_system_error_key
= scm_permanent_object (SCM_CAR (scm_intern0 ("system-error"))); = scm_permanent_object (SCM_CAR (scm_intern0 ("system-error")));
scm_num_overflow scm_num_overflow_key
= scm_permanent_object (SCM_CAR (scm_intern0 ("numerical-overflow"))); = scm_permanent_object (SCM_CAR (scm_intern0 ("numerical-overflow")));
scm_out_of_range_key
= scm_permanent_object (SCM_CAR (scm_intern0 ("out-of-range")));
#include "error.x" #include "error.x"
} }

17
libguile/error.h
View file

@ -47,13 +47,22 @@
extern int scm_ints_disabled; extern int scm_ints_disabled;
extern SCM scm_system_error;
extern SCM scm_num_overflow; extern SCM scm_system_error_key;
extern SCM scm_num_overflow_key;
extern SCM scm_out_of_range_key;
extern void scm_error SCM_P ((SCM key, char *subr, char *message, SCM args, SCM rest)); extern void scm_error SCM_P ((SCM key, char *subr, char *message,
extern void (*scm_error_callback) SCM_P ((SCM key, char *subr, char *message, SCM args, SCM rest)); SCM args, SCM rest));
extern void (*scm_error_callback) SCM_P ((SCM key, char *subr,
char *message, SCM args, SCM rest));
extern void scm_syserror SCM_P ((char *subr));
extern void scm_syserror_msg SCM_P ((char *subr, char *message, SCM args));
extern void scm_sysmissing SCM_P ((char *subr));
extern void scm_num_overflow SCM_P ((char *subr));
extern void scm_out_of_range SCM_P ((char *subr, SCM bad_value));
#ifdef __STDC__ #ifdef __STDC__
extern int scm_handle_it (int i); extern int scm_handle_it (int i);

74
libguile/filesys.c
View file

@ -176,7 +176,7 @@ scm_sys_chown (path, owner, group)
SCM_SYSCALL (val = chown (SCM_ROCHARS (path), SCM_SYSCALL (val = chown (SCM_ROCHARS (path),
SCM_INUM (owner), SCM_INUM (group))); SCM_INUM (owner), SCM_INUM (group)));
if (val != 0) if (val != 0)
SCM_SYSERROR (s_sys_chown); scm_syserror (s_sys_chown);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -205,7 +205,7 @@ scm_sys_chmod (port_or_path, mode)
SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode))); SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode)));
} }
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_chmod); scm_syserror (s_sys_chmod);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -322,7 +322,7 @@ scm_sys_open (path, flags, mode)
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SYSCALL ( fd = open (SCM_ROCHARS (path), SCM_INUM (flags), SCM_INUM (mode)) ); SCM_SYSCALL ( fd = open (SCM_ROCHARS (path), SCM_INUM (flags), SCM_INUM (mode)) );
if (fd == -1) if (fd == -1)
SCM_SYSERROR (s_sys_open); scm_syserror (s_sys_open);
sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc); sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
@ -353,7 +353,7 @@ scm_sys_create (path, mode)
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) ); SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) );
if (fd == -1) if (fd == -1)
SCM_SYSERROR (s_sys_create); scm_syserror (s_sys_create);
sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc); sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
@ -381,7 +381,7 @@ scm_sys_close (sfd)
SCM_SETCAR (sfd, scm_tc16_fd); SCM_SETCAR (sfd, scm_tc16_fd);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (got == -1) if (got == -1)
SCM_SYSERROR (s_sys_close); scm_syserror (s_sys_close);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -406,7 +406,7 @@ scm_sys_write_fd (sfd, buf)
SCM_DEFER_INTS; SCM_DEFER_INTS;
written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf)); written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf));
if (written == -1) if (written == -1)
SCM_SYSERROR (s_sys_write_fd); scm_syserror (s_sys_write_fd);
answer = scm_long2num (written); answer = scm_long2num (written);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return scm_return_first (answer, buf); return scm_return_first (answer, buf);
@ -458,7 +458,7 @@ scm_sys_read_fd (sfd, buf, offset, length)
SCM_DEFER_INTS; SCM_DEFER_INTS;
got = read (fd, bytes + off, len); got = read (fd, bytes + off, len);
if (got == -1) if (got == -1)
SCM_SYSERROR (s_sys_read_fd); scm_syserror (s_sys_read_fd);
answer = scm_long2num (got); answer = scm_long2num (got);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return scm_return_first (answer, buf); return scm_return_first (answer, buf);
@ -497,7 +497,7 @@ scm_sys_lseek (sfd, offset, whence)
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SYSCALL (got = lseek (fd, off, wh)); SCM_SYSCALL (got = lseek (fd, off, wh));
if (got == -1) if (got == -1)
SCM_SYSERROR (s_sys_lseek); scm_syserror (s_sys_lseek);
answer = scm_long2num (got); answer = scm_long2num (got);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return answer; return answer;
@ -529,7 +529,7 @@ scm_sys_dup (oldfd, newfd)
fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2); fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2);
nfd = fn (fd, nfd); nfd = fn (fd, nfd);
if (nfd == -1) if (nfd == -1)
SCM_SYSERROR (s_sys_dup); scm_syserror (s_sys_dup);
answer = SCM_MAKINUM (nfd); answer = SCM_MAKINUM (nfd);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return answer; return answer;
@ -616,7 +616,7 @@ scm_sys_stat (fd_or_path)
} }
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_stat); scm_syserror (s_sys_stat);
return scm_stat2scm (&stat_temp); return scm_stat2scm (&stat_temp);
} }
@ -646,7 +646,7 @@ scm_sys_link (oldpath, newpath)
newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0); newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0);
SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath))); SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0) if (val != 0)
SCM_SYSERROR (s_sys_link); scm_syserror (s_sys_link);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -669,7 +669,7 @@ scm_sys_rename (oldname, newname)
#ifdef HAVE_RENAME #ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname))); SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname)));
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_rename); scm_syserror (s_sys_rename);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_DEFER_INTS; SCM_DEFER_INTS;
@ -683,7 +683,7 @@ scm_sys_rename (oldname, newname)
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_rename); scm_syserror (s_sys_rename);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#endif #endif
} }
@ -703,7 +703,7 @@ scm_sys_delete_file (str)
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_delete_file); SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_delete_file);
SCM_SYSCALL (ans = unlink (SCM_CHARS (str))); SCM_SYSCALL (ans = unlink (SCM_CHARS (str)));
if (ans != 0) if (ans != 0)
SCM_SYSERROR (s_sys_delete_file); scm_syserror (s_sys_delete_file);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -735,10 +735,10 @@ scm_sys_mkdir (path, mode)
SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode))); SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode)));
} }
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_mkdir); scm_syserror (s_sys_mkdir);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_mkdir); scm_sysmissing (s_sys_mkdir);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -761,10 +761,10 @@ scm_sys_rmdir (path)
SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir); SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir);
SCM_SYSCALL (val = rmdir (SCM_CHARS (path))); SCM_SYSCALL (val = rmdir (SCM_CHARS (path)));
if (val != 0) if (val != 0)
SCM_SYSERROR (s_sys_rmdir); scm_syserror (s_sys_rmdir);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_rmdir); scm_sysmissing (s_sys_rmdir);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -793,7 +793,7 @@ scm_sys_opendir (dirname)
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname))); SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname)));
if (ds == NULL) if (ds == NULL)
SCM_SYSERROR (s_sys_opendir); scm_syserror (s_sys_opendir);
SCM_CAR (dir) = scm_tc16_dir | SCM_OPN; SCM_CAR (dir) = scm_tc16_dir | SCM_OPN;
SCM_SETCDR (dir, ds); SCM_SETCDR (dir, ds);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
@ -818,7 +818,7 @@ scm_sys_readdir (port)
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port))); SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (errno != 0) if (errno != 0)
SCM_SYSERROR (s_sys_readdir); scm_syserror (s_sys_readdir);
return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0) return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
: SCM_EOF_VAL); : SCM_EOF_VAL);
} }
@ -863,7 +863,7 @@ scm_sys_closedir (port)
} }
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port))); SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
if (sts != 0) if (sts != 0)
SCM_SYSERROR (s_sys_closedir); scm_syserror (s_sys_closedir);
SCM_CAR (port) = scm_tc16_dir; SCM_CAR (port) = scm_tc16_dir;
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -922,7 +922,7 @@ scm_sys_chdir (str)
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_chdir); SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_chdir);
SCM_SYSCALL (ans = chdir (SCM_CHARS (str))); SCM_SYSCALL (ans = chdir (SCM_CHARS (str)));
if (ans != 0) if (ans != 0)
SCM_SYSERROR (s_sys_chdir); scm_syserror (s_sys_chdir);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -953,13 +953,13 @@ scm_sys_getcwd ()
wd = scm_must_malloc (size, s_sys_getcwd); wd = scm_must_malloc (size, s_sys_getcwd);
} }
if (rv == 0) if (rv == 0)
SCM_SYSERROR (s_sys_getcwd); scm_syserror (s_sys_getcwd);
result = scm_makfromstr (wd, strlen (wd), 0); result = scm_makfromstr (wd, strlen (wd), 0);
scm_must_free (wd); scm_must_free (wd);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return result; return result;
#else #else
SCM_SYSMISSING (s_sys_getcwd); scm_sysmissing (s_sys_getcwd);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1082,13 +1082,13 @@ scm_sys_select (reads, writes, excepts, secs, msecs)
&read_set, &write_set, &except_set, time_p); &read_set, &write_set, &except_set, time_p);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (sreturn < 0) if (sreturn < 0)
SCM_SYSERROR (s_sys_select); scm_syserror (s_sys_select);
return scm_listify (retrieve_select_type (&read_set, reads), return scm_listify (retrieve_select_type (&read_set, reads),
retrieve_select_type (&write_set, writes), retrieve_select_type (&write_set, writes),
retrieve_select_type (&except_set, excepts), retrieve_select_type (&except_set, excepts),
SCM_UNDEFINED); SCM_UNDEFINED);
#else #else
SCM_SYSMISSING (s_sys_select); scm_sysmissing (s_sys_select);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1116,10 +1116,10 @@ scm_sys_symlink(oldpath, newpath)
SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_sys_symlink); SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_sys_symlink);
SCM_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath))); SCM_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath)));
if (val != 0) if (val != 0)
SCM_SYSERROR (s_sys_symlink); scm_syserror (s_sys_symlink);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_symlink); scm_sysmissing (s_sys_symlink);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1151,13 +1151,13 @@ scm_sys_readlink(path)
buf = scm_must_malloc (size, s_sys_readlink); buf = scm_must_malloc (size, s_sys_readlink);
} }
if (rv == -1) if (rv == -1)
SCM_SYSERROR (s_sys_readlink); scm_syserror (s_sys_readlink);
result = scm_makfromstr (buf, rv, 0); result = scm_makfromstr (buf, rv, 0);
scm_must_free (buf); scm_must_free (buf);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return result; return result;
#else #else
SCM_SYSMISSING (s_sys_readlink); scm_sysmissing (s_sys_readlink);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1181,10 +1181,10 @@ scm_sys_lstat(str)
SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_sys_lstat); SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_sys_lstat);
SCM_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp)); SCM_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp));
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_lstat); scm_syserror (s_sys_lstat);
return scm_stat2scm(&stat_temp); return scm_stat2scm(&stat_temp);
#else #else
SCM_SYSMISSING (s_sys_lstat); scm_sysmissing (s_sys_lstat);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1214,28 +1214,28 @@ scm_sys_copy_file (oldfile, newfile)
if (SCM_SUBSTRP (newfile)) if (SCM_SUBSTRP (newfile))
newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0); newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0);
if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1) if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
SCM_SYSERROR (s_sys_copy_file); scm_syserror (s_sys_copy_file);
SCM_DEFER_INTS; SCM_DEFER_INTS;
oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY); oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
if (oldfd == -1) if (oldfd == -1)
SCM_SYSERROR (s_sys_copy_file); scm_syserror (s_sys_copy_file);
/* use POSIX flags instead of 07777?. */ /* use POSIX flags instead of 07777?. */
newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC, newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
oldstat.st_mode & 07777); oldstat.st_mode & 07777);
if (newfd == -1) if (newfd == -1)
SCM_SYSERROR (s_sys_copy_file); scm_syserror (s_sys_copy_file);
while ((n = read (oldfd, buf, sizeof buf)) > 0) while ((n = read (oldfd, buf, sizeof buf)) > 0)
if (write (newfd, buf, n) != n) if (write (newfd, buf, n) != n)
{ {
close (oldfd); close (oldfd);
close (newfd); close (newfd);
SCM_SYSERROR (s_sys_copy_file); scm_syserror (s_sys_copy_file);
} }
close (oldfd); close (oldfd);
if (close (newfd) == -1) if (close (newfd) == -1)
SCM_SYSERROR (s_sys_copy_file); scm_syserror (s_sys_copy_file);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }

8
libguile/fports.c
View file

@ -196,10 +196,10 @@ scm_open_file (filename, modes)
port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes)); port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes));
if (port == SCM_BOOL_F) { if (port == SCM_BOOL_F) {
SCM_SYSERROR_M (s_open_file, "%S: %S", scm_syserror_msg (s_open_file, "%S: %S",
scm_listify (scm_makfrom0str (strerror (errno)), scm_listify (scm_makfrom0str (strerror (errno)),
filename, filename,
SCM_UNDEFINED)); SCM_UNDEFINED));
/* Force the compiler to keep filename and modes alive. */ /* Force the compiler to keep filename and modes alive. */
scm_cons (filename, modes); scm_cons (filename, modes);
} }

24
libguile/ioext.c
View file

@ -70,7 +70,7 @@ scm_sys_ftell (port)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_ftell); SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_ftell);
SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port))); SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
if (pos < 0) if (pos < 0)
SCM_SYSERROR (s_sys_ftell); scm_syserror (s_sys_ftell);
if (pos > 0 && SCM_CRDYP (port)) if (pos > 0 && SCM_CRDYP (port))
pos--; pos--;
return SCM_MAKINUM (pos); return SCM_MAKINUM (pos);
@ -99,7 +99,7 @@ scm_sys_fseek (port, offset, whence)
/* Values of whence are interned in scm_init_ioext. */ /* Values of whence are interned in scm_init_ioext. */
rv = fseek ((FILE *)SCM_STREAM (port), SCM_INUM (offset), SCM_INUM (whence)); rv = fseek ((FILE *)SCM_STREAM (port), SCM_INUM (offset), SCM_INUM (whence));
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_fseek); scm_syserror (s_sys_fseek);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -165,15 +165,15 @@ scm_sys_duplicate_port (oldpt, modes)
SCM_DEFER_INTS; SCM_DEFER_INTS;
oldfd = fileno ((FILE *)SCM_STREAM (oldpt)); oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
if (oldfd == -1) if (oldfd == -1)
SCM_SYSERROR (s_sys_duplicate_port); scm_syserror (s_sys_duplicate_port);
SCM_SYSCALL (newfd = dup (oldfd)); SCM_SYSCALL (newfd = dup (oldfd));
if (newfd == -1) if (newfd == -1)
SCM_SYSERROR (s_sys_duplicate_port); scm_syserror (s_sys_duplicate_port);
f = fdopen (newfd, SCM_CHARS (modes)); f = fdopen (newfd, SCM_CHARS (modes));
if (!f) if (!f)
{ {
SCM_SYSCALL (close (newfd)); SCM_SYSCALL (close (newfd));
SCM_SYSERROR (s_sys_duplicate_port); scm_syserror (s_sys_duplicate_port);
} }
{ {
struct scm_port_table * pt; struct scm_port_table * pt;
@ -207,13 +207,13 @@ scm_sys_redirect_port (into_pt, from_pt)
SCM_ASSERT (SCM_NIMP (from_pt) && SCM_OPPORTP (from_pt), from_pt, SCM_ARG2, 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)); oldfd = fileno ((FILE *)SCM_STREAM (into_pt));
if (oldfd == -1) if (oldfd == -1)
SCM_SYSERROR (s_sys_redirect_port); scm_syserror (s_sys_redirect_port);
newfd = fileno ((FILE *)SCM_STREAM (from_pt)); newfd = fileno ((FILE *)SCM_STREAM (from_pt));
if (newfd == -1) if (newfd == -1)
SCM_SYSERROR (s_sys_redirect_port); scm_syserror (s_sys_redirect_port);
SCM_SYSCALL (ans = dup2 (oldfd, newfd)); SCM_SYSCALL (ans = dup2 (oldfd, newfd));
if (ans == -1) if (ans == -1)
SCM_SYSERROR (s_sys_redirect_port); scm_syserror (s_sys_redirect_port);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -232,7 +232,7 @@ scm_sys_fileno (port)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno); SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
fd = fileno ((FILE *)SCM_STREAM (port)); fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1) if (fd == -1)
SCM_SYSERROR (s_sys_fileno); scm_syserror (s_sys_fileno);
return SCM_MAKINUM (fd); return SCM_MAKINUM (fd);
} }
@ -250,7 +250,7 @@ scm_sys_isatty_p (port)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_isatty); SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_isatty);
rv = fileno ((FILE *)SCM_STREAM (port)); rv = fileno ((FILE *)SCM_STREAM (port));
if (rv == -1) if (rv == -1)
SCM_SYSERROR (s_sys_isatty); scm_syserror (s_sys_isatty);
rv = isatty (rv); rv = isatty (rv);
return rv ? SCM_BOOL_T : SCM_BOOL_F; return rv ? SCM_BOOL_T : SCM_BOOL_F;
} }
@ -278,7 +278,7 @@ scm_sys_fdopen (fdes, modes)
SCM_DEFER_INTS; SCM_DEFER_INTS;
f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes)); f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes));
if (f == NULL) if (f == NULL)
SCM_SYSERROR (s_sys_fdopen); scm_syserror (s_sys_fdopen);
pt = scm_add_to_port_table (port); pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt); SCM_SETPTAB_ENTRY (port, pt);
if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport
@ -326,7 +326,7 @@ scm_sys_primitive_move_to_fdes (port, fd)
scm_evict_ports (new_fd); scm_evict_ports (new_fd);
rv = dup2 (old_fd, new_fd); rv = dup2 (old_fd, new_fd);
if (rv == -1) if (rv == -1)
SCM_SYSERROR (s_sys_primitive_move_to_fdes); scm_syserror (s_sys_primitive_move_to_fdes);
scm_setfileno (stream, new_fd); scm_setfileno (stream, new_fd);
SCM_SYSCALL (close (old_fd)); SCM_SYSCALL (close (old_fd));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;

28
libguile/numbers.c
View file

@ -166,7 +166,7 @@ scm_abs(x)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
return scm_long2big(x); return scm_long2big(x);
#else #else
SCM_NUM_OVERFLOW (s_abs); scm_num_overflow (s_abs);
#endif #endif
return SCM_MAKINUM(x); return SCM_MAKINUM(x);
} }
@ -229,7 +229,7 @@ scm_quotient(x, y)
SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_quotient); SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_quotient);
#endif #endif
if ((z = SCM_INUM(y))==0) if ((z = SCM_INUM(y))==0)
ov: SCM_NUM_OVERFLOW (s_quotient); ov: scm_num_overflow (s_quotient);
z = SCM_INUM(x)/z; z = SCM_INUM(x)/z;
#ifdef BADIVSGNS #ifdef BADIVSGNS
{ {
@ -249,7 +249,7 @@ scm_quotient(x, y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
return scm_long2big(z); return scm_long2big(z);
#else #else
SCM_NUM_OVERFLOW (s_quotient); scm_num_overflow (s_quotient);
#endif #endif
return SCM_MAKINUM(z); return SCM_MAKINUM(z);
} }
@ -289,7 +289,7 @@ scm_remainder(x, y)
SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_remainder); SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_remainder);
#endif #endif
if (!(z = SCM_INUM(y))) if (!(z = SCM_INUM(y)))
ov: SCM_NUM_OVERFLOW (s_remainder); ov: scm_num_overflow (s_remainder);
#if (__TURBOC__==1) #if (__TURBOC__==1)
if (z < 0) z = -z; if (z < 0) z = -z;
#endif #endif
@ -339,7 +339,7 @@ scm_modulo(x, y)
SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_modulo); SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_modulo);
#endif #endif
if (!(yy = SCM_INUM(y))) if (!(yy = SCM_INUM(y)))
ov: SCM_NUM_OVERFLOW (s_modulo); ov: scm_num_overflow (s_modulo);
#if (__TURBOC__==1) #if (__TURBOC__==1)
z = SCM_INUM(x); z = SCM_INUM(x);
z = ((yy<0) ? -z : z)%yy; z = ((yy<0) ? -z : z)%yy;
@ -410,7 +410,7 @@ scm_gcd(x, y)
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
return scm_long2big(u); return scm_long2big(u);
#else #else
SCM_NUM_OVERFLOW (s_gcd); scm_num_overflow (s_gcd);
#endif #endif
return SCM_MAKINUM(u); return SCM_MAKINUM(u);
} }
@ -676,7 +676,7 @@ scm_ash(n, cnt)
if (cnt < 0) return SCM_MAKINUM(SCM_SRS(res, -cnt)); if (cnt < 0) return SCM_MAKINUM(SCM_SRS(res, -cnt));
res = SCM_MAKINUM(res<<cnt); res = SCM_MAKINUM(res<<cnt);
if (SCM_INUM(res)>>cnt != SCM_INUM(n)) if (SCM_INUM(res)>>cnt != SCM_INUM(n))
SCM_NUM_OVERFLOW (s_ash); scm_num_overflow (s_ash);
return res; return res;
#endif #endif
} }
@ -1676,7 +1676,7 @@ scm_istr2int(str, len, radix)
t2 = SCM_BIGDN(t2); t2 = SCM_BIGDN(t2);
} }
if (blen > j) if (blen > j)
SCM_NUM_OVERFLOW ("bignum"); scm_num_overflow ("bignum");
if (t2) {blen++; goto moretodo;} if (t2) {blen++; goto moretodo;}
break; break;
default: default:
@ -2810,7 +2810,7 @@ scm_sum(x, y)
# ifdef SCM_FLOATS # ifdef SCM_FLOATS
return scm_makdbl((double)x, 0.0); return scm_makdbl((double)x, 0.0);
# else # else
SCM_NUM_OVERFLOW (s_sum); scm_num_overflow (s_sum);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
# endif # endif
#endif #endif
@ -2953,7 +2953,7 @@ scm_difference(x, y)
# ifdef SCM_FLOATS # ifdef SCM_FLOATS
return scm_makdbl((double)x, 0.0); return scm_makdbl((double)x, 0.0);
# else # else
SCM_NUM_OVERFLOW (s_difference); scm_num_overflow (s_difference);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
# endif # endif
#endif #endif
@ -3107,7 +3107,7 @@ scm_product(x, y)
# ifdef SCM_FLOATS # ifdef SCM_FLOATS
return scm_makdbl(((double)i)*((double)j), 0.0); return scm_makdbl(((double)i)*((double)j), 0.0);
# else # else
SCM_NUM_OVERFLOW (s_product); scm_num_overflow (s_product);
# endif # endif
#endif #endif
return y; return y;
@ -3187,7 +3187,7 @@ scm_divide(x, y)
z = SCM_INUM(y); z = SCM_INUM(y);
#ifndef RECKLESS #ifndef RECKLESS
if (!z) if (!z)
SCM_NUM_OVERFLOW (s_divide); scm_num_overflow (s_divide);
#endif #endif
if (1==z) return x; if (1==z) return x;
if (z < 0) z = -z; if (z < 0) z = -z;
@ -3328,7 +3328,7 @@ scm_divide(x, y)
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
ov: return scm_makdbl(((double)SCM_INUM(x))/((double)SCM_INUM(y)), 0.0); ov: return scm_makdbl(((double)SCM_INUM(x))/((double)SCM_INUM(y)), 0.0);
#else #else
ov: SCM_NUM_OVERFLOW (s_divide); ov: scm_num_overflow (s_divide);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#endif #endif
} }
@ -3775,7 +3775,7 @@ scm_dbl2big(d)
} }
#ifndef RECKLESS #ifndef RECKLESS
if (u != 0) if (u != 0)
SCM_NUM_OVERFLOW ("dbl2big"); scm_num_overflow ("dbl2big");
#endif #endif
return ans; return ans;
} }

87
libguile/posix.c
View file

@ -206,13 +206,13 @@ scm_sys_pipe ()
SCM_NEWCELL (p_wt); SCM_NEWCELL (p_wt);
rv = pipe (fd); rv = pipe (fd);
if (rv) if (rv)
SCM_SYSERROR (s_sys_pipe); scm_syserror (s_sys_pipe);
f_rd = fdopen (fd[0], "r"); f_rd = fdopen (fd[0], "r");
if (!f_rd) if (!f_rd)
{ {
SCM_SYSCALL (close (fd[0])); SCM_SYSCALL (close (fd[0]));
SCM_SYSCALL (close (fd[1])); SCM_SYSCALL (close (fd[1]));
SCM_SYSERROR (s_sys_pipe); scm_syserror (s_sys_pipe);
} }
f_wt = fdopen (fd[1], "w"); f_wt = fdopen (fd[1], "w");
if (!f_wt) if (!f_wt)
@ -222,7 +222,7 @@ scm_sys_pipe ()
fclose (f_rd); fclose (f_rd);
SCM_SYSCALL (close (fd[1])); SCM_SYSCALL (close (fd[1]));
errno = en; errno = en;
SCM_SYSERROR (s_sys_pipe); scm_syserror (s_sys_pipe);
} }
ptr = scm_add_to_port_table (p_rd); ptr = scm_add_to_port_table (p_rd);
ptw = scm_add_to_port_table (p_wt); ptw = scm_add_to_port_table (p_wt);
@ -251,7 +251,7 @@ scm_sys_getgroups()
SCM grps, ans; SCM grps, ans;
int ngroups = getgroups (0, NULL); int ngroups = getgroups (0, NULL);
if (!ngroups) if (!ngroups)
SCM_SYSERROR (s_sys_getgroups); scm_syserror (s_sys_getgroups);
SCM_NEWCELL(grps); SCM_NEWCELL(grps);
SCM_DEFER_INTS; SCM_DEFER_INTS;
{ {
@ -264,7 +264,7 @@ scm_sys_getgroups()
if (val < 0) if (val < 0)
{ {
scm_must_free((char *)groups); scm_must_free((char *)groups);
SCM_SYSERROR (s_sys_getgroups); scm_syserror (s_sys_getgroups);
} }
SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */ SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string); SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
@ -313,7 +313,7 @@ scm_sys_getpwuid (user)
entry = getpwnam (SCM_ROCHARS (user)); entry = getpwnam (SCM_ROCHARS (user));
} }
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_getpwuid); scm_syserror (s_sys_getpwuid);
ve[0] = scm_makfrom0str (entry->pw_name); ve[0] = scm_makfrom0str (entry->pw_name);
ve[1] = scm_makfrom0str (entry->pw_passwd); ve[1] = scm_makfrom0str (entry->pw_passwd);
@ -382,7 +382,7 @@ scm_sys_getgrgid (name)
SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name))); SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name)));
} }
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_getgrgid); scm_syserror (s_sys_getgrgid);
ve[0] = scm_makfrom0str (entry->gr_name); ve[0] = scm_makfrom0str (entry->gr_name);
ve[1] = scm_makfrom0str (entry->gr_passwd); ve[1] = scm_makfrom0str (entry->gr_passwd);
@ -428,7 +428,7 @@ scm_sys_kill (pid, sig)
SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill); SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill);
/* Signal values are interned in scm_init_posix(). */ /* Signal values are interned in scm_init_posix(). */
if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0) if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
SCM_SYSERROR (s_sys_kill); scm_syserror (s_sys_kill);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -460,10 +460,10 @@ scm_sys_waitpid (pid, options)
} }
SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions)); SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
if (i == -1) if (i == -1)
SCM_SYSERROR (s_sys_waitpid); scm_syserror (s_sys_waitpid);
return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)); return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
#else #else
SCM_SYSMISSING (s_sys_waitpid); scm_sysmissing (s_sys_waitpid);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -560,7 +560,7 @@ scm_sys_setuid (id)
{ {
SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid); SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
if (setuid (SCM_INUM (id)) != 0) if (setuid (SCM_INUM (id)) != 0)
SCM_SYSERROR (s_sys_setuid); scm_syserror (s_sys_setuid);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -576,7 +576,7 @@ scm_sys_setgid (id)
{ {
SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid); SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
if (setgid (SCM_INUM (id)) != 0) if (setgid (SCM_INUM (id)) != 0)
SCM_SYSERROR (s_sys_setgid); scm_syserror (s_sys_setgid);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -599,7 +599,7 @@ scm_sys_seteuid (id)
rv = setuid (SCM_INUM (id)); rv = setuid (SCM_INUM (id));
#endif #endif
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_seteuid); scm_syserror (s_sys_seteuid);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -622,7 +622,7 @@ scm_sys_setegid (id)
rv = setgid (SCM_INUM (id)); rv = setgid (SCM_INUM (id));
#endif #endif
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_setegid); scm_syserror (s_sys_setegid);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -646,10 +646,10 @@ scm_setpgid (pid, pgid)
SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_sys_setpgid); SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_sys_setpgid);
/* FIXME(?): may be known as setpgrp. */ /* FIXME(?): may be known as setpgrp. */
if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
SCM_SYSERROR (s_sys_setpgid); scm_syserror (s_sys_setpgid);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_setpgid); scm_sysmissing (s_sys_setpgid);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -662,10 +662,10 @@ scm_setsid ()
#ifdef HAVE_SETSID #ifdef HAVE_SETSID
pid_t sid = setsid (); pid_t sid = setsid ();
if (sid == -1) if (sid == -1)
SCM_SYSERROR (s_sys_setsid); scm_syserror (s_sys_setsid);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_setsid); scm_sysmissing (s_sys_setsid);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -688,10 +688,10 @@ scm_ttyname (port)
return SCM_BOOL_F; return SCM_BOOL_F;
fd = fileno ((FILE *)SCM_STREAM (port)); fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1) if (fd == -1)
SCM_SYSERROR (s_ttyname); scm_syserror (s_ttyname);
SCM_SYSCALL (ans = ttyname (fd)); SCM_SYSCALL (ans = ttyname (fd));
if (!ans) if (!ans)
SCM_SYSERROR (s_ttyname); scm_syserror (s_ttyname);
/* ans could be overwritten by another call to ttyname */ /* ans could be overwritten by another call to ttyname */
return (scm_makfrom0str (ans)); return (scm_makfrom0str (ans));
} }
@ -704,10 +704,10 @@ scm_ctermid ()
#ifdef HAVE_CTERMID #ifdef HAVE_CTERMID
char *result = ctermid (NULL); char *result = ctermid (NULL);
if (*result == '\0') if (*result == '\0')
SCM_SYSERROR (s_sys_ctermid); scm_syserror (s_sys_ctermid);
return scm_makfrom0str (result); return scm_makfrom0str (result);
#else #else
SCM_SYSMISSING (s_sys_ctermid); scm_sysmissing (s_sys_ctermid);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -724,10 +724,10 @@ scm_tcgetpgrp (port)
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_tcgetpgrp); SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_tcgetpgrp);
fd = fileno ((FILE *)SCM_STREAM (port)); fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1) if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1)
SCM_SYSERROR (s_sys_tcgetpgrp); scm_syserror (s_sys_tcgetpgrp);
return SCM_MAKINUM (pgid); return SCM_MAKINUM (pgid);
#else #else
SCM_SYSMISSING (s_sys_tcgetpgrp); scm_sysmissing (s_sys_tcgetpgrp);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -744,10 +744,10 @@ scm_tcsetpgrp (port, pgid)
SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_sys_tcsetpgrp); SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_sys_tcsetpgrp);
fd = fileno ((FILE *)SCM_STREAM (port)); fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1) if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
SCM_SYSERROR (s_sys_tcsetpgrp); scm_syserror (s_sys_tcsetpgrp);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_tcsetpgrp); scm_sysmissing (s_sys_tcsetpgrp);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -807,7 +807,7 @@ scm_sys_execl (args)
args = SCM_CDR (args); args = SCM_CDR (args);
execargv = scm_convert_exec_args (args); execargv = scm_convert_exec_args (args);
execv (SCM_ROCHARS (filename), execargv); execv (SCM_ROCHARS (filename), execargv);
SCM_SYSERROR (s_sys_execl); scm_syserror (s_sys_execl);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -830,7 +830,7 @@ scm_sys_execlp (args)
args = SCM_CDR (args); args = SCM_CDR (args);
execargv = scm_convert_exec_args (args); execargv = scm_convert_exec_args (args);
execvp (SCM_ROCHARS (filename), execargv); execvp (SCM_ROCHARS (filename), execargv);
SCM_SYSERROR (s_sys_execlp); scm_syserror (s_sys_execlp);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -848,7 +848,7 @@ scm_sys_fork()
int pid; int pid;
pid = fork (); pid = fork ();
if (pid == -1) if (pid == -1)
SCM_SYSERROR (s_sys_fork); scm_syserror (s_sys_fork);
return SCM_MAKINUM (0L+pid); return SCM_MAKINUM (0L+pid);
} }
@ -879,7 +879,7 @@ scm_sys_uname ()
*/ */
return ans; return ans;
#else #else
SCM_SYSMISSING (s_sys_uname); scm_sysmissing (s_sys_uname);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -970,7 +970,7 @@ scm_open_pipe (pipestr, modes)
SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes))); SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
scm_unignore_signals (); scm_unignore_signals ();
if (!f) if (!f)
SCM_SYSERROR (s_open_pipe); scm_syserror (s_open_pipe);
pt = scm_add_to_port_table (z); pt = scm_add_to_port_table (z);
SCM_SETPTAB_ENTRY (z, pt); SCM_SETPTAB_ENTRY (z, pt);
SCM_CAR (z) = scm_tc16_pipe | SCM_OPN SCM_CAR (z) = scm_tc16_pipe | SCM_OPN
@ -1037,7 +1037,7 @@ scm_sys_utime (pathname, actime, modtime)
SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp)); SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
if (rv != 0) if (rv != 0)
SCM_SYSERROR (s_sys_utime); scm_syserror (s_sys_utime);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -1088,7 +1088,7 @@ scm_sys_putenv (str)
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv); SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv);
return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
#else #else
SCM_SYSMISSING (s_sys_putenv); scm_sysmissing (s_sys_putenv);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1243,10 +1243,10 @@ scm_setlocale (category, locale)
rv = setlocale (SCM_INUM (category), clocale); rv = setlocale (SCM_INUM (category), clocale);
if (rv == NULL) if (rv == NULL)
SCM_SYSERROR (s_setlocale); scm_syserror (s_setlocale);
return scm_makfrom0str (rv); return scm_makfrom0str (rv);
#else #else
SCM_SYSMISSING (s_setlocale); scm_sysmissing (s_setlocale);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1351,7 +1351,7 @@ scm_sys_strptime (format, string)
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (rest == NULL) if (rest == NULL)
SCM_SYSERROR (s_sys_strptime); scm_syserror (s_sys_strptime);
stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED); stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED);
@ -1370,7 +1370,7 @@ scm_sys_strptime (format, string)
return scm_cons (stime, scm_makfrom0str (rest)); return scm_cons (stime, scm_makfrom0str (rest));
#else #else
SCM_SYSMISSING (s_sys_strptime); scm_sysmissing (s_sys_strptime);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1395,10 +1395,10 @@ scm_sys_mknod(path, mode, dev)
SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod); SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod);
SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev))); SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev)));
if (val != 0) if (val != 0)
SCM_SYSERROR (s_sys_mknod); scm_syserror (s_sys_mknod);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_mknod); scm_sysmissing (s_sys_mknod);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1418,10 +1418,10 @@ scm_sys_nice(incr)
#ifdef HAVE_NICE #ifdef HAVE_NICE
SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice); SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
if (nice(SCM_INUM(incr)) != 0) if (nice(SCM_INUM(incr)) != 0)
SCM_SYSERROR (s_sys_nice); scm_syserror (s_sys_nice);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_SYSMISSING (s_sys_nice); scm_sysmissing (s_sys_nice);
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
#endif #endif
@ -1439,9 +1439,10 @@ scm_sync()
{ {
#ifdef HAVE_SYNC #ifdef HAVE_SYNC
sync(); sync();
#endif #else
SCM_SYSMISSING (s_sync); scm_sysmissing (s_sync);
/* not reached. */ /* not reached. */
#endif
return SCM_BOOL_F; return SCM_BOOL_F;
} }

2
libguile/simpos.c
View file

@ -99,7 +99,7 @@ scm_sys_getenv(nam)
nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0); nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0);
val = getenv(SCM_CHARS(nam)); val = getenv(SCM_CHARS(nam));
if (!val) if (!val)
SCM_SYSERROR (s_sys_getenv); scm_syserror (s_sys_getenv);
return scm_makfromstr(val, (scm_sizet)strlen(val), 0); return scm_makfromstr(val, (scm_sizet)strlen(val), 0);
} }

12
libguile/socket.c
View file

@ -87,7 +87,7 @@ scm_sys_inet_aton (address)
if (SCM_SUBSTRP (address)) if (SCM_SUBSTRP (address))
address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0); address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0);
if (inet_aton (SCM_ROCHARS (address), &soka) == 0) if (inet_aton (SCM_ROCHARS (address), &soka) == 0)
SCM_SYSERROR (s_sys_inet_aton); scm_syserror (s_sys_inet_aton);
return scm_ulong2num (ntohl (soka.s_addr)); return scm_ulong2num (ntohl (soka.s_addr));
} }
@ -208,7 +208,7 @@ scm_sys_gethost (name)
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_gethost); scm_syserror (s_sys_gethost);
ve[0] = scm_makfromstr (entry->h_name, (scm_sizet) strlen (entry->h_name), 0); ve[0] = scm_makfromstr (entry->h_name, (scm_sizet) strlen (entry->h_name), 0);
ve[1] = scm_makfromstrs (-1, entry->h_aliases); ve[1] = scm_makfromstrs (-1, entry->h_aliases);
ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L);
@ -264,7 +264,7 @@ scm_sys_getnet (name)
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_getnet); scm_syserror (s_sys_getnet);
ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name), 0); ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name), 0);
ve[1] = scm_makfromstrs (-1, entry->n_aliases); ve[1] = scm_makfromstrs (-1, entry->n_aliases);
ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L);
@ -307,7 +307,7 @@ scm_sys_getproto (name)
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_getproto); scm_syserror (s_sys_getproto);
ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name), 0); ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name), 0);
ve[1] = scm_makfromstrs (-1, entry->p_aliases); ve[1] = scm_makfromstrs (-1, entry->p_aliases);
ve[2] = SCM_MAKINUM (entry->p_proto + 0L); ve[2] = SCM_MAKINUM (entry->p_proto + 0L);
@ -353,7 +353,7 @@ scm_sys_getserv (name, proto)
SCM_DEFER_INTS; SCM_DEFER_INTS;
entry = getservent (); entry = getservent ();
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_getserv); scm_syserror (s_sys_getserv);
return scm_return_entry (entry); return scm_return_entry (entry);
} }
SCM_ASSERT (SCM_NIMP (proto) && SCM_STRINGP (proto), proto, SCM_ARG2, s_sys_getserv); SCM_ASSERT (SCM_NIMP (proto) && SCM_STRINGP (proto), proto, SCM_ARG2, s_sys_getserv);
@ -369,7 +369,7 @@ scm_sys_getserv (name, proto)
entry = getservbyport (SCM_INUM (name), SCM_CHARS (proto)); entry = getservbyport (SCM_INUM (name), SCM_CHARS (proto));
} }
if (!entry) if (!entry)
SCM_SYSERROR (s_sys_getserv); scm_syserror (s_sys_getserv);
return scm_return_entry (entry); return scm_return_entry (entry);
} }

4
libguile/unif.c
View file

@ -1128,7 +1128,7 @@ scm_uniform_vector_ref (v, args)
if (SCM_NULLP (args)) if (SCM_NULLP (args))
return v; return v;
badarg:scm_wta (v, (char *) SCM_ARG1, s_uniform_vector_ref); badarg:scm_wta (v, (char *) SCM_ARG1, s_uniform_vector_ref);
outrng:scm_wta (SCM_MAKINUM (pos), (char *) SCM_OUTOFRANGE, s_uniform_vector_ref); outrng:scm_out_of_range (s_uniform_vector_ref, SCM_MAKINUM (pos));
wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_uniform_vector_ref); wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_uniform_vector_ref);
case scm_tc7_smob: case scm_tc7_smob:
{ /* enclosed */ { /* enclosed */
@ -1321,7 +1321,7 @@ scm_array_set_x (v, obj, args)
{ {
default: default:
badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_set_x); badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_set_x);
outrng:scm_wta (SCM_MAKINUM (pos), (char *) SCM_OUTOFRANGE, s_array_set_x); outrng:scm_out_of_range (s_array_set_x, SCM_MAKINUM (pos));
wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_array_set_x); wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_array_set_x);
case scm_tc7_smob: /* enclosed */ case scm_tc7_smob: /* enclosed */
goto badarg1; goto badarg1;