Changeset 11997


Ignore:
Timestamp:
May 4, 2009, 11:57:55 PM (10 years ago)
Author:
gb
Message:

DESCRIBE-EXTERNAL-PROCESS-FAILURE: if an external process exits with
an error or (on Unix) exits with #$EX_OSERR, return a string which describes
the failure, embedded in some contextual description.

In REBUILD-CCL, use DESCRIBE-EXTERNAL-PROCESS-FAILURE to detect exec failure
and note that this may be because developer tools aren't installed.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/compile-ccl.lisp

    r11637 r11997  
    490490    ((:solarisx8664 :solarisx8632) "gmake")
    491491    (t "make")))
     492
     493
     494(defun describe-external-process-failure (proc reminder)
     495  "If it appears that the external-process PROC failed in some way,
     496try to return a string that describes that failure.  If it seems
     497to have succeeded or if we can't tell why it failed, return NIL.
     498This is mostly intended to describe process-creation/fork/exec failures,
     499not runtime errors reported by a successfully created process."
     500  (multiple-value-bind (status exit-code)
     501      (external-process-status proc)
     502    (let* ((procname (car (external-process-args proc)))
     503           (string
     504            (case status
     505              (:error
     506               (%strerror exit-code))
     507              #-windows-target
     508              (:exited
     509               (when(= exit-code #$EX_OSERR)
     510                 "generic OS error in fork/exec")))))
     511      (when string
     512        (format nil "Error executing ~a: ~a~&~a" procname string reminder)))))
    492513
    493514(defparameter *known-optional-features* '(:count-gf-calls :monitor-futex-wait :unique-dcode))
     
    530551               (format t "~&;Building lisp-kernel ...")
    531552               (with-output-to-string (s)
    532                                       (multiple-value-bind
    533                                           (status exit-code)
    534                                           (external-process-status
    535                                            (run-program (make-program)
    536                                                         (list "-k" "-C"
    537                                                               (format nil "lisp-kernel/~a"
    538                                                                       (kernel-build-directory))
    539                                                               "-j"
     553                 (let* ((proc (run-program (make-program)
     554                                           (list "-k" "-C"
     555                                                 (format nil "lisp-kernel/~a"
     556                                                         (kernel-build-directory))
     557                                                 "-j"
    540558                                                           
    541                                                               (format nil "~d" (1+ (cpu-count))))
    542                                                         :output s
    543                                                         :error :output))
    544                                         (if (and (eq :exited status) (zerop exit-code))
    545                                           (progn
    546                                             (format t "~&;Kernel built successfully.")
    547                                             (when verbose
    548                                               (format t "~&;kernel build output:~%~a"
    549                                                       (get-output-stream-string s)))
    550                                             (sleep 1))
    551                                           (error "Error(s) during kernel compilation.~%~a"
    552                                                  (get-output-stream-string s))))))
     559                                                 (format nil "~d" (1+ (cpu-count))))
     560                                           :output s
     561                                           :error :output)))
     562                   (multiple-value-bind (status exit-code)
     563                       (external-process-status proc)
     564                     (if (and (eq :exited status) (zerop exit-code))
     565                       (progn
     566                         (format t "~&;Kernel built successfully.")
     567                         (when verbose
     568                           (format t "~&;kernel build output:~%~a"
     569                                   (get-output-stream-string s)))
     570                         (sleep 1))
     571                       (error "Error(s) during kernel compilation.~%~a"
     572                              (or
     573                               (describe-external-process-failure
     574                                proc
     575                                "Developer tools may not be installed correctly.")
     576                               (get-output-stream-string s))))))))
    553577             (compile-ccl (not (null force)))
    554578             (if force (xload-level-0 :force) (xload-level-0))
    555579             (when reload
    556580               (with-input-from-string (cmd (format nil
    557                                                     "(save-application ~s)"
    558                                                     (standard-image-name)))
     581                                              "(save-application ~s)"
     582                                              (standard-image-name)))
    559583                 (with-output-to-string (output)
    560                                         (multiple-value-bind (status exit-code)
    561                                             (external-process-status
    562                                              (run-program
    563                                               (format nil "./~a" (standard-kernel-name))
    564                                               (list* "--image-name" (standard-boot-image-name)
    565                                                      reload-arguments)
    566                                               :input cmd
    567                                               :output output
    568                                               :error output))
    569                                           (if (and (eq status :exited)
    570                                                    (eql exit-code 0))
    571                                             (progn
    572                                               (format t "~&;Wrote heap image: ~s"
    573                                                       (truename (format nil "ccl:~a"
    574                                                                         (standard-image-name))))
    575                                               (when verbose
    576                                                 (format t "~&;Reload heap image output:~%~a"
    577                                                         (get-output-stream-string output))))
    578                                             (error "Errors (~s ~s) reloading boot image:~&~a"
    579                                                    status exit-code
    580                                                    (get-output-stream-string output)))))))
     584                   (multiple-value-bind (status exit-code)
     585                       (external-process-status
     586                        (run-program
     587                         (format nil "./~a" (standard-kernel-name))
     588                         (list* "--image-name" (standard-boot-image-name)
     589                                reload-arguments)
     590                         :input cmd
     591                         :output output
     592                         :error output))
     593                     (if (and (eq status :exited)
     594                              (eql exit-code 0))
     595                       (progn
     596                         (format t "~&;Wrote heap image: ~s"
     597                                 (truename (format nil "ccl:~a"
     598                                                   (standard-image-name))))
     599                         (when verbose
     600                           (format t "~&;Reload heap image output:~%~a"
     601                                   (get-output-stream-string output))))
     602                       (error "Errors (~s ~s) reloading boot image:~&~a"
     603                              status exit-code
     604                              (get-output-stream-string output)))))))
    581605             (when exit
    582606               (quit)))
Note: See TracChangeset for help on using the changeset viewer.