diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index dfaed88ed..0a66f2b8f 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -5,6 +5,17 @@ Thu Aug 1 02:52:42 1996 Jim Blandy * PLUGIN/this.configure (aux_files): Removed PLUGIN; it's a directory, and needs special treatment in the dist-dir target. +Thu Aug 1 09:00:21 1996 Gary Houston + + * boot-9.scm: remove the wrappers for '%' system primitives, + now that they throw errors directly. + remove make-simple-wrapper and similar functions. + protect a call to getenv which may now throw an exception. + +Wed Jul 31 23:44:42 1996 Gary Houston + + * boot-9.scm (false-if-exception): new macro. + Fri Apr 19 13:53:08 1996 Tom Lord * The more things change... diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index fa55e9a1d..9c8c30767 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -702,31 +702,6 @@ - -(define ((make-simple-wrapper func) . args) - (or (apply func args) - (apply throw 'syserror func (errno) args))) - -(define ((make-eof-wrapper func) . args) - (let ((rv (apply func args))) - (if (eof-object? rv) - (apply throw 'syserror func (errno) args) - rv))) - -(define ((make-errno-wrapper func) . args) - (let ((rv (apply func args))) - (if (number? rv) - (apply throw 'syserror func rv args) - rv))) - -(define ((make-errpair-wrapper func) . args) - (let ((rv (apply func args))) - (if (and (pair? rv) - (number? (car rv)) - (null? (cdr rv))) - (apply throw 'syserror func (car rv) args) - rv))) - (begin (define (syserror key fn err . args) (errno err) @@ -734,18 +709,18 @@ (set-symbol-property! 'syserror 'throw-handler-default syserror)) -(define (%getgrnam name) (%getgr name)) -(define (%getgrgid id) (%getgr id)) -(define (%gethostbyaddr addr) (%gethost addr)) -(define (%gethostbyname name) (%gethost name)) -(define (%getnetbyaddr addr) (%getnet addr)) -(define (%getnetbyname name) (%getnet name)) -(define (%getprotobyname name) (%getproto name)) -(define (%getprotobynumber addr) (%getproto addr)) -(define (%getpwnam name) (%getpw name)) -(define (%getpwuid uid) (%getpw uid)) -(define (%getservbyname name proto) (%getserv name proto)) -(define (%getservbyport port proto) (%getserv port proto)) +(define (getgrnam name) (getgr name)) +(define (getgrgid id) (getgr id)) +(define (gethostbyaddr addr) (gethost addr)) +(define (gethostbyname name) (gethost name)) +(define (getnetbyaddr addr) (getnet addr)) +(define (getnetbyname name) (getnet name)) +(define (getprotobyname name) (getproto name)) +(define (getprotobynumber addr) (getproto addr)) +(define (getpwnam name) (getpw name)) +(define (getpwuid uid) (getpw uid)) +(define (getservbyname name proto) (%getserv name proto)) +(define (getservbyport port proto) (%getserv port proto)) (define (endgrent) (setgr)) (define (endhostent) (sethost)) (define (endnetent) (setnet)) @@ -754,12 +729,12 @@ (define (endservent) (setserv)) (define (file-position . args) (apply ftell args)) (define (file-set-position . args) (apply fseek args)) -(define (getgrent) (%getgr)) -(define (gethostent) (%gethost)) -(define (getnetent) (%getnet)) -(define (getprotoent) (%getproto)) -(define (getpwent) (%getpw)) -(define (getservent) (%getserv)) +(define (getgrent) (getgr)) +(define (gethostent) (gethost)) +(define (getnetent) (getnet)) +(define (getprotoent) (getproto)) +(define (getpwent) (getpw)) +(define (getservent) (getserv)) (define (reopen-file . args) (apply freopen args)) (define (setgrent arg) (setgr arg)) (define (sethostent arg) (sethost arg)) @@ -767,96 +742,9 @@ (define (setprotoent arg) (setproto arg)) (define (setpwent arg) (setpw arg)) (define (setservent arg) (setserv arg)) -(define (%move->fdes port fd) +(define (move->fdes port fd) (if (= 1 (primitive-move->fdes port fd)) - (set-port-revealed! port 1) - #t)) - -(define accept (make-errno-wrapper %accept)) -(define bind (make-errno-wrapper %bind)) -(define chdir (make-errno-wrapper %chdir)) -(define chmod (make-errno-wrapper %chmod)) -(define chown (make-errno-wrapper %chown)) -(define close (make-errno-wrapper %close)) -(define closedir (make-errno-wrapper %closedir)) -(define connect (make-errno-wrapper %connect)) -(define copy-file (make-simple-wrapper %copy-file)) -(define ctermid (make-simple-wrapper %ctermid)) -(define delete-file (make-errno-wrapper %delete-file)) -(define duplicate-port (make-simple-wrapper %duplicate-port)) -(define execl (make-errno-wrapper %execl)) -(define execlp (make-errno-wrapper %execlp)) -(define fdopen (make-errno-wrapper %fdopen)) -(define fileno (make-simple-wrapper %fileno)) -(define fork (make-simple-wrapper %fork)) -(define freopen (make-errno-wrapper %freopen)) -(define fseek (make-errno-wrapper %fseek)) -(define ftell (make-errno-wrapper %ftell)) -(define getcwd (make-errno-wrapper %getcwd)) -(define getenv (make-simple-wrapper %getenv)) -(define getgrgid (make-errno-wrapper %getgrgid)) -(define getgrnam (make-errno-wrapper %getgrnam)) -(define getgroups (make-errno-wrapper %getgroups)) -(define gethostbyaddr (make-simple-wrapper %gethostbyaddr)) -(define gethost (make-simple-wrapper %gethost)) -(define gethostbyname (make-simple-wrapper %gethostbyname)) -(define getnetbyaddr (make-simple-wrapper %getnetbyaddr)) -(define getnetbyname (make-simple-wrapper %getnetbyname)) -(define getpeername (make-errno-wrapper %getpeername)) -(define getprotobyname (make-simple-wrapper %getprotobyname)) -(define getprotobynumber (make-simple-wrapper %getprotobynumber)) -(define getpwnam (make-simple-wrapper %getpwnam)) -(define getpwuid (make-simple-wrapper %getpwuid)) -(define getservbyname (make-simple-wrapper %getservbyname)) -(define getservbyport (make-simple-wrapper %getservbyport)) -(define getsockname (make-errno-wrapper %getsockname)) -(define getsockopt (make-errpair-wrapper %getsockopt)) -(define inet-aton (make-simple-wrapper %inet-aton)) -(define isatty? (make-errno-wrapper %isatty?)) -(define kill (make-errno-wrapper %kill)) -(define link (make-errno-wrapper %link)) -(define listen (make-errno-wrapper %listen)) -(define lstat (make-errno-wrapper %lstat)) -(define mkdir (make-errno-wrapper %mkdir)) -(define mknod (make-errno-wrapper %mknod)) -(define nice (make-errno-wrapper %nice)) -(define opendir (make-errno-wrapper %opendir)) -(define pipe (make-errno-wrapper %pipe)) -(define primitive-move->fdes (make-simple-wrapper %primitive-move->fdes)) -(define putenv (make-errno-wrapper %putenv)) -(define read-fd (make-errpair-wrapper %read-fd)) -(define readdir (make-errno-wrapper %readdir)) -(define readlink (make-errno-wrapper %readlink)) -(define recv (make-errno-wrapper %recv)) -(define recvfrom (make-errno-wrapper %recvfrom)) -(define redirect-port (make-errno-wrapper %redirect-port)) -(define rename-file (make-errno-wrapper %rename-file)) -(define rmdir (make-errno-wrapper %rmdir)) -(define select (make-errno-wrapper %select)) -(define send (make-errpair-wrapper %send)) -(define sendto (make-errpair-wrapper %sendto)) -(define setegid (make-errno-wrapper %setegid)) -(define seteuid (make-errno-wrapper %seteuid)) -(define setgid (make-errno-wrapper %setgid)) -(define setlocale (make-errno-wrapper %setlocale)) -(define setpgid (make-errno-wrapper %setpgid)) -(define setsid (make-simple-wrapper %setsid)) -(define setsockopt (make-errno-wrapper %setsockopt)) -(define setuid (make-errno-wrapper %setuid)) -(define shutdown (make-errno-wrapper %shutdown)) -(define socket (make-errno-wrapper %socket)) -(define socketpair (make-errno-wrapper %socketpair)) -(define stat (make-errno-wrapper %stat)) -(define strptime (make-simple-wrapper %strptime)) -(define symlink (make-simple-wrapper %symlink)) -(define tcgetpgrp (make-simple-wrapper %tcgetpgrp)) -(define tcsetpgrp (make-simple-wrapper %tcsetpgrp)) -(define ttyname (make-errno-wrapper %ttyname)) -(define uname (make-errno-wrapper %uname)) -(define utime (make-errno-wrapper %utime)) -(define waitpid (make-errno-wrapper %waitpid)) -(define write-fd (make-errpair-wrapper %write-fd)) -(define move->fdes (make-simple-wrapper %move->fdes)) + (set-port-revealed! port 1))) ;;; {Load Paths} @@ -887,11 +775,15 @@ path))))) (#t '()))) -(define %load-path (append (parse-path (%getenv "SCHEME_LOAD_PATH")) - (list "" - (in-vicinity (implementation-vicinity) "gls/guile/") - (in-vicinity (implementation-vicinity) "gls/") - (in-vicinity (implementation-vicinity) "slib/")))) +;;; we don't have false-if-exception (or defmacro) yet. +(define %load-path + (let ((lp (catch #t (lambda () (getenv "SCHEME_LOAD_PATH")) + (lambda args #f)))) + (append (parse-path lp) + (list "" + (in-vicinity (implementation-vicinity) "gls/guile/") + (in-vicinity (implementation-vicinity) "gls/") + (in-vicinity (implementation-vicinity) "slib/"))))) ;;; {try-load} ;;; @@ -2469,6 +2361,10 @@ (define (top-repl) (scm-style-repl)) +(defmacro false-if-exception (expr) + `(catch #t (lambda () ,expr) + (lambda args #f))) + (define-module (ice-9 calling)) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 58aaadb4d..5d2a23bf6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -17,6 +17,21 @@ Thu Aug 1 02:58:39 1996 Jim Blandy every if must have an else, or else the whole command has a non-zero exit code whenever the if's condition is false. +Thu Aug 1 08:22:24 1996 Gary Houston + + * posix.c: include string.h. + +Wed Jul 31 23:43:05 1996 Gary Houston + + * numbers.c: rename %expt -> $expt, %atan2 -> $atan2, as it must + have been once. + + * posix.c, ioext.c, socket.c, fdsocket.c, files.c, filesys.c, simpos.c: + Remove leading % from scheme names. + Do not return error values, call SCM_SYSERROR or similar. + + * __scm.h (SCM_SYSERROR, SCM_SYSMISSING): new macros. + Wed Jun 12 00:28:31 1996 Tom Lord * struct.c (scm_init_struct): new file. diff --git a/libguile/__scm.h b/libguile/__scm.h index e3c5772ca..ec870b78a 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -285,7 +285,19 @@ extern unsigned int scm_async_clock; if (!(_cond)) \ goto _label #endif +#define SCM_SYSERROR(_subr) \ + scm_everr (SCM_UNDEFINED, SCM_EOL, SCM_UNDEFINED, \ + strerror (errno), _subr) + /* equivalent to: + scm_throw (system_error_sym, \ + scm_listify (scm_makfrom0str (strerror (errno)), \ + scm_makfrom0str (_subr), \ + SCM_UNDEFINED)); + */ +#define SCM_SYSMISSING(_subr) \ + scm_everr (SCM_UNDEFINED, SCM_EOL, SCM_UNDEFINED, \ + strerror (ENOSYS), _subr) #define SCM_ARGn 0 #define SCM_ARG1 1 diff --git a/libguile/filesys.c b/libguile/filesys.c index 556feba88..30ce43216 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -143,7 +143,7 @@ SCM_CONST_LONG (scm_O_SYNC, "O_SYNC", O_SYNC); /* {Permissions} */ -SCM_PROC (s_sys_chown, "%chown", 3, 0, 0, scm_sys_chown); +SCM_PROC (s_sys_chown, "chown", 3, 0, 0, scm_sys_chown); #ifdef __STDC__ SCM scm_sys_chown (SCM path, SCM owner, SCM group) @@ -156,17 +156,21 @@ scm_sys_chown (path, owner, group) #endif { int val; + SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_chown); if (SCM_SUBSTRP (path)) path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0); SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_sys_chown); SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_sys_chown); - SCM_SYSCALL (val = chown (SCM_ROCHARS (path), SCM_INUM (owner), SCM_INUM (group))); - return val ? SCM_MAKINUM (errno) : SCM_BOOL_T; + SCM_SYSCALL (val = chown (SCM_ROCHARS (path), + SCM_INUM (owner), SCM_INUM (group))); + if (val != 0) + SCM_SYSERROR (s_sys_chown); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_chmod, "%chmod", 2, 0, 0, scm_sys_chmod); +SCM_PROC (s_sys_chmod, "chmod", 2, 0, 0, scm_sys_chmod); #ifdef __STDC__ SCM scm_sys_chmod (SCM port_or_path, SCM mode) @@ -189,7 +193,9 @@ scm_sys_chmod (port_or_path, mode) if (rv != -1) SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode))); } - return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (rv != 0) + SCM_SYSERROR (s_sys_chmod); + return SCM_UNSPECIFIED; } SCM_PROC (s_umask, "umask", 0, 1, 0, scm_umask); @@ -280,7 +286,7 @@ scm_intern_fd (fd, flags) -SCM_PROC (s_sys_open, "%open", 3, 0, 0, scm_sys_open); +SCM_PROC (s_sys_open, "open", 3, 0, 0, scm_sys_open); #ifdef __STDC__ SCM scm_sys_open (SCM path, SCM flags, SCM mode) @@ -305,16 +311,15 @@ 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) - sfd = SCM_MAKINUM (errno); - else - sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc); + SCM_SYSERROR (s_sys_open); + sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc); SCM_ALLOW_INTS; return scm_return_first (sfd, path); } -SCM_PROC (s_sys_create, "%create", 2, 0, 0, scm_sys_create); +SCM_PROC (s_sys_create, "create", 2, 0, 0, scm_sys_create); #ifdef __STDC__ SCM scm_sys_create (SCM path, SCM mode) @@ -337,16 +342,15 @@ scm_sys_create (path, mode) SCM_DEFER_INTS; SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) ); if (fd == -1) - sfd = SCM_MAKINUM (errno); - else - sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc); + SCM_SYSERROR (s_sys_create); + sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc); SCM_ALLOW_INTS; return scm_return_first (sfd, path); } -SCM_PROC (s_sys_close, "%close", 1, 0, 0, scm_sys_close); +SCM_PROC (s_sys_close, "close", 1, 0, 0, scm_sys_close); #ifdef __STDC__ SCM scm_sys_close (SCM sfd) @@ -365,11 +369,13 @@ scm_sys_close (sfd) got = close (fd); SCM_SETCAR (sfd, scm_tc16_fd); SCM_ALLOW_INTS; - return (got == -1 ? SCM_MAKINUM (errno) : SCM_BOOL_T); + if (got == -1) + SCM_SYSERROR (s_sys_close); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_write_fd, "%write-fd", 2, 0, 0, scm_sys_write_fd); +SCM_PROC (s_sys_write_fd, "write-fd", 2, 0, 0, scm_sys_write_fd); #ifdef __STDC__ SCM scm_sys_write_fd (SCM sfd, SCM buf) @@ -389,15 +395,14 @@ scm_sys_write_fd (sfd, buf) SCM_DEFER_INTS; written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf)); if (written == -1) - answer = scm_cons (SCM_MAKINUM (errno), SCM_EOL); - else - answer = scm_long2num (written); + SCM_SYSERROR (s_sys_write_fd); + answer = scm_long2num (written); SCM_ALLOW_INTS; return scm_return_first (answer, buf); } -SCM_PROC (s_sys_read_fd, "%read-fd", 2, 2, 0, scm_sys_read_fd); +SCM_PROC (s_sys_read_fd, "read-fd", 2, 2, 0, scm_sys_read_fd); #ifdef __STDC__ SCM scm_sys_read_fd (SCM sfd, SCM buf, SCM offset, SCM length) @@ -442,14 +447,13 @@ scm_sys_read_fd (sfd, buf, offset, length) SCM_DEFER_INTS; got = read (fd, bytes + off, len); if (got == -1) - answer = scm_cons (SCM_MAKINUM (errno), SCM_EOL); - else - answer = scm_long2num (got); + SCM_SYSERROR (s_sys_read_fd); + answer = scm_long2num (got); SCM_ALLOW_INTS; return scm_return_first (answer, buf); } -SCM_PROC (s_sys_lseek, "%lseek", 2, 1, 0, scm_sys_lseek); +SCM_PROC (s_sys_lseek, "lseek", 2, 1, 0, scm_sys_lseek); #ifdef __STDC__ SCM scm_sys_lseek (SCM sfd, SCM offset, SCM whence) @@ -482,15 +486,14 @@ scm_sys_lseek (sfd, offset, whence) SCM_DEFER_INTS; SCM_SYSCALL (got = lseek (fd, off, wh)); if (got == -1) - answer = SCM_MAKINUM (errno); - else - answer = scm_long2num (got); + SCM_SYSERROR (s_sys_lseek); + answer = scm_long2num (got); SCM_ALLOW_INTS; return answer; } -SCM_PROC (s_sys_dup, "%dup", 1, 1, 0, scm_sys_dup); +SCM_PROC (s_sys_dup, "dup", 1, 1, 0, scm_sys_dup); #ifdef __STDC__ SCM scm_sys_dup (SCM oldfd, SCM newfd) @@ -514,9 +517,9 @@ scm_sys_dup (oldfd, newfd) SCM_DEFER_INTS; fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2); nfd = fn (fd, nfd); - answer = (nfd == -1 - ? scm_cons (SCM_MAKINUM (errno), SCM_EOL) - : SCM_MAKINUM (nfd)); + if (nfd == -1) + SCM_SYSERROR (s_sys_dup); + answer = SCM_MAKINUM (nfd); SCM_ALLOW_INTS; return answer; } @@ -565,7 +568,7 @@ scm_stat2scm (stat_temp) return ans; } -SCM_PROC (s_sys_stat, "%stat", 1, 0, 0, scm_sys_stat); +SCM_PROC (s_sys_stat, "stat", 1, 0, 0, scm_sys_stat); #ifdef __STDC__ SCM scm_sys_stat (SCM fd_or_path) @@ -601,7 +604,9 @@ scm_sys_stat (fd_or_path) } } - return rv ? SCM_MAKINUM (errno) : scm_stat2scm (&stat_temp); + if (rv != 0) + SCM_SYSERROR (s_sys_stat); + return scm_stat2scm (&stat_temp); } @@ -609,7 +614,7 @@ scm_sys_stat (fd_or_path) /* {Modifying Directories} */ -SCM_PROC (s_sys_link, "%link", 2, 0, 0, scm_sys_link); +SCM_PROC (s_sys_link, "link", 2, 0, 0, scm_sys_link); #ifdef __STDC__ SCM scm_sys_link (SCM oldpath, SCM newpath) @@ -621,6 +626,7 @@ scm_sys_link (oldpath, newpath) #endif { int val; + SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1, s_sys_link); if (SCM_SUBSTRP (oldpath)) oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_ROLENGTH (oldpath), 0); @@ -628,12 +634,14 @@ scm_sys_link (oldpath, newpath) if (SCM_SUBSTRP (newpath)) newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0); SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath))); - return val ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (val != 0) + SCM_SYSERROR (s_sys_link); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_rename, "%rename-file", 2, 0, 0, scm_sys_rename); +SCM_PROC (s_sys_rename, "rename-file", 2, 0, 0, scm_sys_rename); #ifdef __STDC__ SCM scm_sys_rename (SCM oldname, SCM newname) @@ -649,25 +657,29 @@ scm_sys_rename (oldname, newname) SCM_ASSERT (SCM_NIMP (newname) && SCM_STRINGP (newname), newname, SCM_ARG2, s_sys_rename); #ifdef HAVE_RENAME SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname))); - return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (rv != 0) + SCM_SYSERROR (s_sys_rename); + return SCM_UNSPECIFIED; #else SCM_DEFER_INTS; SCM_SYSCALL (rv = link (SCM_CHARS (oldname), SCM_CHARS (newname))); - if (!rv) + if (rv == 0) { SCM_SYSCALL (rv = unlink (SCM_CHARS (oldname)));; - if (rv) + if (rv != 0) /* unlink failed. remove new name */ SCM_SYSCALL (unlink (SCM_CHARS (newname))); } SCM_ALLOW_INTS; - return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (rv != 0) + SCM_SYSERROR (s_sys_rename); + return SCM_UNSPECIFIED; #endif } -SCM_PROC (s_sys_mkdir, "%mkdir", 1, 1, 0, scm_sys_mkdir); +SCM_PROC (s_sys_mkdir, "mkdir", 1, 1, 0, scm_sys_mkdir); #ifdef __STDC__ SCM scm_sys_mkdir (SCM path, SCM mode) @@ -693,14 +705,18 @@ scm_sys_mkdir (path, mode) SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_mkdir); SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode))); } - return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (rv != 0) + SCM_SYSERROR (s_sys_mkdir); + return SCM_UNSPECIFIED; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_mkdir); + /* not reached. */ + return SCM_BOOL_F; #endif } -SCM_PROC (s_sys_rmdir, "%rmdir", 1, 0, 0, scm_sys_rmdir); +SCM_PROC (s_sys_rmdir, "rmdir", 1, 0, 0, scm_sys_rmdir); #ifdef __STDC__ SCM scm_sys_rmdir (SCM path) @@ -712,11 +728,16 @@ scm_sys_rmdir (path) { #ifdef HAVE_RMDIR int val; + SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir); SCM_SYSCALL (val = rmdir (SCM_CHARS (path))); - return val ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (val != 0) + SCM_SYSERROR (s_sys_rmdir); + return SCM_UNSPECIFIED; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_rmdir); + /* not reached. */ + return SCM_BOOL_F; #endif } @@ -726,7 +747,7 @@ scm_sys_rmdir (path) long scm_tc16_dir; -SCM_PROC (s_sys_opendir, "%opendir", 1, 0, 0, scm_sys_opendir); +SCM_PROC (s_sys_opendir, "opendir", 1, 0, 0, scm_sys_opendir); #ifdef __STDC__ SCM scm_sys_opendir (SCM dirname) @@ -742,11 +763,8 @@ scm_sys_opendir (dirname) SCM_NEWCELL (dir); SCM_DEFER_INTS; SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname))); - if (!ds) - { - SCM_ALLOW_INTS; - return SCM_MAKINUM (errno); - } + if (ds == NULL) + SCM_SYSERROR (s_sys_opendir); SCM_CAR (dir) = scm_tc16_dir | SCM_OPN; SCM_SETCDR (dir, ds); SCM_ALLOW_INTS; @@ -754,7 +772,7 @@ scm_sys_opendir (dirname) } -SCM_PROC (s_sys_readdir, "%readdir", 1, 0, 0, scm_sys_readdir); +SCM_PROC (s_sys_readdir, "readdir", 1, 0, 0, scm_sys_readdir); #ifdef __STDC__ SCM scm_sys_readdir (SCM port) @@ -770,9 +788,10 @@ scm_sys_readdir (port) errno = 0; SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port))); SCM_ALLOW_INTS; - return (rdent - ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0) - : (errno ? SCM_MAKINUM (errno) : SCM_EOF_VAL)); + if (errno != 0) + SCM_SYSERROR (s_sys_readdir); + return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0) + : SCM_EOF_VAL); } @@ -794,7 +813,7 @@ scm_rewinddir (port) -SCM_PROC (s_sys_closedir, "%closedir", 1, 0, 0, scm_sys_closedir); +SCM_PROC (s_sys_closedir, "closedir", 1, 0, 0, scm_sys_closedir); #ifdef __STDC__ SCM scm_sys_closedir (SCM port) @@ -805,22 +824,20 @@ scm_sys_closedir (port) #endif { int sts; + SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_sys_closedir); SCM_DEFER_INTS; if (SCM_CLOSEDP (port)) { SCM_ALLOW_INTS; - return SCM_MAKINUM (errno); + return SCM_UNSPECIFIED; } SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port))); - if (sts) - { - SCM_ALLOW_INTS; - return SCM_MAKINUM (errno); - } + if (sts != 0) + SCM_SYSERROR (s_sys_closedir); SCM_CAR (port) = scm_tc16_dir; SCM_ALLOW_INTS; - return SCM_BOOL_T; + return SCM_UNSPECIFIED; } @@ -861,7 +878,7 @@ static scm_smobfuns dir_smob = {scm_mark0, scm_dir_free, scm_dir_print, 0}; */ -SCM_PROC (s_sys_chdir, "%chdir", 1, 0, 0, scm_sys_chdir); +SCM_PROC (s_sys_chdir, "chdir", 1, 0, 0, scm_sys_chdir); #ifdef __STDC__ SCM scm_sys_chdir (SCM str) @@ -872,14 +889,17 @@ scm_sys_chdir (str) #endif { int ans; + SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_chdir); SCM_SYSCALL (ans = chdir (SCM_CHARS (str))); - return ans ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (ans != 0) + SCM_SYSERROR (s_sys_chdir); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_getcwd, "%getcwd", 0, 0, 0, scm_sys_getcwd); +SCM_PROC (s_sys_getcwd, "getcwd", 0, 0, 0, scm_sys_getcwd); #ifdef __STDC__ SCM scm_sys_getcwd (void) @@ -903,15 +923,16 @@ scm_sys_getcwd () size *= 2; wd = scm_must_malloc (size, s_sys_getcwd); } - if (rv != 0) - result = scm_makfromstr (wd, strlen (wd), 0); - else - result = SCM_MAKINUM (errno); + if (rv == 0) + SCM_SYSERROR (s_sys_getcwd); + result = scm_makfromstr (wd, strlen (wd), 0); scm_must_free (wd); SCM_ALLOW_INTS; return result; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_getcwd); + /* not reached. */ + return SCM_BOOL_F; #endif } @@ -978,7 +999,7 @@ retrieve_select_type (set, list) } -SCM_PROC (s_sys_select, "%select", 3, 2, 0, scm_sys_select); +SCM_PROC (s_sys_select, "select", 3, 2, 0, scm_sys_select); #ifdef __STDC__ SCM scm_sys_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs) @@ -1032,14 +1053,15 @@ scm_sys_select (reads, writes, excepts, secs, msecs) &read_set, &write_set, &except_set, time_p); SCM_ALLOW_INTS; if (sreturn < 0) - return SCM_MAKINUM (errno); - else - return scm_listify (retrieve_select_type (&read_set, reads), - retrieve_select_type (&write_set, writes), - retrieve_select_type (&except_set, excepts), - SCM_UNDEFINED); + 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 - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_select); + /* not reached. */ + return SCM_BOOL_F; #endif } @@ -1047,7 +1069,7 @@ scm_sys_select (reads, writes, excepts, secs, msecs) /* {Symbolic Links} */ -SCM_PROC (s_sys_symlink, "%symlink", 2, 0, 0, scm_sys_symlink); +SCM_PROC (s_sys_symlink, "symlink", 2, 0, 0, scm_sys_symlink); #ifdef __STDC__ SCM scm_sys_symlink(SCM oldpath, SCM newpath) @@ -1060,17 +1082,22 @@ scm_sys_symlink(oldpath, newpath) { #ifdef HAVE_SYMLINK int val; + SCM_ASSERT(SCM_NIMP(oldpath) && SCM_STRINGP(oldpath), oldpath, SCM_ARG1, 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))); - return val ? SCM_MAKINUM (errno) : SCM_BOOL_T; + SCM_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath))); + if (val != 0) + SCM_SYSERROR (s_sys_symlink); + return SCM_UNSPECIFIED; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_symlink); + /* not reached. */ + return SCM_BOOL_F; #endif } -SCM_PROC (s_sys_readlink, "%readlink", 1, 0, 0, scm_sys_readlink); +SCM_PROC (s_sys_readlink, "readlink", 1, 0, 0, scm_sys_readlink); #ifdef __STDC__ SCM scm_sys_readlink(SCM path) @@ -1094,20 +1121,21 @@ scm_sys_readlink(path) size *= 2; buf = scm_must_malloc (size, s_sys_readlink); } - if (rv != -1) - result = scm_makfromstr (buf, rv, 0); - else - result = SCM_MAKINUM (errno); + if (rv == -1) + SCM_SYSERROR (s_sys_readlink); + result = scm_makfromstr (buf, rv, 0); scm_must_free (buf); SCM_ALLOW_INTS; return result; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_readlink); + /* not reached. */ + return SCM_BOOL_F; #endif } -SCM_PROC (s_sys_lstat, "%lstat", 1, 0, 0, scm_sys_lstat); +SCM_PROC (s_sys_lstat, "lstat", 1, 0, 0, scm_sys_lstat); #ifdef __STDC__ SCM scm_sys_lstat(SCM str) @@ -1117,19 +1145,24 @@ scm_sys_lstat(str) SCM str; #endif { -#ifdef HAVE_LSTATE - int i; +#ifdef HAVE_LSTAT + int rv; struct stat stat_temp; + SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_sys_lstat); - SCM_SYSCALL(i = lstat(SCM_CHARS(str), &stat_temp)); - return i ? SCM_MAKINUM (errno) : scm_stat2scm(&stat_temp); + SCM_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp)); + if (rv != 0) + SCM_SYSERROR (s_sys_lstat); + return scm_stat2scm(&stat_temp); #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_lstat); + /* not reached. */ + return SCM_BOOL_F; #endif } -SCM_PROC (s_sys_copy_file, "%copy-file", 2, 0, 0, scm_sys_copy_file); +SCM_PROC (s_sys_copy_file, "copy-file", 2, 0, 0, scm_sys_copy_file); #ifdef __STDC__ SCM scm_sys_copy_file (SCM oldfile, SCM newfile) @@ -1152,39 +1185,30 @@ 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) - return SCM_BOOL_F; + SCM_SYSERROR (s_sys_copy_file); SCM_DEFER_INTS; oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY); if (oldfd == -1) - { - SCM_ALLOW_INTS; - return SCM_BOOL_F; - } - /* should probably use the POSIX flags instead of 07777. */ + 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) - { - close (oldfd); - SCM_ALLOW_INTS; - return SCM_BOOL_F; - } + 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_ALLOW_INTS; - return SCM_BOOL_F; + SCM_SYSERROR (s_sys_copy_file); } close (oldfd); if (close (newfd) == -1) - { - SCM_ALLOW_INTS; - return SCM_BOOL_F; - } + SCM_SYSERROR (s_sys_copy_file); SCM_ALLOW_INTS; - return SCM_BOOL_T; + return SCM_UNSPECIFIED; } diff --git a/libguile/ioext.c b/libguile/ioext.c index d51b9a09d..707a95e57 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -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) diff --git a/libguile/numbers.c b/libguile/numbers.c index b572ed79f..bc2e831cb 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3488,7 +3488,7 @@ void scm_two_doubles(z1, z2, sstring, xy) -SCM_PROC(s_sys_expt, "%expt", 2, 0, 0, scm_sys_expt); +SCM_PROC(s_sys_expt, "$expt", 2, 0, 0, scm_sys_expt); #ifdef __STDC__ SCM scm_sys_expt(SCM z1, SCM z2) @@ -3506,7 +3506,7 @@ scm_sys_expt(z1, z2) -SCM_PROC(s_sys_atan2, "%atan2", 2, 0, 0, scm_sys_atan2); +SCM_PROC(s_sys_atan2, "$atan2", 2, 0, 0, scm_sys_atan2); #ifdef __STDC__ SCM scm_sys_atan2(SCM z1, SCM z2) diff --git a/libguile/posix.c b/libguile/posix.c index 803b2b922..3636a500a 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -45,6 +45,9 @@ +#ifdef HAVE_STRING_H +#include +#endif #ifdef TIME_WITH_SYS_TIME # include # include @@ -133,7 +136,7 @@ char *strptime (); -SCM_PROC (s_sys_pipe, "%pipe", 0, 0, 0, scm_sys_pipe); +SCM_PROC (s_sys_pipe, "pipe", 0, 0, 0, scm_sys_pipe); #ifdef __STDC__ SCM scm_sys_pipe (void) @@ -145,21 +148,20 @@ scm_sys_pipe () int fd[2], rv; FILE *f_rd, *f_wt; SCM p_rd, p_wt; + struct scm_port_table * ptr; + struct scm_port_table * ptw; + SCM_NEWCELL (p_rd); SCM_NEWCELL (p_wt); rv = pipe (fd); if (rv) - { - SCM_ALLOW_INTS; - return SCM_BOOL_F; - } + 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_ALLOW_INTS; - return SCM_BOOL_F; + SCM_SYSERROR (s_sys_pipe); } f_wt = fdopen (fd[1], "w"); if (!f_wt) @@ -168,29 +170,25 @@ scm_sys_pipe () en = errno; fclose (f_rd); SCM_SYSCALL (close (fd[1])); - SCM_ALLOW_INTS; - return SCM_MAKINUM (en); + errno = en; + SCM_SYSERROR (s_sys_pipe); } - { - struct scm_port_table * ptr; - struct scm_port_table * ptw; + ptr = scm_add_to_port_table (p_rd); + ptw = scm_add_to_port_table (p_wt); + SCM_SETPTAB_ENTRY (p_rd, ptr); + SCM_SETPTAB_ENTRY (p_wt, ptw); + SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r"); + SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w"); + SCM_SETSTREAM (p_rd, (SCM)f_rd); + SCM_SETSTREAM (p_wt, (SCM)f_wt); - ptr = scm_add_to_port_table (p_rd); - ptw = scm_add_to_port_table (p_wt); - SCM_SETPTAB_ENTRY (p_rd, ptr); - SCM_SETPTAB_ENTRY (p_wt, ptw); - SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r"); - SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w"); - SCM_SETSTREAM (p_rd, (SCM)f_rd); - SCM_SETSTREAM (p_wt, (SCM)f_wt); - } SCM_ALLOW_INTS; return scm_cons (p_rd, p_wt); } -SCM_PROC (s_sys_getgroups, "%getgroups", 0, 0, 0, scm_sys_getgroups); +SCM_PROC (s_sys_getgroups, "getgroups", 0, 0, 0, scm_sys_getgroups); #ifdef __STDC__ SCM scm_sys_getgroups(void) @@ -201,7 +199,8 @@ scm_sys_getgroups() { SCM grps, ans; int ngroups = getgroups (0, NULL); - if (!ngroups) return SCM_BOOL_F; + if (!ngroups) + SCM_SYSERROR (s_sys_getgroups); SCM_NEWCELL(grps); SCM_DEFER_INTS; { @@ -214,8 +213,7 @@ scm_sys_getgroups() if (val < 0) { scm_must_free((char *)groups); - SCM_ALLOW_INTS; - return SCM_MAKINUM (errno); + 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); @@ -229,7 +227,7 @@ scm_sys_getgroups() -SCM_PROC (s_sys_getpwuid, "%getpw", 0, 1, 0, scm_sys_getpwuid); +SCM_PROC (s_sys_getpwuid, "getpw", 0, 1, 0, scm_sys_getpwuid); #ifdef __STDC__ SCM scm_sys_getpwuid (SCM user) @@ -264,10 +262,8 @@ scm_sys_getpwuid (user) entry = getpwnam (SCM_ROCHARS (user)); } if (!entry) - { - SCM_ALLOW_INTS; - return SCM_BOOL_F; - } + SCM_SYSERROR (s_sys_getpwuid); + ve[0] = scm_makfrom0str (entry->pw_name); ve[1] = scm_makfrom0str (entry->pw_passwd); ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid); @@ -307,7 +303,7 @@ scm_setpwent (arg) /* Combines getgrgid and getgrnam. */ -SCM_PROC (s_sys_getgrgid, "%getgr", 0, 1, 0, scm_sys_getgrgid); +SCM_PROC (s_sys_getgrgid, "getgr", 0, 1, 0, scm_sys_getgrgid); #ifdef __STDC__ SCM scm_sys_getgrgid (SCM name) @@ -335,10 +331,8 @@ scm_sys_getgrgid (name) SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name))); } if (!entry) - { - SCM_ALLOW_INTS; - return SCM_MAKINUM (errno); - } + SCM_SYSERROR (s_sys_getgrgid); + ve[0] = scm_makfrom0str (entry->gr_name); ve[1] = scm_makfrom0str (entry->gr_passwd); ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid); @@ -368,7 +362,7 @@ scm_setgrent (arg) -SCM_PROC (s_sys_kill, "%kill", 2, 0, 0, scm_sys_kill); +SCM_PROC (s_sys_kill, "kill", 2, 0, 0, scm_sys_kill); #ifdef __STDC__ SCM scm_sys_kill (SCM pid, SCM sig) @@ -379,17 +373,17 @@ scm_sys_kill (pid, sig) SCM sig; #endif { - int i; SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_kill); SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill); /* Signal values are interned in scm_init_posix(). */ - SCM_SYSCALL (i = kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig))); - return i ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0) + SCM_SYSERROR (s_sys_kill); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_waitpid, "%waitpid", 1, 1, 0, scm_sys_waitpid); +SCM_PROC (s_sys_waitpid, "waitpid", 1, 1, 0, scm_sys_waitpid); #ifdef __STDC__ SCM scm_sys_waitpid (SCM pid, SCM options) @@ -413,9 +407,9 @@ scm_sys_waitpid (pid, options) ioptions = SCM_INUM (options); } SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions)); - return ((i == -1) - ? SCM_MAKINUM (errno) - : scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status))); + if (i == -1) + SCM_SYSERROR (s_sys_waitpid); + return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)); } @@ -497,7 +491,7 @@ scm_getegid () } -SCM_PROC (s_sys_setuid, "%setuid", 1, 0, 0, scm_sys_setuid); +SCM_PROC (s_sys_setuid, "setuid", 1, 0, 0, scm_sys_setuid); #ifdef __STDC__ SCM scm_sys_setuid (SCM id) @@ -508,10 +502,12 @@ scm_sys_setuid (id) #endif { SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid); - return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (setuid (SCM_INUM (id)) != 0) + SCM_SYSERROR (s_sys_setuid); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_setgid, "%setgid", 1, 0, 0, scm_sys_setgid); +SCM_PROC (s_sys_setgid, "setgid", 1, 0, 0, scm_sys_setgid); #ifdef __STDC__ SCM scm_sys_setgid (SCM id) @@ -522,10 +518,12 @@ scm_sys_setgid (id) #endif { SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid); - return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (setgid (SCM_INUM (id)) != 0) + SCM_SYSERROR (s_sys_setgid); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_seteuid, "%seteuid", 1, 0, 0, scm_sys_seteuid); +SCM_PROC (s_sys_seteuid, "seteuid", 1, 0, 0, scm_sys_seteuid); #ifdef __STDC__ SCM scm_sys_seteuid (SCM id) @@ -535,15 +533,20 @@ scm_sys_seteuid (id) SCM id; #endif { + int rv; + SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid); #ifdef HAVE_SETEUID - return seteuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + rv = seteuid (SCM_INUM (id)); #else - return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + rv = setuid (SCM_INUM (id)); #endif + if (rv != 0) + SCM_SYSERROR (s_sys_seteuid); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_setegid, "%setegid", 1, 0, 0, scm_sys_setegid); +SCM_PROC (s_sys_setegid, "setegid", 1, 0, 0, scm_sys_setegid); #ifdef __STDC__ SCM scm_sys_setegid (SCM id) @@ -553,12 +556,18 @@ scm_sys_setegid (id) SCM id; #endif { + int rv; + SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid); #ifdef HAVE_SETEUID - return setegid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + rv = setegid (SCM_INUM (id)); #else - return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + rv = setgid (SCM_INUM (id)); #endif + if (rv != 0) + SCM_SYSERROR (s_sys_setegid); + return SCM_UNSPECIFIED; + } SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp); @@ -570,30 +579,34 @@ scm_getpgrp () return SCM_MAKINUM (fn (0)); } -SCM_PROC (s_setpgid, "%setpgid", 2, 0, 0, scm_setpgid); +SCM_PROC (s_setpgid, "setpgid", 2, 0, 0, scm_setpgid); SCM scm_setpgid (pid, pgid) SCM pid, pgid; { SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid); SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid); - /* This may be known as setpgrp, from BSD. */ - return setpgid (SCM_INUM (pid), SCM_INUM (pgid)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + /* FIXME(?): may be known as setpgrp. */ + if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) + SCM_SYSERROR (s_setpgid); + return SCM_UNSPECIFIED; } -SCM_PROC (s_setsid, "%setsid", 0, 0, 0, scm_setsid); +SCM_PROC (s_setsid, "setsid", 0, 0, 0, scm_setsid); SCM scm_setsid () { pid_t sid = setsid (); - return (sid == -1) ? SCM_BOOL_F : SCM_MAKINUM (sid); + if (sid == -1) + SCM_SYSERROR (s_setsid); + return SCM_UNSPECIFIED; } #ifndef ttyname extern char * ttyname(); #endif -SCM_PROC (s_ttyname, "%ttyname", 1, 0, 0, scm_ttyname); +SCM_PROC (s_ttyname, "ttyname", 1, 0, 0, scm_ttyname); #ifdef __STDC__ SCM scm_ttyname (SCM port) @@ -609,24 +622,27 @@ scm_ttyname (port) if (scm_tc16_fport != SCM_TYP16 (port)) return SCM_BOOL_F; fd = fileno ((FILE *)SCM_STREAM (port)); - if (fd != -1) - SCM_SYSCALL (ans = ttyname (fd)); + if (fd == -1) + SCM_SYSERROR (s_ttyname); + SCM_SYSCALL (ans = ttyname (fd)); + if (!ans) + SCM_SYSERROR (s_ttyname); /* ans could be overwritten by another call to ttyname */ - return (((fd != -1) && ans) - ? scm_makfrom0str (ans) - : SCM_MAKINUM (errno)); + return (scm_makfrom0str (ans)); } -SCM_PROC (s_ctermid, "%ctermid", 0, 0, 0, scm_ctermid); +SCM_PROC (s_ctermid, "ctermid", 0, 0, 0, scm_ctermid); SCM scm_ctermid () { char *result = ctermid (NULL); - return *result == '\0' ? SCM_BOOL_F : scm_makfrom0str (result); + if (*result == '\0') + SCM_SYSERROR (s_ctermid); + return scm_makfrom0str (result); } -SCM_PROC (s_tcgetpgrp, "%tcgetpgrp", 1, 0, 0, scm_tcgetpgrp); +SCM_PROC (s_tcgetpgrp, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp); SCM scm_tcgetpgrp (port) SCM port; @@ -636,12 +652,11 @@ scm_tcgetpgrp (port) SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp); fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1) - return SCM_BOOL_F; - else - return SCM_MAKINUM (pgid); + SCM_SYSERROR (s_tcgetpgrp); + return SCM_MAKINUM (pgid); } -SCM_PROC (s_tcsetpgrp, "%tcsetpgrp", 2, 0, 0, scm_tcsetpgrp); +SCM_PROC (s_tcsetpgrp, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp); SCM scm_tcsetpgrp (port, pgid) SCM port, pgid; @@ -651,9 +666,8 @@ scm_tcsetpgrp (port, pgid) SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp); fd = fileno ((FILE *)SCM_STREAM (port)); if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1) - return SCM_BOOL_F; - else - return SCM_BOOL_T; + SCM_SYSERROR (s_tcsetpgrp); + return SCM_UNSPECIFIED; } /* Copy exec args from an SCM vector into a new C array. */ @@ -692,7 +706,7 @@ scm_convert_exec_args (args) return execargv; } -SCM_PROC (s_sys_execl, "%execl", 0, 0, 1, scm_sys_execl); +SCM_PROC (s_sys_execl, "execl", 0, 0, 1, scm_sys_execl); #ifdef __STDC__ SCM scm_sys_execl (SCM args) @@ -710,10 +724,12 @@ scm_sys_execl (args) args = SCM_CDR (args); execargv = scm_convert_exec_args (args); execv (SCM_ROCHARS (filename), execargv); - return SCM_MAKINUM (errno); + SCM_SYSERROR (s_sys_execl); + /* not reached. */ + return SCM_BOOL_F; } -SCM_PROC (s_sys_execlp, "%execlp", 0, 0, 1, scm_sys_execlp); +SCM_PROC (s_sys_execlp, "execlp", 0, 0, 1, scm_sys_execlp); #ifdef __STDC__ SCM scm_sys_execlp (SCM args) @@ -731,11 +747,13 @@ scm_sys_execlp (args) args = SCM_CDR (args); execargv = scm_convert_exec_args (args); execvp (SCM_ROCHARS (filename), execargv); - return SCM_MAKINUM (errno); + SCM_SYSERROR (s_sys_execlp); + /* not reached. */ + return SCM_BOOL_F; } /* Flushing streams etc., is not done here. */ -SCM_PROC (s_sys_fork, "%fork", 0, 0, 0, scm_sys_fork); +SCM_PROC (s_sys_fork, "fork", 0, 0, 0, scm_sys_fork); #ifdef __STDC__ SCM scm_sys_fork(void) @@ -747,13 +765,12 @@ scm_sys_fork() pid_t pid; pid = fork (); if (pid == -1) - return SCM_BOOL_F; - else - return SCM_MAKINUM (0L+pid); + SCM_SYSERROR (s_sys_fork); + return SCM_MAKINUM (0L+pid); } -SCM_PROC (s_sys_uname, "%uname", 0, 0, 0, scm_sys_uname); +SCM_PROC (s_sys_uname, "uname", 0, 0, 0, scm_sys_uname); #ifdef __STDC__ SCM scm_sys_uname (void) @@ -774,12 +791,14 @@ scm_sys_uname () ve[3] = scm_makfrom0str (buf.version); ve[4] = scm_makfrom0str (buf.machine); /* - FIXME + a linux special? ve[5] = scm_makfrom0str (buf.domainname); */ return ans; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_uname); + /* not reached. */ + return SCM_BOOL_F; #endif } @@ -854,6 +873,8 @@ scm_open_pipe (pipestr, modes) { FILE *f; register SCM z; + struct scm_port_table * pt; + SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr, SCM_ARG1, s_open_pipe); if (SCM_SUBSTRP (pipestr)) pipestr = scm_makfromstr (SCM_ROCHARS (pipestr), SCM_ROLENGTH (pipestr), 0); @@ -866,15 +887,12 @@ scm_open_pipe (pipestr, modes) SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes))); scm_unignore_signals (); if (!f) - z = SCM_BOOL_F; - else - { - struct scm_port_table * pt; - pt = scm_add_to_port_table (z); - SCM_SETPTAB_ENTRY (z, pt); - SCM_CAR (z) = scm_tc16_pipe | SCM_OPN | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG); - SCM_SETSTREAM (z, (SCM)f); - } + 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 + | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG); + SCM_SETSTREAM (z, (SCM)f); SCM_ALLOW_INTS; return z; } @@ -913,7 +931,7 @@ scm_open_output_pipe(pipestr) #include #endif -SCM_PROC (s_sys_utime, "%utime", 1, 2, 0, scm_sys_utime); +SCM_PROC (s_sys_utime, "utime", 1, 2, 0, scm_sys_utime); #ifdef __STDC__ SCM scm_sys_utime (SCM pathname, SCM actime, SCM modtime) @@ -941,13 +959,11 @@ scm_sys_utime (pathname, actime, modtime) utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime); SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp)); - return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (rv != 0) + SCM_SYSERROR (s_sys_utime); + return SCM_UNSPECIFIED; } - - - - SCM_PROC (s_sys_access, "access?", 2, 0, 0, scm_sys_access); #ifdef __STDC__ SCM @@ -969,8 +985,6 @@ scm_sys_access (path, how) return rv ? SCM_BOOL_F : SCM_BOOL_T; } - - SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid); #ifdef __STDC__ SCM @@ -983,8 +997,7 @@ scm_getpid () return SCM_MAKINUM ((unsigned long) getpid ()); } - -SCM_PROC (s_sys_putenv, "%putenv", 1, 0, 0, scm_sys_putenv); +SCM_PROC (s_sys_putenv, "putenv", 1, 0, 0, scm_sys_putenv); #ifdef __STDC__ SCM scm_sys_putenv (SCM str) @@ -998,11 +1011,12 @@ 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 - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_putenv); + /* not reached. */ + return SCM_BOOL_F; #endif } - SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line); #ifdef __STDC__ SCM @@ -1065,8 +1079,6 @@ scm_read_line (port, include_terminator) } } - - SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x); #ifdef __STDC__ SCM @@ -1111,8 +1123,6 @@ scm_read_line_x (str, port) } } - - SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line); #ifdef __STDC__ SCM @@ -1128,9 +1138,7 @@ scm_write_line (obj, port) return scm_newline (port); } - - -SCM_PROC (s_setlocale, "%setlocale", 1, 1, 0, scm_setlocale); +SCM_PROC (s_setlocale, "setlocale", 1, 1, 0, scm_setlocale); #ifdef __STDC__ SCM scm_setlocale (SCM category, SCM locale) @@ -1157,10 +1165,13 @@ scm_setlocale (category, locale) } rv = setlocale (SCM_INUM (category), clocale); - return rv ? scm_makfrom0str (rv) : SCM_MAKINUM (errno); + if (rv == NULL) + SCM_SYSERROR (s_setlocale); + return scm_makfrom0str (rv); #else - /* setlocale not available. */ - return SCM_MAKINUM (errno); + SCM_SYSMISSING (s_setlocale); + /* not reached. */ + return SCM_BOOL_F; #endif } @@ -1217,9 +1228,7 @@ scm_strftime (format, stime) return scm_makfromstr (tbuf, len, 0); } - - -SCM_PROC (s_sys_strptime, "%strptime", 2, 0, 0, scm_sys_strptime); +SCM_PROC (s_sys_strptime, "strptime", 2, 0, 0, scm_sys_strptime); #ifdef __STDC__ SCM scm_sys_strptime (SCM format, SCM string) @@ -1235,7 +1244,6 @@ scm_sys_strptime (format, string) struct tm t; char *fmt, *str, *rest; - int len; int n; SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_sys_strptime); @@ -1265,9 +1273,8 @@ scm_sys_strptime (format, string) rest = strptime (str, fmt, &t); SCM_ALLOW_INTS; - if (rest == NULL) { - return SCM_BOOL_F; - } + if (rest == NULL) + SCM_SYSERROR (s_sys_strptime); stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED); @@ -1286,12 +1293,13 @@ scm_sys_strptime (format, string) return scm_cons (stime, scm_makfrom0str (rest)); #else - scm_wta (SCM_UNSPECIFIED, "strptime is not available and no replacement has (yet) been supplied", "strptime"); + SCM_SYSMISSING (s_sys_strptime); + /* not reached. */ return SCM_BOOL_F; #endif } -SCM_PROC (s_sys_mknod, "%mknod", 3, 0, 0, scm_sys_mknod); +SCM_PROC (s_sys_mknod, "mknod", 3, 0, 0, scm_sys_mknod); #ifdef __STDC__ SCM scm_sys_mknod(SCM path, SCM mode, SCM dev) @@ -1309,14 +1317,18 @@ scm_sys_mknod(path, mode, dev) SCM_ASSERT(SCM_INUMP(mode), mode, SCM_ARG2, 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))); - return val ? SCM_BOOL_F : SCM_BOOL_T; + if (val != 0) + SCM_SYSERROR (s_sys_mknod); + return SCM_UNSPECIFIED; #else + SCM_SYSMISSING (s_sys_mknod); + /* not reached. */ return SCM_BOOL_F; #endif } -SCM_PROC (s_sys_nice, "%nice", 1, 0, 0, scm_sys_nice); +SCM_PROC (s_sys_nice, "nice", 1, 0, 0, scm_sys_nice); #ifdef __STDC__ SCM scm_sys_nice(SCM incr) @@ -1328,9 +1340,13 @@ scm_sys_nice(incr) { #ifdef HAVE_NICE SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice); - return nice(SCM_INUM(incr)) ? SCM_MAKINUM (errno) : SCM_BOOL_T; + if (nice(SCM_INUM(incr)) != 0) + SCM_SYSERROR (s_sys_nice); + return SCM_UNSPECIFIED; #else - return SCM_MAKINUM (ENOSYS); + SCM_SYSMISSING (s_sys_nice); + /* not reached. */ + return SCM_BOOL_F; #endif } @@ -1347,7 +1363,9 @@ scm_sync() #ifdef HAVE_SYNC sync(); #endif - return SCM_UNSPECIFIED; + SCM_SYSMISSING (s_sync); + /* not reached. */ + return SCM_BOOL_F; } diff --git a/libguile/simpos.c b/libguile/simpos.c index f04e28cc5..a29cb304a 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -76,7 +76,7 @@ scm_system(cmd) #endif extern char *getenv(); -SCM_PROC (s_sys_getenv, "%getenv", 1, 0, 0, scm_sys_getenv); +SCM_PROC (s_sys_getenv, "getenv", 1, 0, 0, scm_sys_getenv); #ifdef __STDC__ SCM scm_sys_getenv(SCM nam) @@ -92,7 +92,7 @@ scm_sys_getenv(nam) nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0); val = getenv(SCM_CHARS(nam)); if (!val) - return SCM_BOOL_F; + 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 944609714..0bf9f505c 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -23,7 +23,7 @@ int close P ((int fd)); #endif /* STDC_HEADERS */ -SCM_PROC (s_sys_inet_aton, "%inet-aton", 1, 0, 0, scm_sys_inet_aton); +SCM_PROC (s_sys_inet_aton, "inet-aton", 1, 0, 0, scm_sys_inet_aton); #ifdef __STDC__ SCM scm_sys_inet_aton (SCM address) @@ -38,8 +38,9 @@ scm_sys_inet_aton (address) SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, SCM_ARG1, s_sys_inet_aton); if (SCM_SUBSTRP (address)) address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0); - rv = inet_aton (SCM_ROCHARS (address), &soka); - return rv ? scm_ulong2num (ntohl (soka.s_addr)) : SCM_BOOL_F; + if (inet_aton (SCM_ROCHARS (address), &soka) == 0) + SCM_SYSERROR (s_sys_inet_aton); + return scm_ulong2num (ntohl (soka.s_addr)); } @@ -121,7 +122,7 @@ scm_inet_makeaddr (net, lna) * Assumes hostent stream isn't reused. */ -SCM_PROC (s_sys_gethost, "%gethost", 0, 1, 0, scm_sys_gethost); +SCM_PROC (s_sys_gethost, "gethost", 0, 1, 0, scm_sys_gethost); #ifdef __STDC__ SCM scm_sys_gethost (SCM name) @@ -159,7 +160,7 @@ scm_sys_gethost (name) } SCM_ALLOW_INTS; if (!entry) - return SCM_BOOL_F; + 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); @@ -180,7 +181,7 @@ scm_sys_gethost (name) } -SCM_PROC (s_sys_getnet, "%getnet", 0, 1, 0, scm_sys_getnet); +SCM_PROC (s_sys_getnet, "getnet", 0, 1, 0, scm_sys_getnet); #ifdef __STDC__ SCM scm_sys_getnet (SCM name) @@ -215,7 +216,7 @@ scm_sys_getnet (name) } SCM_ALLOW_INTS; if (!entry) - return SCM_BOOL_F; + 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); @@ -223,7 +224,7 @@ scm_sys_getnet (name) return ans; } -SCM_PROC (s_sys_getproto, "%getproto", 0, 1, 0, scm_sys_getproto); +SCM_PROC (s_sys_getproto, "getproto", 0, 1, 0, scm_sys_getproto); #ifdef __STDC__ SCM scm_sys_getproto (SCM name) @@ -258,7 +259,7 @@ scm_sys_getproto (name) } SCM_ALLOW_INTS; if (!entry) - return SCM_BOOL_F; + 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); @@ -279,11 +280,6 @@ scm_return_entry (entry) ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F); ve = SCM_VELTS (ans); - if (!entry) - { - SCM_ALLOW_INTS; - return SCM_BOOL_F; - } ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0); ve[1] = scm_makfromstrs (-1, entry->s_aliases); ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); @@ -292,7 +288,7 @@ scm_return_entry (entry) return ans; } -SCM_PROC (s_sys_getserv, "%getserv", 0, 2, 0, scm_sys_getserv); +SCM_PROC (s_sys_getserv, "getserv", 0, 2, 0, scm_sys_getserv); #ifdef __STDC__ SCM scm_sys_getserv (SCM name, SCM proto) @@ -308,6 +304,8 @@ scm_sys_getserv (name, proto) { SCM_DEFER_INTS; entry = getservent (); + if (!entry) + SCM_SYSERROR (s_sys_getserv); return scm_return_entry (entry); } SCM_ASSERT (SCM_NIMP (proto) && SCM_STRINGP (proto), proto, SCM_ARG2, s_sys_getserv); @@ -322,6 +320,8 @@ scm_sys_getserv (name, proto) SCM_DEFER_INTS; entry = getservbyport (SCM_INUM (name), SCM_CHARS (proto)); } + if (!entry) + SCM_SYSERROR (s_sys_getserv); return scm_return_entry (entry); }