diff --git a/Makefile.in b/Makefile.in index 3dc8d8a..e18c53e 100644 --- a/Makefile.in +++ b/Makefile.in @@ -118,7 +118,6 @@ SCSHOBJS = \ scsh/dirstuff1.o \ scsh/fdports1.o \ scsh/flock1.o \ - scsh/machine/stdio_dep.o \ scsh/machine/time_dep1.o \ scsh/signals1.o \ scsh/machine/libansi.o \ @@ -127,16 +126,17 @@ SCSHOBJS = \ scsh/rx/regexp1.o \ scsh/select.o scsh/select1.o \ scsh/sleep1.o \ - scsh/syscalls.o scsh/syscalls1.o \ + scsh/syscalls1.o \ scsh/syslog1.o \ - scsh/time.o scsh/time1.o \ - scsh/tty.o scsh/tty1.o \ + scsh/time1.o \ + scsh/tty1.o \ scsh/userinfo1.o \ scsh/sighandlers1.o SCSH_INITIALIZERS = s48_init_syslog s48_init_posix_regexp \ s48_init_userinfo s48_init_sighandlers \ - s48_init_syscalls2 s48_init_network s48_init_flock + s48_init_syscalls s48_init_network s48_init_flock \ + s48_init_dirstuff s48_init_time s48_init_tty UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.o @@ -161,8 +161,7 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH) $(LIBSCSHVM) # Files generated by cig need their init functions called. -CIGGEDINIT = s48_init_select \ - s48_init_syscalls s48_init_tty s48_init_time +CIGGEDINIT = s48_init_select # -------------------- # External code to include in the VM @@ -229,15 +228,9 @@ scsh/flock1.o: scsh/flock1.h scsh/fdports1.o scsh/fdports.o: scsh/fdports1.h scsh/select1.o scsh/select.o: scsh/select1.h -scsh/syscalls1.o scsh/syscalls.o: scsh/syscalls1.h -scsh/time1.o scsh/time.o: scsh/time1.h -scsh/tty1.o scsh/tty.o: scsh/tty1.h scsh/rx/regexp1.o: c/scheme48.h -scsh/syscalls.o: scsh/syscalls1.h scsh/dirstuff1.h scsh/fdports1.h \ - scsh/select1.h scsh/userinfo1.h - scsh/sighandlers1.o: scsh/sighandlers1.h scsh/syslog1.o: c/scheme48.h @@ -417,7 +410,7 @@ clean-cig: -rm -f cig/*.o $(CIG) $(CIG).image $(LIBCIG) clean-scm2c: - rm -f scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c + rm -f scsh/select.c distclean: clean rm -f Makefile config.log config.status c/sysdep.h config.cache \ @@ -786,9 +779,6 @@ SCHEME =scsh/awk.scm \ cig/libcig.c: cig/libcig.scm scsh/jcontrol2.c: scsh/jcontrol2.scm scsh/select.c: scsh/select.scm -scsh/syscalls.c: scsh/syscalls.scm -scsh/tty.c: scsh/tty.scm -scsh/time.c: scsh/time.scm scsh/scsh: scsh/scsh-tramp.c $(CC) -o $@ $(CPPFLAGS) $(CFLAGS) \ diff --git a/scsh/newports.scm b/scsh/newports.scm index 2b8957b..1fedca6 100644 --- a/scsh/newports.scm +++ b/scsh/newports.scm @@ -395,9 +395,17 @@ p)) (else (port-maker fd 1)))) -(define (fdes->inport fd) (fdes->port fd make-input-fdport)) +(define (fdes->inport fd) + (let ((port (fdes->port fd make-input-fdport))) + (if (not (input-port? port)) + (error "fdes was already assigned to an outport" fd) + port))) -(define (fdes->outport fd) (fdes->port fd make-output-fdport)) +(define (fdes->outport fd) + (let ((port (fdes->port fd make-output-fdport))) + (if (not (output-port? port)) + (error "fdes was already assigned to an inport" fd) + port))) (define (port->fdes port) (check-arg open-fdport? port port->fdes) @@ -551,7 +559,9 @@ (%char-ready-fdes? input)) (define-r4rs-input (read-char) input s48-read-char - (read-fdes-char input)) + (let ((port (fdes->inport input))) + (set-port-buffering port bufpol/none) + (s48-read-char port))) ;structure refs changed to get reference from scheme -dalbertz (define s48-display (structure-ref scheme display)) @@ -567,7 +577,7 @@ (let ((stream (:optional maybe-i/o (current-output-port)))) (cond ((output-port? stream) (s48name arg ... stream)) ((integer? stream) body ...) - (else (error "Not a port or file descriptor" stream)))))) + (else (error "Not a outport or file descriptor" stream)))))) ;;; This one depends upon S48's string ports. (define-r4rs-output (display object) output s48-display @@ -576,7 +586,9 @@ (write-string (string-output-port-output sp) output))) (define-r4rs-output (newline) output s48-newline - (write-fdes-char #\newline output)) + (let ((port (fdes->outport output))) + (set-port-buffering port bufpol/none) + (s48-newline port))) (define-r4rs-output (write object) output s48-write (let ((sp (make-string-output-port))) @@ -584,7 +596,9 @@ (write-string (string-output-port-output sp) output))) (define-r4rs-output (write-char char) output s48-write-char - (write-fdes-char char output)) + (let ((port (fdes->outport output))) + (set-port-buffering port bufpol/none) + (s48-write-char char port))) ;;; S48's force-output doesn't default to forcing (current-output-port). (define-r4rs-output (force-output) output s48-force-output diff --git a/scsh/rw.scm b/scsh/rw.scm index 667622e..317e449 100644 --- a/scsh/rw.scm +++ b/scsh/rw.scm @@ -12,27 +12,15 @@ ;;; Best-effort/forward-progress reading ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (generic-read-string!/partial s start end reader source) - (if (bogus-substring-spec? s start end) - (error "Bad substring indices" reader source s start end)) - - (if (= start end) 0 ; Vacuous request. - (let loop () - (receive (err nread) (reader s start end source) - (cond ((not err) (and (not (zero? nread)) nread)) - ((= err errno/intr) (loop)) - ((or (= err errno/wouldblock) ; No forward-progess here. - (= err errno/again)) - 0) - (else (errno-error err reader s start start end source))))))) - (define (read-string!/partial s . args) (let-optionals args ((fd/port (current-input-port)) (start 0) (end (string-length s))) (cond ((integer? fd/port) - (generic-read-string!/partial s start end - read-fdes-substring!/errno fd/port)) + (let ((port (fdes->inport fd/port))) + (set-port-buffering port bufpol/block (max (- end start) 0)) + (read-string!/partial port start end))) + (else ; no differnce between fd/ports and s48 ports (let* ((buffer (make-string (- end start))) (needed (if (> (byte-vector-length (port-buffer fd/port)) 1) @@ -59,31 +47,14 @@ ;;; ;;; Operation on ports is easy, since we can use read-block -(define (generic-read-string! s start end reader source) - (if (bogus-substring-spec? s start end) - (error "Bad substring indices" reader source s start end)) - - (let loop ((i start)) - (if (>= i end) (- i start) - (receive (err nread) (reader s i end source) - (cond (err (if (= err errno/intr) (loop i) - ;; Give info on partially-read data in error packet. - (errno-error err reader - s start i end source))) - - ((zero? nread) ; EOF - (let ((result (- i start))) - (and (not (zero? result)) result))) - - (else (loop (+ i nread)))))))) - (define (read-string! s . args) (let-optionals args ((fd/port (current-input-port)) (start 0) (end (string-length s))) (cond ((integer? fd/port) - (generic-read-string! s start end - read-fdes-substring!/errno fd/port)) + (let ((port (fdes->inport fd/port))) + (set-port-buffering port bufpol/block (max (- end start) 0)) + (read-string! port start end))) (else ; no differnce between fd/port and s48 ports (let ((nbytes/eof (read-block s start (- end start) fd/port))) @@ -104,53 +75,31 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Non-blocking output to a buffered port is not defined. -(define (generic-write-string/partial s start end writer target) - (if (bogus-substring-spec? s start end) - (error "Bad substring indices" writer s start end target)) - - (if (= start end) 0 ; Vacuous request. - (let loop () - (receive (err nwritten) (writer s start end target) - (cond ((not err) nwritten) - ((= err errno/intr) (loop)) - ((or (= err errno/again) (= err errno/wouldblock)) 0) - (else (errno-error err writer - s start start end target))))))) - (define (write-string/partial s . args) (let-optionals args ((fd/port (current-output-port)) (start 0) (end (string-length s))) (cond ((integer? fd/port) - (generic-write-string/partial s start end - write-fdes-substring/errno fd/port)) + (let ((port (fdes->outport fd/port))) + (set-port-buffering port bufpol/block (max (- end start) 0)) + (write-string/partial s port start end))) (else ;; the only way to implement this, would be to use ;; channel-maybe-write. But this is an VM-instruction which is not ;; exported. Since we now have threads this shouldn;t matter. - (error "write-string/parital is no longer supported on ports"))))) + (error "write-string/parital is currently dereleased. +See the RELEASE file for details"))))) ;;; Persistent writing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (generic-write-string s start end writer target) - (if (bogus-substring-spec? s start end) - (error "Bad substring indices" writer s start end target)) - - (let loop ((i start)) - (if (< i end) - (receive (err nwritten) (writer s i end target) - (cond ((not err) (loop (+ i nwritten))) - ((= err errno/intr) (loop i)) - (else (errno-error err writer - s start i end target))))))) - (define (write-string s . args) (let-optionals args ((fd/port (current-output-port)) (start 0) (end (string-length s))) (cond ((integer? fd/port) - (generic-write-string s start end - write-fdes-substring/errno fd/port)) + (let ((port (fdes->outport fd/port))) + (set-port-buffering port bufpol/block (max (- end start) 0)) + (write-string s port start end))) (else (write-block s start (- end start) fd/port))))) diff --git a/scsh/sleep1.c b/scsh/sleep1.c index 2e21bf3..3c82732 100644 --- a/scsh/sleep1.c +++ b/scsh/sleep1.c @@ -24,10 +24,10 @@ ** and is pretty straightforward. */ -s48_value sleep_until(time_t when) +s48_value sleep_until(s48_value scm_when) { time_t now = time(0); - int delta = when - now; + int delta = s48_extract_integer(scm_when) - now; if( delta > 0 ) { fd_set r, w, e; struct timeval tv; diff --git a/scsh/syscalls.c b/scsh/syscalls.c deleted file mode 100644 index 90a1b7f..0000000 --- a/scsh/syscalls.c +++ /dev/null @@ -1,201 +0,0 @@ -/* This is an Scheme48/C interface file, -** automatically generated by a hacked version of cig 3.0. -step 4 -*/ - -#include -#include /* For malloc. */ -#include "libcig.h" - -#include -#include -#include -#include -#include /* for O_RDWR */ -#include -#include -#include -#include - -/* Make sure foreign-function stubs interface to the C funs correctly: */ -#include "dirstuff1.h" -#include "select1.h" -#include "syscalls1.h" -#include "userinfo1.h" - -extern int errno; - -#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno)) -#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) -#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE) - -s48_value df_char_ready_fdes(s48_value g1) -{ - extern s48_value char_ready_fdes(int ); - s48_value ret1 = S48_FALSE; - S48_DECLARE_GC_PROTECT(1); - s48_value r1; - - - - S48_GC_PROTECT_1(ret1); - r1 = char_ready_fdes(s48_extract_fixnum(g1)); - ret1 = r1; - S48_GC_UNPROTECT(); - return ret1; -} - -s48_value df_read_fdes_char(s48_value g1) -{ - extern s48_value read_fdes_char(int ); - s48_value ret1 = S48_FALSE; - S48_DECLARE_GC_PROTECT(1); - s48_value r1; - - - - S48_GC_PROTECT_1(ret1); - r1 = read_fdes_char(s48_extract_fixnum(g1)); - ret1 = r1; - S48_GC_UNPROTECT(); - return ret1; -} - -s48_value df_write_fdes_char(s48_value g1, s48_value g2) -{ - extern int write_fdes_char(char , int ); - s48_value ret1 = S48_FALSE; - S48_DECLARE_GC_PROTECT(1); - int r1; - - - - S48_GC_PROTECT_1(ret1); - r1 = write_fdes_char(s48_extract_char(g1), s48_extract_fixnum(g2)); - ret1 = errno_or_false(r1); - S48_GC_UNPROTECT(); - return ret1; -} - -s48_value df_read_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) -{ - extern ssize_t read_fdes_substring(s48_value , size_t , size_t , int ); - s48_value ret1 = S48_FALSE; - S48_DECLARE_GC_PROTECT(2); - ssize_t r1; - - - - S48_GC_PROTECT_2(mv_vec,ret1); - r1 = read_fdes_substring(g1, s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4)); - ret1 = errno_or_false(r1); - S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); - S48_GC_UNPROTECT(); - return ret1; -} - -s48_value df_write_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) -{ - extern ssize_t write_fdes_substring(s48_value , size_t , size_t , int ); - s48_value ret1 = S48_FALSE; - S48_DECLARE_GC_PROTECT(2); - ssize_t r1; - - - - S48_GC_PROTECT_2(mv_vec,ret1); - r1 = write_fdes_substring(g1, s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4)); - ret1 = errno_or_false(r1); - S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); - S48_GC_UNPROTECT(); - return ret1; -} - -s48_value df_sleep_until(s48_value g1) -{ - extern s48_value sleep_until(time_t ); - s48_value ret1 = S48_FALSE; - S48_DECLARE_GC_PROTECT(1); - s48_value r1; - - - - S48_GC_PROTECT_1(ret1); - r1 = sleep_until(s48_extract_integer(g1)); - ret1 = r1; - S48_GC_UNPROTECT(); - return ret1; -} - -void s48_init_syscalls(void) -{ - S48_EXPORT_FUNCTION(scheme_exec); - S48_EXPORT_FUNCTION(scsh_exit); - S48_EXPORT_FUNCTION(scsh__exit); - S48_EXPORT_FUNCTION(scsh_fork); - S48_EXPORT_FUNCTION(wait_pid); - S48_EXPORT_FUNCTION(scsh_chdir); - S48_EXPORT_FUNCTION(scheme_cwd); - S48_EXPORT_FUNCTION(scsh_getgid); - S48_EXPORT_FUNCTION(scsh_getegid); - S48_EXPORT_FUNCTION(scsh_setgid); - S48_EXPORT_FUNCTION(scsh_setegid); - S48_EXPORT_FUNCTION(get_groups); - S48_EXPORT_FUNCTION(scsh_getuid); - S48_EXPORT_FUNCTION(scsh_geteuid); - 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); - S48_EXPORT_FUNCTION(df_write_fdes_char); - S48_EXPORT_FUNCTION(df_read_fdes_substring); - 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); - S48_EXPORT_FUNCTION(align_env); - S48_EXPORT_FUNCTION(free_envvec); - S48_EXPORT_FUNCTION(set_cloexec); - S48_EXPORT_FUNCTION(fcntl_read); - S48_EXPORT_FUNCTION(fcntl_write); - S48_EXPORT_FUNCTION(df_sleep_until); - S48_EXPORT_FUNCTION(scm_gethostname); - S48_EXPORT_FUNCTION(errno_msg); - S48_EXPORT_FUNCTION(scm_crypt); -} diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index 6c9de8f..3968ae1 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -5,33 +5,6 @@ ;;; Need to rationalise names here. getgid. get-gid. "effective" as morpheme? -(foreign-init-name "syscalls") - -(foreign-source - "#include " - "#include " - "#include " - "#include " - "#include /* for O_RDWR */" ; ??? - "#include " - "#include " - "#include " - "#include " - "" - "/* Make sure foreign-function stubs interface to the C funs correctly: */" - "#include \"dirstuff1.h\"" -; "#include \"fdports1.h\"" JMG - "#include \"select1.h\"" - "#include \"syscalls1.h\"" - "#include \"userinfo1.h\"" - "" - "extern int errno;" - "" - "#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno))" - "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" - "#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)" ; Not a function. - "" "") - ;;; Macro for converting syscalls that return error codes to ones that ;;; raise exceptions on errors. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -88,7 +61,7 @@ ((errno packet) ((errno/intr) (display "eintr")(loop))) (apply syscall/eintr args))))))) - + ;;; Process ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; we can't algin env here, because exec-path/env calls @@ -294,7 +267,6 @@ (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) @@ -464,41 +436,6 @@ (values r w))) (pipe-fdes))) -(define-foreign %read-fdes-char - (read_fdes_char (fixnum fd)) - desc) ; Char or errno or #f (eof). - -(define (read-fdes-char fd) - (let ((c (%read-fdes-char fd))) - (if (integer? c) (errno-error c read-fdes-char fd) c))) - - -(define-foreign write-fdes-char/errno (write_fdes_char (char char) (fixnum fd)) - (to-scheme fixnum errno_or_false)) - -(define-errno-syscall (write-fdes-char char fd) write-fdes-char/errno) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Read and write - -(define-foreign read-fdes-substring!/errno - (read_fdes_substring (string-desc buf) - (size_t start) - (size_t end) - (fixnum fd)) - (multi-rep (to-scheme ssize_t errno_or_false) - ssize_t)) - -(define-foreign write-fdes-substring/errno - (write_fdes_substring (string-desc buf) - (size_t start) - (size_t end) - (fixnum fd)) - (multi-rep (to-scheme ssize_t errno_or_false) - ssize_t)) - - ;;; Signals (rather incomplete) ;;; --------------------------- @@ -791,9 +728,7 @@ (let lp () (or (%sleep-until when) (lp))))) -;;; JMG: I don't know whether time_t or long is correct... -(define-foreign %sleep-until (sleep_until (time_t secs)) - desc) +(define-stubless-foreign %sleep-until (secs) "sleep_until") (define-stubless-foreign %gethostname/eintr () "scm_gethostname") (define-retrying-syscall %gethostname %gethostname/eintr) diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index f2f7bf4..2f5f0b5 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -35,7 +35,6 @@ #include #endif #include "cstuff.h" -#include "machine/stdio_dep.h" /* Make sure our exports match up w/the implementation: */ #include "syscalls1.h" @@ -407,36 +406,6 @@ s48_value scsh_mkdir(s48_value sch_path, s48_value sch_mode) return S48_UNSPECIFIC; } - - -/* Reading and writing -******************************************************************************* -*/ - -/* Return a char, #f (EOF), or errno. */ -s48_value read_fdes_char(int fd) -{ - int i; char c; - if( (i=read(fd, &c, 1)) < 0 ) return s48_enter_fixnum(errno); - if(i==0) return S48_FALSE; - return s48_enter_char(c); -} - -int write_fdes_char(char c, int fd) {return write(fd, &c, 1);} - - -ssize_t read_fdes_substring(s48_value buf, size_t start, size_t end, int fd) -{ - return read(fd, StrByte(buf,start), end-start); -} - -ssize_t write_fdes_substring(s48_value buf, size_t start, size_t end, int fd) -{ - return write(fd, StrByte(buf,start), end-start); -} - - - /* S_ISSOCK(mode) and S_ISLNK(mode) are not POSIX. You lose on a NeXT. Ugh. */ #ifndef S_ISSOCK #define S_ISSOCK(mode) (((mode) & S_IFMT) == S_IFSOCK) @@ -611,7 +580,7 @@ s48_value char_ready_fdes(s48_value sch_fd) fd_set readfds; struct timeval timeout; int result; - int fd = s48_extract_fixnum sch_fd; + int fd = s48_extract_fixnum (sch_fd); FD_ZERO(&readfds); FD_SET(fd, &readfds); @@ -935,7 +904,71 @@ s48_value scm_crypt(s48_value key, s48_value salt) return s48_enter_string (ret); } -void s48_init_syscalls2(){ +void s48_init_syscalls (){ + S48_EXPORT_FUNCTION(scheme_exec); + S48_EXPORT_FUNCTION(scsh_exit); + S48_EXPORT_FUNCTION(scsh__exit); + S48_EXPORT_FUNCTION(scsh_fork); + S48_EXPORT_FUNCTION(wait_pid); + S48_EXPORT_FUNCTION(scsh_chdir); + S48_EXPORT_FUNCTION(scheme_cwd); + S48_EXPORT_FUNCTION(scsh_getgid); + S48_EXPORT_FUNCTION(scsh_getegid); + S48_EXPORT_FUNCTION(scsh_setgid); + S48_EXPORT_FUNCTION(scsh_setegid); + S48_EXPORT_FUNCTION(get_groups); + S48_EXPORT_FUNCTION(scsh_getuid); + S48_EXPORT_FUNCTION(scsh_geteuid); + 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(char_ready_fdes); + S48_EXPORT_FUNCTION(scsh_open); + S48_EXPORT_FUNCTION(scheme_pipe); + S48_EXPORT_FUNCTION(scsh_kill); + S48_EXPORT_FUNCTION(scm_envvec); + S48_EXPORT_FUNCTION(create_env); + S48_EXPORT_FUNCTION(align_env); + S48_EXPORT_FUNCTION(free_envvec); + S48_EXPORT_FUNCTION(set_cloexec); + S48_EXPORT_FUNCTION(fcntl_read); + S48_EXPORT_FUNCTION(fcntl_write); + S48_EXPORT_FUNCTION(sleep_until); + S48_EXPORT_FUNCTION(scm_gethostname); + S48_EXPORT_FUNCTION(errno_msg); + S48_EXPORT_FUNCTION(scm_crypt); S48_GC_PROTECT_GLOBAL(envvec_record_type_binding); S48_GC_PROTECT_GLOBAL(add_envvec_finalizerB_binding); S48_GC_PROTECT_GLOBAL(current_env); diff --git a/scsh/syscalls1.h b/scsh/syscalls1.h index aec4b08..9f5661c 100644 --- a/scsh/syscalls1.h +++ b/scsh/syscalls1.h @@ -73,6 +73,8 @@ 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 char_ready_fdes(s48_value sch_fd); + s48_value read_fdes_char(int fd); int write_fdes_char(char c, int fd); @@ -143,3 +145,4 @@ s48_value scm_syslog (s48_value _facility, s48_value _level, s48_value _message) s48_value scm_closelog(); +s48_value sleep_until();