Changeset 4986


Ignore:
Timestamp:
12/06/03 01:27:54 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4980 r4986  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.51 2003-12-05 15:26:19 piso Exp $
     4;;; $Id: jvm.lisp,v 1.52 2003-12-06 01:27:54 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    118118
    119119(defun read-constant-pool-entry (stream)
    120   (let ((tag (read-u1 stream))
    121         info)
     120  (let ((tag (read-u1 stream)))
    122121    (case tag
    123122      ((7 8)
     
    127126              (s (make-string len)))
    128127         (dotimes (i len)
    129 ;;            (setf (char s i) (coerce (read-u1 stream) 'character)))
    130128           (setf (char s i) (code-char (read-u1 stream))))
    131129         (list tag len s)))
     
    304302(defvar *max-locals* 0)
    305303
    306 ;; (defun allocate-local ()
    307 ;;   (let ((index (fill-pointer *locals*)))
    308 ;;     (incf (fill-pointer *locals*))
    309 ;;     (setf *max-locals* (fill-pointer *locals*))
    310 ;;     index))
     304(defvar *variables* ())
     305
     306(defstruct variable
     307  name
     308  special-p
     309  index)
     310
     311(defun push-variable (var special-p index)
     312  (push (make-variable :name var :special-p special-p :index index) *variables*))
     313
     314(defun find-variable (var)
     315  (find var *variables* :key 'variable-name))
     316
     317;; (defun specialp (var)
     318;;   (let ((info (find-variable var)))
     319;;     (if info
     320;;         (cdr info)
     321;;         ;; Not found in variables list.
     322;;         (special-variable-p var))))
    311323
    312324(defvar *args* nil)
     
    16671679
    16681680(defun compile-let/let* (form for-effect)
    1669   (let* ((saved-fp (fill-pointer *locals*))
    1670          (varlist (second form))
     1681;;   (format t "compile-let/let* *locals* = ~S~%" *locals*)
     1682  (let* ((*variables* *variables*)
     1683         (specials ())
     1684         (saved-fp (fill-pointer *locals*))
     1685         (varlist (cadr form))
    16711686         (specialp nil)
    16721687         env-var)
     1688    ;; Process declarations.
     1689    (dolist (f (cddr form))
     1690      (unless (and (consp f) (eq (car f) 'declare))
     1691        (return))
     1692      (let ((decls (cdr f)))
     1693        (dolist (decl decls)
     1694          (when (eq (car decl) 'special)
     1695            (setf specials (append (cdr decl) specials))))))
     1696;;     (when specials
     1697;;       (format t "specials = ~S~%" specials))
    16731698    ;; Are we going to bind any special variables?
    16741699    (dolist (varspec varlist)
    16751700      (let ((var (if (consp varspec) (car varspec) varspec)))
    1676         (when (special-variable-p var)
     1701        (when (or (memq var specials) (special-variable-p var))
    16771702          (setq specialp t)
    16781703          (return))))
     
    16801705    (when specialp
    16811706      ;; Save current dynamic environment.
    1682       (setq env-var (vector-push nil *locals*))
    1683       (setq *max-locals* (max *max-locals* (fill-pointer *locals*)))
     1707      (setf env-var (vector-push nil *locals*))
     1708      (setf *max-locals* (max *max-locals* (fill-pointer *locals*)))
    16841709      (ensure-thread-var-initialized)
    16851710      (emit 'aload *thread*)
     
    16911716    (ecase (car form)
    16921717      (LET
    1693        (compile-let-vars varlist))
     1718       (compile-let-vars varlist specials))
    16941719      (LET*
    1695        (compile-let*-vars varlist)))
     1720       (compile-let*-vars varlist specials)))
    16961721    ;; Body of LET/LET*.
    16971722    (do ((body (cddr form) (cdr body)))
     
    17111736    (setf (fill-pointer *locals*) saved-fp)))
    17121737
    1713 (defun compile-let-vars (varlist)
     1738(defun compile-let-vars (varlist specials)
     1739;;   (format t "compile-let-vars *locals* = ~S~%" *locals*)
    17141740  ;; Generate code to evaluate the initforms and leave the resulting values
    17151741  ;; on the stack.
     
    17341760  ;; Add local variables to local variables vector.
    17351761  (dolist (varspec varlist)
    1736     (let ((var (if (consp varspec) (car varspec) varspec)))
    1737       (unless (special-variable-p var)
    1738         (vector-push var *locals*))))
     1762    (let* ((var (if (consp varspec) (car varspec) varspec))
     1763           (specialp (if (or (memq var specials) (special-variable-p var)) t nil))
     1764           (index (if specialp nil (fill-pointer *locals*))))
     1765      (push-variable var specialp index)
     1766      (unless specialp
     1767;;         (format t "pushing ~S~%" var)
     1768        (vector-push var *locals*)
     1769;;         (format t "after push *locals* = ~S~%" *locals*)
     1770        )))
    17391771  (setq *max-locals* (max *max-locals* (fill-pointer *locals*)))
    17401772  ;; At this point the initial values are on the stack. Now generate code to
     
    17431775  ;; in reverse order.
    17441776  (do* ((varlist (reverse varlist) (cdr varlist))
    1745         (varspec (car varlist) (car varlist))
    1746         (var (if (consp varspec) (car varspec) varspec))
    1747         (i (1- (fill-pointer *locals*)) (1- i)))
     1777        (varspec (car varlist) (car varlist)))
     1778;;         (i (1- (fill-pointer *locals*)) (1- i)))
    17481779       ((null varlist))
    1749     (cond ((special-variable-p var)
    1750            (let ((g (declare-symbol var)))
    1751              (emit 'getstatic
    1752                    *this-class*
    1753                    g
    1754                    "Lorg/armedbear/lisp/Symbol;")
    1755              (emit 'swap)
    1756              (emit-invokestatic +lisp-class+
    1757                                 "bindSpecialVariable"
    1758                                 "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    1759                                 -2)))
    1760           (t
    1761            (emit 'astore i)))))
    1762 
    1763 (defun compile-let*-vars (varlist)
     1780    (let* ((var (if (consp varspec) (car varspec) varspec))
     1781           (v (find-variable var)))
     1782;;       (format t "varlist = ~S varspec = ~S var = ~S~%" varlist varspec var)
     1783;;       (format t "processing ~S~%" var)
     1784;;       (format t "var = ~S v = ~S~%" var v)
     1785      (cond ((or (memq var specials) (special-variable-p var))
     1786             (let ((g (declare-symbol var)))
     1787               (emit 'getstatic
     1788                     *this-class*
     1789                     g
     1790                     "Lorg/armedbear/lisp/Symbol;")
     1791               (emit 'swap)
     1792               (emit-invokestatic +lisp-class+
     1793                                  "bindSpecialVariable"
     1794                                  "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
     1795                                  -2)))
     1796            (t
     1797             (let ((index (position var *locals* :from-end t)))
     1798;;                (format t "index = ~S i = ~S~%" index i)
     1799;;                (unless (= index i)
     1800;;                  (format t "*locals* = ~S~%" *locals*)))
     1801;;              (emit 'astore i))))))
     1802               (unless index
     1803                 (error "COMPILE-LET-VARS can't find local variable"))
     1804               (unless (eql index (variable-index v))
     1805                 (error "COMPILE-LET-VARS wrong index"))
     1806               (emit 'astore index)))))))
     1807
     1808(defun compile-let*-vars (varlist specials)
    17641809  ;; Generate code to evaluate initforms and bind variables.
    17651810  (let ((i (fill-pointer *locals*)))
     
    20882133
    20892134(defun compile-variable-ref (form)
    2090   (let ((index (position form *locals* :from-end t)))
    2091     (when index
    2092       (emit 'aload index)
     2135  (let ((v (find-variable form)))
     2136    (unless (and v (variable-special-p v))
     2137      (let ((index (position form *locals* :from-end t)))
     2138        (when index
     2139          (emit 'aload index)
     2140          (emit-store-value)
     2141          (return-from compile-variable-ref)))
     2142      ;; Not found in locals; look in args.
     2143      (let ((index (position form *args*)))
     2144        (when index
     2145          (cond (*using-arg-array*
     2146                 (emit 'aload 1)
     2147                 (emit 'bipush index)
     2148                 (emit 'aaload)
     2149                 (emit-store-value)
     2150                 (return-from compile-variable-ref))
     2151                (t
     2152                 (emit 'aload (1+ index))
     2153                 (emit-store-value)
     2154                 (return-from compile-variable-ref))))))
     2155    ;; Otherwise it must be a global variable.
     2156    (let ((g (declare-symbol form)))
     2157      (emit 'getstatic
     2158            *this-class*
     2159            g
     2160            "Lorg/armedbear/lisp/Symbol;")
     2161      (emit-invokevirtual +lisp-symbol-class+
     2162                          "symbolValue"
     2163                          "()Lorg/armedbear/lisp/LispObject;"
     2164                          0)
    20932165      (emit-store-value)
    2094       (return-from compile-variable-ref)))
    2095   ;; Not found in locals; look in args.
    2096   (let ((index (position form *args*)))
    2097     (when index
    2098       (cond (*using-arg-array*
    2099              (emit 'aload 1)
    2100              (emit 'bipush index)
    2101              (emit 'aaload)
    2102              (emit-store-value)
    2103              (return-from compile-variable-ref))
    2104             (t
    2105              (emit 'aload (1+ index))
    2106              (emit-store-value)
    2107              (return-from compile-variable-ref)))))
    2108 
    2109   ;; Otherwise it must be a global variable.
    2110   (let ((g (declare-symbol form)))
    2111     (emit 'getstatic
    2112           *this-class*
    2113           g
    2114           "Lorg/armedbear/lisp/Symbol;")
    2115     (emit-invokevirtual +lisp-symbol-class+
    2116                         "symbolValue"
    2117                         "()Lorg/armedbear/lisp/LispObject;"
    2118                         0)
    2119     (emit-store-value)
    2120     (return-from compile-variable-ref)))
     2166      (return-from compile-variable-ref))))
    21212167
    21222168;; If for-effect is true, no value needs to be left on the stack.
     
    22042250         (*locals* (make-array 256 :fill-pointer 0)) ; FIXME Remove hard limit!
    22052251         (*max-locals* 0)
     2252         (*variables* ())
    22062253         (*pool* ())
    22072254         (*pool-count* 1)
Note: See TracChangeset for help on using the changeset viewer.