Changeset 8362


Ignore:
Timestamp:
01/15/05 07:20:28 (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

    r8360 r8362  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.350 2005-01-14 22:02:20 piso Exp $
     4;;; $Id: jvm.lisp,v 1.351 2005-01-15 07:20:28 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    495495
    496496(defun p1-function (form)
    497   (cond
    498    ((and (consp (cadr form)) (eq (caadr form) 'LAMBDA))
    499     (when *current-compiland*
    500       (incf (compiland-children *current-compiland*)))
    501     (let* ((*current-compiland* *current-compiland*)
    502            (lambda-form (cadr form))
    503            (lambda-list (cadr lambda-form))
    504            (body (cddr lambda-form))
    505            (compiland (make-compiland :name (gensym "ANONYMOUS-LAMBDA-")
    506                                       :lambda-expression lambda-form
    507                                       :parent *current-compiland*)))
    508       (multiple-value-bind (body decls)
    509         (sys::parse-body body)
    510         (setf (compiland-lambda-expression compiland)
    511               `(lambda ,lambda-list ,@decls (block nil ,@body)))
    512         (let ((*visible-variables* *visible-variables*)
    513               (*current-compiland* compiland))
    514           (p1-compiland compiland)))
    515       (list 'FUNCTION compiland)))
    516    (t
    517     form)))
     497  (let (local-function)
     498    (cond ((and (consp (cadr form)) (eq (caadr form) 'LAMBDA))
     499           (when *current-compiland*
     500             (incf (compiland-children *current-compiland*)))
     501           (let* ((*current-compiland* *current-compiland*)
     502                  (lambda-form (cadr form))
     503                  (lambda-list (cadr lambda-form))
     504                  (body (cddr lambda-form))
     505                  (compiland (make-compiland :name (gensym "ANONYMOUS-LAMBDA-")
     506                                             :lambda-expression lambda-form
     507                                             :parent *current-compiland*)))
     508             (multiple-value-bind (body decls)
     509               (sys::parse-body body)
     510               (setf (compiland-lambda-expression compiland)
     511                     `(lambda ,lambda-list ,@decls (block nil ,@body)))
     512               (let ((*visible-variables* *visible-variables*)
     513                     (*current-compiland* compiland))
     514                 (p1-compiland compiland)))
     515             (list 'FUNCTION compiland)))
     516          ((setf local-function (find-local-function (cadr form)))
     517           (dformat t "p1-function local function ~S~%" (cadr form))
     518           (let ((variable (local-function-variable local-function)))
     519             (when variable
     520               (unless (eq (variable-compiland variable) *current-compiland*)
     521                 (dformat t "p1-function ~S used non-locally~%" (variable-name variable))
     522                 (setf (variable-used-non-locally-p variable) t))))
     523           form)
     524          (t
     525           form))))
    518526
    519527(defun p1-lambda (form)
     
    53745382    ;; Move args from their original registers to the closure variables array,
    53755383    ;; if applicable.
    5376     (when *closure-variables*
     5384    (when (and *closure-variables*
     5385               #+nil (some #'variable-closure-index parameters)
     5386               )
    53775387      (dformat t "moving arguments to closure array (if applicable)~%")
    5378       (cond
    5379        (*child-p*
    5380         (aver (eql (compiland-closure-register compiland) 1))
    5381         (emit 'aload (compiland-closure-register compiland))
    5382         )
    5383        (t
    5384         (emit-push-constant-int (length *closure-variables*))
    5385         (dformat t "p2-compiland ~S anewarray 1~%" (compiland-name compiland))
    5386         (emit 'anewarray "org/armedbear/lisp/LispObject")))
     5388      (cond (*child-p*
     5389             (aver (eql (compiland-closure-register compiland) 1))
     5390             (when (some #'variable-closure-index parameters)
     5391               (emit 'aload (compiland-closure-register compiland)))
     5392             )
     5393            (t
     5394             (emit-push-constant-int (length *closure-variables*))
     5395             (dformat t "p2-compiland ~S anewarray 1~%" (compiland-name compiland))
     5396             (emit 'anewarray "org/armedbear/lisp/LispObject")))
    53875397      (dolist (variable parameters)
    53885398        (dformat t "considering ~S ...~%" (variable-name variable))
     
    54155425          )))
    54165426      (aver (not (null (compiland-closure-register compiland))))
    5417       (cond
    5418        (*child-p*
    5419         (emit 'pop))
    5420        (t
    5421         (emit 'astore (compiland-closure-register compiland)))))
     5427      (cond (*child-p*
     5428             (when (some #'variable-closure-index parameters)
     5429               (emit 'pop)))
     5430            (t
     5431             (emit 'astore (compiland-closure-register compiland)))))
    54225432
    54235433    ;; Establish dynamic bindings for any variables declared special.
Note: See TracChangeset for help on using the changeset viewer.