/[gcl]/gcl/cmpnew/gcl_cmpenv.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpenv.lsp

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

revision 1.11 by camm, Fri Jan 7 17:58:33 2005 UTC revision 1.12 by camm, Sat Apr 2 16:10:31 2005 UTC
# Line 85  Line 85 
85    
86  (defun add-object (object &aux x)  (defun add-object (object &aux x)
87    ;;; Used only during Pass 1.    ;;; Used only during Pass 1.
88    (cond ((si:contains-sharp-comma object)    (let ((object1 (cond ((and
89           ;;; SI:CONTAINS-SHARP-COMMA returns T iff OBJECT                           (consp object)
90           ;;; contains a sharp comma OR a structure.                           (eq (car object) 'si::|#,|)
91           ;; there will be an eval and we want the eval to happen                           (not (si:contains-sharp-comma (cdr object))))
92           (cond ((and                          (cdr object))
93                   (consp object)                         ((si:contains-sharp-comma object)
94                   (eq (car object) 'si::|#,|)                          `(si::string-to-object ,(wt-to-string object)))
95                   (not (si:contains-sharp-comma (cdr object))))                         ((typep object 'compiled-function)
96                  (setq object (cdr object)))                          `(function ,(or (si::compiled-function-name object)
97                 (t (setq object `(si::string-to-object                                          (cmperr "Can't dump un named compiled funs"))))
98                                   ,(wt-to-string object)))))                         (t object))))
99           (push-data-incf nil)  
100           (push (list *next-vv* object) *sharp-commas*)      (or
101           *next-vv*)       (cadr (assoc object1 *objects*))
102          ((setq x (assoc object *objects*))       (caar (member object1 *sharp-commas* :key #'cadr :test #'equal))
103           (cadr x))       (progn
104          ((typep object 'compiled-function)         (push-data-incf (if (eq object1 object) object1))
105           (push-data-incf nil)         (if (eq object1 object)
106           (push (list *next-vv* `(function             (push (list object1 *next-vv*) *objects*)
107                                   ,(or (si::compiled-function-name           (push (list *next-vv* object1) *sharp-commas*))
108                                         object)         *next-vv*))))
109                                        (cmperr "Can't dump un named compiled funs")  
                                       )))  
                                  *sharp-commas*)  
          *next-vv*  
          )  
         (t  
            (push-data-incf object)  
            (push (list object *next-vv*) *objects*)  
            *next-vv*)))  
110    
111  (defun add-constant (symbol &aux x)  (defun add-constant (symbol &aux x)
112    ;;; Used only during Pass 1.    ;;; Used only during Pass 1.

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

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