Changeset 8360


Ignore:
Timestamp:
01/14/05 22:02:20 (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

    r8359 r8360  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.349 2005-01-14 03:25:48 piso Exp $
     4;;; $Id: jvm.lisp,v 1.350 2005-01-14 22:02:20 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    245245  ;; If non-nil, register containing saved dynamic environment for this block.
    246246  environment-register
    247   ;; Only used in LET/LET* nodes.
     247  ;; Only used in LET/LET*/M-V-B nodes.
    248248  vars
     249  free-specials
    249250  )
    250251
     
    311312            (eq (car varspec) (cadr varspec))
    312313            (return nil))))
    313     (let ((vars (if (eq op 'LET) (p1-let-vars varlist) (p1-let*-vars varlist))))
     314    (let ((vars (if (eq op 'LET) (p1-let-vars varlist) (p1-let*-vars varlist)))
     315          (free-specials '()))
    314316      (dformat t "p1-let/let* vars = ~S~%" (mapcar #'variable-name vars))
    315317      ;; Check for globally declared specials.
     
    326328              (SPECIAL
    327329               (dolist (sym (cdr decl))
    328                  (dolist (variable vars)
    329                    (when (eq sym (variable-name variable))
    330                      (setf (variable-special-p variable) t)))))
     330;;                  (dolist (variable vars)
     331;;                    (when (eq sym (variable-name variable))
     332;;                      (setf (variable-special-p variable) t)))
     333                 (let ((variable (find sym vars :key #'variable-name)))
     334                   (cond (variable
     335                          (setf (variable-special-p variable) t))
     336                         (t
     337                          (dformat t "adding free special ~S~%" sym)
     338                          (push (make-variable :name sym :special-p t) free-specials))))
     339                 ))
    331340              (TYPE
    332341               (dolist (sym (cddr decl))
     
    334343                   (when (eq sym (variable-name variable))
    335344                     (setf (variable-declared-type variable) (cadr decl))))))))))
    336       (setf (block-vars block) vars))
     345      (setf (block-vars block) vars)
     346      (setf (block-free-specials block) free-specials))
    337347    (setf body (mapcar #'p1 body))
    338348    (setf (block-form block) (list* op varlist body))
     
    406416         (*visible-tags* *visible-tags*)
    407417         (body (cdr form)))
     418    ;; Make all the tags visible before processing the body forms.
    408419    (dolist (subform body)
    409420      (when (or (symbolp subform) (integerp subform))
    410421        (let* ((tag (make-tag :name subform :label (gensym) :block block)))
    411422          (push tag *visible-tags*))))
    412     (setf (block-form block) (list* 'TAGBODY (mapcar #'p1 (cdr form))))
     423    (let ((new-body '()))
     424      (dolist (subform body)
     425        (push (if (or (symbolp subform) (integerp subform))
     426                  subform
     427                  (p1 subform))
     428              new-body))
     429      (setf (block-form block) (list* 'TAGBODY (nreverse new-body))))
    413430    block))
    414431
     
    417434         (tag (find-tag name)))
    418435    (unless tag
    419       (error "COMPILE-GO: tag not found: ~S" name))
     436      (error "p1-go: tag not found: ~S" name))
    420437    (unless (eq (tag-compiland tag) *current-compiland*)
    421438      (setf (block-non-local-go-p (tag-block tag)) t)))
     
    33663383         (form (block-form block))
    33673384         (*visible-variables* *visible-variables*)
    3368          (varlist (cadr form))
    33693385         (specialp nil))
    33703386    ;; Are we going to bind any special variables?
     
    33853401      (LET*
    33863402       (p2-let*-bindings block)))
     3403    ;; Make declarations of free specials visible.
     3404    (dolist (variable (block-free-specials block))
     3405      (push variable *visible-variables*))
    33873406    ;; Body of LET/LET*.
    33883407    (compile-progn-body (cddr form) target)
Note: See TracChangeset for help on using the changeset viewer.