Changeset 13497 for trunk/abcl/src/org


Ignore:
Timestamp:
08/14/11 19:55:17 (10 years ago)
Author:
ehuelsmann
Message:

More code shuffling.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r13496 r13497  
    122122                 *fasl-stream*))
    123123    (%stream-terpri *fasl-stream*)))
     124
     125
     126(declaim (ftype (function (t) t) simple-toplevel-form-p))
     127(defun simple-toplevel-form-p (form)
     128  "Returns NIL if the form is too complex to become an
     129interpreted toplevel form, non-NIL if it is 'simple enough'."
     130  (and (consp form)
     131       (every #'(lambda (arg)
     132                  (or (and (atom arg)
     133                           (not (and (symbolp arg)
     134                                     (symbol-macro-p arg))))
     135                      (and (consp arg)
     136                           (eq 'QUOTE (car arg)))))
     137              (cdr form))))
     138
     139(declaim (ftype (function (t t) t) convert-toplevel-form))
     140(defun convert-toplevel-form (form declare-inline)
     141  (when (or (simple-toplevel-form-p form)
     142            (and (eq (car form) 'SETQ)
     143                 ;; for SETQ, look at the evaluated part
     144                 (simple-toplevel-form-p (third form))))
     145    ;; single form with simple or constant arguments
     146    ;; Without this exception, toplevel function calls
     147    ;; will be compiled into lambdas which get compiled to
     148    ;; compiled-functions. Those need to be loaded.
     149    ;; Conclusion: Top level interpreting the function call
     150    ;;  and its arguments may be (and should be) more efficient.
     151    (return-from convert-toplevel-form
     152      (precompiler:precompile-form form nil *compile-file-environment*)))
     153  (let* ((expr `(lambda () ,form))
     154         (saved-class-number *class-number*)
     155         (classfile (next-classfile-name))
     156         (result
     157          (with-open-file
     158              (f classfile
     159                 :direction :output
     160                 :element-type '(unsigned-byte 8)
     161                 :if-exists :supersede)
     162            (report-error (jvm:compile-defun nil
     163                                             expr *compile-file-environment*
     164                                             classfile f declare-inline))))
     165         (compiled-function (verify-load classfile)))
     166    (declare (ignore result))
     167    (setf form
     168          (if compiled-function
     169              `(funcall (sys::get-fasl-function *fasl-loader*
     170                                                ,saved-class-number))
     171              (precompiler:precompile-form form nil
     172                                           *compile-file-environment*)))))
    124173
    125174
     
    354403          `(put ',name 'macroexpand-macro
    355404                (make-macro ',name
    356                             (sys::get-fasl-function *fasl-loader* ,saved-class-number)))
     405                            (sys::get-fasl-function *fasl-loader*
     406                                                    ,saved-class-number)))
    357407          `(fset ',name
    358408                 (make-macro ',name
    359                              (sys::get-fasl-function *fasl-loader* ,saved-class-number))
     409                             (sys::get-fasl-function *fasl-loader*
     410                                                     ,saved-class-number))
    360411                 ,*source-position*
    361412                 ',(third form))))))
     
    520571      (eval form))))
    521572
    522 
    523 (declaim (ftype (function (t) t) simple-toplevel-form-p))
    524 (defun simple-toplevel-form-p (form)
    525   "Returns NIL if the form is too complex to become an
    526 interpreted toplevel form, non-NIL if it is 'simple enough'."
    527   (and (consp form)
    528        (every #'(lambda (arg)
    529                   (or (and (atom arg)
    530                            (not (and (symbolp arg)
    531                                      (symbol-macro-p arg))))
    532                       (and (consp arg)
    533                            (eq 'QUOTE (car arg)))))
    534               (cdr form))))
    535 
    536 (declaim (ftype (function (t t) t) convert-toplevel-form))
    537 (defun convert-toplevel-form (form declare-inline)
    538   (when (or (simple-toplevel-form-p form)
    539             (and (eq (car form) 'SETQ)
    540                  ;; for SETQ, look at the evaluated part
    541                  (simple-toplevel-form-p (third form))))
    542     ;; single form with simple or constant arguments
    543     ;; Without this exception, toplevel function calls
    544     ;; will be compiled into lambdas which get compiled to
    545     ;; compiled-functions. Those need to be loaded.
    546     ;; Conclusion: Top level interpreting the function call
    547     ;;  and its arguments may be (and should be) more efficient.
    548     (return-from convert-toplevel-form
    549       (precompiler:precompile-form form nil *compile-file-environment*)))
    550   (let* ((expr `(lambda () ,form))
    551    (saved-class-number *class-number*)
    552          (classfile (next-classfile-name))
    553          (result
    554     (with-open-file
    555         (f classfile
    556      :direction :output
    557      :element-type '(unsigned-byte 8)
    558      :if-exists :supersede)
    559       (report-error (jvm:compile-defun nil expr *compile-file-environment*
    560                                              classfile f declare-inline))))
    561          (compiled-function (verify-load classfile)))
    562     (declare (ignore result))
    563     (setf form
    564           (if compiled-function
    565               `(funcall (sys::get-fasl-function *fasl-loader* ,saved-class-number))
    566               (precompiler:precompile-form form nil *compile-file-environment*)))))
    567573
    568574
Note: See TracChangeset for help on using the changeset viewer.