From 6eb6bf750d2c327aaee78f6f5adfcf4f62137ea7 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Wed, 19 Dec 2007 22:46:07 -0500 Subject: [PATCH] Added a (process "cmd" "args" ...) procedure that execs cmd, passing args to it, and returns 4 values: * the process's pid * the process's standard-input-port (for writing) * the process's standard-output-port (for reading) * the process's standard-error-port (for reading) See lab/process-example.ss for a sample usage. --- benchmarks/Makefile.in | 4 +-- doc/Makefile.in | 4 +-- lab/process-example.ss | 16 +++++++++ lib/Makefile.in | 4 +-- scheme/Makefile.in | 4 +-- scheme/ikarus.io.ss | 27 +++++++++++++-- scheme/last-revision | 2 +- scheme/makefile.ss | 2 ++ src/Makefile.am | 3 +- src/Makefile.in | 11 +++--- src/ikarus-process.c | 79 ++++++++++++++++++++++++++++++++++++++++++ src/ikarus-runtime.c | 7 +--- 12 files changed, 141 insertions(+), 22 deletions(-) create mode 100755 lab/process-example.ss create mode 100644 src/ikarus-process.c diff --git a/benchmarks/Makefile.in b/benchmarks/Makefile.in index d24ea03..22a379b 100644 --- a/benchmarks/Makefile.in +++ b/benchmarks/Makefile.in @@ -223,9 +223,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) exit 1;; \ esac; \ done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign benchmarks/Makefile'; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu benchmarks/Makefile'; \ cd $(top_srcdir) && \ - $(AUTOMAKE) --foreign benchmarks/Makefile + $(AUTOMAKE) --gnu benchmarks/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ diff --git a/doc/Makefile.in b/doc/Makefile.in index b43b5f4..30c9268 100644 --- a/doc/Makefile.in +++ b/doc/Makefile.in @@ -170,9 +170,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) exit 1;; \ esac; \ done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign doc/Makefile'; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/Makefile'; \ cd $(top_srcdir) && \ - $(AUTOMAKE) --foreign doc/Makefile + $(AUTOMAKE) --gnu doc/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ diff --git a/lab/process-example.ss b/lab/process-example.ss new file mode 100755 index 0000000..a9f3270 --- /dev/null +++ b/lab/process-example.ss @@ -0,0 +1,16 @@ +#!/usr/bin/env scheme-script + +(import (ikarus)) + +(let-values ([(pid in out err) (process "date")]) + (printf "pid=~s\n" pid) + (let f () + (let ([x (get-u8 out)]) + (unless (eof-object? x) + (write-char (integer->char x)) + (f)))) + (flush-output-port) + (close-output-port in) + (close-input-port out) + (close-input-port err) + (printf "exit status = ~s\n" (waitpid pid))) diff --git a/lib/Makefile.in b/lib/Makefile.in index 4798dc0..484f03e 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -172,9 +172,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) exit 1;; \ esac; \ done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign lib/Makefile'; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu lib/Makefile'; \ cd $(top_srcdir) && \ - $(AUTOMAKE) --foreign lib/Makefile + $(AUTOMAKE) --gnu lib/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ diff --git a/scheme/Makefile.in b/scheme/Makefile.in index 869f1ef..6285adf 100644 --- a/scheme/Makefile.in +++ b/scheme/Makefile.in @@ -194,9 +194,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) exit 1;; \ esac; \ done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign scheme/Makefile'; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu scheme/Makefile'; \ cd $(top_srcdir) && \ - $(AUTOMAKE) --foreign scheme/Makefile + $(AUTOMAKE) --gnu scheme/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss index 31b8332..ac05ed5 100644 --- a/scheme/ikarus.io.ss +++ b/scheme/ikarus.io.ss @@ -59,7 +59,7 @@ reset-input-port! port-id input-port-byte-position - ) + process ) (import @@ -107,7 +107,7 @@ reset-input-port! port-id input-port-byte-position - )) + process)) (module UNSAFE (fx< fx<= fx> fx>= fx= fx+ fx- @@ -1794,5 +1794,28 @@ (die who "not an output port" p))])))) + + (define (process cmd . args) + (define who 'process) + (unless (string? cmd) + (die who "command is not a string" cmd)) + (unless (andmap string? args) + (die who "all arguments must be strings")) + (let ([r (foreign-call "ikrt_process" + (make-vector 4) + (string->utf8 cmd) + (map string->utf8 (cons cmd args)))]) + (if (fixnum? r) + (io-error who cmd r) + (values + (vector-ref r 0) ; pid + (fh->output-port (vector-ref r 1) + cmd output-file-buffer-size #f #t) + (fh->input-port (vector-ref r 2) + cmd input-file-buffer-size #f #t) + (fh->input-port (vector-ref r 3) + cmd input-file-buffer-size #f #t))))) + + ) diff --git a/scheme/last-revision b/scheme/last-revision index e4a7c99..75d94d2 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1270 +1271 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 29391ea..48eca4b 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -393,6 +393,8 @@ [immediate? i] [pointer-value i] [system i] + [process i] + [waitpid i] [installed-libraries i] [library-path i] [current-primitive-locations $boot] diff --git a/src/Makefile.am b/src/Makefile.am index 6a22301..7469df9 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -5,7 +5,8 @@ ikarus_SOURCES = ikarus-collect.c ikarus-exec.c ikarus-fasl.c \ ikarus-flonums.c ikarus-main.c ikarus-numerics.c ikarus-print.c \ ikarus-runtime.c ikarus-symbol-table.c ikarus-verify-integrity.c \ ikarus-weak-pairs.c ikarus-winmmap.c ikarus-data.h \ - ikarus-winmmap.h ikarus-enter.s cpu_has_sse2.s ikarus-io.c + ikarus-winmmap.h ikarus-enter.s cpu_has_sse2.s ikarus-io.c \ + ikarus-process.c scheme_script_SOURCES = scheme-script.c diff --git a/src/Makefile.in b/src/Makefile.in index e40332c..a387420 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -53,7 +53,8 @@ am_ikarus_OBJECTS = ikarus-collect.$(OBJEXT) ikarus-exec.$(OBJEXT) \ ikarus-symbol-table.$(OBJEXT) \ ikarus-verify-integrity.$(OBJEXT) ikarus-weak-pairs.$(OBJEXT) \ ikarus-winmmap.$(OBJEXT) ikarus-enter.$(OBJEXT) \ - cpu_has_sse2.$(OBJEXT) ikarus-io.$(OBJEXT) + cpu_has_sse2.$(OBJEXT) ikarus-io.$(OBJEXT) \ + ikarus-process.$(OBJEXT) nodist_ikarus_OBJECTS = ikarus_OBJECTS = $(am_ikarus_OBJECTS) $(nodist_ikarus_OBJECTS) ikarus_LDADD = $(LDADD) @@ -178,7 +179,8 @@ ikarus_SOURCES = ikarus-collect.c ikarus-exec.c ikarus-fasl.c \ ikarus-flonums.c ikarus-main.c ikarus-numerics.c ikarus-print.c \ ikarus-runtime.c ikarus-symbol-table.c ikarus-verify-integrity.c \ ikarus-weak-pairs.c ikarus-winmmap.c ikarus-data.h \ - ikarus-winmmap.h ikarus-enter.s cpu_has_sse2.s ikarus-io.c + ikarus-winmmap.h ikarus-enter.s cpu_has_sse2.s ikarus-io.c \ + ikarus-process.c scheme_script_SOURCES = scheme-script.c nodist_ikarus_SOURCES = bootfileloc.h @@ -198,9 +200,9 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) exit 1;; \ esac; \ done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign src/Makefile'; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/Makefile'; \ cd $(top_srcdir) && \ - $(AUTOMAKE) --foreign src/Makefile + $(AUTOMAKE) --gnu src/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ @@ -262,6 +264,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-main.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-numerics.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-print.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-process.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-runtime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-symbol-table.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-verify-integrity.Po@am__quote@ diff --git a/src/ikarus-process.c b/src/ikarus-process.c new file mode 100644 index 0000000..b53356a --- /dev/null +++ b/src/ikarus-process.c @@ -0,0 +1,79 @@ +#include +#include +#include +#include +#include "ikarus-data.h" +#include + +extern ikp ikrt_io_error(); + +static int +list_length(ikp x){ + int n = 0; + while(tagof(x) == pair_tag){ + n++; + x = ref(x, off_cdr); + } + return n; +} + +static char** +list_to_vec(ikp x){ + int n = list_length(x); + char** vec = malloc((n+1) * sizeof(char*)); + if (vec == NULL) exit(-1); + int i; + for(i=0; i 0){ + /* parent */ + close(infds[0]); /* ignore errors */ + close(outfds[1]); + close(errfds[1]); + ref(rvec,off_vector_data+0*wordsize) = fix(pid); + ref(rvec,off_vector_data+1*wordsize) = fix(infds[1]); + ref(rvec,off_vector_data+2*wordsize) = fix(outfds[0]); + ref(rvec,off_vector_data+3*wordsize) = fix(errfds[0]); + return rvec; + } else { + return ikrt_io_error(); + } +} + +ikp +ikrt_waitpid(ikp pid, ikpcb* pcb){ + int status; + waitpid(unfix(pid), &status, 0); + return fix(status); +} diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c index b6b9456..52c37c2 100644 --- a/src/ikarus-runtime.c +++ b/src/ikarus-runtime.c @@ -883,12 +883,7 @@ ikrt_fork(){ return fix(pid); } -ikp -ikrt_waitpid(ikp pid){ - int status; - /*pid_t t = */ waitpid(unfix(pid), &status, 0); - return fix(status); -} + ikp ikrt_getenv(ikp bv, ikpcb* pcb){