used EXEC-EPF instead of RUN in the RUN/* forms.

scheme/job.scm

@@ -27,15 +27,13 @@
     (add-job! job)
     job))
 
-(define (make-job-sans-console name proc . args)
+(define (make-job-sans-console name proc)
-  (let-optionals args
+  (let ((job (really-make-job 
-      ((fetch-status (lambda (x) x)))
+	      name #f proc (make-placeholder)
-    (let ((job (really-make-job 
-		name #f proc (make-placeholder)
 	      (date) #f 'running)))
-      (spawn-job-status-surveillant job fetch-status)
+    (spawn-job-status-surveillant job)
-      (add-job! job)
+    (add-job! job)
-      job)))
+    job))
 
 (define (job-with-console? v)
   (and (job? v) (job-console v)))
@@ -49,11 +47,10 @@
 (define (job-status job)
   (sync (job-status-rv job)))
 
-(define (spawn-job-status-surveillant job fetch-status)
+(define (spawn-job-status-surveillant job)
   (spawn
    (lambda ()
-     (let ((status (fetch-status (wait (job-proc job) wait/stopped-children))))
+     (let ((status (wait (job-proc job) wait/stopped-children)))
-       (debug-message "job-status-surveillant, wait returned with " status)
        (cond 
 	((status:exit-val status) 
 	 => (lambda (i)
@@ -308,8 +305,8 @@
 ;; for use in Scheme mode
 (define-syntax run/console
   (syntax-rules ()
-    ((_ pf)
+    ((_ epf)
-     (run/console* `(run (quote pf))))))
+     (run/console* '(exec-epf epf)))))
 
 ;; for use in command mode (used by command-line-compiler)
 (define (run/fg* s-expr)
@@ -317,50 +314,32 @@
   (save-tty-excursion
    (current-input-port)
    (lambda ()
-     (call-with-values
+     (def-prog-mode)
-	 pipe
+     (clear)
-       (lambda (rport wport)
+     (endwin)
-	 (def-prog-mode)
+     (restore-initial-tty-info! (current-input-port))
-	 (clear)
+     (drain-tty (current-output-port))
-	 (endwin)
+     (obtain-lock paint-lock)
-	 (restore-initial-tty-info! (current-input-port))
+     (let ((foreground-pgrp (tty-process-group (current-output-port)))
-	 (drain-tty (current-output-port))
+	   (proc
-	 (obtain-lock paint-lock)
+	    (fork
-	 (let ((foreground-pgrp (tty-process-group (current-output-port)))
+	     (lambda ()
-	       (proc 
+	       (set-process-group (pid) (pid))
-		(fork 
+	       (set-tty-process-group (current-output-port) (pid))
-		 (lambda ()
+	       (eval-s-expr s-expr)))))
-		   ;; this a forked child
+       (let* ((job (make-job-sans-console s-expr proc))
-		   (close-input-port rport)
+	      (status (job-status job)))
-		   (set-process-group (pid) (pid))
+	 (set-tty-process-group (current-output-port) foreground-pgrp)
-		   (set-tty-process-group (current-output-port) (pid))
+	 (newline)
-		   (let ((status (eval-s-expr s-expr)))
+	 (display "Press any key to return to Commander S...")
-		     (write status wport)
+	 (wait-for-key)
-		     (close-output-port wport)
+	 (release-lock paint-lock)
-		     ;; We can't call EXIT with a scsh encoded status code,
+	 job)))))
-		     ;; because the value does not fit into a byte. Sigh.
-		     ;; Send value over pipe instead.
-		     (exit 0))))))
-	   (close-output-port wport)
-	   (let* ((job (make-job-sans-console 
-			s-expr proc
-			;; truely evil, I think.
-			(lambda (ignore)
-			  (let ((v (read rport)))
-			    (close-input-port rport)
-			    v))))
-		  (status (job-status job)))
-	     (set-tty-process-group (current-output-port) foreground-pgrp)
-	     (newline)
-	     (display "Press any key to return to Commander S...")
-	     (wait-for-key)
-	     (release-lock paint-lock)
-	     job)))))))
 
 (define-syntax run/fg
   (syntax-rules ()
     ((_ epf)
-     (run/fg* `(run ,(quote epf))))))
+     (run/fg* '(exec-epf epf)))))
 
 ;; for use in command mode (used by command-line-compiler)
 (define (run/bg* s-expr)
@@ -372,15 +351,15 @@
 	  (lambda ()
 	    (set-process-group (pid) (pid))
 	    (eval-s-expr s-expr)))))
-    (let ((job (make-job-sans-console (quote epf) proc)))
+    (let ((job (make-job-sans-console s-expr proc)))
       (release-lock paint-lock)
       job)))
 
 ;; for use in Scheme mode
 (define-syntax run/bg
   (syntax-rules ()
-    ((_ pf)
+    ((_ epf)
-     (run/bg* `(run ,(quote pf))))))
+     (run/bg* '(exec-epf epf)))))
 
 (define (init-evaluation-environment package)
   (let ((structure (reify-structure package)))
@@ -406,7 +385,7 @@
 ; 	 (eval (read-sexp-from-string exp) env))))))
 
 (define (eval-s-expr s-expr)
-  (debug-message "eval-s-expr " s-expr)
+  (debug-message "eval-s-expr " s-expr " " (pid))
   (eval s-expr (evaluation-environment)))
 
 ;;; EOF