mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
make C system primitives throw exceptions
This commit is contained in:
Gary Houston
parent
cb0016401f
commit
02b754d3a6
10 changed files with 415 additions and 454 deletions
|
|
@ -5,6 +5,17 @@ Thu Aug 1 02:52:42 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
|||
* 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 <ghouston@actrix.gen.nz>
|
||||
|
||||
* 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 <ghouston@actrix.gen.nz>
|
||||
|
||||
* boot-9.scm (false-if-exception): new macro.
|
||||
|
||||
Fri Apr 19 13:53:08 1996 Tom Lord <lord@beehive>
|
||||
|
||||
* The more things change...
|
||||
|
|
|
|||
170
ice-9/boot-9.scm
170
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))
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,21 @@ Thu Aug 1 02:58:39 1996 Jim Blandy <jimb@totoro.cyclic.com>
|
|||
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 <ghouston@actrix.gen.nz>
|
||||
|
||||
* posix.c: include string.h.
|
||||
|
||||
Wed Jul 31 23:43:05 1996 Gary Houston <ghouston@actrix.gen.nz>
|
||||
|
||||
* 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 <lord@beehive>
|
||||
|
||||
* struct.c (scm_init_struct): new file.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
278
libguile/posix.c
278
libguile/posix.c
|
|
@ -45,6 +45,9 @@
|
|||
|
||||
|
||||
|
||||
#ifdef HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#ifdef TIME_WITH_SYS_TIME
|
||||
# include <sys/time.h>
|
||||
# include <time.h>
|
||||
|
|
@ -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 <utime.h>
|
||||
#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;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue