🚀 go-pugleaf

Hello,

The following fix is for XScheme - 0.20 but I am pretty sure XLisp
has the same bug. The following code, after a minor bug fix in Xscheme 0.20
will produce an infinate loop in XScheme 0.20:


(set! base (class 'new '()))
(set! nextLevel (class 'new '() '() base))
(set! mainLevel (class 'new '() '() nextLevel))

(base 'answer 'Hello '() '(
(print "Hi from base")
))
(nextLevel 'answer 'Hello '() '(
(print "Hi from nextLevel")
(send-super 'hello)
))
(mainLevel 'answer 'Hello '() '(
(print "Hi from mainlevel")
(send-super 'hello)
))
(print (list "Class(base) -" base))
(print (list "Class(nextLevel) -" nextLevel))
(print (list "Class(mainLevel) -" mainLevel))
(set! foo (mainLevel 'new))
(foo 'Hello)


The send-super to the base level will always go back to nextlevel and
recurse repeatedly. This is because it always takes the ancestor of the object
and not of the message. Mybe someone can find a better way of doing this but
here is a fix to make the above code execute in a sane manner:

13c13
< static LVAL s_self,k_isnew;
---
> static LVAL s_self,k_isnew,s_ancestor;
40a41
> 	        push(getivar(cls,SUPERCLASS)); ++xlargc;
54a56,57
>     LVAL env, names;
>     int offs;
58c61
<     
---
> 
62c65
< 	    goto find_method;
---
> 	    goto find_class;
65c68,78
< find_method:
---
> find_class:
> 
>     for (env = xlenv; env != NIL; env = cdr(env)) {
> 	names = getelement(car(env),0);
> 	for (offs = 1; names != NIL; offs++, names = cdr(names))
> 	    if (s_ancestor == car(names)) {
> 	        cls = getelement(car(env),offs);
> 		goto find_method;}
>     }
>     xlerror("could not find ancestor",sym);
> 
67c80,81
<     cls = getivar(getelement(car(cdr(obj)),0),SUPERCLASS);
---
> 
> find_method:
69c83
<     
---
> 
73a88
> 	        push(getivar(cls,SUPERCLASS)); ++xlargc;
88a104
>     xlgetarg();
97a114
>     xlgetarg();
109a127
>     xlgetarg();
145a164
>     xlgetarg();
159a179
>     xlgetarg();
196a217
>     xlgetarg();
206c227,229
<     cpush(cons(s_self,fargs));
---
>     check(2);
>     push(fargs = cons(s_ancestor,fargs));
>     push(cons(s_self,fargs));
215c238
<     drop(1);
---
>     drop(2);
311a335
>     s_ancestor = xlenter("%ANCESTOR-CLASS");


	If anyone knows of other fixes/updates, please let me know (thanx).

					JonnyG.