diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 91da62b16..3b704b02b 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,26 @@ +Sun Sep 15 03:58:29 1996 Gary Houston + + * 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 * numbers.c: use SCM_NUM_OVERFLOW instead of scm_wta or ASSERT. diff --git a/libguile/__scm.h b/libguile/__scm.h index 4af8303ef..86f345edd 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -315,45 +315,6 @@ extern unsigned int scm_async_clock; #define lgh_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_ARG1 1 #define SCM_ARG2 2 diff --git a/libguile/debug.c b/libguile/debug.c index a7a7704a7..e56a1b373 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -83,8 +83,7 @@ scm_debug_options (setting) 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); - /* *fixme* Should SCM_ALLOW_INTS be called here? */ - scm_wta (setting, (char *) SCM_OUTOFRANGE, "frames"); + scm_out_of_range (s_debug_options, setting); } #endif SCM_RESET_DEBUG_MODE; diff --git a/libguile/error.c b/libguile/error.c index d975da9b0..87d6a958e 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -166,13 +166,13 @@ scm_everr (exp, env, arg, pos, s_subr) args = scm_listify (desc, sym, arg, SCM_UNDEFINED); } - /* (throw (quote system-error) arg) + /* (throw (quote scm_system-error_key) arg) * * is a string or an integer (see %%system-errors). * 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: */ @@ -224,9 +224,78 @@ scm_error (key, subr, message, args, rest) /* error keys: defined here, initialized below, prototyped in error.h, associated with handler procedures in boot-9.scm. */ -SCM scm_system_error; -SCM scm_num_overflow; +SCM scm_system_error_key; +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__ void scm_init_error (void) @@ -235,10 +304,12 @@ void scm_init_error () #endif { - scm_system_error + scm_system_error_key = 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_out_of_range_key + = scm_permanent_object (SCM_CAR (scm_intern0 ("out-of-range"))); #include "error.x" } diff --git a/libguile/error.h b/libguile/error.h index 046a38f0d..8ca8e9606 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -47,13 +47,22 @@ 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_callback) SCM_P ((SCM key, char *subr, char *message, SCM args, SCM rest)); +extern void scm_error SCM_P ((SCM key, char *subr, char *message, + 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__ extern int scm_handle_it (int i); diff --git a/libguile/filesys.c b/libguile/filesys.c index 48f8bdb7e..c81ee5e85 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -176,7 +176,7 @@ scm_sys_chown (path, owner, group) SCM_SYSCALL (val = chown (SCM_ROCHARS (path), SCM_INUM (owner), SCM_INUM (group))); if (val != 0) - SCM_SYSERROR (s_sys_chown); + scm_syserror (s_sys_chown); return SCM_UNSPECIFIED; } @@ -205,7 +205,7 @@ scm_sys_chmod (port_or_path, mode) SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode))); } if (rv != 0) - SCM_SYSERROR (s_sys_chmod); + scm_syserror (s_sys_chmod); return SCM_UNSPECIFIED; } @@ -322,7 +322,7 @@ scm_sys_open (path, flags, mode) SCM_DEFER_INTS; SCM_SYSCALL ( fd = open (SCM_ROCHARS (path), SCM_INUM (flags), SCM_INUM (mode)) ); 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); SCM_ALLOW_INTS; @@ -353,7 +353,7 @@ scm_sys_create (path, mode) SCM_DEFER_INTS; SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) ); 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); SCM_ALLOW_INTS; @@ -381,7 +381,7 @@ scm_sys_close (sfd) SCM_SETCAR (sfd, scm_tc16_fd); SCM_ALLOW_INTS; if (got == -1) - SCM_SYSERROR (s_sys_close); + scm_syserror (s_sys_close); return SCM_UNSPECIFIED; } @@ -406,7 +406,7 @@ scm_sys_write_fd (sfd, buf) SCM_DEFER_INTS; written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf)); if (written == -1) - SCM_SYSERROR (s_sys_write_fd); + scm_syserror (s_sys_write_fd); answer = scm_long2num (written); SCM_ALLOW_INTS; return scm_return_first (answer, buf); @@ -458,7 +458,7 @@ scm_sys_read_fd (sfd, buf, offset, length) SCM_DEFER_INTS; got = read (fd, bytes + off, len); if (got == -1) - SCM_SYSERROR (s_sys_read_fd); + scm_syserror (s_sys_read_fd); answer = scm_long2num (got); SCM_ALLOW_INTS; return scm_return_first (answer, buf); @@ -497,7 +497,7 @@ scm_sys_lseek (sfd, offset, whence) SCM_DEFER_INTS; SCM_SYSCALL (got = lseek (fd, off, wh)); if (got == -1) - SCM_SYSERROR (s_sys_lseek); + scm_syserror (s_sys_lseek); answer = scm_long2num (got); SCM_ALLOW_INTS; return answer; @@ -529,7 +529,7 @@ scm_sys_dup (oldfd, newfd) fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2); nfd = fn (fd, nfd); if (nfd == -1) - SCM_SYSERROR (s_sys_dup); + scm_syserror (s_sys_dup); answer = SCM_MAKINUM (nfd); SCM_ALLOW_INTS; return answer; @@ -616,7 +616,7 @@ scm_sys_stat (fd_or_path) } if (rv != 0) - SCM_SYSERROR (s_sys_stat); + scm_syserror (s_sys_stat); return scm_stat2scm (&stat_temp); } @@ -646,7 +646,7 @@ scm_sys_link (oldpath, newpath) newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0); SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath))); if (val != 0) - SCM_SYSERROR (s_sys_link); + scm_syserror (s_sys_link); return SCM_UNSPECIFIED; } @@ -669,7 +669,7 @@ scm_sys_rename (oldname, newname) #ifdef HAVE_RENAME SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname))); if (rv != 0) - SCM_SYSERROR (s_sys_rename); + scm_syserror (s_sys_rename); return SCM_UNSPECIFIED; #else SCM_DEFER_INTS; @@ -683,7 +683,7 @@ scm_sys_rename (oldname, newname) } SCM_ALLOW_INTS; if (rv != 0) - SCM_SYSERROR (s_sys_rename); + scm_syserror (s_sys_rename); return SCM_UNSPECIFIED; #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_SYSCALL (ans = unlink (SCM_CHARS (str))); if (ans != 0) - SCM_SYSERROR (s_sys_delete_file); + scm_syserror (s_sys_delete_file); return SCM_UNSPECIFIED; } @@ -735,10 +735,10 @@ scm_sys_mkdir (path, mode) SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode))); } if (rv != 0) - SCM_SYSERROR (s_sys_mkdir); + scm_syserror (s_sys_mkdir); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_mkdir); + scm_sysmissing (s_sys_mkdir); /* not reached. */ return SCM_BOOL_F; #endif @@ -761,10 +761,10 @@ scm_sys_rmdir (path) SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir); SCM_SYSCALL (val = rmdir (SCM_CHARS (path))); if (val != 0) - SCM_SYSERROR (s_sys_rmdir); + scm_syserror (s_sys_rmdir); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_rmdir); + scm_sysmissing (s_sys_rmdir); /* not reached. */ return SCM_BOOL_F; #endif @@ -793,7 +793,7 @@ scm_sys_opendir (dirname) SCM_DEFER_INTS; SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname))); if (ds == NULL) - SCM_SYSERROR (s_sys_opendir); + scm_syserror (s_sys_opendir); SCM_CAR (dir) = scm_tc16_dir | SCM_OPN; SCM_SETCDR (dir, ds); SCM_ALLOW_INTS; @@ -818,7 +818,7 @@ scm_sys_readdir (port) SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port))); SCM_ALLOW_INTS; if (errno != 0) - SCM_SYSERROR (s_sys_readdir); + scm_syserror (s_sys_readdir); return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0) : SCM_EOF_VAL); } @@ -863,7 +863,7 @@ scm_sys_closedir (port) } SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port))); if (sts != 0) - SCM_SYSERROR (s_sys_closedir); + scm_syserror (s_sys_closedir); SCM_CAR (port) = scm_tc16_dir; SCM_ALLOW_INTS; 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_SYSCALL (ans = chdir (SCM_CHARS (str))); if (ans != 0) - SCM_SYSERROR (s_sys_chdir); + scm_syserror (s_sys_chdir); return SCM_UNSPECIFIED; } @@ -953,13 +953,13 @@ scm_sys_getcwd () wd = scm_must_malloc (size, s_sys_getcwd); } if (rv == 0) - SCM_SYSERROR (s_sys_getcwd); + scm_syserror (s_sys_getcwd); result = scm_makfromstr (wd, strlen (wd), 0); scm_must_free (wd); SCM_ALLOW_INTS; return result; #else - SCM_SYSMISSING (s_sys_getcwd); + scm_sysmissing (s_sys_getcwd); /* not reached. */ return SCM_BOOL_F; #endif @@ -1082,13 +1082,13 @@ scm_sys_select (reads, writes, excepts, secs, msecs) &read_set, &write_set, &except_set, time_p); SCM_ALLOW_INTS; if (sreturn < 0) - SCM_SYSERROR (s_sys_select); + scm_syserror (s_sys_select); return scm_listify (retrieve_select_type (&read_set, reads), retrieve_select_type (&write_set, writes), retrieve_select_type (&except_set, excepts), SCM_UNDEFINED); #else - SCM_SYSMISSING (s_sys_select); + scm_sysmissing (s_sys_select); /* not reached. */ return SCM_BOOL_F; #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_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath))); if (val != 0) - SCM_SYSERROR (s_sys_symlink); + scm_syserror (s_sys_symlink); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_symlink); + scm_sysmissing (s_sys_symlink); /* not reached. */ return SCM_BOOL_F; #endif @@ -1151,13 +1151,13 @@ scm_sys_readlink(path) buf = scm_must_malloc (size, s_sys_readlink); } if (rv == -1) - SCM_SYSERROR (s_sys_readlink); + scm_syserror (s_sys_readlink); result = scm_makfromstr (buf, rv, 0); scm_must_free (buf); SCM_ALLOW_INTS; return result; #else - SCM_SYSMISSING (s_sys_readlink); + scm_sysmissing (s_sys_readlink); /* not reached. */ return SCM_BOOL_F; #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_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp)); if (rv != 0) - SCM_SYSERROR (s_sys_lstat); + scm_syserror (s_sys_lstat); return scm_stat2scm(&stat_temp); #else - SCM_SYSMISSING (s_sys_lstat); + scm_sysmissing (s_sys_lstat); /* not reached. */ return SCM_BOOL_F; #endif @@ -1214,28 +1214,28 @@ scm_sys_copy_file (oldfile, newfile) if (SCM_SUBSTRP (newfile)) newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0); if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1) - SCM_SYSERROR (s_sys_copy_file); + scm_syserror (s_sys_copy_file); SCM_DEFER_INTS; oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY); if (oldfd == -1) - SCM_SYSERROR (s_sys_copy_file); + scm_syserror (s_sys_copy_file); /* use POSIX flags instead of 07777?. */ newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC, oldstat.st_mode & 07777); if (newfd == -1) - SCM_SYSERROR (s_sys_copy_file); + scm_syserror (s_sys_copy_file); while ((n = read (oldfd, buf, sizeof buf)) > 0) if (write (newfd, buf, n) != n) { close (oldfd); close (newfd); - SCM_SYSERROR (s_sys_copy_file); + scm_syserror (s_sys_copy_file); } close (oldfd); if (close (newfd) == -1) - SCM_SYSERROR (s_sys_copy_file); + scm_syserror (s_sys_copy_file); SCM_ALLOW_INTS; return SCM_UNSPECIFIED; } diff --git a/libguile/fports.c b/libguile/fports.c index c3a1eb47c..91ca9c231 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -196,10 +196,10 @@ scm_open_file (filename, modes) port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes)); if (port == SCM_BOOL_F) { - SCM_SYSERROR_M (s_open_file, "%S: %S", - scm_listify (scm_makfrom0str (strerror (errno)), - filename, - SCM_UNDEFINED)); + scm_syserror_msg (s_open_file, "%S: %S", + scm_listify (scm_makfrom0str (strerror (errno)), + filename, + SCM_UNDEFINED)); /* Force the compiler to keep filename and modes alive. */ scm_cons (filename, modes); } diff --git a/libguile/ioext.c b/libguile/ioext.c index e4c154143..9f1959c39 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -70,7 +70,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) - SCM_SYSERROR (s_sys_ftell); + scm_syserror (s_sys_ftell); if (pos > 0 && SCM_CRDYP (port)) pos--; return SCM_MAKINUM (pos); @@ -99,7 +99,7 @@ scm_sys_fseek (port, offset, whence) /* Values of whence are interned in scm_init_ioext. */ rv = fseek ((FILE *)SCM_STREAM (port), SCM_INUM (offset), SCM_INUM (whence)); if (rv != 0) - SCM_SYSERROR (s_sys_fseek); + scm_syserror (s_sys_fseek); return SCM_UNSPECIFIED; } @@ -165,15 +165,15 @@ scm_sys_duplicate_port (oldpt, modes) SCM_DEFER_INTS; oldfd = fileno ((FILE *)SCM_STREAM (oldpt)); if (oldfd == -1) - SCM_SYSERROR (s_sys_duplicate_port); + scm_syserror (s_sys_duplicate_port); SCM_SYSCALL (newfd = dup (oldfd)); if (newfd == -1) - SCM_SYSERROR (s_sys_duplicate_port); + scm_syserror (s_sys_duplicate_port); f = fdopen (newfd, SCM_CHARS (modes)); if (!f) { SCM_SYSCALL (close (newfd)); - SCM_SYSERROR (s_sys_duplicate_port); + scm_syserror (s_sys_duplicate_port); } { 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); oldfd = fileno ((FILE *)SCM_STREAM (into_pt)); if (oldfd == -1) - SCM_SYSERROR (s_sys_redirect_port); + scm_syserror (s_sys_redirect_port); newfd = fileno ((FILE *)SCM_STREAM (from_pt)); if (newfd == -1) - SCM_SYSERROR (s_sys_redirect_port); + scm_syserror (s_sys_redirect_port); SCM_SYSCALL (ans = dup2 (oldfd, newfd)); if (ans == -1) - SCM_SYSERROR (s_sys_redirect_port); + scm_syserror (s_sys_redirect_port); SCM_ALLOW_INTS; 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); fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1) - SCM_SYSERROR (s_sys_fileno); + scm_syserror (s_sys_fileno); 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); rv = fileno ((FILE *)SCM_STREAM (port)); if (rv == -1) - SCM_SYSERROR (s_sys_isatty); + scm_syserror (s_sys_isatty); rv = isatty (rv); return rv ? SCM_BOOL_T : SCM_BOOL_F; } @@ -278,7 +278,7 @@ scm_sys_fdopen (fdes, modes) SCM_DEFER_INTS; f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes)); if (f == NULL) - SCM_SYSERROR (s_sys_fdopen); + scm_syserror (s_sys_fdopen); pt = scm_add_to_port_table (port); SCM_SETPTAB_ENTRY (port, pt); 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); rv = dup2 (old_fd, new_fd); 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_SYSCALL (close (old_fd)); SCM_ALLOW_INTS; diff --git a/libguile/numbers.c b/libguile/numbers.c index 070f52911..bf3d6387f 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -166,7 +166,7 @@ scm_abs(x) #ifdef SCM_BIGDIG return scm_long2big(x); #else - SCM_NUM_OVERFLOW (s_abs); + scm_num_overflow (s_abs); #endif return SCM_MAKINUM(x); } @@ -229,7 +229,7 @@ scm_quotient(x, y) SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_quotient); #endif if ((z = SCM_INUM(y))==0) - ov: SCM_NUM_OVERFLOW (s_quotient); + ov: scm_num_overflow (s_quotient); z = SCM_INUM(x)/z; #ifdef BADIVSGNS { @@ -249,7 +249,7 @@ scm_quotient(x, y) #ifdef SCM_BIGDIG return scm_long2big(z); #else - SCM_NUM_OVERFLOW (s_quotient); + scm_num_overflow (s_quotient); #endif return SCM_MAKINUM(z); } @@ -289,7 +289,7 @@ scm_remainder(x, y) SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_remainder); #endif if (!(z = SCM_INUM(y))) - ov: SCM_NUM_OVERFLOW (s_remainder); + ov: scm_num_overflow (s_remainder); #if (__TURBOC__==1) if (z < 0) z = -z; #endif @@ -339,7 +339,7 @@ scm_modulo(x, y) SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_modulo); #endif if (!(yy = SCM_INUM(y))) - ov: SCM_NUM_OVERFLOW (s_modulo); + ov: scm_num_overflow (s_modulo); #if (__TURBOC__==1) z = SCM_INUM(x); z = ((yy<0) ? -z : z)%yy; @@ -410,7 +410,7 @@ scm_gcd(x, y) #ifdef SCM_BIGDIG return scm_long2big(u); #else - SCM_NUM_OVERFLOW (s_gcd); + scm_num_overflow (s_gcd); #endif return SCM_MAKINUM(u); } @@ -676,7 +676,7 @@ scm_ash(n, cnt) if (cnt < 0) return SCM_MAKINUM(SCM_SRS(res, -cnt)); res = SCM_MAKINUM(res<>cnt != SCM_INUM(n)) - SCM_NUM_OVERFLOW (s_ash); + scm_num_overflow (s_ash); return res; #endif } @@ -1676,7 +1676,7 @@ scm_istr2int(str, len, radix) t2 = SCM_BIGDN(t2); } if (blen > j) - SCM_NUM_OVERFLOW ("bignum"); + scm_num_overflow ("bignum"); if (t2) {blen++; goto moretodo;} break; default: @@ -2810,7 +2810,7 @@ scm_sum(x, y) # ifdef SCM_FLOATS return scm_makdbl((double)x, 0.0); # else - SCM_NUM_OVERFLOW (s_sum); + scm_num_overflow (s_sum); return SCM_UNSPECIFIED; # endif #endif @@ -2953,7 +2953,7 @@ scm_difference(x, y) # ifdef SCM_FLOATS return scm_makdbl((double)x, 0.0); # else - SCM_NUM_OVERFLOW (s_difference); + scm_num_overflow (s_difference); return SCM_UNSPECIFIED; # endif #endif @@ -3107,7 +3107,7 @@ scm_product(x, y) # ifdef SCM_FLOATS return scm_makdbl(((double)i)*((double)j), 0.0); # else - SCM_NUM_OVERFLOW (s_product); + scm_num_overflow (s_product); # endif #endif return y; @@ -3187,7 +3187,7 @@ scm_divide(x, y) z = SCM_INUM(y); #ifndef RECKLESS if (!z) - SCM_NUM_OVERFLOW (s_divide); + scm_num_overflow (s_divide); #endif if (1==z) return x; if (z < 0) z = -z; @@ -3328,7 +3328,7 @@ scm_divide(x, y) #ifdef SCM_FLOATS ov: return scm_makdbl(((double)SCM_INUM(x))/((double)SCM_INUM(y)), 0.0); #else - ov: SCM_NUM_OVERFLOW (s_divide); + ov: scm_num_overflow (s_divide); return SCM_UNSPECIFIED; #endif } @@ -3775,7 +3775,7 @@ scm_dbl2big(d) } #ifndef RECKLESS if (u != 0) - SCM_NUM_OVERFLOW ("dbl2big"); + scm_num_overflow ("dbl2big"); #endif return ans; } diff --git a/libguile/posix.c b/libguile/posix.c index 48c0b8b61..5d70baf34 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -206,13 +206,13 @@ scm_sys_pipe () SCM_NEWCELL (p_wt); rv = pipe (fd); if (rv) - SCM_SYSERROR (s_sys_pipe); + scm_syserror (s_sys_pipe); f_rd = fdopen (fd[0], "r"); if (!f_rd) { SCM_SYSCALL (close (fd[0])); SCM_SYSCALL (close (fd[1])); - SCM_SYSERROR (s_sys_pipe); + scm_syserror (s_sys_pipe); } f_wt = fdopen (fd[1], "w"); if (!f_wt) @@ -222,7 +222,7 @@ scm_sys_pipe () fclose (f_rd); SCM_SYSCALL (close (fd[1])); errno = en; - SCM_SYSERROR (s_sys_pipe); + scm_syserror (s_sys_pipe); } ptr = scm_add_to_port_table (p_rd); ptw = scm_add_to_port_table (p_wt); @@ -251,7 +251,7 @@ scm_sys_getgroups() SCM grps, ans; int ngroups = getgroups (0, NULL); if (!ngroups) - SCM_SYSERROR (s_sys_getgroups); + scm_syserror (s_sys_getgroups); SCM_NEWCELL(grps); SCM_DEFER_INTS; { @@ -264,7 +264,7 @@ scm_sys_getgroups() if (val < 0) { 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_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string); @@ -313,7 +313,7 @@ scm_sys_getpwuid (user) entry = getpwnam (SCM_ROCHARS (user)); } if (!entry) - SCM_SYSERROR (s_sys_getpwuid); + scm_syserror (s_sys_getpwuid); ve[0] = scm_makfrom0str (entry->pw_name); ve[1] = scm_makfrom0str (entry->pw_passwd); @@ -382,7 +382,7 @@ scm_sys_getgrgid (name) SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name))); } if (!entry) - SCM_SYSERROR (s_sys_getgrgid); + scm_syserror (s_sys_getgrgid); ve[0] = scm_makfrom0str (entry->gr_name); 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); /* Signal values are interned in scm_init_posix(). */ if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0) - SCM_SYSERROR (s_sys_kill); + scm_syserror (s_sys_kill); return SCM_UNSPECIFIED; } @@ -460,10 +460,10 @@ scm_sys_waitpid (pid, options) } SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions)); if (i == -1) - SCM_SYSERROR (s_sys_waitpid); + scm_syserror (s_sys_waitpid); return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)); #else - SCM_SYSMISSING (s_sys_waitpid); + scm_sysmissing (s_sys_waitpid); /* not reached. */ return SCM_BOOL_F; #endif @@ -560,7 +560,7 @@ scm_sys_setuid (id) { SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid); if (setuid (SCM_INUM (id)) != 0) - SCM_SYSERROR (s_sys_setuid); + scm_syserror (s_sys_setuid); return SCM_UNSPECIFIED; } @@ -576,7 +576,7 @@ scm_sys_setgid (id) { SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid); if (setgid (SCM_INUM (id)) != 0) - SCM_SYSERROR (s_sys_setgid); + scm_syserror (s_sys_setgid); return SCM_UNSPECIFIED; } @@ -599,7 +599,7 @@ scm_sys_seteuid (id) rv = setuid (SCM_INUM (id)); #endif if (rv != 0) - SCM_SYSERROR (s_sys_seteuid); + scm_syserror (s_sys_seteuid); return SCM_UNSPECIFIED; } @@ -622,7 +622,7 @@ scm_sys_setegid (id) rv = setgid (SCM_INUM (id)); #endif if (rv != 0) - SCM_SYSERROR (s_sys_setegid); + scm_syserror (s_sys_setegid); return SCM_UNSPECIFIED; } @@ -646,10 +646,10 @@ scm_setpgid (pid, pgid) SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_sys_setpgid); /* FIXME(?): may be known as setpgrp. */ if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) - SCM_SYSERROR (s_sys_setpgid); + scm_syserror (s_sys_setpgid); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_setpgid); + scm_sysmissing (s_sys_setpgid); /* not reached. */ return SCM_BOOL_F; #endif @@ -662,10 +662,10 @@ scm_setsid () #ifdef HAVE_SETSID pid_t sid = setsid (); if (sid == -1) - SCM_SYSERROR (s_sys_setsid); + scm_syserror (s_sys_setsid); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_setsid); + scm_sysmissing (s_sys_setsid); /* not reached. */ return SCM_BOOL_F; #endif @@ -688,10 +688,10 @@ scm_ttyname (port) return SCM_BOOL_F; fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1) - SCM_SYSERROR (s_ttyname); + scm_syserror (s_ttyname); SCM_SYSCALL (ans = ttyname (fd)); if (!ans) - SCM_SYSERROR (s_ttyname); + scm_syserror (s_ttyname); /* ans could be overwritten by another call to ttyname */ return (scm_makfrom0str (ans)); } @@ -704,10 +704,10 @@ scm_ctermid () #ifdef HAVE_CTERMID char *result = ctermid (NULL); if (*result == '\0') - SCM_SYSERROR (s_sys_ctermid); + scm_syserror (s_sys_ctermid); return scm_makfrom0str (result); #else - SCM_SYSMISSING (s_sys_ctermid); + scm_sysmissing (s_sys_ctermid); /* not reached. */ return SCM_BOOL_F; #endif @@ -724,10 +724,10 @@ scm_tcgetpgrp (port) SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_tcgetpgrp); fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1) - SCM_SYSERROR (s_sys_tcgetpgrp); + scm_syserror (s_sys_tcgetpgrp); return SCM_MAKINUM (pgid); #else - SCM_SYSMISSING (s_sys_tcgetpgrp); + scm_sysmissing (s_sys_tcgetpgrp); /* not reached. */ return SCM_BOOL_F; #endif @@ -744,10 +744,10 @@ scm_tcsetpgrp (port, pgid) SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_sys_tcsetpgrp); fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1) - SCM_SYSERROR (s_sys_tcsetpgrp); + scm_syserror (s_sys_tcsetpgrp); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_tcsetpgrp); + scm_sysmissing (s_sys_tcsetpgrp); /* not reached. */ return SCM_BOOL_F; #endif @@ -807,7 +807,7 @@ scm_sys_execl (args) args = SCM_CDR (args); execargv = scm_convert_exec_args (args); execv (SCM_ROCHARS (filename), execargv); - SCM_SYSERROR (s_sys_execl); + scm_syserror (s_sys_execl); /* not reached. */ return SCM_BOOL_F; } @@ -830,7 +830,7 @@ scm_sys_execlp (args) args = SCM_CDR (args); execargv = scm_convert_exec_args (args); execvp (SCM_ROCHARS (filename), execargv); - SCM_SYSERROR (s_sys_execlp); + scm_syserror (s_sys_execlp); /* not reached. */ return SCM_BOOL_F; } @@ -848,7 +848,7 @@ scm_sys_fork() int pid; pid = fork (); if (pid == -1) - SCM_SYSERROR (s_sys_fork); + scm_syserror (s_sys_fork); return SCM_MAKINUM (0L+pid); } @@ -879,7 +879,7 @@ scm_sys_uname () */ return ans; #else - SCM_SYSMISSING (s_sys_uname); + scm_sysmissing (s_sys_uname); /* not reached. */ return SCM_BOOL_F; #endif @@ -970,7 +970,7 @@ scm_open_pipe (pipestr, modes) SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes))); scm_unignore_signals (); if (!f) - SCM_SYSERROR (s_open_pipe); + scm_syserror (s_open_pipe); pt = scm_add_to_port_table (z); SCM_SETPTAB_ENTRY (z, pt); 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)); if (rv != 0) - SCM_SYSERROR (s_sys_utime); + scm_syserror (s_sys_utime); 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); return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; #else - SCM_SYSMISSING (s_sys_putenv); + scm_sysmissing (s_sys_putenv); /* not reached. */ return SCM_BOOL_F; #endif @@ -1243,10 +1243,10 @@ scm_setlocale (category, locale) rv = setlocale (SCM_INUM (category), clocale); if (rv == NULL) - SCM_SYSERROR (s_setlocale); + scm_syserror (s_setlocale); return scm_makfrom0str (rv); #else - SCM_SYSMISSING (s_setlocale); + scm_sysmissing (s_setlocale); /* not reached. */ return SCM_BOOL_F; #endif @@ -1351,7 +1351,7 @@ scm_sys_strptime (format, string) SCM_ALLOW_INTS; 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); @@ -1370,7 +1370,7 @@ scm_sys_strptime (format, string) return scm_cons (stime, scm_makfrom0str (rest)); #else - SCM_SYSMISSING (s_sys_strptime); + scm_sysmissing (s_sys_strptime); /* not reached. */ return SCM_BOOL_F; #endif @@ -1395,10 +1395,10 @@ scm_sys_mknod(path, mode, dev) SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod); SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev))); if (val != 0) - SCM_SYSERROR (s_sys_mknod); + scm_syserror (s_sys_mknod); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_mknod); + scm_sysmissing (s_sys_mknod); /* not reached. */ return SCM_BOOL_F; #endif @@ -1418,10 +1418,10 @@ scm_sys_nice(incr) #ifdef HAVE_NICE SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice); if (nice(SCM_INUM(incr)) != 0) - SCM_SYSERROR (s_sys_nice); + scm_syserror (s_sys_nice); return SCM_UNSPECIFIED; #else - SCM_SYSMISSING (s_sys_nice); + scm_sysmissing (s_sys_nice); /* not reached. */ return SCM_BOOL_F; #endif @@ -1439,9 +1439,10 @@ scm_sync() { #ifdef HAVE_SYNC sync(); -#endif - SCM_SYSMISSING (s_sync); +#else + scm_sysmissing (s_sync); /* not reached. */ +#endif return SCM_BOOL_F; } diff --git a/libguile/simpos.c b/libguile/simpos.c index f9e79e46d..702489510 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -99,7 +99,7 @@ scm_sys_getenv(nam) nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0); val = getenv(SCM_CHARS(nam)); if (!val) - SCM_SYSERROR (s_sys_getenv); + scm_syserror (s_sys_getenv); return scm_makfromstr(val, (scm_sizet)strlen(val), 0); } diff --git a/libguile/socket.c b/libguile/socket.c index 89ce1d01e..0ed4a9b71 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -87,7 +87,7 @@ scm_sys_inet_aton (address) if (SCM_SUBSTRP (address)) address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 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)); } @@ -208,7 +208,7 @@ scm_sys_gethost (name) } SCM_ALLOW_INTS; 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[1] = scm_makfromstrs (-1, entry->h_aliases); ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); @@ -264,7 +264,7 @@ scm_sys_getnet (name) } SCM_ALLOW_INTS; 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[1] = scm_makfromstrs (-1, entry->n_aliases); ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); @@ -307,7 +307,7 @@ scm_sys_getproto (name) } SCM_ALLOW_INTS; 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[1] = scm_makfromstrs (-1, entry->p_aliases); ve[2] = SCM_MAKINUM (entry->p_proto + 0L); @@ -353,7 +353,7 @@ scm_sys_getserv (name, proto) SCM_DEFER_INTS; entry = getservent (); if (!entry) - SCM_SYSERROR (s_sys_getserv); + scm_syserror (s_sys_getserv); return scm_return_entry (entry); } 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)); } if (!entry) - SCM_SYSERROR (s_sys_getserv); + scm_syserror (s_sys_getserv); return scm_return_entry (entry); } diff --git a/libguile/unif.c b/libguile/unif.c index e1926fe15..7cc8d6ae1 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1128,7 +1128,7 @@ scm_uniform_vector_ref (v, args) if (SCM_NULLP (args)) return v; 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); case scm_tc7_smob: { /* enclosed */ @@ -1321,7 +1321,7 @@ scm_array_set_x (v, obj, args) { default: 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); case scm_tc7_smob: /* enclosed */ goto badarg1;