gcl.git - GNU Common Lisp

diff --git a/gcl/h/notcomp.h b/gcl/h/notcomp.h
index 9730d85d9..d3b6d1667 100755
--- a/gcl/h/notcomp.h
+++ b/gcl/h/notcomp.h

@@ -347,3 +347,21 @@ extern bool writable_malloc;

({object _b=(b_);while (type_of(_b)!=t_hashtable) _b=wrong_type_argument(sLhash_table,_b);sethash(a_,_b,c_);})

#include "prelink.h"

+

+#ifdef GCL_PROF

+#define prof_block(x) ({\

+ sigset_t prof,old; \

+ int r; \

+ sigemptyset(&prof); \

+ sigaddset(&prof,SIGPROF); \

+ sigprocmask(SIG_BLOCK,&prof,&old); \

+ r=x; \

+ sigprocmask(SIG_SETMASK,&old); \

+ r;})

+#else

+#define prof_block(x) x

+#endif

+

+#define psystem(x) prof_block(system(x))

+#define pfork() prof_block(fork())

+

diff --git a/gcl/o/fasldlsym.c b/gcl/o/fasldlsym.c
index b5aeb1db3..a4a345489 100755
--- a/gcl/o/fasldlsym.c
+++ b/gcl/o/fasldlsym.c

@@ -81,7 +81,7 @@ fasload(object faslfile) {

faslstream = open_stream(faslfile, smm_input, Cnil, sKerror);

massert(snprintf(b,sizeof(b),"cc -shared %s -o %s",filename,buf)>0);

- massert(!system(b));

+ massert(!psystem(b));

if (!(dlp = dlopen(buf,RTLD_NOW))) {

fputs(dlerror(),stderr);

diff --git a/gcl/o/file.d b/gcl/o/file.d
index 4e8510a23..7defde504 100755
--- a/gcl/o/file.d
+++ b/gcl/o/file.d

@@ -2390,7 +2390,7 @@ object x=Cnil;

sigaction(SIGCHLD,&sa,NULL);

- switch((pid=fork())) {

+ switch((pid=pfork())) {

case -1:

FEerror("Cannot fork", 0);

break;

@@ -2400,7 +2400,7 @@ object x=Cnil;

FEerror("setsid error", 0);

if (daemon == sKpersistent)

- switch(fork()) {

+ switch(pfork()) {

case -1:

FEerror("daemon fork error", 0);

break;

@@ -2452,7 +2452,7 @@ object x=Cnil;

sigaction(SIGCHLD,&sa,NULL);

- switch((pid=fork())) {

+ switch((pid=pfork())) {

case 0:

ifuncall1(server,y);

exit(0);

diff --git a/gcl/o/run_process.c b/gcl/o/run_process.c
index 63206b025..f6c39c327 100755
--- a/gcl/o/run_process.c
+++ b/gcl/o/run_process.c

@@ -535,7 +535,7 @@ char **argv;

FEerror("Cannot spawn process with given stream", 0);

fdin = istream->sm.sm_int0;

fdout = ostream->sm.sm_int0;

- if (fork() == 0)

+ if (pfork() == 0)

{ /* the child --- replace standard in and out with descriptors given */

close(0);

massert(dup(fdin)>=0);

diff --git a/gcl/o/unixsys.c b/gcl/o/unixsys.c
index 03a95063a..af50c7f44 100755
--- a/gcl/o/unixsys.c
+++ b/gcl/o/unixsys.c

@@ -110,7 +110,7 @@ detect_wine() {

massert(snprintf(b,sizeof(b),"%-.*smsys /tmp/ out%0d tmp%0d log%0d",

o->st.st_fillp,o->st.st_self,mpid,mpid,mpid)>0);

- massert(!system(b));

+ massert(!psystem(b));

sSAwine_detectedA->s.s_dbind=Ct;

@@ -122,8 +122,6 @@ detect_wine() {

int

msystem(const char *s) {

- int r;

-

#ifdef _WIN32

if (sSAwine_detectedA->s.s_dbind==Ct) {

@@ -161,9 +159,8 @@ msystem(const char *s) {

} else

#endif

- r=system(s);

-

- return r;

+

+ return psystem(s);

}