Changeset 11876


Ignore:
Timestamp:
05/15/09 20:43:31 (13 years ago)
Author:
ehuelsmann
Message:

Reindent < 80 columns.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11875 r11876  
    49604960       (compile-and-write-to-file class-file compiland)
    49614961             (emit 'getstatic *this-class*
    4962                    (declare-local-function (make-local-function :class-file class-file))
     4962                   (declare-local-function (make-local-function :class-file
     4963                                                                class-file))
    49634964                   +lisp-object+)))
    49644965          (t
     
    49694970             (unwind-protect
    49704971                 (progn
    4971        (compile-and-write-to-file (compiland-class-file compiland) compiland)
     4972       (compile-and-write-to-file (compiland-class-file compiland)
     4973                                              compiland)
    49724974                   (emit 'getstatic *this-class*
    49734975                         (declare-object (load-compiled-function pathname))
    49744976                         +lisp-object+))
    49754977               (delete-file pathname)))))
    4976     (cond ((null *closure-variables*)) ; Nothing to do.
     4978    (cond ((null *closure-variables*))  ; Nothing to do.
    49774979          ((compiland-closure-register *current-compiland*)
    49784980           (duplicate-closure-array *current-compiland*)
     
    49804982                              (list +lisp-object+ +closure-binding-array+)
    49814983                              +lisp-object+)
    4982            (emit 'checkcast +lisp-compiled-closure-class+)) ; Stack: compiled-closure
     4984           (emit 'checkcast +lisp-compiled-closure-class+))
     4985                                        ; Stack: compiled-closure
    49834986          (t
    49844987           (aver nil))) ;; Shouldn't happen.
     
    49914994  (let ((name (second form))
    49924995        local-function)
    4993     (cond ((symbolp name)
    4994            (dformat t "p2-function case 1~%")
    4995            (cond ((setf local-function (find-local-function name))
    4996                   (dformat t "p2-function 1~%")
    4997                   (cond ((local-function-variable local-function)
    4998                          (dformat t "p2-function 2 emitting var-ref~%")
    4999 ;;                          (emit 'var-ref (local-function-variable local-function) 'stack)
    5000                          (compile-var-ref (make-var-ref (local-function-variable local-function)) 'stack nil)
    5001                          )
    5002                         (t
    5003                          (let ((g (if *file-compilation*
    5004                                       (declare-local-function local-function)
    5005                                       (declare-object (local-function-function local-function)))))
    5006                            (emit 'getstatic *this-class* g +lisp-object+) ; Stack: template-function
    5007 
    5008                            (when (compiland-closure-register *current-compiland*)
    5009                              (emit 'checkcast +lisp-ctf-class+)
    5010                              (duplicate-closure-array *current-compiland*)
    5011                              (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    5012                                                 (list +lisp-object+ +closure-binding-array+)
    5013                                                 +lisp-object+)))))
    5014                   (emit-move-from-stack target))
    5015                  ((inline-ok name)
    5016                   (emit 'getstatic *this-class*
    5017                         (declare-function name) +lisp-object+)
    5018                   (emit-move-from-stack target))
    5019                  (t
    5020                   (multiple-value-bind
    5021                         (name class)
    5022                       (lookup-or-declare-symbol name)
    5023                     (emit 'getstatic class name +lisp-symbol+))
    5024                   (emit-invokevirtual +lisp-object-class+
    5025                                       "getSymbolFunctionOrDie"
    5026                                       nil +lisp-object+)
    5027                   (emit-move-from-stack target))))
    5028           ((and (consp name) (eq (%car name) 'SETF))
    5029            (dformat t "p2-function case 2~%")
    5030            ; FIXME Need to check for NOTINLINE declaration!
    5031            (cond ((setf local-function (find-local-function name))
    5032                   (dformat t "p2-function 1~%")
    5033                   (when (eq (local-function-compiland local-function) *current-compiland*)
    5034                     (aload 0) ; this
    5035                     (emit-move-from-stack target)
    5036                     (return-from p2-function))
    5037                   (cond ((local-function-variable local-function)
    5038                          (dformat t "p2-function 2~%")
    5039 ;;                          (emit 'var-ref (local-function-variable local-function) 'stack)
    5040                          (compile-var-ref (make-var-ref (local-function-variable local-function)) 'stack nil)
    5041                          )
    5042                         (t
    5043                          (let ((g (if *file-compilation*
    5044                                       (declare-local-function local-function)
    5045                                       (declare-object (local-function-function local-function)))))
    5046                            (emit 'getstatic *this-class*
    5047                                  g +lisp-object+))))) ; Stack: template-function
    5048                  ((member name *functions-defined-in-current-file* :test #'equal)
    5049                   (emit 'getstatic *this-class*
    5050                         (declare-setf-function name) +lisp-object+)
    5051                   (emit-move-from-stack target))
    5052                  ((and (null *file-compilation*)
    5053                        (fboundp name)
    5054                        (fdefinition name))
    5055                   (emit 'getstatic *this-class*
    5056                         (declare-object (fdefinition name)) +lisp-object+)
    5057                   (emit-move-from-stack target))
    5058                  (t
    5059                   (multiple-value-bind
    5060                         (name class)
    5061                       (lookup-or-declare-symbol (cadr name))
    5062                     (emit 'getstatic class name +lisp-symbol+))
    5063                   (emit-invokevirtual +lisp-symbol-class+
    5064                                       "getSymbolSetfFunctionOrDie"
    5065                                       nil +lisp-object+)
    5066                   (emit-move-from-stack target))))
    5067           ((compiland-p name)
    5068            (dformat t "p2-function case 3~%")
    5069            (p2-lambda name target))
    5070           (t
    5071            (compiler-unsupported "p2-function: unsupported case: ~S" form)))))
     4996    (cond
     4997      ((symbolp name)
     4998       (dformat t "p2-function case 1~%")
     4999       (cond
     5000         ((setf local-function (find-local-function name))
     5001          (dformat t "p2-function 1~%")
     5002          (cond
     5003            ((local-function-variable local-function)
     5004             (dformat t "p2-function 2 emitting var-ref~%")
     5005;;;          (emit 'var-ref (local-function-variable local-function) 'stack)
     5006             (compile-var-ref (make-var-ref
     5007                               (local-function-variable local-function))
     5008                              'stack nil)
     5009             )
     5010            (t
     5011             (let ((g (if *file-compilation*
     5012                          (declare-local-function local-function)
     5013                          (declare-object
     5014                           (local-function-function local-function)))))
     5015               (emit 'getstatic *this-class* g +lisp-object+)
     5016                                        ; Stack: template-function
     5017
     5018               (when (compiland-closure-register *current-compiland*)
     5019                 (emit 'checkcast +lisp-ctf-class+)
     5020                 (duplicate-closure-array *current-compiland*)
     5021                 (emit-invokestatic +lisp-class+ "makeCompiledClosure"
     5022                                    (list +lisp-object+ +closure-binding-array+)
     5023                                    +lisp-object+)))))
     5024          (emit-move-from-stack target))
     5025         ((inline-ok name)
     5026          (emit 'getstatic *this-class*
     5027                (declare-function name) +lisp-object+)
     5028          (emit-move-from-stack target))
     5029         (t
     5030          (multiple-value-bind
     5031                (name class)
     5032              (lookup-or-declare-symbol name)
     5033            (emit 'getstatic class name +lisp-symbol+))
     5034          (emit-invokevirtual +lisp-object-class+ "getSymbolFunctionOrDie"
     5035                              nil +lisp-object+)
     5036          (emit-move-from-stack target))))
     5037      ((and (consp name) (eq (%car name) 'SETF))
     5038       (dformat t "p2-function case 2~%")
     5039       ;; FIXME Need to check for NOTINLINE declaration!
     5040       (cond
     5041         ((setf local-function (find-local-function name))
     5042          (dformat t "p2-function 1~%")
     5043          (when (eq (local-function-compiland local-function)
     5044                    *current-compiland*)
     5045            (aload 0) ; this
     5046            (emit-move-from-stack target)
     5047            (return-from p2-function))
     5048          (cond
     5049            ((local-function-variable local-function)
     5050             (dformat t "p2-function 2~%")
     5051;;           (emit 'var-ref (local-function-variable local-function) 'stack)
     5052             (compile-var-ref (make-var-ref
     5053                               (local-function-variable local-function))
     5054                              'stack nil)
     5055             )
     5056            (t
     5057             (let ((g (if *file-compilation*
     5058                          (declare-local-function local-function)
     5059                          (declare-object
     5060                           (local-function-function local-function)))))
     5061               (emit 'getstatic *this-class*
     5062                     g +lisp-object+))))) ; Stack: template-function
     5063         ((member name *functions-defined-in-current-file* :test #'equal)
     5064          (emit 'getstatic *this-class*
     5065                (declare-setf-function name) +lisp-object+)
     5066          (emit-move-from-stack target))
     5067         ((and (null *file-compilation*)
     5068               (fboundp name)
     5069               (fdefinition name))
     5070          (emit 'getstatic *this-class*
     5071                (declare-object (fdefinition name)) +lisp-object+)
     5072          (emit-move-from-stack target))
     5073         (t
     5074          (multiple-value-bind
     5075                (name class)
     5076              (lookup-or-declare-symbol (cadr name))
     5077            (emit 'getstatic class name +lisp-symbol+))
     5078          (emit-invokevirtual +lisp-symbol-class+
     5079                              "getSymbolSetfFunctionOrDie"
     5080                              nil +lisp-object+)
     5081          (emit-move-from-stack target))))
     5082      ((compiland-p name)
     5083       (dformat t "p2-function case 3~%")
     5084       (p2-lambda name target))
     5085      (t
     5086       (compiler-unsupported "p2-function: unsupported case: ~S" form)))))
    50725087
    50735088(defknown p2-ash (t t t) t)
Note: See TracChangeset for help on using the changeset viewer.