merging in add-object2 - gcl.git - GNU Common Lisp

diff --git a/gcl/cmpnew/gcl_cmpenv.lsp b/gcl/cmpnew/gcl_cmpenv.lsp
index 158e57370..3587dfd53 100755
--- a/gcl/cmpnew/gcl_cmpenv.lsp
+++ b/gcl/cmpnew/gcl_cmpenv.lsp

@@ -40,7 +40,6 @@

(setq *next-cfun* 0)

(setq *last-label* 0)

(clrhash *objects*)

- (clrhash *rev-objects*)

(setq *hash-eq* nil)

(setq *constants* nil)

(setq *local-funs* nil)

@@ -79,7 +78,7 @@

(cond ((gethash object *objects*))

((push-data-incf (unless init object))

(when init (add-init `(si::setvv ,*next-vv* ,init)))

- (setf (gethash *next-vv* *rev-objects*) object (gethash object *objects*) *next-vv*)))))

+ (setf (gethash object *objects*) *next-vv*)))))

;; Write to a string with all the *print-.. levels bound appropriately.

(defun wt-to-string (x &aux

@@ -88,6 +87,12 @@

(wt-data1 x)

(get-output-stream-string *compiler-output-data*))

+(defun ltvp-eval (form)

+ (cond ((atom form) form)

+ ((eq (car form) 'si::|#,|) (ltvp-eval (cdr form)))

+ ((eq (car form) 'si::nani) (si::nani (cadr form)))

+ (form)))

+

(defun ltvp (val)

(when (consp val) (eq (car val) 'si::|#,|)))

diff --git a/gcl/cmpnew/gcl_cmpfun.lsp b/gcl/cmpnew/gcl_cmpfun.lsp
index fb7278e33..4143af2b9 100755
--- a/gcl/cmpnew/gcl_cmpfun.lsp
+++ b/gcl/cmpnew/gcl_cmpfun.lsp

@@ -913,7 +913,7 @@

(sublis1 ,s ,(second args) ',test))))))

(defun sublis1-inline (a b c)

- (let ((tst (cadr c)))

+ (let ((tst (ltvp-eval (cadr c))))

(or (member tst '(eq equal eql)) (error "bad test"))

(wt "(check_alist(" a "),sublis1("a "," b "," (format nil "&o~(~a~)))" tst))))

diff --git a/gcl/cmpnew/gcl_cmptop.lsp b/gcl/cmpnew/gcl_cmptop.lsp
index 7a59b777e..52a79bb31 100755
--- a/gcl/cmpnew/gcl_cmptop.lsp
+++ b/gcl/cmpnew/gcl_cmptop.lsp

@@ -22,7 +22,6 @@

(in-package 'compiler)

(defvar *objects* (make-hash-table :test 'eq))

-(defvar *rev-objects* (make-hash-table :test 'eql))

;(defvar *objects* nil)

(defvar *constants* nil)

(defvar *sharp-commas* nil)

@@ -1804,7 +1803,7 @@

(when (eq (car form) 'location)

(when (listp (caddr form))

(when (eq 'vv (caaddr form))

- (let ((s (gethash (cadr (caddr form)) *rev-objects*)))

+ (let ((s (ltvp-eval (cadr (caddr form)))))

(when s `(defun ,s)))))))

(defun c1fset (args)