Changeset 13490 for trunk/abcl/src/org


Ignore:
Timestamp:
08/13/11 21:54:55 (10 years ago)
Author:
ehuelsmann
Message:

More code duplication removal.

File:
1 edited

Legend:

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

    r13489 r13490  
    467467  (or (variable-register variable) ;; either register or index
    468468      (variable-index variable)))  ;; is non-nil for local variables
     469
    469470
    470471(defun emit-load-local-variable (variable)
     
    21802181
    21812182
     2183(defun emit-load-local-function (local-function)
     2184  (when (eq *current-compiland* (local-function-compiland local-function))
     2185    (aload 0)
     2186    (return-from emit-load-local-function))
     2187  (multiple-value-bind
     2188        (class field)
     2189      (local-function-class-and-field local-function)
     2190    (emit-getstatic class field +lisp-object+))
     2191  (when *closure-variables*
     2192    (emit-checkcast +lisp-compiled-closure+)
     2193    (duplicate-closure-array *current-compiland*)
     2194    (emit-invokestatic +lisp+ "makeCompiledClosure"
     2195                       (list +lisp-object+ +closure-binding-array+)
     2196                       +lisp-object+)))
     2197
     2198
    21822199
    21832200(defknown compile-local-function-call (t t t) t)
     
    21872204Functions this applies to can be FLET, LABELS, LAMBDA or NAMED-LAMBDA.
    21882205Note: DEFUN implies a named lambda."
    2189   (let* ((compiland *current-compiland*)
    2190          (op (car form))
     2206  (let* ((op (car form))
    21912207         (args (cdr form))
    21922208         (local-function (find-local-function op))
     
    22052221          (t
    22062222           (dformat t "compile-local-function-call default case~%")
    2207            (multiple-value-bind
    2208                  (class field)
    2209                (local-function-class-and-field local-function)
    2210              (emit-getstatic class field +lisp-object+))
    2211            (when *closure-variables*
    2212              (emit-checkcast +lisp-compiled-closure+)
    2213              (duplicate-closure-array compiland)
    2214              (emit-invokestatic +lisp+ "makeCompiledClosure"
    2215                                 (list +lisp-object+ +closure-binding-array+)
    2216                                 +lisp-object+))))
     2223           (emit-load-local-function local-function)))
    22172224    (process-args args '(nil))
    22182225    (emit-call-execute (length args))
     
    40874094(defun p2-lambda (local-function target)
    40884095  (compile-local-function local-function)
    4089   (multiple-value-bind
    4090         (class field)
    4091       (local-function-class-and-field local-function)
    4092     (emit-getstatic class field +lisp-object+))
    4093   (when (compiland-closure-register *current-compiland*)
    4094     (duplicate-closure-array *current-compiland*)
    4095     (emit-invokestatic +lisp+ "makeCompiledClosure"
    4096                        (list +lisp-object+ +closure-binding-array+)
    4097                        +lisp-object+))
     4096  (emit-load-local-function local-function)
    40984097  (emit-move-from-stack target))
    40994098
     
    41104109         ((setf local-function (find-local-function name))
    41114110          (dformat t "p2-function 1~%")
    4112           (multiple-value-bind
    4113                 (class field)
    4114               (local-function-class-and-field local-function)
    4115             (emit-getstatic class field +lisp-object+))
    4116           (when (compiland-closure-register *current-compiland*)
    4117             (emit-checkcast +lisp-compiled-closure+)
    4118             (duplicate-closure-array *current-compiland*)
    4119             (emit-invokestatic +lisp+ "makeCompiledClosure"
    4120                                (list +lisp-object+ +closure-binding-array+)
    4121                                +lisp-object+))
     4111          (emit-load-local-function local-function)
    41224112          (emit-move-from-stack target))
    41234113         ((inline-ok name)
     
    41364126         ((setf local-function (find-local-function name))
    41374127          (dformat t "p2-function 1~%")
    4138           (when (eq (local-function-compiland local-function)
    4139                     *current-compiland*)
    4140             (aload 0) ; this
    4141             (emit-move-from-stack target)
    4142             (return-from p2-function))
    4143           (multiple-value-bind
    4144                 (class field)
    4145               (local-function-class-and-field local-function)
    4146                                         ; Stack: template-function
    4147             (emit-getstatic class field +lisp-object+)))
     4128          (emit-load-local-function local-function))
    41484129         ((and (member name *functions-defined-in-current-file* :test #'equal)
    41494130               (not (notinline-p name)))
Note: See TracChangeset for help on using the changeset viewer.