Changeset 7857


Ignore:
Timestamp:
Dec 9, 2007, 1:49:44 PM (13 years ago)
Author:
gb
Message:

Start support for building with optional features (GF call counting,
lock accounting) enabled.

File:
1 edited

Legend:

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

    r7842 r7857  
    456456    (:darwinx8664 "darwinx8664")))
    457457
    458 (defun rebuild-ccl (&key update full clean kernel force (reload t) exit reload-arguments verbose)
    459   (when full
    460     (setq clean t kernel t reload t))
    461   (when update (update-ccl))
    462   (let* ((cd (current-directory)))
    463     (unwind-protect
    464          (progn
    465            (setf (current-directory) "ccl:")
    466            (when clean
    467              (dolist (f (directory
    468                          (merge-pathnames
    469                           (make-pathname :name :wild
    470                                          :type (pathname-type *.fasl-pathname*))
    471                           "ccl:**;")))
    472                (delete-file f)))
    473            (when kernel
    474              (when (or clean force)
    475                ;; Do a "make -k clean".
    476                (run-program "make"
    477                             (list "-k"
    478                                   "-C"
    479                                   (format nil "lisp-kernel/~a"
    480                                           (kernel-build-directory))
    481                                   "clean")))
    482              (format t "~&;Building lisp-kernel ...")
    483              (with-output-to-string (s)
    484                                     (multiple-value-bind
    485                                         (status exit-code)
    486                                         (external-process-status
    487                                          (run-program "make"
    488                                                       (list "-k" "-C"
    489                                                             (format nil "lisp-kernel/~a"
    490                                                                     (kernel-build-directory))
    491                                                             "-j"
     458(defparameter *known-optional-features* '(:lock-accouting :count-gf-calls))
     459(defvar *build-time-optional-features* nil)
     460
     461
     462(defun rebuild-ccl (&key update full clean kernel force (reload t) exit reload-arguments verbose optional-features)
     463  (let* ((*build-time-optional-features* (intersection *known-optional-features* optional-features))
     464         (*features* (append *build-time-optional-features* *features*)))
     465    (when *build-time-optional-features*
     466      (setq full t))
     467    (when full
     468      (setq clean t kernel t reload t))
     469    (when update (update-ccl))
     470    (let* ((cd (current-directory)))
     471      (unwind-protect
     472           (progn
     473             (setf (current-directory) "ccl:")
     474             (when clean
     475               (dolist (f (directory
     476                           (merge-pathnames
     477                            (make-pathname :name :wild
     478                                           :type (pathname-type *.fasl-pathname*))
     479                            "ccl:**;")))
     480                 (delete-file f)))
     481             (when kernel
     482               (when (or clean force)
     483                 ;; Do a "make -k clean".
     484                 (run-program "make"
     485                              (list "-k"
     486                                    "-C"
     487                                    (format nil "lisp-kernel/~a"
     488                                            (kernel-build-directory))
     489                                    "clean")))
     490               (format t "~&;Building lisp-kernel ...")
     491               (with-output-to-string (s)
     492                                      (multiple-value-bind
     493                                          (status exit-code)
     494                                          (external-process-status
     495                                           (run-program "make"
     496                                                        (list "-k" "-C"
     497                                                              (format nil "lisp-kernel/~a"
     498                                                                      (kernel-build-directory))
     499                                                              "-j"
    492500                                                           
    493                                                             (format nil "~d" (1+ (cpu-count))))
    494                                                       :output s
    495                                                       :error s))
    496                                       (if (and (eq :exited status) (zerop exit-code))
    497                                         (progn
    498                                           (format t "~&;Kernel built successfully.")
    499                                           (when verbose
    500                                             (format t "~&;kernel build output:~%~a"
    501                                                     (get-output-stream-string s)))
    502                                           (sleep 1))
    503                                         (error "Error(s) during kernel compilation.~%~a"
    504                                                (get-output-stream-string s))))))
    505            (compile-ccl (not (null force)))
    506            (if force (xload-level-0 :force) (xload-level-0))
    507            (when reload
    508              (with-input-from-string (cmd (format nil
    509                                                   "(save-application ~s)"
    510                                                   (standard-image-name)))
    511                (with-output-to-string (output)
    512                                       (multiple-value-bind (status exit-code)
    513                                           (external-process-status
    514                                            (run-program
    515                                             (format nil "./~a" (standard-kernel-name))
    516                                             (list* "--image-name" (standard-boot-image-name)
    517                                                    reload-arguments)
    518                                             :input cmd
    519                                             :output output
    520                                             :error output))
    521                                         (if (and (eq status :exited)
    522                                                  (eql exit-code 0))
     501                                                              (format nil "~d" (1+ (cpu-count))))
     502                                                        :output s
     503                                                        :error s))
     504                                        (if (and (eq :exited status) (zerop exit-code))
    523505                                          (progn
    524                                             (format t "~&;Wrote heap image: ~s"
    525                                                     (truename (format nil "ccl:~a"
    526                                                                       (standard-image-name))))
     506                                            (format t "~&;Kernel built successfully.")
    527507                                            (when verbose
    528                                               (format t "~&;Reload heap image output:~%~a"
    529                                                       (get-output-stream-string output))))
    530                                           (error "Errors (~s ~s) reloading boot image:~&~a"
    531                                                  status exit-code
    532                                                  (get-output-stream-string output)))))))
    533            (when exit
    534              (quit)))
    535       (setf (current-directory) cd))))
     508                                              (format t "~&;kernel build output:~%~a"
     509                                                      (get-output-stream-string s)))
     510                                            (sleep 1))
     511                                          (error "Error(s) during kernel compilation.~%~a"
     512                                                 (get-output-stream-string s))))))
     513             (compile-ccl (not (null force)))
     514             (if force (xload-level-0 :force) (xload-level-0))
     515             (when reload
     516               (with-input-from-string (cmd (format nil
     517                                                    "(save-application ~s)"
     518                                                    (standard-image-name)))
     519                 (with-output-to-string (output)
     520                                        (multiple-value-bind (status exit-code)
     521                                            (external-process-status
     522                                             (run-program
     523                                              (format nil "./~a" (standard-kernel-name))
     524                                              (list* "--image-name" (standard-boot-image-name)
     525                                                     reload-arguments)
     526                                              :input cmd
     527                                              :output output
     528                                              :error output))
     529                                          (if (and (eq status :exited)
     530                                                   (eql exit-code 0))
     531                                            (progn
     532                                              (format t "~&;Wrote heap image: ~s"
     533                                                      (truename (format nil "ccl:~a"
     534                                                                        (standard-image-name))))
     535                                              (when verbose
     536                                                (format t "~&;Reload heap image output:~%~a"
     537                                                        (get-output-stream-string output))))
     538                                            (error "Errors (~s ~s) reloading boot image:~&~a"
     539                                                   status exit-code
     540                                                   (get-output-stream-string output)))))))
     541             (when exit
     542               (quit)))
     543        (setf (current-directory) cd)))))
    536544                                                 
    537545               
Note: See TracChangeset for help on using the changeset viewer.