Changeset 8359


Ignore:
Timestamp:
01/14/05 03:25:48 (17 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8349 r8359  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.348 2005-01-13 11:19:37 piso Exp $
     4;;; $Id: jvm.lisp,v 1.349 2005-01-14 03:25:48 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    185185
    186186(defvar *child-count* 0)
    187 
    188 ;; (defvar *context* nil)
    189 
    190 ;; (defstruct context vars)
    191 
    192 ;; (defun add-variable-to-context (variable)
    193 ;;   (aver (variable-p variable))
    194 ;;   (push variable (context-vars *context*)))
    195187
    196188(defun find-visible-variable (name)
     
    642634                      (when expansion
    643635                        (return-from p1 (p1 (expand-inline form expansion)))))
    644 ;;                     (p1-default form)
    645636                    (let ((local-function (find-local-function op)))
    646637                      (when local-function
    647638                        (dformat t "p1 local function ~S~%" op)
    648                         (let ((variable (local-function-variable local-function)))
    649                           (when variable
    650                             (unless (eq (variable-compiland variable) *current-compiland*)
    651                               (dformat t "p1 ~S used non-locally~%" (variable-name variable))
    652                               (setf (variable-used-non-locally-p variable) t))))))
     639                        (unless (eq (local-function-compiland local-function)
     640                                    *current-compiland*)
     641                          (let ((variable (local-function-variable local-function)))
     642                            (when variable
     643                              (unless (eq (variable-compiland variable) *current-compiland*)
     644                                (dformat t "p1 ~S used non-locally~%" (variable-name variable))
     645                                (setf (variable-used-non-locally-p variable) t)))))))
    653646                    (list* op (mapcar #'p1 (cdr form)))
    654647                    )))
     
    27532746         (local-function (find-local-function op)))
    27542747    (cond
     2748     ((eq (local-function-compiland local-function) *current-compiland*)
     2749      (emit 'aload_0))
    27552750     ((local-function-variable local-function)
    27562751      ;; LABELS
     
    27692764      (emit 'checkcast +lisp-ctf-class+))
    27702765
    2771       (when *closure-variables*
    2772         ;; First arg is closure variable array.
    2773         (aver (not (null (compiland-closure-register *current-compiland*))))
    2774         (emit 'aload (compiland-closure-register *current-compiland*)))
    2775       (cond
    2776        ((> (length args) 4)
    2777         (emit-push-constant-int (length args))
    2778         (emit 'anewarray "org/armedbear/lisp/LispObject")
    2779         (let ((i 0)
    2780               (must-clear-values nil))
    2781           (dolist (arg args)
    2782             (emit 'dup)
    2783             (emit 'sipush i)
    2784             (compile-form arg :target :stack)
    2785             (emit 'aastore) ; store value in array
    2786             (unless must-clear-values
    2787               (unless (single-valued-p arg)
    2788                 (setf must-clear-values t)))
    2789             (incf i))
    2790           (when must-clear-values
    2791             (emit-clear-values))) ; array left on stack here
    2792         )
    2793        (t
    2794         (let ((must-clear-values nil))
    2795           (dolist (arg args)
    2796             (compile-form arg :target :stack)
    2797             (unless must-clear-values
    2798               (unless (single-valued-p arg)
    2799                 (setf must-clear-values t))))
    2800           (when must-clear-values
    2801             (emit-clear-values))) ; args left on stack here
    2802         ))
     2766    (when *closure-variables*
     2767      ;; First arg is closure variable array.
     2768      (aver (not (null (compiland-closure-register *current-compiland*))))
     2769      (emit 'aload (compiland-closure-register *current-compiland*)))
     2770    (cond
     2771     ((> (length args) 4)
     2772      (emit-push-constant-int (length args))
     2773      (emit 'anewarray "org/armedbear/lisp/LispObject")
     2774      (let ((i 0)
     2775            (must-clear-values nil))
     2776        (dolist (arg args)
     2777          (emit 'dup)
     2778          (emit 'sipush i)
     2779          (compile-form arg :target :stack)
     2780          (emit 'aastore) ; store value in array
     2781          (unless must-clear-values
     2782            (unless (single-valued-p arg)
     2783              (setf must-clear-values t)))
     2784          (incf i))
     2785        (when must-clear-values
     2786          (emit-clear-values)))) ; array left on stack here
     2787     (t
     2788      (let ((must-clear-values nil))
     2789        (dolist (arg args)
     2790          (compile-form arg :target :stack)
     2791          (unless must-clear-values
     2792            (unless (single-valued-p arg)
     2793              (setf must-clear-values t))))
     2794        (when must-clear-values
     2795          (emit-clear-values))))) ; args left on stack here
    28032796
    28042797    (if *closure-variables*
Note: See TracChangeset for help on using the changeset viewer.