/[gcl]/gcl/lsp/gcl_top.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_top.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by camm, Sat Jul 23 08:53:17 2005 UTC revision 1.9 by camm, Tue Aug 9 00:46:06 2005 UTC
# Line 412  Line 412 
412    (do ((bi (1+ (frs-bds (1- *frs-base*))) (1+ bi))    (do ((bi (1+ (frs-bds (1- *frs-base*))) (1+ bi))
413         (last (frs-bds (1+ *frs-top*))))         (last (frs-bds (1+ *frs-top*))))
414        ((> bi last) (values))        ((> bi last) (values))
415      (when (or (null vars) (member (bds-var bi) vars))      (when (or (null vars) (member (the symbol (bds-var bi)) vars))
416        (do ()        (do ()
417            ((or (> fi *frs-top*) (> (frs-bds fi) bi)))            ((or (> fi *frs-top*) (> (frs-bds fi) bi)))
418          (print-frs fi)          (print-frs fi)
# Line 471  Line 471 
471    (case (frs-class i)    (case (frs-class i)
472      (:catch      (:catch
473       (if (spicep (frs-tag i))       (if (spicep (frs-tag i))
474           (or (and (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2))           (or (and (setq x (member (the symbol (frs-tag i)) (vs (+ (frs-vs i) 2))
475                                    :key #'caddr :test #'eq))                                    :key #'caddr :test #'eq))
476                    (if (eq (cadar x) 'block)                    (if (eq (cadar x) 'block)
477                        `(block ,(caar x) ***)                        `(block ,(caar x) ***)
# Line 496  Line 496 
496  (defvar *break-hidden-packages* nil)  (defvar *break-hidden-packages* nil)
497    
498  (defun ihs-visible (i &aux (tem (ihs-fname i)))  (defun ihs-visible (i &aux (tem (ihs-fname i)))
499    (and tem (not (member tem *break-hidden-packages*))))    (and tem (not (member (the symbol tem) *break-hidden-packages*))))
500    
501    
502  (defun ihs-fname (ihs-index)  (defun ihs-fname (ihs-index)
# Line 540  Line 540 
540    
541  (defun super-go (i tag &aux x)  (defun super-go (i tag &aux x)
542    (when (and (>= i *frs-base*) (<= i *frs-top*) (spicep (frs-tag i)))    (when (and (>= i *frs-base*) (<= i *frs-top*) (spicep (frs-tag i)))
543      (if (setq x (member (frs-tag i) (vs (+ (frs-vs i) 2))      (if (setq x (member (the symbol (frs-tag i)) (vs (+ (frs-vs i) 2))
544                          :key #'caddr :test #'eq))                          :key #'caddr :test #'eq))
545          ; Interpreted TAGBODY.          ; Interpreted TAGBODY.
546          (when (and (eq (cadar x) 'tag)          (when (and (eq (cadar x) 'tag)
547                     (member tag (mapcar #'car (remove (frs-tag i) x                     (member (the symbol tag) (mapcar #'car (remove (frs-tag i) x
548                                                       :test-not #'eq                                                       :test-not #'eq
549                                                       :key #'caddr))))                                                       :key #'caddr))))
550            (internal-super-go (frs-tag i) tag t))            (internal-super-go (frs-tag i) tag t))

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26