[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] Re: ceteris paribus
|
From: |
Camm Maguire |
|
Subject: |
[Gcl-devel] Re: ceteris paribus |
|
Date: |
22 Sep 2005 13:45:57 -0400 |
|
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
Greetings!
Robert Boyer <address@hidden> writes:
> > by the almost 50% differential seen here
>
> Amazing!
>
> > Is this helpful, or is this example artificial?
>
> Well, any example is artificial and this one sure is. 10,000,000 nils!
>
> Getting rid of the NULL checks makes sense. What other functions do that
> check?
>
> Doing the == test first makes intuitive programmer's sense to me given the
> realization that type_of now might take real time.
>
> > Can reduce by another 15% by pulling out the == test before the recursion.
>
> Quite an interesting idea!
>
> > Will commit to head if you are interested.
>
> I am most interested. Or, if you'd rather just send me new code for equal, I
> could try out the nqthm tests with that and the most recent 2.7.0. I'm not
> sure of the importance/significance/impact of "commit to head".
>
OK, just committed this diff to CVS head:
=============================================================================
Index: cmpnew/gcl_cmpfun.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpfun.lsp,v
retrieving revision 1.14
diff -u -r1.14 gcl_cmpfun.lsp
--- cmpnew/gcl_cmpfun.lsp 18 Sep 2005 01:46:25 -0000 1.14
+++ cmpnew/gcl_cmpfun.lsp 22 Sep 2005 17:23:06 -0000
@@ -1066,10 +1066,10 @@
(si::putprop 'sublis 'co1sublis 'co1)
(defun co1sublis (f args &aux test) f
(and (case (length args)
- (2 (setq test 'eql))
+ (2 (setq test 'eql1))
(4 (and (eq (third args) :test)
- (cond ((member (fourth args) '(equal (function equal))) (setq
test 'equal))
- ((member (fourth args) '(eql (function eql))) (setq test
'eql))
+ (cond ((member (fourth args) '(equal (function equal))) (setq
test 'equal1))
+ ((member (fourth args) '(eql (function eql))) (setq test
'eql1))
((member (fourth args) '(eq (function eq))) (setq test
'eq))
))))
(let ((s (gensym)))
@@ -1079,7 +1079,7 @@
(defun sublis1-inline (a b c)
(let ((tst (car (find (cadr c) *objects* :key 'cadr))))
- (or (member tst '(eq equal eql)) (error "bad test"))
+ (or (member tst '(eq equal1 eql1)) (error "bad test"))
(wt "(check_alist("
a
"),sublis1("a "," b "," (format nil "~(&~a~)))" tst))))
Index: h/att_ext.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/att_ext.h,v
retrieving revision 1.36
diff -u -r1.36 att_ext.h
--- h/att_ext.h 18 Sep 2005 02:02:00 -0000 1.36
+++ h/att_ext.h 22 Sep 2005 17:23:09 -0000
@@ -423,7 +423,7 @@
/* prediate.c */
-int eql(),equal(),eq();
+int eql1(),equal1(),eq();
/* print.d */
EXTER object sKupcase;
Index: h/object.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/object.h,v
retrieving revision 1.42
diff -u -r1.42 object.h
--- h/object.h 18 Sep 2005 02:02:00 -0000 1.42
+++ h/object.h 22 Sep 2005 17:23:09 -0000
@@ -1235,3 +1235,7 @@
#define proper_list(a) (type_of(a)==t_cons || (a)==Cnil)
#define fix_dot(a) ((a) == Dotnil ? Cnil : (type_of(a)==t_cons &&
(a)->c.c_cdr==Dotnil ? (a)->c.c_car : (a)))
+
+#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b
|| eql1(_a,_b);})
+#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b
|| equal1(_a,_b);})
+#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b
|| equalp1(_a,_b);})
Index: h/protoize.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/protoize.h,v
retrieving revision 1.57
diff -u -r1.57 protoize.h
--- h/protoize.h 18 Sep 2005 02:02:00 -0000 1.57
+++ h/protoize.h 22 Sep 2005 17:23:11 -0000
@@ -435,11 +435,11 @@
/* predicate.c:346:OF */ extern object fLcompiled_function_p (object x0); /*
(x0) object x0; */
/* predicate.c:367:OF */ extern object fLcommonp (object x0); /* (x0) object
x0; */
/* predicate.c:379:OF */ extern object fLeq (object x0, object x1); /* (x0,
x1) object x0; object x1; */
-/* predicate.c:393:OF */ extern int eql (object x, object y); /* (x, y) object
x; object y; */
+/* predicate.c:393:OF */ extern int eql1 (object x, object y); /* (x, y)
object x; object y; */
/* predicate.c:455:OF */ extern object fLeql (object x0, object x1); /* (x0,
x1) object x0; object x1; */
-/* predicate.c:469:OF */ extern int equal (register object x, register object
y); /* (x, y) register object x; register object y; */
+/* predicate.c:469:OF */ extern int equal1 (register object x, register object
y); /* (x, y) register object x; register object y; */
/* predicate.c:543:OF */ extern object fLequal (object x0, object x1); /* (x0,
x1) object x0; object x1; */
-/* predicate.c:557:OF */ extern bool equalp (object x, object y); /* (x, y)
object x; object y; */
+/* predicate.c:557:OF */ extern bool equalp1 (object x, object y); /* (x, y)
object x; object y; */
/* predicate.c:681:OF */ extern object fLequalp (object x0, object x1); /*
(x0, x1) object x0; object x1; */
/* predicate.c:750:OF */ extern bool contains_sharp_comma (object x); /* (x)
object x; */
/* predicate.c:797:OF */ extern object fScontains_sharp_comma (object x0); /*
(x0) object x0; */
Index: o/array.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/array.c,v
retrieving revision 1.40
diff -u -r1.40 array.c
--- o/array.c 18 Sep 2005 02:48:58 -0000 1.40
+++ o/array.c 22 Sep 2005 17:23:14 -0000
@@ -482,7 +482,7 @@
DEFUN_NEW("AELTTYPE-LIST",object,fSaelttype_list,SI,0,0,NONE,OO,OO,OO,OO,(),"")
{
aet_type_struct *p,*pe;
- object f,x,y=OBJNULL;
+ object f=Cnil,x,y=OBJNULL;
for (p=aet_types,pe=p+aet_object;p<=pe;p++) {
x=MMcons(*p->namep,Cnil);
Index: o/hash.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/hash.d,v
retrieving revision 1.17
diff -u -r1.17 hash.d
--- o/hash.d 18 Sep 2005 02:48:59 -0000 1.17
+++ o/hash.d 22 Sep 2005 17:23:14 -0000
@@ -279,11 +279,11 @@
break;
case htt_eql:
i = hash_eql(key);
- f=eql;
+ f=eql1;
break;
case htt_equal:
i = ihash_equal(key,0);
- f=equal;
+ f=equal1;
break;
default:
FEerror( "gethash: Hash table not of type EQ, EQL, or EQUAL." ,0);
@@ -302,7 +302,7 @@
if (e->hte_value==OBJNULL) return first_objnull ? first_objnull : e;
if (!first_objnull) first_objnull=e;
} else
- if (f ? f(key,hkey) : key==hkey) return e;
+ if (key == hkey || (f && f(key,hkey))) return e;
}
if (s) {
q=s;
Index: o/list.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/list.d,v
retrieving revision 1.33
diff -u -r1.33 list.d
--- o/list.d 7 Sep 2005 02:55:02 -0000 1.33
+++ o/list.d 22 Sep 2005 17:23:14 -0000
@@ -1093,7 +1093,7 @@
bool (*tst)();
{object v;
for (v=alist ; v!=Cnil; v=v->c.c_cdr)
- { if ((*tst)(v->c.c_car->c.c_car ,tree))
+ { if (v->c.c_car->c.c_car == tree || (*tst)(v->c.c_car->c.c_car ,tree))
return(v->c.c_car->c.c_cdr);}
if (type_of(tree)==t_cons)
{object ntree=make_cons(sublis1(alist,tree->c.c_car,tst),
Index: o/predicate.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/predicate.c,v
retrieving revision 1.13
diff -u -r1.13 predicate.c
--- o/predicate.c 18 Sep 2005 02:48:59 -0000 1.13
+++ o/predicate.c 22 Sep 2005 17:23:14 -0000
@@ -446,65 +446,67 @@
;}
bool
-eql(object x, object y)
-{
- enum type t;
+eql1(register object x, register object y) {
- if (x == y)
- return(TRUE);
- if ((t = type_of(x)) != type_of(y))
- return(FALSE);
- switch (t) {
+ register enum type t;
- case t_fixnum:
- if (fix(x) == fix(y))
- return(TRUE);
- else
- return(FALSE);
-
- case t_bignum:
- if (big_compare(x,y) == 0)
- return(TRUE);
- else
- return(FALSE);
-
- case t_ratio:
- if (eql(x->rat.rat_num, y->rat.rat_num) &&
- eql(x->rat.rat_den, y->rat.rat_den))
- return(TRUE);
- else
- return(FALSE);
-
- case t_shortfloat:
- if (sf(x) == sf(y))
- return(TRUE);
- else
- return(FALSE);
-
- case t_longfloat:
- if (lf(x) == lf(y))
- return(TRUE);
- else
- return(FALSE);
-
- case t_complex:
- if (eql(x->cmp.cmp_real, y->cmp.cmp_real) &&
- eql(x->cmp.cmp_imag, y->cmp.cmp_imag))
- return(TRUE);
- else
- return(FALSE);
-
- case t_character:
- if (char_code(x) == char_code(y) &&
- char_bits(x) == char_bits(y) &&
- char_font(x) == char_font(y))
- return(TRUE);
- else
- return(FALSE);
- default:
- break;
- }
- return(FALSE);
+/* if (x == y) */
+/* return(TRUE); */
+
+ if ((t = type_of(x)) != type_of(y))
+ return(FALSE);
+
+ switch (t) {
+
+ case t_fixnum:
+ if (fix(x) == fix(y))
+ return(TRUE);
+ else
+ return(FALSE);
+
+ case t_bignum:
+ if (big_compare(x,y) == 0)
+ return(TRUE);
+ else
+ return(FALSE);
+
+ case t_ratio:
+ if (eql(x->rat.rat_num, y->rat.rat_num) &&
+ eql(x->rat.rat_den, y->rat.rat_den))
+ return(TRUE);
+ else
+ return(FALSE);
+
+ case t_shortfloat:
+ if (sf(x) == sf(y))
+ return(TRUE);
+ else
+ return(FALSE);
+
+ case t_longfloat:
+ if (lf(x) == lf(y))
+ return(TRUE);
+ else
+ return(FALSE);
+
+ case t_complex:
+ if (eql(x->cmp.cmp_real, y->cmp.cmp_real) &&
+ eql(x->cmp.cmp_imag, y->cmp.cmp_imag))
+ return(TRUE);
+ else
+ return(FALSE);
+
+ case t_character:
+ if (char_code(x) == char_code(y) &&
+ char_bits(x) == char_bits(y) &&
+ char_font(x) == char_font(y))
+ return(TRUE);
+ else
+ return(FALSE);
+ default:
+ break;
+ }
+ return(FALSE);
}
DEFUNO_NEW("EQL",object,fLeql,LISP
@@ -520,90 +522,87 @@
RETURN1(x0);}
-bool
-equal(register object x, register object y)
-
-#ifdef UNIX /* in non unix case cs_check want's an address */
-
-#endif
-
-{
-register enum type t;
- cs_check(y);
- cs_check(x);
-
-BEGIN:
- if ( NULL == x ) {
- FEerror ( "equal: x is a NULL pointer", 0 );
- }
- if ( NULL == y ) {
- FEerror ( "equal: y is a NULL pointer", 0 );
- }
- if ((t = type_of(x)) != type_of(y))
- return(FALSE);
- if (x==y)
- return(TRUE);
- switch (t) {
-
- case t_cons:
- if (!equal(x->c.c_car, y->c.c_car))
- return(FALSE);
- x = x->c.c_cdr;
- y = y->c.c_cdr;
- goto BEGIN;
-
- case t_structure:
- case t_symbol:
- case t_vector:
- case t_array:
- return FALSE;
-
- case t_fixnum :
- return(fix(x)==fix(y));
- case t_shortfloat:
- return(x->SF.SFVAL==y->SF.SFVAL);
- case t_longfloat:
- return(x->LF.LFVAL==y->LF.LFVAL);
-
- case t_string:
- return(string_eq(x, y));
-
- case t_bitvector:
- {
- int i, ox, oy;
-
- if (x->bv.bv_fillp != y->bv.bv_fillp)
- return(FALSE);
- ox = BV_OFFSET(x);
- oy = BV_OFFSET(y);
- for (i = 0; i < x->bv.bv_fillp; i++)
- if((x->bv.bv_self[(i+ox)/8] & (0200>>(i+ox)%8))
- !=(y->bv.bv_self[(i+oy)/8] & (0200>>(i+oy)%8)))
- return(FALSE);
- return(TRUE);
- }
+bool
+equal1(register object x, register object y) {
- case t_pathname:
- if (equal(x->pn.pn_host, y->pn.pn_host) &&
- equal(x->pn.pn_device, y->pn.pn_device) &&
- equal(x->pn.pn_directory, y->pn.pn_directory) &&
- equal(x->pn.pn_name, y->pn.pn_name) &&
- equal(x->pn.pn_type, y->pn.pn_type)) {
- /* version is ignored unless logical host */
- if ((type_of(x->pn.pn_host) == t_string) &&
- (pathname_lookup(x->pn.pn_host,sSApathname_logicalA) !=
Cnil))
- return(equal(x->pn.pn_version, y->pn.pn_version) ?
- TRUE : FALSE);
- else
- return(TRUE);
- } else
- return(FALSE);
- default:
- break;
- }
- return(eql(x,y));
+ register enum type t;
+
+ BEGIN:
+ /* if ( NULL == x ) { */
+ /* FEerror ( "equal: x is a NULL pointer", 0 ); */
+ /* } */
+ /* if ( NULL == y ) { */
+ /* FEerror ( "equal: y is a NULL pointer", 0 ); */
+ /* } */
+
+/* if (x==y) */
+/* return(TRUE); */
+
+ if ((t = type_of(x)) != type_of(y))
+ return(FALSE);
+
+ switch (t) {
+
+ case t_cons:
+ if (!equal(x->c.c_car, y->c.c_car))
+ return(FALSE);
+ x = x->c.c_cdr;
+ y = y->c.c_cdr;
+ if (x==y) return (TRUE);
+ goto BEGIN;
+
+ case t_structure:
+ case t_symbol:
+ case t_vector:
+ case t_array:
+ return FALSE;
+
+ case t_fixnum :
+ return(fix(x)==fix(y));
+ case t_shortfloat:
+ return(x->SF.SFVAL==y->SF.SFVAL);
+ case t_longfloat:
+ return(x->LF.LFVAL==y->LF.LFVAL);
+
+ case t_string:
+ return(string_eq(x, y));
+
+ case t_bitvector:
+ {
+ fixnum i, ox, oy;
+
+ if (x->bv.bv_fillp != y->bv.bv_fillp)
+ return(FALSE);
+ ox = BV_OFFSET(x);
+ oy = BV_OFFSET(y);
+ for (i = 0; i < x->bv.bv_fillp; i++)
+ if((x->bv.bv_self[(i+ox)/8] & (0200>>(i+ox)%8))
+ !=(y->bv.bv_self[(i+oy)/8] & (0200>>(i+oy)%8)))
+ return(FALSE);
+ return(TRUE);
+ }
+
+ case t_pathname:
+ if (equal(x->pn.pn_host, y->pn.pn_host) &&
+ equal(x->pn.pn_device, y->pn.pn_device) &&
+ equal(x->pn.pn_directory, y->pn.pn_directory) &&
+ equal(x->pn.pn_name, y->pn.pn_name) &&
+ equal(x->pn.pn_type, y->pn.pn_type)) {
+ /* version is ignored unless logical host */
+ if ((type_of(x->pn.pn_host) == t_string) &&
+ (pathname_lookup(x->pn.pn_host,sSApathname_logicalA) != Cnil))
+ return(equal(x->pn.pn_version, y->pn.pn_version) ?
+ TRUE : FALSE);
+ else
+ return(TRUE);
+ } else
+ return(FALSE);
+ default:
+ break;
+ }
+ return(eql(x,y));
}
DEFUNO_NEW("EQUAL",object,fLequal,LISP
@@ -621,133 +620,145 @@
}
bool
-equalp(object x, object y)
-{
- enum type tx, ty;
- int j;
-
- cs_check(x);
+equalp1(register object x, register object y) {
-BEGIN:
- if (eql(x, y))
- return(TRUE);
- tx = type_of(x);
- ty = type_of(y);
-
- switch (tx) {
- case t_fixnum:
- case t_bignum:
- case t_ratio:
- case t_shortfloat:
- case t_longfloat:
- case t_complex:
- if (ty == t_fixnum || ty == t_bignum || ty == t_ratio ||
- ty == t_shortfloat || ty == t_longfloat ||
- ty == t_complex)
- return(!number_compare(x, y));
- else
- return(FALSE);
-
- case t_vector:
- case t_string:
- case t_bitvector:
- if (ty == t_vector || ty == t_string || ty == t_bitvector)
- { j = x->v.v_fillp;
- if (j != y->v.v_fillp)
- return FALSE;
- goto ARRAY;}
- else
- return(FALSE);
-
- case t_array:
- if (ty == t_array && x->a.a_rank == y->a.a_rank)
- { if (x->a.a_rank > 1)
- {int i=0;
- for (i=0; i< x->a.a_rank; i++)
- {if (x->a.a_dims[i]!=y->a.a_dims[i])
- return(FALSE);}}
- if (x->a.a_dim != y->a.a_dim)
- return(FALSE);
- j=x->a.a_dim;
- goto ARRAY;}
- else
- return(FALSE);
- default:
- break;
+ register enum type tx, ty;
+ fixnum j;
+
+ BEGIN:
+ if (eql1(x, y))
+ return(TRUE);
+
+ tx = type_of(x);
+ ty = type_of(y);
+
+ switch (tx) {
+ case t_fixnum:
+ case t_bignum:
+ case t_ratio:
+ case t_shortfloat:
+ case t_longfloat:
+ case t_complex:
+ if (ty == t_fixnum || ty == t_bignum || ty == t_ratio ||
+ ty == t_shortfloat || ty == t_longfloat ||
+ ty == t_complex)
+ return(!number_compare(x, y));
+ else
+ return(FALSE);
+
+ case t_vector:
+ case t_string:
+ case t_bitvector:
+ if (ty == t_vector || ty == t_string || ty == t_bitvector) {
+ j = x->v.v_fillp;
+ if (j != y->v.v_fillp)
+ return FALSE;
+ goto ARRAY;
+ }
+ else
+ return(FALSE);
+
+ case t_array:
+ if (ty == t_array && x->a.a_rank == y->a.a_rank) {
+ if (x->a.a_rank > 1) {
+ fixnum i;
+ for (i=0; i< x->a.a_rank; i++) {
+ if (x->a.a_dims[i]!=y->a.a_dims[i])
+ return(FALSE);
}
- if (tx != ty)
+ }
+ if (x->a.a_dim != y->a.a_dim)
+ return(FALSE);
+ j=x->a.a_dim;
+ goto ARRAY;
+ }
+ else
+ return(FALSE);
+ default:
+ break;
+ }
+
+ if (tx != ty)
+ return(FALSE);
+
+ switch (tx) {
+
+ case t_character:
+ return(char_equal(x, y));
+
+ case t_cons:
+ if (!equalp(x->c.c_car, y->c.c_car))
+ return(FALSE);
+ x = x->c.c_cdr;
+ y = y->c.c_cdr;
+ if (x==y) return (TRUE);
+ goto BEGIN;
+
+ case t_structure:
+ {
+ fixnum i;
+ if (x->str.str_def != y->str.str_def)
+ return(FALSE);
+ {
+ fixnum leng= S_DATA(x->str.str_def)->length;
+ unsigned char *s_type= & SLOT_TYPE(x->str.str_def,0);
+ unsigned short *s_pos= & SLOT_POS(x->str.str_def,0);
+ for (i = 0; i < leng; i++,s_pos++) {
+ if (s_type[i]==aet_object) {
+ if (!equalp(STREF(object,x,*s_pos),STREF(object,y,*s_pos)))
+ return FALSE;
+ }
+ else
+ /* if (! (*s_pos & (sizeof(object)-1))) */
+ switch(s_type[i]) {
+ case aet_lf:
+ if((! (*s_pos & (sizeof(longfloat)-1))) &&
+ STREF(longfloat,x,*s_pos) != STREF(longfloat,y,*s_pos))
+ return(FALSE);
+ break;
+ case aet_sf:
+ if((! (*s_pos & (sizeof(shortfloat)-1))) &&
+ STREF(shortfloat,x,*s_pos)!=STREF(shortfloat,y,*s_pos))
+ return(FALSE);
+ break;
+ default:
+ if((! (*s_pos & (sizeof(fixnum)-1))) &&
+ STREF(fixnum,x,*s_pos)!=STREF(fixnum,y,*s_pos))
return(FALSE);
- switch (tx) {
- case t_character:
- return(char_equal(x, y));
-
- case t_cons:
- if (!equalp(x->c.c_car, y->c.c_car))
- return(FALSE);
- x = x->c.c_cdr;
- y = y->c.c_cdr;
- goto BEGIN;
-
- case t_structure:
- {
- int i;
- if (x->str.str_def != y->str.str_def)
- return(FALSE);
- {int leng= S_DATA(x->str.str_def)->length;
- unsigned char *s_type= & SLOT_TYPE(x->str.str_def,0);
- unsigned short *s_pos= & SLOT_POS(x->str.str_def,0);
- for (i = 0; i < leng; i++,s_pos++)
- {if (s_type[i]==aet_object)
- {if (!equalp(STREF(object,x,*s_pos),STREF(object,y,*s_pos)))
- return FALSE;}
- else
-/* if (! (*s_pos & (sizeof(object)-1))) */
- switch(s_type[i]){
- case aet_lf:
- if((! (*s_pos & (sizeof(longfloat)-1))) &&
- STREF(longfloat,x,*s_pos) != STREF(longfloat,y,*s_pos))
- return(FALSE);
- break;
- case aet_sf:
- if((! (*s_pos & (sizeof(shortfloat)-1))) &&
- STREF(shortfloat,x,*s_pos)!=STREF(shortfloat,y,*s_pos))
- return(FALSE);
- break;
- default:
- if((! (*s_pos & (sizeof(fixnum)-1))) &&
- STREF(fixnum,x,*s_pos)!=STREF(fixnum,y,*s_pos))
- return(FALSE);
- break;}}
- return(TRUE);
- }}
-
- case t_pathname:
- return(equal(x, y));
- default:
- break;
+ break;
+ }
}
+ return(TRUE);
+ }
+ }
+
+ case t_pathname:
+ return(equal(x, y));
+ default:
+ break;
+ }
+ return(FALSE);
+
+ ARRAY:
+
+ {
+ fixnum i;
+
+ vs_push(Cnil);
+ vs_push(Cnil);
+ for (i = 0; i < j; i++) {
+ vs_top[-2] = aref(x, i);
+ vs_top[-1] = aref(y, i);
+ if (!equalp(vs_top[-2], vs_top[-1])) {
+ vs_popp;
+ vs_popp;
return(FALSE);
-
-ARRAY:
-
- {
- int i;
-
- vs_push(Cnil);
- vs_push(Cnil);
- for (i = 0; i < j; i++) {
- vs_top[-2] = aref(x, i);
- vs_top[-1] = aref(y, i);
- if (!equalp(vs_top[-2], vs_top[-1])) {
- vs_popp;
- vs_popp;
- return(FALSE);
- }
- }
- vs_popp;
- vs_popp;
- return(TRUE);
- }
+ }
+ }
+ vs_popp;
+ vs_popp;
+ return(TRUE);
+ }
}
DEFUNO_NEW("EQUALP",object,fLequalp,LISP
=============================================================================
> Thanks,
>
> Bob
>
> -------------------------------------------------------------------------------
>
>
> P. S. In the case we have only immediate fixnums, shouldn't the equal
>
> case t_fixnum :
> return(fix(x)==fix(y));
>
> be simplified to
>
> case t_fixnum :
> return(FALSE);
>
> since we already failed the == test?
>
Yes, but we never only have immediate fixnums, do we? In GCL, fixnums
cover the whole word range, and immediate fixnums are necessarily of
subset of this. Am I misunderstanding here?
> -------------------------------------------------------------------------------
>
>
> P. P. S. I don't think you ever got back to me on my suggestion to flush
> dotnil.
My apologies -- I overlooked this!
I agree COMPLETELY -- I put in DOTNIL quite early in my involvement
with GCL in an effort to accelerate ANSI compliance. But it really
should go. I'd be happy to do so now if someone could kindly provide
me a complete list of functions which are supposed to handle an
improper list according to the spec. Paul has been putting in some
pretty nasty test functions which has been complicating our list
handling. I just put in a check-type at the end of the dolist macro
to properly handle some of these, but if you look at how the code
expands, it is quite heavyweight. It is on my todo to omit all
check-type when *safety* is 0, but the form could have side-effects
- sigh.
Why T is handled the same way as NIL is beyond me -- this was before
my time, but I don't think (cdr t) is ever taken and T could be an
ordinary symbol. Then we just have the special case nil, and we don't
have to worry about where it is placed, as checking for it is one
instruction anyway.
I also think the cons check should be !->d.e first and then check if
the cdr is an odd immediate fixnum -- this should clearly be somewhat
faster.
In any case, we need to ensure that type_of is cached whenever called
multiple times. I've reordered the enum type list to change the old
'vectorp expansion:
(type_of(x)==t_string || (type_of(x)==t_vector || ...)
to
({enum type _tp=type_of(x);_t>=t_string && _t<=t_vector;})
for example. If you find other examples where this need be done,
please let me know.
Take care,
>
> >From boyer Tue Jul 26 10:09:32 -0500 2005
> To: camm
> Cc: hunt
> Subject: flush dotnil ?
>
> I am barely beginning to understand the dotnil and endp stuff, so please
> forgive me if this message is ludicrous.
>
> Dotnil's implementation is pretty amazing to me even though I barely know
> what a static declaration in c is. But I really wonder if dotnil is a good
> idea or was done at all right.
>
> Off the top of my head and the seat of my pants, I think that the idea of a
> Lisp implementation automagically converting an improper list to a proper
> list to be totally foreign to the history of Lisp. I'll be happily shown
> wrong, but I doubt I will be.
>
> For example, (apply #'+ (list* 1 2 3)), which GCL now says is 6, causes an
> error in Allegro, CMU, and Clisp. Even in Emacs Lisp.
>
> Why do I care? If you get rid of dotnil, that will make type_of one
> instruction faster!
>
> Bob
>
> P. S. Currently, (eval '(and 1 2 . 3)) returns #:DOTNIL.
>
> Allegro returns 2 (not caring how things end, I guess) and CMU causes an
> error because of the ugly ending. Clisp agrees with Allegro. But returning
> a gensym that evaluates to itself seems wild!
>
> It is my guess, based upon all to little scrutiny, that the vast majority of
> the C calls of endp in GCL were fine and would be just fine causing an error
> on a non-nil atom. The very few cases, such as BUTLAST, where GCL was simply
> wrong should just be fixed when someone finds an error or has the time to
> read over the code.
>
> gcl-newest-ansi
> GCL (GNU Common Lisp) 2.7.0 ANSI Jul 23 2005 12:04:01
> Source License: LGPL(gcl,gmp), GPL(unexec,bfd)
> Binary License: GPL due to GPL'ed components: (BFD UNEXEC)
> Modifications of this banner must retain notice of a compatible license
> Dedicated to the memory of W. Schelter
>
> Use (help) to get some basic information on how to use GCL.
>
> >(eval '(and 1 2 . 3))
>
> #:DOTNIL
>
> >(apply #'+ (list* 1 2 3))
>
> 6
>
> >
>
>
>
>
>
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
- [Gcl-devel] Re: ceteris paribus,
Camm Maguire <=