Ignore:
Timestamp:
04/18/11 20:33:58 (11 years ago)
Author:
astalla
Message:

Included changes to compile-system.lisp missing from previous commit.
Refactored run-program to abstract jnew and jcall to low-level functions
(to be replaced by primitives).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/run-program.lisp

    r13270 r13271  
    3737(defun run-program (program args &key environment (wait t))
    3838  ;;For documentation, see below.
    39   (let ((pb (java:jnew "java.lang.ProcessBuilder"
    40                        (java:jnew-array-from-list "java.lang.String" (cons program args)))))
     39  (let ((pb (%make-process-builder program args)))
    4140    (when environment
    42       (let ((env-map (java:jcall "environment" pb)))
     41      (let ((env-map (%process-builder-environment pb)))
    4342        (dolist (entry environment)
    44           (java:jcall "put" env-map
    45                  (princ-to-string (car entry))
    46                  (princ-to-string (cdr entry))))))
    47     (let ((process (make-process (java:jcall "start" pb))))
     43          (%process-builder-env-put env-map
     44                                    (princ-to-string (car entry))
     45                                    (princ-to-string (cdr entry))))))
     46    (let ((process (make-process (%process-builder-start pb))))
    4847      (when wait (process-wait process))
    4948      process)))
    50 
    51 ;;The process structure.
    52 
    53 (defstruct (process (:constructor %make-process (jprocess)))
    54   jprocess input output error)
    55 
    56 (defun make-process (proc)
    57   (let ((process (%make-process proc)))
    58     (setf (process-input process)
    59           (java:jnew "org.armedbear.lisp.Stream" 'system-stream
    60                      (java:jcall "getOutputStream" proc)
    61                      'character)) ;;not a typo!
    62     (setf (process-output process)
    63           (java:jnew "org.armedbear.lisp.Stream" 'system-stream
    64                 (java:jcall "getInputStream" proc) ;;not a typo|
    65                 'character))
    66     (setf (process-error process)
    67           (java:jnew "org.armedbear.lisp.Stream" 'system-stream
    68                 (java:jcall "getErrorStream" proc)
    69                 'character))
    70     process))
    71 
    72 (defun process-alive-p (process)
    73   "Return t if process is still alive, nil otherwise."
    74   (not (ignore-errors (java:jcall "exitValue" (process-jprocess process)))))
    75 
    76 (defun process-wait (process)
    77   "Wait for process to quit running for some reason."
    78   (java:jcall "waitFor" (process-jprocess process)))
    79 
    80 (defun process-exit-code (instance)
    81   "The exit code of a process."
    82   (ignore-errors (java:jcall "exitValue" (process-jprocess instance))))
    83 
    84 (defun process-kill (process)
    85   "Kills the process."
    86   (java:jcall "destroy" (process-jprocess process)))
    8749
    8850(setf (documentation 'run-program 'function)
     
    10264:wait
    10365    If non-NIL (default), wait until the created process finishes. If nil, continue running Lisp until the program finishes.")
     66
     67;;The process structure.
     68
     69(defstruct (process (:constructor %make-process (jprocess)))
     70  jprocess input output error)
     71
     72(defun make-process (proc)
     73  (let ((process (%make-process proc)))
     74    (setf (process-input process) (%make-process-input-stream proc))
     75    (setf (process-output process) (%make-process-output-stream proc))
     76    (setf (process-error process) (%make-process-error-stream proc))
     77    process))
     78
     79(defun process-alive-p (process)
     80  "Return t if process is still alive, nil otherwise."
     81  (%process-alive-p (process-jprocess process)))
     82
     83(defun process-wait (process)
     84  "Wait for process to quit running for some reason."
     85  (%process-wait (process-jprocess process)))
     86
     87(defun process-exit-code (instance)
     88  "The exit code of a process."
     89  (%process-exit-code (process-jprocess instance)))
     90
     91(defun process-kill (process)
     92  "Kills the process."
     93  (%process-kill (process-jprocess process)))
     94
     95;;Low-level functions. For now they're just a refactoring of the initial implementation with direct
     96;;jnew & jcall forms in the code. As per Ville's suggestion, these should really be implemented as
     97;;primitives.
     98
     99(defun %make-process-builder (program args)
     100  (java:jnew "java.lang.ProcessBuilder"
     101             (java:jnew-array-from-list "java.lang.String" (cons program args))))
     102
     103(defun %process-builder-environment (pb)
     104  (java:jcall "environment" pb))
     105
     106(defun %process-builder-env-put (env-map key value)
     107  (java:jcall "put" env-map key value))
     108
     109(defun %process-builder-start (pb)
     110  (java:jcall "start" pb))
     111
     112(defun %make-process-input-stream (proc)
     113  (java:jnew "org.armedbear.lisp.Stream" 'system-stream
     114             (java:jcall "getOutputStream" proc) ;;not a typo!
     115             'character))
     116
     117(defun %make-process-output-stream (proc)
     118  (java:jnew "org.armedbear.lisp.Stream" 'system-stream
     119             (java:jcall "getInputStream" proc) ;;not a typo|
     120             'character))
     121
     122(defun %make-process-error-stream (proc)
     123  (java:jnew "org.armedbear.lisp.Stream" 'system-stream
     124             (java:jcall "getErrorStream" proc)
     125             'character))
     126
     127(defun %process-alive-p (jprocess)
     128  (not (ignore-errors (java:jcall "exitValue" jprocess))))
     129
     130(defun %process-wait (jprocess)
     131  (java:jcall "waitFor" jprocess))
     132
     133(defun %process-exit-code (jprocess)
     134  (ignore-errors (java:jcall "exitValue" jprocess)))
     135
     136(defun %process-kill (jprocess)
     137  (java:jcall "destroy" jprocess))
Note: See TracChangeset for help on using the changeset viewer.