gcl.git - GNU Common Lisp

diff --git a/gcl/cmpnew/gcl_cmpinline.lsp b/gcl/cmpnew/gcl_cmpinline.lsp
index 8d7108b37..312c2c76b 100755
--- a/gcl/cmpnew/gcl_cmpinline.lsp
+++ b/gcl/cmpnew/gcl_cmpinline.lsp

@@ -701,7 +701,7 @@

(defun list*-inline (&rest x)

(case (length x)

(1 (wt (car x)))

- (2 (wt "make_cons(" (car x) "," (cadr x) ")"))

+ (2 (wt "CMPmake_cons(" (car x) "," (cadr x) ")"))

(otherwise

(wt "listA(" (length x)) (dolist (loc x) (wt #,円 loc)) (wt #\)))))

diff --git a/gcl/cmpnew/gcl_cmpopt.lsp b/gcl/cmpnew/gcl_cmpopt.lsp
index 7b1285606..5b4736015 100755
--- a/gcl/cmpnew/gcl_cmpopt.lsp
+++ b/gcl/cmpnew/gcl_cmpopt.lsp

@@ -728,7 +728,7 @@ type_of(#0)==t_bitvector")

(get 'code-char 'inline-always))

;;CONS

- (push '((t t) t #.(flags ans)"make_cons(#0,#1)")

+ (push '((t t) t #.(flags ans)"CMPmake_cons(#0,#1)")

(get 'cons 'inline-always))

(push '((t t) :dynamic-extent #.(flags ans)"ON_STACK_CONS(#0,#1)")

(get 'cons 'inline-always))

@@ -891,7 +891,7 @@ type_of(#0)==t_bitvector")

;;LIST

(push '(nil t #.(flags)"Cnil")

(get 'list 'inline-always))

-(push '((t) t #.(flags ans)"make_cons(#0,Cnil)")

+(push '((t) t #.(flags ans)"CMPmake_cons(#0,Cnil)")

(get 'list 'inline-always))

(push '((t t) t #.(flags ans)LIST-INLINE)

(get 'list 'inline-always))

@@ -915,7 +915,7 @@ type_of(#0)==t_bitvector")

;;LIST*

(push '((t) t #.(flags)"(#0)")

(get 'list* 'inline-always))

-(push '((t t) t #.(flags ans)"make_cons(#0,#1)")

+(push '((t t) t #.(flags ans)"CMPmake_cons(#0,#1)")

(get 'list* 'inline-always))

(push '((t t t) t #.(flags ans)LIST*-INLINE)

(get 'list* 'inline-always))

diff --git a/gcl/h/compdefs.h b/gcl/h/compdefs.h
index e8029bd5c..cf981d2f1 100644
--- a/gcl/h/compdefs.h
+++ b/gcl/h/compdefs.h

@@ -111,3 +111,4 @@ Scons

EQ(x,y)

aset

stp_ordinary

+CMPmake_cons(x,y)

diff --git a/gcl/h/globals.h b/gcl/h/globals.h
index 8c9552591..dc1a841dd 100644
--- a/gcl/h/globals.h
+++ b/gcl/h/globals.h

@@ -21,4 +21,12 @@ EXTER object sLcons;

EXTER object sLhash_table;

EXTER object MVloc[10];

-

+EXTER void **cfreep;

+EXTER ufixnum *cnfreep;

+struct mpageinfo {

+ unsigned long type:6;

+ unsigned long magic:7;

+ unsigned long sgc_flags:2;

+ unsigned long in_use:49;

+ struct mpageinfo *next;

+};

diff --git a/gcl/h/object.h b/gcl/h/object.h
index bc459448b..97ff0460b 100755
--- a/gcl/h/object.h
+++ b/gcl/h/object.h

@@ -518,3 +518,12 @@ EXTER unsigned plong signals_allowed, signals_pending;

#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));})

#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));})

#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));})

+

+

+#ifdef IN_MAIN

+void **cfreep=(void **)&tm_table[t_cons].tm_free;

+ufixnum *cnfreep=(ufixnum *)&tm_table[t_cons].tm_nfree;

+#endif

+

+#define mpageinfo(x) ((struct mpageinfo *)(((ufixnum)x)&(-(1L << 12))))

+#define CMPmake_cons(a_,b_) ({object o;void *p;if ((p=cfreep[0])!=OBJNULL) {cfreep[0]=((void **)cfreep[0])[1];(*cnfreep)--;o=p;o->c.c_car=a_;o->c.c_cdr=b_;mpageinfo(o)->in_use++;} else o=make_cons(a_,b_);o;})

diff --git a/gcl/makefile b/gcl/makefile
index 6f2981941..9cd1b03ca 100644
--- a/gcl/makefile
+++ b/gcl/makefile

@@ -256,7 +256,7 @@ $(HDIR)new_decl.h:

(cd o && $(MAKE) ../$@)

$(HDIR)mcompdefs.h: $(HDIR)compdefs.h $(HDIR)new_decl.h

- $(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"cmponly.h\"";print "---"} {print "\"#define " $1ドル "\" " $1ドル}' $< |\

+ $(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"cmponly.h\"";print "#include \"page.h\"";print "---"} {print "\"#define " $1ドル "\" " $1ドル}' $< |\

cpp -I./$(HDIR) |\

$(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@