Changeset 11935


Ignore:
Timestamp:
05/23/09 17:15:36 (12 years ago)
Author:
vvoutilainen
Message:

Patches to make the branch build. It doesn't run yet, there's a Thread
that's attempted to coerce to a Function somewhere, but at least it
builds.

Location:
branches/fewer-executes/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/fewer-executes/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11886 r11935  
    27842784in order to call the relevant `execute' form. The function call
    27852785itself is *not* compiled by this function."
    2786   (when args
    2787     (let ((numargs (length args)))
    2788       (let ((must-clear-values nil))
    2789         (declare (type boolean must-clear-values))
    2790         (cond ((<= numargs call-registers-limit)
    2791                (dolist (arg args)
    2792                  (compile-form arg 'stack nil)
    2793                  (unless must-clear-values
    2794                    (unless (single-valued-p arg)
    2795                      (setf must-clear-values t)))))
    2796               (t
    2797                (emit-push-constant-int numargs)
    2798                (emit 'anewarray +lisp-object-class+)
    2799                (let ((i 0))
    2800                  (dolist (arg args)
    2801                    (emit 'dup)
    2802                    (emit-push-constant-int i)
    2803                    (compile-form arg 'stack nil)
    2804                    (emit 'aastore) ; store value in array
    2805                    (unless must-clear-values
    2806                      (unless (single-valued-p arg)
    2807                        (setf must-clear-values t)))
    2808                    (incf i)))))
    2809         (when must-clear-values
    2810           (emit-clear-values)))))
     2786  (let ((numargs (length args)))
     2787    (let ((must-clear-values nil))
     2788      (declare (type boolean must-clear-values))
     2789      (emit-push-constant-int numargs)
     2790      (emit 'anewarray +lisp-object-class+)
     2791      (let ((i 0))
     2792  (dolist (arg args)
     2793    (emit 'dup)
     2794    (emit-push-constant-int i)
     2795    (compile-form arg 'stack nil)
     2796    (emit 'aastore) ; store value in array
     2797    (unless must-clear-values
     2798      (unless (single-valued-p arg)
     2799        (setf must-clear-values t)))
     2800    (incf i)))
     2801      (when must-clear-values
     2802  (emit-clear-values))))
    28112803  t)
    28122804
     
    28252817(declaim (ftype (function (t) t) emit-call-execute))
    28262818(defun emit-call-execute (numargs)
    2827   (let ((arg-types (if (<= numargs call-registers-limit)
    2828                        (lisp-object-arg-types numargs)
    2829                        (list +lisp-object-array+)))
     2819  (declare (ignore numargs))
     2820  (let ((arg-types (list +lisp-object-array+))
    28302821        (return-type +lisp-object+))
    28312822    (emit-invokevirtual +lisp-object-class+ "execute" arg-types return-type)))
     
    28332824(declaim (ftype (function (t) t) emit-call-thread-execute))
    28342825(defun emit-call-thread-execute (numargs)
    2835   (let ((arg-types (if (<= numargs call-registers-limit)
    2836                        (lisp-object-arg-types (1+ numargs))
    2837                        (list +lisp-object+ +lisp-object-array+)))
     2826  (declare (ignore numargs))
     2827  (let ((arg-types (list +lisp-object+ +lisp-object-array+))
    28382828        (return-type +lisp-object+))
    28392829    (emit-invokevirtual +lisp-thread-class+ "execute" arg-types return-type)))
     
    28932883is registered (or not)."
    28942884  (let ((numargs (length args)))
    2895     (cond ((> *speed* *debug*)
     2885    (cond ((and (> *speed* *debug*) (not *require-stack-frame*))
    28962886           (process-args args)
    28972887           (emit-call-execute numargs))
     
    38403830     (emit-invokestatic +lisp-class+ "coerceToFunction"
    38413831                        (lisp-object-arg-types 1) +lisp-object+)
    3842      (emit-invokevirtual +lisp-object-class+ "execute" nil +lisp-object+))
     3832     (emit-invokevirtual +lisp-object-class+ "execute" (list +lisp-object-array+) +lisp-object+))
    38433833    (3
    38443834     (let* ((*register* *register*)
     
    78677857          (get-descriptor (list +lisp-object-array+) +lisp-object+)))
    78687858      (return-from analyze-args
    7869         (cond ((<= arg-count call-registers-limit)
    7870                (get-descriptor (lisp-object-arg-types arg-count) +lisp-object+))
    7871               (t (setf *using-arg-array* t)
     7859        (cond (t (setf *using-arg-array* t)
    78727860                 (setf (compiland-arity compiland) arg-count)
    78737861                 (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
     
    78797867      (return-from analyze-args
    78807868                   (get-descriptor (list +lisp-object-array+) +lisp-object+)))
    7881     (cond ((<= arg-count call-registers-limit)
    7882            (get-descriptor (lisp-object-arg-types (length args))
    7883                             +lisp-object+))
    7884           (t
    7885            (setf *using-arg-array* t)
    7886            (setf (compiland-arity compiland) arg-count)
    7887            (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
     7869    (setf *using-arg-array* t)
     7870    (setf (compiland-arity compiland) arg-count)
     7871    (get-descriptor (list +lisp-object-array+) +lisp-object+)))
    78887872
    78897873(defun write-class-file (class-file)
     
    79987982          (find compiland *closure-variables* :key #'variable-compiland))
    79997983         (body (cddr p1-result))
    8000          (*using-arg-array* nil)
     7984         (*using-arg-array* t)
    80017985         (*hairy-arglist-p* nil)
    80027986         ;; *hairy-arglist-p* != NIL --> *using-arglist-array* != NIL
  • branches/fewer-executes/abcl/src/org/armedbear/lisp/jvm.lisp

    r11880 r11935  
    342342        (return local-function))))
    343343
    344 (defvar *using-arg-array* nil)
     344(defvar *using-arg-array* t)
    345345(defvar *hairy-arglist-p* nil)
    346346
Note: See TracChangeset for help on using the changeset viewer.