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. |