Changeset 8349


Ignore:
Timestamp:
01/13/05 11:19:37 (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

    r8348 r8349  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.347 2005-01-13 10:09:20 piso Exp $
     4;;; $Id: jvm.lisp,v 1.348 2005-01-13 11:19:37 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    144144          (dump-1-variable variable))
    145145        (%format t "  None.~%"))))
    146 
    147 (defvar *nesting-level* 0)
    148146
    149147(defstruct variable
     
    449447                `(lambda ,lambda-list ,@decls (block ,name ,@body)))
    450448          (let ((*visible-variables* *visible-variables*)
    451                 (*nesting-level* (1+ *nesting-level*))
    452449                (*current-compiland* compiland))
    453450            (p1-compiland compiland)))
     
    484481    (dolist (local-function local-functions)
    485482      (let ((*visible-variables* *visible-variables*)
    486             (*nesting-level* (1+ *nesting-level*))
    487483            (*current-compiland* (local-function-compiland local-function)))
    488484        (p1-compiland (local-function-compiland local-function))))
     
    506502              `(lambda ,lambda-list ,@decls (block nil ,@body)))
    507503        (let ((*visible-variables* *visible-variables*)
    508               (*nesting-level* (1+ *nesting-level*))
    509504              (*current-compiland* compiland))
    510505          (p1-compiland compiland)))
     
    39563951                   (error "P2-LOCAL-FUNCTION: can't handle optional argument with non-constant initform.")))))))
    39573952    (setf form (compiland-lambda-expression compiland))
    3958     (let ((*nesting-level* (1+ *nesting-level*)))
    3959       (setf classfile (if *compile-file-truename*
    3960                           (sys::next-classfile-name)
    3961                           (prog1
    3962                            (%format nil "local-~D.class" *child-count*)
    3963                            (incf *child-count*))))
    3964       (setf (compiland-classfile compiland) classfile)
    3965       (let ((*current-compiland* compiland)
    3966             (*speed* *speed*)
    3967             (*safety* *safety*)
    3968             (*debug* *debug*))
    3969         (p2-compiland compiland))
    3970       (when (null *compile-file-truename*)
    3971         (setf function (sys:load-compiled-function classfile))))
     3953    (setf classfile (if *compile-file-truename*
     3954                        (sys::next-classfile-name)
     3955                        (prog1
     3956                         (%format nil "local-~D.class" *child-count*)
     3957                         (incf *child-count*))))
     3958    (setf (compiland-classfile compiland) classfile)
     3959    (let ((*current-compiland* compiland)
     3960          (*speed* *speed*)
     3961          (*safety* *safety*)
     3962          (*debug* *debug*))
     3963      (p2-compiland compiland))
     3964    (when (null *compile-file-truename*)
     3965      (setf function (sys:load-compiled-function classfile)))
    39723966    (cond (local-function
    39733967           (setf (local-function-classfile local-function) classfile)
     
    41134107      (cond
    41144108       ((setf local-function (find-local-function name))
     4109        (when (eq (local-function-compiland local-function) *current-compiland*)
     4110          (emit 'aload 0) ; this
     4111          (emit-move-from-stack target)
     4112          (return-from p2-function))
    41154113        (if (local-function-variable local-function)
    41164114            (emit 'var-ref (local-function-variable local-function) :stack)
     
    41224120                    g
    41234121                    +lisp-object+))) ; Stack: template-function
    4124 ;;         (unless (zerop *nesting-level*)
    4125 ;;           (error "nesting level > 0, not supported"))
    41264122        (cond
    41274123         ((null *closure-variables*)) ; Nothing to do.
     
    52705266    (dformat t "pass2 *using-arg-array* = ~S~%" *using-arg-array*)
    52715267    (dformat t "pass2 *child-p* = ~S~%" *child-p*)
    5272     (dformat t "pass2 *nesting-level* = ~S~%" *nesting-level*)
    5273 ;;     (when (zerop *nesting-level*)
    5274 ;;       (setf *child-count* 0))
    5275 ;;     (setf *context* (make-context))
    52765268    (setf (method-name-index execute-method)
    52775269          (pool-name (method-name execute-method)))
Note: See TracChangeset for help on using the changeset viewer.