Changeset 12252


Ignore:
Timestamp:
Jun 11, 2009, 12:11:08 AM (10 years ago)
Author:
gz
Message:

Merge r11997 r12139 from trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/compile-ccl.lisp

    r11638 r12252  
    502502    ((:solarisx8664 :solarisx8632) "gmake")
    503503    (t "make")))
     504
     505
     506(defun describe-external-process-failure (proc reminder)
     507  "If it appears that the external-process PROC failed in some way,
     508try to return a string that describes that failure.  If it seems
     509to have succeeded or if we can't tell why it failed, return NIL.
     510This is mostly intended to describe process-creation/fork/exec failures,
     511not runtime errors reported by a successfully created process."
     512  (multiple-value-bind (status exit-code)
     513      (external-process-status proc)
     514    (let* ((procname (car (external-process-args proc)))
     515           (string
     516            (case status
     517              (:error
     518               (%strerror exit-code))
     519              #-windows-target
     520              (:exited
     521               (when(= exit-code #$EX_OSERR)
     522                 "generic OS error in fork/exec")))))
     523      (when string
     524        (format nil "Error executing ~a: ~a~&~a" procname string reminder)))))
    504525
    505526(defparameter *known-optional-features* '(:count-gf-calls :monitor-futex-wait :unique-dcode))
     
    542563               (format t "~&;Building lisp-kernel ...")
    543564               (with-output-to-string (s)
    544                                       (multiple-value-bind
    545                                           (status exit-code)
    546                                           (external-process-status
    547                                            (run-program (make-program)
    548                                                         (list "-k" "-C"
    549                                                               (format nil "lisp-kernel/~a"
    550                                                                       (kernel-build-directory))
    551                                                               "-j"
     565                 (let* ((proc (run-program (make-program)
     566                                           (list "-k" "-C"
     567                                                 (format nil "lisp-kernel/~a"
     568                                                         (kernel-build-directory))
     569                                                 "-j"
    552570                                                           
    553                                                               (format nil "~d" (1+ (cpu-count))))
    554                                                         :output s
    555                                                         :error :output))
    556                                         (if (and (eq :exited status) (zerop exit-code))
    557                                           (progn
    558                                             (format t "~&;Kernel built successfully.")
    559                                             (when verbose
    560                                               (format t "~&;kernel build output:~%~a"
    561                                                       (get-output-stream-string s)))
    562                                             (sleep 1))
    563                                           (error "Error(s) during kernel compilation.~%~a"
    564                                                  (get-output-stream-string s))))))
     571                                                 (format nil "~d" (1+ (cpu-count))))
     572                                           :output s
     573                                           :error :output)))
     574                   (multiple-value-bind (status exit-code)
     575                       (external-process-status proc)
     576                     (if (and (eq :exited status) (zerop exit-code))
     577                       (progn
     578                         (format t "~&;Kernel built successfully.")
     579                         (when verbose
     580                           (format t "~&;kernel build output:~%~a"
     581                                   (get-output-stream-string s)))
     582                         (sleep 1))
     583                       (error "Error(s) during kernel compilation.~%~a"
     584                              (or
     585                               (describe-external-process-failure
     586                                proc
     587                                "Developer tools may not be installed correctly.")
     588                               (get-output-stream-string s))))))))
    565589             (compile-ccl (not (null force)))
    566590             (if force (xload-level-0 :force) (xload-level-0))
    567591             (when reload
    568592               (with-input-from-string (cmd (format nil
    569                                                     "(save-application ~s)"
    570                                                     (standard-image-name)))
     593                                              "(save-application ~s)"
     594                                              (standard-image-name)))
    571595                 (with-output-to-string (output)
    572                                         (multiple-value-bind (status exit-code)
    573                                             (external-process-status
    574                                              (run-program
    575                                               (format nil "./~a" (standard-kernel-name))
    576                                               (list* "--image-name" (standard-boot-image-name)
    577                                                      reload-arguments)
    578                                               :input cmd
    579                                               :output output
    580                                               :error output))
    581                                           (if (and (eq status :exited)
    582                                                    (eql exit-code 0))
    583                                             (progn
    584                                               (format t "~&;Wrote heap image: ~s"
    585                                                       (truename (format nil "ccl:~a"
    586                                                                         (standard-image-name))))
    587                                               (when verbose
    588                                                 (format t "~&;Reload heap image output:~%~a"
    589                                                         (get-output-stream-string output))))
    590                                             (error "Errors (~s ~s) reloading boot image:~&~a"
    591                                                    status exit-code
    592                                                    (get-output-stream-string output)))))))
     596                   (multiple-value-bind (status exit-code)
     597                       (external-process-status
     598                        (run-program
     599                         (format nil "./~a" (standard-kernel-name))
     600                         (list* "--image-name" (standard-boot-image-name)
     601                                "--batch"
     602                                reload-arguments)
     603                         :input cmd
     604                         :output output
     605                         :error output))
     606                     (if (and (eq status :exited)
     607                              (eql exit-code 0))
     608                       (progn
     609                         (format t "~&;Wrote heap image: ~s"
     610                                 (truename (format nil "ccl:~a"
     611                                                   (standard-image-name))))
     612                         (when verbose
     613                           (format t "~&;Reload heap image output:~%~a"
     614                                   (get-output-stream-string output))))
     615                       (error "Errors (~s ~s) reloading boot image:~&~a"
     616                              status exit-code
     617                              (get-output-stream-string output)))))))
    593618             (when exit
    594619               (quit)))
Note: See TracChangeset for help on using the changeset viewer.