Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv9753/scsh
Modified Files:
dirstuff1.c dirstuff1.h filesys.scm scsh-package.scm
syscalls.c syscalls.scm syscalls1.c syscalls1.h
Log Message:
Replaced most of define-foreign by
define-stubless-foreign/define-retrying-syscall in syscalls.scm.
Index: dirstuff1.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/dirstuff1.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** dirstuff1.c 1999/09/14 13:32:01 1.1
--- dirstuff1.c 2001/08/08 09:21:20 1.2
***************
*** 8,145 ****
#include <stdlib.h>
#include <string.h>
- #include "libcig.h"
- #include "scsh_aux.h"
-
/* Make sure our exports match up w/the implementation: */
#include "dirstuff1.h"
-
- extern int errno;
! /* Linked list of malloc'd entries. */
! struct scm_dirent_struct
! { char *fname; /* File name */
! struct scm_dirent_struct *next;}; /* Next pointer */
! typedef struct scm_dirent_struct scm_dirent_t;
!
! void free_dirent_list(scm_dirent_t *entry)
{
! while(entry) {
! scm_dirent_t *next = entry->next;
! Free(entry);
! entry = next;
! }
! }
!
! /* Returns [err, fnames, len]
! ** err is 0 for success, otw errno.
! ** fnames is a vector of strings (filenames), null terminated.
! ** len is the length of fnames.
! */
! int open_dir(const char *dirname, char ***fnames, int *len)
! {
! scm_dirent_t *dep, *entries;
! struct dirent *dirent;
! char *fname, **dirvec, **vecp;
! DIR *d;
! int num_entries;
! int e; /* errno temp */
!
! if( NULL == (d = opendir(dirname)) ) {
! fnames = 0; len = 0;
! return errno;
! }
!
! entries = NULL; num_entries = 0;
! while( NULL != (dirent = readdir(d)) ) {
! if((strcmp(dirent->d_name,".") == 0) || (strcmp(dirent->d_name,"..") ==
0))
! continue;
! if( NULL == (dep=Alloc(scm_dirent_t)) )
! {e=errno; goto lose2;}
! if( NULL == (fname=copystring(NULL, dirent->d_name)) ) goto lose1;
! dep->fname = fname;
! dep->next = entries;
! entries = dep; num_entries++;
! }
! closedir(d);
! /* Load the filenames into a vector and free the structs. */
! if( NULL == (dirvec = Malloc(char *, num_entries+1)) )
! {e=errno; goto lose3;}
! for(dep=entries, vecp=dirvec; dep; vecp++) {
! scm_dirent_t *next = dep->next;
! *vecp = dep->fname;
! Free(dep);
! dep = next;
! }
! dirvec[num_entries] = NULL;
! *fnames = dirvec;
! *len = num_entries;
! return 0;
!
!
! lose1: e = errno; Free(dep);
! lose2: closedir(d);
! lose3: free_dirent_list(entries);
! fnames = 0; len = 0;
! return e;
! }
!
!
! #define DOTFILE(a) ((a) && *(a) == '.') /* Not a function. */
!
! /* a <= b in the Unix filename ordering:
! ** dotfiles come first, lexicographically ordered.
! ** others come second, lexicographically ordered.
! **
! ** This is for sorting filenames in directory listings.
! */
!
! static int compare_fname(const void *aptr, const void *bptr)
! {
! char const *a = * (char const * *) aptr;
! char const *b = * (char const * *) bptr;
! if( DOTFILE(a) )
! return DOTFILE(b) ? strcmp(a+1,b+1) : -1;
! return DOTFILE(b) ? 1 : strcmp(a,b);
! }
!
!
! void scm_sort_filevec(const char **dirvec, int nelts)
! {
! qsort((char *) dirvec, nelts, sizeof(char*), compare_fname);
! }
!
! #if 0
! /* This one is a little more complex, but we don't use it because we
! ** never try to sort lists of filenames with . or .. in the list.
! */
!
! /* Boolean function: a <= b in the Unix filename ordering:
! ** . comes first
! ** .. comes second
! ** Other dotfiles come next, lexicographically ordered.
! ** Non-dotfiles come last, lexicographically ordered.
! **
! ** This is for sorting filenames in directory listings.
! */
!
! static int comp1(const void *aptr, const void* bptr)
! {
! char const *a = *(char const **)aptr;
! char const *b = *(char const **)bptr;
!
! if(streq(a,b)) return 0;
!
! if(DOTFILE(a))
! if( DOTFILE(b) )
! return streq(a, ".") ||
! (!streq(b, ".") && (streq(a, "..") || (!streq(b, "..") &&
! (strcmp(a,b) <= 0))))
! ? -1 : 1;
! else return -1;
!
! else return DOTFILE(b) ? 1 : strcmp(a,b);
}
- #endif
--- 8,45 ----
#include <stdlib.h>
#include <string.h>
+ #include <errno.h>
/* Make sure our exports match up w/the implementation: */
+ #include "scheme48.h"
#include "dirstuff1.h"
! s48_value open_dir(s48_value sch_dirname)
{
! char *fname;
! struct dirent *dirent;
! DIR *d;
! s48_value dirlist = S48_NULL;
!
! S48_DECLARE_GC_PROTECT(1);
!
! S48_GC_PROTECT_1(dirlist);
!
! if( NULL == (d = opendir(s48_extract_string (sch_dirname))) )
! s48_raise_os_error_1 (errno, sch_dirname);
!
! while( NULL != (dirent = readdir(d)) ) {
! if((strcmp(dirent->d_name,".") == 0) || (strcmp(dirent->d_name,"..") ==
0))
! continue;
! if( NULL == (fname=copystring(NULL, dirent->d_name)) )
! s48_raise_os_error_1 (errno, sch_dirname);
! dirlist = s48_cons (s48_enter_string (dirent->d_name),
! dirlist);
! }
! if (closedir(d) == -1)
! s48_raise_os_error_1 (errno, sch_dirname);
!
! S48_GC_UNPROTECT ();
! return dirlist;
}
Index: dirstuff1.h
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/dirstuff1.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** dirstuff1.h 1999/09/14 13:32:01 1.1
--- dirstuff1.h 2001/08/08 09:21:20 1.2
***************
*** 1,4 ****
/* Exports from dirstuff1.c. */
! int open_dir(const char *dirname, char ***fnames, int *len);
! void scm_sort_filevec(const char **dirvec, int nelts);
--- 1,4 ----
/* Exports from dirstuff1.c. */
! s48_value open_dir(s48_value dirname);
!
Index: filesys.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/filesys.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** filesys.scm 1999/09/14 13:32:01 1.1
--- filesys.scm 2001/08/08 09:21:20 1.2
***************
*** 40,60 ****
(y-or-n? (string-append op-name ": " fname
" already exists. Delete")))))
! (let loop ((override? override?))
! ;; MAKEIT returns #f if win, errno if lose.
! (cond ((makeit fname) =>
! (lambda (err)
! (if (not (= err errno/exist))
! (errno-error err syscall fname)
- ;; FNAME exists. Nuke it and retry?
- (cond ((if (eq? override? 'query)
- (query)
- override?)
- (delete-filesys-object fname)
- (loop #t))
- (else
- (errno-error err syscall fname))))))))))
-
-
;;;;;;;
--- 40,62 ----
(y-or-n? (string-append op-name ": " fname
" already exists. Delete")))))
! (let ((result
! (let loop ((override? override?))
! (with-errno-handler
! ((err data)
! ((errno/exist)
! (cond ((if (eq? override? 'query)
! (query)
! override?)
! (delete-filesys-object fname)
! (loop #t))
! ;;; raising an error here won't work due to S48's
! ;;; broken exception system
! (else (list err syscall fname)))))
! (makeit fname)
! #f))))
! (if (list? result)
! (apply errno-error result)
! (if #f #f)))))
;;;;;;;
***************
*** 64,68 ****
(cadr rest))))
(create-file-thing dir
! (lambda (dir) (create-directory/errno dir perms))
override?
"create-directory"
--- 66,70 ----
(cadr rest))))
(create-file-thing dir
! (lambda (dir) (%create-directory dir perms))
override?
"create-directory"
***************
*** 74,78 ****
(cadr rest))))
(create-file-thing fifo
! (lambda (fifo) (create-fifo/errno fifo perms))
override?
"create-fifo"
--- 76,80 ----
(cadr rest))))
(create-file-thing fifo
! (lambda (fifo) (%create-fifo fifo perms))
override?
"create-fifo"
***************
*** 82,86 ****
(create-file-thing new-fname
(lambda (new-fname)
! (create-hard-link/errno old-fname new-fname))
(:optional maybe-override? #f)
"create-hard-link"
--- 84,88 ----
(create-file-thing new-fname
(lambda (new-fname)
! (%create-hard-link old-fname new-fname))
(:optional maybe-override? #f)
"create-hard-link"
***************
*** 90,94 ****
(create-file-thing new-fname
(lambda (symlink)
! (create-symlink/errno old-fname symlink))
(:optional maybe-override? #f)
"create-symlink"
--- 92,96 ----
(create-file-thing new-fname
(lambda (symlink)
! (%create-symlink old-fname symlink))
(:optional maybe-override? #f)
"create-symlink"
Index: scsh-package.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-package.scm,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -r1.22 -r1.23
*** scsh-package.scm 2001/07/09 18:29:26 1.22
--- scsh-package.scm 2001/08/08 09:21:20 1.23
***************
*** 135,138 ****
--- 135,139 ----
(scsh-level-0-internals (export set-command-line-args!
init-scsh-hindbrain
+ initialize-cwd
init-scsh-vars))
; (scsh-regexp-package scsh-regexp-interface)
***************
*** 206,209 ****
--- 207,211 ----
(for-syntax (open scsh-syntax-helpers scheme))
(access interrupts
+ sort
command-processor
escapes
Index: syscalls.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** syscalls.c 2001/08/06 08:33:24 1.13
--- syscalls.c 2001/08/08 09:21:20 1.14
***************
*** 30,518 ****
#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)
- s48_value df_getpid(void)
- {
- extern pid_t getpid(void);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- pid_t r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = getpid();
- ret1 = s48_enter_fixnum(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_getppid(void)
- {
- extern pid_t getppid(void);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- pid_t r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = getppid();
- ret1 = s48_enter_fixnum(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_getpgrp(void)
- {
- extern pid_t getpgrp(void);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- pid_t r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = getpgrp();
- ret1 = s48_enter_fixnum(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_setpgid(s48_value g1, s48_value g2)
- {
- extern int setpgid(pid_t , pid_t );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = setpgid(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_setsid(s48_value mv_vec)
- {
- extern pid_t setsid(void);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- pid_t r1;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = setsid();
- ret1 = errno_or_false(r1);
- S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_umask(s48_value g1)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- mode_t r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = umask(s48_extract_fixnum(g1));
- ret1 = s48_enter_fixnum(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_process_times(s48_value mv_vec)
- {
- extern int process_times(clock_t *, clock_t *, clock_t *, clock_t *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- int r1;
- clock_t r2 = 0;
- clock_t r3 = 0;
- clock_t r4 = 0;
- clock_t r5 = 0;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = process_times(&r2, &r3, &r4, &r5);
- ret1 = errno_or_false(r1);
- S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
- S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
- S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4));
- S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_cpu_clock_ticks_per_sec(void)
- {
- extern int cpu_clock_ticks_per_sec(void);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = cpu_clock_ticks_per_sec();
- ret1 = s48_enter_integer(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_chmod(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = chmod(s48_extract_string(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_fchmod(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = fchmod(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_chown(s48_value g1, s48_value g2, s48_value g3)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = chown(s48_extract_string(g1), s48_extract_fixnum(g2),
s48_extract_fixnum(g3));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_fchown(s48_value g1, s48_value g2, s48_value g3)
- {
- extern int fchown(int , uid_t , gid_t );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = fchown(s48_extract_fixnum(g1), s48_extract_fixnum(g2),
s48_extract_fixnum(g3));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_access(s48_value g1, s48_value g2)
- {
- extern int access(const char *, int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = access(s48_extract_string(g1), s48_extract_integer(g2));
- ret1 = ENTER_BOOLEAN(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_link(s48_value g1, s48_value g2)
- {
- extern int link(const char *, const char *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = link(s48_extract_string(g1), s48_extract_string(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_mkfifo(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = mkfifo(s48_extract_string(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_mkdir(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = mkdir(s48_extract_string(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_rename(s48_value g1, s48_value g2)
- {
- extern int rename(const char *, const char *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = rename(s48_extract_string(g1), s48_extract_string(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_rmdir(s48_value g1)
- {
- extern int rmdir(const char *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = rmdir(s48_extract_string(g1));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_scm_utime(s48_value g1, s48_value g2, s48_value g3)
- {
- extern int scm_utime(const char *, time_t , time_t );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = scm_utime(s48_extract_string(g1), s48_extract_integer(g2),
s48_extract_integer(g3));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_scm_utime_now(s48_value g1)
- {
- extern int scm_utime_now(const char *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = scm_utime_now(s48_extract_string(g1));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_symlink(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = symlink(s48_extract_string(g1), s48_extract_string(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_truncate(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = truncate(s48_extract_string(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_ftruncate(s48_value g1, s48_value g2)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = ftruncate(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_unlink(s48_value g1)
- {
- extern int unlink(const char *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = unlink(s48_extract_string(g1));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_fsync(s48_value g1)
- {
- extern int fsync(int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = fsync(s48_extract_fixnum(g1));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_sync(void)
- {
-
-
-
- sync();
- return S48_FALSE;
- }
-
- s48_value df_close(s48_value g1)
- {
- extern int close(int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(1);
- int r1;
-
-
-
- S48_GC_PROTECT_1(ret1);
- r1 = close(s48_extract_fixnum(g1));
- ret1 = errno_or_false(r1);
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_dup(s48_value g1, s48_value mv_vec)
- {
- extern int dup(int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- int r1;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = dup(s48_extract_fixnum(g1));
- ret1 = errno_or_false(r1);
- S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_dup2(s48_value g1, s48_value g2, s48_value mv_vec)
- {
- extern int dup2(int , int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- int r1;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = dup2(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
- ret1 = errno_or_false(r1);
- S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_lseek(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec)
- {
- extern off_t lseek(int , off_t , int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- off_t r1;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = lseek(s48_extract_fixnum(g1), s48_extract_fixnum(g2),
s48_extract_fixnum(g3));
- ret1 = errno_or_false(r1);
- S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
s48_value df_char_ready_fdes(s48_value g1)
{
--- 30,33 ----
***************
*** 531,551 ****
}
- s48_value df_open(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec)
- {
-
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- int r1;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = open(s48_extract_string(g1), s48_extract_fixnum(g2),
s48_extract_fixnum(g3));
- ret1 = errno_or_false(r1);
- S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
s48_value df_read_fdes_char(s48_value g1)
{
--- 46,49 ----
***************
*** 614,655 ****
}
- s48_value df_pause(void)
- {
-
-
-
- pause();
- return S48_FALSE;
- }
-
- s48_value df_open_dir(s48_value g1, s48_value mv_vec)
- {
- extern int open_dir(const char *, char** *, int *);
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- int r1;
- char** r2 = 0;
- int r3 = 0;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = open_dir(s48_extract_string(g1), &r2, &r3);
- ret1 = False_on_zero(r1);
- SetAlienVal(S48_VECTOR_REF(mv_vec,0),(long) r2);//simple-assign
- S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
- S48_GC_UNPROTECT();
- return ret1;
- }
-
- s48_value df_scm_sort_filevec(s48_value g1, s48_value g2)
- {
- extern void scm_sort_filevec(const char** , int );
-
-
- scm_sort_filevec((const char** )AlienVal(g1), s48_extract_fixnum(g2));
- return S48_FALSE;
- }
-
s48_value df_sleep_until(s48_value g1)
{
--- 112,115 ----
***************
*** 668,688 ****
}
- s48_value df_errno_msg(s48_value g1, s48_value mv_vec)
- {
- extern char *errno_msg(int );
- s48_value ret1 = S48_FALSE;
- S48_DECLARE_GC_PROTECT(2);
- char *r1;
-
-
-
- S48_GC_PROTECT_2(mv_vec,ret1);
- r1 = errno_msg(s48_extract_integer(g1));
- ret1 = S48_VECTOR_REF(mv_vec,0);
- SetAlienVal(S48_CAR(ret1),(long) r1);
S48_SET_CDR(ret1,strlen_or_false(r1));//str-and-len
- S48_GC_UNPROTECT();
- return ret1;
- }
-
void s48_init_syscalls(void)
{
--- 128,131 ----
***************
*** 703,741 ****
S48_EXPORT_FUNCTION(scsh_setuid);
S48_EXPORT_FUNCTION(scsh_seteuid);
! S48_EXPORT_FUNCTION(df_getpid);
! S48_EXPORT_FUNCTION(df_getppid);
! S48_EXPORT_FUNCTION(df_getpgrp);
! S48_EXPORT_FUNCTION(df_setpgid);
! S48_EXPORT_FUNCTION(df_setsid);
! S48_EXPORT_FUNCTION(df_umask);
! S48_EXPORT_FUNCTION(df_process_times);
! S48_EXPORT_FUNCTION(df_cpu_clock_ticks_per_sec);
! S48_EXPORT_FUNCTION(df_chmod);
! S48_EXPORT_FUNCTION(df_fchmod);
! S48_EXPORT_FUNCTION(df_chown);
! S48_EXPORT_FUNCTION(df_fchown);
! S48_EXPORT_FUNCTION(df_access);
! S48_EXPORT_FUNCTION(df_link);
! S48_EXPORT_FUNCTION(df_mkfifo);
! S48_EXPORT_FUNCTION(df_mkdir);
! S48_EXPORT_FUNCTION(scm_readlink);
! S48_EXPORT_FUNCTION(df_rename);
! S48_EXPORT_FUNCTION(df_rmdir);
! S48_EXPORT_FUNCTION(df_scm_utime);
! S48_EXPORT_FUNCTION(df_scm_utime_now);
S48_EXPORT_FUNCTION(scheme_stat);
S48_EXPORT_FUNCTION(scheme_fstat);
! S48_EXPORT_FUNCTION(df_symlink);
! S48_EXPORT_FUNCTION(df_truncate);
! S48_EXPORT_FUNCTION(df_ftruncate);
! S48_EXPORT_FUNCTION(df_unlink);
! S48_EXPORT_FUNCTION(df_fsync);
! S48_EXPORT_FUNCTION(df_sync);
! S48_EXPORT_FUNCTION(df_close);
! S48_EXPORT_FUNCTION(df_dup);
! S48_EXPORT_FUNCTION(df_dup2);
! S48_EXPORT_FUNCTION(df_lseek);
S48_EXPORT_FUNCTION(df_char_ready_fdes);
! S48_EXPORT_FUNCTION(df_open);
S48_EXPORT_FUNCTION(scheme_pipe);
S48_EXPORT_FUNCTION(df_read_fdes_char);
--- 146,184 ----
S48_EXPORT_FUNCTION(scsh_setuid);
S48_EXPORT_FUNCTION(scsh_seteuid);
! S48_EXPORT_FUNCTION(scsh_getpid);
! S48_EXPORT_FUNCTION(scsh_getppid);
! S48_EXPORT_FUNCTION(scsh_getpgrp);
! S48_EXPORT_FUNCTION(setpgid);
! S48_EXPORT_FUNCTION(scsh_setsid);
! S48_EXPORT_FUNCTION(scsh_umask);
! S48_EXPORT_FUNCTION(process_times);
! S48_EXPORT_FUNCTION(cpu_clock_ticks_per_sec);
! S48_EXPORT_FUNCTION(scsh_chmod);
! S48_EXPORT_FUNCTION(scsh_fchmod);
! S48_EXPORT_FUNCTION(scsh_chown);
! S48_EXPORT_FUNCTION(scsh_fchown);
! S48_EXPORT_FUNCTION(scsh_access);
! S48_EXPORT_FUNCTION(scsh_link);
! S48_EXPORT_FUNCTION(scsh_mkfifo);
! S48_EXPORT_FUNCTION(scsh_mkdir);
! S48_EXPORT_FUNCTION(scsh_readlink);
! S48_EXPORT_FUNCTION(scsh_rename);
! S48_EXPORT_FUNCTION(scsh_rmdir);
! S48_EXPORT_FUNCTION(scm_utime);
! S48_EXPORT_FUNCTION(scm_utime_now);
S48_EXPORT_FUNCTION(scheme_stat);
S48_EXPORT_FUNCTION(scheme_fstat);
! S48_EXPORT_FUNCTION(scsh_symlink);
! S48_EXPORT_FUNCTION(scsh_truncate);
! S48_EXPORT_FUNCTION(scsh_ftruncate);
! S48_EXPORT_FUNCTION(scsh_unlink);
! S48_EXPORT_FUNCTION(scsh_fsync);
! S48_EXPORT_FUNCTION(scsh_sync);
! S48_EXPORT_FUNCTION(scsh_close);
! S48_EXPORT_FUNCTION(scsh_dup);
! S48_EXPORT_FUNCTION(scsh_dup2);
! S48_EXPORT_FUNCTION(scsh_lseek);
S48_EXPORT_FUNCTION(df_char_ready_fdes);
! S48_EXPORT_FUNCTION(scsh_open);
S48_EXPORT_FUNCTION(scheme_pipe);
S48_EXPORT_FUNCTION(df_read_fdes_char);
***************
*** 744,750 ****
S48_EXPORT_FUNCTION(df_write_fdes_substring);
S48_EXPORT_FUNCTION(scsh_kill);
! S48_EXPORT_FUNCTION(df_pause);
! S48_EXPORT_FUNCTION(df_open_dir);
! S48_EXPORT_FUNCTION(df_scm_sort_filevec);
S48_EXPORT_FUNCTION(scm_envvec);
S48_EXPORT_FUNCTION(create_env);
--- 187,191 ----
S48_EXPORT_FUNCTION(df_write_fdes_substring);
S48_EXPORT_FUNCTION(scsh_kill);
! S48_EXPORT_FUNCTION(open_dir);
S48_EXPORT_FUNCTION(scm_envvec);
S48_EXPORT_FUNCTION(create_env);
***************
*** 756,760 ****
S48_EXPORT_FUNCTION(df_sleep_until);
S48_EXPORT_FUNCTION(scm_gethostname);
! S48_EXPORT_FUNCTION(df_errno_msg);
S48_EXPORT_FUNCTION(scm_crypt);
}
--- 197,201 ----
S48_EXPORT_FUNCTION(df_sleep_until);
S48_EXPORT_FUNCTION(scm_gethostname);
! S48_EXPORT_FUNCTION(errno_msg);
S48_EXPORT_FUNCTION(scm_crypt);
}
Index: syscalls.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls.scm,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -r1.24 -r1.25
*** syscalls.scm 2001/08/06 08:33:24 1.24
--- syscalls.scm 2001/08/08 09:21:20 1.25
***************
*** 80,83 ****
--- 80,93 ----
+ (define-syntax define-retrying-syscall
+ (syntax-rules ()
+ ((define-retrying-syscall syscall syscall/eintr)
+ (define (syscall . args)
+ (let loop ()
+ (with-errno-handler
+ ((errno packet)
+ ((errno/intr) (display "eintr")(loop)))
+ (apply syscall/eintr args)))))))
+
;;; Process
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
***************
*** 162,180 ****
;;; PID
! (define-foreign pid (getpid) pid_t)
! (define-foreign parent-pid (getppid) pid_t)
!
!
;;; Process groups and session ids
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-foreign process-group (getpgrp) pid_t)
! (define-foreign %set-process-group/errno
! (setpgid (pid_t pid) (pid_t groupid))
! (to-scheme fixnum errno_or_false))
! (define-errno-syscall (%set-process-group pid pgrp)
! %set-process-group/errno)
(define (set-process-group arg1 . maybe-arg2)
--- 172,186 ----
;;; PID
! (define-stubless-foreign pid () "scsh_getpid")
! (define-stubless-foreign parent-pid () "scsh_getppid")
;;; Process groups and session ids
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign process-group () "scsh_getpgrp")
! (define-stubless-foreign %set-process-group/eintr
! (pid groupid) "setpgid")
+ (define-retrying-syscall %set-process-group %set-process-group/eintr)
(define (set-process-group arg1 . maybe-arg2)
***************
*** 185,200 ****
! (define-foreign become-session-leader/errno (setsid)
! (multi-rep (to-scheme pid_t errno_or_false)
! pid_t))
- (define-errno-syscall (become-session-leader) become-session-leader/errno
- sid)
-
-
;;; UMASK
! (define-foreign set-process-umask (umask (mode_t mask)) no-declare ; integer
on SunOS
! mode_t)
(define (process-umask)
--- 191,200 ----
! (define-stubless-foreign become-session-leader/eintr () "scsh_setsid")
! (define-retrying-syscall become-session-leader become-session-leader/eintr)
;;; UMASK
! (define-stubless-foreign set-process-umask (mask) "scsh_umask")
(define (process-umask)
***************
*** 209,223 ****
! (define-foreign process-times/errno (process_times)
! (to-scheme integer errno_or_false)
! clock_t ; user cpu time
! clock_t ; system cpu time
! clock_t ; user cpu time for me and all my descendants.
! clock_t) ; system cpu time for me and all my descendants.
! (define-errno-syscall (process-times) process-times/errno
! utime stime cutime cstime)
! (define-foreign cpu-ticks/sec (cpu_clock_ticks_per_sec) integer)
;;; File system
--- 209,219 ----
! (define-stubless-foreign process-times/eintr-list () "process_times")
! (define (process-times)
! (define-retrying-syscall process-times/list process-times/eintr-list)
! (apply values (process-times/list)))
! (define-stubless-foreign cpu-ticks/sec () "cpu_clock_ticks_per_sec")
;;; File system
***************
*** 232,283 ****
! (define-foreign set-file-mode/errno
! (chmod (string path) (mode_t mode)) no-declare ; integer on SunOS
! (to-scheme fixnum errno_or_false))
! ; IBM's AIX include files declare fchmod(char*, mode_t).
! ; Amazing, but true. So we must prevent this def-foreign from issuing
! ; the conflicting, correct declaration. Hence the NO-DECLARE.
!
! (define-foreign set-fdes-mode/errno
! (fchmod (fixnum fd) (mode_t mode)) ; integer on SunOS
! no-declare ; Workaround for AIX bug.
! (to-scheme fixnum errno_or_false))
! (define-errno-syscall (set-file-mode thing mode)
! (lambda (thing mode)
! (generic-file-op thing
! (lambda (fd) (set-fdes-mode/errno fd mode))
! (lambda (fname) (set-file-mode/errno fname mode)))))
! ;;; NO-DECLARE: gcc unistd.h bogusness.
! (define-foreign set-file-uid&gid/errno
! (chown (string path) (uid_t uid) (gid_t gid)) no-declare
! (to-scheme fixnum errno_or_false))
! (define-foreign set-fdes-uid&gid/errno
! (fchown (fixnum fd) (uid_t uid) (gid_t gid))
! (to-scheme fixnum errno_or_false))
! (define-errno-syscall (set-file-owner thing uid)
! (lambda (thing uid)
! (generic-file-op thing
! (lambda (fd) (set-fdes-uid&gid/errno fd uid -1))
! (lambda (fname) (set-file-uid&gid/errno fname uid -1)))))
!
! (define-errno-syscall (set-file-group thing gid)
! (lambda (thing gid)
! (generic-file-op thing
! (lambda (fd) (set-fdes-uid&gid/errno fd -1 gid))
! (lambda (fname) (set-file-uid&gid/errno fname -1 gid)))))
;;; Uses real uid and gid, not effective. I don't use this anywhere.
! (define-foreign %file-ruid-access-not?
! (access (string path)
! (integer perms))
! bool)
;(define (file-access? path perms)
--- 228,263 ----
! (define-stubless-foreign %set-file-mode/eintr (path mode) "scsh_chmod")
! (define-retrying-syscall %set-file-mode %set-file-mode/eintr)
! (define-stubless-foreign %set-fdes-mode/eintr (path mode) "scsh_fchmod")
! (define-retrying-syscall %set-fdes-mode %set-fdes-mode/eintr)
! (define (set-file-mode thing mode)
! (generic-file-op thing
! (lambda (fd) (%set-fdes-mode fd mode))
! (lambda (fname) (%set-file-mode fname mode))))
! (define-stubless-foreign set-file-uid&gid/eintr (path uid gid) "scsh_chown")
! (define-retrying-syscall set-file-uid&gid set-file-uid&gid/eintr)
! (define-stubless-foreign set-fdes-uid&gid/eintr (fd uid gid) "scsh_fchown")
! (define-retrying-syscall set-fdes-uid&gid set-fdes-uid&gid/eintr)
! (define (set-file-owner thing uid)
! (generic-file-op thing
! (lambda (fd) (set-fdes-uid&gid fd uid -1))
! (lambda (fname) (set-file-uid&gid fname uid -1))))
+ (define (set-file-group thing gid)
+ (generic-file-op thing
+ (lambda (fd) (set-fdes-uid&gid fd -1 gid))
+ (lambda (fname) (set-file-uid&gid fname -1 gid))))
+
;;; Uses real uid and gid, not effective. I don't use this anywhere.
! (define-stubless-foreign %file-ruid-access-not? (path perms) "scsh_access")
;(define (file-access? path perms)
***************
*** 293,352 ****
; (file-access? fname 4))
-
- (define-foreign create-hard-link/errno
- (link (string original-name) (string new-name))
- (to-scheme fixnum errno_or_false))
-
- (define-errno-syscall (create-hard-link original-name new-name)
- create-hard-link/errno)
-
! (define-foreign create-fifo/errno (mkfifo (string path) (mode_t mode))
! no-declare ; integer on SunOS
! (to-scheme fixnum errno_or_false))
!
! (define-errno-syscall (create-fifo path mode) create-fifo/errno)
! (define-foreign create-directory/errno
! (mkdir (string path) (mode_t mode)) no-declare ; integer on SunOS.
! (to-scheme fixnum errno_or_false))
! (define (create-directory path . maybe-mode)
(let ((mode (:optional maybe-mode #o777))
(fname (ensure-file-name-is-nondirectory path)))
! (cond ((create-directory/errno fname mode) =>
! (lambda (err)
! (if err (errno-error err create-directory path mode)))))))
! (define-stubless-foreign read-symlink (path) "scm_readlink")
! (define-foreign %rename-file/errno
! (rename (string old-name) (string new-name))
! (to-scheme fixnum errno_or_false))
!
! (define-errno-syscall (%rename-file old-name new-name)
! %rename-file/errno)
! (define-foreign delete-directory/errno
! (rmdir (string path))
! (to-scheme fixnum errno_or_false))
! (define-errno-syscall (delete-directory path) delete-directory/errno)
! (define-foreign %utime/errno (scm_utime (string path)
! (time_t ac)
! (time_t m))
! (to-scheme fixnum errno_or_false))
! (define-foreign %utime-now/errno (scm_utime_now (string path))
! (to-scheme fixnum errno_or_false))
!
!
! ;;; (SET-FILE-TIMES/ERRNO path [access-time mod-time])
!
! (define (set-file-times/errno path . maybe-times)
(if (pair? maybe-times)
(let* ((access-time (real->exact-integer (car maybe-times)))
--- 273,311 ----
; (file-access? fname 4))
! (define-stubless-foreign create-hard-link/eintr (original-name new-name)
! "scsh_link")
! (define-retrying-syscall %create-hard-link create-hard-link/eintr)
+ (define-stubless-foreign create-fifo/eintr (path mode) "scsh_mkfifo")
+ (define-retrying-syscall %create-fifo create-fifo/eintr)
! (define-stubless-foreign create-directory/eintr (path mode) "scsh_mkdir")
! (define-retrying-syscall %%create-directory create-directory/eintr)
! (define (%create-directory path . maybe-mode)
(let ((mode (:optional maybe-mode #o777))
(fname (ensure-file-name-is-nondirectory path)))
! (%%create-directory fname mode)))
! (define-stubless-foreign read-symlink/eintr (path) "scsh_readlink")
! (define-retrying-syscall read-symlink read-symlink/eintr)
! (define-stubless-foreign %rename-file/eintr (old-name new-name) "scsh_rename")
! (define-retrying-syscall %rename-file %rename-file/eintr)
! (define-stubless-foreign delete-directory/eintr (path) "scsh_rmdir")
! (define-retrying-syscall delete-directory delete-directory/eintr)
! (define-stubless-foreign %utime/eintr (path ac m) "scm_utime")
! (define-retrying-syscall %utime %utime/eintr)
+ (define-stubless-foreign %utime-now/eintr (path) "scm_utime_now")
+ (define-retrying-syscall %utime-now %utime-now/eintr)
! ;;; (SET-FILE-TIMES path [access-time mod-time])
! (define (set-file-times path . maybe-times)
(if (pair? maybe-times)
(let* ((access-time (real->exact-integer (car maybe-times)))
***************
*** 355,371 ****
(cons path maybe-times))
(real->exact-integer (cadr maybe-times)))))
! (%utime/errno path access-time
mod-time ))
! (%utime-now/errno path)))
!
! (define-errno-syscall (set-file-times . args) set-file-times/errno)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; STAT
! (define-stubless-foreign stat-file (path data chase?) "scheme_stat")
! (define-stubless-foreign stat-fdes (fd data) "scheme_fstat")
(define-record file-info
--- 314,329 ----
(cons path maybe-times))
(real->exact-integer (cadr maybe-times)))))
! (%utime path access-time
mod-time ))
! (%utime-now path)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; STAT
! (define-stubless-foreign stat-file/eintr (path data chase?) "scheme_stat")
! (define-retrying-syscall stat-file stat-file/eintr)
! (define-stubless-foreign stat-fdes/eintr (fd data) "scheme_fstat")
! (define-retrying-syscall stat-fdes stat-fdes/eintr)
(define-record file-info
***************
*** 422,511 ****
;;; the OLD-NAME arg is "const". It *should* be const.
! (define-foreign create-symlink/errno
! (symlink (string old-name) (string new-name)) no-declare
! (to-scheme fixnum errno_or_false))
- ;(define-errno-syscall (create-symlink old-name new-name)
- ; create-symlink/errno)
-
-
;;; "no-declare" as there is no agreement among the OS's as to whether or not
;;; the PATH arg is "const". It *should* be const.
! (define-foreign truncate-file/errno
! (truncate (string path) (off_t length)) no-declare
! (to-scheme fixnum errno_or_false))
! (define-foreign truncate-fdes/errno
! (ftruncate (fixnum fd) (off_t length)) no-declare ; Indigo bogosity.
! (to-scheme fixnum errno_or_false))
! (define-errno-syscall (truncate-file path length)
! (lambda (thing length)
! (generic-file-op thing
! (lambda (fd) (truncate-fdes/errno fd length))
! (lambda (fname) (truncate-file/errno fname length)))))
- (define-foreign delete-file/errno
- (unlink (string path))
- (to-scheme fixnum errno_or_false))
-
- (define-errno-syscall (delete-file path) delete-file/errno)
-
-
- (define-foreign sync-file/errno (fsync (fixnum fd))
- (to-scheme fixnum errno_or_false))
-
- (define-errno-syscall (sync-file fd/port)
- (lambda (fd/port)
- (if (output-port? fd/port) (force-output fd/port))
- (sleazy-call/fdes fd/port sync-file/errno)))
-
-
;;; Amazingly bogus syscall -- doesn't *actually* sync the filesys.
! (define-foreign sync-file-system (sync) no-declare ; Linux sux - says int
! ignore)
!
;;; I/O
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-foreign %close-fdes/errno (close (fixnum fd))
! (to-scheme fixnum "errno_or_false"))
! (define (%close-fdes fd)
! (let lp ()
! (let ((errno (%close-fdes/errno fd)))
! (cond ((not errno) #t) ; Successful close.
! ((= errno errno/badf) #f) ; File descriptor already closed.
! ((= errno errno/intr) (lp)) ; Retry.
! (else
! (errno-error errno %close-fdes fd)))))) ; You lose.
!
! (define-foreign %dup/errno
! (dup (fixnum fd))
! (multi-rep (to-scheme fixnum errno_or_false)
! fixnum))
!
! (define-errno-syscall (%dup fd) %dup/errno
! new-fd)
!
! (define-foreign %dup2/errno
! (dup2 (fixnum fd-from) (fixnum fd-to))
! (multi-rep (to-scheme fixnum errno_or_false)
! fixnum))
!
! (define-errno-syscall (%dup2 fd-from fd-to) %dup2/errno
! new-fd)
!
!
! (define-foreign %fd-seek/errno
! (lseek (fixnum fd) (off_t offset) (fixnum whence))
! (multi-rep (to-scheme off_t errno_or_false)
! off_t))
(define seek/set 0) ;Unix codes for "whence"
(define seek/delta 1)
--- 380,431 ----
;;; the OLD-NAME arg is "const". It *should* be const.
! (define-stubless-foreign create-symlink/eintr (old-name new-name)
"scsh_symlink")
! (define-retrying-syscall %create-symlink create-symlink/eintr)
;;; "no-declare" as there is no agreement among the OS's as to whether or not
;;; the PATH arg is "const". It *should* be const.
! (define-stubless-foreign %truncate-file/eintr (path length) "scsh_truncate")
! (define-retrying-syscall %truncate-file %truncate-file/eintr)
! (define-stubless-foreign %truncate-fdes/eintr (path length) "scsh_ftruncate")
! (define-retrying-syscall %truncate-fdes %truncate-fdes/eintr)
! (define (truncate-file thing length)
! (generic-file-op thing
! (lambda (fd) (%truncate-fdes fd length))
! (lambda (fname) (%truncate-file fname length))))
!
! (define-stubless-foreign delete-file/eintr (path) "scsh_unlink")
! (define-retrying-syscall delete-file delete-file/eintr)
!
! (define-stubless-foreign %sync-file/eintr (fd) "scsh_fsync")
! (define-retrying-syscall %sync-file %sync-file/eintr)
!
! (define (sync-file fd/port)
! (if (output-port? fd/port) (force-output fd/port))
! (sleazy-call/fdes fd/port %sync-file))
;;; Amazingly bogus syscall -- doesn't *actually* sync the filesys.
! (define-stubless-foreign sync-file-system () "scsh_sync")
;;; I/O
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (define-stubless-foreign %close-fdes/eintr (fd) "scsh_close")
+ (define-retrying-syscall %close-fdes %close-fdes/eintr)
! (define-stubless-foreign %dup/eintr (fd) "scsh_dup")
! (define-retrying-syscall %dup %dup/eintr)
! (define-stubless-foreign %dup2/eintr (fd-from fd-to) "scsh_dup2")
! (define-retrying-syscall %dup2 %dup2/eintr)
+ (define-stubless-foreign %fd-seek/eintr (fd offset whence) "scsh_lseek")
+ (define-retrying-syscall %fd-seek %fd-seek/eintr)
+
(define seek/set 0) ;Unix codes for "whence"
(define seek/delta 1)
***************
*** 515,525 ****
(let ((whence (:optional maybe-whence seek/set))
(fd (if (integer? fd/port) fd/port (port->fdes fd/port))))
! (receive (err cursor) (%fd-seek/errno fd offset whence)
! (if err (errno-error err seek fd offset whence) cursor))))
(define (tell fd/port)
(let ((fd (if (integer? fd/port) fd/port (port->fdes fd/port))))
! (receive (err offset) (%fd-seek/errno fd 0 seek/delta)
! (if err (errno-error err tell fd/port) offset))))
(define-foreign %char-ready-fdes?/errno
--- 435,443 ----
(let ((whence (:optional maybe-whence seek/set))
(fd (if (integer? fd/port) fd/port (port->fdes fd/port))))
! (%fd-seek fd offset whence)))
(define (tell fd/port)
(let ((fd (if (integer? fd/port) fd/port (port->fdes fd/port))))
! (%fd-seek fd 0 seek/delta)))
(define-foreign %char-ready-fdes?/errno
***************
*** 532,546 ****
retval)))
-
- (define-foreign %open/errno
- (open (string path)
- (fixnum flags)
- (mode_t mode)) ; integer on SunOS
- no-declare ; NOTE
- (multi-rep (to-scheme fixnum errno_or_false)
- fixnum))
! (define-errno-syscall (%open path flags mode) %open/errno
! fd)
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
--- 450,456 ----
retval)))
! (define-stubless-foreign %open/eintr (path flags mode) "scsh_open")
! (define-retrying-syscall %open %open/eintr)
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
***************
*** 550,554 ****
! (define-stubless-foreign pipe-fdes () "scheme_pipe")
(define (pipe)
--- 460,465 ----
! (define-stubless-foreign pipe-fdes/eintr () "scheme_pipe")
! (define-retrying-syscall pipe-fdes pipe-fdes/eintr)
(define (pipe)
***************
*** 599,603 ****
;;; ---------------------------
! (define-stubless-foreign signal-pid (pid signal) "scsh_kill")
(define (signal-process proc signal)
--- 510,515 ----
;;; ---------------------------
! (define-stubless-foreign signal-pid/eintr (pid signal) "scsh_kill")
! (define-retrying-syscall signal-pid signal-pid/eintr)
(define (signal-process proc signal)
***************
*** 623,629 ****
;;; signal-process-group/errno)
! (define-foreign pause-until-interrupt (pause) no-declare ignore)
- ;;; now in low-interrupt: (define-foreign itimer (alarm (uint_t secs)) uint_t)
;;; User info
--- 535,541 ----
;;; signal-process-group/errno)
! (define (pause-until-interrupt)
! (next-sigevent (most-recent-sigevent) full-interrupt-set))
;;; User info
***************
*** 727,742 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-foreign %open-dir (open_dir (string dir-name))
! (to-scheme integer "False_on_zero") ; Win: #f, lose: errno
! (C char**) ; Vector of strings
! fixnum) ; Length of strings
!
! ;;; Takes a null-terminated C vector of strings -- filenames.
! ;;; Sorts them in place by the Unix filename order: ., .., dotfiles, others.
!
! (define-foreign %sort-file-vector
! (scm_sort_filevec ((C "const char** ~a") cvec)
! (fixnum veclen))
! ignore)
(define (directory-files . args)
--- 639,644 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign %open-dir/eintr (dir-name) "open_dir")
! (define-retrying-syscall %open-dir %open-dir/eintr)
(define (directory-files . args)
***************
*** 745,756 ****
(dotfiles? #f))
(check-arg string? dir directory-files)
! (receive (err cvec numfiles)
! (%open-dir (ensure-file-name-is-nondirectory dir))
! (if err (errno-error err directory-files dir dotfiles?))
! (%sort-file-vector cvec numfiles)
! (let ((files (vector->list (C-string-vec->Scheme&free cvec numfiles))))
! (if dotfiles? files
! (filter (lambda (f) (not (char=? (string-ref f 0) #\.)))
! files)))))))
;;; I do this one in C, I'm not sure why:
--- 647,667 ----
(dotfiles? #f))
(check-arg string? dir directory-files)
! (let* ((files (%open-dir (ensure-file-name-is-nondirectory dir)))
! (files-sorted ((structure-ref sort sort-list!) files filename<=)))
! (if dotfiles? files-sorted
! (filter (lambda (f) (not (dotfile? f)))
! files-sorted))))))
!
! (define (dotfile? f)
! (char=? (string-ref f 0) #\.))
!
! (define (filename<= f1 f2)
! (if (dotfile? f1)
! (if (dotfile? f2)
! (string<= f1 f2)
! #t)
! (if (dotfile? f2)
! #f
! (string<= f1 f2))))
;;; I do this one in C, I'm not sure why:
***************
*** 834,844 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign %set-cloexec (fd val) "set_cloexec")
;;; Some of fcntl()
;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign %fcntl-read (fd command) "fcntl_read")
! (define-stubless-foreign %fcntl-write (fd command val) "fcntl_write")
;;; fcntl()'s F_GETFD and F_SETFD. Note that the SLEAZY- prefix on the
--- 745,758 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign %set-cloexec/eintr (fd val) "set_cloexec")
! (define-retrying-syscall %set-cloexec %set-cloexec/eintr)
;;; Some of fcntl()
;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign %fcntl-read/eintr (fd command) "fcntl_read")
! (define-retrying-syscall %fcntl-read %fcntl-read/eintr)
! (define-stubless-foreign %fcntl-write/eintr (fd command val) "fcntl_write")
! (define-retrying-syscall %fcntl-write %fcntl-write/eintr)
;;; fcntl()'s F_GETFD and F_SETFD. Note that the SLEAZY- prefix on the
***************
*** 889,898 ****
desc)
! (define-stubless-foreign %gethostname () "scm_gethostname")
(define system-name %gethostname)
! (define-foreign errno-msg (errno_msg (integer i))
! static-string)
(define-stubless-foreign %crypt (key salt) "scm_crypt")
--- 803,812 ----
desc)
! (define-stubless-foreign %gethostname/eintr () "scm_gethostname")
! (define-retrying-syscall %gethostname %gethostname/eintr)
(define system-name %gethostname)
! (define-stubless-foreign errno-msg (i) "errno_msg")
(define-stubless-foreign %crypt (key salt) "scm_crypt")
Index: syscalls1.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls1.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -r1.18 -r1.19
*** syscalls1.c 2001/08/06 08:33:24 1.18
--- syscalls1.c 2001/08/08 09:21:20 1.19
***************
*** 157,167 ****
}
! s48_value scsh_kill (s48_value pid, s48_value signal)
{
! int ret = kill ((pid_t) s48_extract_fixnum (pid),
! s48_extract_fixnum (signal));
! if (ret == -1)
! s48_raise_os_error_2(errno, pid, signal);
! else return s48_enter_fixnum (ret);
}
--- 157,167 ----
}
! s48_value scsh_kill (s48_value sch_pid, s48_value sch_signal)
{
! int retval = kill ((pid_t) s48_extract_fixnum (sch_pid),
! s48_extract_fixnum (sch_signal));
! if (retval == -1)
! s48_raise_os_error_2(errno, sch_pid, sch_signal);
! else return s48_enter_fixnum (retval);
}
***************
*** 169,178 ****
/* Read the symlink. */
! s48_value scm_readlink(s48_value path)
{
char linkpath[MAXPATHLEN+1];
! int retval = readlink(s48_extract_string (path), linkpath, MAXPATHLEN);
if (retval == -1)
! s48_raise_os_error_1(errno, path);
else
{
--- 169,178 ----
/* Read the symlink. */
! s48_value scsh_readlink(s48_value sch_path)
{
char linkpath[MAXPATHLEN+1];
! int retval = readlink(s48_extract_string (sch_path), linkpath, MAXPATHLEN);
if (retval == -1)
! s48_raise_os_error_1(errno, sch_path);
else
{
***************
*** 182,185 ****
--- 182,203 ----
}
+ s48_value scsh_rename(s48_value sch_from, s48_value sch_to)
+ {
+ int retval = rename (s48_extract_string (sch_from),
+ s48_extract_string (sch_to));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_from, sch_to);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_rmdir(s48_value sch_path)
+ {
+ int retval = rmdir (s48_extract_string (sch_path));
+ if (retval == -1)
+ s48_raise_os_error_1(errno, sch_path);
+ return S48_UNSPECIFIC;
+ }
+
+
/* Scheme interfaces to utime().
***************
*** 187,199 ****
*/
! int scm_utime(char const *path, time_t ac, time_t mod)
{
struct utimbuf t;
! t.actime = ac;
! t.modtime = mod;
! return utime(path, &t);
}
! int scm_utime_now(char const *path) {return utime(path, 0);}
--- 205,226 ----
*/
! s48_value scm_utime(s48_value sch_path, s48_value sch_ac, s48_value sch_mod)
{
struct utimbuf t;
! int retval;
! t.actime = s48_extract_integer (sch_ac);
! t.modtime = s48_extract_integer (sch_mod);
! retval = utime(s48_extract_string (sch_path), &t);
! if (retval == -1)
! s48_raise_os_error_3(errno, sch_path, sch_ac, sch_mod);
! return S48_UNSPECIFIC;
}
! s48_value scm_utime_now(s48_value sch_path){
! int retval = utime (s48_extract_string (sch_path), 0);
! if (retval == -1)
! s48_raise_os_error_1(errno, sch_path);
! return S48_UNSPECIFIC;
! }
***************
*** 215,219 ****
}
! s48_value scsh_chdir(s48_value directory){
int retval = chdir (s48_extract_string (directory));
if (retval == -1)
--- 242,247 ----
}
! s48_value scsh_chdir(s48_value directory)
! {
int retval = chdir (s48_extract_string (directory));
if (retval == -1)
***************
*** 271,304 ****
*/
! int process_times(clock_t *utime, clock_t *stime,
! clock_t *cutime, clock_t *cstime)
{
! struct tms tms;
! clock_t t = times(&tms);
! if (t == -1) return -1;
! *utime = tms.tms_utime;
! *stime = tms.tms_stime;
! *cutime = tms.tms_cutime;
! *cstime = tms.tms_cstime;
! return t;
! }
! int cpu_clock_ticks_per_sec()
{
#ifdef _SC_CLK_TCK
static long clock_tick = 0;
! if (clock_tick == 0)
clock_tick = sysconf(_SC_CLK_TCK); /* POSIX.1, POSIX.2 */
! return clock_tick;
#else
#ifdef CLK_TCK
! return CLK_TCK;
#else
! return 60;
#endif
#endif
}
/* Reading and writing
*******************************************************************************
--- 299,413 ----
*/
! s48_value process_times()
{
! struct tms tms;
! clock_t t = times(&tms);
! if (t == -1) s48_raise_os_error(errno);
! return
! s48_cons(s48_enter_integer (tms.tms_utime),
! s48_cons(s48_enter_integer (tms.tms_stime),
! s48_cons(s48_enter_integer (tms.tms_cutime),
! s48_cons(s48_enter_integer (tms.tms_cstime),
! S48_NULL))));
! }
! s48_value cpu_clock_ticks_per_sec()
{
#ifdef _SC_CLK_TCK
static long clock_tick = 0;
! if (clock_tick == 0){
clock_tick = sysconf(_SC_CLK_TCK); /* POSIX.1, POSIX.2 */
! if (clock_tick == -1)
! s48_raise_os_error(errno);
! }
! return s48_enter_integer(clock_tick);
#else
#ifdef CLK_TCK
! return s48_enter_integer(CLK_TCK);
#else
! return s48_enter_fixnum(60);
#endif
#endif
}
+ s48_value scsh_chmod(s48_value sch_path, s48_value sch_mode)
+ {
+ int retval = chmod (s48_extract_string(sch_path),
+ s48_extract_integer(sch_mode));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_path, sch_mode);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_fchmod(s48_value sch_fd, s48_value sch_mode)
+ {
+ int retval = fchmod (s48_extract_fixnum(sch_fd),
+ s48_extract_integer(sch_mode));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_fd, sch_mode);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_chown(s48_value sch_path, s48_value sch_uid, s48_value sch_gid)
+ {
+ int retval = chown(s48_extract_string(sch_path),
+ s48_extract_integer(sch_uid),
+ s48_extract_integer(sch_gid));
+
+ if (retval == -1)
+ s48_raise_os_error_3(errno, sch_path, sch_uid, sch_gid);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_fchown(s48_value sch_fd, s48_value sch_uid, s48_value sch_gid)
+ {
+ int retval = fchown(s48_extract_fixnum(sch_fd),
+ s48_extract_integer(sch_uid),
+ s48_extract_integer(sch_gid));
+
+ if (retval == -1)
+ s48_raise_os_error_3(errno, sch_fd, sch_uid, sch_gid);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_access(s48_value sch_path, s48_value sch_mode)
+ {
+ int retval = access (s48_extract_string(sch_path),
+ s48_extract_integer(sch_mode));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_path, sch_mode);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_link(s48_value sch_name1, s48_value sch_name2)
+ {
+ int retval = link (s48_extract_string (sch_name1),
+ s48_extract_string (sch_name2));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_name1, sch_name2);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_mkfifo(s48_value sch_path, s48_value sch_mode)
+ {
+ int retval = mkfifo (s48_extract_string (sch_path),
+ s48_extract_fixnum (sch_mode));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_path, sch_mode);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_mkdir(s48_value sch_path, s48_value sch_mode)
+ {
+ int retval = mkdir (s48_extract_string (sch_path),
+ s48_extract_fixnum (sch_mode));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_path, sch_mode);
+ return S48_UNSPECIFIC;
+ }
+
+
+
/* Reading and writing
*******************************************************************************
***************
*** 400,404 ****
--- 509,612 ----
}
+ s48_value scsh_symlink(s48_value sch_name1, s48_value sch_name2)
+ {
+ int retval = symlink (s48_extract_string (sch_name1),
+ s48_extract_string (sch_name2));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_name1, sch_name2);
+ return S48_UNSPECIFIC;
+ }
+ s48_value scsh_truncate(s48_value sch_path, s48_value sch_length)
+ {
+ int retval = truncate (s48_extract_string (sch_path),
+ s48_extract_integer (sch_length));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_path, sch_length);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_ftruncate(s48_value sch_fdes, s48_value sch_length)
+ {
+ int retval = ftruncate (s48_extract_fixnum (sch_fdes),
+ s48_extract_integer (sch_length));
+ if (retval == -1)
+ s48_raise_os_error_2(errno, sch_fdes, sch_length);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_unlink(s48_value sch_path)
+ {
+ int retval = unlink (s48_extract_string (sch_path));
+ if (retval == -1)
+ s48_raise_os_error_1(errno, sch_path);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_fsync(s48_value sch_fdes)
+ {
+ int retval = fsync (s48_extract_fixnum (sch_fdes));
+ if (retval == -1)
+ s48_raise_os_error_1(errno, sch_fdes);
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_sync()
+ {
+ sync();
+ return S48_UNSPECIFIC;
+ }
+
+ s48_value scsh_close(s48_value sch_fdes)
+ {
+ int retval = close (s48_extract_fixnum (sch_fdes));
+ if (retval == 0)
+ return S48_TRUE;
+ else if (retval == EBADF)
+ return S48_FALSE;
+ else s48_raise_os_error_1 (errno, sch_fdes);
+ }
+
+ s48_value scsh_dup(s48_value sch_fdes)
+ {
+ int retval = dup (s48_extract_fixnum (sch_fdes));
+ if (retval == -1)
+ s48_raise_os_error_1 (errno, sch_fdes);
+ return s48_enter_fixnum (retval);
+ }
+
+ s48_value scsh_dup2(s48_value sch_oldd, s48_value sch_newd)
+ {
+ int retval = dup2 (s48_extract_fixnum (sch_oldd),
+ s48_extract_fixnum (sch_newd));
+ if (retval == -1)
+ s48_raise_os_error_2 (errno, sch_oldd, sch_newd);
+ return s48_enter_fixnum (retval);
+ }
+
+ s48_value scsh_lseek(s48_value sch_fdes, s48_value sch_offset,
+ s48_value sch_whence)
+ {
+ int retval = lseek (s48_extract_fixnum (sch_fdes),
+ s48_extract_integer (sch_offset),
+ s48_extract_fixnum (sch_whence));
+ if (retval == -1)
+ s48_raise_os_error_3 (errno, sch_fdes, sch_offset, sch_whence);
+ return s48_enter_integer (retval);
+ }
+
+ s48_value scsh_open(s48_value sch_path, s48_value sch_flags, s48_value
sch_mode)
+ {
+ int retval = open (s48_extract_string (sch_path),
+ s48_extract_fixnum (sch_flags),
+ s48_extract_fixnum (sch_mode));
+ if (retval == -1)
+ s48_raise_os_error_3 (errno, sch_path, sch_flags, sch_mode);
+
+ return s48_enter_fixnum (retval);
+ }
+
+
+
/* Supplementary groups access
*******************************************************************************
***************
*** 488,492 ****
return S48_UNSPECIFIC;
}
!
/* Environment hackery
*******************************************************************************
--- 696,737 ----
return S48_UNSPECIFIC;
}
!
! s48_value scsh_getpid()
! {
! return s48_enter_integer(getpid());
! }
!
! s48_value scsh_getppid()
! {
! return s48_enter_integer(getppid());
! }
!
! s48_value scsh_getpgrp()
! {
! return s48_enter_integer(getpgrp());
! }
!
! s48_value scsh_setpgid(s48_value sch_pid, s48_value sch_pgrp)
! {
! int retval = setpgid(s48_extract_integer(sch_pid),
! s48_extract_integer(sch_pgrp));
! if (retval == -1)
! s48_raise_os_error_2(errno, sch_pid, sch_pgrp);
! return S48_UNSPECIFIC;
! }
!
! s48_value scsh_setsid()
! {
! pid_t retval = setsid();
! if (retval == -1)
! s48_raise_os_error(errno);
! return s48_enter_integer(retval);
! }
!
! s48_value scsh_umask(s48_value sch_mask)
! {
! return s48_enter_integer(umask(s48_extract_integer(sch_mask)));
! }
!
/* Environment hackery
*******************************************************************************
***************
*** 615,632 ****
#include <errno.h>
! char *errno_msg(int i)
{
#ifdef HAVE_STRERROR
! return(strerror(i));
#else
/* temp hack until we figure out what to do about losing sys_errlist's */
! extern
#ifdef HAVE_CONST_SYS_ERRLIST
! const
#endif
! char *sys_errlist[];
! extern int sys_nerr;
! return ( i < 0 || i > sys_nerr ) ? NULL /* i.e., #f */
! : (char*) sys_errlist[i];
#endif /* !HAVE_STRERROR */
}
--- 860,878 ----
#include <errno.h>
! s48_value errno_msg(s48_value sch_i)
{
+ int i = s48_extract_fixnum (sch_i);
#ifdef HAVE_STRERROR
! return(s48_enter_string (strerror(i)));
#else
/* temp hack until we figure out what to do about losing sys_errlist's */
! extern
#ifdef HAVE_CONST_SYS_ERRLIST
! const
#endif
! char *sys_errlist[];
! extern int sys_nerr;
! return ( i < 0 || i > sys_nerr ) ? s48_raise_argtype_error(sch_i)
! : s48_enter_string (sys_errlist[i]);
#endif /* !HAVE_STRERROR */
}
Index: syscalls1.h
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls1.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -r1.14 -r1.15
*** syscalls1.h 2001/08/06 08:33:24 1.14
--- syscalls1.h 2001/08/08 09:21:20 1.15
***************
*** 15,24 ****
s48_value scsh_kill (s48_value pid, s48_value signal);
! s48_value scm_readlink(s48_value path);
! int scm_utime(char const *path, time_t ac, time_t mod);
! int scm_utime_now(char const *path);
s48_value set_cloexec(s48_value _fd, s48_value _val);
--- 15,51 ----
s48_value scsh_kill (s48_value pid, s48_value signal);
! s48_value scsh_readlink(s48_value path);
! s48_value scsh_rename(s48_value sch_from, s48_value sch_to);
! s48_value scsh_rmdir(s48_value sch_path);
+ s48_value scsh_symlink(s48_value sch_name1, s48_value name2);
+
+ s48_value scsh_truncate(s48_value sch_path, s48_value sch_length);
+
+ s48_value scsh_ftruncate(s48_value sch_fdes, s48_value sch_length);
+
+ s48_value scsh_unlink(s48_value sch_path);
+
+ s48_value scsh_fsync(s48_value sch_fdes);
+
+ s48_value scsh_sync();
+
+ s48_value scsh_close(s48_value sch_fdes);
+
+ s48_value scsh_dup(s48_value sch_fdes);
+
+ s48_value scsh_dup2(s48_value sch_oldd, s48_value sch_newd);
+
+ s48_value scsh_lseek(s48_value sch_fdes, s48_value sch_offset,
+ s48_value sch_whence);
+
+ s48_value scsh_open(s48_value sch_path, s48_value sch_flags, s48_value
sch_mode);
+
+ s48_value scm_utime(s48_value path, s48_value ac, s48_value mod);
+
+ s48_value scm_utime_now(s48_value path);
+
s48_value set_cloexec(s48_value _fd, s48_value _val);
***************
*** 26,35 ****
s48_value scheme_cwd();
! int process_times(clock_t *utime, clock_t *stime,
! clock_t *cutime, clock_t *cstime);
! int cpu_clock_ticks_per_sec();
s48_value read_fdes_char(int fd);
--- 53,77 ----
s48_value scheme_cwd();
+
+ s48_value process_times();
! s48_value cpu_clock_ticks_per_sec();
! s48_value scsh_chmod(s48_value sch_path, s48_value sch_mode);
+ s48_value scsh_fchmod(s48_value sch_fd, s48_value sch_mode);
+
+ s48_value scsh_chown(s48_value sch_path, s48_value sch_uid, s48_value
sch_gid);
+
+ s48_value scsh_fchown(s48_value sch_fd, s48_value sch_uid, s48_value sch_gid);
+
+ s48_value scsh_access(s48_value sch_path, s48_value sch_mode);
+
+ s48_value scsh_link(s48_value sch_name1, s48_value name2);
+
+ s48_value scsh_mkfifo(s48_value sch_path, s48_value sch_mode);
+
+ s48_value scsh_mkdir(s48_value sch_path, s48_value sch_mode);
+
s48_value read_fdes_char(int fd);
***************
*** 66,69 ****
--- 108,123 ----
s48_value scsh_seteuid(s48_value uid);
+ s48_value scsh_getpid();
+
+ s48_value scsh_getppid();
+
+ s48_value scsh_getpgrp();
+
+ s48_value scsh_setpgid(s48_value sch_pid, s48_value sch_pgrp);
+
+ s48_value scsh_setsid();
+
+ s48_value scsh_umask(s48_value sch_mask);
+
s48_value align_env(s48_value pointer_to_struct);
***************
*** 76,80 ****
s48_value scm_gethostname(void);
! char *errno_msg(int i);
s48_value fcntl_read(s48_value fd, s48_value command);
--- 130,134 ----
s48_value scm_gethostname(void);
! s48_value errno_msg(s48_value sch_i);
s48_value fcntl_read(s48_value fd, s48_value command);
|