conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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.
This commit is contained in:
Abdulaziz Ghuloum 2007-12-19 22:46:07 -05:00
parent 10077a6468
commit 6eb6bf750d
12 changed files with 141 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
benchmarks/Makefile.in
View File

@ -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 \

4
doc/Makefile.in
View File

@ -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 \

16
lab/process-example.ss Executable file
View File

@ -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)))

4
lib/Makefile.in
View File

@ -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 \

4
scheme/Makefile.in
View File

@ -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 \

27
scheme/ikarus.io.ss
View File

@ -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)))))
)

2
scheme/last-revision
View File

@ -1 +1 @@
1270
1271

2
scheme/makefile.ss
View File

@ -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]

3
src/Makefile.am
View File

@ -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

11
src/Makefile.in
View File

@ -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@

79
src/ikarus-process.c Normal file
View File

@ -0,0 +1,79 @@
#include <unistd.h>
#include <sys/types.h>
#include <stdlib.h>
#include <stdio.h>
#include "ikarus-data.h"
#include <errno.h>
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<n; i++){
vec[i] = (char*)ref(x, off_car) + off_bytevector_data;
x = ref(x, off_cdr);
}
vec[n] = 0;
return vec;
}
ikp
ikrt_process(ikp rvec, ikp cmd, ikp argv, ikpcb* pcb){
int infds[2];
int outfds[2];
int errfds[2];
if(pipe(infds)) return ikrt_io_error();
if(pipe(outfds)) return ikrt_io_error();
if(pipe(errfds)) return ikrt_io_error();
pid_t pid = fork();
if(pid == 0){
/* child */
if(close(infds[1])) exit(1);
if(close(outfds[0])) exit(1);
if(close(errfds[0])) exit(1);
if(close(0)) exit(1);
if(dup(infds[0]) == -1) exit(1);
if(close(1)) exit(1);
if(dup(outfds[1]) == -1) exit(1);
if(close(2)) exit(2);
if(dup(errfds[1]) == -1) exit(1);
execvp((char*)cmd+off_bytevector_data, list_to_vec(argv));
fprintf(stderr, "failed to exec %s: %s\n",
(char*)cmd+off_bytevector_data,
strerror(errno));
exit(-1);
} else if(pid > 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);
}

7
src/ikarus-runtime.c
View File

@ -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){